diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,9 +1,8 @@ +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} module Main where -import Distribution.Simple -import Distribution.Simple.UUAGC -import UU.UUAGC.Bootstrap +import Distribution.Simple (defaultMainWithHooks) +import Distribution.Simple.UUAGC (uuagcUserHook) --- uses the bootstrapped version of uuagc to build itself -compiler = uuagcBootstrap -main = defaultMainWithHooks (uuagcLibUserHook compiler) +main :: IO () +main = defaultMainWithHooks uuagcUserHook diff --git a/dist/build/AG2AspectAG.hs b/dist/build/AG2AspectAG.hs new file mode 100644 --- /dev/null +++ b/dist/build/AG2AspectAG.hs @@ -0,0 +1,3679 @@ + + +-- UUAGC 0.9.42.0 (src-ag/AG2AspectAG.ag) +module AG2AspectAG where +{-# LINE 8 "./src-ag/AG2AspectAG.ag" #-} + +import Options + +import Data.Char +import Data.List +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe + +import Pretty +import PPUtil +import UU.Scanner.Position + +import AbstractSyntax +import TokenDef +import CommonTypes + +-- import Debug.Trace +{-# LINE 25 "dist/build/AG2AspectAG.hs" #-} + +{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import Macro --marcos +import CommonTypes +import ErrorMessages +{-# LINE 37 "dist/build/AG2AspectAG.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 44 "dist/build/AG2AspectAG.hs" #-} + +{-# LINE 2 "./src-ag/Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 50 "dist/build/AG2AspectAG.hs" #-} + +{-# LINE 2 "./src-ag/HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 56 "dist/build/AG2AspectAG.hs" #-} +{-# LINE 28 "./src-ag/AG2AspectAG.ag" #-} + +pragmaAspectAG = pp "{-# LANGUAGE EmptyDataDecls, NoMonomorphismRestriction , TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}" + +{-# LINE 61 "dist/build/AG2AspectAG.hs" #-} + +{-# LINE 33 "./src-ag/AG2AspectAG.ag" #-} + +ppName l = ppListSep "" "" "_" l +{-# LINE 66 "dist/build/AG2AspectAG.hs" #-} + +{-# LINE 70 "./src-ag/AG2AspectAG.ag" #-} + +type FieldMap = [(Identifier, Type)] +type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap) +{-# LINE 72 "dist/build/AG2AspectAG.hs" #-} + +{-# LINE 342 "./src-ag/AG2AspectAG.ag" #-} + +filterAtts newAtts = filter (\att -> Map.member (identifier att) newAtts) +filterNotAtts newAtts = filter (\att -> not (Map.member (identifier att) newAtts)) + +defAtt att = "data " >|< attTName att >|< "; " >|< attName att >|< " = proxy :: Proxy " >|< attTName att +attName att = pp $ "att_" ++ att +attTName att = pp $ "Att_" ++ att + + +defAttRec recPref ppNt atts noGroup = + let recName = ppName [recPref, ppNt] + fields = ppCommas (map (\(a,t) -> ppName [pp a, recName ] >|< " ::" >|< ppShow t) (groupAtts atts noGroup)) + in + "data " >|< recName >|< " = " >|< recName >|< " { " >|< fields >|< " }" + +groupAtts atts noGroup = (Map.toAscList . Map.difference atts) noGroup + +-- it defines selectors with the form: +-- l1_nt_prod(x, _, .., _) = x +-- ln_nt_prod(_, .., _, x) = x +defLocalAtts prodName total actual (l:ls) = ppName [pp l, prodName] >|< + ppListSep "(" ")" "," (replicate (actual-1) "_" ++ "x" : replicate (total-actual) "_") >|< + pp " = x" >-< + defLocalAtts prodName total (actual+1) ls +defLocalAtts _ _ _ [] = empty + +{-# LINE 101 "dist/build/AG2AspectAG.hs" #-} + +{-# LINE 397 "./src-ag/AG2AspectAG.ag" #-} + +ntsList att ppNtL = "nts_" ++ att ++ " = " >|< ppListSep "" "" " .*. " ((map fst ppNtL) ++ [pp "hNil"]) + +filterNts att = filter ( Map.member (identifier att) . snd ) +{-# LINE 108 "dist/build/AG2AspectAG.hs" #-} + +{-# LINE 455 "./src-ag/AG2AspectAG.ag" #-} + +data PPRule = PPRule Identifier Identifier Bool ([(Identifier,Type)] -> [Identifier] -> PP_Doc) + +ppRule (field,attr) owrt def = PPRule field attr owrt def +ruleField (PPRule field _ _ _ ) = field +ruleAttr (PPRule _ attr _ _ ) = attr +ruleOwrt (PPRule _ _ owrt _ ) = owrt +ruleDef (PPRule _ _ _ def) = def + +{-# LINE 120 "dist/build/AG2AspectAG.hs" #-} + +{-# LINE 494 "./src-ag/AG2AspectAG.ag" #-} + + +defInhGRule ppNt prodName newNT newProd ch rules inhNoGroup synNoGroup chids locals = + let ppAtt = ppName [pp "inh", prodName] + ppR = ppAtt >|< pp " = inhdefM att_inh nts_group $" >-< + indent 4 "do " >-< + indent 5 "loc <- at loc" >-< + indent 5 "lhs <- at lhs" >-< + indent 5 ch >-< + indent 5 "return $" >-< + indent 6 (foldr (>-<) (pp "emptyRecord") (map (chGRule ppNt prodName rules inhNoGroup synNoGroup chids locals) chids)) + in if (newNT || (not newNT && newProd)) + then (ppR, [ ppAtt ]) + else (empty, []) + +chGRule ppNt prodName rules inhNoGroup synNoGroup chids locals (idCh,tp) = + let chName = ppName [pp "ch", pp idCh, prodName] + ppTp = ppShow tp + chRules = ppCommas $ mapGRuleDefs (== idCh) rules inhNoGroup synNoGroup chids locals + in if (isNonterminal tp) + then chName >|< ".=." >-< + indent 1 "InhG_" >|< ppShow tp >|< pp " {" >-< + indent 2 chRules >-< + indent 1 "} .*. " + else empty + + +defSynGRule ppNt prod newNT newProd ch rules inhNoGroup synNoGroup chids locals = + let ppAtt = ppName [pp "syn", ppNt, pp prod] + ppTAtt = "SynG_" >|< ppNt + ppR = ppAtt >|< pp " = syndefM att_syn $" >-< + indent 4 "do " >-< + indent 5 "loc <- at loc" >-< + indent 5 "lhs <- at lhs" >-< + indent 5 ch >-< + indent 5 "return $" >-< + indent 6 ppTAtt >|< pp " {" >-< + indent 7 (ppCommas $ mapGRuleDefs ((== "lhs") . show) rules inhNoGroup synNoGroup chids locals) >-< + indent 6 "}" + in if (newNT || (not newNT && newProd)) + then (ppR, [ ppAtt ]) + else (empty, []) + +defLocRule ppNt prod newNT newProd ch rules inhNoGroup synNoGroup chids locals = + let ppAtt = ppName [pp "loc", ppNt, pp prod] + ppTAtt = ppName [pp "Loc", ppNt, pp prod] + ppR = ppAtt >|< pp " = locdefM att_loc $" >-< + indent 4 "do " >-< + indent 5 "loc <- at loc" >-< + indent 5 "lhs <- at lhs" >-< + indent 5 ch >-< + indent 5 "return $" >-< + indent 6 (ppListSep "(" ")" "," $ mapLRuleDefs rules inhNoGroup synNoGroup chids locals) + in (ppR, [ ppAtt ]) + +defInstRules ppNt prod newNT newProd ch rules chids locals + = let ppAsp = ppName [pp "inst", ppNt, pp prod] + instRules = filter ((=="inst") . show . ruleField) rules + ppAtt att = ppListSep "`ext` " "" "_" [pp "inst_ch", pp att, ppNt, pp prod] + in ( ppAsp >|< pp " = emptyRule " >|< (map (ppAtt . ruleAttr) instRules) >-< + (vlist $ map (defInstRule ppNt prod ch chids locals) instRules) + , [ ppAsp ]) + + +defInstRule ppNt prod ch chids locals rule = + let ppAtt = ppName [pp "ch", pp (ruleAttr rule), ppNt, pp prod] + in pp "inst_" >|< ppAtt >|< pp " = instdefM " >|< ppAtt >|< pp " $" >-< + indent 4 "do " >-< + indent 5 "loc <- at loc" >-< + indent 5 "lhs <- at lhs" >-< + indent 5 ch >-< + indent 5 "return $" >-< + indent 6 ((ruleDef rule) chids locals) + + +defSynRules ppNt prod newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals + = let synRules = filter ( (=="lhs") . show . ruleField) rules + ngRules = filter ((flip elem synNoGroup) . getName . ruleAttr) synRules + (ppR, ppRA) = unzip $ map (defSynRule True ppNt prod newNT newProd newAtts ch chids locals) ngRules + in (vlist ppR, concat ppRA ) + +modSynRules ppNt prod newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals + = let synRules = filter ( (=="lhs") . show . ruleField) rules + ngRules = filter ((flip elem synNoGroup) . getName . ruleAttr) synRules + (ppR, ppRA) = unzip $ map (defSynRule False ppNt prod newNT newProd newAtts ch chids locals) ngRules + in (vlist ppR, concat ppRA ) + +defSynRule new ppNt prod newNT newProd newAtts ch chids locals rule = + let att = ruleAttr rule + newAtt = Map.member att newAtts + owrt = ruleOwrt rule + ppAtt = ppName [pp att, pp (if new then "syn" else "synM"), ppNt, pp prod] + ppR def = ppAtt >|< pp (" = " ++ def ++ " ") >|< attName (show att) >|< pp " $" >-< + indent 4 "do " >-< + indent 5 "loc <- at loc" >-< + indent 5 "lhs <- at lhs" >-< + indent 5 ch >-< + indent 5 "return $" >-< + indent 6 ((ruleDef rule) chids locals) + in + if new + then if (not owrt && (newNT || (not newNT && newProd) || newAtt)) + then (ppR "syndefM", [ ppAtt ]) + else (empty, []) + else if owrt + then (ppR "synmodM", [ ppAtt ]) + else (empty, []) + + + +defInhRules ppNt prodName newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals + = let ngRules = filter ((flip elem inhNoGroup) . getName . ruleAttr) rules + (ppR, ppRA) = unzip $ map (defInhRule True ppNt prodName newNT newProd newAtts ch ngRules inhNoGroup synNoGroup chids locals) inhNoGroup + in (vlist ppR, concat ppRA) + +modInhRules ppNt prodName newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals + = let ngRules = filter ((flip elem inhNoGroup) . getName . ruleAttr) rules + (ppR, ppRA) = unzip $ map (defInhRule False ppNt prodName newNT newProd newAtts ch ngRules inhNoGroup synNoGroup chids locals) inhNoGroup + in (vlist ppR, concat ppRA) + + +defInhRule new ppNt prodName newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals att = + let ppAtt = ppName [pp att, pp (if new then "inh" else "inhM"),prodName] + newAtt = Map.member (identifier att) newAtts + chRMaybe = map (chRule new ppNt prodName att rules inhNoGroup synNoGroup chids locals) chids + chR = [ x | (Just x) <- chRMaybe ] + ppR def = ppAtt >|< pp (" = " ++ def ++ " ") >|< attName att >|< " nts_" >|< att >|< " $" >-< + indent 4 "do " >-< + indent 5 "loc <- at loc" >-< + indent 5 "lhs <- at lhs" >-< + indent 5 ch >-< + indent 5 "return $" >-< + indent 6 (foldr (>-<) (pp "emptyRecord") chR) + in + if new + then if (newNT || (not newNT && newProd) || newAtt) + then (ppR "inhdefM", [ ppAtt ]) + else (empty, []) + else if (not . null) chR + then (ppR "inhmodM", [ ppAtt ]) + else (empty, []) + + +chRule new ppNt prodName att rules inhNoGroup synNoGroup chids locals (idCh,tp) = + let chName = ppName [pp "ch", pp idCh, prodName] + ppTp = ppShow tp + chRule = inhRuleDef new (== idCh) (== att) rules inhNoGroup synNoGroup chids locals -- it's supposed to be only one + in if (isNonterminal tp && (not . null) chRule) + then Just $ chName >|< ".=. (" >|< chRule >|< ") .*. " + else Nothing + + +mapLRuleDefs rules inhNoGroup synNoGroup chids locals + = map appSnd $ sortBy cmpField $ filter ((== "loc") . show . ruleField) rules + where cmpField r1 r2 = compare (ruleField r1) (ruleField r2) + appSnd rule = (ruleDef rule) chids locals + + +mapGRuleDefs filt rules inhNoGroup synNoGroup chids locals + = map appSnd $ sortBy cmpField $ filter (not . (flip elem inhNoGroup) . getName . ruleAttr) + $ filter (not . (flip elem synNoGroup) . getName . ruleAttr) + $ filter ( filt . ruleField) rules + where cmpField r1 r2 = compare (ruleField r1) (ruleField r2) + appSnd rule = (ruleDef rule) chids locals + +inhRuleDef new filt1 filt2 rules inhNoGroup synNoGroup chids locals + = map appSnd $ sortBy cmpField $ filter ( (== not new) . ruleOwrt) + $ filter ((flip elem inhNoGroup) . getName . ruleAttr) + $ filter ( filt2 . getName . ruleAttr) + $ filter ( filt1 . ruleField) rules + where cmpField r1 r2 = compare (ruleField r1) (ruleField r2) + appSnd rule = (ruleDef rule) chids locals + +defRule ppNt (field,att) noGroup rhs = \chids locals -> + let ppAtt = if (elem (getName att) noGroup) + then empty + else case (show field) of + "lhs" -> att >|< "_" >|< pp "SynG" >|< pp "_" >|< ppNt >|< " = " + "loc" -> empty + "inst" -> empty + otherwise -> att >|< "_" >|< pp "InhG" >|< pp "_" >|< + (maybe (error $ "lhs field " ++ show field ++" is not a child") + ppShow (lookup field chids)) + >|< " = " + in ppAtt >|< (rhs noGroup field chids locals) + + +rhsRule ppNt ppProd tks noGroup field chids locals = vlist . lines2PP . (map (token2PP ppNt ppProd field chids locals noGroup )) $ tks + + +lines2PP [] = [] +lines2PP xs = map line2PP . shiftLeft . getLines $ xs + + +token2PP ppNt ppProd field chids locals noGroup tk + = case tk of + AGLocal var pos _ -> (pos, if (elem var locals) + then (ppListSep "(" "" "_" [pp var, ppNt, ppProd]) >|< pp " (loc # att_loc)) " + else pp var) + AGField field attr pos _ -> let ppChT = maybe (error $ "rhs field " ++ show field ++ " is not a child") ppShow (lookup field chids) + ppAtt = case (show field) of + "lhs" -> attName "inh" + "loc" -> attName "loc" + otherwise -> attName "syn" + ppSubAtt = case (show field) of + "lhs" -> ppName [pp (getName attr), pp "InhG", ppNt] + "loc" -> ppName [pp (getName attr), ppNt, ppProd] + otherwise -> ppName [pp (getName attr), pp "SynG", ppChT] + in (pos, if ((elem (getName attr) noGroup) && ((show field) /= "loc")) + then pp "(" >|< pp (getName field) >|< " # " >|< attName (getName attr) >|< pp ")" + else pp "(" >|< ppSubAtt >|< " (" >|< pp (getName field) >|< " # " >|< ppAtt >|< ")) ") + HsToken value pos -> (pos, pp value) + CharToken value pos -> (pos, pp (show value)) + StrToken value pos -> (pos, pp (show value)) + Err mesg pos -> (pos, pp $ " ***" ++ mesg ++ "*** ") + +line2PP ts = let f (p,t) r = let ct = column p + in \c -> pp (spaces (ct-c)) >|< t >|< r (length (show t) +ct) + spaces x | x < 0 = "" + | otherwise = replicate x ' ' + in foldr f (pp . const "") ts 1 + +{-# LINE 345 "dist/build/AG2AspectAG.hs" #-} + +{-# LINE 721 "./src-ag/AG2AspectAG.ag" #-} + +ppMacro (Macro con children) = "( atts_" >|< show con >|< ", " >|< ppListSep "" "" " <.> " ppChildren >|<")" + where ppChildren = map ppChild children + ppChild (RuleChild ch n) = chName ch >|< " ==> " >|< ppMacro n + ppChild (ChildChild ch n) = chName ch >|< " --> " >|< n + ppChild (ValueChild ch n) = chName ch >|< " ~~> " >|< n + chName ch = ppName [pp "ch", pp ch, pp con] +{-# LINE 355 "dist/build/AG2AspectAG.hs" #-} + +{-# LINE 754 "./src-ag/AG2AspectAG.ag" #-} + +ppNoGroupAtts syn noGroup = let synatts = Map.keys $ Map.filterWithKey (\att _ -> elem (getName att) noGroup) syn + in map (flip (>|<) "_inh") noGroup ++ map (flip (>|<) "_syn") synatts + +ruleName att prodName = ppName [att,prodName] + +elemNT a b = False +{-# LINE 365 "dist/build/AG2AspectAG.hs" #-} + +{-# LINE 797 "./src-ag/AG2AspectAG.ag" #-} + +attTypes atts = map (\(a,t) -> "(HCons (LVPair (Proxy Att_" >|< a >|< ") " >|< ppShow t >|< ") ") $ Map.toAscList atts +{-# LINE 370 "dist/build/AG2AspectAG.hs" #-} + +{-# LINE 851 "./src-ag/AG2AspectAG.ag" #-} + +attVars atts = map (\(a,_) -> "_" >|< a >|< " ") $ Map.toAscList atts +attFields atts noGroup ppNt = + let ng = map (\(a,_) -> attName (getName a) >|< " .=. _" >|< a >|< " .*. ") $ Map.toAscList noGroup + g = ppCommas $ map (\(a,_) -> ppName [pp a, pp "InhG",ppNt] >|< "= _" >|< a) $ Map.toAscList $ Map.difference atts noGroup + in "(" >|< ng >|< "att_inh .=. " >|< ppName [pp "InhG", ppNt] >|< " { " >|< g >|< " } .*. emptyRecord)" +{-# LINE 379 "dist/build/AG2AspectAG.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + inherited attributes: + ext : Maybe String + inhMap : Map Identifier Attributes + inhNoGroup : [String] + newAtts : Attributes + o_noGroup : [String] + o_rename : Bool + ppNt : PP_Doc + ppProd : PP_Doc + synMap : Map Identifier Attributes + synNoGroup : [String] + synthesized attributes: + idCL : [(Identifier,Type)] + ppCSF : [(Identifier,(PP_Doc,PP_Doc))] + ppDL : [PP_Doc] + ppL : PP_Doc + ppLI : [PP_Doc] + ppR : PP_Doc + prdInh : Attributes + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child kind : {ChildKind} + visit 0: + local ppCh : _ + local ppTCh : _ + local chName : _ + local chLabel : _ + local chTLabel : _ + local chnt : _ + local inh : _ + local syn : _ +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child (Child _name _tp _kind) = + (sem_Child_Child _name _tp _kind) +-- semantic domain +newtype T_Child = T_Child ((Maybe String) -> + (Map Identifier Attributes) -> + ([String]) -> + ( Attributes ) -> + ([String]) -> + Bool -> + PP_Doc -> + PP_Doc -> + (Map Identifier Attributes) -> + ([String]) -> + ( ([(Identifier,Type)]),([(Identifier,(PP_Doc,PP_Doc))]),([PP_Doc]),PP_Doc,([PP_Doc]),PP_Doc,Attributes)) +data Inh_Child = Inh_Child {ext_Inh_Child :: (Maybe String),inhMap_Inh_Child :: (Map Identifier Attributes),inhNoGroup_Inh_Child :: ([String]),newAtts_Inh_Child :: ( Attributes ),o_noGroup_Inh_Child :: ([String]),o_rename_Inh_Child :: Bool,ppNt_Inh_Child :: PP_Doc,ppProd_Inh_Child :: PP_Doc,synMap_Inh_Child :: (Map Identifier Attributes),synNoGroup_Inh_Child :: ([String])} +data Syn_Child = Syn_Child {idCL_Syn_Child :: ([(Identifier,Type)]),ppCSF_Syn_Child :: ([(Identifier,(PP_Doc,PP_Doc))]),ppDL_Syn_Child :: ([PP_Doc]),ppL_Syn_Child :: PP_Doc,ppLI_Syn_Child :: ([PP_Doc]),ppR_Syn_Child :: PP_Doc,prdInh_Syn_Child :: Attributes} +wrap_Child :: T_Child -> + Inh_Child -> + Syn_Child +wrap_Child (T_Child sem) (Inh_Child _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) = + (let ( _lhsOidCL,_lhsOppCSF,_lhsOppDL,_lhsOppL,_lhsOppLI,_lhsOppR,_lhsOprdInh) = sem _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup + in (Syn_Child _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh)) +sem_Child_Child :: Identifier -> + Type -> + ChildKind -> + T_Child +sem_Child_Child name_ tp_ kind_ = + (T_Child (\ _lhsIext + _lhsIinhMap + _lhsIinhNoGroup + _lhsInewAtts + _lhsIo_noGroup + _lhsIo_rename + _lhsIppNt + _lhsIppProd + _lhsIsynMap + _lhsIsynNoGroup -> + (let _lhsOprdInh :: Attributes + _lhsOppDL :: ([PP_Doc]) + _lhsOppL :: PP_Doc + _lhsOppLI :: ([PP_Doc]) + _lhsOppR :: PP_Doc + _lhsOidCL :: ([(Identifier,Type)]) + _lhsOppCSF :: ([(Identifier,(PP_Doc,PP_Doc))]) + -- "./src-ag/AG2AspectAG.ag"(line 67, column 12) + _lhsOprdInh = + ({-# LINE 67 "./src-ag/AG2AspectAG.ag" #-} + _inh + {-# LINE 468 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 182, column 25) + _ppCh = + ({-# LINE 182 "./src-ag/AG2AspectAG.ag" #-} + pp name_ + {-# LINE 474 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 183, column 25) + _ppTCh = + ({-# LINE 183 "./src-ag/AG2AspectAG.ag" #-} + ppShow tp_ + {-# LINE 480 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 184, column 25) + _chName = + ({-# LINE 184 "./src-ag/AG2AspectAG.ag" #-} + ppName [_ppCh , _lhsIppNt, _lhsIppProd] + {-# LINE 486 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 242, column 25) + _lhsOppDL = + ({-# LINE 242 "./src-ag/AG2AspectAG.ag" #-} + case kind_ of + ChildSyntax -> [ _chName >|< pp " :: " >|< _ppTCh ] + _ -> [] + {-# LINE 494 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 285, column 25) + _chLabel = + ({-# LINE 285 "./src-ag/AG2AspectAG.ag" #-} + "ch_" >|< _chName + {-# LINE 500 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 286, column 25) + _chTLabel = + ({-# LINE 286 "./src-ag/AG2AspectAG.ag" #-} + "Ch_" >|< _chName + {-# LINE 506 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 287, column 25) + _lhsOppL = + ({-# LINE 287 "./src-ag/AG2AspectAG.ag" #-} + "data " >|< _chTLabel >|< "; " >|< _chLabel >|< pp " = proxy :: " >|< + case kind_ of + ChildSyntax -> "Proxy " >|< "(" >|< _chTLabel >|< ", " >|< _ppTCh >|< ")" + _ -> "SemType " >|< _ppTCh >|< pp " nt => Proxy " >|< + "(" >|< _chTLabel >|< ", nt)" + {-# LINE 516 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 293, column 25) + _lhsOppLI = + ({-# LINE 293 "./src-ag/AG2AspectAG.ag" #-} + [ _chLabel , _chTLabel ] + {-# LINE 522 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 451, column 25) + _lhsOppR = + ({-# LINE 451 "./src-ag/AG2AspectAG.ag" #-} + let chName = ppListSep "" "" "_" [pp name_, _lhsIppNt, _lhsIppProd] + in pp name_ >|< " <- at ch_" >|< chName + {-# LINE 529 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 489, column 25) + _lhsOidCL = + ({-# LINE 489 "./src-ag/AG2AspectAG.ag" #-} + [ (name_, removeDeforested tp_ ) ] + {-# LINE 535 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 826, column 25) + _lhsOppCSF = + ({-# LINE 826 "./src-ag/AG2AspectAG.ag" #-} + let + semC = if (isNonterminal tp_) + then "sem_" >|< ppShow tp_ >|< " _" >|< name_ + else "sem_Lit _" >|< name_ + in case kind_ of + ChildSyntax -> [(name_, ( _chLabel >|< " .=. (" >|< semC >|< ") .*. " + , _chLabel >|< " .=. _" >|< name_ >|< " .*. "))] + _ -> [] + {-# LINE 548 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 19, column 11) + _chnt = + ({-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + case tp_ of + NT nt _ _ -> nt + Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") + Haskell t -> identifier "" + {-# LINE 557 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 23, column 11) + _inh = + ({-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIinhMap + {-# LINE 563 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 24, column 11) + _syn = + ({-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIsynMap + {-# LINE 569 "dist/build/AG2AspectAG.hs" #-} + ) + in ( _lhsOidCL,_lhsOppCSF,_lhsOppDL,_lhsOppL,_lhsOppLI,_lhsOppR,_lhsOprdInh)))) +-- Children ---------------------------------------------------- +{- + visit 0: + inherited attributes: + ext : Maybe String + inhMap : Map Identifier Attributes + inhNoGroup : [String] + newAtts : Attributes + o_noGroup : [String] + o_rename : Bool + ppNt : PP_Doc + ppProd : PP_Doc + synMap : Map Identifier Attributes + synNoGroup : [String] + synthesized attributes: + idCL : [(Identifier,Type)] + ppCSF : [(Identifier,(PP_Doc,PP_Doc))] + ppDL : [PP_Doc] + ppL : PP_Doc + ppLI : [PP_Doc] + ppR : PP_Doc + prdInh : Attributes + alternatives: + alternative Cons: + child hd : Child + child tl : Children + alternative Nil: +-} +-- 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 ((Maybe String) -> + (Map Identifier Attributes) -> + ([String]) -> + ( Attributes ) -> + ([String]) -> + Bool -> + PP_Doc -> + PP_Doc -> + (Map Identifier Attributes) -> + ([String]) -> + ( ([(Identifier,Type)]),([(Identifier,(PP_Doc,PP_Doc))]),([PP_Doc]),PP_Doc,([PP_Doc]),PP_Doc,Attributes)) +data Inh_Children = Inh_Children {ext_Inh_Children :: (Maybe String),inhMap_Inh_Children :: (Map Identifier Attributes),inhNoGroup_Inh_Children :: ([String]),newAtts_Inh_Children :: ( Attributes ),o_noGroup_Inh_Children :: ([String]),o_rename_Inh_Children :: Bool,ppNt_Inh_Children :: PP_Doc,ppProd_Inh_Children :: PP_Doc,synMap_Inh_Children :: (Map Identifier Attributes),synNoGroup_Inh_Children :: ([String])} +data Syn_Children = Syn_Children {idCL_Syn_Children :: ([(Identifier,Type)]),ppCSF_Syn_Children :: ([(Identifier,(PP_Doc,PP_Doc))]),ppDL_Syn_Children :: ([PP_Doc]),ppL_Syn_Children :: PP_Doc,ppLI_Syn_Children :: ([PP_Doc]),ppR_Syn_Children :: PP_Doc,prdInh_Syn_Children :: Attributes} +wrap_Children :: T_Children -> + Inh_Children -> + Syn_Children +wrap_Children (T_Children sem) (Inh_Children _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) = + (let ( _lhsOidCL,_lhsOppCSF,_lhsOppDL,_lhsOppL,_lhsOppLI,_lhsOppR,_lhsOprdInh) = sem _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup + in (Syn_Children _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh)) +sem_Children_Cons :: T_Child -> + T_Children -> + T_Children +sem_Children_Cons (T_Child hd_) (T_Children tl_) = + (T_Children (\ _lhsIext + _lhsIinhMap + _lhsIinhNoGroup + _lhsInewAtts + _lhsIo_noGroup + _lhsIo_rename + _lhsIppNt + _lhsIppProd + _lhsIsynMap + _lhsIsynNoGroup -> + (let _lhsOppDL :: ([PP_Doc]) + _lhsOidCL :: ([(Identifier,Type)]) + _lhsOppCSF :: ([(Identifier,(PP_Doc,PP_Doc))]) + _lhsOppL :: PP_Doc + _lhsOppLI :: ([PP_Doc]) + _lhsOppR :: PP_Doc + _lhsOprdInh :: Attributes + _hdOext :: (Maybe String) + _hdOinhMap :: (Map Identifier Attributes) + _hdOinhNoGroup :: ([String]) + _hdOnewAtts :: ( Attributes ) + _hdOo_noGroup :: ([String]) + _hdOo_rename :: Bool + _hdOppNt :: PP_Doc + _hdOppProd :: PP_Doc + _hdOsynMap :: (Map Identifier Attributes) + _hdOsynNoGroup :: ([String]) + _tlOext :: (Maybe String) + _tlOinhMap :: (Map Identifier Attributes) + _tlOinhNoGroup :: ([String]) + _tlOnewAtts :: ( Attributes ) + _tlOo_noGroup :: ([String]) + _tlOo_rename :: Bool + _tlOppNt :: PP_Doc + _tlOppProd :: PP_Doc + _tlOsynMap :: (Map Identifier Attributes) + _tlOsynNoGroup :: ([String]) + _hdIidCL :: ([(Identifier,Type)]) + _hdIppCSF :: ([(Identifier,(PP_Doc,PP_Doc))]) + _hdIppDL :: ([PP_Doc]) + _hdIppL :: PP_Doc + _hdIppLI :: ([PP_Doc]) + _hdIppR :: PP_Doc + _hdIprdInh :: Attributes + _tlIidCL :: ([(Identifier,Type)]) + _tlIppCSF :: ([(Identifier,(PP_Doc,PP_Doc))]) + _tlIppDL :: ([PP_Doc]) + _tlIppL :: PP_Doc + _tlIppLI :: ([PP_Doc]) + _tlIppR :: PP_Doc + _tlIprdInh :: Attributes + -- "./src-ag/AG2AspectAG.ag"(line 238, column 33) + _lhsOppDL = + ({-# LINE 238 "./src-ag/AG2AspectAG.ag" #-} + _hdIppDL ++ _tlIppDL + {-# LINE 684 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 487, column 31) + _lhsOidCL = + ({-# LINE 487 "./src-ag/AG2AspectAG.ag" #-} + _hdIidCL ++ _tlIidCL + {-# LINE 690 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 822, column 34) + _lhsOppCSF = + ({-# LINE 822 "./src-ag/AG2AspectAG.ag" #-} + _hdIppCSF ++ _tlIppCSF + {-# LINE 696 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 259, column 79) + _lhsOppL = + ({-# LINE 259 "./src-ag/AG2AspectAG.ag" #-} + _hdIppL >-< _tlIppL + {-# LINE 702 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 259, column 112) + _lhsOppLI = + ({-# LINE 259 "./src-ag/AG2AspectAG.ag" #-} + _hdIppLI ++ _tlIppLI + {-# LINE 708 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 418, column 79) + _lhsOppR = + ({-# LINE 418 "./src-ag/AG2AspectAG.ag" #-} + _hdIppR >-< _tlIppR + {-# LINE 714 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 65, column 57) + _lhsOprdInh = + ({-# LINE 65 "./src-ag/AG2AspectAG.ag" #-} + _hdIprdInh `Map.union` _tlIprdInh + {-# LINE 720 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOext = + ({-# LINE 119 "./src-ag/AG2AspectAG.ag" #-} + _lhsIext + {-# LINE 726 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 732 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOinhNoGroup = + ({-# LINE 55 "./src-ag/AG2AspectAG.ag" #-} + _lhsIinhNoGroup + {-# LINE 738 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOnewAtts = + ({-# LINE 78 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewAtts + {-# LINE 744 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOo_noGroup = + ({-# LINE 45 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_noGroup + {-# LINE 750 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 41 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 756 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOppNt = + ({-# LINE 187 "./src-ag/AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 762 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOppProd = + ({-# LINE 192 "./src-ag/AG2AspectAG.ag" #-} + _lhsIppProd + {-# LINE 768 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 774 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOsynNoGroup = + ({-# LINE 55 "./src-ag/AG2AspectAG.ag" #-} + _lhsIsynNoGroup + {-# LINE 780 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOext = + ({-# LINE 119 "./src-ag/AG2AspectAG.ag" #-} + _lhsIext + {-# LINE 786 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 792 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOinhNoGroup = + ({-# LINE 55 "./src-ag/AG2AspectAG.ag" #-} + _lhsIinhNoGroup + {-# LINE 798 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOnewAtts = + ({-# LINE 78 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewAtts + {-# LINE 804 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOo_noGroup = + ({-# LINE 45 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_noGroup + {-# LINE 810 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 41 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 816 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOppNt = + ({-# LINE 187 "./src-ag/AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 822 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOppProd = + ({-# LINE 192 "./src-ag/AG2AspectAG.ag" #-} + _lhsIppProd + {-# LINE 828 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 834 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOsynNoGroup = + ({-# LINE 55 "./src-ag/AG2AspectAG.ag" #-} + _lhsIsynNoGroup + {-# LINE 840 "dist/build/AG2AspectAG.hs" #-} + ) + ( _hdIidCL,_hdIppCSF,_hdIppDL,_hdIppL,_hdIppLI,_hdIppR,_hdIprdInh) = + hd_ _hdOext _hdOinhMap _hdOinhNoGroup _hdOnewAtts _hdOo_noGroup _hdOo_rename _hdOppNt _hdOppProd _hdOsynMap _hdOsynNoGroup + ( _tlIidCL,_tlIppCSF,_tlIppDL,_tlIppL,_tlIppLI,_tlIppR,_tlIprdInh) = + tl_ _tlOext _tlOinhMap _tlOinhNoGroup _tlOnewAtts _tlOo_noGroup _tlOo_rename _tlOppNt _tlOppProd _tlOsynMap _tlOsynNoGroup + in ( _lhsOidCL,_lhsOppCSF,_lhsOppDL,_lhsOppL,_lhsOppLI,_lhsOppR,_lhsOprdInh)))) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (\ _lhsIext + _lhsIinhMap + _lhsIinhNoGroup + _lhsInewAtts + _lhsIo_noGroup + _lhsIo_rename + _lhsIppNt + _lhsIppProd + _lhsIsynMap + _lhsIsynNoGroup -> + (let _lhsOppDL :: ([PP_Doc]) + _lhsOidCL :: ([(Identifier,Type)]) + _lhsOppCSF :: ([(Identifier,(PP_Doc,PP_Doc))]) + _lhsOppL :: PP_Doc + _lhsOppLI :: ([PP_Doc]) + _lhsOppR :: PP_Doc + _lhsOprdInh :: Attributes + -- "./src-ag/AG2AspectAG.ag"(line 239, column 33) + _lhsOppDL = + ({-# LINE 239 "./src-ag/AG2AspectAG.ag" #-} + [] + {-# LINE 870 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 487, column 31) + _lhsOidCL = + ({-# LINE 487 "./src-ag/AG2AspectAG.ag" #-} + [] + {-# LINE 876 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 822, column 34) + _lhsOppCSF = + ({-# LINE 822 "./src-ag/AG2AspectAG.ag" #-} + [] + {-# LINE 882 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 259, column 79) + _lhsOppL = + ({-# LINE 259 "./src-ag/AG2AspectAG.ag" #-} + empty + {-# LINE 888 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 259, column 112) + _lhsOppLI = + ({-# LINE 259 "./src-ag/AG2AspectAG.ag" #-} + [] + {-# LINE 894 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 418, column 79) + _lhsOppR = + ({-# LINE 418 "./src-ag/AG2AspectAG.ag" #-} + empty + {-# LINE 900 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 65, column 57) + _lhsOprdInh = + ({-# LINE 65 "./src-ag/AG2AspectAG.ag" #-} + Map.empty + {-# LINE 906 "dist/build/AG2AspectAG.hs" #-} + ) + in ( _lhsOidCL,_lhsOppCSF,_lhsOppDL,_lhsOppL,_lhsOppLI,_lhsOppR,_lhsOprdInh)))) +-- Expression -------------------------------------------------- +{- + visit 0: + inherited attributes: + ppNt : PP_Doc + ppProd : PP_Doc + synthesized attribute: + ppRE : [String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression _pos _tks) = + (sem_Expression_Expression _pos _tks) +-- semantic domain +newtype T_Expression = T_Expression (PP_Doc -> + PP_Doc -> + ( ([String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc))) +data Inh_Expression = Inh_Expression {ppNt_Inh_Expression :: PP_Doc,ppProd_Inh_Expression :: PP_Doc} +data Syn_Expression = Syn_Expression {ppRE_Syn_Expression :: ([String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc)} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem) (Inh_Expression _lhsIppNt _lhsIppProd) = + (let ( _lhsOppRE) = sem _lhsIppNt _lhsIppProd + in (Syn_Expression _lhsOppRE)) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (\ _lhsIppNt + _lhsIppProd -> + (let _lhsOppRE :: ([String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc) + -- "./src-ag/AG2AspectAG.ag"(line 484, column 25) + _lhsOppRE = + ({-# LINE 484 "./src-ag/AG2AspectAG.ag" #-} + rhsRule _lhsIppNt _lhsIppProd tks_ + {-# LINE 950 "dist/build/AG2AspectAG.hs" #-} + ) + in ( _lhsOppRE)))) +-- Grammar ----------------------------------------------------- +{- + visit 0: + inherited attributes: + agi : (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes)) + ext : Maybe String + options : Options + synthesized attributes: + imp : PP_Doc + pp : PP_Doc + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} + visit 0: + local o_noGroup : _ + local newAtts : _ + local newProds : _ + local ppA : _ + local ppAI : _ + local ppANT : _ + local ppNtL : _ + local ppR : _ +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) +-- semantic domain +newtype T_Grammar = T_Grammar (((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) -> + (Maybe String) -> + Options -> + ( PP_Doc,PP_Doc)) +data Inh_Grammar = Inh_Grammar {agi_Inh_Grammar :: ((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))),ext_Inh_Grammar :: (Maybe String),options_Inh_Grammar :: Options} +data Syn_Grammar = Syn_Grammar {imp_Syn_Grammar :: PP_Doc,pp_Syn_Grammar :: PP_Doc} +wrap_Grammar :: T_Grammar -> + Inh_Grammar -> + Syn_Grammar +wrap_Grammar (T_Grammar sem) (Inh_Grammar _lhsIagi _lhsIext _lhsIoptions) = + (let ( _lhsOimp,_lhsOpp) = sem _lhsIagi _lhsIext _lhsIoptions + in (Syn_Grammar _lhsOimp _lhsOpp)) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ = + (T_Grammar (\ _lhsIagi + _lhsIext + _lhsIoptions -> + (let _nontsOo_rename :: Bool + _nontsOo_noGroup :: ([String]) + _nontsOnewAtts :: ( Attributes ) + _nontsOnewProds :: ( DataTypes ) + _nontsOnewNTs :: (Set NontermIdent) + _lhsOimp :: PP_Doc + _lhsOpp :: PP_Doc + _nontsOderivs :: Derivings + _nontsOtSyns :: TypeSyns + _nontsOinhMap :: (Map Identifier Attributes) + _nontsOsynMap :: (Map Identifier Attributes) + _nontsOext :: (Maybe String) + _nontsIextendedNTs :: (Set NontermIdent) + _nontsIinhMap' :: (Map Identifier Attributes) + _nontsIppA :: PP_Doc + _nontsIppAI :: ([PP_Doc]) + _nontsIppCata :: PP_Doc + _nontsIppD :: PP_Doc + _nontsIppDI :: ([PP_Doc]) + _nontsIppL :: PP_Doc + _nontsIppLI :: ([PP_Doc]) + _nontsIppNtL :: ([(PP_Doc, Attributes)]) + _nontsIppR :: PP_Doc + _nontsIppSF :: PP_Doc + _nontsIppW :: PP_Doc + _nontsIsynMap' :: (Map Identifier Attributes) + -- "./src-ag/AG2AspectAG.ag"(line 43, column 14) + _nontsOo_rename = + ({-# LINE 43 "./src-ag/AG2AspectAG.ag" #-} + rename _lhsIoptions + {-# LINE 1056 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 47, column 14) + _o_noGroup = + ({-# LINE 47 "./src-ag/AG2AspectAG.ag" #-} + sort $ noGroup _lhsIoptions + {-# LINE 1062 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 48, column 14) + _nontsOo_noGroup = + ({-# LINE 48 "./src-ag/AG2AspectAG.ag" #-} + _o_noGroup + {-# LINE 1068 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 80, column 23) + _newAtts = + ({-# LINE 80 "./src-ag/AG2AspectAG.ag" #-} + case _lhsIagi of + (_,_,atts) -> ( Map.unions . (\(a,b) -> a++b) . unzip . Map.elems) atts + {-# LINE 1075 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 82, column 23) + _nontsOnewAtts = + ({-# LINE 82 "./src-ag/AG2AspectAG.ag" #-} + _newAtts + {-# LINE 1081 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 88, column 23) + _newProds = + ({-# LINE 88 "./src-ag/AG2AspectAG.ag" #-} + case _lhsIagi of + (_,prods,_) -> prods + {-# LINE 1088 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 90, column 23) + _nontsOnewProds = + ({-# LINE 90 "./src-ag/AG2AspectAG.ag" #-} + _newProds + {-# LINE 1094 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 112, column 23) + _nontsOnewNTs = + ({-# LINE 112 "./src-ag/AG2AspectAG.ag" #-} + case _lhsIagi of + (newNTs,_,_) -> Set.difference newNTs _nontsIextendedNTs + {-# LINE 1101 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 127, column 25) + _lhsOimp = + ({-# LINE 127 "./src-ag/AG2AspectAG.ag" #-} + "import Language.Grammars.AspectAG" >-< + "import Language.Grammars.AspectAG.Derive" >-< + "import Data.HList.Label4" >-< + "import Data.HList.TypeEqGeneric1" >-< + "import Data.HList.TypeCastGeneric1" >-< + maybe empty ("import qualified" >#<) _lhsIext >-< + maybe empty (\ext -> "import" >#< ext >#< ppListSep "(" ")" "," (_nontsIppDI ++ _nontsIppLI ++ _ppAI ++ _ppANT )) _lhsIext + {-# LINE 1113 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 140, column 25) + _lhsOpp = + ({-# LINE 140 "./src-ag/AG2AspectAG.ag" #-} + (if dataTypes _lhsIoptions + then "-- datatypes" >-< _nontsIppD >-< + "-- labels" >-< _nontsIppL + else empty) + >-< + (if folds _lhsIoptions + then "-- attributes" >-< _ppA >-< + "-- rules" >-< _ppR >-< + "-- catas" >-< _nontsIppCata + else empty) + >-< + (if semfuns _lhsIoptions + then "-- semantic functions" >-< _nontsIppSF + else empty) + >-< + (if wrappers _lhsIoptions + then "-- wrappers" >-< _nontsIppW + else empty) + {-# LINE 1136 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 202, column 25) + _nontsOderivs = + ({-# LINE 202 "./src-ag/AG2AspectAG.ag" #-} + derivings_ + {-# LINE 1142 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 251, column 34) + _nontsOtSyns = + ({-# LINE 251 "./src-ag/AG2AspectAG.ag" #-} + typeSyns_ + {-# LINE 1148 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 300, column 25) + _ppA = + ({-# LINE 300 "./src-ag/AG2AspectAG.ag" #-} + vlist (map defAtt (filterAtts _newAtts _o_noGroup )) >-< + defAtt "loc" >-< + (case _lhsIext of + Nothing -> defAtt "inh" >-< defAtt "syn" + otherwise -> empty) >-< + _nontsIppA + {-# LINE 1159 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 307, column 25) + _ppAI = + ({-# LINE 307 "./src-ag/AG2AspectAG.ag" #-} + let atts = filterNotAtts _newAtts _o_noGroup + in (foldr (\a as -> attName a : as) [] atts) ++ + (foldr (\a as -> attTName a : as) [] atts) ++ + (case _lhsIext of + Nothing -> [] + otherwise -> [ attName "inh", attName "syn", attTName "inh", attTName "syn" ]) ++ + _nontsIppAI + {-# LINE 1171 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 317, column 25) + _ppANT = + ({-# LINE 317 "./src-ag/AG2AspectAG.ag" #-} + let atts = filterNotAtts _newAtts _o_noGroup + in (foldr (\a as -> ("nts_" >|< a) : as) [] atts) + {-# LINE 1178 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 392, column 25) + _ppNtL = + ({-# LINE 392 "./src-ag/AG2AspectAG.ag" #-} + _nontsIppNtL + {-# LINE 1184 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 393, column 25) + _ppR = + ({-# LINE 393 "./src-ag/AG2AspectAG.ag" #-} + ntsList "group" _ppNtL >-< + vlist (map (\att -> ntsList att (filterNts att _ppNtL )) (filterAtts _newAtts _o_noGroup )) >-< + _nontsIppR + {-# LINE 1192 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 15, column 13) + _nontsOinhMap = + ({-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + _nontsIinhMap' + {-# LINE 1198 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 16, column 13) + _nontsOsynMap = + ({-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + _nontsIsynMap' + {-# LINE 1204 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _nontsOext = + ({-# LINE 119 "./src-ag/AG2AspectAG.ag" #-} + _lhsIext + {-# LINE 1210 "dist/build/AG2AspectAG.hs" #-} + ) + ( _nontsIextendedNTs,_nontsIinhMap',_nontsIppA,_nontsIppAI,_nontsIppCata,_nontsIppD,_nontsIppDI,_nontsIppL,_nontsIppLI,_nontsIppNtL,_nontsIppR,_nontsIppSF,_nontsIppW,_nontsIsynMap') = + nonts_ _nontsOderivs _nontsOext _nontsOinhMap _nontsOnewAtts _nontsOnewNTs _nontsOnewProds _nontsOo_noGroup _nontsOo_rename _nontsOsynMap _nontsOtSyns + in ( _lhsOimp,_lhsOpp)))) +-- HsToken ----------------------------------------------------- +{- + alternatives: + alternative AGLocal: + child var : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + alternative AGField: + child field : {Identifier} + child attr : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + alternative HsToken: + child value : {String} + child pos : {Pos} + alternative CharToken: + child value : {String} + child pos : {Pos} + alternative StrToken: + child value : {String} + child pos : {Pos} + alternative Err: + child mesg : {String} + child pos : {Pos} +-} +-- cata +sem_HsToken :: HsToken -> + T_HsToken +sem_HsToken (AGLocal _var _pos _rdesc) = + (sem_HsToken_AGLocal _var _pos _rdesc) +sem_HsToken (AGField _field _attr _pos _rdesc) = + (sem_HsToken_AGField _field _attr _pos _rdesc) +sem_HsToken (HsToken _value _pos) = + (sem_HsToken_HsToken _value _pos) +sem_HsToken (CharToken _value _pos) = + (sem_HsToken_CharToken _value _pos) +sem_HsToken (StrToken _value _pos) = + (sem_HsToken_StrToken _value _pos) +sem_HsToken (Err _mesg _pos) = + (sem_HsToken_Err _mesg _pos) +-- semantic domain +newtype T_HsToken = T_HsToken (( )) +data Inh_HsToken = Inh_HsToken {} +data Syn_HsToken = Syn_HsToken {} +wrap_HsToken :: T_HsToken -> + Inh_HsToken -> + Syn_HsToken +wrap_HsToken (T_HsToken sem) (Inh_HsToken) = + (let ( ) = sem + in (Syn_HsToken)) +sem_HsToken_AGLocal :: Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGLocal var_ pos_ rdesc_ = + (T_HsToken (let + in ( ))) +sem_HsToken_AGField :: Identifier -> + Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGField field_ attr_ pos_ rdesc_ = + (T_HsToken (let + in ( ))) +sem_HsToken_HsToken :: String -> + Pos -> + T_HsToken +sem_HsToken_HsToken value_ pos_ = + (T_HsToken (let + in ( ))) +sem_HsToken_CharToken :: String -> + Pos -> + T_HsToken +sem_HsToken_CharToken value_ pos_ = + (T_HsToken (let + in ( ))) +sem_HsToken_StrToken :: String -> + Pos -> + T_HsToken +sem_HsToken_StrToken value_ pos_ = + (T_HsToken (let + in ( ))) +sem_HsToken_Err :: String -> + Pos -> + T_HsToken +sem_HsToken_Err mesg_ pos_ = + (T_HsToken (let + in ( ))) +-- HsTokens ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : HsToken + child tl : HsTokens + alternative Nil: +-} +-- cata +sem_HsTokens :: HsTokens -> + T_HsTokens +sem_HsTokens list = + (Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list)) +-- semantic domain +newtype T_HsTokens = T_HsTokens (( )) +data Inh_HsTokens = Inh_HsTokens {} +data Syn_HsTokens = Syn_HsTokens {} +wrap_HsTokens :: T_HsTokens -> + Inh_HsTokens -> + Syn_HsTokens +wrap_HsTokens (T_HsTokens sem) (Inh_HsTokens) = + (let ( ) = sem + in (Syn_HsTokens)) +sem_HsTokens_Cons :: T_HsToken -> + T_HsTokens -> + T_HsTokens +sem_HsTokens_Cons (T_HsToken hd_) (T_HsTokens tl_) = + (T_HsTokens (let + in ( ))) +sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil = + (T_HsTokens (let + in ( ))) +-- HsTokensRoot ------------------------------------------------ +{- + 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 (( )) +data Inh_HsTokensRoot = Inh_HsTokensRoot {} +data Syn_HsTokensRoot = Syn_HsTokensRoot {} +wrap_HsTokensRoot :: T_HsTokensRoot -> + Inh_HsTokensRoot -> + Syn_HsTokensRoot +wrap_HsTokensRoot (T_HsTokensRoot sem) (Inh_HsTokensRoot) = + (let ( ) = sem + in (Syn_HsTokensRoot)) +sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> + T_HsTokensRoot +sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_) = + (T_HsTokensRoot (let + in ( ))) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + inherited attributes: + derivs : Derivings + ext : Maybe String + inhMap : Map Identifier Attributes + newAtts : Attributes + newNTs : Set NontermIdent + newProds : DataTypes + o_noGroup : [String] + o_rename : Bool + synMap : Map Identifier Attributes + tSyns : TypeSyns + synthesized attributes: + extendedNTs : Set NontermIdent + inhMap' : Map Identifier Attributes + ppA : PP_Doc + ppAI : [PP_Doc] + ppCata : PP_Doc + ppD : PP_Doc + ppDI : [PP_Doc] + ppL : PP_Doc + ppLI : [PP_Doc] + ppNtL : [(PP_Doc, Attributes)] + ppR : PP_Doc + ppSF : PP_Doc + ppW : PP_Doc + synMap' : Map Identifier Attributes + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions + visit 0: + local inhNoGroup : _ + local synNoGroup : _ + local ppNt : _ + local ntLabel : _ +-} +-- 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 (Derivings -> + (Maybe String) -> + (Map Identifier Attributes) -> + ( Attributes ) -> + (Set NontermIdent) -> + ( DataTypes ) -> + ([String]) -> + Bool -> + (Map Identifier Attributes) -> + TypeSyns -> + ( (Set NontermIdent),(Map Identifier Attributes),PP_Doc,([PP_Doc]),PP_Doc,PP_Doc,([PP_Doc]),PP_Doc,([PP_Doc]),([(PP_Doc, Attributes)]),PP_Doc,PP_Doc,PP_Doc,(Map Identifier Attributes))) +data Inh_Nonterminal = Inh_Nonterminal {derivs_Inh_Nonterminal :: Derivings,ext_Inh_Nonterminal :: (Maybe String),inhMap_Inh_Nonterminal :: (Map Identifier Attributes),newAtts_Inh_Nonterminal :: ( Attributes ),newNTs_Inh_Nonterminal :: (Set NontermIdent),newProds_Inh_Nonterminal :: ( DataTypes ),o_noGroup_Inh_Nonterminal :: ([String]),o_rename_Inh_Nonterminal :: Bool,synMap_Inh_Nonterminal :: (Map Identifier Attributes),tSyns_Inh_Nonterminal :: TypeSyns} +data Syn_Nonterminal = Syn_Nonterminal {extendedNTs_Syn_Nonterminal :: (Set NontermIdent),inhMap'_Syn_Nonterminal :: (Map Identifier Attributes),ppA_Syn_Nonterminal :: PP_Doc,ppAI_Syn_Nonterminal :: ([PP_Doc]),ppCata_Syn_Nonterminal :: PP_Doc,ppD_Syn_Nonterminal :: PP_Doc,ppDI_Syn_Nonterminal :: ([PP_Doc]),ppL_Syn_Nonterminal :: PP_Doc,ppLI_Syn_Nonterminal :: ([PP_Doc]),ppNtL_Syn_Nonterminal :: ([(PP_Doc, Attributes)]),ppR_Syn_Nonterminal :: PP_Doc,ppSF_Syn_Nonterminal :: PP_Doc,ppW_Syn_Nonterminal :: PP_Doc,synMap'_Syn_Nonterminal :: (Map Identifier Attributes)} +wrap_Nonterminal :: T_Nonterminal -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) = + (let ( _lhsOextendedNTs,_lhsOinhMap',_lhsOppA,_lhsOppAI,_lhsOppCata,_lhsOppD,_lhsOppDI,_lhsOppL,_lhsOppLI,_lhsOppNtL,_lhsOppR,_lhsOppSF,_lhsOppW,_lhsOsynMap') = sem _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns + in (Syn_Nonterminal _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap')) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) = + (T_Nonterminal (\ _lhsIderivs + _lhsIext + _lhsIinhMap + _lhsInewAtts + _lhsInewNTs + _lhsInewProds + _lhsIo_noGroup + _lhsIo_rename + _lhsIsynMap + _lhsItSyns -> + (let _prodsOinhNoGroup :: ([String]) + _prodsOsynNoGroup :: ([String]) + _prodsOnewProds :: ( Map.Map ConstructorIdent FieldMap ) + _lhsOextendedNTs :: (Set NontermIdent) + _prodsOppNt :: PP_Doc + _lhsOppD :: PP_Doc + _lhsOppDI :: ([PP_Doc]) + _lhsOppL :: PP_Doc + _lhsOppLI :: ([PP_Doc]) + _lhsOppA :: PP_Doc + _lhsOppAI :: ([PP_Doc]) + _lhsOppNtL :: ([(PP_Doc, Attributes)]) + _prodsOnewNT :: Bool + _lhsOppR :: PP_Doc + _lhsOppCata :: PP_Doc + _prodsOsyn :: ( Attributes ) + _prodsOinh :: ( Attributes ) + _lhsOppSF :: PP_Doc + _lhsOppW :: PP_Doc + _lhsOinhMap' :: (Map Identifier Attributes) + _lhsOsynMap' :: (Map Identifier Attributes) + _prodsOext :: (Maybe String) + _prodsOinhMap :: (Map Identifier Attributes) + _prodsOnewAtts :: ( Attributes ) + _prodsOo_noGroup :: ([String]) + _prodsOo_rename :: Bool + _prodsOsynMap :: (Map Identifier Attributes) + _prodsIhasMoreProds :: ( Bool ) + _prodsIppA :: PP_Doc + _prodsIppCata :: PP_Doc + _prodsIppDL :: ([PP_Doc]) + _prodsIppL :: PP_Doc + _prodsIppLI :: ([PP_Doc]) + _prodsIppR :: PP_Doc + _prodsIppRA :: ([PP_Doc]) + _prodsIppSF :: PP_Doc + _prodsIppSPF :: PP_Doc + _prodsIprdInh :: Attributes + -- "./src-ag/AG2AspectAG.ag"(line 51, column 18) + _inhNoGroup = + ({-# LINE 51 "./src-ag/AG2AspectAG.ag" #-} + Map.filterWithKey (\att _ -> elem (getName att) _lhsIo_noGroup) _prodsIprdInh + {-# LINE 1489 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 52, column 18) + _synNoGroup = + ({-# LINE 52 "./src-ag/AG2AspectAG.ag" #-} + Map.filterWithKey (\att _ -> elem (getName att) _lhsIo_noGroup) syn_ + {-# LINE 1495 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 57, column 18) + _prodsOinhNoGroup = + ({-# LINE 57 "./src-ag/AG2AspectAG.ag" #-} + map show $ Map.keys _inhNoGroup + {-# LINE 1501 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 58, column 18) + _prodsOsynNoGroup = + ({-# LINE 58 "./src-ag/AG2AspectAG.ag" #-} + map show $ Map.keys _synNoGroup + {-# LINE 1507 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 94, column 17) + _prodsOnewProds = + ({-# LINE 94 "./src-ag/AG2AspectAG.ag" #-} + case Map.lookup nt_ _lhsInewProds of + Just prds -> prds + Nothing -> Map.empty + {-# LINE 1515 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 107, column 31) + _lhsOextendedNTs = + ({-# LINE 107 "./src-ag/AG2AspectAG.ag" #-} + if _prodsIhasMoreProds + then Set.singleton nt_ + else Set.empty + {-# LINE 1523 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 173, column 25) + _ppNt = + ({-# LINE 173 "./src-ag/AG2AspectAG.ag" #-} + pp nt_ + {-# LINE 1529 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 190, column 25) + _prodsOppNt = + ({-# LINE 190 "./src-ag/AG2AspectAG.ag" #-} + _ppNt + {-# LINE 1535 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 208, column 25) + _lhsOppD = + ({-# LINE 208 "./src-ag/AG2AspectAG.ag" #-} + if (Set.member nt_ _lhsInewNTs) + then case (lookup nt_ _lhsItSyns) of + Nothing -> "data " >|< _ppNt + >|< " = " >|< vlist_sep " | " _prodsIppDL >-< + case (Map.lookup nt_ _lhsIderivs) of + Just ntds -> pp " deriving " >|< (ppListSep "(" ")" ", " $ Set.elems ntds) + Nothing -> empty + Just tp -> "type " >|< _ppNt >|< " = " >|< ppShow tp + else empty + {-# LINE 1549 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 221, column 25) + _lhsOppDI = + ({-# LINE 221 "./src-ag/AG2AspectAG.ag" #-} + if (not $ Set.member nt_ _lhsInewNTs) + then [ _ppNt ] + else [ ] + {-# LINE 1557 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 262, column 25) + _ntLabel = + ({-# LINE 262 "./src-ag/AG2AspectAG.ag" #-} + "nt_" >|< _ppNt + {-# LINE 1563 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 264, column 25) + _lhsOppL = + ({-# LINE 264 "./src-ag/AG2AspectAG.ag" #-} + ( if (Set.member nt_ _lhsInewNTs) + then _ntLabel >|< " = proxy :: Proxy " >|< _ppNt + else empty) >-< + _prodsIppL + {-# LINE 1572 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 269, column 25) + _lhsOppLI = + ({-# LINE 269 "./src-ag/AG2AspectAG.ag" #-} + ( if (not $ Set.member nt_ _lhsInewNTs) + then [ _ntLabel ] + else [ ]) ++ + _prodsIppLI + {-# LINE 1581 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 324, column 25) + _lhsOppA = + ({-# LINE 324 "./src-ag/AG2AspectAG.ag" #-} + ( if (Set.member nt_ _lhsInewNTs) + then + defAttRec (pp "InhG") _ppNt inh_ _inhNoGroup >-< + defAttRec (pp "SynG") _ppNt syn_ _synNoGroup + else empty) >-< + _prodsIppA + {-# LINE 1592 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 338, column 25) + _lhsOppAI = + ({-# LINE 338 "./src-ag/AG2AspectAG.ag" #-} + if (not $ Set.member nt_ _lhsInewNTs) + then [ ppName [(pp "InhG"), _ppNt ] >#< pp "(..)", ppName [(pp "SynG"), _ppNt ] >#< pp "(..)" ] + else [ ] + {-# LINE 1600 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 406, column 25) + _lhsOppNtL = + ({-# LINE 406 "./src-ag/AG2AspectAG.ag" #-} + [ ("nt_" >|< nt_, Map.union inh_ syn_) ] + {-# LINE 1606 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 415, column 25) + _prodsOnewNT = + ({-# LINE 415 "./src-ag/AG2AspectAG.ag" #-} + Set.member nt_ _lhsInewNTs + {-# LINE 1612 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 425, column 25) + _lhsOppR = + ({-# LINE 425 "./src-ag/AG2AspectAG.ag" #-} + pp "----" >|< pp nt_ >-< _prodsIppR + {-# LINE 1618 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 735, column 25) + _lhsOppCata = + ({-# LINE 735 "./src-ag/AG2AspectAG.ag" #-} + "----" >|< _ppNt >-< _prodsIppCata + {-# LINE 1624 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 766, column 25) + _prodsOsyn = + ({-# LINE 766 "./src-ag/AG2AspectAG.ag" #-} + syn_ + {-# LINE 1630 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 767, column 25) + _prodsOinh = + ({-# LINE 767 "./src-ag/AG2AspectAG.ag" #-} + inh_ + {-# LINE 1636 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 778, column 25) + _lhsOppSF = + ({-# LINE 778 "./src-ag/AG2AspectAG.ag" #-} + let inhAtts = attTypes _inhNoGroup + synAtts = attTypes _synNoGroup + in + "----" >|< _ppNt >-< + "type T_" >|< _ppNt >|< " = " >|< + "(Record " >|< + inhAtts >|< + "(HCons (LVPair (Proxy Att_inh) InhG_" >|< _ppNt >|< ") HNil))" >|< + replicate (length inhAtts) ")" >|< " -> " >|< + "(Record " >|< + synAtts >|< + "(HCons (LVPair (Proxy Att_syn) SynG_" >|< _ppNt >|< ") HNil))" >|< + replicate (length synAtts) ")" >-< + "-- instance SemType T_" >|< _ppNt >|< " " >|< _ppNt >-< + "-- sem_" >|< _ppNt >|< " :: " >|< _ppNt >|< " -> T_" >|< _ppNt >-< + _prodsIppSPF + {-# LINE 1657 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 846, column 25) + _lhsOppW = + ({-# LINE 846 "./src-ag/AG2AspectAG.ag" #-} + ppName [pp "wrap", _ppNt ] >|< " sem " >|< attVars inh_ >|< " = " >-< + " sem " >|< attFields inh_ _inhNoGroup _ppNt + {-# LINE 1664 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 7, column 18) + _lhsOinhMap' = + ({-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 1670 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 8, column 18) + _lhsOsynMap' = + ({-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 1676 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _prodsOext = + ({-# LINE 119 "./src-ag/AG2AspectAG.ag" #-} + _lhsIext + {-# LINE 1682 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _prodsOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1688 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _prodsOnewAtts = + ({-# LINE 78 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewAtts + {-# LINE 1694 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _prodsOo_noGroup = + ({-# LINE 45 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_noGroup + {-# LINE 1700 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _prodsOo_rename = + ({-# LINE 41 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 1706 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _prodsOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1712 "dist/build/AG2AspectAG.hs" #-} + ) + ( _prodsIhasMoreProds,_prodsIppA,_prodsIppCata,_prodsIppDL,_prodsIppL,_prodsIppLI,_prodsIppR,_prodsIppRA,_prodsIppSF,_prodsIppSPF,_prodsIprdInh) = + prods_ _prodsOext _prodsOinh _prodsOinhMap _prodsOinhNoGroup _prodsOnewAtts _prodsOnewNT _prodsOnewProds _prodsOo_noGroup _prodsOo_rename _prodsOppNt _prodsOsyn _prodsOsynMap _prodsOsynNoGroup + in ( _lhsOextendedNTs,_lhsOinhMap',_lhsOppA,_lhsOppAI,_lhsOppCata,_lhsOppD,_lhsOppDI,_lhsOppL,_lhsOppLI,_lhsOppNtL,_lhsOppR,_lhsOppSF,_lhsOppW,_lhsOsynMap')))) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + inherited attributes: + derivs : Derivings + ext : Maybe String + inhMap : Map Identifier Attributes + newAtts : Attributes + newNTs : Set NontermIdent + newProds : DataTypes + o_noGroup : [String] + o_rename : Bool + synMap : Map Identifier Attributes + tSyns : TypeSyns + synthesized attributes: + extendedNTs : Set NontermIdent + inhMap' : Map Identifier Attributes + ppA : PP_Doc + ppAI : [PP_Doc] + ppCata : PP_Doc + ppD : PP_Doc + ppDI : [PP_Doc] + ppL : PP_Doc + ppLI : [PP_Doc] + ppNtL : [(PP_Doc, Attributes)] + ppR : PP_Doc + ppSF : PP_Doc + ppW : PP_Doc + synMap' : Map Identifier Attributes + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + alternative Nil: +-} +-- 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 (Derivings -> + (Maybe String) -> + (Map Identifier Attributes) -> + ( Attributes ) -> + (Set NontermIdent) -> + ( DataTypes ) -> + ([String]) -> + Bool -> + (Map Identifier Attributes) -> + TypeSyns -> + ( (Set NontermIdent),(Map Identifier Attributes),PP_Doc,([PP_Doc]),PP_Doc,PP_Doc,([PP_Doc]),PP_Doc,([PP_Doc]),([(PP_Doc, Attributes)]),PP_Doc,PP_Doc,PP_Doc,(Map Identifier Attributes))) +data Inh_Nonterminals = Inh_Nonterminals {derivs_Inh_Nonterminals :: Derivings,ext_Inh_Nonterminals :: (Maybe String),inhMap_Inh_Nonterminals :: (Map Identifier Attributes),newAtts_Inh_Nonterminals :: ( Attributes ),newNTs_Inh_Nonterminals :: (Set NontermIdent),newProds_Inh_Nonterminals :: ( DataTypes ),o_noGroup_Inh_Nonterminals :: ([String]),o_rename_Inh_Nonterminals :: Bool,synMap_Inh_Nonterminals :: (Map Identifier Attributes),tSyns_Inh_Nonterminals :: TypeSyns} +data Syn_Nonterminals = Syn_Nonterminals {extendedNTs_Syn_Nonterminals :: (Set NontermIdent),inhMap'_Syn_Nonterminals :: (Map Identifier Attributes),ppA_Syn_Nonterminals :: PP_Doc,ppAI_Syn_Nonterminals :: ([PP_Doc]),ppCata_Syn_Nonterminals :: PP_Doc,ppD_Syn_Nonterminals :: PP_Doc,ppDI_Syn_Nonterminals :: ([PP_Doc]),ppL_Syn_Nonterminals :: PP_Doc,ppLI_Syn_Nonterminals :: ([PP_Doc]),ppNtL_Syn_Nonterminals :: ([(PP_Doc, Attributes)]),ppR_Syn_Nonterminals :: PP_Doc,ppSF_Syn_Nonterminals :: PP_Doc,ppW_Syn_Nonterminals :: PP_Doc,synMap'_Syn_Nonterminals :: (Map Identifier Attributes)} +wrap_Nonterminals :: T_Nonterminals -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) = + (let ( _lhsOextendedNTs,_lhsOinhMap',_lhsOppA,_lhsOppAI,_lhsOppCata,_lhsOppD,_lhsOppDI,_lhsOppL,_lhsOppLI,_lhsOppNtL,_lhsOppR,_lhsOppSF,_lhsOppW,_lhsOsynMap') = sem _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns + in (Syn_Nonterminals _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap')) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) = + (T_Nonterminals (\ _lhsIderivs + _lhsIext + _lhsIinhMap + _lhsInewAtts + _lhsInewNTs + _lhsInewProds + _lhsIo_noGroup + _lhsIo_rename + _lhsIsynMap + _lhsItSyns -> + (let _lhsOextendedNTs :: (Set NontermIdent) + _lhsOinhMap' :: (Map Identifier Attributes) + _lhsOppA :: PP_Doc + _lhsOppAI :: ([PP_Doc]) + _lhsOppCata :: PP_Doc + _lhsOppD :: PP_Doc + _lhsOppDI :: ([PP_Doc]) + _lhsOppL :: PP_Doc + _lhsOppLI :: ([PP_Doc]) + _lhsOppNtL :: ([(PP_Doc, Attributes)]) + _lhsOppR :: PP_Doc + _lhsOppSF :: PP_Doc + _lhsOppW :: PP_Doc + _lhsOsynMap' :: (Map Identifier Attributes) + _hdOderivs :: Derivings + _hdOext :: (Maybe String) + _hdOinhMap :: (Map Identifier Attributes) + _hdOnewAtts :: ( Attributes ) + _hdOnewNTs :: (Set NontermIdent) + _hdOnewProds :: ( DataTypes ) + _hdOo_noGroup :: ([String]) + _hdOo_rename :: Bool + _hdOsynMap :: (Map Identifier Attributes) + _hdOtSyns :: TypeSyns + _tlOderivs :: Derivings + _tlOext :: (Maybe String) + _tlOinhMap :: (Map Identifier Attributes) + _tlOnewAtts :: ( Attributes ) + _tlOnewNTs :: (Set NontermIdent) + _tlOnewProds :: ( DataTypes ) + _tlOo_noGroup :: ([String]) + _tlOo_rename :: Bool + _tlOsynMap :: (Map Identifier Attributes) + _tlOtSyns :: TypeSyns + _hdIextendedNTs :: (Set NontermIdent) + _hdIinhMap' :: (Map Identifier Attributes) + _hdIppA :: PP_Doc + _hdIppAI :: ([PP_Doc]) + _hdIppCata :: PP_Doc + _hdIppD :: PP_Doc + _hdIppDI :: ([PP_Doc]) + _hdIppL :: PP_Doc + _hdIppLI :: ([PP_Doc]) + _hdIppNtL :: ([(PP_Doc, Attributes)]) + _hdIppR :: PP_Doc + _hdIppSF :: PP_Doc + _hdIppW :: PP_Doc + _hdIsynMap' :: (Map Identifier Attributes) + _tlIextendedNTs :: (Set NontermIdent) + _tlIinhMap' :: (Map Identifier Attributes) + _tlIppA :: PP_Doc + _tlIppAI :: ([PP_Doc]) + _tlIppCata :: PP_Doc + _tlIppD :: PP_Doc + _tlIppDI :: ([PP_Doc]) + _tlIppL :: PP_Doc + _tlIppLI :: ([PP_Doc]) + _tlIppNtL :: ([(PP_Doc, Attributes)]) + _tlIppR :: PP_Doc + _tlIppSF :: PP_Doc + _tlIppW :: PP_Doc + _tlIsynMap' :: (Map Identifier Attributes) + -- use rule "./src-ag/AG2AspectAG.ag"(line 105, column 52) + _lhsOextendedNTs = + ({-# LINE 105 "./src-ag/AG2AspectAG.ag" #-} + _hdIextendedNTs `Set.union` _tlIextendedNTs + {-# LINE 1857 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOinhMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + _hdIinhMap' `Map.union` _tlIinhMap' + {-# LINE 1863 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 321, column 64) + _lhsOppA = + ({-# LINE 321 "./src-ag/AG2AspectAG.ag" #-} + _hdIppA >-< _tlIppA + {-# LINE 1869 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 335, column 42) + _lhsOppAI = + ({-# LINE 335 "./src-ag/AG2AspectAG.ag" #-} + _hdIppAI ++ _tlIppAI + {-# LINE 1875 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 732, column 67) + _lhsOppCata = + ({-# LINE 732 "./src-ag/AG2AspectAG.ag" #-} + _hdIppCata >-< _tlIppCata + {-# LINE 1881 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 205, column 52) + _lhsOppD = + ({-# LINE 205 "./src-ag/AG2AspectAG.ag" #-} + _hdIppD >-< _tlIppD + {-# LINE 1887 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 205, column 86) + _lhsOppDI = + ({-# LINE 205 "./src-ag/AG2AspectAG.ag" #-} + _hdIppDI ++ _tlIppDI + {-# LINE 1893 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 259, column 79) + _lhsOppL = + ({-# LINE 259 "./src-ag/AG2AspectAG.ag" #-} + _hdIppL >-< _tlIppL + {-# LINE 1899 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 259, column 112) + _lhsOppLI = + ({-# LINE 259 "./src-ag/AG2AspectAG.ag" #-} + _hdIppLI ++ _tlIppLI + {-# LINE 1905 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 403, column 44) + _lhsOppNtL = + ({-# LINE 403 "./src-ag/AG2AspectAG.ag" #-} + _hdIppNtL ++ _tlIppNtL + {-# LINE 1911 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 418, column 79) + _lhsOppR = + ({-# LINE 418 "./src-ag/AG2AspectAG.ag" #-} + _hdIppR >-< _tlIppR + {-# LINE 1917 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 773, column 66) + _lhsOppSF = + ({-# LINE 773 "./src-ag/AG2AspectAG.ag" #-} + _hdIppSF >-< _tlIppSF + {-# LINE 1923 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 843, column 42) + _lhsOppW = + ({-# LINE 843 "./src-ag/AG2AspectAG.ag" #-} + _hdIppW >-< _tlIppW + {-# LINE 1929 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOsynMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + _hdIsynMap' `Map.union` _tlIsynMap' + {-# LINE 1935 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOderivs = + ({-# LINE 199 "./src-ag/AG2AspectAG.ag" #-} + _lhsIderivs + {-# LINE 1941 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOext = + ({-# LINE 119 "./src-ag/AG2AspectAG.ag" #-} + _lhsIext + {-# LINE 1947 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1953 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOnewAtts = + ({-# LINE 78 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewAtts + {-# LINE 1959 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOnewNTs = + ({-# LINE 99 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewNTs + {-# LINE 1965 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOnewProds = + ({-# LINE 85 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewProds + {-# LINE 1971 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOo_noGroup = + ({-# LINE 45 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_noGroup + {-# LINE 1977 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 41 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 1983 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1989 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOtSyns = + ({-# LINE 248 "./src-ag/AG2AspectAG.ag" #-} + _lhsItSyns + {-# LINE 1995 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOderivs = + ({-# LINE 199 "./src-ag/AG2AspectAG.ag" #-} + _lhsIderivs + {-# LINE 2001 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOext = + ({-# LINE 119 "./src-ag/AG2AspectAG.ag" #-} + _lhsIext + {-# LINE 2007 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 2013 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOnewAtts = + ({-# LINE 78 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewAtts + {-# LINE 2019 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOnewNTs = + ({-# LINE 99 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewNTs + {-# LINE 2025 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOnewProds = + ({-# LINE 85 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewProds + {-# LINE 2031 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOo_noGroup = + ({-# LINE 45 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_noGroup + {-# LINE 2037 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 41 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 2043 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2049 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOtSyns = + ({-# LINE 248 "./src-ag/AG2AspectAG.ag" #-} + _lhsItSyns + {-# LINE 2055 "dist/build/AG2AspectAG.hs" #-} + ) + ( _hdIextendedNTs,_hdIinhMap',_hdIppA,_hdIppAI,_hdIppCata,_hdIppD,_hdIppDI,_hdIppL,_hdIppLI,_hdIppNtL,_hdIppR,_hdIppSF,_hdIppW,_hdIsynMap') = + hd_ _hdOderivs _hdOext _hdOinhMap _hdOnewAtts _hdOnewNTs _hdOnewProds _hdOo_noGroup _hdOo_rename _hdOsynMap _hdOtSyns + ( _tlIextendedNTs,_tlIinhMap',_tlIppA,_tlIppAI,_tlIppCata,_tlIppD,_tlIppDI,_tlIppL,_tlIppLI,_tlIppNtL,_tlIppR,_tlIppSF,_tlIppW,_tlIsynMap') = + tl_ _tlOderivs _tlOext _tlOinhMap _tlOnewAtts _tlOnewNTs _tlOnewProds _tlOo_noGroup _tlOo_rename _tlOsynMap _tlOtSyns + in ( _lhsOextendedNTs,_lhsOinhMap',_lhsOppA,_lhsOppAI,_lhsOppCata,_lhsOppD,_lhsOppDI,_lhsOppL,_lhsOppLI,_lhsOppNtL,_lhsOppR,_lhsOppSF,_lhsOppW,_lhsOsynMap')))) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (\ _lhsIderivs + _lhsIext + _lhsIinhMap + _lhsInewAtts + _lhsInewNTs + _lhsInewProds + _lhsIo_noGroup + _lhsIo_rename + _lhsIsynMap + _lhsItSyns -> + (let _lhsOextendedNTs :: (Set NontermIdent) + _lhsOinhMap' :: (Map Identifier Attributes) + _lhsOppA :: PP_Doc + _lhsOppAI :: ([PP_Doc]) + _lhsOppCata :: PP_Doc + _lhsOppD :: PP_Doc + _lhsOppDI :: ([PP_Doc]) + _lhsOppL :: PP_Doc + _lhsOppLI :: ([PP_Doc]) + _lhsOppNtL :: ([(PP_Doc, Attributes)]) + _lhsOppR :: PP_Doc + _lhsOppSF :: PP_Doc + _lhsOppW :: PP_Doc + _lhsOsynMap' :: (Map Identifier Attributes) + -- use rule "./src-ag/AG2AspectAG.ag"(line 105, column 52) + _lhsOextendedNTs = + ({-# LINE 105 "./src-ag/AG2AspectAG.ag" #-} + Set.empty + {-# LINE 2092 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOinhMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + Map.empty + {-# LINE 2098 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 321, column 64) + _lhsOppA = + ({-# LINE 321 "./src-ag/AG2AspectAG.ag" #-} + empty + {-# LINE 2104 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 335, column 42) + _lhsOppAI = + ({-# LINE 335 "./src-ag/AG2AspectAG.ag" #-} + [] + {-# LINE 2110 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 732, column 67) + _lhsOppCata = + ({-# LINE 732 "./src-ag/AG2AspectAG.ag" #-} + empty + {-# LINE 2116 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 205, column 52) + _lhsOppD = + ({-# LINE 205 "./src-ag/AG2AspectAG.ag" #-} + empty + {-# LINE 2122 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 205, column 86) + _lhsOppDI = + ({-# LINE 205 "./src-ag/AG2AspectAG.ag" #-} + [] + {-# LINE 2128 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 259, column 79) + _lhsOppL = + ({-# LINE 259 "./src-ag/AG2AspectAG.ag" #-} + empty + {-# LINE 2134 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 259, column 112) + _lhsOppLI = + ({-# LINE 259 "./src-ag/AG2AspectAG.ag" #-} + [] + {-# LINE 2140 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 403, column 44) + _lhsOppNtL = + ({-# LINE 403 "./src-ag/AG2AspectAG.ag" #-} + [] + {-# LINE 2146 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 418, column 79) + _lhsOppR = + ({-# LINE 418 "./src-ag/AG2AspectAG.ag" #-} + empty + {-# LINE 2152 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 773, column 66) + _lhsOppSF = + ({-# LINE 773 "./src-ag/AG2AspectAG.ag" #-} + empty + {-# LINE 2158 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 843, column 42) + _lhsOppW = + ({-# LINE 843 "./src-ag/AG2AspectAG.ag" #-} + empty + {-# LINE 2164 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOsynMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + Map.empty + {-# LINE 2170 "dist/build/AG2AspectAG.hs" #-} + ) + in ( _lhsOextendedNTs,_lhsOinhMap',_lhsOppA,_lhsOppAI,_lhsOppCata,_lhsOppD,_lhsOppDI,_lhsOppL,_lhsOppLI,_lhsOppNtL,_lhsOppR,_lhsOppSF,_lhsOppW,_lhsOsynMap')))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : Pattern + info : (Identifier, Identifier) + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern (Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern (Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern (Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +sem_Pattern (Underscore _pos) = + (sem_Pattern_Underscore _pos) +-- semantic domain +newtype T_Pattern = T_Pattern (( Pattern,((Identifier, Identifier)))) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,info_Syn_Pattern :: ((Identifier, Identifier))} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem) (Inh_Pattern) = + (let ( _lhsOcopy,_lhsOinfo) = sem + in (Syn_Pattern _lhsOcopy _lhsOinfo)) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_) = + (T_Pattern (let _lhsOinfo :: ((Identifier, Identifier)) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + -- "./src-ag/AG2AspectAG.ag"(line 383, column 25) + _lhsOinfo = + ({-# LINE 383 "./src-ag/AG2AspectAG.ag" #-} + error "Pattern Constr undefined!!" + {-# LINE 2239 "dist/build/AG2AspectAG.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 2245 "dist/build/AG2AspectAG.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 2251 "dist/build/AG2AspectAG.hs" #-} + ) + ( _patsIcopy) = + pats_ + in ( _lhsOcopy,_lhsOinfo))) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_) = + (T_Pattern (let _lhsOinfo :: ((Identifier, Identifier)) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + -- "./src-ag/AG2AspectAG.ag"(line 384, column 25) + _lhsOinfo = + ({-# LINE 384 "./src-ag/AG2AspectAG.ag" #-} + error "Pattern Product undefined!!" + {-# LINE 2267 "dist/build/AG2AspectAG.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 2273 "dist/build/AG2AspectAG.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 2279 "dist/build/AG2AspectAG.hs" #-} + ) + ( _patsIcopy) = + pats_ + in ( _lhsOcopy,_lhsOinfo))) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_) = + (T_Pattern (let _lhsOinfo :: ((Identifier, Identifier)) + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIinfo :: ((Identifier, Identifier)) + -- "./src-ag/AG2AspectAG.ag"(line 382, column 25) + _lhsOinfo = + ({-# LINE 382 "./src-ag/AG2AspectAG.ag" #-} + (field_, attr_) + {-# LINE 2297 "dist/build/AG2AspectAG.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 2303 "dist/build/AG2AspectAG.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 2309 "dist/build/AG2AspectAG.hs" #-} + ) + ( _patIcopy,_patIinfo) = + pat_ + in ( _lhsOcopy,_lhsOinfo))) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_) = + (T_Pattern (let _lhsOcopy :: Pattern + _lhsOinfo :: ((Identifier, Identifier)) + _patIcopy :: Pattern + _patIinfo :: ((Identifier, Identifier)) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 2325 "dist/build/AG2AspectAG.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 2331 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (up) + _lhsOinfo = + ({-# LINE 380 "./src-ag/AG2AspectAG.ag" #-} + _patIinfo + {-# LINE 2337 "dist/build/AG2AspectAG.hs" #-} + ) + ( _patIcopy,_patIinfo) = + pat_ + in ( _lhsOcopy,_lhsOinfo))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOinfo :: ((Identifier, Identifier)) + _lhsOcopy :: Pattern + -- "./src-ag/AG2AspectAG.ag"(line 385, column 25) + _lhsOinfo = + ({-# LINE 385 "./src-ag/AG2AspectAG.ag" #-} + error "Pattern Underscore undefined!!" + {-# LINE 2351 "dist/build/AG2AspectAG.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 2357 "dist/build/AG2AspectAG.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 2363 "dist/build/AG2AspectAG.hs" #-} + ) + in ( _lhsOcopy,_lhsOinfo))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : 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)) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem) (Inh_Patterns) = + (let ( _lhsOcopy) = sem + in (Syn_Patterns _lhsOcopy)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = + (T_Patterns (let _lhsOcopy :: Patterns + _hdIcopy :: Pattern + _hdIinfo :: ((Identifier, Identifier)) + _tlIcopy :: Patterns + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 2408 "dist/build/AG2AspectAG.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 2414 "dist/build/AG2AspectAG.hs" #-} + ) + ( _hdIcopy,_hdIinfo) = + hd_ + ( _tlIcopy) = + tl_ + in ( _lhsOcopy))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOcopy :: Patterns + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 2428 "dist/build/AG2AspectAG.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 2434 "dist/build/AG2AspectAG.hs" #-} + ) + in ( _lhsOcopy))) +-- Production -------------------------------------------------- +{- + visit 0: + inherited attributes: + ext : Maybe String + inh : Attributes + inhMap : Map Identifier Attributes + inhNoGroup : [String] + newAtts : Attributes + newNT : Bool + newProds : Map.Map ConstructorIdent FieldMap + o_noGroup : [String] + o_rename : Bool + ppNt : PP_Doc + syn : Attributes + synMap : Map Identifier Attributes + synNoGroup : [String] + synthesized attributes: + hasMoreProds : Bool + ppA : PP_Doc + ppCata : PP_Doc + ppD : PP_Doc + ppDI : [PP_Doc] + ppL : PP_Doc + ppLI : [PP_Doc] + ppR : PP_Doc + ppRA : [PP_Doc] + ppSF : PP_Doc + ppSPF : PP_Doc + prdInh : Attributes + alternatives: + alternative Production: + child con : {ConstructorIdent} + child params : {[Identifier]} + child constraints : {[Type]} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + child macro : {MaybeMacro} + visit 0: + local ppProd : _ + local prodName : _ + local conName : _ + local newProd : _ + local ppR : _ + local ppRA : _ +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production (Production _con _params _constraints _children _rules _typeSigs _macro) = + (sem_Production_Production _con _params _constraints (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs) _macro) +-- semantic domain +newtype T_Production = T_Production ((Maybe String) -> + ( Attributes ) -> + (Map Identifier Attributes) -> + ([String]) -> + ( Attributes ) -> + Bool -> + ( Map.Map ConstructorIdent FieldMap ) -> + ([String]) -> + Bool -> + PP_Doc -> + ( Attributes ) -> + (Map Identifier Attributes) -> + ([String]) -> + ( ( Bool ),PP_Doc,PP_Doc,PP_Doc,([PP_Doc]),PP_Doc,([PP_Doc]),PP_Doc,([PP_Doc]),PP_Doc,PP_Doc,Attributes)) +data Inh_Production = Inh_Production {ext_Inh_Production :: (Maybe String),inh_Inh_Production :: ( Attributes ),inhMap_Inh_Production :: (Map Identifier Attributes),inhNoGroup_Inh_Production :: ([String]),newAtts_Inh_Production :: ( Attributes ),newNT_Inh_Production :: Bool,newProds_Inh_Production :: ( Map.Map ConstructorIdent FieldMap ),o_noGroup_Inh_Production :: ([String]),o_rename_Inh_Production :: Bool,ppNt_Inh_Production :: PP_Doc,syn_Inh_Production :: ( Attributes ),synMap_Inh_Production :: (Map Identifier Attributes),synNoGroup_Inh_Production :: ([String])} +data Syn_Production = Syn_Production {hasMoreProds_Syn_Production :: ( Bool ),ppA_Syn_Production :: PP_Doc,ppCata_Syn_Production :: PP_Doc,ppD_Syn_Production :: PP_Doc,ppDI_Syn_Production :: ([PP_Doc]),ppL_Syn_Production :: PP_Doc,ppLI_Syn_Production :: ([PP_Doc]),ppR_Syn_Production :: PP_Doc,ppRA_Syn_Production :: ([PP_Doc]),ppSF_Syn_Production :: PP_Doc,ppSPF_Syn_Production :: PP_Doc,prdInh_Syn_Production :: Attributes} +wrap_Production :: T_Production -> + Inh_Production -> + Syn_Production +wrap_Production (T_Production sem) (Inh_Production _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) = + (let ( _lhsOhasMoreProds,_lhsOppA,_lhsOppCata,_lhsOppD,_lhsOppDI,_lhsOppL,_lhsOppLI,_lhsOppR,_lhsOppRA,_lhsOppSF,_lhsOppSPF,_lhsOprdInh) = sem _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup + in (Syn_Production _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh)) +sem_Production_Production :: ConstructorIdent -> + ([Identifier]) -> + ([Type]) -> + T_Children -> + T_Rules -> + T_TypeSigs -> + MaybeMacro -> + T_Production +sem_Production_Production con_ params_ constraints_ (T_Children children_) (T_Rules rules_) (T_TypeSigs typeSigs_) macro_ = + (T_Production (\ _lhsIext + _lhsIinh + _lhsIinhMap + _lhsIinhNoGroup + _lhsInewAtts + _lhsInewNT + _lhsInewProds + _lhsIo_noGroup + _lhsIo_rename + _lhsIppNt + _lhsIsyn + _lhsIsynMap + _lhsIsynNoGroup -> + (let _lhsOhasMoreProds :: ( Bool ) + _childrenOppProd :: PP_Doc + _rulesOppProd :: PP_Doc + _lhsOppD :: PP_Doc + _lhsOppL :: PP_Doc + _lhsOppLI :: ([PP_Doc]) + _lhsOppA :: PP_Doc + _lhsOppCata :: PP_Doc + _lhsOppSF :: PP_Doc + _lhsOppSPF :: PP_Doc + _lhsOppDI :: ([PP_Doc]) + _lhsOppR :: PP_Doc + _lhsOppRA :: ([PP_Doc]) + _lhsOprdInh :: Attributes + _childrenOext :: (Maybe String) + _childrenOinhMap :: (Map Identifier Attributes) + _childrenOinhNoGroup :: ([String]) + _childrenOnewAtts :: ( Attributes ) + _childrenOo_noGroup :: ([String]) + _childrenOo_rename :: Bool + _childrenOppNt :: PP_Doc + _childrenOsynMap :: (Map Identifier Attributes) + _childrenOsynNoGroup :: ([String]) + _rulesOext :: (Maybe String) + _rulesOinhNoGroup :: ([String]) + _rulesOnewAtts :: ( Attributes ) + _rulesOnewProd :: Bool + _rulesOo_noGroup :: ([String]) + _rulesOppNt :: PP_Doc + _rulesOsynNoGroup :: ([String]) + _childrenIidCL :: ([(Identifier,Type)]) + _childrenIppCSF :: ([(Identifier,(PP_Doc,PP_Doc))]) + _childrenIppDL :: ([PP_Doc]) + _childrenIppL :: PP_Doc + _childrenIppLI :: ([PP_Doc]) + _childrenIppR :: PP_Doc + _childrenIprdInh :: Attributes + _rulesIlocals :: ([Identifier]) + _rulesIppRL :: ([ PPRule ]) + -- "./src-ag/AG2AspectAG.ag"(line 103, column 29) + _lhsOhasMoreProds = + ({-# LINE 103 "./src-ag/AG2AspectAG.ag" #-} + not $ Map.member con_ _lhsInewProds + {-# LINE 2577 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 176, column 25) + _ppProd = + ({-# LINE 176 "./src-ag/AG2AspectAG.ag" #-} + pp con_ + {-# LINE 2583 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 177, column 25) + _prodName = + ({-# LINE 177 "./src-ag/AG2AspectAG.ag" #-} + ppName [_lhsIppNt, _ppProd ] + {-# LINE 2589 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 178, column 25) + _conName = + ({-# LINE 178 "./src-ag/AG2AspectAG.ag" #-} + if _lhsIo_rename + then _prodName + else _ppProd + {-# LINE 2597 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 195, column 25) + _childrenOppProd = + ({-# LINE 195 "./src-ag/AG2AspectAG.ag" #-} + _ppProd + {-# LINE 2603 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 196, column 25) + _rulesOppProd = + ({-# LINE 196 "./src-ag/AG2AspectAG.ag" #-} + _ppProd + {-# LINE 2609 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 228, column 25) + _lhsOppD = + ({-# LINE 228 "./src-ag/AG2AspectAG.ag" #-} + _conName >|< ppListSep " {" "}" ", " _childrenIppDL + {-# LINE 2615 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 275, column 25) + _lhsOppL = + ({-# LINE 275 "./src-ag/AG2AspectAG.ag" #-} + if (Map.member con_ _lhsInewProds) + then _childrenIppL + else empty + {-# LINE 2623 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 279, column 25) + _lhsOppLI = + ({-# LINE 279 "./src-ag/AG2AspectAG.ag" #-} + if (not $ Map.member con_ _lhsInewProds) + then _childrenIppLI + else [] + {-# LINE 2631 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 332, column 25) + _lhsOppA = + ({-# LINE 332 "./src-ag/AG2AspectAG.ag" #-} + defLocalAtts _prodName (length _rulesIlocals) 1 $ sort _rulesIlocals + {-# LINE 2637 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 428, column 25) + _newProd = + ({-# LINE 428 "./src-ag/AG2AspectAG.ag" #-} + Map.member con_ _lhsInewProds + {-# LINE 2643 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 429, column 41) + (_ppR,_ppRA) = + ({-# LINE 429 "./src-ag/AG2AspectAG.ag" #-} + let (instR, instRA) = defInstRules _lhsIppNt con_ _lhsInewNT _newProd + _childrenIppR _rulesIppRL _childrenIidCL _rulesIlocals + (locR, locRA) = defLocRule _lhsIppNt con_ _lhsInewNT _newProd + _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals + (inhGR, inhGRA) = defInhGRule _lhsIppNt _prodName _lhsInewNT _newProd + _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals + (synGR, synGRA) = defSynGRule _lhsIppNt con_ _lhsInewNT _newProd + _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals + (inhR, inhRA) = defInhRules _lhsIppNt _prodName _lhsInewNT _newProd _lhsInewAtts + _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals + (synR, synRA) = defSynRules _lhsIppNt con_ _lhsInewNT _newProd _lhsInewAtts + _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals + (inhMR, inhMRA) = modInhRules _lhsIppNt _prodName _lhsInewNT _newProd _lhsInewAtts + _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals + (synMR, synMRA) = modSynRules _lhsIppNt con_ _lhsInewNT _newProd _lhsInewAtts + _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals + in ( vlist [instR,locR,inhGR,synGR,inhR,synR,inhMR,synMR] + , instRA ++ locRA ++ inhGRA ++ synGRA ++ inhMRA ++ synMRA ++ inhRA ++ synRA) + {-# LINE 2666 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 739, column 25) + _lhsOppCata = + ({-# LINE 739 "./src-ag/AG2AspectAG.ag" #-} + let extend = maybe [] + ( \ext -> if (_lhsInewNT || (not _lhsInewNT && _newProd )) + then [] + else [ ext >|< ".atts_" >|< _prodName ]) + _lhsIext + macro = case macro_ of + Nothing -> [] + Just macro -> [ "agMacro " >|< ppMacro macro ] + atts = sortBy (\a b -> compare (show a) (show b)) _ppRA + in "atts_" >|< _prodName >|< " = " >|< + ppListSep "" "" " `ext` " + (atts ++ macro ++ extend ) >-< + "semP_" >|< _prodName >|< pp " = knit atts_" >|< _prodName + {-# LINE 2684 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 803, column 25) + _lhsOppSF = + ({-# LINE 803 "./src-ag/AG2AspectAG.ag" #-} + let chi = _childrenIppCSF + ppPattern = case (show con_) of + "Cons" -> ppParams (ppListSep "" "" " : ") + "Nil" -> pp "[]" + otherwise -> _conName >|< " " >|< (ppParams ppSpaced) + ppParams f = f $ map (((>|<) (pp "_")) . fst) chi + in "sem_" >|< _lhsIppNt >|< " (" >|< ppPattern >|< ") = sem_" >|< _prodName >|< + " (" >|< map (fst . snd) chi >|< "emptyRecord)" + {-# LINE 2697 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 815, column 25) + _lhsOppSPF = + ({-# LINE 815 "./src-ag/AG2AspectAG.ag" #-} + let chi = _childrenIppCSF + ppParams f = f $ map (((>|<) (pp "_")) . fst) chi + in "sem_" >|< _lhsIppNt >|< "_" >|< con_ >#< ppParams ppSpaced >|< " = semP_" >|< _prodName >|< + " (" >|< map (snd . snd) chi >|< "emptyRecord)" + {-# LINE 2706 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 205, column 86) + _lhsOppDI = + ({-# LINE 205 "./src-ag/AG2AspectAG.ag" #-} + [] + {-# LINE 2712 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 418, column 79) + _lhsOppR = + ({-# LINE 418 "./src-ag/AG2AspectAG.ag" #-} + _ppR + {-# LINE 2718 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 419, column 43) + _lhsOppRA = + ({-# LINE 419 "./src-ag/AG2AspectAG.ag" #-} + _ppRA + {-# LINE 2724 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 65, column 57) + _lhsOprdInh = + ({-# LINE 65 "./src-ag/AG2AspectAG.ag" #-} + _childrenIprdInh + {-# LINE 2730 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _childrenOext = + ({-# LINE 119 "./src-ag/AG2AspectAG.ag" #-} + _lhsIext + {-# LINE 2736 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _childrenOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 2742 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _childrenOinhNoGroup = + ({-# LINE 55 "./src-ag/AG2AspectAG.ag" #-} + _lhsIinhNoGroup + {-# LINE 2748 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _childrenOnewAtts = + ({-# LINE 78 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewAtts + {-# LINE 2754 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _childrenOo_noGroup = + ({-# LINE 45 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_noGroup + {-# LINE 2760 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _childrenOo_rename = + ({-# LINE 41 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 2766 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _childrenOppNt = + ({-# LINE 187 "./src-ag/AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 2772 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _childrenOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2778 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _childrenOsynNoGroup = + ({-# LINE 55 "./src-ag/AG2AspectAG.ag" #-} + _lhsIsynNoGroup + {-# LINE 2784 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _rulesOext = + ({-# LINE 119 "./src-ag/AG2AspectAG.ag" #-} + _lhsIext + {-# LINE 2790 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _rulesOinhNoGroup = + ({-# LINE 55 "./src-ag/AG2AspectAG.ag" #-} + _lhsIinhNoGroup + {-# LINE 2796 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _rulesOnewAtts = + ({-# LINE 78 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewAtts + {-# LINE 2802 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (from local) + _rulesOnewProd = + ({-# LINE 412 "./src-ag/AG2AspectAG.ag" #-} + _newProd + {-# LINE 2808 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _rulesOo_noGroup = + ({-# LINE 45 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_noGroup + {-# LINE 2814 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _rulesOppNt = + ({-# LINE 187 "./src-ag/AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 2820 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _rulesOsynNoGroup = + ({-# LINE 55 "./src-ag/AG2AspectAG.ag" #-} + _lhsIsynNoGroup + {-# LINE 2826 "dist/build/AG2AspectAG.hs" #-} + ) + ( _childrenIidCL,_childrenIppCSF,_childrenIppDL,_childrenIppL,_childrenIppLI,_childrenIppR,_childrenIprdInh) = + children_ _childrenOext _childrenOinhMap _childrenOinhNoGroup _childrenOnewAtts _childrenOo_noGroup _childrenOo_rename _childrenOppNt _childrenOppProd _childrenOsynMap _childrenOsynNoGroup + ( _rulesIlocals,_rulesIppRL) = + rules_ _rulesOext _rulesOinhNoGroup _rulesOnewAtts _rulesOnewProd _rulesOo_noGroup _rulesOppNt _rulesOppProd _rulesOsynNoGroup + in ( _lhsOhasMoreProds,_lhsOppA,_lhsOppCata,_lhsOppD,_lhsOppDI,_lhsOppL,_lhsOppLI,_lhsOppR,_lhsOppRA,_lhsOppSF,_lhsOppSPF,_lhsOprdInh)))) +-- Productions ------------------------------------------------- +{- + visit 0: + inherited attributes: + ext : Maybe String + inh : Attributes + inhMap : Map Identifier Attributes + inhNoGroup : [String] + newAtts : Attributes + newNT : Bool + newProds : Map.Map ConstructorIdent FieldMap + o_noGroup : [String] + o_rename : Bool + ppNt : PP_Doc + syn : Attributes + synMap : Map Identifier Attributes + synNoGroup : [String] + synthesized attributes: + hasMoreProds : Bool + ppA : PP_Doc + ppCata : PP_Doc + ppDL : [PP_Doc] + ppL : PP_Doc + ppLI : [PP_Doc] + ppR : PP_Doc + ppRA : [PP_Doc] + ppSF : PP_Doc + ppSPF : PP_Doc + prdInh : Attributes + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + alternative Nil: +-} +-- 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 ((Maybe String) -> + ( Attributes ) -> + (Map Identifier Attributes) -> + ([String]) -> + ( Attributes ) -> + Bool -> + ( Map.Map ConstructorIdent FieldMap ) -> + ([String]) -> + Bool -> + PP_Doc -> + ( Attributes ) -> + (Map Identifier Attributes) -> + ([String]) -> + ( ( Bool ),PP_Doc,PP_Doc,([PP_Doc]),PP_Doc,([PP_Doc]),PP_Doc,([PP_Doc]),PP_Doc,PP_Doc,Attributes)) +data Inh_Productions = Inh_Productions {ext_Inh_Productions :: (Maybe String),inh_Inh_Productions :: ( Attributes ),inhMap_Inh_Productions :: (Map Identifier Attributes),inhNoGroup_Inh_Productions :: ([String]),newAtts_Inh_Productions :: ( Attributes ),newNT_Inh_Productions :: Bool,newProds_Inh_Productions :: ( Map.Map ConstructorIdent FieldMap ),o_noGroup_Inh_Productions :: ([String]),o_rename_Inh_Productions :: Bool,ppNt_Inh_Productions :: PP_Doc,syn_Inh_Productions :: ( Attributes ),synMap_Inh_Productions :: (Map Identifier Attributes),synNoGroup_Inh_Productions :: ([String])} +data Syn_Productions = Syn_Productions {hasMoreProds_Syn_Productions :: ( Bool ),ppA_Syn_Productions :: PP_Doc,ppCata_Syn_Productions :: PP_Doc,ppDL_Syn_Productions :: ([PP_Doc]),ppL_Syn_Productions :: PP_Doc,ppLI_Syn_Productions :: ([PP_Doc]),ppR_Syn_Productions :: PP_Doc,ppRA_Syn_Productions :: ([PP_Doc]),ppSF_Syn_Productions :: PP_Doc,ppSPF_Syn_Productions :: PP_Doc,prdInh_Syn_Productions :: Attributes} +wrap_Productions :: T_Productions -> + Inh_Productions -> + Syn_Productions +wrap_Productions (T_Productions sem) (Inh_Productions _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) = + (let ( _lhsOhasMoreProds,_lhsOppA,_lhsOppCata,_lhsOppDL,_lhsOppL,_lhsOppLI,_lhsOppR,_lhsOppRA,_lhsOppSF,_lhsOppSPF,_lhsOprdInh) = sem _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup + in (Syn_Productions _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh)) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons (T_Production hd_) (T_Productions tl_) = + (T_Productions (\ _lhsIext + _lhsIinh + _lhsIinhMap + _lhsIinhNoGroup + _lhsInewAtts + _lhsInewNT + _lhsInewProds + _lhsIo_noGroup + _lhsIo_rename + _lhsIppNt + _lhsIsyn + _lhsIsynMap + _lhsIsynNoGroup -> + (let _hdOinhNoGroup :: ([String]) + _lhsOppDL :: ([PP_Doc]) + _lhsOhasMoreProds :: ( Bool ) + _lhsOppA :: PP_Doc + _lhsOppCata :: PP_Doc + _lhsOppL :: PP_Doc + _lhsOppLI :: ([PP_Doc]) + _lhsOppR :: PP_Doc + _lhsOppRA :: ([PP_Doc]) + _lhsOppSF :: PP_Doc + _lhsOppSPF :: PP_Doc + _lhsOprdInh :: Attributes + _hdOext :: (Maybe String) + _hdOinh :: ( Attributes ) + _hdOinhMap :: (Map Identifier Attributes) + _hdOnewAtts :: ( Attributes ) + _hdOnewNT :: Bool + _hdOnewProds :: ( Map.Map ConstructorIdent FieldMap ) + _hdOo_noGroup :: ([String]) + _hdOo_rename :: Bool + _hdOppNt :: PP_Doc + _hdOsyn :: ( Attributes ) + _hdOsynMap :: (Map Identifier Attributes) + _hdOsynNoGroup :: ([String]) + _tlOext :: (Maybe String) + _tlOinh :: ( Attributes ) + _tlOinhMap :: (Map Identifier Attributes) + _tlOinhNoGroup :: ([String]) + _tlOnewAtts :: ( Attributes ) + _tlOnewNT :: Bool + _tlOnewProds :: ( Map.Map ConstructorIdent FieldMap ) + _tlOo_noGroup :: ([String]) + _tlOo_rename :: Bool + _tlOppNt :: PP_Doc + _tlOsyn :: ( Attributes ) + _tlOsynMap :: (Map Identifier Attributes) + _tlOsynNoGroup :: ([String]) + _hdIhasMoreProds :: ( Bool ) + _hdIppA :: PP_Doc + _hdIppCata :: PP_Doc + _hdIppD :: PP_Doc + _hdIppDI :: ([PP_Doc]) + _hdIppL :: PP_Doc + _hdIppLI :: ([PP_Doc]) + _hdIppR :: PP_Doc + _hdIppRA :: ([PP_Doc]) + _hdIppSF :: PP_Doc + _hdIppSPF :: PP_Doc + _hdIprdInh :: Attributes + _tlIhasMoreProds :: ( Bool ) + _tlIppA :: PP_Doc + _tlIppCata :: PP_Doc + _tlIppDL :: ([PP_Doc]) + _tlIppL :: PP_Doc + _tlIppLI :: ([PP_Doc]) + _tlIppR :: PP_Doc + _tlIppRA :: ([PP_Doc]) + _tlIppSF :: PP_Doc + _tlIppSPF :: PP_Doc + _tlIprdInh :: Attributes + -- "./src-ag/AG2AspectAG.ag"(line 62, column 11) + _hdOinhNoGroup = + ({-# LINE 62 "./src-ag/AG2AspectAG.ag" #-} + filter (flip Map.member _hdIprdInh . identifier) _lhsIinhNoGroup + {-# LINE 2977 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 234, column 33) + _lhsOppDL = + ({-# LINE 234 "./src-ag/AG2AspectAG.ag" #-} + _hdIppD : _tlIppDL + {-# LINE 2983 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 101, column 51) + _lhsOhasMoreProds = + ({-# LINE 101 "./src-ag/AG2AspectAG.ag" #-} + _hdIhasMoreProds || _tlIhasMoreProds + {-# LINE 2989 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 321, column 64) + _lhsOppA = + ({-# LINE 321 "./src-ag/AG2AspectAG.ag" #-} + _hdIppA >-< _tlIppA + {-# LINE 2995 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 732, column 67) + _lhsOppCata = + ({-# LINE 732 "./src-ag/AG2AspectAG.ag" #-} + _hdIppCata >-< _tlIppCata + {-# LINE 3001 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 259, column 79) + _lhsOppL = + ({-# LINE 259 "./src-ag/AG2AspectAG.ag" #-} + _hdIppL >-< _tlIppL + {-# LINE 3007 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 259, column 112) + _lhsOppLI = + ({-# LINE 259 "./src-ag/AG2AspectAG.ag" #-} + _hdIppLI ++ _tlIppLI + {-# LINE 3013 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 418, column 79) + _lhsOppR = + ({-# LINE 418 "./src-ag/AG2AspectAG.ag" #-} + _hdIppR >-< _tlIppR + {-# LINE 3019 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 419, column 43) + _lhsOppRA = + ({-# LINE 419 "./src-ag/AG2AspectAG.ag" #-} + _hdIppRA ++ _tlIppRA + {-# LINE 3025 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 773, column 66) + _lhsOppSF = + ({-# LINE 773 "./src-ag/AG2AspectAG.ag" #-} + _hdIppSF >-< _tlIppSF + {-# LINE 3031 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 774, column 42) + _lhsOppSPF = + ({-# LINE 774 "./src-ag/AG2AspectAG.ag" #-} + _hdIppSPF >-< _tlIppSPF + {-# LINE 3037 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 65, column 57) + _lhsOprdInh = + ({-# LINE 65 "./src-ag/AG2AspectAG.ag" #-} + _hdIprdInh `Map.union` _tlIprdInh + {-# LINE 3043 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOext = + ({-# LINE 119 "./src-ag/AG2AspectAG.ag" #-} + _lhsIext + {-# LINE 3049 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 763 "./src-ag/AG2AspectAG.ag" #-} + _lhsIinh + {-# LINE 3055 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 3061 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOnewAtts = + ({-# LINE 78 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewAtts + {-# LINE 3067 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOnewNT = + ({-# LINE 411 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewNT + {-# LINE 3073 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOnewProds = + ({-# LINE 86 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewProds + {-# LINE 3079 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOo_noGroup = + ({-# LINE 45 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_noGroup + {-# LINE 3085 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 41 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 3091 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOppNt = + ({-# LINE 187 "./src-ag/AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 3097 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 763 "./src-ag/AG2AspectAG.ag" #-} + _lhsIsyn + {-# LINE 3103 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 3109 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOsynNoGroup = + ({-# LINE 55 "./src-ag/AG2AspectAG.ag" #-} + _lhsIsynNoGroup + {-# LINE 3115 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOext = + ({-# LINE 119 "./src-ag/AG2AspectAG.ag" #-} + _lhsIext + {-# LINE 3121 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 763 "./src-ag/AG2AspectAG.ag" #-} + _lhsIinh + {-# LINE 3127 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 3133 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOinhNoGroup = + ({-# LINE 55 "./src-ag/AG2AspectAG.ag" #-} + _lhsIinhNoGroup + {-# LINE 3139 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOnewAtts = + ({-# LINE 78 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewAtts + {-# LINE 3145 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOnewNT = + ({-# LINE 411 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewNT + {-# LINE 3151 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOnewProds = + ({-# LINE 86 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewProds + {-# LINE 3157 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOo_noGroup = + ({-# LINE 45 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_noGroup + {-# LINE 3163 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 41 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_rename + {-# LINE 3169 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOppNt = + ({-# LINE 187 "./src-ag/AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 3175 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 763 "./src-ag/AG2AspectAG.ag" #-} + _lhsIsyn + {-# LINE 3181 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 3187 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOsynNoGroup = + ({-# LINE 55 "./src-ag/AG2AspectAG.ag" #-} + _lhsIsynNoGroup + {-# LINE 3193 "dist/build/AG2AspectAG.hs" #-} + ) + ( _hdIhasMoreProds,_hdIppA,_hdIppCata,_hdIppD,_hdIppDI,_hdIppL,_hdIppLI,_hdIppR,_hdIppRA,_hdIppSF,_hdIppSPF,_hdIprdInh) = + hd_ _hdOext _hdOinh _hdOinhMap _hdOinhNoGroup _hdOnewAtts _hdOnewNT _hdOnewProds _hdOo_noGroup _hdOo_rename _hdOppNt _hdOsyn _hdOsynMap _hdOsynNoGroup + ( _tlIhasMoreProds,_tlIppA,_tlIppCata,_tlIppDL,_tlIppL,_tlIppLI,_tlIppR,_tlIppRA,_tlIppSF,_tlIppSPF,_tlIprdInh) = + tl_ _tlOext _tlOinh _tlOinhMap _tlOinhNoGroup _tlOnewAtts _tlOnewNT _tlOnewProds _tlOo_noGroup _tlOo_rename _tlOppNt _tlOsyn _tlOsynMap _tlOsynNoGroup + in ( _lhsOhasMoreProds,_lhsOppA,_lhsOppCata,_lhsOppDL,_lhsOppL,_lhsOppLI,_lhsOppR,_lhsOppRA,_lhsOppSF,_lhsOppSPF,_lhsOprdInh)))) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (\ _lhsIext + _lhsIinh + _lhsIinhMap + _lhsIinhNoGroup + _lhsInewAtts + _lhsInewNT + _lhsInewProds + _lhsIo_noGroup + _lhsIo_rename + _lhsIppNt + _lhsIsyn + _lhsIsynMap + _lhsIsynNoGroup -> + (let _lhsOppDL :: ([PP_Doc]) + _lhsOhasMoreProds :: ( Bool ) + _lhsOppA :: PP_Doc + _lhsOppCata :: PP_Doc + _lhsOppL :: PP_Doc + _lhsOppLI :: ([PP_Doc]) + _lhsOppR :: PP_Doc + _lhsOppRA :: ([PP_Doc]) + _lhsOppSF :: PP_Doc + _lhsOppSPF :: PP_Doc + _lhsOprdInh :: Attributes + -- "./src-ag/AG2AspectAG.ag"(line 235, column 33) + _lhsOppDL = + ({-# LINE 235 "./src-ag/AG2AspectAG.ag" #-} + [] + {-# LINE 3230 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 101, column 51) + _lhsOhasMoreProds = + ({-# LINE 101 "./src-ag/AG2AspectAG.ag" #-} + False + {-# LINE 3236 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 321, column 64) + _lhsOppA = + ({-# LINE 321 "./src-ag/AG2AspectAG.ag" #-} + empty + {-# LINE 3242 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 732, column 67) + _lhsOppCata = + ({-# LINE 732 "./src-ag/AG2AspectAG.ag" #-} + empty + {-# LINE 3248 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 259, column 79) + _lhsOppL = + ({-# LINE 259 "./src-ag/AG2AspectAG.ag" #-} + empty + {-# LINE 3254 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 259, column 112) + _lhsOppLI = + ({-# LINE 259 "./src-ag/AG2AspectAG.ag" #-} + [] + {-# LINE 3260 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 418, column 79) + _lhsOppR = + ({-# LINE 418 "./src-ag/AG2AspectAG.ag" #-} + empty + {-# LINE 3266 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 419, column 43) + _lhsOppRA = + ({-# LINE 419 "./src-ag/AG2AspectAG.ag" #-} + [] + {-# LINE 3272 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 773, column 66) + _lhsOppSF = + ({-# LINE 773 "./src-ag/AG2AspectAG.ag" #-} + empty + {-# LINE 3278 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 774, column 42) + _lhsOppSPF = + ({-# LINE 774 "./src-ag/AG2AspectAG.ag" #-} + empty + {-# LINE 3284 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 65, column 57) + _lhsOprdInh = + ({-# LINE 65 "./src-ag/AG2AspectAG.ag" #-} + Map.empty + {-# LINE 3290 "dist/build/AG2AspectAG.hs" #-} + ) + in ( _lhsOhasMoreProds,_lhsOppA,_lhsOppCata,_lhsOppDL,_lhsOppL,_lhsOppLI,_lhsOppR,_lhsOppRA,_lhsOppSF,_lhsOppSPF,_lhsOprdInh)))) +-- Rule -------------------------------------------------------- +{- + visit 0: + inherited attributes: + ext : Maybe String + inhNoGroup : [String] + newAtts : Attributes + newProd : Bool + o_noGroup : [String] + ppNt : PP_Doc + ppProd : PP_Doc + synNoGroup : [String] + synthesized attributes: + locals : [Identifier] + ppRL : [ PPRule ] + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + child pure : {Bool} + child identity : {Bool} + child mbError : {Maybe Error} + child eager : {Bool} +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit _pure _identity _mbError _eager) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin _explicit _pure _identity _mbError _eager) +-- semantic domain +newtype T_Rule = T_Rule ((Maybe String) -> + ([String]) -> + ( Attributes ) -> + Bool -> + ([String]) -> + PP_Doc -> + PP_Doc -> + ([String]) -> + ( ([Identifier]),([ PPRule ]))) +data Inh_Rule = Inh_Rule {ext_Inh_Rule :: (Maybe String),inhNoGroup_Inh_Rule :: ([String]),newAtts_Inh_Rule :: ( Attributes ),newProd_Inh_Rule :: Bool,o_noGroup_Inh_Rule :: ([String]),ppNt_Inh_Rule :: PP_Doc,ppProd_Inh_Rule :: PP_Doc,synNoGroup_Inh_Rule :: ([String])} +data Syn_Rule = Syn_Rule {locals_Syn_Rule :: ([Identifier]),ppRL_Syn_Rule :: ([ PPRule ])} +wrap_Rule :: T_Rule -> + Inh_Rule -> + Syn_Rule +wrap_Rule (T_Rule sem) (Inh_Rule _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) = + (let ( _lhsOlocals,_lhsOppRL) = sem _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup + in (Syn_Rule _lhsOlocals _lhsOppRL)) +sem_Rule_Rule :: (Maybe Identifier) -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + Bool -> + Bool -> + (Maybe Error) -> + Bool -> + T_Rule +sem_Rule_Rule mbName_ (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ = + (T_Rule (\ _lhsIext + _lhsIinhNoGroup + _lhsInewAtts + _lhsInewProd + _lhsIo_noGroup + _lhsIppNt + _lhsIppProd + _lhsIsynNoGroup -> + (let _lhsOlocals :: ([Identifier]) + _lhsOppRL :: ([ PPRule ]) + _rhsOppNt :: PP_Doc + _rhsOppProd :: PP_Doc + _patternIcopy :: Pattern + _patternIinfo :: ((Identifier, Identifier)) + _rhsIppRE :: ([String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc) + -- "./src-ag/AG2AspectAG.ag"(line 375, column 25) + _lhsOlocals = + ({-# LINE 375 "./src-ag/AG2AspectAG.ag" #-} + if (show (fst _patternIinfo) == "loc") + then [ snd _patternIinfo ] + else [ ] + {-# LINE 3377 "dist/build/AG2AspectAG.hs" #-} + ) + -- "./src-ag/AG2AspectAG.ag"(line 472, column 33) + _lhsOppRL = + ({-# LINE 472 "./src-ag/AG2AspectAG.ag" #-} + if (not explicit_ && not _lhsInewProd && not (Map.member (snd _patternIinfo) _lhsInewAtts) ) + then [] + else [ ppRule _patternIinfo owrt_ (defRule _lhsIppNt _patternIinfo _lhsIo_noGroup _rhsIppRE) ] + {-# LINE 3385 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _rhsOppNt = + ({-# LINE 187 "./src-ag/AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 3391 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _rhsOppProd = + ({-# LINE 192 "./src-ag/AG2AspectAG.ag" #-} + _lhsIppProd + {-# LINE 3397 "dist/build/AG2AspectAG.hs" #-} + ) + ( _patternIcopy,_patternIinfo) = + pattern_ + ( _rhsIppRE) = + rhs_ _rhsOppNt _rhsOppProd + in ( _lhsOlocals,_lhsOppRL)))) +-- Rules ------------------------------------------------------- +{- + visit 0: + inherited attributes: + ext : Maybe String + inhNoGroup : [String] + newAtts : Attributes + newProd : Bool + o_noGroup : [String] + ppNt : PP_Doc + ppProd : PP_Doc + synNoGroup : [String] + synthesized attributes: + locals : [Identifier] + ppRL : [ PPRule ] + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + alternative Nil: +-} +-- 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 ((Maybe String) -> + ([String]) -> + ( Attributes ) -> + Bool -> + ([String]) -> + PP_Doc -> + PP_Doc -> + ([String]) -> + ( ([Identifier]),([ PPRule ]))) +data Inh_Rules = Inh_Rules {ext_Inh_Rules :: (Maybe String),inhNoGroup_Inh_Rules :: ([String]),newAtts_Inh_Rules :: ( Attributes ),newProd_Inh_Rules :: Bool,o_noGroup_Inh_Rules :: ([String]),ppNt_Inh_Rules :: PP_Doc,ppProd_Inh_Rules :: PP_Doc,synNoGroup_Inh_Rules :: ([String])} +data Syn_Rules = Syn_Rules {locals_Syn_Rules :: ([Identifier]),ppRL_Syn_Rules :: ([ PPRule ])} +wrap_Rules :: T_Rules -> + Inh_Rules -> + Syn_Rules +wrap_Rules (T_Rules sem) (Inh_Rules _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) = + (let ( _lhsOlocals,_lhsOppRL) = sem _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup + in (Syn_Rules _lhsOlocals _lhsOppRL)) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) = + (T_Rules (\ _lhsIext + _lhsIinhNoGroup + _lhsInewAtts + _lhsInewProd + _lhsIo_noGroup + _lhsIppNt + _lhsIppProd + _lhsIsynNoGroup -> + (let _lhsOppRL :: ([ PPRule ]) + _lhsOlocals :: ([Identifier]) + _hdOext :: (Maybe String) + _hdOinhNoGroup :: ([String]) + _hdOnewAtts :: ( Attributes ) + _hdOnewProd :: Bool + _hdOo_noGroup :: ([String]) + _hdOppNt :: PP_Doc + _hdOppProd :: PP_Doc + _hdOsynNoGroup :: ([String]) + _tlOext :: (Maybe String) + _tlOinhNoGroup :: ([String]) + _tlOnewAtts :: ( Attributes ) + _tlOnewProd :: Bool + _tlOo_noGroup :: ([String]) + _tlOppNt :: PP_Doc + _tlOppProd :: PP_Doc + _tlOsynNoGroup :: ([String]) + _hdIlocals :: ([Identifier]) + _hdIppRL :: ([ PPRule ]) + _tlIlocals :: ([Identifier]) + _tlIppRL :: ([ PPRule ]) + -- "./src-ag/AG2AspectAG.ag"(line 468, column 33) + _lhsOppRL = + ({-# LINE 468 "./src-ag/AG2AspectAG.ag" #-} + _hdIppRL ++ _tlIppRL + {-# LINE 3486 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 371, column 30) + _lhsOlocals = + ({-# LINE 371 "./src-ag/AG2AspectAG.ag" #-} + _hdIlocals ++ _tlIlocals + {-# LINE 3492 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOext = + ({-# LINE 119 "./src-ag/AG2AspectAG.ag" #-} + _lhsIext + {-# LINE 3498 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOinhNoGroup = + ({-# LINE 55 "./src-ag/AG2AspectAG.ag" #-} + _lhsIinhNoGroup + {-# LINE 3504 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOnewAtts = + ({-# LINE 78 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewAtts + {-# LINE 3510 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOnewProd = + ({-# LINE 412 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewProd + {-# LINE 3516 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOo_noGroup = + ({-# LINE 45 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_noGroup + {-# LINE 3522 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOppNt = + ({-# LINE 187 "./src-ag/AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 3528 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOppProd = + ({-# LINE 192 "./src-ag/AG2AspectAG.ag" #-} + _lhsIppProd + {-# LINE 3534 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _hdOsynNoGroup = + ({-# LINE 55 "./src-ag/AG2AspectAG.ag" #-} + _lhsIsynNoGroup + {-# LINE 3540 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOext = + ({-# LINE 119 "./src-ag/AG2AspectAG.ag" #-} + _lhsIext + {-# LINE 3546 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOinhNoGroup = + ({-# LINE 55 "./src-ag/AG2AspectAG.ag" #-} + _lhsIinhNoGroup + {-# LINE 3552 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOnewAtts = + ({-# LINE 78 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewAtts + {-# LINE 3558 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOnewProd = + ({-# LINE 412 "./src-ag/AG2AspectAG.ag" #-} + _lhsInewProd + {-# LINE 3564 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOo_noGroup = + ({-# LINE 45 "./src-ag/AG2AspectAG.ag" #-} + _lhsIo_noGroup + {-# LINE 3570 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOppNt = + ({-# LINE 187 "./src-ag/AG2AspectAG.ag" #-} + _lhsIppNt + {-# LINE 3576 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOppProd = + ({-# LINE 192 "./src-ag/AG2AspectAG.ag" #-} + _lhsIppProd + {-# LINE 3582 "dist/build/AG2AspectAG.hs" #-} + ) + -- copy rule (down) + _tlOsynNoGroup = + ({-# LINE 55 "./src-ag/AG2AspectAG.ag" #-} + _lhsIsynNoGroup + {-# LINE 3588 "dist/build/AG2AspectAG.hs" #-} + ) + ( _hdIlocals,_hdIppRL) = + hd_ _hdOext _hdOinhNoGroup _hdOnewAtts _hdOnewProd _hdOo_noGroup _hdOppNt _hdOppProd _hdOsynNoGroup + ( _tlIlocals,_tlIppRL) = + tl_ _tlOext _tlOinhNoGroup _tlOnewAtts _tlOnewProd _tlOo_noGroup _tlOppNt _tlOppProd _tlOsynNoGroup + in ( _lhsOlocals,_lhsOppRL)))) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (\ _lhsIext + _lhsIinhNoGroup + _lhsInewAtts + _lhsInewProd + _lhsIo_noGroup + _lhsIppNt + _lhsIppProd + _lhsIsynNoGroup -> + (let _lhsOppRL :: ([ PPRule ]) + _lhsOlocals :: ([Identifier]) + -- "./src-ag/AG2AspectAG.ag"(line 469, column 33) + _lhsOppRL = + ({-# LINE 469 "./src-ag/AG2AspectAG.ag" #-} + [] + {-# LINE 3611 "dist/build/AG2AspectAG.hs" #-} + ) + -- use rule "./src-ag/AG2AspectAG.ag"(line 371, column 30) + _lhsOlocals = + ({-# LINE 371 "./src-ag/AG2AspectAG.ag" #-} + [] + {-# LINE 3617 "dist/build/AG2AspectAG.hs" #-} + ) + in ( _lhsOlocals,_lhsOppRL)))) +-- TypeSig ----------------------------------------------------- +{- + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig (TypeSig _name _tp) = + (sem_TypeSig_TypeSig _name _tp) +-- semantic domain +newtype T_TypeSig = T_TypeSig (( )) +data Inh_TypeSig = Inh_TypeSig {} +data Syn_TypeSig = Syn_TypeSig {} +wrap_TypeSig :: T_TypeSig -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig) = + (let ( ) = sem + in (Syn_TypeSig)) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig name_ tp_ = + (T_TypeSig (let + in ( ))) +-- TypeSigs ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + alternative Nil: +-} +-- 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 (( )) +data Inh_TypeSigs = Inh_TypeSigs {} +data Syn_TypeSigs = Syn_TypeSigs {} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs) = + (let ( ) = sem + in (Syn_TypeSigs)) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons (T_TypeSig hd_) (T_TypeSigs tl_) = + (T_TypeSigs (let + in ( ))) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (let + in ( ))) diff --git a/dist/build/AbstractSyntax.hs b/dist/build/AbstractSyntax.hs new file mode 100644 --- /dev/null +++ b/dist/build/AbstractSyntax.hs @@ -0,0 +1,137 @@ + + +-- UUAGC 0.9.42.0 (src-ag/AbstractSyntax.ag) +module AbstractSyntax where +{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import Macro --marcos +import CommonTypes +import ErrorMessages +{-# LINE 16 "dist/build/AbstractSyntax.hs" #-} +-- Child ------------------------------------------------------- +{- + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child kind : {ChildKind} +-} +data Child = Child (Identifier) (Type) (ChildKind) +-- Children ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Child + child tl : Children + alternative Nil: +-} +type Children = [Child] +-- Grammar ----------------------------------------------------- +{- + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} +-} +data Grammar = Grammar (TypeSyns) (UseMap) (Derivings) ((Set NontermIdent)) (Nonterminals) (PragmaMap) (AttrOrderMap) (ParamMap) (ContextMap) (QuantMap) (UniqueMap) ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))) ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))) ((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))))) +-- Nonterminal ------------------------------------------------- +{- + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions +-} +data Nonterminal = Nonterminal (NontermIdent) (([Identifier])) (Attributes) (Attributes) (Productions) +-- Nonterminals ------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + alternative Nil: +-} +type Nonterminals = [Nonterminal] +-- Production -------------------------------------------------- +{- + alternatives: + alternative Production: + child con : {ConstructorIdent} + child params : {[Identifier]} + child constraints : {[Type]} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + child macro : {MaybeMacro} +-} +data Production = Production (ConstructorIdent) (([Identifier])) (([Type])) (Children) (Rules) (TypeSigs) (MaybeMacro) +-- Productions ------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + alternative Nil: +-} +type Productions = [Production] +-- Rule -------------------------------------------------------- +{- + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : {Pattern} + child rhs : {Expression} + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + child pure : {Bool} + child identity : {Bool} + child mbError : {Maybe Error} + child eager : {Bool} +-} +data Rule = Rule ((Maybe Identifier)) (Pattern) (Expression) (Bool) (String) (Bool) (Bool) (Bool) ((Maybe Error)) (Bool) +-- Rules ------------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + alternative Nil: +-} +type Rules = [Rule] +-- TypeSig ----------------------------------------------------- +{- + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} +-} +data TypeSig = TypeSig (Identifier) (Type) +-- TypeSigs ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + alternative Nil: +-} +type TypeSigs = [TypeSig] diff --git a/dist/build/AbstractSyntaxDump.hs b/dist/build/AbstractSyntaxDump.hs new file mode 100644 --- /dev/null +++ b/dist/build/AbstractSyntaxDump.hs @@ -0,0 +1,1040 @@ + + +-- UUAGC 0.9.42.0 (src-ag/AbstractSyntaxDump.ag) +module AbstractSyntaxDump where +{-# LINE 6 "./src-ag/AbstractSyntaxDump.ag" #-} + +import Data.List +import qualified Data.Map as Map + +import Pretty +import PPUtil + +import AbstractSyntax +import TokenDef +{-# LINE 16 "dist/build/AbstractSyntaxDump.hs" #-} + +{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import Macro --marcos +import CommonTypes +import ErrorMessages +{-# LINE 28 "dist/build/AbstractSyntaxDump.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 35 "dist/build/AbstractSyntaxDump.hs" #-} + +{-# LINE 2 "./src-ag/Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 41 "dist/build/AbstractSyntaxDump.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child kind : {ChildKind} +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child (Child _name _tp _kind) = + (sem_Child_Child _name _tp _kind) +-- semantic domain +newtype T_Child = T_Child (( PP_Doc)) +data Inh_Child = Inh_Child {} +data Syn_Child = Syn_Child {pp_Syn_Child :: PP_Doc} +wrap_Child :: T_Child -> + Inh_Child -> + Syn_Child +wrap_Child (T_Child sem) (Inh_Child) = + (let ( _lhsOpp) = sem + in (Syn_Child _lhsOpp)) +sem_Child_Child :: Identifier -> + Type -> + ChildKind -> + T_Child +sem_Child_Child name_ tp_ kind_ = + (T_Child (let _lhsOpp :: PP_Doc + -- "./src-ag/AbstractSyntaxDump.ag"(line 35, column 33) + _lhsOpp = + ({-# LINE 35 "./src-ag/AbstractSyntaxDump.ag" #-} + ppNestInfo ["Child","Child"] [pp name_, ppShow tp_] [ppF "kind" $ ppShow kind_] [] + {-# LINE 78 "dist/build/AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp))) +-- Children ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : Child + child tl : Children + alternative Nil: +-} +-- 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 (( PP_Doc,([PP_Doc]))) +data Inh_Children = Inh_Children {} +data Syn_Children = Syn_Children {pp_Syn_Children :: PP_Doc,ppL_Syn_Children :: ([PP_Doc])} +wrap_Children :: T_Children -> + Inh_Children -> + Syn_Children +wrap_Children (T_Children sem) (Inh_Children) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_Children _lhsOpp _lhsOppL)) +sem_Children_Cons :: T_Child -> + T_Children -> + T_Children +sem_Children_Cons (T_Child hd_) (T_Children tl_) = + (T_Children (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "./src-ag/AbstractSyntaxDump.ag"(line 67, column 33) + _lhsOppL = + ({-# LINE 67 "./src-ag/AbstractSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 121 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "./src-ag/AbstractSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 127 "dist/build/AbstractSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL))) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "./src-ag/AbstractSyntaxDump.ag"(line 68, column 33) + _lhsOppL = + ({-# LINE 68 "./src-ag/AbstractSyntaxDump.ag" #-} + [] + {-# LINE 142 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "./src-ag/AbstractSyntaxDump.ag" #-} + empty + {-# LINE 148 "dist/build/AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL))) +-- Expression -------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression _pos _tks) = + (sem_Expression_Expression _pos _tks) +-- semantic domain +newtype T_Expression = T_Expression (( PP_Doc)) +data Inh_Expression = Inh_Expression {} +data Syn_Expression = Syn_Expression {pp_Syn_Expression :: PP_Doc} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem) (Inh_Expression) = + (let ( _lhsOpp) = sem + in (Syn_Expression _lhsOpp)) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (let _lhsOpp :: PP_Doc + -- "./src-ag/AbstractSyntaxDump.ag"(line 50, column 25) + _lhsOpp = + ({-# LINE 50 "./src-ag/AbstractSyntaxDump.ag" #-} + ppNestInfo ["Expression","Expression"] [ppShow pos_] [ppF "txt" $ vlist . showTokens . tokensToStrings $ tks_] [] + {-# LINE 185 "dist/build/AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp))) +-- Grammar ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) +-- semantic domain +newtype T_Grammar = T_Grammar (( PP_Doc)) +data Inh_Grammar = Inh_Grammar {} +data Syn_Grammar = Syn_Grammar {pp_Syn_Grammar :: PP_Doc} +wrap_Grammar :: T_Grammar -> + Inh_Grammar -> + Syn_Grammar +wrap_Grammar (T_Grammar sem) (Inh_Grammar) = + (let ( _lhsOpp) = sem + in (Syn_Grammar _lhsOpp)) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ = + (T_Grammar (let _lhsOpp :: PP_Doc + _nontsIpp :: PP_Doc + _nontsIppL :: ([PP_Doc]) + -- "./src-ag/AbstractSyntaxDump.ag"(line 20, column 25) + _lhsOpp = + ({-# LINE 20 "./src-ag/AbstractSyntaxDump.ag" #-} + ppNestInfo ["Grammar","Grammar"] [] + [ ppF "typeSyns" $ ppAssocL typeSyns_ + , ppF "useMap" $ ppMap $ Map.map ppMap $ useMap_ + , ppF "derivings" $ ppMap $ derivings_ + , ppF "wrappers" $ ppShow $ wrappers_ + , ppF "nonts" $ ppVList _nontsIppL + ] [] + {-# LINE 254 "dist/build/AbstractSyntaxDump.hs" #-} + ) + ( _nontsIpp,_nontsIppL) = + nonts_ + in ( _lhsOpp))) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions +-} +-- 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 (( PP_Doc)) +data Inh_Nonterminal = Inh_Nonterminal {} +data Syn_Nonterminal = Syn_Nonterminal {pp_Syn_Nonterminal :: PP_Doc} +wrap_Nonterminal :: T_Nonterminal -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal) = + (let ( _lhsOpp) = sem + in (Syn_Nonterminal _lhsOpp)) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) = + (T_Nonterminal (let _lhsOpp :: PP_Doc + _prodsIpp :: PP_Doc + _prodsIppL :: ([PP_Doc]) + -- "./src-ag/AbstractSyntaxDump.ag"(line 29, column 25) + _lhsOpp = + ({-# LINE 29 "./src-ag/AbstractSyntaxDump.ag" #-} + ppNestInfo ["Nonterminal","Nonterminal"] (pp nt_ : map pp params_) [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "prods" $ ppVList _prodsIppL] [] + {-# LINE 301 "dist/build/AbstractSyntaxDump.hs" #-} + ) + ( _prodsIpp,_prodsIppL) = + prods_ + in ( _lhsOpp))) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + alternative Nil: +-} +-- 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 (( PP_Doc,([PP_Doc]))) +data Inh_Nonterminals = Inh_Nonterminals {} +data Syn_Nonterminals = Syn_Nonterminals {pp_Syn_Nonterminals :: PP_Doc,ppL_Syn_Nonterminals :: ([PP_Doc])} +wrap_Nonterminals :: T_Nonterminals -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_Nonterminals _lhsOpp _lhsOppL)) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) = + (T_Nonterminals (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "./src-ag/AbstractSyntaxDump.ag"(line 75, column 33) + _lhsOppL = + ({-# LINE 75 "./src-ag/AbstractSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 346 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "./src-ag/AbstractSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 352 "dist/build/AbstractSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL))) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "./src-ag/AbstractSyntaxDump.ag"(line 76, column 33) + _lhsOppL = + ({-# LINE 76 "./src-ag/AbstractSyntaxDump.ag" #-} + [] + {-# LINE 367 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "./src-ag/AbstractSyntaxDump.ag" #-} + empty + {-# LINE 373 "dist/build/AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : Pattern + pp : PP_Doc + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern (Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern (Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern (Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +sem_Pattern (Underscore _pos) = + (sem_Pattern_Underscore _pos) +-- semantic domain +newtype T_Pattern = T_Pattern (( Pattern,PP_Doc)) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,pp_Syn_Pattern :: PP_Doc} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem) (Inh_Pattern) = + (let ( _lhsOcopy,_lhsOpp) = sem + in (Syn_Pattern _lhsOcopy _lhsOpp)) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIpp :: PP_Doc + _patsIppL :: ([PP_Doc]) + -- "./src-ag/AbstractSyntaxDump.ag"(line 44, column 33) + _lhsOpp = + ({-# LINE 44 "./src-ag/AbstractSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] [] + {-# LINE 444 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 450 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 456 "dist/build/AbstractSyntaxDump.hs" #-} + ) + ( _patsIcopy,_patsIpp,_patsIppL) = + pats_ + in ( _lhsOcopy,_lhsOpp))) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIpp :: PP_Doc + _patsIppL :: ([PP_Doc]) + -- "./src-ag/AbstractSyntaxDump.ag"(line 45, column 33) + _lhsOpp = + ({-# LINE 45 "./src-ag/AbstractSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] [] + {-# LINE 474 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 480 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 486 "dist/build/AbstractSyntaxDump.hs" #-} + ) + ( _patsIcopy,_patsIpp,_patsIppL) = + pats_ + in ( _lhsOcopy,_lhsOpp))) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIpp :: PP_Doc + -- "./src-ag/AbstractSyntaxDump.ag"(line 46, column 33) + _lhsOpp = + ({-# LINE 46 "./src-ag/AbstractSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] [] + {-# LINE 504 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 510 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 516 "dist/build/AbstractSyntaxDump.hs" #-} + ) + ( _patIcopy,_patIpp) = + pat_ + in ( _lhsOcopy,_lhsOpp))) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIpp :: PP_Doc + -- use rule "./src-ag/AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "./src-ag/AbstractSyntaxDump.ag" #-} + _patIpp + {-# LINE 532 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 538 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 544 "dist/build/AbstractSyntaxDump.hs" #-} + ) + ( _patIcopy,_patIpp) = + pat_ + in ( _lhsOcopy,_lhsOpp))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + -- "./src-ag/AbstractSyntaxDump.ag"(line 47, column 25) + _lhsOpp = + ({-# LINE 47 "./src-ag/AbstractSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] [] + {-# LINE 558 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 564 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 570 "dist/build/AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOcopy,_lhsOpp))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : Patterns + pp : PP_Doc + ppL : [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 (( Patterns,PP_Doc,([PP_Doc]))) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,pp_Syn_Patterns :: PP_Doc,ppL_Syn_Patterns :: ([PP_Doc])} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem) (Inh_Patterns) = + (let ( _lhsOcopy,_lhsOpp,_lhsOppL) = sem + in (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = + (T_Patterns (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _lhsOcopy :: Patterns + _hdIcopy :: Pattern + _hdIpp :: PP_Doc + _tlIcopy :: Patterns + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "./src-ag/AbstractSyntaxDump.ag"(line 55, column 33) + _lhsOppL = + ({-# LINE 55 "./src-ag/AbstractSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 621 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "./src-ag/AbstractSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 627 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 633 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 639 "dist/build/AbstractSyntaxDump.hs" #-} + ) + ( _hdIcopy,_hdIpp) = + hd_ + ( _tlIcopy,_tlIpp,_tlIppL) = + tl_ + in ( _lhsOcopy,_lhsOpp,_lhsOppL))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _lhsOcopy :: Patterns + -- "./src-ag/AbstractSyntaxDump.ag"(line 56, column 33) + _lhsOppL = + ({-# LINE 56 "./src-ag/AbstractSyntaxDump.ag" #-} + [] + {-# LINE 655 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "./src-ag/AbstractSyntaxDump.ag" #-} + empty + {-# LINE 661 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 667 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 673 "dist/build/AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOcopy,_lhsOpp,_lhsOppL))) +-- Production -------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Production: + child con : {ConstructorIdent} + child params : {[Identifier]} + child constraints : {[Type]} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + child macro : {MaybeMacro} +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production (Production _con _params _constraints _children _rules _typeSigs _macro) = + (sem_Production_Production _con _params _constraints (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs) _macro) +-- semantic domain +newtype T_Production = T_Production (( PP_Doc)) +data Inh_Production = Inh_Production {} +data Syn_Production = Syn_Production {pp_Syn_Production :: PP_Doc} +wrap_Production :: T_Production -> + Inh_Production -> + Syn_Production +wrap_Production (T_Production sem) (Inh_Production) = + (let ( _lhsOpp) = sem + in (Syn_Production _lhsOpp)) +sem_Production_Production :: ConstructorIdent -> + ([Identifier]) -> + ([Type]) -> + T_Children -> + T_Rules -> + T_TypeSigs -> + MaybeMacro -> + T_Production +sem_Production_Production con_ params_ constraints_ (T_Children children_) (T_Rules rules_) (T_TypeSigs typeSigs_) macro_ = + (T_Production (let _lhsOpp :: PP_Doc + _childrenIpp :: PP_Doc + _childrenIppL :: ([PP_Doc]) + _rulesIpp :: PP_Doc + _rulesIppL :: ([PP_Doc]) + _typeSigsIpp :: PP_Doc + _typeSigsIppL :: ([PP_Doc]) + -- "./src-ag/AbstractSyntaxDump.ag"(line 32, column 25) + _lhsOpp = + ({-# LINE 32 "./src-ag/AbstractSyntaxDump.ag" #-} + ppNestInfo ["Production","Production"] [pp con_] [ppF "children" $ ppVList _childrenIppL,ppF "rules" $ ppVList _rulesIppL,ppF "typeSigs" $ ppVList _typeSigsIppL] [] + {-# LINE 726 "dist/build/AbstractSyntaxDump.hs" #-} + ) + ( _childrenIpp,_childrenIppL) = + children_ + ( _rulesIpp,_rulesIppL) = + rules_ + ( _typeSigsIpp,_typeSigsIppL) = + typeSigs_ + in ( _lhsOpp))) +-- Productions ------------------------------------------------- +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + alternative Nil: +-} +-- 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 (( PP_Doc,([PP_Doc]))) +data Inh_Productions = Inh_Productions {} +data Syn_Productions = Syn_Productions {pp_Syn_Productions :: PP_Doc,ppL_Syn_Productions :: ([PP_Doc])} +wrap_Productions :: T_Productions -> + Inh_Productions -> + Syn_Productions +wrap_Productions (T_Productions sem) (Inh_Productions) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_Productions _lhsOpp _lhsOppL)) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons (T_Production hd_) (T_Productions tl_) = + (T_Productions (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "./src-ag/AbstractSyntaxDump.ag"(line 71, column 33) + _lhsOppL = + ({-# LINE 71 "./src-ag/AbstractSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 775 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "./src-ag/AbstractSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 781 "dist/build/AbstractSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL))) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "./src-ag/AbstractSyntaxDump.ag"(line 72, column 33) + _lhsOppL = + ({-# LINE 72 "./src-ag/AbstractSyntaxDump.ag" #-} + [] + {-# LINE 796 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "./src-ag/AbstractSyntaxDump.ag" #-} + empty + {-# LINE 802 "dist/build/AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL))) +-- Rule -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + child pure : {Bool} + child identity : {Bool} + child mbError : {Maybe Error} + child eager : {Bool} +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit _pure _identity _mbError _eager) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin _explicit _pure _identity _mbError _eager) +-- semantic domain +newtype T_Rule = T_Rule (( PP_Doc)) +data Inh_Rule = Inh_Rule {} +data Syn_Rule = Syn_Rule {pp_Syn_Rule :: PP_Doc} +wrap_Rule :: T_Rule -> + Inh_Rule -> + Syn_Rule +wrap_Rule (T_Rule sem) (Inh_Rule) = + (let ( _lhsOpp) = sem + in (Syn_Rule _lhsOpp)) +sem_Rule_Rule :: (Maybe Identifier) -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + Bool -> + Bool -> + (Maybe Error) -> + Bool -> + T_Rule +sem_Rule_Rule mbName_ (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ = + (T_Rule (let _lhsOpp :: PP_Doc + _patternIcopy :: Pattern + _patternIpp :: PP_Doc + _rhsIpp :: PP_Doc + -- "./src-ag/AbstractSyntaxDump.ag"(line 38, column 33) + _lhsOpp = + ({-# LINE 38 "./src-ag/AbstractSyntaxDump.ag" #-} + ppNestInfo ["Rule","Rule"] [ppShow owrt_, pp origin_] [ppF "pattern" $ _patternIpp, ppF "rhs" $ _rhsIpp] [] + {-# LINE 858 "dist/build/AbstractSyntaxDump.hs" #-} + ) + ( _patternIcopy,_patternIpp) = + pattern_ + ( _rhsIpp) = + rhs_ + in ( _lhsOpp))) +-- Rules ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + alternative Nil: +-} +-- 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 (( PP_Doc,([PP_Doc]))) +data Inh_Rules = Inh_Rules {} +data Syn_Rules = Syn_Rules {pp_Syn_Rules :: PP_Doc,ppL_Syn_Rules :: ([PP_Doc])} +wrap_Rules :: T_Rules -> + Inh_Rules -> + Syn_Rules +wrap_Rules (T_Rules sem) (Inh_Rules) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_Rules _lhsOpp _lhsOppL)) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) = + (T_Rules (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "./src-ag/AbstractSyntaxDump.ag"(line 63, column 33) + _lhsOppL = + ({-# LINE 63 "./src-ag/AbstractSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 905 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "./src-ag/AbstractSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 911 "dist/build/AbstractSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL))) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "./src-ag/AbstractSyntaxDump.ag"(line 64, column 33) + _lhsOppL = + ({-# LINE 64 "./src-ag/AbstractSyntaxDump.ag" #-} + [] + {-# LINE 926 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "./src-ag/AbstractSyntaxDump.ag" #-} + empty + {-# LINE 932 "dist/build/AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL))) +-- TypeSig ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig (TypeSig _name _tp) = + (sem_TypeSig_TypeSig _name _tp) +-- semantic domain +newtype T_TypeSig = T_TypeSig (( PP_Doc)) +data Inh_TypeSig = Inh_TypeSig {} +data Syn_TypeSig = Syn_TypeSig {pp_Syn_TypeSig :: PP_Doc} +wrap_TypeSig :: T_TypeSig -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig) = + (let ( _lhsOpp) = sem + in (Syn_TypeSig _lhsOpp)) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig name_ tp_ = + (T_TypeSig (let _lhsOpp :: PP_Doc + -- "./src-ag/AbstractSyntaxDump.ag"(line 41, column 33) + _lhsOpp = + ({-# LINE 41 "./src-ag/AbstractSyntaxDump.ag" #-} + ppNestInfo ["TypeSig","TypeSig"] [pp name_, ppShow tp_] [] [] + {-# LINE 969 "dist/build/AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp))) +-- TypeSigs ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + alternative Nil: +-} +-- 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 (( PP_Doc,([PP_Doc]))) +data Inh_TypeSigs = Inh_TypeSigs {} +data Syn_TypeSigs = Syn_TypeSigs {pp_Syn_TypeSigs :: PP_Doc,ppL_Syn_TypeSigs :: ([PP_Doc])} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_TypeSigs _lhsOpp _lhsOppL)) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons (T_TypeSig hd_) (T_TypeSigs tl_) = + (T_TypeSigs (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "./src-ag/AbstractSyntaxDump.ag"(line 59, column 33) + _lhsOppL = + ({-# LINE 59 "./src-ag/AbstractSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 1012 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "./src-ag/AbstractSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 1018 "dist/build/AbstractSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL))) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "./src-ag/AbstractSyntaxDump.ag"(line 60, column 33) + _lhsOppL = + ({-# LINE 60 "./src-ag/AbstractSyntaxDump.ag" #-} + [] + {-# LINE 1033 "dist/build/AbstractSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/AbstractSyntaxDump.ag"(line 17, column 58) + _lhsOpp = + ({-# LINE 17 "./src-ag/AbstractSyntaxDump.ag" #-} + empty + {-# LINE 1039 "dist/build/AbstractSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL))) diff --git a/dist/build/Code.hs b/dist/build/Code.hs new file mode 100644 --- /dev/null +++ b/dist/build/Code.hs @@ -0,0 +1,353 @@ + + +-- UUAGC 0.9.42.0 (src-ag/Code.ag) +module Code where +{-# LINE 2 "./src-ag/Code.ag" #-} + +import Pretty +import Patterns +import Data.List(partition) +import Data.Set(Set) +import qualified Data.Set as Set +import Data.Map(Map) +import qualified Data.Map as Map +{-# LINE 15 "dist/build/Code.hs" #-} +{-# LINE 146 "./src-ag/Code.ag" #-} + +-- 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 +{-# LINE 33 "dist/build/Code.hs" #-} +-- CaseAlt ----------------------------------------------------- +{- + alternatives: + alternative CaseAlt: + child left : Lhs + child expr : Expr +-} +data CaseAlt = CaseAlt (Lhs) (Expr) +-- CaseAlts ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CaseAlt + child tl : CaseAlts + alternative Nil: +-} +type CaseAlts = [CaseAlt] +-- Chunk ------------------------------------------------------- +{- + 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]} +-} +data Chunk = Chunk (String) (Decl) (Decls) (Decls) (Decls) (Decls) (Decls) (Decls) (([String])) +-- Chunks ------------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : Chunk + child tl : Chunks + alternative Nil: +-} +type Chunks = [Chunk] +-- DataAlt ----------------------------------------------------- +{- + alternatives: + alternative DataAlt: + child name : {String} + child args : Types + alternative Record: + child name : {String} + child args : NamedTypes +-} +data DataAlt = DataAlt (String) (Types) + | Record (String) (NamedTypes) +-- DataAlts ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : DataAlt + child tl : DataAlts + alternative Nil: +-} +type DataAlts = [DataAlt] +-- Decl -------------------------------------------------------- +{- + alternatives: + alternative Decl: + child left : Lhs + child rhs : Expr + child binds : {Set String} + child uses : {Set String} + alternative Bind: + child left : Lhs + child rhs : Expr + alternative BindLet: + child left : Lhs + child rhs : Expr + alternative Data: + child name : {String} + child params : {[String]} + child alts : DataAlts + child strict : {Bool} + child derivings : {[String]} + alternative NewType: + child name : {String} + child params : {[String]} + child con : {String} + child tp : Type + alternative Type: + child name : {String} + child params : {[String]} + child tp : Type + alternative TSig: + child name : {String} + child tp : Type + alternative Comment: + child txt : {String} + alternative PragmaDecl: + child txt : {String} + alternative Resume: + child monadic : {Bool} + child nt : {String} + child left : Lhs + child rhs : Expr + alternative EvalDecl: + child nt : {String} + child left : Lhs + child rhs : Expr +-} +data Decl = Decl (Lhs) (Expr) ((Set String)) ((Set String)) + | Bind (Lhs) (Expr) + | BindLet (Lhs) (Expr) + | Data (String) (([String])) (DataAlts) (Bool) (([String])) + | NewType (String) (([String])) (String) (Type) + | Type (String) (([String])) (Type) + | TSig (String) (Type) + | Comment (String) + | PragmaDecl (String) + | Resume (Bool) (String) (Lhs) (Expr) + | EvalDecl (String) (Lhs) (Expr) +-- Decls ------------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Decl + child tl : Decls + alternative Nil: +-} +type Decls = [Decl] +-- Expr -------------------------------------------------------- +{- + alternatives: + alternative Let: + child decls : Decls + child body : Expr + alternative Case: + child expr : Expr + child alts : CaseAlts + alternative Do: + child stmts : Decls + child body : Expr + alternative Lambda: + child args : Exprs + child body : Expr + alternative TupleExpr: + child exprs : Exprs + alternative UnboxedTupleExpr: + child exprs : Exprs + alternative App: + child name : {String} + child args : Exprs + alternative SimpleExpr: + child txt : {String} + alternative TextExpr: + child lns : {[String]} + alternative Trace: + child txt : {String} + child expr : Expr + alternative PragmaExpr: + child onLeftSide : {Bool} + child onNewLine : {Bool} + child txt : {String} + child expr : Expr + alternative LineExpr: + child expr : Expr + alternative TypedExpr: + child expr : Expr + child tp : Type + alternative ResultExpr: + child nt : {String} + child expr : Expr + alternative InvokeExpr: + child nt : {String} + child expr : Expr + child args : Exprs + alternative ResumeExpr: + child nt : {String} + child expr : Expr + child left : Lhs + child rhs : Expr + alternative SemFun: + child nt : {String} + child args : Exprs + child body : Expr +-} +data Expr = Let (Decls) (Expr) + | Case (Expr) (CaseAlts) + | Do (Decls) (Expr) + | Lambda (Exprs) (Expr) + | TupleExpr (Exprs) + | UnboxedTupleExpr (Exprs) + | App (String) (Exprs) + | SimpleExpr (String) + | TextExpr (([String])) + | Trace (String) (Expr) + | PragmaExpr (Bool) (Bool) (String) (Expr) + | LineExpr (Expr) + | TypedExpr (Expr) (Type) + | ResultExpr (String) (Expr) + | InvokeExpr (String) (Expr) (Exprs) + | ResumeExpr (String) (Expr) (Lhs) (Expr) + | SemFun (String) (Exprs) (Expr) +-- Exprs ------------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Expr + child tl : Exprs + alternative Nil: +-} +type Exprs = [Expr] +-- Lhs --------------------------------------------------------- +{- + alternatives: + alternative Pattern3: + child pat3 : {Pattern} + alternative Pattern3SM: + child pat3 : {Pattern} + alternative TupleLhs: + child comps : {[String]} + alternative UnboxedTupleLhs: + child comps : {[String]} + alternative Fun: + child name : {String} + child args : Exprs + alternative Unwrap: + child name : {String} + child sub : Lhs +-} +data Lhs = Pattern3 (Pattern) + | Pattern3SM (Pattern) + | TupleLhs (([String])) + | UnboxedTupleLhs (([String])) + | Fun (String) (Exprs) + | Unwrap (String) (Lhs) +-- NamedType --------------------------------------------------- +{- + alternatives: + alternative Named: + child strict : {Bool} + child name : {String} + child tp : Type +-} +data NamedType = Named (Bool) (String) (Type) +-- NamedTypes -------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : NamedType + child tl : NamedTypes + alternative Nil: +-} +type NamedTypes = [NamedType] +-- Program ----------------------------------------------------- +{- + alternatives: + alternative Program: + child chunks : Chunks + child ordered : {Bool} +-} +data Program = Program (Chunks) (Bool) +-- Type -------------------------------------------------------- +{- + alternatives: + alternative Arr: + child left : Type + child right : Type + alternative CtxApp: + child left : {[(String, [String])]} + child right : Type + alternative QuantApp: + child left : {String} + child right : Type + alternative TypeApp: + child func : Type + child args : Types + alternative TupleType: + child tps : Types + alternative UnboxedTupleType: + child tps : Types + alternative List: + child tp : Type + alternative SimpleType: + child txt : {String} + alternative NontermType: + child name : {String} + child params : {[String]} + child deforested : {Bool} + alternative TMaybe: + child tp : Type + alternative TEither: + child left : Type + child right : Type + alternative TMap: + child key : Type + child value : Type + alternative TIntMap: + child value : Type +-} +data Type = Arr (Type) (Type) + | CtxApp (([(String, [String])])) (Type) + | QuantApp (String) (Type) + | TypeApp (Type) (Types) + | TupleType (Types) + | UnboxedTupleType (Types) + | List (Type) + | SimpleType (String) + | NontermType (String) (([String])) (Bool) + | TMaybe (Type) + | TEither (Type) (Type) + | TMap (Type) (Type) + | TIntMap (Type) + deriving ( Show) +-- Types ------------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Type + child tl : Types + alternative Nil: +-} +type Types = [Type] diff --git a/dist/build/CodeSyntax.hs b/dist/build/CodeSyntax.hs new file mode 100644 --- /dev/null +++ b/dist/build/CodeSyntax.hs @@ -0,0 +1,151 @@ + + +-- UUAGC 0.9.42.0 (src-ag/CodeSyntax.ag) +module CodeSyntax where +{-# LINE 2 "./src-ag/CodeSyntax.ag" #-} + +import Patterns +import CommonTypes +import Data.Map(Map) +import Data.Set(Set) +{-# LINE 12 "dist/build/CodeSyntax.hs" #-} +-- CGrammar ---------------------------------------------------- +{- + alternatives: + alternative CGrammar: + child typeSyns : {TypeSyns} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : CNonterminals + child pragmas : {PragmaMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Set Identifier))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))} + child multivisit : {Bool} +-} +data CGrammar = CGrammar (TypeSyns) (Derivings) ((Set NontermIdent)) (CNonterminals) (PragmaMap) (ParamMap) (ContextMap) (QuantMap) ((Map NontermIdent (Map ConstructorIdent (Set Identifier)))) ((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))))) (Bool) +-- CInterface -------------------------------------------------- +{- + alternatives: + alternative CInterface: + child seg : CSegments +-} +data CInterface = CInterface (CSegments) +-- CNonterminal ------------------------------------------------ +{- + alternatives: + alternative CNonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : CProductions + child inter : CInterface +-} +data CNonterminal = CNonterminal (NontermIdent) (([Identifier])) (Attributes) (Attributes) (CProductions) (CInterface) +-- CNonterminals ----------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CNonterminal + child tl : CNonterminals + alternative Nil: +-} +type CNonterminals = [CNonterminal] +-- CProduction ------------------------------------------------- +{- + alternatives: + alternative CProduction: + child con : {ConstructorIdent} + child visits : CVisits + child children : {[(Identifier,Type,ChildKind)]} + child terminals : {[Identifier]} +-} +data CProduction = CProduction (ConstructorIdent) (CVisits) (([(Identifier,Type,ChildKind)])) (([Identifier])) +-- CProductions ------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : CProduction + child tl : CProductions + alternative Nil: +-} +type CProductions = [CProduction] +-- CRule ------------------------------------------------------- +{- + alternatives: + alternative CRule: + child name : {Identifier} + child isIn : {Bool} + child hasCode : {Bool} + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child childnt : {Maybe NontermIdent} + child tp : {Maybe Type} + child pattern : {Pattern} + child rhs : {[String]} + child defines : {Map Int (Identifier,Identifier,Maybe Type)} + child owrt : {Bool} + child origin : {String} + child uses : {Set (Identifier, Identifier)} + child explicit : {Bool} + child mbNamed : {Maybe Identifier} + alternative CChildVisit: + child name : {Identifier} + child nt : {NontermIdent} + child nr : {Int} + child inh : {Attributes} + child syn : {Attributes} + child isLast : {Bool} +-} +data CRule = CRule (Identifier) (Bool) (Bool) (NontermIdent) (ConstructorIdent) (Identifier) ((Maybe NontermIdent)) ((Maybe Type)) (Pattern) (([String])) ((Map Int (Identifier,Identifier,Maybe Type))) (Bool) (String) ((Set (Identifier, Identifier))) (Bool) ((Maybe Identifier)) + | CChildVisit (Identifier) (NontermIdent) (Int) (Attributes) (Attributes) (Bool) +-- CSegment ---------------------------------------------------- +{- + alternatives: + alternative CSegment: + child inh : {Attributes} + child syn : {Attributes} +-} +data CSegment = CSegment (Attributes) (Attributes) +-- CSegments --------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CSegment + child tl : CSegments + alternative Nil: +-} +type CSegments = [CSegment] +-- CVisit ------------------------------------------------------ +{- + alternatives: + alternative CVisit: + child inh : {Attributes} + child syn : {Attributes} + child vss : Sequence + child intra : Sequence + child ordered : {Bool} +-} +data CVisit = CVisit (Attributes) (Attributes) (Sequence) (Sequence) (Bool) +-- CVisits ----------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CVisit + child tl : CVisits + alternative Nil: +-} +type CVisits = [CVisit] +-- Sequence ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CRule + child tl : Sequence + alternative Nil: +-} +type Sequence = [CRule] diff --git a/dist/build/CodeSyntaxDump.hs b/dist/build/CodeSyntaxDump.hs new file mode 100644 --- /dev/null +++ b/dist/build/CodeSyntaxDump.hs @@ -0,0 +1,1070 @@ + + +-- UUAGC 0.9.42.0 (src-ag/CodeSyntaxDump.ag) +module CodeSyntaxDump where +{-# LINE 5 "./src-ag/CodeSyntaxDump.ag" #-} + +import Data.List +import qualified Data.Map as Map + +import Pretty +import PPUtil + +import CodeSyntax +{-# LINE 15 "dist/build/CodeSyntaxDump.hs" #-} + +{-# LINE 2 "./src-ag/CodeSyntax.ag" #-} + +import Patterns +import CommonTypes +import Data.Map(Map) +import Data.Set(Set) +{-# LINE 23 "dist/build/CodeSyntaxDump.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 30 "dist/build/CodeSyntaxDump.hs" #-} +{-# LINE 15 "./src-ag/CodeSyntaxDump.ag" #-} + +ppChild :: (Identifier,Type,ChildKind) -> PP_Doc +ppChild (nm,tp,b) + = pp nm >#< "::" >#< pp (show tp) + +ppVertexMap :: Map Int (Identifier,Identifier,Maybe Type) -> PP_Doc +ppVertexMap m + = ppVList [ ppF (show k) $ ppAttr v | (k,v) <- Map.toList m ] + +ppAttr :: (Identifier,Identifier,Maybe Type) -> PP_Doc +ppAttr (fld,nm,mTp) + = pp fld >|< "." >|< pp nm >#< + case mTp of + Just tp -> pp "::" >#< show tp + Nothing -> empty + +ppBool :: Bool -> PP_Doc +ppBool True = pp "T" +ppBool False = pp "F" + +ppMaybeShow :: Show a => Maybe a -> PP_Doc +ppMaybeShow (Just x) = pp (show x) +ppMaybeShow Nothing = pp "_" + +ppStrings :: [String] -> PP_Doc +ppStrings = vlist +{-# LINE 58 "dist/build/CodeSyntaxDump.hs" #-} +-- CGrammar ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CGrammar: + child typeSyns : {TypeSyns} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : CNonterminals + child pragmas : {PragmaMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Set Identifier))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))} + child multivisit : {Bool} +-} +-- cata +sem_CGrammar :: CGrammar -> + T_CGrammar +sem_CGrammar (CGrammar _typeSyns _derivings _wrappers _nonts _pragmas _paramMap _contextMap _quantMap _aroundsMap _mergeMap _multivisit) = + (sem_CGrammar_CGrammar _typeSyns _derivings _wrappers (sem_CNonterminals _nonts) _pragmas _paramMap _contextMap _quantMap _aroundsMap _mergeMap _multivisit) +-- semantic domain +newtype T_CGrammar = T_CGrammar (( PP_Doc)) +data Inh_CGrammar = Inh_CGrammar {} +data Syn_CGrammar = Syn_CGrammar {pp_Syn_CGrammar :: PP_Doc} +wrap_CGrammar :: T_CGrammar -> + Inh_CGrammar -> + Syn_CGrammar +wrap_CGrammar (T_CGrammar sem) (Inh_CGrammar) = + (let ( _lhsOpp) = sem + in (Syn_CGrammar _lhsOpp)) +sem_CGrammar_CGrammar :: TypeSyns -> + Derivings -> + (Set NontermIdent) -> + T_CNonterminals -> + PragmaMap -> + ParamMap -> + ContextMap -> + QuantMap -> + (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> + Bool -> + T_CGrammar +sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ (T_CNonterminals nonts_) pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ = + (T_CGrammar (let _lhsOpp :: PP_Doc + _nontsIpp :: PP_Doc + _nontsIppL :: ([PP_Doc]) + -- "./src-ag/CodeSyntaxDump.ag"(line 47, column 21) + _lhsOpp = + ({-# LINE 47 "./src-ag/CodeSyntaxDump.ag" #-} + ppNestInfo ["CGrammar","CGrammar"] [] + [ ppF "typeSyns" $ ppAssocL typeSyns_ + , ppF "derivings" $ ppMap $ derivings_ + , ppF "nonts" $ ppVList _nontsIppL + ] [] + {-# LINE 117 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _nontsIpp,_nontsIppL) = + nonts_ + in ( _lhsOpp))) +-- CInterface -------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CInterface: + child seg : CSegments +-} +-- cata +sem_CInterface :: CInterface -> + T_CInterface +sem_CInterface (CInterface _seg) = + (sem_CInterface_CInterface (sem_CSegments _seg)) +-- semantic domain +newtype T_CInterface = T_CInterface (( PP_Doc)) +data Inh_CInterface = Inh_CInterface {} +data Syn_CInterface = Syn_CInterface {pp_Syn_CInterface :: PP_Doc} +wrap_CInterface :: T_CInterface -> + Inh_CInterface -> + Syn_CInterface +wrap_CInterface (T_CInterface sem) (Inh_CInterface) = + (let ( _lhsOpp) = sem + in (Syn_CInterface _lhsOpp)) +sem_CInterface_CInterface :: T_CSegments -> + T_CInterface +sem_CInterface_CInterface (T_CSegments seg_) = + (T_CInterface (let _lhsOpp :: PP_Doc + _segIpp :: PP_Doc + _segIppL :: ([PP_Doc]) + -- "./src-ag/CodeSyntaxDump.ag"(line 57, column 21) + _lhsOpp = + ({-# LINE 57 "./src-ag/CodeSyntaxDump.ag" #-} + ppNestInfo ["CInterface","CInterface"] [] [ppF "seg" $ ppVList _segIppL] [] + {-# LINE 156 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _segIpp,_segIppL) = + seg_ + in ( _lhsOpp))) +-- CNonterminal ------------------------------------------------ +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CNonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : CProductions + child inter : CInterface +-} +-- cata +sem_CNonterminal :: CNonterminal -> + T_CNonterminal +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 (( PP_Doc)) +data Inh_CNonterminal = Inh_CNonterminal {} +data Syn_CNonterminal = Syn_CNonterminal {pp_Syn_CNonterminal :: PP_Doc} +wrap_CNonterminal :: T_CNonterminal -> + Inh_CNonterminal -> + Syn_CNonterminal +wrap_CNonterminal (T_CNonterminal sem) (Inh_CNonterminal) = + (let ( _lhsOpp) = sem + in (Syn_CNonterminal _lhsOpp)) +sem_CNonterminal_CNonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_CProductions -> + T_CInterface -> + T_CNonterminal +sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ (T_CProductions prods_) (T_CInterface inter_) = + (T_CNonterminal (let _lhsOpp :: PP_Doc + _prodsIpp :: PP_Doc + _prodsIppL :: ([PP_Doc]) + _interIpp :: PP_Doc + -- "./src-ag/CodeSyntaxDump.ag"(line 54, column 33) + _lhsOpp = + ({-# LINE 54 "./src-ag/CodeSyntaxDump.ag" #-} + ppNestInfo ["CNonterminal","CNonterminal"] (pp nt_ : map pp params_) [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "prods" $ ppVList _prodsIppL, ppF "inter" _interIpp] [] + {-# LINE 206 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _prodsIpp,_prodsIppL) = + prods_ + ( _interIpp) = + inter_ + in ( _lhsOpp))) +-- CNonterminals ----------------------------------------------- +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CNonterminal + child tl : CNonterminals + alternative Nil: +-} +-- cata +sem_CNonterminals :: CNonterminals -> + T_CNonterminals +sem_CNonterminals list = + (Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list)) +-- semantic domain +newtype T_CNonterminals = T_CNonterminals (( PP_Doc,([PP_Doc]))) +data Inh_CNonterminals = Inh_CNonterminals {} +data Syn_CNonterminals = Syn_CNonterminals {pp_Syn_CNonterminals :: PP_Doc,ppL_Syn_CNonterminals :: ([PP_Doc])} +wrap_CNonterminals :: T_CNonterminals -> + Inh_CNonterminals -> + Syn_CNonterminals +wrap_CNonterminals (T_CNonterminals sem) (Inh_CNonterminals) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_CNonterminals _lhsOpp _lhsOppL)) +sem_CNonterminals_Cons :: T_CNonterminal -> + T_CNonterminals -> + T_CNonterminals +sem_CNonterminals_Cons (T_CNonterminal hd_) (T_CNonterminals tl_) = + (T_CNonterminals (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "./src-ag/CodeSyntaxDump.ag"(line 102, column 33) + _lhsOppL = + ({-# LINE 102 "./src-ag/CodeSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 253 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "./src-ag/CodeSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 259 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL))) +sem_CNonterminals_Nil :: T_CNonterminals +sem_CNonterminals_Nil = + (T_CNonterminals (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "./src-ag/CodeSyntaxDump.ag"(line 103, column 33) + _lhsOppL = + ({-# LINE 103 "./src-ag/CodeSyntaxDump.ag" #-} + [] + {-# LINE 274 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "./src-ag/CodeSyntaxDump.ag" #-} + empty + {-# LINE 280 "dist/build/CodeSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL))) +-- CProduction ------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CProduction: + child con : {ConstructorIdent} + child visits : CVisits + child children : {[(Identifier,Type,ChildKind)]} + child terminals : {[Identifier]} +-} +-- cata +sem_CProduction :: CProduction -> + T_CProduction +sem_CProduction (CProduction _con _visits _children _terminals) = + (sem_CProduction_CProduction _con (sem_CVisits _visits) _children _terminals) +-- semantic domain +newtype T_CProduction = T_CProduction (( PP_Doc)) +data Inh_CProduction = Inh_CProduction {} +data Syn_CProduction = Syn_CProduction {pp_Syn_CProduction :: PP_Doc} +wrap_CProduction :: T_CProduction -> + Inh_CProduction -> + Syn_CProduction +wrap_CProduction (T_CProduction sem) (Inh_CProduction) = + (let ( _lhsOpp) = sem + in (Syn_CProduction _lhsOpp)) +sem_CProduction_CProduction :: ConstructorIdent -> + T_CVisits -> + ([(Identifier,Type,ChildKind)]) -> + ([Identifier]) -> + T_CProduction +sem_CProduction_CProduction con_ (T_CVisits visits_) children_ terminals_ = + (T_CProduction (let _lhsOpp :: PP_Doc + _visitsIpp :: PP_Doc + _visitsIppL :: ([PP_Doc]) + -- "./src-ag/CodeSyntaxDump.ag"(line 63, column 17) + _lhsOpp = + ({-# LINE 63 "./src-ag/CodeSyntaxDump.ag" #-} + ppNestInfo ["CProduction","CProduction"] [pp con_] [ppF "visits" $ ppVList _visitsIppL, ppF "children" $ ppVList (map ppChild children_),ppF "terminals" $ ppVList (map ppShow terminals_)] [] + {-# LINE 323 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _visitsIpp,_visitsIppL) = + visits_ + in ( _lhsOpp))) +-- CProductions ------------------------------------------------ +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CProduction + child tl : CProductions + alternative Nil: +-} +-- cata +sem_CProductions :: CProductions -> + T_CProductions +sem_CProductions list = + (Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list)) +-- semantic domain +newtype T_CProductions = T_CProductions (( PP_Doc,([PP_Doc]))) +data Inh_CProductions = Inh_CProductions {} +data Syn_CProductions = Syn_CProductions {pp_Syn_CProductions :: PP_Doc,ppL_Syn_CProductions :: ([PP_Doc])} +wrap_CProductions :: T_CProductions -> + Inh_CProductions -> + Syn_CProductions +wrap_CProductions (T_CProductions sem) (Inh_CProductions) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_CProductions _lhsOpp _lhsOppL)) +sem_CProductions_Cons :: T_CProduction -> + T_CProductions -> + T_CProductions +sem_CProductions_Cons (T_CProduction hd_) (T_CProductions tl_) = + (T_CProductions (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "./src-ag/CodeSyntaxDump.ag"(line 94, column 33) + _lhsOppL = + ({-# LINE 94 "./src-ag/CodeSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 368 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "./src-ag/CodeSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 374 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL))) +sem_CProductions_Nil :: T_CProductions +sem_CProductions_Nil = + (T_CProductions (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "./src-ag/CodeSyntaxDump.ag"(line 95, column 33) + _lhsOppL = + ({-# LINE 95 "./src-ag/CodeSyntaxDump.ag" #-} + [] + {-# LINE 389 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "./src-ag/CodeSyntaxDump.ag" #-} + empty + {-# LINE 395 "dist/build/CodeSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL))) +-- CRule ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CRule: + child name : {Identifier} + child isIn : {Bool} + child hasCode : {Bool} + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child childnt : {Maybe NontermIdent} + child tp : {Maybe Type} + child pattern : Pattern + child rhs : {[String]} + child defines : {Map Int (Identifier,Identifier,Maybe Type)} + child owrt : {Bool} + child origin : {String} + child uses : {Set (Identifier, Identifier)} + child explicit : {Bool} + child mbNamed : {Maybe Identifier} + alternative CChildVisit: + child name : {Identifier} + child nt : {NontermIdent} + child nr : {Int} + child inh : {Attributes} + child syn : {Attributes} + child isLast : {Bool} +-} +-- cata +sem_CRule :: CRule -> + T_CRule +sem_CRule (CRule _name _isIn _hasCode _nt _con _field _childnt _tp _pattern _rhs _defines _owrt _origin _uses _explicit _mbNamed) = + (sem_CRule_CRule _name _isIn _hasCode _nt _con _field _childnt _tp (sem_Pattern _pattern) _rhs _defines _owrt _origin _uses _explicit _mbNamed) +sem_CRule (CChildVisit _name _nt _nr _inh _syn _isLast) = + (sem_CRule_CChildVisit _name _nt _nr _inh _syn _isLast) +-- semantic domain +newtype T_CRule = T_CRule (( PP_Doc)) +data Inh_CRule = Inh_CRule {} +data Syn_CRule = Syn_CRule {pp_Syn_CRule :: PP_Doc} +wrap_CRule :: T_CRule -> + Inh_CRule -> + Syn_CRule +wrap_CRule (T_CRule sem) (Inh_CRule) = + (let ( _lhsOpp) = sem + in (Syn_CRule _lhsOpp)) +sem_CRule_CRule :: Identifier -> + Bool -> + Bool -> + NontermIdent -> + ConstructorIdent -> + Identifier -> + (Maybe NontermIdent) -> + (Maybe Type) -> + T_Pattern -> + ([String]) -> + (Map Int (Identifier,Identifier,Maybe Type)) -> + Bool -> + String -> + (Set (Identifier, Identifier)) -> + Bool -> + (Maybe Identifier) -> + T_CRule +sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ (T_Pattern pattern_) rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ = + (T_CRule (let _lhsOpp :: PP_Doc + _patternIcopy :: Pattern + _patternIpp :: PP_Doc + -- "./src-ag/CodeSyntaxDump.ag"(line 69, column 33) + _lhsOpp = + ({-# LINE 69 "./src-ag/CodeSyntaxDump.ag" #-} + ppNestInfo ["CRule","CRule"] [pp name_] [ppF "isIn" $ ppBool isIn_, ppF "hasCode" $ ppBool hasCode_, ppF "nt" $ pp nt_, ppF "con" $ pp con_, ppF "field" $ pp field_, ppF "childnt" $ ppMaybeShow childnt_, ppF "tp" $ ppMaybeShow tp_, ppF "pattern" $ if isIn_ then pp "" else _patternIpp, ppF "rhs" $ ppStrings rhs_, ppF "defines" $ ppVertexMap defines_, ppF "owrt" $ ppBool owrt_, ppF "origin" $ pp origin_] [] + {-# LINE 471 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _patternIcopy,_patternIpp) = + pattern_ + in ( _lhsOpp))) +sem_CRule_CChildVisit :: Identifier -> + NontermIdent -> + Int -> + Attributes -> + Attributes -> + Bool -> + T_CRule +sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ = + (T_CRule (let _lhsOpp :: PP_Doc + -- "./src-ag/CodeSyntaxDump.ag"(line 70, column 21) + _lhsOpp = + ({-# LINE 70 "./src-ag/CodeSyntaxDump.ag" #-} + ppNestInfo ["CRule","CChildVisit"] [pp name_] [ppF "nt" $ pp nt_, ppF "nr" $ ppShow nr_, ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "last" $ ppBool isLast_] [] + {-# LINE 489 "dist/build/CodeSyntaxDump.hs" #-} + ) + in ( _lhsOpp))) +-- CSegment ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CSegment: + child inh : {Attributes} + child syn : {Attributes} +-} +-- cata +sem_CSegment :: CSegment -> + T_CSegment +sem_CSegment (CSegment _inh _syn) = + (sem_CSegment_CSegment _inh _syn) +-- semantic domain +newtype T_CSegment = T_CSegment (( PP_Doc)) +data Inh_CSegment = Inh_CSegment {} +data Syn_CSegment = Syn_CSegment {pp_Syn_CSegment :: PP_Doc} +wrap_CSegment :: T_CSegment -> + Inh_CSegment -> + Syn_CSegment +wrap_CSegment (T_CSegment sem) (Inh_CSegment) = + (let ( _lhsOpp) = sem + in (Syn_CSegment _lhsOpp)) +sem_CSegment_CSegment :: Attributes -> + Attributes -> + T_CSegment +sem_CSegment_CSegment inh_ syn_ = + (T_CSegment (let _lhsOpp :: PP_Doc + -- "./src-ag/CodeSyntaxDump.ag"(line 60, column 21) + _lhsOpp = + ({-# LINE 60 "./src-ag/CodeSyntaxDump.ag" #-} + ppNestInfo ["CSegment","CSegment"] [] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_] [] + {-# LINE 526 "dist/build/CodeSyntaxDump.hs" #-} + ) + in ( _lhsOpp))) +-- CSegments --------------------------------------------------- +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CSegment + child tl : CSegments + alternative Nil: +-} +-- cata +sem_CSegments :: CSegments -> + T_CSegments +sem_CSegments list = + (Prelude.foldr sem_CSegments_Cons sem_CSegments_Nil (Prelude.map sem_CSegment list)) +-- semantic domain +newtype T_CSegments = T_CSegments (( PP_Doc,([PP_Doc]))) +data Inh_CSegments = Inh_CSegments {} +data Syn_CSegments = Syn_CSegments {pp_Syn_CSegments :: PP_Doc,ppL_Syn_CSegments :: ([PP_Doc])} +wrap_CSegments :: T_CSegments -> + Inh_CSegments -> + Syn_CSegments +wrap_CSegments (T_CSegments sem) (Inh_CSegments) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_CSegments _lhsOpp _lhsOppL)) +sem_CSegments_Cons :: T_CSegment -> + T_CSegments -> + T_CSegments +sem_CSegments_Cons (T_CSegment hd_) (T_CSegments tl_) = + (T_CSegments (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "./src-ag/CodeSyntaxDump.ag"(line 98, column 33) + _lhsOppL = + ({-# LINE 98 "./src-ag/CodeSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 569 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "./src-ag/CodeSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 575 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL))) +sem_CSegments_Nil :: T_CSegments +sem_CSegments_Nil = + (T_CSegments (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "./src-ag/CodeSyntaxDump.ag"(line 99, column 33) + _lhsOppL = + ({-# LINE 99 "./src-ag/CodeSyntaxDump.ag" #-} + [] + {-# LINE 590 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "./src-ag/CodeSyntaxDump.ag" #-} + empty + {-# LINE 596 "dist/build/CodeSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL))) +-- CVisit ------------------------------------------------------ +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CVisit: + child inh : {Attributes} + child syn : {Attributes} + child vss : Sequence + child intra : Sequence + child ordered : {Bool} +-} +-- cata +sem_CVisit :: CVisit -> + T_CVisit +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 (( PP_Doc)) +data Inh_CVisit = Inh_CVisit {} +data Syn_CVisit = Syn_CVisit {pp_Syn_CVisit :: PP_Doc} +wrap_CVisit :: T_CVisit -> + Inh_CVisit -> + Syn_CVisit +wrap_CVisit (T_CVisit sem) (Inh_CVisit) = + (let ( _lhsOpp) = sem + in (Syn_CVisit _lhsOpp)) +sem_CVisit_CVisit :: Attributes -> + Attributes -> + T_Sequence -> + T_Sequence -> + Bool -> + T_CVisit +sem_CVisit_CVisit inh_ syn_ (T_Sequence vss_) (T_Sequence intra_) ordered_ = + (T_CVisit (let _lhsOpp :: PP_Doc + _vssIppL :: ([PP_Doc]) + _intraIppL :: ([PP_Doc]) + -- "./src-ag/CodeSyntaxDump.ag"(line 66, column 21) + _lhsOpp = + ({-# LINE 66 "./src-ag/CodeSyntaxDump.ag" #-} + ppNestInfo ["CVisit","CVisit"] [] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "sequence" $ ppVList _vssIppL, ppF "intra" $ ppVList _intraIppL, ppF "ordered" $ ppBool ordered_] [] + {-# LINE 641 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _vssIppL) = + vss_ + ( _intraIppL) = + intra_ + in ( _lhsOpp))) +-- CVisits ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CVisit + child tl : CVisits + alternative Nil: +-} +-- cata +sem_CVisits :: CVisits -> + T_CVisits +sem_CVisits list = + (Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list)) +-- semantic domain +newtype T_CVisits = T_CVisits (( PP_Doc,([PP_Doc]))) +data Inh_CVisits = Inh_CVisits {} +data Syn_CVisits = Syn_CVisits {pp_Syn_CVisits :: PP_Doc,ppL_Syn_CVisits :: ([PP_Doc])} +wrap_CVisits :: T_CVisits -> + Inh_CVisits -> + Syn_CVisits +wrap_CVisits (T_CVisits sem) (Inh_CVisits) = + (let ( _lhsOpp,_lhsOppL) = sem + in (Syn_CVisits _lhsOpp _lhsOppL)) +sem_CVisits_Cons :: T_CVisit -> + T_CVisits -> + T_CVisits +sem_CVisits_Cons (T_CVisit hd_) (T_CVisits tl_) = + (T_CVisits (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "./src-ag/CodeSyntaxDump.ag"(line 90, column 33) + _lhsOppL = + ({-# LINE 90 "./src-ag/CodeSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 688 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "./src-ag/CodeSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 694 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIpp,_tlIppL) = + tl_ + in ( _lhsOpp,_lhsOppL))) +sem_CVisits_Nil :: T_CVisits +sem_CVisits_Nil = + (T_CVisits (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + -- "./src-ag/CodeSyntaxDump.ag"(line 91, column 33) + _lhsOppL = + ({-# LINE 91 "./src-ag/CodeSyntaxDump.ag" #-} + [] + {-# LINE 709 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "./src-ag/CodeSyntaxDump.ag" #-} + empty + {-# LINE 715 "dist/build/CodeSyntaxDump.hs" #-} + ) + in ( _lhsOpp,_lhsOppL))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : Pattern + pp : PP_Doc + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern (Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern (Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern (Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +sem_Pattern (Underscore _pos) = + (sem_Pattern_Underscore _pos) +-- semantic domain +newtype T_Pattern = T_Pattern (( Pattern,PP_Doc)) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,pp_Syn_Pattern :: PP_Doc} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem) (Inh_Pattern) = + (let ( _lhsOcopy,_lhsOpp) = sem + in (Syn_Pattern _lhsOcopy _lhsOpp)) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIpp :: PP_Doc + _patsIppL :: ([PP_Doc]) + -- "./src-ag/CodeSyntaxDump.ag"(line 73, column 33) + _lhsOpp = + ({-# LINE 73 "./src-ag/CodeSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] [] + {-# LINE 786 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 792 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 798 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _patsIcopy,_patsIpp,_patsIppL) = + pats_ + in ( _lhsOcopy,_lhsOpp))) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIpp :: PP_Doc + _patsIppL :: ([PP_Doc]) + -- "./src-ag/CodeSyntaxDump.ag"(line 74, column 33) + _lhsOpp = + ({-# LINE 74 "./src-ag/CodeSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] [] + {-# LINE 816 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 822 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 828 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _patsIcopy,_patsIpp,_patsIppL) = + pats_ + in ( _lhsOcopy,_lhsOpp))) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIpp :: PP_Doc + -- "./src-ag/CodeSyntaxDump.ag"(line 75, column 33) + _lhsOpp = + ({-# LINE 75 "./src-ag/CodeSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] [] + {-# LINE 846 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 852 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 858 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _patIcopy,_patIpp) = + pat_ + in ( _lhsOcopy,_lhsOpp))) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_) = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIpp :: PP_Doc + -- use rule "./src-ag/CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "./src-ag/CodeSyntaxDump.ag" #-} + _patIpp + {-# LINE 874 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 880 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 886 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _patIcopy,_patIpp) = + pat_ + in ( _lhsOcopy,_lhsOpp))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOpp :: PP_Doc + _lhsOcopy :: Pattern + -- "./src-ag/CodeSyntaxDump.ag"(line 76, column 25) + _lhsOpp = + ({-# LINE 76 "./src-ag/CodeSyntaxDump.ag" #-} + ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] [] + {-# LINE 900 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 906 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 912 "dist/build/CodeSyntaxDump.hs" #-} + ) + in ( _lhsOcopy,_lhsOpp))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : Patterns + pp : PP_Doc + ppL : [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 (( Patterns,PP_Doc,([PP_Doc]))) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,pp_Syn_Patterns :: PP_Doc,ppL_Syn_Patterns :: ([PP_Doc])} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem) (Inh_Patterns) = + (let ( _lhsOcopy,_lhsOpp,_lhsOppL) = sem + in (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = + (T_Patterns (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _lhsOcopy :: Patterns + _hdIcopy :: Pattern + _hdIpp :: PP_Doc + _tlIcopy :: Patterns + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "./src-ag/CodeSyntaxDump.ag"(line 82, column 33) + _lhsOppL = + ({-# LINE 82 "./src-ag/CodeSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 963 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "./src-ag/CodeSyntaxDump.ag" #-} + _hdIpp >-< _tlIpp + {-# LINE 969 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 975 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 981 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _hdIcopy,_hdIpp) = + hd_ + ( _tlIcopy,_tlIpp,_tlIppL) = + tl_ + in ( _lhsOcopy,_lhsOpp,_lhsOppL))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOppL :: ([PP_Doc]) + _lhsOpp :: PP_Doc + _lhsOcopy :: Patterns + -- "./src-ag/CodeSyntaxDump.ag"(line 83, column 33) + _lhsOppL = + ({-# LINE 83 "./src-ag/CodeSyntaxDump.ag" #-} + [] + {-# LINE 997 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- use rule "./src-ag/CodeSyntaxDump.ag"(line 44, column 40) + _lhsOpp = + ({-# LINE 44 "./src-ag/CodeSyntaxDump.ag" #-} + empty + {-# LINE 1003 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 1009 "dist/build/CodeSyntaxDump.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1015 "dist/build/CodeSyntaxDump.hs" #-} + ) + in ( _lhsOcopy,_lhsOpp,_lhsOppL))) +-- Sequence ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CRule + child tl : Sequence + alternative Nil: +-} +-- cata +sem_Sequence :: Sequence -> + T_Sequence +sem_Sequence list = + (Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list)) +-- semantic domain +newtype T_Sequence = T_Sequence (( ([PP_Doc]))) +data Inh_Sequence = Inh_Sequence {} +data Syn_Sequence = Syn_Sequence {ppL_Syn_Sequence :: ([PP_Doc])} +wrap_Sequence :: T_Sequence -> + Inh_Sequence -> + Syn_Sequence +wrap_Sequence (T_Sequence sem) (Inh_Sequence) = + (let ( _lhsOppL) = sem + in (Syn_Sequence _lhsOppL)) +sem_Sequence_Cons :: T_CRule -> + T_Sequence -> + T_Sequence +sem_Sequence_Cons (T_CRule hd_) (T_Sequence tl_) = + (T_Sequence (let _lhsOppL :: ([PP_Doc]) + _hdIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + -- "./src-ag/CodeSyntaxDump.ag"(line 86, column 33) + _lhsOppL = + ({-# LINE 86 "./src-ag/CodeSyntaxDump.ag" #-} + _hdIpp : _tlIppL + {-# LINE 1055 "dist/build/CodeSyntaxDump.hs" #-} + ) + ( _hdIpp) = + hd_ + ( _tlIppL) = + tl_ + in ( _lhsOppL))) +sem_Sequence_Nil :: T_Sequence +sem_Sequence_Nil = + (T_Sequence (let _lhsOppL :: ([PP_Doc]) + -- "./src-ag/CodeSyntaxDump.ag"(line 87, column 33) + _lhsOppL = + ({-# LINE 87 "./src-ag/CodeSyntaxDump.ag" #-} + [] + {-# LINE 1069 "dist/build/CodeSyntaxDump.hs" #-} + ) + in ( _lhsOppL))) diff --git a/dist/build/ConcreteSyntax.hs b/dist/build/ConcreteSyntax.hs new file mode 100644 --- /dev/null +++ b/dist/build/ConcreteSyntax.hs @@ -0,0 +1,260 @@ + + +-- UUAGC 0.9.42.0 (src-ag/ConcreteSyntax.ag) +module ConcreteSyntax where +{-# LINE 2 "./src-ag/ConcreteSyntax.ag" #-} + +import UU.Scanner.Position (Pos) +import Patterns (Pattern) +import Expression (Expression) +import CommonTypes +import Macro --marcos +{-# LINE 13 "dist/build/ConcreteSyntax.hs" #-} +-- AG ---------------------------------------------------------- +{- + alternatives: + alternative AG: + child elems : Elems +-} +data AG = AG (Elems) +-- Alt --------------------------------------------------------- +{- + alternatives: + alternative Alt: + child pos : {Pos} + child names : ConstructorSet + child tyvars : {[Identifier]} + child fields : Fields + child macro : {MaybeMacro} +-} +data Alt = Alt (Pos) (ConstructorSet) (([Identifier])) (Fields) (MaybeMacro) +-- Alts -------------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Alt + child tl : Alts + alternative Nil: +-} +type Alts = [Alt] +-- Attrs ------------------------------------------------------- +{- + alternatives: + alternative Attrs: + child pos : {Pos} + child inh : {AttrNames} + child chn : {AttrNames} + child syn : {AttrNames} +-} +data Attrs = Attrs (Pos) (AttrNames) (AttrNames) (AttrNames) +-- ConstructorSet ---------------------------------------------- +{- + alternatives: + alternative CName: + child name : {ConstructorIdent} + alternative CUnion: + child set1 : ConstructorSet + child set2 : ConstructorSet + alternative CDifference: + child set1 : ConstructorSet + child set2 : ConstructorSet + alternative CAll: +-} +data ConstructorSet = CName (ConstructorIdent) + | CUnion (ConstructorSet) (ConstructorSet) + | CDifference (ConstructorSet) (ConstructorSet) + | CAll +-- Elem -------------------------------------------------------- +{- + alternatives: + alternative Data: + child pos : {Pos} + child ctx : {ClassContext} + child names : NontSet + child params : {[Identifier]} + child attrs : Attrs + child alts : Alts + child ext : {Bool} + alternative Type: + child pos : {Pos} + child ctx : {ClassContext} + child name : {NontermIdent} + child params : {[Identifier]} + child type : {ComplexType} + alternative Attr: + child pos : {Pos} + child ctx : {ClassContext} + child names : NontSet + child quants : {[String]} + child attrs : Attrs + alternative Sem: + child pos : {Pos} + child ctx : {ClassContext} + child names : NontSet + child attrs : Attrs + child quants : {[String]} + child alts : SemAlts + alternative Txt: + child pos : {Pos} + child kind : {BlockKind} + child mbNt : {Maybe NontermIdent} + child lines : {[String]} + alternative Set: + child pos : {Pos} + child name : {NontermIdent} + child merge : {Bool} + child set : NontSet + alternative Deriving: + child pos : {Pos} + child set : NontSet + child classes : {[NontermIdent]} + alternative Wrapper: + child pos : {Pos} + child set : NontSet + alternative Nocatas: + child pos : {Pos} + child set : NontSet + alternative Pragma: + child pos : {Pos} + child names : {[NontermIdent]} + alternative Module: + child pos : {Pos} + child name : {String} + child exports : {String} + child imports : {String} +-} +data Elem = Data (Pos) (ClassContext) (NontSet) (([Identifier])) (Attrs) (Alts) (Bool) + | Type (Pos) (ClassContext) (NontermIdent) (([Identifier])) (ComplexType) + | Attr (Pos) (ClassContext) (NontSet) (([String])) (Attrs) + | Sem (Pos) (ClassContext) (NontSet) (Attrs) (([String])) (SemAlts) + | Txt (Pos) (BlockKind) ((Maybe NontermIdent)) (([String])) + | Set (Pos) (NontermIdent) (Bool) (NontSet) + | Deriving (Pos) (NontSet) (([NontermIdent])) + | Wrapper (Pos) (NontSet) + | Nocatas (Pos) (NontSet) + | Pragma (Pos) (([NontermIdent])) + | Module (Pos) (String) (String) (String) +-- Elems ------------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Elem + child tl : Elems + alternative Nil: +-} +type Elems = [Elem] +-- Field ------------------------------------------------------- +{- + alternatives: + alternative FChild: + child name : {Identifier} + child tp : {Type} + alternative FCtx: + child tps : {[Type]} +-} +data Field = FChild (Identifier) (Type) + | FCtx (([Type])) +-- Fields ------------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : Field + child tl : Fields + alternative Nil: +-} +type Fields = [Field] +-- NontSet ----------------------------------------------------- +{- + alternatives: + alternative NamedSet: + child name : {NontermIdent} + alternative All: + alternative Union: + child set1 : NontSet + child set2 : NontSet + alternative Intersect: + child set1 : NontSet + child set2 : NontSet + alternative Difference: + child set1 : NontSet + child set2 : NontSet + alternative Path: + child from : {NontermIdent} + child to : {NontermIdent} +-} +data NontSet = NamedSet (NontermIdent) + | All + | Union (NontSet) (NontSet) + | Intersect (NontSet) (NontSet) + | Difference (NontSet) (NontSet) + | Path (NontermIdent) (NontermIdent) +-- SemAlt ------------------------------------------------------ +{- + alternatives: + alternative SemAlt: + child pos : {Pos} + child constructorSet : ConstructorSet + child rules : SemDefs +-} +data SemAlt = SemAlt (Pos) (ConstructorSet) (SemDefs) +-- SemAlts ----------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : SemAlt + child tl : SemAlts + alternative Nil: +-} +type SemAlts = [SemAlt] +-- SemDef ------------------------------------------------------ +{- + alternatives: + alternative Def: + child pos : {Pos} + child mbName : {Maybe Identifier} + child pattern : {Pattern} + child rhs : {Expression} + child owrt : {Bool} + child pure : {Bool} + child eager : {Bool} + alternative TypeDef: + child pos : {Pos} + child ident : {Identifier} + child tp : {Type} + alternative UniqueDef: + child ident : {Identifier} + child ref : {Identifier} + alternative AugmentDef: + child ident : {Identifier} + child rhs : {Expression} + alternative AroundDef: + child ident : {Identifier} + child rhs : {Expression} + alternative MergeDef: + child target : {Identifier} + child nt : {Identifier} + child sources : {[Identifier]} + child rhs : {Expression} + alternative SemPragma: + child names : {[NontermIdent]} + alternative AttrOrderBefore: + child before : {[Occurrence]} + child after : {[Occurrence]} +-} +data SemDef = Def (Pos) ((Maybe Identifier)) (Pattern) (Expression) (Bool) (Bool) (Bool) + | TypeDef (Pos) (Identifier) (Type) + | UniqueDef (Identifier) (Identifier) + | AugmentDef (Identifier) (Expression) + | AroundDef (Identifier) (Expression) + | MergeDef (Identifier) (Identifier) (([Identifier])) (Expression) + | SemPragma (([NontermIdent])) + | AttrOrderBefore (([Occurrence])) (([Occurrence])) +-- SemDefs ----------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : SemDef + child tl : SemDefs + alternative Nil: +-} +type SemDefs = [SemDef] diff --git a/dist/build/DeclBlocks.hs b/dist/build/DeclBlocks.hs new file mode 100644 --- /dev/null +++ b/dist/build/DeclBlocks.hs @@ -0,0 +1,28 @@ + + +-- UUAGC 0.9.42.0 (src-ag/DeclBlocks.ag) +module DeclBlocks where +{-# LINE 2 "./src-ag/DeclBlocks.ag" #-} + +import Code (Decl,Expr) +{-# LINE 9 "dist/build/DeclBlocks.hs" #-} +-- DeclBlocks -------------------------------------------------- +{- + alternatives: + alternative DeclBlock: + child defs : {[Decl]} + child visit : {Decl} + child next : DeclBlocks + alternative DeclTerminator: + child defs : {[Decl]} + child result : {Expr} +-} +data DeclBlocks = DeclBlock (([Decl])) (Decl) (DeclBlocks) + | DeclTerminator (([Decl])) (Expr) +-- DeclBlocksRoot ---------------------------------------------- +{- + alternatives: + alternative DeclBlocksRoot: + child blocks : DeclBlocks +-} +data DeclBlocksRoot = DeclBlocksRoot (DeclBlocks) diff --git a/dist/build/DefaultRules.hs b/dist/build/DefaultRules.hs new file mode 100644 --- /dev/null +++ b/dist/build/DefaultRules.hs @@ -0,0 +1,3220 @@ +{-# OPTIONS_GHC -XBangPatterns #-} + +-- UUAGC 0.9.42.0 (src-ag/DefaultRules.ag) +module DefaultRules where +{-# LINE 15 "./src-ag/DefaultRules.ag" #-} + +import qualified Data.List +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Map(Map) +import qualified Data.Sequence as Seq +import Data.Sequence(Seq,(><)) +import UU.Scanner.Position(noPos) +import Pretty +import Data.Maybe +import HsToken +import HsTokenScanner +import Data.List(intersperse) +import Data.Char + +import AbstractSyntax +import ErrorMessages + +import Options +{-# LINE 26 "dist/build/DefaultRules.hs" #-} + +{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import Macro --marcos +import CommonTypes +import ErrorMessages +{-# LINE 38 "dist/build/DefaultRules.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 45 "dist/build/DefaultRules.hs" #-} +{-# LINE 78 "./src-ag/DefaultRules.ag" #-} + +fieldName n = '@' : getName n + +locName n = "@loc." ++ getName n + +attrName fld attr + | fld == _LOC = locName attr + | fld == _FIELD = fieldName attr + | otherwise = '@' : getName fld ++ "." ++ getName attr + +_ACHILD = Ident "(" noPos -- hack + +mkLocVar = AGField _LOC + + +buildConExpr ocaml typeSyns rename nt con1 fs + | nt `elem` map fst typeSyns = if ocaml then synonymMl else synonymHs + | otherwise = normalExpr + where con = getName con1 + tup = " " ++ buildTuple fs + args = " " ++ unwords fs + normalExpr = conname' ++ args + + conname' | rename = getName nt ++ "_" ++ getName con1 + | otherwise = getName con1 + + synonymHs | con == "Tuple" = buildTuple fs + | con == "Cons" = "(:)" ++ args + | con == "Nil" = case lookup nt typeSyns of + Just (Map _ _) -> "Data.Map.empty" + Just (IntMap _) -> "Data.IntMap.empty" + Just (OrdSet _) -> "Data.Set.empty" + Just IntSet -> "Data.IntSet.empty" + _ -> "[]" + | con == "Just" = "Just" ++ args + | con == "Nothing" = "Nothing" + | con == "Entry" = ( case lookup nt typeSyns of + Just (Map _ _) -> "Data.Map.insert" + Just (IntMap _) -> "Data.IntMap.insert" + Just (OrdSet _) -> "Data.Set.insert" + Just IntSet -> "Data.IntSet.insert" ) ++ args + | otherwise = normalExpr + + synonymMl | con == "Tuple" = buildTuple fs + | con == "Cons" = "(::)" ++ tup + | con == "Nil" = case lookup nt typeSyns of + Just (Map _ _) -> prefixMod nt "empty" + Just (IntMap _) -> prefixMod nt "empty" + Just (OrdSet _) -> prefixMod nt "empty" + Just IntSet -> prefixMod nt "empty" + _ -> "[]" + | con == "Just" = "Some" ++ tup + | con == "Nothing" = "None" + | con == "Entry" = ( case lookup nt typeSyns of + Just (Map _ _) -> prefixMod nt "add" + Just (IntMap _) -> prefixMod nt "add" + Just (OrdSet _) -> prefixMod nt "add" + Just IntSet -> prefixMod nt "add" ) ++ args + | otherwise = normalExpr + + prefixMod nt nm = "M_" ++ getName nt ++ "." ++ nm + +concatSeq = foldr (Seq.><) Seq.empty + +splitAttrs :: Map Identifier a -> [Identifier] -> ([(Identifier,a)],[Identifier]) -- a used as (String,String) +splitAttrs _ [] + = ([],[]) +splitAttrs useMap (n:rest) + = let (uses,normals) = splitAttrs useMap rest + in case Map.lookup n useMap of + Just x -> ((n,x):uses , normals ) + Nothing -> ( uses , n:normals ) + +removeDefined :: Set (Identifier,Identifier) -> (Identifier,Attributes) -> (Identifier,[Identifier]) +removeDefined defined (fld,as) + = ( fld + , [ a + | a <- Map.keys as + , not (Set.member (fld,a) defined) + ] + ) + +{-# LINE 129 "dist/build/DefaultRules.hs" #-} + +{-# LINE 226 "./src-ag/DefaultRules.ag" #-} + + + + +deprecatedCopyRuleError nt con fld a + = let mesg = + "In the definitions for alternative" + >#< getName con + >#< "of nonterminal" + >#< getName nt + >|< "," + >-< "the value of field" + >#< getName a + >#< "is copied by a copy-rule." + >-< "Copying the value of a field using a copy-rule is deprecated" + >-< "Please add the following lines to your code:" + >-< ( "SEM" + >#< getName nt + >-< indent 2 ( "|" + >#< getName con + >#< getName fld + >#< "." + >#< a + >#< "=" + >#< "@" + >|< a + ) + ) + in CustomError True (getPos a) mesg + + +missingRuleErrorExpr nt con fld a + = "error \"missing rule: " + ++ show nt ++ "." ++ show con ++ "." + ++ show fld ++ "." ++ show a ++ "\"" + + + +makeRule :: (Identifier,Identifier) -> Expression -> String -> Bool -> Maybe Error -> Rule +makeRule (f1,a1) expr origin identity mbDelayedError + = Rule Nothing + (Alias f1 a1 (Underscore noPos)) + expr + False + origin + False + True + identity + mbDelayedError + False + + +useRule :: Set Identifier -> [(Identifier,Attributes)] -> (Identifier,(String,String,String)) -> Rule +useRule locals ch_outs (n,(op,e,pos)) + = let elems = [ fld + | (fld,as) <- ch_outs + , Map.member n as + ] + + isOp [] = False + isOp (c:cs) + | isSpace c = isOp cs + | isAlpha c = case dropWhile isAlpha cs of + ('.':cs2) -> isOp cs2 -- fully qualified name, drop prefix + _ -> False + | c == '(' = False + | otherwise = True + + tks | Set.member n locals = [mkLocVar n noPos Nothing] + | null elems = lexTokens noPos e + | otherwise = lexTokens noPos str + where + opExpr l r + | isOp op = l ++ " " ++ op ++ " " ++ r -- takes the associativity of the operator + | otherwise = "(" ++ op ++ " " ++ l ++ " " ++ r ++ ")" -- associates to the right + str = foldr1 opExpr (map (flip attrName n) elems) + + in makeRule (_LHS,n) + (Expression noPos tks) + ("use rule " ++ pos) + False + Nothing + + +selfRule :: Bool -> Identifier -> [HsToken] -> Rule +selfRule lhsNecLoc attr tks + = makeRule (if lhsNecLoc then _LHS else _LOC,attr) + (Expression noPos tks) + "self rule" + False + Nothing + + + + +concatRE rsess = let (rss,ess) = unzip rsess + in (concat rss, concatSeq ess) + + +copyRule :: Options -> Set NontermIdent -> Identifier -> Identifier -> Bool -> Set Identifier -> (Map Identifier Identifier, (Identifier,[Identifier])) -> ([Rule], Seq Error) +copyRule options wrappers nt con modcopy locals (env,(fld,as)) + = concatRE (map copyRu as) + + where + copyRu a + = ( [ makeRule (fld,a) + (Expression noPos tks) + (cruletxt sel) + True + mbDelayedErr + ] + , err + ) + + where + sel + | not modcopy + && Set.member a locals = Just _LOC + | otherwise = Map.lookup a env + + (tks,err,mbDelayedErr) + = case sel of + Nothing -> let tks = [HsToken (missingRuleErrorExpr nt con fld a) noPos] + err = MissingRule nt con fld a + in if nt `Set.member` wrappers && kennedyWarren options + then (tks, Seq.empty, Just err) -- yield error only if the rule is actually scheduled; for kennedyWarren code gen only + else (tks, Seq.singleton err, Nothing) + Just f + | f == _ACHILD -> ( [AGLocal a noPos Nothing] + , Seq.singleton (deprecatedCopyRuleError nt con fld a) + , Nothing + ) + | otherwise -> ( [AGField f a noPos Nothing] + , Seq.empty + , Nothing + ) + + cruletxt sel + | local = "copy rule (from local)" + | deprChild = "deprecated child copy" + | Set.member a locals && nonlocal = "modified copy rule" + | incoming && outgoing = "copy rule (chain)" + | incoming = "copy rule (down)" + | outgoing = "copy rule (up)" + | otherwise = "copy rule (chain)" + where outgoing = fld == _LHS + incoming = maybe False (== _LHS) sel + nonlocal = maybe False (/= _LOC) sel + local = maybe False (== _LOC) sel + deprChild = maybe False (== _ACHILD) sel +{-# LINE 282 "dist/build/DefaultRules.hs" #-} + +{-# LINE 460 "./src-ag/DefaultRules.ag" #-} + +buildTuple fs = "(" ++ concat (intersperse "," fs) ++ ")" + +addAugments :: (Identifier, [Expression]) -> [Rule] -> [Rule] +addAugments (_, exprs) rules + | null exprs = rules +addAugments (syn, exprs) rules + = [rule] ++ funRules ++ map modify rules + where + rule = Rule Nothing (Alias _LHS syn (Underscore noPos)) rhs False "augmented rule" False True False Nothing False + rhs = Expression noPos tks + tks = [ HsToken "foldr ($) " noPos, mkLocVar substSyn noPos Nothing, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] + funs = intersperse (HsToken ", " noPos) (map (\n -> mkLocVar n noPos Nothing) funNames) + + substSyn = Ident (show syn ++ "_augmented_syn") (getPos syn) + funNames = zipWith (\i _ -> Ident (show syn ++ "_augmented_f" ++ show i) (getPos syn)) [1..] exprs + funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos)) expr False "augment function" False True False Nothing False) funNames exprs + + modify (Rule mbNm pat rhs owrt origin expl pure identity mbErr eager) + | containsSyn pat = Rule mbNm (modifyPat pat) rhs owrt origin expl pure identity mbErr eager + modify r = r + + containsSyn (Constr _ pats) = any containsSyn pats + containsSyn (Product _ pats) = any containsSyn pats + containsSyn (Irrefutable pat) = containsSyn pat + containsSyn (Alias field attr pat) = (field == _LHS && attr == syn) || containsSyn pat + containsSyn _ = False + + modifyPat (Constr name pats) = Constr name (map modifyPat pats) + modifyPat (Product pos pats) = Product pos (map modifyPat pats) + modifyPat (Irrefutable pat) = Irrefutable (modifyPat pat) + modifyPat (Alias field attr pat) + | field == _LHS && attr == syn = Alias _LOC substSyn (modifyPat pat) + | otherwise = Alias field attr (modifyPat pat) + modifyPat p = p + +-- adds the additional rules needed for around, which creates a sequence of +-- rules that form a function that each transforms the semantics of a child +-- before attaching the child. +-- The rule defines a local attribute "_around" and is dependent +-- on this attribute. +addArounds :: (Identifier, [Expression]) -> [Rule] -> [Rule] +addArounds (_, exprs) rules | null exprs = rules +addArounds (child, exprs) rules + = [rule] ++ funRules ++ rules + where + rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos)) rhs False "around rule" False True False Nothing False + rhs = Expression noPos tks + tks = [ HsToken "\\s -> foldr ($) s " noPos, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] + funs = intersperse (HsToken ", " noPos) (map (\n -> mkLocVar n noPos Nothing) funNames) + + childLoc = Ident (show child ++ "_around") (getPos child) + funNames = zipWith (\i _ -> Ident (show child ++ "_around_f" ++ show i) (getPos child)) [1..] exprs + funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos)) expr False "around function" False True False Nothing False) funNames exprs + +-- adds the additional rules needed for merging. +-- It produces for each merging child a rule with local attribute: "_merged". +-- this rules takes the semantics of the first children and feeds it to the function +-- represented by this attribute. This attribute then defines the semantics for +-- the merging child. +addMerges :: (Identifier, (Identifier,[Identifier],Expression)) -> [Rule] -> [Rule] +addMerges (target,(_,_,expr)) rules + = rule : rules + where + rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos)) expr False "merge rule" False True False Nothing False + childLoc = Ident (show target ++ "_merge") (getPos target) +{-# LINE 351 "dist/build/DefaultRules.hs" #-} + +{-# LINE 578 "./src-ag/DefaultRules.ag" #-} + +elimSelfId :: NontermIdent -> [Identifier] -> Type -> Type +elimSelfId nt args Self = NT nt (map getName args) False +elimSelfId _ _ tp = tp + +elimSelfStr :: NontermIdent -> [String] -> Type -> Type +elimSelfStr nt args Self = NT nt args False +elimSelfStr _ _ tp = tp +{-# LINE 362 "dist/build/DefaultRules.hs" #-} + +{-# LINE 630 "./src-ag/DefaultRules.ag" #-} + +-- When a rule has a name, create an alias for a rule +-- and a modified rule that refers to the alias +-- Thus it removes rule names from rules +mkRuleAlias :: Rule -> (Rule, Maybe Rule) +mkRuleAlias r@(Rule Nothing _ _ _ _ _ _ _ _ _) = (r, Nothing) +mkRuleAlias (Rule (Just nm) pat expr owrt origin expl pure identity mbErr eager) = (r', Just alias) where + alias = Rule Nothing (Alias _LOC (Ident ("_rule_" ++ show nm) pos) (Underscore pos)) expr owrt origin expl pure identity mbErr eager + pos = getPos nm + expr' = Expression pos tks + tks = [mkLocVar (Ident ("_rule_" ++ show nm) pos) pos (Just ("Indirection to rule " ++ show nm))] + r' = Rule Nothing pat expr' owrt origin False True identity Nothing False +{-# LINE 377 "dist/build/DefaultRules.hs" #-} + +{-# LINE 647 "./src-ag/DefaultRules.ag" #-} + +needsMultiRules :: Options -> Bool +needsMultiRules opts = (visit opts || withCycle opts) && not (kennedyWarren opts) +{-# LINE 383 "dist/build/DefaultRules.hs" #-} + +{-# LINE 652 "./src-ag/DefaultRules.ag" #-} + +{- +multiRule replaces + loc.(a,b) = e +by + loc.tup1 = e + loc.(a,_) = @loc.tup1 + loc.(_,b) = @loc.tup1 +It needs to thread a unique number for inventing names for the tuples. + +It also works for nested tuples: + loc.(a,(b,c)) = e +becomes + loc.tup1 = e + loc.(a,_) = @loc.tup1 + loc.(_,tup2) = @loc.tup1 + loc.(b,_) = @loc.tup2 + loc.(_,c) = @loc.tup2 +-} + +multiRule :: Rule -> Int -> ([Rule], Int) +multiRule (Rule _ pat expr owrt origin expl pure identity mbErr eager) uniq + = let f :: Bool -> (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int)) + f expl' w e (Product pos pats) n + = let freshName = Ident ("_tup" ++ show n) pos + freshExpr = Expression pos freshTks + freshTks = [AGField _LOC freshName pos Nothing] + freshPat = Alias _LOC freshName (Underscore pos) + a = length pats - 1 + us b p = Product pos (replicate (a-b) (Underscore pos) ++ [p] ++ replicate b (Underscore pos)) + g :: Pattern -> ([Pattern],[Rule],Int) -> ([Pattern],[Rule],Int) + g p (xs1,rs1,n1) = let (x2,(rs2,n2)) = f False (us (length xs1)) freshExpr p n1 + in (x2:xs1, rs2++rs1, n2) + (xs9,rs9,n9) = foldr g ([], [], n+1) pats + in ( freshPat + , ( Rule Nothing (w freshPat) e owrt origin expl' True False mbErr eager : rs9 + , n9 + ) + ) + f expl' w e p n + = ( p + , ( [Rule Nothing (w p) e owrt origin expl' True False mbErr eager] + , n + ) + ) + in snd (f expl id expr pat uniq) + +{-# LINE 433 "dist/build/DefaultRules.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + cr : Bool + inhMap : Map Identifier Attributes + merged : Set Identifier + nt : NontermIdent + params : [Identifier] + synMap : Map Identifier Attributes + synthesized attributes: + errors : Seq Error + field : (Identifier,Type,ChildKind) + inherited : Attributes + name : Identifier + output : Child + synthesized : Attributes + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child kind : {ChildKind} + visit 0: + local chnt : _ + local inh : _ + local _tup1 : _ + local params : _ + local nt : _ + local inh1 : _ + local syn : _ + local syn1 : _ +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child !(Child _name _tp _kind) = + (sem_Child_Child _name _tp _kind) +-- semantic domain +newtype T_Child = T_Child (ConstructorIdent -> + Bool -> + (Map Identifier Attributes) -> + (Set Identifier) -> + NontermIdent -> + ([Identifier]) -> + (Map Identifier Attributes) -> + ( (Seq Error),( (Identifier,Type,ChildKind) ),Attributes,Identifier,Child,Attributes)) +data Inh_Child = Inh_Child {con_Inh_Child :: !(ConstructorIdent),cr_Inh_Child :: !(Bool),inhMap_Inh_Child :: !((Map Identifier Attributes)),merged_Inh_Child :: !((Set Identifier)),nt_Inh_Child :: !(NontermIdent),params_Inh_Child :: !(([Identifier])),synMap_Inh_Child :: !((Map Identifier Attributes))} +data Syn_Child = Syn_Child {errors_Syn_Child :: !((Seq Error)),field_Syn_Child :: !(( (Identifier,Type,ChildKind) )),inherited_Syn_Child :: !(Attributes),name_Syn_Child :: !(Identifier),output_Syn_Child :: !(Child),synthesized_Syn_Child :: !(Attributes)} +wrap_Child :: T_Child -> + Inh_Child -> + Syn_Child +wrap_Child !(T_Child sem) !(Inh_Child _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) = + (let ( !_lhsOerrors,!_lhsOfield,!_lhsOinherited,!_lhsOname,!_lhsOoutput,!_lhsOsynthesized) = sem _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap + in (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized)) +sem_Child_Child :: Identifier -> + Type -> + ChildKind -> + T_Child +sem_Child_Child !name_ !tp_ !kind_ = + (T_Child (\ (!_lhsIcon) + (!_lhsIcr) + (!_lhsIinhMap) + (!_lhsImerged) + (!_lhsInt) + (!_lhsIparams) + (!_lhsIsynMap) -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + Seq.empty + {-# LINE 503 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 546 "./src-ag/DefaultRules.ag" #-} + (name_,tp_,kind_) + {-# LINE 508 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOfield -> + (case (({-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + case tp_ of + NT nt _ _ -> nt + Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") + Haskell t -> identifier "" + {-# LINE 516 "dist/build/DefaultRules.hs" #-} + )) of + { !_chnt -> + (case (({-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIinhMap + {-# LINE 521 "dist/build/DefaultRules.hs" #-} + )) of + { !_inh -> + (case (({-# LINE 568 "./src-ag/DefaultRules.ag" #-} + case tp_ of + NT nt params _ -> (nt, params) + Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") + Haskell t -> (identifier t, []) + {-# LINE 529 "dist/build/DefaultRules.hs" #-} + )) of + { !__tup1 -> + (case (({-# LINE 568 "./src-ag/DefaultRules.ag" #-} + __tup1 + {-# LINE 534 "dist/build/DefaultRules.hs" #-} + )) of + { !(_,!_params) -> + (case (({-# LINE 568 "./src-ag/DefaultRules.ag" #-} + __tup1 + {-# LINE 539 "dist/build/DefaultRules.hs" #-} + )) of + { !(!_nt,_) -> + (case (({-# LINE 572 "./src-ag/DefaultRules.ag" #-} + Map.map (elimSelfStr _nt _params ) _inh + {-# LINE 544 "dist/build/DefaultRules.hs" #-} + )) of + { !_inh1 -> + (case (({-# LINE 209 "./src-ag/DefaultRules.ag" #-} + _inh1 + {-# LINE 549 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOinherited -> + (case (({-# LINE 200 "./src-ag/DefaultRules.ag" #-} + name_ + {-# LINE 554 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOname -> + (case (({-# LINE 614 "./src-ag/DefaultRules.ag" #-} + Child name_ tp_ kind_ + {-# LINE 559 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIsynMap + {-# LINE 564 "dist/build/DefaultRules.hs" #-} + )) of + { !_syn -> + (case (({-# LINE 573 "./src-ag/DefaultRules.ag" #-} + Map.map (elimSelfStr _nt _params ) _syn + {-# LINE 569 "dist/build/DefaultRules.hs" #-} + )) of + { !_syn1 -> + (case (({-# LINE 210 "./src-ag/DefaultRules.ag" #-} + if name_ `Set.member` _lhsImerged + then Map.empty + else _syn1 + {-# LINE 576 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOsynthesized -> + ( _lhsOerrors,_lhsOfield,_lhsOinherited,_lhsOname,_lhsOoutput,_lhsOsynthesized) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +-- Children ---------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + cr : Bool + inhMap : Map Identifier Attributes + merged : Set Identifier + nt : NontermIdent + params : [Identifier] + synMap : Map Identifier Attributes + synthesized attributes: + errors : Seq Error + fields : [(Identifier,Type,ChildKind)] + inputs : [(Identifier, Attributes)] + output : Children + 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 -> + (Map Identifier Attributes) -> + (Set Identifier) -> + NontermIdent -> + ([Identifier]) -> + (Map Identifier Attributes) -> + ( (Seq Error),([(Identifier,Type,ChildKind)]),([(Identifier, Attributes)]),Children,([(Identifier, Attributes)]))) +data Inh_Children = Inh_Children {con_Inh_Children :: !(ConstructorIdent),cr_Inh_Children :: !(Bool),inhMap_Inh_Children :: !((Map Identifier Attributes)),merged_Inh_Children :: !((Set Identifier)),nt_Inh_Children :: !(NontermIdent),params_Inh_Children :: !(([Identifier])),synMap_Inh_Children :: !((Map Identifier Attributes))} +data Syn_Children = Syn_Children {errors_Syn_Children :: !((Seq Error)),fields_Syn_Children :: !(([(Identifier,Type,ChildKind)])),inputs_Syn_Children :: !(([(Identifier, Attributes)])),output_Syn_Children :: !(Children),outputs_Syn_Children :: !(([(Identifier, Attributes)]))} +wrap_Children :: T_Children -> + Inh_Children -> + Syn_Children +wrap_Children !(T_Children sem) !(Inh_Children _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) = + (let ( !_lhsOerrors,!_lhsOfields,!_lhsOinputs,!_lhsOoutput,!_lhsOoutputs) = sem _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap + 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) + (!_lhsIinhMap) + (!_lhsImerged) + (!_lhsInt) + (!_lhsIparams) + (!_lhsIsynMap) -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 642 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOsynMap -> + (case (({-# LINE 42 "./src-ag/DefaultRules.ag" #-} + _lhsIparams + {-# LINE 647 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOparams -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 652 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 788 "./src-ag/DefaultRules.ag" #-} + _lhsImerged + {-# LINE 657 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOmerged -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 662 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOinhMap -> + (case (({-# LINE 56 "./src-ag/DefaultRules.ag" #-} + _lhsIcr + {-# LINE 667 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOcr -> + (case (({-# LINE 40 "./src-ag/DefaultRules.ag" #-} + _lhsIcon + {-# LINE 672 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOcon -> + (case (tl_ _tlOcon _tlOcr _tlOinhMap _tlOmerged _tlOnt _tlOparams _tlOsynMap) of + { ( !_tlIerrors,!_tlIfields,!_tlIinputs,!_tlIoutput,!_tlIoutputs) -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 679 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOsynMap -> + (case (({-# LINE 42 "./src-ag/DefaultRules.ag" #-} + _lhsIparams + {-# LINE 684 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOparams -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 689 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 788 "./src-ag/DefaultRules.ag" #-} + _lhsImerged + {-# LINE 694 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOmerged -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 699 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOinhMap -> + (case (({-# LINE 56 "./src-ag/DefaultRules.ag" #-} + _lhsIcr + {-# LINE 704 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOcr -> + (case (({-# LINE 40 "./src-ag/DefaultRules.ag" #-} + _lhsIcon + {-# LINE 709 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOcon -> + (case (hd_ _hdOcon _hdOcr _hdOinhMap _hdOmerged _hdOnt _hdOparams _hdOsynMap) of + { ( !_hdIerrors,!_hdIfield,!_hdIinherited,!_hdIname,!_hdIoutput,!_hdIsynthesized) -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 716 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 542 "./src-ag/DefaultRules.ag" #-} + _hdIfield : _tlIfields + {-# LINE 721 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOfields -> + (case (({-# LINE 215 "./src-ag/DefaultRules.ag" #-} + (_hdIname, _hdIinherited) : _tlIinputs + {-# LINE 726 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOinputs -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 731 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 736 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 216 "./src-ag/DefaultRules.ag" #-} + (_hdIname, _hdIsynthesized) : _tlIoutputs + {-# LINE 741 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutputs -> + ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (\ (!_lhsIcon) + (!_lhsIcr) + (!_lhsIinhMap) + (!_lhsImerged) + (!_lhsInt) + (!_lhsIparams) + (!_lhsIsynMap) -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + Seq.empty + {-# LINE 756 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 543 "./src-ag/DefaultRules.ag" #-} + [] + {-# LINE 761 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOfields -> + (case (({-# LINE 217 "./src-ag/DefaultRules.ag" #-} + [] + {-# LINE 766 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOinputs -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + [] + {-# LINE 771 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 776 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 218 "./src-ag/DefaultRules.ag" #-} + [] + {-# LINE 781 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutputs -> + ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) }) }) }) }) }) }))) +-- Grammar ----------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + errors : Seq Error + output : Grammar + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} + visit 0: + local output : _ +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) +-- semantic domain +newtype T_Grammar = T_Grammar (Options -> + ( (Seq Error),Grammar)) +data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: !(Options)} +data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: !((Seq Error)),output_Syn_Grammar :: !(Grammar)} +wrap_Grammar :: T_Grammar -> + Inh_Grammar -> + Syn_Grammar +wrap_Grammar !(T_Grammar sem) !(Inh_Grammar _lhsIoptions) = + (let ( !_lhsOerrors,!_lhsOoutput) = sem _lhsIoptions + in (Syn_Grammar _lhsOerrors _lhsOoutput)) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !quantMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ !mergeMap_ = + (T_Grammar (\ (!_lhsIoptions) -> + (case (({-# LINE 51 "./src-ag/DefaultRules.ag" #-} + _lhsIoptions + {-# LINE 847 "dist/build/DefaultRules.hs" #-} + )) of + { !_nontsOoptions -> + (case (nonts_) of + { ( !_nontsIcollect_nts,!_nontsIinhMap',!_nontsIsynMap',!T_Nonterminals_1 nonts_1) -> + (case (({-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + _nontsIsynMap' + {-# LINE 854 "dist/build/DefaultRules.hs" #-} + )) of + { !_nontsOsynMap -> + (case (({-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + _nontsIinhMap' + {-# LINE 859 "dist/build/DefaultRules.hs" #-} + )) of + { !_nontsOinhMap -> + (case (({-# LINE 790 "./src-ag/DefaultRules.ag" #-} + mergeMap_ + {-# LINE 864 "dist/build/DefaultRules.hs" #-} + )) of + { !_nontsOmergesIn -> + (case (({-# LINE 709 "./src-ag/DefaultRules.ag" #-} + manualAttrOrderMap_ + {-# LINE 869 "dist/build/DefaultRules.hs" #-} + )) of + { !_nontsOmanualAttrOrderMap -> + (case (({-# LINE 204 "./src-ag/DefaultRules.ag" #-} + typeSyns_ + {-# LINE 874 "dist/build/DefaultRules.hs" #-} + )) of + { !_nontsOtypeSyns -> + (case (({-# LINE 202 "./src-ag/DefaultRules.ag" #-} + useMap_ + {-# LINE 879 "dist/build/DefaultRules.hs" #-} + )) of + { !_nontsOuseMap -> + (case (({-# LINE 67 "./src-ag/DefaultRules.ag" #-} + wrappers_ + {-# LINE 884 "dist/build/DefaultRules.hs" #-} + )) of + { !_nontsOwrappers -> + (case (({-# LINE 59 "./src-ag/DefaultRules.ag" #-} + modcopy _lhsIoptions + {-# LINE 889 "dist/build/DefaultRules.hs" #-} + )) of + { !_nontsOcr -> + (case (({-# LINE 58 "./src-ag/DefaultRules.ag" #-} + rename _lhsIoptions + {-# LINE 894 "dist/build/DefaultRules.hs" #-} + )) of + { !_nontsOo_rename -> + (case (({-# LINE 782 "./src-ag/DefaultRules.ag" #-} + aroundsMap_ + {-# LINE 899 "dist/build/DefaultRules.hs" #-} + )) of + { !_nontsOaroundsIn -> + (case (({-# LINE 775 "./src-ag/DefaultRules.ag" #-} + augmentsMap_ + {-# LINE 904 "dist/build/DefaultRules.hs" #-} + )) of + { !_nontsOaugmentsIn -> + (case (({-# LINE 595 "./src-ag/DefaultRules.ag" #-} + 1 + {-# LINE 909 "dist/build/DefaultRules.hs" #-} + )) of + { !_nontsOuniq -> + (case (({-# LINE 180 "./src-ag/DefaultRules.ag" #-} + _nontsIcollect_nts + {-# LINE 914 "dist/build/DefaultRules.hs" #-} + )) of + { !_nontsOnonterminals -> + (case (nonts_1 _nontsOaroundsIn _nontsOaugmentsIn _nontsOcr _nontsOinhMap _nontsOmanualAttrOrderMap _nontsOmergesIn _nontsOnonterminals _nontsOo_rename _nontsOoptions _nontsOsynMap _nontsOtypeSyns _nontsOuniq _nontsOuseMap _nontsOwrappers) of + { ( !_nontsIerrors,!_nontsIoutput,!_nontsIuniq) -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + _nontsIerrors + {-# LINE 921 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ + {-# LINE 926 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 931 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + synthesized attributes: + collect_nts : Set NontermIdent + inhMap' : Map Identifier Attributes + synMap' : Map Identifier Attributes + visit 1: + inherited attributes: + aroundsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + cr : Bool + inhMap : Map Identifier Attributes + manualAttrOrderMap : AttrOrderMap + mergesIn : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) + nonterminals : Set NontermIdent + o_rename : Bool + options : Options + synMap : Map Identifier Attributes + typeSyns : TypeSyns + useMap : UseMap + wrappers : Set NontermIdent + chained attribute: + uniq : Int + synthesized attributes: + errors : Seq Error + output : Nonterminal + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions + visit 1: + local mergesIn : _ + local syn1 : _ + local inh1 : _ + local augmentsIn : _ + local aroundsIn : _ +-} +-- 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),(Map Identifier Attributes),(Map Identifier Attributes),T_Nonterminal_1)) +newtype T_Nonterminal_1 = T_Nonterminal_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + Bool -> + (Map Identifier Attributes) -> + AttrOrderMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> + (Set NontermIdent) -> + Bool -> + Options -> + (Map Identifier Attributes) -> + TypeSyns -> + Int -> + UseMap -> + (Set NontermIdent) -> + ( (Seq Error),Nonterminal,Int)) +data Inh_Nonterminal = Inh_Nonterminal {aroundsIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),augmentsIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cr_Inh_Nonterminal :: !(Bool),inhMap_Inh_Nonterminal :: !((Map Identifier Attributes)),manualAttrOrderMap_Inh_Nonterminal :: !(AttrOrderMap),mergesIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))))),nonterminals_Inh_Nonterminal :: !((Set NontermIdent)),o_rename_Inh_Nonterminal :: !(Bool),options_Inh_Nonterminal :: !(Options),synMap_Inh_Nonterminal :: !((Map Identifier Attributes)),typeSyns_Inh_Nonterminal :: !(TypeSyns),uniq_Inh_Nonterminal :: !(Int),useMap_Inh_Nonterminal :: !(UseMap),wrappers_Inh_Nonterminal :: !((Set NontermIdent))} +data Syn_Nonterminal = Syn_Nonterminal {collect_nts_Syn_Nonterminal :: !((Set NontermIdent)),errors_Syn_Nonterminal :: !((Seq Error)),inhMap'_Syn_Nonterminal :: !((Map Identifier Attributes)),output_Syn_Nonterminal :: !(Nonterminal),synMap'_Syn_Nonterminal :: !((Map Identifier Attributes)),uniq_Syn_Nonterminal :: !(Int)} +wrap_Nonterminal :: T_Nonterminal -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal !(T_Nonterminal sem) !(Inh_Nonterminal _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = + (let ( !_lhsOcollect_nts,!_lhsOinhMap',!_lhsOsynMap',!T_Nonterminal_1 sem_1) = sem + ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem_1 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers + in (Syn_Nonterminal _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq)) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal !nt_ !params_ !inh_ !syn_ !(T_Productions prods_) = + (T_Nonterminal (case (({-# LINE 176 "./src-ag/DefaultRules.ag" #-} + Set.singleton nt_ + {-# LINE 1016 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcollect_nts -> + (case (({-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 1021 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOinhMap' -> + (case (({-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 1026 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOsynMap' -> + (case ((let sem_Nonterminal_Nonterminal_1 :: T_Nonterminal_1 + sem_Nonterminal_Nonterminal_1 = + (T_Nonterminal_1 (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsIinhMap) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsIo_rename) + (!_lhsIoptions) + (!_lhsIsynMap) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) + (!_lhsIwrappers) -> + (case (({-# LINE 65 "./src-ag/DefaultRules.ag" #-} + _lhsIwrappers + {-# LINE 1047 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOwrappers -> + (case (({-# LINE 72 "./src-ag/DefaultRules.ag" #-} + _lhsItypeSyns + {-# LINE 1052 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOtypeSyns -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1057 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOsynMap -> + (case (({-# LINE 51 "./src-ag/DefaultRules.ag" #-} + _lhsIoptions + {-# LINE 1062 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOoptions -> + (case (({-# LINE 52 "./src-ag/DefaultRules.ag" #-} + _lhsIo_rename + {-# LINE 1067 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOo_rename -> + (case (({-# LINE 791 "./src-ag/DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsImergesIn + {-# LINE 1072 "dist/build/DefaultRules.hs" #-} + )) of + { !_mergesIn -> + (case (({-# LINE 787 "./src-ag/DefaultRules.ag" #-} + _mergesIn + {-# LINE 1077 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOmergesIn -> + (case (({-# LINE 705 "./src-ag/DefaultRules.ag" #-} + _lhsImanualAttrOrderMap + {-# LINE 1082 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOmanualAttrOrderMap -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1087 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOinhMap -> + (case (({-# LINE 53 "./src-ag/DefaultRules.ag" #-} + _lhsIcr + {-# LINE 1092 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOcr -> + (case (({-# LINE 565 "./src-ag/DefaultRules.ag" #-} + Map.map (elimSelfId nt_ params_) syn_ + {-# LINE 1097 "dist/build/DefaultRules.hs" #-} + )) of + { !_syn1 -> + (case (({-# LINE 564 "./src-ag/DefaultRules.ag" #-} + Map.map (elimSelfId nt_ params_) inh_ + {-# LINE 1102 "dist/build/DefaultRules.hs" #-} + )) of + { !_inh1 -> + (case (({-# LINE 206 "./src-ag/DefaultRules.ag" #-} + nt_ + {-# LINE 1107 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOnt -> + (case (({-# LINE 194 "./src-ag/DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIuseMap + {-# LINE 1112 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOuseMap -> + (case (({-# LINE 193 "./src-ag/DefaultRules.ag" #-} + syn_ + {-# LINE 1117 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOsynOrig -> + (case (({-# LINE 191 "./src-ag/DefaultRules.ag" #-} + _syn1 + {-# LINE 1122 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOsyn -> + (case (({-# LINE 190 "./src-ag/DefaultRules.ag" #-} + _inh1 + {-# LINE 1127 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOinh -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 1132 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOuniq -> + (case (({-# LINE 178 "./src-ag/DefaultRules.ag" #-} + _lhsInonterminals + {-# LINE 1137 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOnonterminals -> + (case (({-# LINE 776 "./src-ag/DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn + {-# LINE 1142 "dist/build/DefaultRules.hs" #-} + )) of + { !_augmentsIn -> + (case (({-# LINE 773 "./src-ag/DefaultRules.ag" #-} + _augmentsIn + {-# LINE 1147 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOaugmentsIn -> + (case (({-# LINE 783 "./src-ag/DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaroundsIn + {-# LINE 1152 "dist/build/DefaultRules.hs" #-} + )) of + { !_aroundsIn -> + (case (({-# LINE 780 "./src-ag/DefaultRules.ag" #-} + _aroundsIn + {-# LINE 1157 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOaroundsIn -> + (case (({-# LINE 192 "./src-ag/DefaultRules.ag" #-} + inh_ + {-# LINE 1162 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOinhOrig -> + (case (({-# LINE 44 "./src-ag/DefaultRules.ag" #-} + params_ + {-# LINE 1167 "dist/build/DefaultRules.hs" #-} + )) of + { !_prodsOparams -> + (case (prods_ _prodsOaroundsIn _prodsOaugmentsIn _prodsOcr _prodsOinh _prodsOinhMap _prodsOinhOrig _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnonterminals _prodsOnt _prodsOo_rename _prodsOoptions _prodsOparams _prodsOsyn _prodsOsynMap _prodsOsynOrig _prodsOtypeSyns _prodsOuniq _prodsOuseMap _prodsOwrappers) of + { ( !_prodsIerrors,!_prodsIoutput,!_prodsIuniq) -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + _prodsIerrors + {-# LINE 1174 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 604 "./src-ag/DefaultRules.ag" #-} + Nonterminal nt_ params_ _inh1 _syn1 _prodsIoutput + {-# LINE 1179 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _prodsIuniq + {-# LINE 1184 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_Nonterminal_Nonterminal_1)) of + { ( !sem_Nonterminal_1) -> + ( _lhsOcollect_nts,_lhsOinhMap',_lhsOsynMap',sem_Nonterminal_1) }) }) }) })) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + synthesized attributes: + collect_nts : Set NontermIdent + inhMap' : Map Identifier Attributes + synMap' : Map Identifier Attributes + visit 1: + inherited attributes: + aroundsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + cr : Bool + inhMap : Map Identifier Attributes + manualAttrOrderMap : AttrOrderMap + mergesIn : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) + nonterminals : Set NontermIdent + o_rename : Bool + options : Options + synMap : Map Identifier Attributes + typeSyns : TypeSyns + useMap : UseMap + wrappers : Set NontermIdent + chained attribute: + uniq : Int + synthesized attributes: + errors : Seq Error + output : Nonterminals + 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),(Map Identifier Attributes),(Map Identifier Attributes),T_Nonterminals_1)) +newtype T_Nonterminals_1 = T_Nonterminals_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + Bool -> + (Map Identifier Attributes) -> + AttrOrderMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> + (Set NontermIdent) -> + Bool -> + Options -> + (Map Identifier Attributes) -> + TypeSyns -> + Int -> + UseMap -> + (Set NontermIdent) -> + ( (Seq Error),Nonterminals,Int)) +data Inh_Nonterminals = Inh_Nonterminals {aroundsIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),augmentsIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cr_Inh_Nonterminals :: !(Bool),inhMap_Inh_Nonterminals :: !((Map Identifier Attributes)),manualAttrOrderMap_Inh_Nonterminals :: !(AttrOrderMap),mergesIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))))),nonterminals_Inh_Nonterminals :: !((Set NontermIdent)),o_rename_Inh_Nonterminals :: !(Bool),options_Inh_Nonterminals :: !(Options),synMap_Inh_Nonterminals :: !((Map Identifier Attributes)),typeSyns_Inh_Nonterminals :: !(TypeSyns),uniq_Inh_Nonterminals :: !(Int),useMap_Inh_Nonterminals :: !(UseMap),wrappers_Inh_Nonterminals :: !((Set NontermIdent))} +data Syn_Nonterminals = Syn_Nonterminals {collect_nts_Syn_Nonterminals :: !((Set NontermIdent)),errors_Syn_Nonterminals :: !((Seq Error)),inhMap'_Syn_Nonterminals :: !((Map Identifier Attributes)),output_Syn_Nonterminals :: !(Nonterminals),synMap'_Syn_Nonterminals :: !((Map Identifier Attributes)),uniq_Syn_Nonterminals :: !(Int)} +wrap_Nonterminals :: T_Nonterminals -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals !(T_Nonterminals sem) !(Inh_Nonterminals _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = + (let ( !_lhsOcollect_nts,!_lhsOinhMap',!_lhsOsynMap',!T_Nonterminals_1 sem_1) = sem + ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem_1 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers + in (Syn_Nonterminals _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _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,!_tlIinhMap',!_tlIsynMap',!T_Nonterminals_1 tl_1) -> + (case (hd_) of + { ( !_hdIcollect_nts,!_hdIinhMap',!_hdIsynMap',!T_Nonterminal_1 hd_1) -> + (case (({-# LINE 174 "./src-ag/DefaultRules.ag" #-} + _hdIcollect_nts `Set.union` _tlIcollect_nts + {-# LINE 1269 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcollect_nts -> + (case (({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + _hdIinhMap' `Map.union` _tlIinhMap' + {-# LINE 1274 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOinhMap' -> + (case (({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + _hdIsynMap' `Map.union` _tlIsynMap' + {-# LINE 1279 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOsynMap' -> + (case ((let sem_Nonterminals_Cons_1 :: T_Nonterminals_1 + sem_Nonterminals_Cons_1 = + (T_Nonterminals_1 (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsIinhMap) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsIo_rename) + (!_lhsIoptions) + (!_lhsIsynMap) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) + (!_lhsIwrappers) -> + (case (({-# LINE 65 "./src-ag/DefaultRules.ag" #-} + _lhsIwrappers + {-# LINE 1300 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOwrappers -> + (case (({-# LINE 186 "./src-ag/DefaultRules.ag" #-} + _lhsIuseMap + {-# LINE 1305 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOuseMap -> + (case (({-# LINE 72 "./src-ag/DefaultRules.ag" #-} + _lhsItypeSyns + {-# LINE 1310 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOtypeSyns -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1315 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOsynMap -> + (case (({-# LINE 51 "./src-ag/DefaultRules.ag" #-} + _lhsIoptions + {-# LINE 1320 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 52 "./src-ag/DefaultRules.ag" #-} + _lhsIo_rename + {-# LINE 1325 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOo_rename -> + (case (({-# LINE 786 "./src-ag/DefaultRules.ag" #-} + _lhsImergesIn + {-# LINE 1330 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOmergesIn -> + (case (({-# LINE 705 "./src-ag/DefaultRules.ag" #-} + _lhsImanualAttrOrderMap + {-# LINE 1335 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOmanualAttrOrderMap -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1340 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOinhMap -> + (case (({-# LINE 53 "./src-ag/DefaultRules.ag" #-} + _lhsIcr + {-# LINE 1345 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOcr -> + (case (({-# LINE 65 "./src-ag/DefaultRules.ag" #-} + _lhsIwrappers + {-# LINE 1350 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOwrappers -> + (case (({-# LINE 186 "./src-ag/DefaultRules.ag" #-} + _lhsIuseMap + {-# LINE 1355 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOuseMap -> + (case (({-# LINE 72 "./src-ag/DefaultRules.ag" #-} + _lhsItypeSyns + {-# LINE 1360 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOtypeSyns -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1365 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOsynMap -> + (case (({-# LINE 51 "./src-ag/DefaultRules.ag" #-} + _lhsIoptions + {-# LINE 1370 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 52 "./src-ag/DefaultRules.ag" #-} + _lhsIo_rename + {-# LINE 1375 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOo_rename -> + (case (({-# LINE 786 "./src-ag/DefaultRules.ag" #-} + _lhsImergesIn + {-# LINE 1380 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOmergesIn -> + (case (({-# LINE 705 "./src-ag/DefaultRules.ag" #-} + _lhsImanualAttrOrderMap + {-# LINE 1385 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOmanualAttrOrderMap -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1390 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOinhMap -> + (case (({-# LINE 53 "./src-ag/DefaultRules.ag" #-} + _lhsIcr + {-# LINE 1395 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOcr -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 1400 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOuniq -> + (case (({-# LINE 178 "./src-ag/DefaultRules.ag" #-} + _lhsInonterminals + {-# LINE 1405 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOnonterminals -> + (case (({-# LINE 772 "./src-ag/DefaultRules.ag" #-} + _lhsIaugmentsIn + {-# LINE 1410 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOaugmentsIn -> + (case (({-# LINE 779 "./src-ag/DefaultRules.ag" #-} + _lhsIaroundsIn + {-# LINE 1415 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOaroundsIn -> + (case (hd_1 _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOnonterminals _hdOo_rename _hdOoptions _hdOsynMap _hdOtypeSyns _hdOuniq _hdOuseMap _hdOwrappers) of + { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _hdIuniq + {-# LINE 1422 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOuniq -> + (case (({-# LINE 178 "./src-ag/DefaultRules.ag" #-} + _lhsInonterminals + {-# LINE 1427 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOnonterminals -> + (case (({-# LINE 772 "./src-ag/DefaultRules.ag" #-} + _lhsIaugmentsIn + {-# LINE 1432 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOaugmentsIn -> + (case (({-# LINE 779 "./src-ag/DefaultRules.ag" #-} + _lhsIaroundsIn + {-# LINE 1437 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOaroundsIn -> + (case (tl_1 _tlOaroundsIn _tlOaugmentsIn _tlOcr _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOnonterminals _tlOo_rename _tlOoptions _tlOsynMap _tlOtypeSyns _tlOuniq _tlOuseMap _tlOwrappers) of + { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 1444 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 1449 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 1454 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _tlIuniq + {-# LINE 1459 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_Nonterminals_Cons_1)) of + { ( !sem_Nonterminals_1) -> + ( _lhsOcollect_nts,_lhsOinhMap',_lhsOsynMap',sem_Nonterminals_1) }) }) }) }) }) })) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (case (({-# LINE 174 "./src-ag/DefaultRules.ag" #-} + Set.empty + {-# LINE 1470 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcollect_nts -> + (case (({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + Map.empty + {-# LINE 1475 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOinhMap' -> + (case (({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + Map.empty + {-# LINE 1480 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOsynMap' -> + (case ((let sem_Nonterminals_Nil_1 :: T_Nonterminals_1 + sem_Nonterminals_Nil_1 = + (T_Nonterminals_1 (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsIinhMap) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsIo_rename) + (!_lhsIoptions) + (!_lhsIsynMap) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) + (!_lhsIwrappers) -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + Seq.empty + {-# LINE 1501 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + [] + {-# LINE 1506 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 1511 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 1516 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }))) + in sem_Nonterminals_Nil_1)) of + { ( !sem_Nonterminals_1) -> + ( _lhsOcollect_nts,_lhsOinhMap',_lhsOsynMap',sem_Nonterminals_1) }) }) }) })) +-- Pattern ----------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + nt : NontermIdent + synthesized attributes: + containsVars : Bool + copy : Pattern + definedAttrs : Set (Identifier,Identifier) + errors : Seq Error + locals : Set Identifier + output : Pattern + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + local output : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + local output : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local copy : _ + local output : _ + alternative Irrefutable: + child pat : Pattern + 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 !(Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern !(Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern !(Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern !(Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +sem_Pattern !(Underscore _pos) = + (sem_Pattern_Underscore _pos) +-- semantic domain +newtype T_Pattern = T_Pattern (ConstructorIdent -> + NontermIdent -> + ( Bool,Pattern,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Pattern)) +data Inh_Pattern = Inh_Pattern {con_Inh_Pattern :: !(ConstructorIdent),nt_Inh_Pattern :: !(NontermIdent)} +data Syn_Pattern = Syn_Pattern {containsVars_Syn_Pattern :: !(Bool),copy_Syn_Pattern :: !(Pattern),definedAttrs_Syn_Pattern :: !((Set (Identifier,Identifier))),errors_Syn_Pattern :: !((Seq Error)),locals_Syn_Pattern :: !((Set Identifier)),output_Syn_Pattern :: !(Pattern)} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern !(T_Pattern sem) !(Inh_Pattern _lhsIcon _lhsInt) = + (let ( !_lhsOcontainsVars,!_lhsOcopy,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput) = sem _lhsIcon _lhsInt + in (Syn_Pattern _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput)) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr !name_ !(T_Patterns pats_) = + (T_Pattern (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 1600 "dist/build/DefaultRules.hs" #-} + )) of + { !_patsOnt -> + (case (({-# LINE 40 "./src-ag/DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1605 "dist/build/DefaultRules.hs" #-} + )) of + { !_patsOcon -> + (case (pats_ _patsOcon _patsOnt) of + { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) -> + (case (({-# LINE 551 "./src-ag/DefaultRules.ag" #-} + _patsIcontainsVars + {-# LINE 1612 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 1617 "dist/build/DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1622 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 531 "./src-ag/DefaultRules.ag" #-} + _patsIdefinedAttrs + {-# LINE 1627 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + _patsIerrors + {-# LINE 1632 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 530 "./src-ag/DefaultRules.ag" #-} + _patsIlocals + {-# LINE 1637 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + Constr name_ _patsIoutput + {-# LINE 1642 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 1647 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }))) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product !pos_ !(T_Patterns pats_) = + (T_Pattern (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 1659 "dist/build/DefaultRules.hs" #-} + )) of + { !_patsOnt -> + (case (({-# LINE 40 "./src-ag/DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1664 "dist/build/DefaultRules.hs" #-} + )) of + { !_patsOcon -> + (case (pats_ _patsOcon _patsOnt) of + { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) -> + (case (({-# LINE 551 "./src-ag/DefaultRules.ag" #-} + _patsIcontainsVars + {-# LINE 1671 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 1676 "dist/build/DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1681 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 531 "./src-ag/DefaultRules.ag" #-} + _patsIdefinedAttrs + {-# LINE 1686 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + _patsIerrors + {-# LINE 1691 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 530 "./src-ag/DefaultRules.ag" #-} + _patsIlocals + {-# LINE 1696 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + Product pos_ _patsIoutput + {-# LINE 1701 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 1706 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }))) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_) = + (T_Pattern (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 554 "./src-ag/DefaultRules.ag" #-} + True + {-# LINE 1719 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 1724 "dist/build/DefaultRules.hs" #-} + )) of + { !_patOnt -> + (case (({-# LINE 40 "./src-ag/DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1729 "dist/build/DefaultRules.hs" #-} + )) of + { !_patOcon -> + (case (pat_ _patOcon _patOnt) of + { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 1736 "dist/build/DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1741 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 536 "./src-ag/DefaultRules.ag" #-} + Set.insert (field_,attr_) _patIdefinedAttrs + {-# LINE 1746 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + _patIerrors + {-# LINE 1751 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 537 "./src-ag/DefaultRules.ag" #-} + if field_ == _LOC + then Set.insert attr_ _patIlocals + else _patIlocals + {-# LINE 1758 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + Alias field_ attr_ _patIoutput + {-# LINE 1763 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 1768 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }))) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable !(T_Pattern pat_) = + (T_Pattern (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 1779 "dist/build/DefaultRules.hs" #-} + )) of + { !_patOnt -> + (case (({-# LINE 40 "./src-ag/DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1784 "dist/build/DefaultRules.hs" #-} + )) of + { !_patOcon -> + (case (pat_ _patOcon _patOnt) of + { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) -> + (case (({-# LINE 551 "./src-ag/DefaultRules.ag" #-} + _patIcontainsVars + {-# LINE 1791 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 1796 "dist/build/DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1801 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 531 "./src-ag/DefaultRules.ag" #-} + _patIdefinedAttrs + {-# LINE 1806 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + _patIerrors + {-# LINE 1811 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 530 "./src-ag/DefaultRules.ag" #-} + _patIlocals + {-# LINE 1816 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + Irrefutable _patIoutput + {-# LINE 1821 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 1826 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore !pos_ = + (T_Pattern (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 551 "./src-ag/DefaultRules.ag" #-} + False + {-# LINE 1837 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 1842 "dist/build/DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1847 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 531 "./src-ag/DefaultRules.ag" #-} + Set.empty + {-# LINE 1852 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + Seq.empty + {-# LINE 1857 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 530 "./src-ag/DefaultRules.ag" #-} + Set.empty + {-# LINE 1862 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + Underscore pos_ + {-# LINE 1867 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 1872 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + nt : NontermIdent + synthesized attributes: + containsVars : Bool + copy : Patterns + definedAttrs : Set (Identifier,Identifier) + errors : Seq Error + locals : Set Identifier + output : Patterns + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + local output : _ + alternative Nil: + visit 0: + local copy : _ + local output : _ +-} +-- cata +sem_Patterns :: Patterns -> + T_Patterns +sem_Patterns !list = + (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list)) +-- semantic domain +newtype T_Patterns = T_Patterns (ConstructorIdent -> + NontermIdent -> + ( Bool,Patterns,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Patterns)) +data Inh_Patterns = Inh_Patterns {con_Inh_Patterns :: !(ConstructorIdent),nt_Inh_Patterns :: !(NontermIdent)} +data Syn_Patterns = Syn_Patterns {containsVars_Syn_Patterns :: !(Bool),copy_Syn_Patterns :: !(Patterns),definedAttrs_Syn_Patterns :: !((Set (Identifier,Identifier))),errors_Syn_Patterns :: !((Seq Error)),locals_Syn_Patterns :: !((Set Identifier)),output_Syn_Patterns :: !(Patterns)} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns !(T_Patterns sem) !(Inh_Patterns _lhsIcon _lhsInt) = + (let ( !_lhsOcontainsVars,!_lhsOcopy,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput) = sem _lhsIcon _lhsInt + in (Syn_Patterns _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons !(T_Pattern hd_) !(T_Patterns tl_) = + (T_Patterns (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 1926 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 40 "./src-ag/DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1931 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOcon -> + (case (tl_ _tlOcon _tlOnt) of + { ( !_tlIcontainsVars,!_tlIcopy,!_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput) -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 1938 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 40 "./src-ag/DefaultRules.ag" #-} + _lhsIcon + {-# LINE 1943 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOcon -> + (case (hd_ _hdOcon _hdOnt) of + { ( !_hdIcontainsVars,!_hdIcopy,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput) -> + (case (({-# LINE 551 "./src-ag/DefaultRules.ag" #-} + _hdIcontainsVars || _tlIcontainsVars + {-# LINE 1950 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 1955 "dist/build/DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1960 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 531 "./src-ag/DefaultRules.ag" #-} + _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs + {-# LINE 1965 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 1970 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 530 "./src-ag/DefaultRules.ag" #-} + _hdIlocals `Set.union` _tlIlocals + {-# LINE 1975 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 1980 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 1985 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (\ (!_lhsIcon) + (!_lhsInt) -> + (case (({-# LINE 551 "./src-ag/DefaultRules.ag" #-} + False + {-# LINE 1995 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 2000 "dist/build/DefaultRules.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 2005 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 531 "./src-ag/DefaultRules.ag" #-} + Set.empty + {-# LINE 2010 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + Seq.empty + {-# LINE 2015 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 530 "./src-ag/DefaultRules.ag" #-} + Set.empty + {-# LINE 2020 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + [] + {-# LINE 2025 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 2030 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }))) +-- Production -------------------------------------------------- +{- + visit 0: + inherited attributes: + aroundsIn : Map ConstructorIdent (Map Identifier [Expression]) + augmentsIn : Map ConstructorIdent (Map Identifier [Expression]) + cr : Bool + inh : Attributes + inhMap : Map Identifier Attributes + inhOrig : Attributes + manualAttrOrderMap : AttrOrderMap + mergesIn : Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)) + nonterminals : Set NontermIdent + nt : NontermIdent + o_rename : Bool + options : Options + params : [Identifier] + syn : Attributes + synMap : Map Identifier Attributes + synOrig : Attributes + typeSyns : TypeSyns + useMap : Map Identifier (String,String,String) + wrappers : Set NontermIdent + chained attribute: + uniq : Int + synthesized attributes: + errors : Seq Error + output : Production + alternatives: + alternative Production: + child con : {ConstructorIdent} + child params : {[Identifier]} + child constraints : {[Type]} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + child macro : {MaybeMacro} + visit 0: + local mergesIn : _ + local merged : _ + local orderDeps : _ + local orderErrs : _ + local _tup2 : _ + local errs : _ + local aroundsIn : _ + local augmentsIn : _ + local newRls : _ + local extra1 : _ + local extra2 : _ + local extra3 : _ +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production !(Production _con _params _constraints _children _rules _typeSigs _macro) = + (sem_Production_Production _con _params _constraints (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs) _macro) +-- semantic domain +newtype T_Production = T_Production ((Map ConstructorIdent (Map Identifier [Expression])) -> + (Map ConstructorIdent (Map Identifier [Expression])) -> + Bool -> + Attributes -> + (Map Identifier Attributes) -> + Attributes -> + AttrOrderMap -> + (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> + (Set NontermIdent) -> + NontermIdent -> + Bool -> + Options -> + ([Identifier]) -> + Attributes -> + (Map Identifier Attributes) -> + Attributes -> + TypeSyns -> + Int -> + (Map Identifier (String,String,String)) -> + (Set NontermIdent) -> + ( (Seq Error),Production,Int)) +data Inh_Production = Inh_Production {aroundsIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),augmentsIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),cr_Inh_Production :: !(Bool),inh_Inh_Production :: !(Attributes),inhMap_Inh_Production :: !((Map Identifier Attributes)),inhOrig_Inh_Production :: !(Attributes),manualAttrOrderMap_Inh_Production :: !(AttrOrderMap),mergesIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))),nonterminals_Inh_Production :: !((Set NontermIdent)),nt_Inh_Production :: !(NontermIdent),o_rename_Inh_Production :: !(Bool),options_Inh_Production :: !(Options),params_Inh_Production :: !(([Identifier])),syn_Inh_Production :: !(Attributes),synMap_Inh_Production :: !((Map Identifier Attributes)),synOrig_Inh_Production :: !(Attributes),typeSyns_Inh_Production :: !(TypeSyns),uniq_Inh_Production :: !(Int),useMap_Inh_Production :: !((Map Identifier (String,String,String))),wrappers_Inh_Production :: !((Set NontermIdent))} +data Syn_Production = Syn_Production {errors_Syn_Production :: !((Seq Error)),output_Syn_Production :: !(Production),uniq_Syn_Production :: !(Int)} +wrap_Production :: T_Production -> + Inh_Production -> + Syn_Production +wrap_Production !(T_Production sem) !(Inh_Production _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = + (let ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers + in (Syn_Production _lhsOerrors _lhsOoutput _lhsOuniq)) +sem_Production_Production :: ConstructorIdent -> + ([Identifier]) -> + ([Type]) -> + T_Children -> + T_Rules -> + T_TypeSigs -> + MaybeMacro -> + T_Production +sem_Production_Production !con_ !params_ !constraints_ !(T_Children children_) !(T_Rules rules_) !(T_TypeSigs typeSigs_) !macro_ = + (T_Production (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsIinh) + (!_lhsIinhMap) + (!_lhsIinhOrig) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsInt) + (!_lhsIo_rename) + (!_lhsIoptions) + (!_lhsIparams) + (!_lhsIsyn) + (!_lhsIsynMap) + (!_lhsIsynOrig) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) + (!_lhsIwrappers) -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2151 "dist/build/DefaultRules.hs" #-} + )) of + { !_childrenOsynMap -> + (case (({-# LINE 792 "./src-ag/DefaultRules.ag" #-} + Map.findWithDefault Map.empty con_ _lhsImergesIn + {-# LINE 2156 "dist/build/DefaultRules.hs" #-} + )) of + { !_mergesIn -> + (case (({-# LINE 793 "./src-ag/DefaultRules.ag" #-} + Set.fromList [ c | (_,cs,_) <- Map.elems _mergesIn , c <- cs ] + {-# LINE 2161 "dist/build/DefaultRules.hs" #-} + )) of + { !_merged -> + (case (({-# LINE 788 "./src-ag/DefaultRules.ag" #-} + _merged + {-# LINE 2166 "dist/build/DefaultRules.hs" #-} + )) of + { !_childrenOmerged -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 2171 "dist/build/DefaultRules.hs" #-} + )) of + { !_childrenOinhMap -> + (case (({-# LINE 719 "./src-ag/DefaultRules.ag" #-} + Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap + {-# LINE 2176 "dist/build/DefaultRules.hs" #-} + )) of + { !_orderDeps -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 2181 "dist/build/DefaultRules.hs" #-} + )) of + { !_rulesOuniq -> + (case (({-# LINE 51 "./src-ag/DefaultRules.ag" #-} + _lhsIoptions + {-# LINE 2186 "dist/build/DefaultRules.hs" #-} + )) of + { !_rulesOoptions -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 2191 "dist/build/DefaultRules.hs" #-} + )) of + { !_rulesOnt -> + (case (({-# LINE 197 "./src-ag/DefaultRules.ag" #-} + con_ + {-# LINE 2196 "dist/build/DefaultRules.hs" #-} + )) of + { !_rulesOcon -> + (case (rules_ _rulesOcon _rulesOnt _rulesOoptions _rulesOuniq) of + { ( !_rulesIdefinedAttrs,!_rulesIerrors,!_rulesIlocals,!_rulesIoutput,!_rulesIruleNames,!_rulesIuniq) -> + (case (({-# LINE 42 "./src-ag/DefaultRules.ag" #-} + _lhsIparams + {-# LINE 2203 "dist/build/DefaultRules.hs" #-} + )) of + { !_childrenOparams -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 2208 "dist/build/DefaultRules.hs" #-} + )) of + { !_childrenOnt -> + (case (({-# LINE 56 "./src-ag/DefaultRules.ag" #-} + _lhsIcr + {-# LINE 2213 "dist/build/DefaultRules.hs" #-} + )) of + { !_childrenOcr -> + (case (({-# LINE 198 "./src-ag/DefaultRules.ag" #-} + con_ + {-# LINE 2218 "dist/build/DefaultRules.hs" #-} + )) of + { !_childrenOcon -> + (case (children_ _childrenOcon _childrenOcr _childrenOinhMap _childrenOmerged _childrenOnt _childrenOparams _childrenOsynMap) of + { ( !_childrenIerrors,!_childrenIfields,!_childrenIinputs,!_childrenIoutput,!_childrenIoutputs) -> + (case (({-# LINE 721 "./src-ag/DefaultRules.ag" #-} + let chldOutMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIoutputs ] + chldInMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIinputs ] + isInAttribute :: Identifier -> Identifier -> [Error] + isInAttribute fld nm + | fld == _LOC = if nm `Set.member` _rulesIlocals + then [] + else [UndefAttr _lhsInt con_ fld nm False] + | fld == _LHS = if nm `Map.member` _lhsIinh + then [] + else [UndefAttr _lhsInt con_ fld nm False] + | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldOutMap) + then [] + else [UndefAttr _lhsInt con_ fld nm False] + isOutAttribute :: Identifier -> Identifier -> [Error] + isOutAttribute fld nm + | fld == _LOC = if nm `Set.member` _rulesIlocals + then [] + else [UndefAttr _lhsInt con_ fld nm True] + | fld == _LHS = if nm `Map.member` _lhsIsyn + then [] + else [UndefAttr _lhsInt con_ fld nm True] + | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldInMap) + then [] + else [UndefAttr _lhsInt con_ fld nm True] + existsRule nm = if nm `Set.member` _rulesIruleNames + then [] + else [MissingNamedRule _lhsInt con_ nm] + checkIn (OccAttr fld nm) = isInAttribute fld nm + checkIn (OccRule nm) = existsRule nm + checkOut (OccAttr fld nm) = isOutAttribute fld nm + checkOut (OccRule nm) = existsRule nm + in Seq.fromList . concat $ + [ checkIn occA ++ checkOut occB + | (Dependency occA occB) <- _orderDeps + ] + {-# LINE 2259 "dist/build/DefaultRules.hs" #-} + )) of + { !_orderErrs -> + (case (({-# LINE 386 "./src-ag/DefaultRules.ag" #-} + let locals = _rulesIlocals + initenv = Map.fromList ( [ (a,_ACHILD) + | (a,_,_) <- _childrenIfields + ] + ++ attrs(_LHS, _lhsIinh) + ++ [ (a,_LOC) + | a <- Set.toList locals + ] + ) + attrs (n,as) = [ (a,n) | a <- Map.keys as ] + envs = scanl (flip Map.union) + initenv + (map (Map.fromList . attrs ) _childrenIoutputs) + child_envs = init envs + lhs_env = last envs + (selfAttrs, normalAttrs) + = Map.partitionWithKey (\k _ -> maybe False isSELFNonterminal $ Map.lookup k _lhsIsynOrig) _lhsIsyn + (_,undefAttrs) + = removeDefined _rulesIdefinedAttrs (_LHS, normalAttrs) + (useAttrs,others) + = splitAttrs _lhsIuseMap undefAttrs + (rules1, errors1) + = concatRE $ map (copyRule _lhsIoptions _lhsIwrappers _lhsInt con_ _lhsIcr locals) + (zip envs (map (removeDefined _rulesIdefinedAttrs) _childrenIinputs)) + uRules + = map (useRule locals _childrenIoutputs) useAttrs + selfLocRules + = [ selfRule False attr $ + lexTokens noPos $ + constructor [childSelf attr nm tp | (nm,tp,virt) <- _childrenIfields, childExists virt] + | attr <- Map.keys selfAttrs + , not (Set.member attr locals) + ] + where + childSelf self nm tp + = case tp of NT nt _ _ -> attrName nm self + _ | nm `Set.member` locals -> locName nm + | otherwise -> fieldName nm + constructor fs + = buildConExpr (ocaml _lhsIoptions) _lhsItypeSyns _lhsIo_rename _lhsInt con_ fs + childExists ChildAttr = False + childExists _ = True + selfRules + = [ selfRule True attr [mkLocVar attr noPos Nothing] + | attr <- Map.keys selfAttrs + , not (Set.member (_LHS,attr) _rulesIdefinedAttrs) + ] + (rules5, errs5) + = copyRule _lhsIoptions + _lhsIwrappers + _lhsInt + con_ + _lhsIcr + locals + (lhs_env, (_LHS, others)) + in (uRules++selfLocRules++selfRules++rules5++rules1, errors1> + (case (({-# LINE 386 "./src-ag/DefaultRules.ag" #-} + __tup2 + {-# LINE 2324 "dist/build/DefaultRules.hs" #-} + )) of + { !(_,!_errs) -> + (case (({-# LINE 384 "./src-ag/DefaultRules.ag" #-} + _childrenIerrors >< _errs >< _rulesIerrors >< _orderErrs + {-# LINE 2329 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 42 "./src-ag/DefaultRules.ag" #-} + _lhsIparams + {-# LINE 2334 "dist/build/DefaultRules.hs" #-} + )) of + { !_typeSigsOparams -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 2339 "dist/build/DefaultRules.hs" #-} + )) of + { !_typeSigsOnt -> + (case (({-# LINE 784 "./src-ag/DefaultRules.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIaroundsIn + {-# LINE 2344 "dist/build/DefaultRules.hs" #-} + )) of + { !_aroundsIn -> + (case (({-# LINE 777 "./src-ag/DefaultRules.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIaugmentsIn + {-# LINE 2349 "dist/build/DefaultRules.hs" #-} + )) of + { !_augmentsIn -> + (case (({-# LINE 386 "./src-ag/DefaultRules.ag" #-} + __tup2 + {-# LINE 2354 "dist/build/DefaultRules.hs" #-} + )) of + { !(!_newRls,_) -> + (case (({-# LINE 608 "./src-ag/DefaultRules.ag" #-} + foldr addAugments (_rulesIoutput ++ _newRls) (Map.assocs _augmentsIn ) + {-# LINE 2359 "dist/build/DefaultRules.hs" #-} + )) of + { !_extra1 -> + (case (({-# LINE 609 "./src-ag/DefaultRules.ag" #-} + foldr addArounds _extra1 (Map.assocs _aroundsIn ) + {-# LINE 2364 "dist/build/DefaultRules.hs" #-} + )) of + { !_extra2 -> + (case (({-# LINE 610 "./src-ag/DefaultRules.ag" #-} + foldr addMerges _extra2 (Map.assocs _mergesIn ) + {-# LINE 2369 "dist/build/DefaultRules.hs" #-} + )) of + { !_extra3 -> + (case (typeSigs_ _typeSigsOnt _typeSigsOparams) of + { ( !_typeSigsIoutput) -> + (case (({-# LINE 611 "./src-ag/DefaultRules.ag" #-} + Production con_ params_ constraints_ _childrenIoutput _extra3 _typeSigsIoutput macro_ + {-# LINE 2376 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _rulesIuniq + {-# LINE 2381 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +-- Productions ------------------------------------------------- +{- + visit 0: + inherited attributes: + aroundsIn : Map ConstructorIdent (Map Identifier [Expression]) + augmentsIn : Map ConstructorIdent (Map Identifier [Expression]) + cr : Bool + inh : Attributes + inhMap : Map Identifier Attributes + inhOrig : Attributes + manualAttrOrderMap : AttrOrderMap + mergesIn : Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)) + nonterminals : Set NontermIdent + nt : NontermIdent + o_rename : Bool + options : Options + params : [Identifier] + syn : Attributes + synMap : Map Identifier Attributes + synOrig : Attributes + typeSyns : TypeSyns + useMap : Map Identifier (String,String,String) + wrappers : Set NontermIdent + chained attribute: + uniq : Int + synthesized attributes: + errors : Seq Error + output : Productions + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_Productions :: Productions -> + T_Productions +sem_Productions !list = + (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list)) +-- semantic domain +newtype T_Productions = T_Productions ((Map ConstructorIdent (Map Identifier [Expression])) -> + (Map ConstructorIdent (Map Identifier [Expression])) -> + Bool -> + Attributes -> + (Map Identifier Attributes) -> + Attributes -> + AttrOrderMap -> + (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> + (Set NontermIdent) -> + NontermIdent -> + Bool -> + Options -> + ([Identifier]) -> + Attributes -> + (Map Identifier Attributes) -> + Attributes -> + TypeSyns -> + Int -> + (Map Identifier (String,String,String)) -> + (Set NontermIdent) -> + ( (Seq Error),Productions,Int)) +data Inh_Productions = Inh_Productions {aroundsIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),augmentsIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),cr_Inh_Productions :: !(Bool),inh_Inh_Productions :: !(Attributes),inhMap_Inh_Productions :: !((Map Identifier Attributes)),inhOrig_Inh_Productions :: !(Attributes),manualAttrOrderMap_Inh_Productions :: !(AttrOrderMap),mergesIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))),nonterminals_Inh_Productions :: !((Set NontermIdent)),nt_Inh_Productions :: !(NontermIdent),o_rename_Inh_Productions :: !(Bool),options_Inh_Productions :: !(Options),params_Inh_Productions :: !(([Identifier])),syn_Inh_Productions :: !(Attributes),synMap_Inh_Productions :: !((Map Identifier Attributes)),synOrig_Inh_Productions :: !(Attributes),typeSyns_Inh_Productions :: !(TypeSyns),uniq_Inh_Productions :: !(Int),useMap_Inh_Productions :: !((Map Identifier (String,String,String))),wrappers_Inh_Productions :: !((Set NontermIdent))} +data Syn_Productions = Syn_Productions {errors_Syn_Productions :: !((Seq Error)),output_Syn_Productions :: !(Productions),uniq_Syn_Productions :: !(Int)} +wrap_Productions :: T_Productions -> + Inh_Productions -> + Syn_Productions +wrap_Productions !(T_Productions sem) !(Inh_Productions _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = + (let ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers + in (Syn_Productions _lhsOerrors _lhsOoutput _lhsOuniq)) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons !(T_Production hd_) !(T_Productions tl_) = + (T_Productions (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsIinh) + (!_lhsIinhMap) + (!_lhsIinhOrig) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsInt) + (!_lhsIo_rename) + (!_lhsIoptions) + (!_lhsIparams) + (!_lhsIsyn) + (!_lhsIsynMap) + (!_lhsIsynOrig) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) + (!_lhsIwrappers) -> + (case (({-# LINE 65 "./src-ag/DefaultRules.ag" #-} + _lhsIwrappers + {-# LINE 2484 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOwrappers -> + (case (({-# LINE 187 "./src-ag/DefaultRules.ag" #-} + _lhsIuseMap + {-# LINE 2489 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOuseMap -> + (case (({-# LINE 72 "./src-ag/DefaultRules.ag" #-} + _lhsItypeSyns + {-# LINE 2494 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOtypeSyns -> + (case (({-# LINE 187 "./src-ag/DefaultRules.ag" #-} + _lhsIsynOrig + {-# LINE 2499 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOsynOrig -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2504 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOsynMap -> + (case (({-# LINE 187 "./src-ag/DefaultRules.ag" #-} + _lhsIsyn + {-# LINE 2509 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOsyn -> + (case (({-# LINE 51 "./src-ag/DefaultRules.ag" #-} + _lhsIoptions + {-# LINE 2514 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 52 "./src-ag/DefaultRules.ag" #-} + _lhsIo_rename + {-# LINE 2519 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOo_rename -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 2524 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 787 "./src-ag/DefaultRules.ag" #-} + _lhsImergesIn + {-# LINE 2529 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOmergesIn -> + (case (({-# LINE 705 "./src-ag/DefaultRules.ag" #-} + _lhsImanualAttrOrderMap + {-# LINE 2534 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOmanualAttrOrderMap -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 2539 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOinhMap -> + (case (({-# LINE 187 "./src-ag/DefaultRules.ag" #-} + _lhsIinh + {-# LINE 2544 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOinh -> + (case (({-# LINE 53 "./src-ag/DefaultRules.ag" #-} + _lhsIcr + {-# LINE 2549 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOcr -> + (case (({-# LINE 65 "./src-ag/DefaultRules.ag" #-} + _lhsIwrappers + {-# LINE 2554 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOwrappers -> + (case (({-# LINE 187 "./src-ag/DefaultRules.ag" #-} + _lhsIuseMap + {-# LINE 2559 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOuseMap -> + (case (({-# LINE 72 "./src-ag/DefaultRules.ag" #-} + _lhsItypeSyns + {-# LINE 2564 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOtypeSyns -> + (case (({-# LINE 187 "./src-ag/DefaultRules.ag" #-} + _lhsIsynOrig + {-# LINE 2569 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOsynOrig -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2574 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOsynMap -> + (case (({-# LINE 187 "./src-ag/DefaultRules.ag" #-} + _lhsIsyn + {-# LINE 2579 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOsyn -> + (case (({-# LINE 51 "./src-ag/DefaultRules.ag" #-} + _lhsIoptions + {-# LINE 2584 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 52 "./src-ag/DefaultRules.ag" #-} + _lhsIo_rename + {-# LINE 2589 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOo_rename -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 2594 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 787 "./src-ag/DefaultRules.ag" #-} + _lhsImergesIn + {-# LINE 2599 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOmergesIn -> + (case (({-# LINE 705 "./src-ag/DefaultRules.ag" #-} + _lhsImanualAttrOrderMap + {-# LINE 2604 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOmanualAttrOrderMap -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 2609 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOinhMap -> + (case (({-# LINE 187 "./src-ag/DefaultRules.ag" #-} + _lhsIinh + {-# LINE 2614 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOinh -> + (case (({-# LINE 53 "./src-ag/DefaultRules.ag" #-} + _lhsIcr + {-# LINE 2619 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOcr -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 2624 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOuniq -> + (case (({-# LINE 42 "./src-ag/DefaultRules.ag" #-} + _lhsIparams + {-# LINE 2629 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOparams -> + (case (({-# LINE 178 "./src-ag/DefaultRules.ag" #-} + _lhsInonterminals + {-# LINE 2634 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOnonterminals -> + (case (({-# LINE 187 "./src-ag/DefaultRules.ag" #-} + _lhsIinhOrig + {-# LINE 2639 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOinhOrig -> + (case (({-# LINE 773 "./src-ag/DefaultRules.ag" #-} + _lhsIaugmentsIn + {-# LINE 2644 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOaugmentsIn -> + (case (({-# LINE 780 "./src-ag/DefaultRules.ag" #-} + _lhsIaroundsIn + {-# LINE 2649 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOaroundsIn -> + (case (hd_ _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOinh _hdOinhMap _hdOinhOrig _hdOmanualAttrOrderMap _hdOmergesIn _hdOnonterminals _hdOnt _hdOo_rename _hdOoptions _hdOparams _hdOsyn _hdOsynMap _hdOsynOrig _hdOtypeSyns _hdOuniq _hdOuseMap _hdOwrappers) of + { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _hdIuniq + {-# LINE 2656 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOuniq -> + (case (({-# LINE 42 "./src-ag/DefaultRules.ag" #-} + _lhsIparams + {-# LINE 2661 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOparams -> + (case (({-# LINE 178 "./src-ag/DefaultRules.ag" #-} + _lhsInonterminals + {-# LINE 2666 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOnonterminals -> + (case (({-# LINE 187 "./src-ag/DefaultRules.ag" #-} + _lhsIinhOrig + {-# LINE 2671 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOinhOrig -> + (case (({-# LINE 773 "./src-ag/DefaultRules.ag" #-} + _lhsIaugmentsIn + {-# LINE 2676 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOaugmentsIn -> + (case (({-# LINE 780 "./src-ag/DefaultRules.ag" #-} + _lhsIaroundsIn + {-# LINE 2681 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOaroundsIn -> + (case (tl_ _tlOaroundsIn _tlOaugmentsIn _tlOcr _tlOinh _tlOinhMap _tlOinhOrig _tlOmanualAttrOrderMap _tlOmergesIn _tlOnonterminals _tlOnt _tlOo_rename _tlOoptions _tlOparams _tlOsyn _tlOsynMap _tlOsynOrig _tlOtypeSyns _tlOuniq _tlOuseMap _tlOwrappers) of + { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 2688 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 2693 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 2698 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _tlIuniq + {-# LINE 2703 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (\ (!_lhsIaroundsIn) + (!_lhsIaugmentsIn) + (!_lhsIcr) + (!_lhsIinh) + (!_lhsIinhMap) + (!_lhsIinhOrig) + (!_lhsImanualAttrOrderMap) + (!_lhsImergesIn) + (!_lhsInonterminals) + (!_lhsInt) + (!_lhsIo_rename) + (!_lhsIoptions) + (!_lhsIparams) + (!_lhsIsyn) + (!_lhsIsynMap) + (!_lhsIsynOrig) + (!_lhsItypeSyns) + (!_lhsIuniq) + (!_lhsIuseMap) + (!_lhsIwrappers) -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + Seq.empty + {-# LINE 2731 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + [] + {-# LINE 2736 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 2741 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 2746 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }))) +-- Rule -------------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + nt : NontermIdent + options : Options + chained attribute: + uniq : Int + synthesized attributes: + containsVars : Bool + definedAttrs : Set (Identifier,Identifier) + errors : Seq Error + isPure : Bool + locals : Set Identifier + output : Rule + outputs : Rules + ruleNames : Set Identifier + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : {Expression} + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + child pure : {Bool} + child identity : {Bool} + child mbError : {Maybe Error} + child eager : {Bool} + visit 0: + local output : _ + local _tup3 : _ + local output1 : _ + local _tup4 : _ + local outputs : _ + local mbAlias : _ +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule !(Rule _mbName _pattern _rhs _owrt _origin _explicit _pure _identity _mbError _eager) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern) _rhs _owrt _origin _explicit _pure _identity _mbError _eager) +-- semantic domain +newtype T_Rule = T_Rule (ConstructorIdent -> + NontermIdent -> + Options -> + Int -> + ( Bool,(Set (Identifier,Identifier)),(Seq Error),Bool,(Set Identifier),Rule,Rules,(Set Identifier),Int)) +data Inh_Rule = Inh_Rule {con_Inh_Rule :: !(ConstructorIdent),nt_Inh_Rule :: !(NontermIdent),options_Inh_Rule :: !(Options),uniq_Inh_Rule :: !(Int)} +data Syn_Rule = Syn_Rule {containsVars_Syn_Rule :: !(Bool),definedAttrs_Syn_Rule :: !((Set (Identifier,Identifier))),errors_Syn_Rule :: !((Seq Error)),isPure_Syn_Rule :: !(Bool),locals_Syn_Rule :: !((Set Identifier)),output_Syn_Rule :: !(Rule),outputs_Syn_Rule :: !(Rules),ruleNames_Syn_Rule :: !((Set Identifier)),uniq_Syn_Rule :: !(Int)} +wrap_Rule :: T_Rule -> + Inh_Rule -> + Syn_Rule +wrap_Rule !(T_Rule sem) !(Inh_Rule _lhsIcon _lhsInt _lhsIoptions _lhsIuniq) = + (let ( !_lhsOcontainsVars,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOisPure,!_lhsOlocals,!_lhsOoutput,!_lhsOoutputs,!_lhsOruleNames,!_lhsOuniq) = sem _lhsIcon _lhsInt _lhsIoptions _lhsIuniq + in (Syn_Rule _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOisPure _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOruleNames _lhsOuniq)) +sem_Rule_Rule :: (Maybe Identifier) -> + T_Pattern -> + Expression -> + Bool -> + String -> + Bool -> + Bool -> + Bool -> + (Maybe Error) -> + Bool -> + T_Rule +sem_Rule_Rule !mbName_ !(T_Pattern pattern_) !rhs_ !owrt_ !origin_ !explicit_ !pure_ !identity_ !mbError_ !eager_ = + (T_Rule (\ (!_lhsIcon) + (!_lhsInt) + (!_lhsIoptions) + (!_lhsIuniq) -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 2825 "dist/build/DefaultRules.hs" #-} + )) of + { !_patternOnt -> + (case (({-# LINE 40 "./src-ag/DefaultRules.ag" #-} + _lhsIcon + {-# LINE 2830 "dist/build/DefaultRules.hs" #-} + )) of + { !_patternOcon -> + (case (pattern_ _patternOcon _patternOnt) of + { ( !_patternIcontainsVars,!_patternIcopy,!_patternIdefinedAttrs,!_patternIerrors,!_patternIlocals,!_patternIoutput) -> + (case (({-# LINE 551 "./src-ag/DefaultRules.ag" #-} + _patternIcontainsVars + {-# LINE 2837 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOcontainsVars -> + (case (({-# LINE 531 "./src-ag/DefaultRules.ag" #-} + _patternIdefinedAttrs + {-# LINE 2842 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + _patternIerrors + {-# LINE 2847 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 557 "./src-ag/DefaultRules.ag" #-} + pure_ + {-# LINE 2852 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOisPure -> + (case (({-# LINE 530 "./src-ag/DefaultRules.ag" #-} + _patternIlocals + {-# LINE 2857 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + Rule mbName_ _patternIoutput rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ + {-# LINE 2862 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 2867 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 624 "./src-ag/DefaultRules.ag" #-} + mkRuleAlias _output + {-# LINE 2872 "dist/build/DefaultRules.hs" #-} + )) of + { !__tup3 -> + (case (({-# LINE 624 "./src-ag/DefaultRules.ag" #-} + __tup3 + {-# LINE 2877 "dist/build/DefaultRules.hs" #-} + )) of + { !(!_output1,_) -> + (case (({-# LINE 625 "./src-ag/DefaultRules.ag" #-} + if needsMultiRules _lhsIoptions + then multiRule _output1 _lhsIuniq + else ([_output1 ], _lhsIuniq) + {-# LINE 2884 "dist/build/DefaultRules.hs" #-} + )) of + { !__tup4 -> + (case (({-# LINE 625 "./src-ag/DefaultRules.ag" #-} + __tup4 + {-# LINE 2889 "dist/build/DefaultRules.hs" #-} + )) of + { !(!_outputs,_) -> + (case (({-# LINE 624 "./src-ag/DefaultRules.ag" #-} + __tup3 + {-# LINE 2894 "dist/build/DefaultRules.hs" #-} + )) of + { !(_,!_mbAlias) -> + (case (({-# LINE 628 "./src-ag/DefaultRules.ag" #-} + maybe [] return _mbAlias ++ _outputs + {-# LINE 2899 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutputs -> + (case (({-# LINE 713 "./src-ag/DefaultRules.ag" #-} + case mbName_ of + Nothing -> Set.empty + Just nm -> Set.singleton nm + {-# LINE 2906 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOruleNames -> + (case (({-# LINE 625 "./src-ag/DefaultRules.ag" #-} + __tup4 + {-# LINE 2911 "dist/build/DefaultRules.hs" #-} + )) of + { !(_,!_lhsOuniq) -> + ( _lhsOcontainsVars,_lhsOdefinedAttrs,_lhsOerrors,_lhsOisPure,_lhsOlocals,_lhsOoutput,_lhsOoutputs,_lhsOruleNames,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +-- Rules ------------------------------------------------------- +{- + visit 0: + inherited attributes: + con : ConstructorIdent + nt : NontermIdent + options : Options + chained attribute: + uniq : Int + synthesized attributes: + definedAttrs : Set (Identifier,Identifier) + errors : Seq Error + locals : Set Identifier + output : Rules + ruleNames : Set Identifier + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_Rules :: Rules -> + T_Rules +sem_Rules !list = + (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list)) +-- semantic domain +newtype T_Rules = T_Rules (ConstructorIdent -> + NontermIdent -> + Options -> + Int -> + ( (Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rules,(Set Identifier),Int)) +data Inh_Rules = Inh_Rules {con_Inh_Rules :: !(ConstructorIdent),nt_Inh_Rules :: !(NontermIdent),options_Inh_Rules :: !(Options),uniq_Inh_Rules :: !(Int)} +data Syn_Rules = Syn_Rules {definedAttrs_Syn_Rules :: !((Set (Identifier,Identifier))),errors_Syn_Rules :: !((Seq Error)),locals_Syn_Rules :: !((Set Identifier)),output_Syn_Rules :: !(Rules),ruleNames_Syn_Rules :: !((Set Identifier)),uniq_Syn_Rules :: !(Int)} +wrap_Rules :: T_Rules -> + Inh_Rules -> + Syn_Rules +wrap_Rules !(T_Rules sem) !(Inh_Rules _lhsIcon _lhsInt _lhsIoptions _lhsIuniq) = + (let ( !_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput,!_lhsOruleNames,!_lhsOuniq) = sem _lhsIcon _lhsInt _lhsIoptions _lhsIuniq + in (Syn_Rules _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq)) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons !(T_Rule hd_) !(T_Rules tl_) = + (T_Rules (\ (!_lhsIcon) + (!_lhsInt) + (!_lhsIoptions) + (!_lhsIuniq) -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 2967 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOuniq -> + (case (({-# LINE 51 "./src-ag/DefaultRules.ag" #-} + _lhsIoptions + {-# LINE 2972 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 2977 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 40 "./src-ag/DefaultRules.ag" #-} + _lhsIcon + {-# LINE 2982 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOcon -> + (case (hd_ _hdOcon _hdOnt _hdOoptions _hdOuniq) of + { ( !_hdIcontainsVars,!_hdIdefinedAttrs,!_hdIerrors,!_hdIisPure,!_hdIlocals,!_hdIoutput,!_hdIoutputs,!_hdIruleNames,!_hdIuniq) -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _hdIuniq + {-# LINE 2989 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOuniq -> + (case (({-# LINE 51 "./src-ag/DefaultRules.ag" #-} + _lhsIoptions + {-# LINE 2994 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 2999 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 40 "./src-ag/DefaultRules.ag" #-} + _lhsIcon + {-# LINE 3004 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOcon -> + (case (tl_ _tlOcon _tlOnt _tlOoptions _tlOuniq) of + { ( !_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput,!_tlIruleNames,!_tlIuniq) -> + (case (({-# LINE 531 "./src-ag/DefaultRules.ag" #-} + _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs + {-# LINE 3011 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 3016 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 530 "./src-ag/DefaultRules.ag" #-} + _hdIlocals `Set.union` _tlIlocals + {-# LINE 3021 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 620 "./src-ag/DefaultRules.ag" #-} + if _hdIcontainsVars && _hdIisPure then _hdIoutputs ++ _tlIoutput else _tlIoutput + {-# LINE 3026 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 711 "./src-ag/DefaultRules.ag" #-} + _hdIruleNames `Set.union` _tlIruleNames + {-# LINE 3031 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOruleNames -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _tlIuniq + {-# LINE 3036 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOruleNames,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (\ (!_lhsIcon) + (!_lhsInt) + (!_lhsIoptions) + (!_lhsIuniq) -> + (case (({-# LINE 531 "./src-ag/DefaultRules.ag" #-} + Set.empty + {-# LINE 3048 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOdefinedAttrs -> + (case (({-# LINE 168 "./src-ag/DefaultRules.ag" #-} + Seq.empty + {-# LINE 3053 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 530 "./src-ag/DefaultRules.ag" #-} + Set.empty + {-# LINE 3058 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOlocals -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + [] + {-# LINE 3063 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 3068 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + (case (({-# LINE 711 "./src-ag/DefaultRules.ag" #-} + Set.empty + {-# LINE 3073 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOruleNames -> + (case (({-# LINE 592 "./src-ag/DefaultRules.ag" #-} + _lhsIuniq + {-# LINE 3078 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOuniq -> + ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOruleNames,_lhsOuniq) }) }) }) }) }) }) }))) +-- TypeSig ----------------------------------------------------- +{- + visit 0: + inherited attributes: + nt : NontermIdent + params : [Identifier] + synthesized attribute: + output : TypeSig + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} + visit 0: + local tp1 : _ +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig !(TypeSig _name _tp) = + (sem_TypeSig_TypeSig _name _tp) +-- semantic domain +newtype T_TypeSig = T_TypeSig (NontermIdent -> + ([Identifier]) -> + ( TypeSig)) +data Inh_TypeSig = Inh_TypeSig {nt_Inh_TypeSig :: !(NontermIdent),params_Inh_TypeSig :: !(([Identifier]))} +data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: !(TypeSig)} +wrap_TypeSig :: T_TypeSig -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig !(T_TypeSig sem) !(Inh_TypeSig _lhsInt _lhsIparams) = + (let ( !_lhsOoutput) = sem _lhsInt _lhsIparams + in (Syn_TypeSig _lhsOoutput)) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig !name_ !tp_ = + (T_TypeSig (\ (!_lhsInt) + (!_lhsIparams) -> + (case (({-# LINE 576 "./src-ag/DefaultRules.ag" #-} + elimSelfId _lhsInt _lhsIparams tp_ + {-# LINE 3122 "dist/build/DefaultRules.hs" #-} + )) of + { !_tp1 -> + (case (({-# LINE 617 "./src-ag/DefaultRules.ag" #-} + TypeSig name_ _tp1 + {-# LINE 3127 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }))) +-- TypeSigs ---------------------------------------------------- +{- + visit 0: + inherited attributes: + nt : NontermIdent + params : [Identifier] + synthesized attribute: + output : TypeSigs + 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 (NontermIdent -> + ([Identifier]) -> + ( TypeSigs)) +data Inh_TypeSigs = Inh_TypeSigs {nt_Inh_TypeSigs :: !(NontermIdent),params_Inh_TypeSigs :: !(([Identifier]))} +data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: !(TypeSigs)} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs !(T_TypeSigs sem) !(Inh_TypeSigs _lhsInt _lhsIparams) = + (let ( !_lhsOoutput) = sem _lhsInt _lhsIparams + in (Syn_TypeSigs _lhsOoutput)) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons !(T_TypeSig hd_) !(T_TypeSigs tl_) = + (T_TypeSigs (\ (!_lhsInt) + (!_lhsIparams) -> + (case (({-# LINE 42 "./src-ag/DefaultRules.ag" #-} + _lhsIparams + {-# LINE 3174 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOparams -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 3179 "dist/build/DefaultRules.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 42 "./src-ag/DefaultRules.ag" #-} + _lhsIparams + {-# LINE 3184 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOparams -> + (case (({-# LINE 39 "./src-ag/DefaultRules.ag" #-} + _lhsInt + {-# LINE 3189 "dist/build/DefaultRules.hs" #-} + )) of + { !_hdOnt -> + (case (tl_ _tlOnt _tlOparams) of + { ( !_tlIoutput) -> + (case (hd_ _hdOnt _hdOparams) of + { ( !_hdIoutput) -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 3198 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 3203 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }) }) }) }) }) }) }))) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (\ (!_lhsInt) + (!_lhsIparams) -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + [] + {-# LINE 3213 "dist/build/DefaultRules.hs" #-} + )) of + { !_output -> + (case (({-# LINE 599 "./src-ag/DefaultRules.ag" #-} + _output + {-# LINE 3218 "dist/build/DefaultRules.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }))) diff --git a/dist/build/Desugar.hs b/dist/build/Desugar.hs new file mode 100644 --- /dev/null +++ b/dist/build/Desugar.hs @@ -0,0 +1,3104 @@ +{-# OPTIONS_GHC -XBangPatterns #-} + +-- UUAGC 0.9.42.0 (src-ag/Desugar.ag) +module Desugar where +{-# LINE 14 "./src-ag/Desugar.ag" #-} + +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Map(Map) +import qualified Data.Sequence as Seq +import Data.Sequence(Seq,(><)) +import UU.Scanner.Position(Pos(..)) +import Data.Maybe +import Data.List(intersperse) + +import AbstractSyntax +import ErrorMessages +import Options +import HsToken +import HsTokenScanner +import TokenDef +import CommonTypes +{-# LINE 24 "dist/build/Desugar.hs" #-} + +{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import Macro --marcos +import CommonTypes +import ErrorMessages +{-# LINE 36 "dist/build/Desugar.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 43 "dist/build/Desugar.hs" #-} + +{-# LINE 2 "./src-ag/Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 49 "dist/build/Desugar.hs" #-} + +{-# LINE 2 "./src-ag/HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 55 "dist/build/Desugar.hs" #-} +{-# LINE 98 "./src-ag/Desugar.ag" #-} + +addl :: Int -> Pos -> Pos +addl n (Pos l c f) = Pos (l+n) c f +{-# LINE 60 "dist/build/Desugar.hs" #-} + +{-# LINE 133 "./src-ag/Desugar.ag" #-} + +maybeError :: a -> Error -> Maybe a -> (a, Seq Error) +maybeError def err mb + = maybe (def, Seq.singleton 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 +{-# LINE 75 "dist/build/Desugar.hs" #-} + +{-# LINE 204 "./src-ag/Desugar.ag" #-} + +mergeAttributes :: AttrMap -> AttrMap -> AttrMap +mergeAttributes = Map.unionWith $ Map.unionWith $ Set.union +{-# LINE 81 "dist/build/Desugar.hs" #-} + +{-# LINE 251 "./src-ag/Desugar.ag" #-} + +desugarExprs :: Options -> NontermIdent -> ConstructorIdent -> + [(Identifier, Identifier)] -> [(Identifier, Identifier)] -> + Seq Error -> [Expression] -> (Seq Error, [Expression]) +desugarExprs options nt con childInhs childSyns + = mapAccum (desugarExpr options nt con childInhs childSyns) + where mapAccum f e = foldr (\x (e0,xs) -> let (e1,x') = f e0 x in (e1, x:xs)) (e, []) + +desugarExpr :: Options -> NontermIdent -> ConstructorIdent -> + [(Identifier, Identifier)] -> [(Identifier, Identifier)] -> + Seq Error -> Expression -> (Seq Error, Expression) +desugarExpr options nt con childInhs childSyns errs expr + = (errs Seq.>< errors_Syn_Expression syn, output_Syn_Expression syn) + where + inh = Inh_Expression { childInhs_Inh_Expression = childInhs + , childSyns_Inh_Expression = childSyns + , con_Inh_Expression = con + , nt_Inh_Expression = nt + , options_Inh_Expression = options + , ruleDescr_Inh_Expression = "augment-rule" + } + sem = sem_Expression expr + syn = wrap_Expression sem inh +{-# LINE 107 "dist/build/Desugar.hs" #-} + +{-# LINE 294 "./src-ag/Desugar.ag" #-} + +addLateAttr :: Options -> String -> Attributes +addLateAttr options mainName + | kennedyWarren options && lateHigherOrderBinding options = + let tp = lateBindingType mainName + in Map.singleton idLateBindingAttr tp + | otherwise = Map.empty +{-# LINE 117 "dist/build/Desugar.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + inherited attributes: + inhMap : Map Identifier Attributes + mainName : String + options : Options + synMap : Map Identifier Attributes + synthesized attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + output : Child + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child kind : {ChildKind} + visit 0: + local chnt : _ + local inh : _ + local syn : _ +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child !(Child _name _tp _kind) = + (sem_Child_Child _name _tp _kind) +-- semantic domain +newtype T_Child = T_Child ((Map Identifier Attributes) -> + String -> + Options -> + (Map Identifier Attributes) -> + ( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Child)) +data Inh_Child = Inh_Child {inhMap_Inh_Child :: !((Map Identifier Attributes)),mainName_Inh_Child :: !(String),options_Inh_Child :: !(Options),synMap_Inh_Child :: !((Map Identifier Attributes))} +data Syn_Child = Syn_Child {childInhs_Syn_Child :: !(([(Identifier, Identifier)])),childSyns_Syn_Child :: !(([(Identifier, Identifier)])),output_Syn_Child :: !(Child)} +wrap_Child :: T_Child -> + Inh_Child -> + Syn_Child +wrap_Child !(T_Child sem) !(Inh_Child _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = + (let ( !_lhsOchildInhs,!_lhsOchildSyns,!_lhsOoutput) = sem _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap + in (Syn_Child _lhsOchildInhs _lhsOchildSyns _lhsOoutput)) +sem_Child_Child :: Identifier -> + Type -> + ChildKind -> + T_Child +sem_Child_Child !name_ !tp_ !kind_ = + (T_Child (\ (!_lhsIinhMap) + (!_lhsImainName) + (!_lhsIoptions) + (!_lhsIsynMap) -> + (case (({-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + case tp_ of + NT nt _ _ -> nt + Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") + Haskell t -> identifier "" + {-# LINE 173 "dist/build/Desugar.hs" #-} + )) of + { !_chnt -> + (case (({-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIinhMap + {-# LINE 178 "dist/build/Desugar.hs" #-} + )) of + { !_inh -> + (case (({-# LINE 130 "./src-ag/Desugar.ag" #-} + [(i, name_) | i <- Map.keys _inh ] + {-# LINE 183 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOchildInhs -> + (case (({-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIsynMap + {-# LINE 188 "dist/build/Desugar.hs" #-} + )) of + { !_syn -> + (case (({-# LINE 131 "./src-ag/Desugar.ag" #-} + [(s, name_) | s <- Map.keys _syn ] + {-# LINE 193 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOchildSyns -> + (case (({-# LINE 315 "./src-ag/Desugar.ag" #-} + Child name_ tp_ kind_ + {-# LINE 198 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) }) }) }))) +-- Children ---------------------------------------------------- +{- + visit 0: + inherited attributes: + inhMap : Map Identifier Attributes + mainName : String + options : Options + synMap : Map Identifier Attributes + synthesized attributes: + childInhs : [(Identifier, Identifier)] + childSyns : [(Identifier, Identifier)] + output : Children + 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 ((Map Identifier Attributes) -> + String -> + Options -> + (Map Identifier Attributes) -> + ( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Children)) +data Inh_Children = Inh_Children {inhMap_Inh_Children :: !((Map Identifier Attributes)),mainName_Inh_Children :: !(String),options_Inh_Children :: !(Options),synMap_Inh_Children :: !((Map Identifier Attributes))} +data Syn_Children = Syn_Children {childInhs_Syn_Children :: !(([(Identifier, Identifier)])),childSyns_Syn_Children :: !(([(Identifier, Identifier)])),output_Syn_Children :: !(Children)} +wrap_Children :: T_Children -> + Inh_Children -> + Syn_Children +wrap_Children !(T_Children sem) !(Inh_Children _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = + (let ( !_lhsOchildInhs,!_lhsOchildSyns,!_lhsOoutput) = sem _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap + 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 (\ (!_lhsIinhMap) + (!_lhsImainName) + (!_lhsIoptions) + (!_lhsIsynMap) -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 253 "dist/build/Desugar.hs" #-} + )) of + { !_tlOinhMap -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 258 "dist/build/Desugar.hs" #-} + )) of + { !_hdOinhMap -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 263 "dist/build/Desugar.hs" #-} + )) of + { !_tlOsynMap -> + (case (({-# LINE 36 "./src-ag/Desugar.ag" #-} + _lhsIoptions + {-# LINE 268 "dist/build/Desugar.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 289 "./src-ag/Desugar.ag" #-} + _lhsImainName + {-# LINE 273 "dist/build/Desugar.hs" #-} + )) of + { !_tlOmainName -> + (case (tl_ _tlOinhMap _tlOmainName _tlOoptions _tlOsynMap) of + { ( !_tlIchildInhs,!_tlIchildSyns,!_tlIoutput) -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 280 "dist/build/Desugar.hs" #-} + )) of + { !_hdOsynMap -> + (case (({-# LINE 36 "./src-ag/Desugar.ag" #-} + _lhsIoptions + {-# LINE 285 "dist/build/Desugar.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 289 "./src-ag/Desugar.ag" #-} + _lhsImainName + {-# LINE 290 "dist/build/Desugar.hs" #-} + )) of + { !_hdOmainName -> + (case (hd_ _hdOinhMap _hdOmainName _hdOoptions _hdOsynMap) of + { ( !_hdIchildInhs,!_hdIchildSyns,!_hdIoutput) -> + (case (({-# LINE 125 "./src-ag/Desugar.ag" #-} + _hdIchildInhs ++ _tlIchildInhs + {-# LINE 297 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOchildInhs -> + (case (({-# LINE 125 "./src-ag/Desugar.ag" #-} + _hdIchildSyns ++ _tlIchildSyns + {-# LINE 302 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOchildSyns -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 307 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 312 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (\ (!_lhsIinhMap) + (!_lhsImainName) + (!_lhsIoptions) + (!_lhsIsynMap) -> + (case (({-# LINE 125 "./src-ag/Desugar.ag" #-} + [] + {-# LINE 324 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOchildInhs -> + (case (({-# LINE 125 "./src-ag/Desugar.ag" #-} + [] + {-# LINE 329 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOchildSyns -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + [] + {-# LINE 334 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 339 "dist/build/Desugar.hs" #-} + )) 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 : Expression + 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 -> + Inh_Expression -> + Syn_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 (({-# LINE 49 "./src-ag/Desugar.ag" #-} + 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) + {-# LINE 406 "dist/build/Desugar.hs" #-} + )) of + { !__tup1 -> + (case (({-# LINE 49 "./src-ag/Desugar.ag" #-} + __tup1 + {-# LINE 411 "dist/build/Desugar.hs" #-} + )) of + { !(_,!_lhsOerrors) -> + (case (({-# LINE 49 "./src-ag/Desugar.ag" #-} + __tup1 + {-# LINE 416 "dist/build/Desugar.hs" #-} + )) of + { !(!_tks',_) -> + (case (({-# LINE 59 "./src-ag/Desugar.ag" #-} + Expression pos_ _tks' + {-# LINE 421 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOerrors,_lhsOoutput) }) }) }) }))) +-- Grammar ----------------------------------------------------- +{- + visit 0: + inherited attributes: + forcedIrrefutables : AttrMap + mainName : String + options : Options + synthesized attributes: + allAttributes : AttrMap + errors : Seq Error + output : Grammar + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) +-- semantic domain +newtype T_Grammar = T_Grammar (AttrMap -> + String -> + Options -> + ( AttrMap,(Seq Error),Grammar)) +data Inh_Grammar = Inh_Grammar {forcedIrrefutables_Inh_Grammar :: !(AttrMap),mainName_Inh_Grammar :: !(String),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 -> + Inh_Grammar -> + Syn_Grammar +wrap_Grammar !(T_Grammar sem) !(Inh_Grammar _lhsIforcedIrrefutables _lhsImainName _lhsIoptions) = + (let ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) = sem _lhsIforcedIrrefutables _lhsImainName _lhsIoptions + in (Syn_Grammar _lhsOallAttributes _lhsOerrors _lhsOoutput)) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !quantMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ !mergeMap_ = + (T_Grammar (\ (!_lhsIforcedIrrefutables) + (!_lhsImainName) + (!_lhsIoptions) -> + (case (nonts_) of + { ( !_nontsIinhMap',!_nontsIsynMap',!T_Nonterminals_1 nonts_1) -> + (case (({-# LINE 36 "./src-ag/Desugar.ag" #-} + _lhsIoptions + {-# LINE 494 "dist/build/Desugar.hs" #-} + )) of + { !_nontsOoptions -> + (case (({-# LINE 289 "./src-ag/Desugar.ag" #-} + _lhsImainName + {-# LINE 499 "dist/build/Desugar.hs" #-} + )) of + { !_nontsOmainName -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 504 "dist/build/Desugar.hs" #-} + )) of + { !_nontsOforcedIrrefutables -> + (case (({-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + _nontsIsynMap' + {-# LINE 509 "dist/build/Desugar.hs" #-} + )) of + { !_nontsOsynMap -> + (case (({-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + _nontsIinhMap' + {-# LINE 514 "dist/build/Desugar.hs" #-} + )) of + { !_nontsOinhMap -> + (case (({-# LINE 235 "./src-ag/Desugar.ag" #-} + augmentsMap_ + {-# LINE 519 "dist/build/Desugar.hs" #-} + )) of + { !_nontsOaugmentsIn -> + (case (nonts_1 _nontsOaugmentsIn _nontsOforcedIrrefutables _nontsOinhMap _nontsOmainName _nontsOoptions _nontsOsynMap) of + { ( !_nontsIallAttributes,!_nontsIaugmentsOut,!_nontsIerrors,!_nontsIoutput) -> + (case (({-# LINE 196 "./src-ag/Desugar.ag" #-} + _nontsIallAttributes + {-# LINE 526 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + _nontsIerrors + {-# LINE 531 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 319 "./src-ag/Desugar.ag" #-} + Grammar typeSyns_ + useMap_ + derivings_ + wrappers_ + _nontsIoutput + pragmas_ + manualAttrOrderMap_ + paramMap_ + contextMap_ + quantMap_ + uniqueMap_ + _nontsIaugmentsOut + aroundsMap_ + mergeMap_ + {-# LINE 549 "dist/build/Desugar.hs" #-} + )) 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 : HsToken + alternatives: + alternative AGLocal: + child var : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local tks : _ + alternative AGField: + child field : {Identifier} + child attr : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local mField : _ + local field' : _ + local tks : _ + alternative HsToken: + child value : {String} + child pos : {Pos} + visit 0: + local tks : _ + alternative CharToken: + child value : {String} + child pos : {Pos} + visit 0: + local tks : _ + alternative StrToken: + child value : {String} + child pos : {Pos} + visit 0: + local tks : _ + alternative Err: + child mesg : {String} + child pos : {Pos} + visit 0: + local tks : _ +-} +-- cata +sem_HsToken :: HsToken -> + T_HsToken +sem_HsToken !(AGLocal _var _pos _rdesc) = + (sem_HsToken_AGLocal _var _pos _rdesc) +sem_HsToken !(AGField _field _attr _pos _rdesc) = + (sem_HsToken_AGField _field _attr _pos _rdesc) +sem_HsToken !(HsToken _value _pos) = + (sem_HsToken_HsToken _value _pos) +sem_HsToken !(CharToken _value _pos) = + (sem_HsToken_CharToken _value _pos) +sem_HsToken !(StrToken _value _pos) = + (sem_HsToken_StrToken _value _pos) +sem_HsToken !(Err _mesg _pos) = + (sem_HsToken_Err _mesg _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 -> + Inh_HsToken -> + Syn_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_AGLocal :: Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGLocal !var_ !pos_ !rdesc_ = + (T_HsToken (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (({-# LINE 74 "./src-ag/Desugar.ag" #-} + if _lhsIuseFieldIdent + then _lhsIaddLines + 1 + else _lhsIaddLines + {-# LINE 653 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + Seq.empty + {-# LINE 658 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 77 "./src-ag/Desugar.ag" #-} + AGLocal var_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing) + {-# LINE 663 "dist/build/Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 70 "./src-ag/Desugar.ag" #-} + _tks + {-# LINE 668 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOtks -> + ( _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 (({-# LINE 79 "./src-ag/Desugar.ag" #-} + findField field_ attr_ _lhsIchildSyns + {-# LINE 687 "dist/build/Desugar.hs" #-} + )) of + { !_mField -> + (case (({-# LINE 81 "./src-ag/Desugar.ag" #-} + maybe field_ id _mField + {-# LINE 692 "dist/build/Desugar.hs" #-} + )) of + { !_field' -> + (case (({-# LINE 84 "./src-ag/Desugar.ag" #-} + if _lhsIuseFieldIdent || length (getName field_) < length (getName _field' ) + then _lhsIaddLines + 1 + else _lhsIaddLines + {-# LINE 699 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 82 "./src-ag/Desugar.ag" #-} + maybe (Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ (Ident "" (getPos field_)) False)) (const Seq.empty) _mField + {-# LINE 704 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 88 "./src-ag/Desugar.ag" #-} + AGField _field' attr_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing) + {-# LINE 709 "dist/build/Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 70 "./src-ag/Desugar.ag" #-} + _tks + {-# LINE 714 "dist/build/Desugar.hs" #-} + )) 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 (({-# LINE 64 "./src-ag/Desugar.ag" #-} + _lhsIaddLines + {-# LINE 731 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + Seq.empty + {-# LINE 736 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 90 "./src-ag/Desugar.ag" #-} + HsToken value_ (addl _lhsIaddLines pos_) + {-# LINE 741 "dist/build/Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 70 "./src-ag/Desugar.ag" #-} + _tks + {-# LINE 746 "dist/build/Desugar.hs" #-} + )) 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 (({-# LINE 64 "./src-ag/Desugar.ag" #-} + _lhsIaddLines + {-# LINE 763 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + Seq.empty + {-# LINE 768 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 92 "./src-ag/Desugar.ag" #-} + CharToken value_ (addl _lhsIaddLines pos_) + {-# LINE 773 "dist/build/Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 70 "./src-ag/Desugar.ag" #-} + _tks + {-# LINE 778 "dist/build/Desugar.hs" #-} + )) 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 (({-# LINE 64 "./src-ag/Desugar.ag" #-} + _lhsIaddLines + {-# LINE 795 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + Seq.empty + {-# LINE 800 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 94 "./src-ag/Desugar.ag" #-} + StrToken value_ (addl _lhsIaddLines pos_) + {-# LINE 805 "dist/build/Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 70 "./src-ag/Desugar.ag" #-} + _tks + {-# LINE 810 "dist/build/Desugar.hs" #-} + )) 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 (({-# LINE 64 "./src-ag/Desugar.ag" #-} + _lhsIaddLines + {-# LINE 827 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + Seq.empty + {-# LINE 832 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 96 "./src-ag/Desugar.ag" #-} + Err mesg_ (addl _lhsIaddLines pos_) + {-# LINE 837 "dist/build/Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 70 "./src-ag/Desugar.ag" #-} + _tks + {-# LINE 842 "dist/build/Desugar.hs" #-} + )) 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 : HsTokens + 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 -> + Inh_HsTokens -> + Syn_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 (({-# LINE 62 "./src-ag/Desugar.ag" #-} + _lhsIuseFieldIdent + {-# LINE 906 "dist/build/Desugar.hs" #-} + )) of + { !_tlOuseFieldIdent -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 911 "dist/build/Desugar.hs" #-} + )) of + { !_tlOchildSyns -> + (case (({-# LINE 62 "./src-ag/Desugar.ag" #-} + _lhsIuseFieldIdent + {-# LINE 916 "dist/build/Desugar.hs" #-} + )) of + { !_hdOuseFieldIdent -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 921 "dist/build/Desugar.hs" #-} + )) of + { !_hdOchildSyns -> + (case (({-# LINE 64 "./src-ag/Desugar.ag" #-} + _lhsIaddLines + {-# LINE 926 "dist/build/Desugar.hs" #-} + )) of + { !_hdOaddLines -> + (case (({-# LINE 168 "./src-ag/Desugar.ag" #-} + _lhsIruleDescr + {-# LINE 931 "dist/build/Desugar.hs" #-} + )) of + { !_hdOruleDescr -> + (case (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 936 "dist/build/Desugar.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 153 "./src-ag/Desugar.ag" #-} + _lhsIcon + {-# LINE 941 "dist/build/Desugar.hs" #-} + )) of + { !_hdOcon -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 946 "dist/build/Desugar.hs" #-} + )) of + { !_hdOchildInhs -> + (case (hd_ _hdOaddLines _hdOchildInhs _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent) of + { ( !_hdIaddLines,!_hdIerrors,!_hdItks) -> + (case (({-# LINE 64 "./src-ag/Desugar.ag" #-} + _hdIaddLines + {-# LINE 953 "dist/build/Desugar.hs" #-} + )) of + { !_tlOaddLines -> + (case (({-# LINE 168 "./src-ag/Desugar.ag" #-} + _lhsIruleDescr + {-# LINE 958 "dist/build/Desugar.hs" #-} + )) of + { !_tlOruleDescr -> + (case (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 963 "dist/build/Desugar.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 153 "./src-ag/Desugar.ag" #-} + _lhsIcon + {-# LINE 968 "dist/build/Desugar.hs" #-} + )) of + { !_tlOcon -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 973 "dist/build/Desugar.hs" #-} + )) of + { !_tlOchildInhs -> + (case (tl_ _tlOaddLines _tlOchildInhs _tlOchildSyns _tlOcon _tlOnt _tlOruleDescr _tlOuseFieldIdent) of + { ( !_tlIaddLines,!_tlIerrors,!_tlItks) -> + (case (({-# LINE 64 "./src-ag/Desugar.ag" #-} + _tlIaddLines + {-# LINE 980 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 985 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 70 "./src-ag/Desugar.ag" #-} + (:) _hdItks _tlItks + {-# LINE 990 "dist/build/Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 70 "./src-ag/Desugar.ag" #-} + _tks + {-# LINE 995 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOtks -> + ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil = + (T_HsTokens (\ (!_lhsIaddLines) + (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsInt) + (!_lhsIruleDescr) + (!_lhsIuseFieldIdent) -> + (case (({-# LINE 64 "./src-ag/Desugar.ag" #-} + _lhsIaddLines + {-# LINE 1010 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOaddLines -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + Seq.empty + {-# LINE 1015 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 70 "./src-ag/Desugar.ag" #-} + [] + {-# LINE 1020 "dist/build/Desugar.hs" #-} + )) of + { !_tks -> + (case (({-# LINE 70 "./src-ag/Desugar.ag" #-} + _tks + {-# LINE 1025 "dist/build/Desugar.hs" #-} + )) 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 -> + Inh_HsTokensRoot -> + Syn_HsTokensRoot +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 (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 1078 "dist/build/Desugar.hs" #-} + )) of + { !_tokensOnt -> + (case (({-# LINE 153 "./src-ag/Desugar.ag" #-} + _lhsIcon + {-# LINE 1083 "dist/build/Desugar.hs" #-} + )) of + { !_tokensOcon -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 1088 "dist/build/Desugar.hs" #-} + )) of + { !_tokensOchildSyns -> + (case (({-# LINE 62 "./src-ag/Desugar.ag" #-} + _lhsIuseFieldIdent + {-# LINE 1093 "dist/build/Desugar.hs" #-} + )) of + { !_tokensOuseFieldIdent -> + (case (({-# LINE 168 "./src-ag/Desugar.ag" #-} + _lhsIruleDescr + {-# LINE 1098 "dist/build/Desugar.hs" #-} + )) of + { !_tokensOruleDescr -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 1103 "dist/build/Desugar.hs" #-} + )) of + { !_tokensOchildInhs -> + (case (({-# LINE 67 "./src-ag/Desugar.ag" #-} + 0 + {-# LINE 1108 "dist/build/Desugar.hs" #-} + )) of + { !_tokensOaddLines -> + (case (tokens_ _tokensOaddLines _tokensOchildInhs _tokensOchildSyns _tokensOcon _tokensOnt _tokensOruleDescr _tokensOuseFieldIdent) of + { ( !_tokensIaddLines,!_tokensIerrors,!_tokensItks) -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + _tokensIerrors + {-# LINE 1115 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 69 "./src-ag/Desugar.ag" #-} + _tokensItks + {-# LINE 1120 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOtks -> + ( _lhsOerrors,_lhsOtks) }) }) }) }) }) }) }) }) }) }))) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + synthesized attributes: + inhMap' : Map Identifier Attributes + synMap' : Map Identifier Attributes + visit 1: + inherited attributes: + augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + forcedIrrefutables : AttrMap + inhMap : Map Identifier Attributes + mainName : String + options : Options + synMap : Map Identifier Attributes + synthesized attributes: + allAttributes : AttrMap + augmentsOut : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + errors : Seq Error + output : Nonterminal + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions + visit 1: + local augmentsIn : _ + local augmentsOut : _ + local extraInh : _ +-} +-- 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 (( (Map Identifier Attributes),(Map Identifier Attributes),T_Nonterminal_1)) +newtype T_Nonterminal_1 = T_Nonterminal_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + AttrMap -> + (Map Identifier Attributes) -> + String -> + Options -> + (Map Identifier Attributes) -> + ( AttrMap,(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))),(Seq Error),Nonterminal)) +data Inh_Nonterminal = Inh_Nonterminal {augmentsIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),forcedIrrefutables_Inh_Nonterminal :: !(AttrMap),inhMap_Inh_Nonterminal :: !((Map Identifier Attributes)),mainName_Inh_Nonterminal :: !(String),options_Inh_Nonterminal :: !(Options),synMap_Inh_Nonterminal :: !((Map Identifier Attributes))} +data Syn_Nonterminal = Syn_Nonterminal {allAttributes_Syn_Nonterminal :: !(AttrMap),augmentsOut_Syn_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),errors_Syn_Nonterminal :: !((Seq Error)),inhMap'_Syn_Nonterminal :: !((Map Identifier Attributes)),output_Syn_Nonterminal :: !(Nonterminal),synMap'_Syn_Nonterminal :: !((Map Identifier Attributes))} +wrap_Nonterminal :: T_Nonterminal -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal !(T_Nonterminal sem) !(Inh_Nonterminal _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = + (let ( !_lhsOinhMap',!_lhsOsynMap',!T_Nonterminal_1 sem_1) = sem + ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem_1 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap + in (Syn_Nonterminal _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap')) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal !nt_ !params_ !inh_ !syn_ !(T_Productions prods_) = + (T_Nonterminal (case (({-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 1187 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOinhMap' -> + (case (({-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 1192 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOsynMap' -> + (case ((let sem_Nonterminal_Nonterminal_1 :: T_Nonterminal_1 + sem_Nonterminal_Nonterminal_1 = + (T_Nonterminal_1 (\ (!_lhsIaugmentsIn) + (!_lhsIforcedIrrefutables) + (!_lhsIinhMap) + (!_lhsImainName) + (!_lhsIoptions) + (!_lhsIsynMap) -> + (case (({-# LINE 157 "./src-ag/Desugar.ag" #-} + nt_ + {-# LINE 1205 "dist/build/Desugar.hs" #-} + )) of + { !_prodsOnt -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1210 "dist/build/Desugar.hs" #-} + )) of + { !_prodsOsynMap -> + (case (({-# LINE 36 "./src-ag/Desugar.ag" #-} + _lhsIoptions + {-# LINE 1215 "dist/build/Desugar.hs" #-} + )) of + { !_prodsOoptions -> + (case (({-# LINE 289 "./src-ag/Desugar.ag" #-} + _lhsImainName + {-# LINE 1220 "dist/build/Desugar.hs" #-} + )) of + { !_prodsOmainName -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1225 "dist/build/Desugar.hs" #-} + )) of + { !_prodsOinhMap -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1230 "dist/build/Desugar.hs" #-} + )) of + { !_prodsOforcedIrrefutables -> + (case (({-# LINE 239 "./src-ag/Desugar.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn + {-# LINE 1235 "dist/build/Desugar.hs" #-} + )) of + { !_augmentsIn -> + (case (({-# LINE 230 "./src-ag/Desugar.ag" #-} + _augmentsIn + {-# LINE 1240 "dist/build/Desugar.hs" #-} + )) of + { !_prodsOaugmentsIn -> + (case (prods_ _prodsOaugmentsIn _prodsOforcedIrrefutables _prodsOinhMap _prodsOmainName _prodsOnt _prodsOoptions _prodsOsynMap) of + { ( !_prodsIallAttributes,!_prodsIaugmentsOut,!_prodsIerrors,!_prodsIoutput) -> + (case (({-# LINE 196 "./src-ag/Desugar.ag" #-} + _prodsIallAttributes + {-# LINE 1247 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 240 "./src-ag/Desugar.ag" #-} + Map.singleton nt_ _prodsIaugmentsOut + {-# LINE 1252 "dist/build/Desugar.hs" #-} + )) of + { !_augmentsOut -> + (case (({-# LINE 229 "./src-ag/Desugar.ag" #-} + _augmentsOut + {-# LINE 1257 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOaugmentsOut -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + _prodsIerrors + {-# LINE 1262 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 292 "./src-ag/Desugar.ag" #-} + addLateAttr _lhsIoptions _lhsImainName + {-# LINE 1267 "dist/build/Desugar.hs" #-} + )) of + { !_extraInh -> + (case (({-# LINE 308 "./src-ag/Desugar.ag" #-} + Nonterminal + nt_ params_ + (_extraInh `Map.union` inh_) + syn_ + _prodsIoutput + {-# LINE 1276 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_Nonterminal_Nonterminal_1)) of + { ( !sem_Nonterminal_1) -> + ( _lhsOinhMap',_lhsOsynMap',sem_Nonterminal_1) }) }) })) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + synthesized attributes: + inhMap' : Map Identifier Attributes + synMap' : Map Identifier Attributes + visit 1: + inherited attributes: + augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + forcedIrrefutables : AttrMap + inhMap : Map Identifier Attributes + mainName : String + options : Options + synMap : Map Identifier Attributes + synthesized attributes: + allAttributes : AttrMap + augmentsOut : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + errors : Seq Error + output : Nonterminals + 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 (( (Map Identifier Attributes),(Map Identifier Attributes),T_Nonterminals_1)) +newtype T_Nonterminals_1 = T_Nonterminals_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + AttrMap -> + (Map Identifier Attributes) -> + String -> + Options -> + (Map Identifier Attributes) -> + ( AttrMap,(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))),(Seq Error),Nonterminals)) +data Inh_Nonterminals = Inh_Nonterminals {augmentsIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),forcedIrrefutables_Inh_Nonterminals :: !(AttrMap),inhMap_Inh_Nonterminals :: !((Map Identifier Attributes)),mainName_Inh_Nonterminals :: !(String),options_Inh_Nonterminals :: !(Options),synMap_Inh_Nonterminals :: !((Map Identifier Attributes))} +data Syn_Nonterminals = Syn_Nonterminals {allAttributes_Syn_Nonterminals :: !(AttrMap),augmentsOut_Syn_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),errors_Syn_Nonterminals :: !((Seq Error)),inhMap'_Syn_Nonterminals :: !((Map Identifier Attributes)),output_Syn_Nonterminals :: !(Nonterminals),synMap'_Syn_Nonterminals :: !((Map Identifier Attributes))} +wrap_Nonterminals :: T_Nonterminals -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals !(T_Nonterminals sem) !(Inh_Nonterminals _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = + (let ( !_lhsOinhMap',!_lhsOsynMap',!T_Nonterminals_1 sem_1) = sem + ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem_1 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap + in (Syn_Nonterminals _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap')) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons !(T_Nonterminal hd_) !(T_Nonterminals tl_) = + (T_Nonterminals (case (tl_) of + { ( !_tlIinhMap',!_tlIsynMap',!T_Nonterminals_1 tl_1) -> + (case (hd_) of + { ( !_hdIinhMap',!_hdIsynMap',!T_Nonterminal_1 hd_1) -> + (case (({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + _hdIinhMap' `Map.union` _tlIinhMap' + {-# LINE 1345 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOinhMap' -> + (case (({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + _hdIsynMap' `Map.union` _tlIsynMap' + {-# LINE 1350 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOsynMap' -> + (case ((let sem_Nonterminals_Cons_1 :: T_Nonterminals_1 + sem_Nonterminals_Cons_1 = + (T_Nonterminals_1 (\ (!_lhsIaugmentsIn) + (!_lhsIforcedIrrefutables) + (!_lhsIinhMap) + (!_lhsImainName) + (!_lhsIoptions) + (!_lhsIsynMap) -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1363 "dist/build/Desugar.hs" #-} + )) of + { !_tlOsynMap -> + (case (({-# LINE 36 "./src-ag/Desugar.ag" #-} + _lhsIoptions + {-# LINE 1368 "dist/build/Desugar.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 289 "./src-ag/Desugar.ag" #-} + _lhsImainName + {-# LINE 1373 "dist/build/Desugar.hs" #-} + )) of + { !_tlOmainName -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1378 "dist/build/Desugar.hs" #-} + )) of + { !_tlOinhMap -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1383 "dist/build/Desugar.hs" #-} + )) of + { !_tlOforcedIrrefutables -> + (case (({-# LINE 228 "./src-ag/Desugar.ag" #-} + _lhsIaugmentsIn + {-# LINE 1388 "dist/build/Desugar.hs" #-} + )) of + { !_tlOaugmentsIn -> + (case (tl_1 _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOmainName _tlOoptions _tlOsynMap) of + { ( !_tlIallAttributes,!_tlIaugmentsOut,!_tlIerrors,!_tlIoutput) -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1395 "dist/build/Desugar.hs" #-} + )) of + { !_hdOsynMap -> + (case (({-# LINE 36 "./src-ag/Desugar.ag" #-} + _lhsIoptions + {-# LINE 1400 "dist/build/Desugar.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 289 "./src-ag/Desugar.ag" #-} + _lhsImainName + {-# LINE 1405 "dist/build/Desugar.hs" #-} + )) of + { !_hdOmainName -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1410 "dist/build/Desugar.hs" #-} + )) of + { !_hdOinhMap -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1415 "dist/build/Desugar.hs" #-} + )) of + { !_hdOforcedIrrefutables -> + (case (({-# LINE 228 "./src-ag/Desugar.ag" #-} + _lhsIaugmentsIn + {-# LINE 1420 "dist/build/Desugar.hs" #-} + )) of + { !_hdOaugmentsIn -> + (case (hd_1 _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOmainName _hdOoptions _hdOsynMap) of + { ( !_hdIallAttributes,!_hdIaugmentsOut,!_hdIerrors,!_hdIoutput) -> + (case (({-# LINE 196 "./src-ag/Desugar.ag" #-} + _hdIallAttributes `mergeAttributes` _tlIallAttributes + {-# LINE 1427 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 229 "./src-ag/Desugar.ag" #-} + _hdIaugmentsOut `Map.union` _tlIaugmentsOut + {-# LINE 1432 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOaugmentsOut -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 1437 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 1442 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 1447 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_Nonterminals_Cons_1)) of + { ( !sem_Nonterminals_1) -> + ( _lhsOinhMap',_lhsOsynMap',sem_Nonterminals_1) }) }) }) }) })) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (case (({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + Map.empty + {-# LINE 1458 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOinhMap' -> + (case (({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + Map.empty + {-# LINE 1463 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOsynMap' -> + (case ((let sem_Nonterminals_Nil_1 :: T_Nonterminals_1 + sem_Nonterminals_Nil_1 = + (T_Nonterminals_1 (\ (!_lhsIaugmentsIn) + (!_lhsIforcedIrrefutables) + (!_lhsIinhMap) + (!_lhsImainName) + (!_lhsIoptions) + (!_lhsIsynMap) -> + (case (({-# LINE 196 "./src-ag/Desugar.ag" #-} + Map.empty + {-# LINE 1476 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 229 "./src-ag/Desugar.ag" #-} + Map.empty + {-# LINE 1481 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOaugmentsOut -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + Seq.empty + {-# LINE 1486 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + [] + {-# LINE 1491 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 1496 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }))) + in sem_Nonterminals_Nil_1)) of + { ( !sem_Nonterminals_1) -> + ( _lhsOinhMap',_lhsOsynMap',sem_Nonterminals_1) }) }) })) +-- 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 : Pattern + errors : Seq Error + output : Pattern + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 1: + local copy : _ + local output : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 1: + local copy : _ + local output : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local def : _ + visit 1: + local copy : _ + local _tup2 : _ + local field' : _ + local err2 : _ + local err1 : _ + local output : _ + alternative Irrefutable: + child pat : Pattern + 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 !(Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern !(Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern !(Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern !(Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +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 -> + Inh_Pattern -> + Syn_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_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 (({-# LINE 179 "./src-ag/Desugar.ag" #-} + _patsIdefsCollect + {-# LINE 1597 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Pattern_Constr_1 :: T_Pattern_1 + sem_Pattern_Constr_1 = + (T_Pattern_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 1610 "dist/build/Desugar.hs" #-} + )) of + { !_patsOnt -> + (case (({-# LINE 153 "./src-ag/Desugar.ag" #-} + _lhsIcon + {-# LINE 1615 "dist/build/Desugar.hs" #-} + )) of + { !_patsOcon -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1620 "dist/build/Desugar.hs" #-} + )) of + { !_patsOforcedIrrefutables -> + (case (({-# LINE 185 "./src-ag/Desugar.ag" #-} + _lhsIdefs + {-# LINE 1625 "dist/build/Desugar.hs" #-} + )) of + { !_patsOdefs -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 1630 "dist/build/Desugar.hs" #-} + )) of + { !_patsOchildSyns -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 1635 "dist/build/Desugar.hs" #-} + )) of + { !_patsOchildInhs -> + (case (pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) of + { ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) -> + (case (({-# LINE 196 "./src-ag/Desugar.ag" #-} + _patsIallAttributes + {-# LINE 1642 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 1647 "dist/build/Desugar.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1652 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + _patsIerrors + {-# LINE 1657 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + Constr name_ _patsIoutput + {-# LINE 1662 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 1667 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_Pattern_Constr_1)) of + { ( !sem_Pattern_1) -> + ( _lhsOdefsCollect,sem_Pattern_1) }) }) })) +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 (({-# LINE 179 "./src-ag/Desugar.ag" #-} + _patsIdefsCollect + {-# LINE 1682 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Pattern_Product_1 :: T_Pattern_1 + sem_Pattern_Product_1 = + (T_Pattern_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 1695 "dist/build/Desugar.hs" #-} + )) of + { !_patsOnt -> + (case (({-# LINE 153 "./src-ag/Desugar.ag" #-} + _lhsIcon + {-# LINE 1700 "dist/build/Desugar.hs" #-} + )) of + { !_patsOcon -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1705 "dist/build/Desugar.hs" #-} + )) of + { !_patsOforcedIrrefutables -> + (case (({-# LINE 185 "./src-ag/Desugar.ag" #-} + _lhsIdefs + {-# LINE 1710 "dist/build/Desugar.hs" #-} + )) of + { !_patsOdefs -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 1715 "dist/build/Desugar.hs" #-} + )) of + { !_patsOchildSyns -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 1720 "dist/build/Desugar.hs" #-} + )) of + { !_patsOchildInhs -> + (case (pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) of + { ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) -> + (case (({-# LINE 196 "./src-ag/Desugar.ag" #-} + _patsIallAttributes + {-# LINE 1727 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 1732 "dist/build/Desugar.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1737 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + _patsIerrors + {-# LINE 1742 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + Product pos_ _patsIoutput + {-# LINE 1747 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 1752 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_Pattern_Product_1)) of + { ( !sem_Pattern_1) -> + ( _lhsOdefsCollect,sem_Pattern_1) }) }) })) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_) = + (T_Pattern (case (({-# LINE 182 "./src-ag/Desugar.ag" #-} + Set.singleton (field_, attr_) + {-# LINE 1766 "dist/build/Desugar.hs" #-} + )) of + { !_def -> + (case (pat_) of + { ( !_patIdefsCollect,!T_Pattern_1 pat_1) -> + (case (({-# LINE 183 "./src-ag/Desugar.ag" #-} + _def `Set.union` _patIdefsCollect + {-# LINE 1773 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Pattern_Alias_1 :: T_Pattern_1 + sem_Pattern_Alias_1 = + (T_Pattern_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 1786 "dist/build/Desugar.hs" #-} + )) of + { !_patOnt -> + (case (({-# LINE 153 "./src-ag/Desugar.ag" #-} + _lhsIcon + {-# LINE 1791 "dist/build/Desugar.hs" #-} + )) of + { !_patOcon -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1796 "dist/build/Desugar.hs" #-} + )) of + { !_patOforcedIrrefutables -> + (case (({-# LINE 185 "./src-ag/Desugar.ag" #-} + _lhsIdefs + {-# LINE 1801 "dist/build/Desugar.hs" #-} + )) of + { !_patOdefs -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 1806 "dist/build/Desugar.hs" #-} + )) of + { !_patOchildSyns -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 1811 "dist/build/Desugar.hs" #-} + )) of + { !_patOchildInhs -> + (case (pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt) of + { ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) -> + (case (({-# LINE 200 "./src-ag/Desugar.ag" #-} + (Map.singleton _lhsInt $ Map.singleton _lhsIcon $ Set.singleton (field_, attr_)) `mergeAttributes` _patIallAttributes + {-# LINE 1818 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 1823 "dist/build/Desugar.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1828 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 110 "./src-ag/Desugar.ag" #-} + maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "" (getPos field_)) attr_ True) $ + findField field_ attr_ _lhsIchildInhs + {-# LINE 1834 "dist/build/Desugar.hs" #-} + )) of + { !__tup2 -> + (case (({-# LINE 110 "./src-ag/Desugar.ag" #-} + __tup2 + {-# LINE 1839 "dist/build/Desugar.hs" #-} + )) of + { !(!_field',_) -> + (case (({-# LINE 112 "./src-ag/Desugar.ag" #-} + if _field' == field_ + then Seq.empty + else if (_field' , attr_) `Set.member` _lhsIdefs + then Seq.singleton $ DupRule _lhsInt _lhsIcon field_ attr_ _field' + else Seq.empty + {-# LINE 1848 "dist/build/Desugar.hs" #-} + )) of + { !_err2 -> + (case (({-# LINE 110 "./src-ag/Desugar.ag" #-} + __tup2 + {-# LINE 1853 "dist/build/Desugar.hs" #-} + )) of + { !(_,!_err1) -> + (case (({-# LINE 117 "./src-ag/Desugar.ag" #-} + _err1 Seq.>< _err2 Seq.>< _patIerrors + {-# LINE 1858 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 118 "./src-ag/Desugar.ag" #-} + Alias _field' attr_ _patIoutput + {-# LINE 1863 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 219 "./src-ag/Desugar.ag" #-} + if Set.member (field_, attr_) $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt $ _lhsIforcedIrrefutables + then Irrefutable _output + else _output + {-# LINE 1870 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_Pattern_Alias_1)) of + { ( !sem_Pattern_1) -> + ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) })) +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 (({-# LINE 179 "./src-ag/Desugar.ag" #-} + _patIdefsCollect + {-# LINE 1884 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Pattern_Irrefutable_1 :: T_Pattern_1 + sem_Pattern_Irrefutable_1 = + (T_Pattern_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (({-# LINE 202 "./src-ag/Desugar.ag" #-} + Map.empty + {-# LINE 1897 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 1902 "dist/build/Desugar.hs" #-} + )) of + { !_patOnt -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 1907 "dist/build/Desugar.hs" #-} + )) of + { !_patOforcedIrrefutables -> + (case (({-# LINE 185 "./src-ag/Desugar.ag" #-} + _lhsIdefs + {-# LINE 1912 "dist/build/Desugar.hs" #-} + )) of + { !_patOdefs -> + (case (({-# LINE 153 "./src-ag/Desugar.ag" #-} + _lhsIcon + {-# LINE 1917 "dist/build/Desugar.hs" #-} + )) of + { !_patOcon -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 1922 "dist/build/Desugar.hs" #-} + )) of + { !_patOchildSyns -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 1927 "dist/build/Desugar.hs" #-} + )) of + { !_patOchildInhs -> + (case (pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt) of + { ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 1934 "dist/build/Desugar.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1939 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + _patIerrors + {-# LINE 1944 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + Irrefutable _patIoutput + {-# LINE 1949 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 1954 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_Pattern_Irrefutable_1)) of + { ( !sem_Pattern_1) -> + ( _lhsOdefsCollect,sem_Pattern_1) }) }) })) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore !pos_ = + (T_Pattern (case (({-# LINE 179 "./src-ag/Desugar.ag" #-} + Set.empty + {-# LINE 1966 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Pattern_Underscore_1 :: T_Pattern_1 + sem_Pattern_Underscore_1 = + (T_Pattern_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (({-# LINE 196 "./src-ag/Desugar.ag" #-} + Map.empty + {-# LINE 1979 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 1984 "dist/build/Desugar.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1989 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + Seq.empty + {-# LINE 1994 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + Underscore pos_ + {-# LINE 1999 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 2004 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }))) + in sem_Pattern_Underscore_1)) of + { ( !sem_Pattern_1) -> + ( _lhsOdefsCollect,sem_Pattern_1) }) })) +-- 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 : Patterns + errors : Seq Error + output : Patterns + 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 -> + Inh_Patterns -> + Syn_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 (({-# LINE 179 "./src-ag/Desugar.ag" #-} + _hdIdefsCollect `Set.union` _tlIdefsCollect + {-# LINE 2074 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Patterns_Cons_1 :: T_Patterns_1 + sem_Patterns_Cons_1 = + (T_Patterns_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 2087 "dist/build/Desugar.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 153 "./src-ag/Desugar.ag" #-} + _lhsIcon + {-# LINE 2092 "dist/build/Desugar.hs" #-} + )) of + { !_tlOcon -> + (case (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 2097 "dist/build/Desugar.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 153 "./src-ag/Desugar.ag" #-} + _lhsIcon + {-# LINE 2102 "dist/build/Desugar.hs" #-} + )) of + { !_hdOcon -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 2107 "dist/build/Desugar.hs" #-} + )) of + { !_tlOforcedIrrefutables -> + (case (({-# LINE 185 "./src-ag/Desugar.ag" #-} + _lhsIdefs + {-# LINE 2112 "dist/build/Desugar.hs" #-} + )) of + { !_tlOdefs -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 2117 "dist/build/Desugar.hs" #-} + )) of + { !_tlOchildSyns -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 2122 "dist/build/Desugar.hs" #-} + )) of + { !_tlOchildInhs -> + (case (tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt) of + { ( !_tlIallAttributes,!_tlIcopy,!_tlIerrors,!_tlIoutput) -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 2129 "dist/build/Desugar.hs" #-} + )) of + { !_hdOforcedIrrefutables -> + (case (({-# LINE 185 "./src-ag/Desugar.ag" #-} + _lhsIdefs + {-# LINE 2134 "dist/build/Desugar.hs" #-} + )) of + { !_hdOdefs -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 2139 "dist/build/Desugar.hs" #-} + )) of + { !_hdOchildSyns -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 2144 "dist/build/Desugar.hs" #-} + )) of + { !_hdOchildInhs -> + (case (hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt) of + { ( !_hdIallAttributes,!_hdIcopy,!_hdIerrors,!_hdIoutput) -> + (case (({-# LINE 196 "./src-ag/Desugar.ag" #-} + _hdIallAttributes `mergeAttributes` _tlIallAttributes + {-# LINE 2151 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 2156 "dist/build/Desugar.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 2161 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 2166 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 2171 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 2176 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_Patterns_Cons_1)) of + { ( !sem_Patterns_1) -> + ( _lhsOdefsCollect,sem_Patterns_1) }) }) }) })) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (case (({-# LINE 179 "./src-ag/Desugar.ag" #-} + Set.empty + {-# LINE 2187 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Patterns_Nil_1 :: T_Patterns_1 + sem_Patterns_Nil_1 = + (T_Patterns_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) -> + (case (({-# LINE 196 "./src-ag/Desugar.ag" #-} + Map.empty + {-# LINE 2200 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 2205 "dist/build/Desugar.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 2210 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + Seq.empty + {-# LINE 2215 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + [] + {-# LINE 2220 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 2225 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }))) + in sem_Patterns_Nil_1)) of + { ( !sem_Patterns_1) -> + ( _lhsOdefsCollect,sem_Patterns_1) }) })) +-- Production -------------------------------------------------- +{- + visit 0: + inherited attributes: + augmentsIn : Map ConstructorIdent (Map Identifier [Expression]) + forcedIrrefutables : AttrMap + inhMap : Map Identifier Attributes + mainName : String + nt : NontermIdent + options : Options + synMap : Map Identifier Attributes + synthesized attributes: + allAttributes : AttrMap + augmentsOut : Map ConstructorIdent (Map Identifier [Expression]) + errors : Seq Error + output : Production + alternatives: + alternative Production: + child con : {ConstructorIdent} + child params : {[Identifier]} + child constraints : {[Type]} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + child macro : {MaybeMacro} + visit 0: + local augmentsIn : _ + local _tup3 : _ + local augmentsOut1 : _ + local augmentsOut : _ + local augmentErrs : _ + local output : _ +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production !(Production _con _params _constraints _children _rules _typeSigs _macro) = + (sem_Production_Production _con _params _constraints (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs) _macro) +-- semantic domain +newtype T_Production = T_Production ((Map ConstructorIdent (Map Identifier [Expression])) -> + AttrMap -> + (Map Identifier Attributes) -> + String -> + NontermIdent -> + Options -> + (Map Identifier Attributes) -> + ( AttrMap,(Map ConstructorIdent (Map Identifier [Expression])),(Seq Error),Production)) +data Inh_Production = Inh_Production {augmentsIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),forcedIrrefutables_Inh_Production :: !(AttrMap),inhMap_Inh_Production :: !((Map Identifier Attributes)),mainName_Inh_Production :: !(String),nt_Inh_Production :: !(NontermIdent),options_Inh_Production :: !(Options),synMap_Inh_Production :: !((Map Identifier Attributes))} +data Syn_Production = Syn_Production {allAttributes_Syn_Production :: !(AttrMap),augmentsOut_Syn_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),errors_Syn_Production :: !((Seq Error)),output_Syn_Production :: !(Production)} +wrap_Production :: T_Production -> + Inh_Production -> + Syn_Production +wrap_Production !(T_Production sem) !(Inh_Production _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) = + (let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap + in (Syn_Production _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput)) +sem_Production_Production :: ConstructorIdent -> + ([Identifier]) -> + ([Type]) -> + T_Children -> + T_Rules -> + T_TypeSigs -> + MaybeMacro -> + T_Production +sem_Production_Production !con_ !params_ !constraints_ !(T_Children children_) !(T_Rules rules_) !(T_TypeSigs typeSigs_) !macro_ = + (T_Production (\ (!_lhsIaugmentsIn) + (!_lhsIforcedIrrefutables) + (!_lhsIinhMap) + (!_lhsImainName) + (!_lhsInt) + (!_lhsIoptions) + (!_lhsIsynMap) -> + (case (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 2305 "dist/build/Desugar.hs" #-} + )) of + { !_rulesOnt -> + (case (({-# LINE 161 "./src-ag/Desugar.ag" #-} + con_ + {-# LINE 2310 "dist/build/Desugar.hs" #-} + )) of + { !_rulesOcon -> + (case (rules_) of + { ( !_rulesIdefsCollect,!T_Rules_1 rules_1) -> + (case (({-# LINE 36 "./src-ag/Desugar.ag" #-} + _lhsIoptions + {-# LINE 2317 "dist/build/Desugar.hs" #-} + )) of + { !_rulesOoptions -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 2322 "dist/build/Desugar.hs" #-} + )) of + { !_rulesOforcedIrrefutables -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2327 "dist/build/Desugar.hs" #-} + )) of + { !_childrenOsynMap -> + (case (({-# LINE 36 "./src-ag/Desugar.ag" #-} + _lhsIoptions + {-# LINE 2332 "dist/build/Desugar.hs" #-} + )) of + { !_childrenOoptions -> + (case (({-# LINE 289 "./src-ag/Desugar.ag" #-} + _lhsImainName + {-# LINE 2337 "dist/build/Desugar.hs" #-} + )) of + { !_childrenOmainName -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 2342 "dist/build/Desugar.hs" #-} + )) of + { !_childrenOinhMap -> + (case (children_ _childrenOinhMap _childrenOmainName _childrenOoptions _childrenOsynMap) of + { ( !_childrenIchildInhs,!_childrenIchildSyns,!_childrenIoutput) -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _childrenIchildSyns + {-# LINE 2349 "dist/build/Desugar.hs" #-} + )) of + { !_rulesOchildSyns -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _childrenIchildInhs + {-# LINE 2354 "dist/build/Desugar.hs" #-} + )) of + { !_rulesOchildInhs -> + (case (({-# LINE 188 "./src-ag/Desugar.ag" #-} + _rulesIdefsCollect + {-# LINE 2359 "dist/build/Desugar.hs" #-} + )) of + { !_rulesOdefs -> + (case (rules_1 _rulesOchildInhs _rulesOchildSyns _rulesOcon _rulesOdefs _rulesOforcedIrrefutables _rulesOnt _rulesOoptions) of + { ( !_rulesIallAttributes,!_rulesIerrors,!_rulesIoutput) -> + (case (({-# LINE 196 "./src-ag/Desugar.ag" #-} + _rulesIallAttributes + {-# LINE 2366 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 244 "./src-ag/Desugar.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIaugmentsIn + {-# LINE 2371 "dist/build/Desugar.hs" #-} + )) of + { !_augmentsIn -> + (case (({-# LINE 247 "./src-ag/Desugar.ag" #-} + Map.mapAccum (desugarExprs _lhsIoptions _lhsInt con_ _childrenIchildInhs _childrenIchildSyns) Seq.empty _augmentsIn + {-# LINE 2376 "dist/build/Desugar.hs" #-} + )) of + { !__tup3 -> + (case (({-# LINE 247 "./src-ag/Desugar.ag" #-} + __tup3 + {-# LINE 2381 "dist/build/Desugar.hs" #-} + )) of + { !(_,!_augmentsOut1) -> + (case (({-# LINE 245 "./src-ag/Desugar.ag" #-} + Map.singleton con_ _augmentsOut1 + {-# LINE 2386 "dist/build/Desugar.hs" #-} + )) of + { !_augmentsOut -> + (case (({-# LINE 231 "./src-ag/Desugar.ag" #-} + _augmentsOut + {-# LINE 2391 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOaugmentsOut -> + (case (({-# LINE 247 "./src-ag/Desugar.ag" #-} + __tup3 + {-# LINE 2396 "dist/build/Desugar.hs" #-} + )) of + { !(!_augmentErrs,_) -> + (case (({-# LINE 283 "./src-ag/Desugar.ag" #-} + _rulesIerrors Seq.>< _augmentErrs + {-# LINE 2401 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (typeSigs_) of + { ( !_typeSigsIoutput) -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + Production con_ params_ constraints_ _childrenIoutput _rulesIoutput _typeSigsIoutput macro_ + {-# LINE 2408 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 2413 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +-- Productions ------------------------------------------------- +{- + visit 0: + inherited attributes: + augmentsIn : Map ConstructorIdent (Map Identifier [Expression]) + forcedIrrefutables : AttrMap + inhMap : Map Identifier Attributes + mainName : String + nt : NontermIdent + options : Options + synMap : Map Identifier Attributes + synthesized attributes: + allAttributes : AttrMap + augmentsOut : Map ConstructorIdent (Map Identifier [Expression]) + errors : Seq Error + output : Productions + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_Productions :: Productions -> + T_Productions +sem_Productions !list = + (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list)) +-- semantic domain +newtype T_Productions = T_Productions ((Map ConstructorIdent (Map Identifier [Expression])) -> + AttrMap -> + (Map Identifier Attributes) -> + String -> + NontermIdent -> + Options -> + (Map Identifier Attributes) -> + ( AttrMap,(Map ConstructorIdent (Map Identifier [Expression])),(Seq Error),Productions)) +data Inh_Productions = Inh_Productions {augmentsIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),forcedIrrefutables_Inh_Productions :: !(AttrMap),inhMap_Inh_Productions :: !((Map Identifier Attributes)),mainName_Inh_Productions :: !(String),nt_Inh_Productions :: !(NontermIdent),options_Inh_Productions :: !(Options),synMap_Inh_Productions :: !((Map Identifier Attributes))} +data Syn_Productions = Syn_Productions {allAttributes_Syn_Productions :: !(AttrMap),augmentsOut_Syn_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),errors_Syn_Productions :: !((Seq Error)),output_Syn_Productions :: !(Productions)} +wrap_Productions :: T_Productions -> + Inh_Productions -> + Syn_Productions +wrap_Productions !(T_Productions sem) !(Inh_Productions _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) = + (let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap + in (Syn_Productions _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput)) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons !(T_Production hd_) !(T_Productions tl_) = + (T_Productions (\ (!_lhsIaugmentsIn) + (!_lhsIforcedIrrefutables) + (!_lhsIinhMap) + (!_lhsImainName) + (!_lhsInt) + (!_lhsIoptions) + (!_lhsIsynMap) -> + (case (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 2478 "dist/build/Desugar.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 2483 "dist/build/Desugar.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2488 "dist/build/Desugar.hs" #-} + )) of + { !_tlOsynMap -> + (case (({-# LINE 36 "./src-ag/Desugar.ag" #-} + _lhsIoptions + {-# LINE 2493 "dist/build/Desugar.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 289 "./src-ag/Desugar.ag" #-} + _lhsImainName + {-# LINE 2498 "dist/build/Desugar.hs" #-} + )) of + { !_tlOmainName -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 2503 "dist/build/Desugar.hs" #-} + )) of + { !_tlOinhMap -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 2508 "dist/build/Desugar.hs" #-} + )) of + { !_tlOforcedIrrefutables -> + (case (({-# LINE 230 "./src-ag/Desugar.ag" #-} + _lhsIaugmentsIn + {-# LINE 2513 "dist/build/Desugar.hs" #-} + )) of + { !_tlOaugmentsIn -> + (case (tl_ _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOmainName _tlOnt _tlOoptions _tlOsynMap) of + { ( !_tlIallAttributes,!_tlIaugmentsOut,!_tlIerrors,!_tlIoutput) -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2520 "dist/build/Desugar.hs" #-} + )) of + { !_hdOsynMap -> + (case (({-# LINE 36 "./src-ag/Desugar.ag" #-} + _lhsIoptions + {-# LINE 2525 "dist/build/Desugar.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 289 "./src-ag/Desugar.ag" #-} + _lhsImainName + {-# LINE 2530 "dist/build/Desugar.hs" #-} + )) of + { !_hdOmainName -> + (case (({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 2535 "dist/build/Desugar.hs" #-} + )) of + { !_hdOinhMap -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 2540 "dist/build/Desugar.hs" #-} + )) of + { !_hdOforcedIrrefutables -> + (case (({-# LINE 230 "./src-ag/Desugar.ag" #-} + _lhsIaugmentsIn + {-# LINE 2545 "dist/build/Desugar.hs" #-} + )) of + { !_hdOaugmentsIn -> + (case (hd_ _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOmainName _hdOnt _hdOoptions _hdOsynMap) of + { ( !_hdIallAttributes,!_hdIaugmentsOut,!_hdIerrors,!_hdIoutput) -> + (case (({-# LINE 196 "./src-ag/Desugar.ag" #-} + _hdIallAttributes `mergeAttributes` _tlIallAttributes + {-# LINE 2552 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 231 "./src-ag/Desugar.ag" #-} + _hdIaugmentsOut `Map.union` _tlIaugmentsOut + {-# LINE 2557 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOaugmentsOut -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 2562 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 2567 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 2572 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (\ (!_lhsIaugmentsIn) + (!_lhsIforcedIrrefutables) + (!_lhsIinhMap) + (!_lhsImainName) + (!_lhsInt) + (!_lhsIoptions) + (!_lhsIsynMap) -> + (case (({-# LINE 196 "./src-ag/Desugar.ag" #-} + Map.empty + {-# LINE 2587 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 231 "./src-ag/Desugar.ag" #-} + Map.empty + {-# LINE 2592 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOaugmentsOut -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + Seq.empty + {-# LINE 2597 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + [] + {-# LINE 2602 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 2607 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOaugmentsOut,_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 : Rule + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + child pure : {Bool} + child identity : {Bool} + child mbError : {Maybe Error} + child eager : {Bool} + visit 1: + local ruleDescr : _ + local output : _ +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule !(Rule _mbName _pattern _rhs _owrt _origin _explicit _pure _identity _mbError _eager) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin _explicit _pure _identity _mbError _eager) +-- 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 -> + Inh_Rule -> + Syn_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 :: (Maybe Identifier) -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + Bool -> + Bool -> + (Maybe Error) -> + Bool -> + T_Rule +sem_Rule_Rule !mbName_ !(T_Pattern pattern_) !(T_Expression rhs_) !owrt_ !origin_ !explicit_ !pure_ !identity_ !mbError_ !eager_ = + (T_Rule (case (pattern_) of + { ( !_patternIdefsCollect,!T_Pattern_1 pattern_1) -> + (case (({-# LINE 179 "./src-ag/Desugar.ag" #-} + _patternIdefsCollect + {-# LINE 2685 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Rule_Rule_1 :: T_Rule_1 + sem_Rule_Rule_1 = + (T_Rule_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) + (!_lhsIoptions) -> + (case (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 2699 "dist/build/Desugar.hs" #-} + )) of + { !_patternOnt -> + (case (({-# LINE 153 "./src-ag/Desugar.ag" #-} + _lhsIcon + {-# LINE 2704 "dist/build/Desugar.hs" #-} + )) of + { !_patternOcon -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 2709 "dist/build/Desugar.hs" #-} + )) of + { !_patternOforcedIrrefutables -> + (case (({-# LINE 185 "./src-ag/Desugar.ag" #-} + _lhsIdefs + {-# LINE 2714 "dist/build/Desugar.hs" #-} + )) of + { !_patternOdefs -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 2719 "dist/build/Desugar.hs" #-} + )) of + { !_patternOchildSyns -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 2724 "dist/build/Desugar.hs" #-} + )) of + { !_patternOchildInhs -> + (case (pattern_1 _patternOchildInhs _patternOchildSyns _patternOcon _patternOdefs _patternOforcedIrrefutables _patternOnt) of + { ( !_patternIallAttributes,!_patternIcopy,!_patternIerrors,!_patternIoutput) -> + (case (({-# LINE 196 "./src-ag/Desugar.ag" #-} + _patternIallAttributes + {-# LINE 2731 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 172 "./src-ag/Desugar.ag" #-} + show _lhsInt ++ " :: " ++ show _lhsIcon ++ " :: " ++ (concat $ intersperse "," $ map (\(f,a) -> show f ++ "." ++ show a) $ Set.toList _patternIdefsCollect) + {-# LINE 2736 "dist/build/Desugar.hs" #-} + )) of + { !_ruleDescr -> + (case (({-# LINE 168 "./src-ag/Desugar.ag" #-} + _ruleDescr + {-# LINE 2741 "dist/build/Desugar.hs" #-} + )) of + { !_rhsOruleDescr -> + (case (({-# LINE 36 "./src-ag/Desugar.ag" #-} + _lhsIoptions + {-# LINE 2746 "dist/build/Desugar.hs" #-} + )) of + { !_rhsOoptions -> + (case (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 2751 "dist/build/Desugar.hs" #-} + )) of + { !_rhsOnt -> + (case (({-# LINE 153 "./src-ag/Desugar.ag" #-} + _lhsIcon + {-# LINE 2756 "dist/build/Desugar.hs" #-} + )) of + { !_rhsOcon -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 2761 "dist/build/Desugar.hs" #-} + )) of + { !_rhsOchildSyns -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 2766 "dist/build/Desugar.hs" #-} + )) of + { !_rhsOchildInhs -> + (case (rhs_ _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr) of + { ( !_rhsIerrors,!_rhsIoutput) -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + _patternIerrors Seq.>< _rhsIerrors + {-# LINE 2773 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + Rule mbName_ _patternIoutput _rhsIoutput owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ + {-# LINE 2778 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 2783 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_Rule_Rule_1)) of + { ( !sem_Rule_1) -> + ( _lhsOdefsCollect,sem_Rule_1) }) }) })) +-- 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 : Rules + 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 -> + Inh_Rules -> + Syn_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 (({-# LINE 179 "./src-ag/Desugar.ag" #-} + _hdIdefsCollect `Set.union` _tlIdefsCollect + {-# LINE 2852 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Rules_Cons_1 :: T_Rules_1 + sem_Rules_Cons_1 = + (T_Rules_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) + (!_lhsIoptions) -> + (case (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 2866 "dist/build/Desugar.hs" #-} + )) of + { !_tlOnt -> + (case (({-# LINE 153 "./src-ag/Desugar.ag" #-} + _lhsIcon + {-# LINE 2871 "dist/build/Desugar.hs" #-} + )) of + { !_tlOcon -> + (case (({-# LINE 152 "./src-ag/Desugar.ag" #-} + _lhsInt + {-# LINE 2876 "dist/build/Desugar.hs" #-} + )) of + { !_hdOnt -> + (case (({-# LINE 153 "./src-ag/Desugar.ag" #-} + _lhsIcon + {-# LINE 2881 "dist/build/Desugar.hs" #-} + )) of + { !_hdOcon -> + (case (({-# LINE 36 "./src-ag/Desugar.ag" #-} + _lhsIoptions + {-# LINE 2886 "dist/build/Desugar.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 2891 "dist/build/Desugar.hs" #-} + )) of + { !_tlOforcedIrrefutables -> + (case (({-# LINE 185 "./src-ag/Desugar.ag" #-} + _lhsIdefs + {-# LINE 2896 "dist/build/Desugar.hs" #-} + )) of + { !_tlOdefs -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 2901 "dist/build/Desugar.hs" #-} + )) of + { !_tlOchildSyns -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 2906 "dist/build/Desugar.hs" #-} + )) of + { !_tlOchildInhs -> + (case (tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt _tlOoptions) of + { ( !_tlIallAttributes,!_tlIerrors,!_tlIoutput) -> + (case (({-# LINE 36 "./src-ag/Desugar.ag" #-} + _lhsIoptions + {-# LINE 2913 "dist/build/Desugar.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 215 "./src-ag/Desugar.ag" #-} + _lhsIforcedIrrefutables + {-# LINE 2918 "dist/build/Desugar.hs" #-} + )) of + { !_hdOforcedIrrefutables -> + (case (({-# LINE 185 "./src-ag/Desugar.ag" #-} + _lhsIdefs + {-# LINE 2923 "dist/build/Desugar.hs" #-} + )) of + { !_hdOdefs -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildSyns + {-# LINE 2928 "dist/build/Desugar.hs" #-} + )) of + { !_hdOchildSyns -> + (case (({-# LINE 126 "./src-ag/Desugar.ag" #-} + _lhsIchildInhs + {-# LINE 2933 "dist/build/Desugar.hs" #-} + )) of + { !_hdOchildInhs -> + (case (hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt _hdOoptions) of + { ( !_hdIallAttributes,!_hdIerrors,!_hdIoutput) -> + (case (({-# LINE 196 "./src-ag/Desugar.ag" #-} + _hdIallAttributes `mergeAttributes` _tlIallAttributes + {-# LINE 2940 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 2945 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 2950 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 2955 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_Rules_Cons_1)) of + { ( !sem_Rules_1) -> + ( _lhsOdefsCollect,sem_Rules_1) }) }) }) })) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (case (({-# LINE 179 "./src-ag/Desugar.ag" #-} + Set.empty + {-# LINE 2966 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOdefsCollect -> + (case ((let sem_Rules_Nil_1 :: T_Rules_1 + sem_Rules_Nil_1 = + (T_Rules_1 (\ (!_lhsIchildInhs) + (!_lhsIchildSyns) + (!_lhsIcon) + (!_lhsIdefs) + (!_lhsIforcedIrrefutables) + (!_lhsInt) + (!_lhsIoptions) -> + (case (({-# LINE 196 "./src-ag/Desugar.ag" #-} + Map.empty + {-# LINE 2980 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOallAttributes -> + (case (({-# LINE 38 "./src-ag/Desugar.ag" #-} + Seq.empty + {-# LINE 2985 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOerrors -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + [] + {-# LINE 2990 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 2995 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOallAttributes,_lhsOerrors,_lhsOoutput) }) }) }) }))) + in sem_Rules_Nil_1)) of + { ( !sem_Rules_1) -> + ( _lhsOdefsCollect,sem_Rules_1) }) })) +-- TypeSig ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + output : TypeSig + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} + visit 0: + local output : _ +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig !(TypeSig _name _tp) = + (sem_TypeSig_TypeSig _name _tp) +-- semantic domain +newtype T_TypeSig = T_TypeSig (( TypeSig)) +data Inh_TypeSig = Inh_TypeSig {} +data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: !(TypeSig)} +wrap_TypeSig :: T_TypeSig -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig !(T_TypeSig sem) !(Inh_TypeSig) = + (let ( !_lhsOoutput) = sem + in (Syn_TypeSig _lhsOoutput)) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig !name_ !tp_ = + (T_TypeSig (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + TypeSig name_ tp_ + {-# LINE 3035 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 3040 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) })) +-- TypeSigs ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + output : TypeSigs + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_TypeSigs :: TypeSigs -> + T_TypeSigs +sem_TypeSigs !list = + (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list)) +-- semantic domain +newtype T_TypeSigs = T_TypeSigs (( TypeSigs)) +data Inh_TypeSigs = Inh_TypeSigs {} +data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: !(TypeSigs)} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs !(T_TypeSigs sem) !(Inh_TypeSigs) = + (let ( !_lhsOoutput) = sem + in (Syn_TypeSigs _lhsOoutput)) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons !(T_TypeSig hd_) !(T_TypeSigs tl_) = + (T_TypeSigs (case (tl_) of + { ( !_tlIoutput) -> + (case (hd_) of + { ( !_hdIoutput) -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 3084 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 3089 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }) }) })) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + [] + {-# LINE 3097 "dist/build/Desugar.hs" #-} + )) of + { !_output -> + (case (({-# LINE 40 "./src-ag/Desugar.ag" #-} + _output + {-# LINE 3102 "dist/build/Desugar.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) })) diff --git a/dist/build/ErrorMessages.hs b/dist/build/ErrorMessages.hs new file mode 100644 --- /dev/null +++ b/dist/build/ErrorMessages.hs @@ -0,0 +1,199 @@ + + +-- UUAGC 0.9.42.0 (src-ag/ErrorMessages.ag) +module ErrorMessages where +{-# LINE 2 "./src-ag/ErrorMessages.ag" #-} + +import UU.Scanner.Position(Pos) +import Pretty +import CodeSyntax +import CommonTypes +{-# LINE 12 "dist/build/ErrorMessages.hs" #-} +-- Error ------------------------------------------------------- +{- + alternatives: + alternative ParserError: + child pos : {Pos} + child problem : {String} + child action : {String} + alternative HsParseError: + child pos : {Pos} + child msg : {String} + alternative DupAlt: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child occ1 : {ConstructorIdent} + alternative DupSynonym: + child nt : {NontermIdent} + child occ1 : {NontermIdent} + alternative DupSet: + child name : {NontermIdent} + child occ1 : {NontermIdent} + alternative DupInhAttr: + child nt : {NontermIdent} + child attr : {Identifier} + child occ1 : {Identifier} + alternative DupSynAttr: + child nt : {NontermIdent} + child attr : {Identifier} + child occ1 : {Identifier} + alternative DupChild: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child name : {Identifier} + child occ1 : {Identifier} + alternative DupRule: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + child occ1 : {Identifier} + alternative DupRuleName: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child nm : {Identifier} + alternative DupSig: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + alternative UndefNont: + child nt : {NontermIdent} + alternative UndefAlt: + child nt : {NontermIdent} + child con : {ConstructorIdent} + alternative UndefChild: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child name : {Identifier} + alternative MissingRule: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + alternative MissingNamedRule: + child nt : {NontermIdent} + child con : {Identifier} + child name : {Identifier} + alternative SuperfluousRule: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + alternative UndefLocal: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child var : {Identifier} + alternative ChildAsLocal: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child var : {Identifier} + alternative UndefAttr: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + child isOut : {Bool} + alternative Cyclic: + child nt : {NontermIdent} + child mbCon : {Maybe ConstructorIdent} + child verts : {[String]} + alternative CyclicSet: + child name : {Identifier} + alternative CustomError: + child isWarning : {Bool} + child pos : {Pos} + child mesg : {PP_Doc} + alternative LocalCirc: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + child o_visit : {Bool} + child path : {[String]} + alternative InstCirc: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + child o_visit : {Bool} + child path : {[String]} + alternative DirectCirc: + child nt : {NontermIdent} + child o_visit : {Bool} + child cyclic : {[((Identifier,Identifier),[String],[String])]} + alternative InducedCirc: + child nt : {NontermIdent} + child cinter : {CInterface} + child cyclic : {[((Identifier,Identifier),[String],[String])]} + alternative MissingTypeSig: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + alternative MissingInstSig: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + alternative DupUnique: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + alternative MissingUnique: + child nt : {NontermIdent} + child attr : {Identifier} + alternative MissingSyn: + child nt : {NontermIdent} + child attr : {Identifier} + alternative IncompatibleVisitKind: + child child : {Identifier} + child vis : {VisitIdentifier} + child from : {VisitKind} + child to : {VisitKind} + alternative IncompatibleRuleKind: + child rule : {Identifier} + child kind : {VisitKind} + alternative IncompatibleAttachKind: + child child : {Identifier} + child kind : {VisitKind} +-} +data Error = ParserError (Pos) (String) (String) + | HsParseError (Pos) (String) + | DupAlt (NontermIdent) (ConstructorIdent) (ConstructorIdent) + | DupSynonym (NontermIdent) (NontermIdent) + | DupSet (NontermIdent) (NontermIdent) + | DupInhAttr (NontermIdent) (Identifier) (Identifier) + | DupSynAttr (NontermIdent) (Identifier) (Identifier) + | DupChild (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) + | DupRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) (Identifier) + | DupRuleName (NontermIdent) (ConstructorIdent) (Identifier) + | DupSig (NontermIdent) (ConstructorIdent) (Identifier) + | UndefNont (NontermIdent) + | UndefAlt (NontermIdent) (ConstructorIdent) + | UndefChild (NontermIdent) (ConstructorIdent) (Identifier) + | MissingRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) + | MissingNamedRule (NontermIdent) (Identifier) (Identifier) + | SuperfluousRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) + | UndefLocal (NontermIdent) (ConstructorIdent) (Identifier) + | ChildAsLocal (NontermIdent) (ConstructorIdent) (Identifier) + | UndefAttr (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) (Bool) + | Cyclic (NontermIdent) ((Maybe ConstructorIdent)) (([String])) + | CyclicSet (Identifier) + | CustomError (Bool) (Pos) (PP_Doc) + | LocalCirc (NontermIdent) (ConstructorIdent) (Identifier) (Bool) (([String])) + | InstCirc (NontermIdent) (ConstructorIdent) (Identifier) (Bool) (([String])) + | DirectCirc (NontermIdent) (Bool) (([((Identifier,Identifier),[String],[String])])) + | InducedCirc (NontermIdent) (CInterface) (([((Identifier,Identifier),[String],[String])])) + | MissingTypeSig (NontermIdent) (ConstructorIdent) (Identifier) + | MissingInstSig (NontermIdent) (ConstructorIdent) (Identifier) + | DupUnique (NontermIdent) (ConstructorIdent) (Identifier) + | MissingUnique (NontermIdent) (Identifier) + | MissingSyn (NontermIdent) (Identifier) + | IncompatibleVisitKind (Identifier) (VisitIdentifier) (VisitKind) (VisitKind) + | IncompatibleRuleKind (Identifier) (VisitKind) + | IncompatibleAttachKind (Identifier) (VisitKind) +-- Errors ------------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : Error + child tl : Errors + alternative Nil: +-} +type Errors = [Error] diff --git a/dist/build/ExecutionPlan.hs b/dist/build/ExecutionPlan.hs new file mode 100644 --- /dev/null +++ b/dist/build/ExecutionPlan.hs @@ -0,0 +1,174 @@ + + +-- UUAGC 0.9.42.0 (src-ag/ExecutionPlan.ag) +module ExecutionPlan where +{-# LINE 2 "./src-ag/ExecutionPlan.ag" #-} + +-- VisitSyntax.ag imports +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes +import ErrorMessages + +import qualified Data.Set as Set +import Data.Set(Set) +import qualified Data.Map as Map +import Data.Map(Map) +{-# LINE 18 "dist/build/ExecutionPlan.hs" #-} +-- EChild ------------------------------------------------------ +{- + alternatives: + alternative EChild: + child name : {Identifier} + child tp : {Type} + child kind : {ChildKind} + child hasAround : {Bool} + child merges : {Maybe [Identifier]} + child isMerged : {Bool} + alternative ETerm: + child name : {Identifier} + child tp : {Type} +-} +data EChild = EChild (Identifier) (Type) (ChildKind) (Bool) ((Maybe [Identifier])) (Bool) + | ETerm (Identifier) (Type) +-- EChildren --------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : EChild + child tl : EChildren + alternative Nil: +-} +type EChildren = [EChild] +-- ENonterminal ------------------------------------------------ +{- + alternatives: + alternative ENonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child classCtxs : {ClassContext} + child initial : {StateIdentifier} + child initialv : {Maybe VisitIdentifier} + child nextVisits : {Map StateIdentifier StateCtx} + child prevVisits : {Map StateIdentifier StateCtx} + child prods : EProductions + child recursive : {Bool} + child hoInfo : {HigherOrderInfo} +-} +data ENonterminal = ENonterminal (NontermIdent) (([Identifier])) (ClassContext) (StateIdentifier) ((Maybe VisitIdentifier)) ((Map StateIdentifier StateCtx)) ((Map StateIdentifier StateCtx)) (EProductions) (Bool) (HigherOrderInfo) +-- ENonterminals ----------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : ENonterminal + child tl : ENonterminals + alternative Nil: +-} +type ENonterminals = [ENonterminal] +-- EProduction ------------------------------------------------- +{- + alternatives: + alternative EProduction: + child con : {ConstructorIdent} + child params : {[Identifier]} + child constraints : {[Type]} + child rules : ERules + child children : EChildren + child visits : Visits +-} +data EProduction = EProduction (ConstructorIdent) (([Identifier])) (([Type])) (ERules) (EChildren) (Visits) +-- EProductions ------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : EProduction + child tl : EProductions + alternative Nil: +-} +type EProductions = [EProduction] +-- ERule ------------------------------------------------------- +{- + alternatives: + alternative ERule: + child name : {Identifier} + child pattern : {Pattern} + child rhs : {Expression} + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + child pure : {Bool} + child mbError : {Maybe Error} +-} +data ERule = ERule (Identifier) (Pattern) (Expression) (Bool) (String) (Bool) (Bool) ((Maybe Error)) +-- ERules ------------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : ERule + child tl : ERules + alternative Nil: +-} +type ERules = [ERule] +-- ExecutionPlan ----------------------------------------------- +{- + alternatives: + alternative ExecutionPlan: + child nonts : ENonterminals + child typeSyns : {TypeSyns} + child wrappers : {Set NontermIdent} + child derivings : {Derivings} +-} +data ExecutionPlan = ExecutionPlan (ENonterminals) (TypeSyns) ((Set NontermIdent)) (Derivings) +-- Visit ------------------------------------------------------- +{- + alternatives: + alternative Visit: + child ident : {VisitIdentifier} + child from : {StateIdentifier} + child to : {StateIdentifier} + child inh : {Set Identifier} + child syn : {Set Identifier} + child steps : VisitSteps + child kind : {VisitKind} +-} +data Visit = Visit (VisitIdentifier) (StateIdentifier) (StateIdentifier) ((Set Identifier)) ((Set Identifier)) (VisitSteps) (VisitKind) +-- VisitStep --------------------------------------------------- +{- + alternatives: + alternative Sem: + child name : {Identifier} + alternative ChildVisit: + child child : {Identifier} + child nonterm : {NontermIdent} + child visit : {VisitIdentifier} + alternative PureGroup: + child steps : VisitSteps + child ordered : {Bool} + alternative Sim: + child steps : VisitSteps + alternative ChildIntro: + child child : {Identifier} +-} +data VisitStep = Sem (Identifier) + | ChildVisit (Identifier) (NontermIdent) (VisitIdentifier) + | PureGroup (VisitSteps) (Bool) + | Sim (VisitSteps) + | ChildIntro (Identifier) +-- VisitSteps -------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : VisitStep + child tl : VisitSteps + alternative Nil: +-} +type VisitSteps = [VisitStep] +-- Visits ------------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : Visit + child tl : Visits + alternative Nil: +-} +type Visits = [Visit] diff --git a/dist/build/ExecutionPlan2Caml.hs b/dist/build/ExecutionPlan2Caml.hs new file mode 100644 --- /dev/null +++ b/dist/build/ExecutionPlan2Caml.hs @@ -0,0 +1,8514 @@ + + +-- UUAGC 0.9.42.0 (src-ag/ExecutionPlan2Caml.ag) +module ExecutionPlan2Caml where +{-# LINE 32 "./src-ag/ExecutionPlan2Caml.ag" #-} + +import ExecutionPlan +import Pretty +import PPUtil +import Options +import Data.Monoid(mappend,mempty) +import Data.Maybe +import Data.Graph +import Debug.Trace +import System.IO +import System.Directory +import System.FilePath +import UU.Scanner.Position + +import TokenDef +import HsToken +import ErrorMessages + +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Sequence(Seq) +import qualified Data.Sequence as Seq +import Data.Foldable(toList) +{-# LINE 32 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 2 "./src-ag/ExecutionPlan.ag" #-} + +-- VisitSyntax.ag imports +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes +import ErrorMessages + +import qualified Data.Set as Set +import Data.Set(Set) +import qualified Data.Map as Map +import Data.Map(Map) +{-# LINE 46 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 53 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 2 "./src-ag/Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 59 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 2 "./src-ag/HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 65 "dist/build/ExecutionPlan2Caml.hs" #-} +{-# LINE 173 "./src-ag/ExecutionPlan2Caml.ag" #-} + +ppRecordTp :: PP a => [a] -> PP_Doc +ppRecordTp es + | null es = text "unit" + | otherwise = pp_block "{" "}" "; " (map pp es) + +ppRecordVal :: PP a => [a] -> PP_Doc +ppRecordVal es + | null es = text "()" + | otherwise = pp_block "{" "}" "; " (map pp es) + +ppFieldsVal :: Bool -> [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)] -> PP_Doc +ppFieldsVal record fields + | null fields = text "()" + | record = ppRecordVal [ r >#< "=" >#< x | (r,x,_,_) <- fields ] + | otherwise = pp_block "(" ")" "," [ x | (_,x,_,_) <- fields ] + +ppFieldsType :: Bool -> Bool -> [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)] -> PP_Doc +ppFieldsType record defor fields + | null fields = text "unit" + | record = ppRecordTp [ r >#< ":" >#< (if defor then d else f) | (r,_,d,f) <- fields ] + | otherwise = pp_block "(" ")" "*" [ if defor then d else f | (_,_,d,f) <- fields ] +{-# LINE 89 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 285 "./src-ag/ExecutionPlan2Caml.ag" #-} + +ppTp :: Type -> PP_Doc +ppTp tp = case tp of + Haskell t -> pp t -- ocaml type + NT nt tps deforested + | nt == _SELF -> pp "?SELF?" + | null tps -> ppNontTp nt deforested + | otherwise -> pp_parens (ppSpaced (map pp_parens tps) >#< ppNontTp nt deforested) + Self -> pp "?SELF?" + +ppNontTp :: NontermIdent -> Bool -> PP_Doc +ppNontTp nt True = pp "t_" >|< pp nt +ppNontTp nt False = pp nt + +-- multiple type parameters go into a tuple +ppTypeParams :: PP a => [a] -> PP_Doc +ppTypeParams [] = empty +ppTypeParams [x] = pp x +ppTypeParams xs = pp_block "(" ")" "," (map pp xs) +{-# LINE 111 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 357 "./src-ag/ExecutionPlan2Caml.ag" #-} + +-- convention for nonterminals to module names +modName :: NontermIdent -> PP_Doc +modName nt = pp "M_" >|< pp nt + +ppFunDecl :: Bool -> PP_Doc -> [(PP_Doc,PP_Doc)] -> PP_Doc -> PP_Doc -> PP_Doc +ppFunDecl gensigs nm args resSig expr = body where + body = nm >#< ppSpaced (map arg args) >#< ppRes >#< "=" + >-< indent 2 expr + arg (arg,tp) = ppArg gensigs arg tp + ppRes + | gensigs = ":" >#< resSig + | otherwise = empty + +ppArg :: Bool -> PP_Doc -> PP_Doc -> PP_Doc +ppArg gensigs arg tp + | gensigs = pp_parens (arg >#< ":" >#< tp) + | otherwise = arg + +{-# LINE 133 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 424 "./src-ag/ExecutionPlan2Caml.ag" #-} +type VisitStateState = (VisitIdentifier,StateIdentifier, StateIdentifier) +{-# LINE 137 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 460 "./src-ag/ExecutionPlan2Caml.ag" #-} + +-- +-- conventions +-- + +-- type of the state of a node: a closure containing the children states and attributes, +-- with code of type 'type_nt_sem' that represents the subsequent visits to successor states. +type_nt_state nt st = "s_" >|< nt >|< "_" >|< st + +-- type of a visit to a node (the initial, and when in a given state) +-- an instance of this type is called the "semantics" +type_nt_sem_top nt = "t_" >|< nt +type_nt_sem nt st = type_nt_sem_top nt >|< "_s" >|< st + +-- type of a caller (contains visit selection + inputs + continuation) +type_caller nt st = "c_" >|< nt >|< "_s" >|< st + +-- names of records +nm_attach nt = "attach_">|< nt +nm_invoke nt st = "inv_" >|< nt >|< "_s" >|< st + +-- name of the type variable representing the result type of the continuation +cont_tvar = text "'cont__" + + +-- order states in reverse topological order so that successor states are +-- earlier in the resulting list. +orderStates :: StateIdentifier -> [VisitStateState] -> [StateIdentifier] +orderStates initial edges = res where + source = Map.singleton initial Set.empty -- ensures that the initial state is in graph even when there are no edges + targets = [ Map.singleton t Set.empty | (_,_,t) <- edges ] + deps = [ Map.singleton f (Set.singleton t) | (_,f,t) <- edges ] + + mp = Map.unionsWith Set.union (source : (targets ++ deps)) + es = [ (f,f,Set.toList ts) | (f,ts) <- Map.toList mp ] + cps = stronglyConnComp es + res = flattenSCCs cps +{-# LINE 177 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 517 "./src-ag/ExecutionPlan2Caml.ag" #-} + +type_caller_visit nt v = "c_" >|< nt >|< "_v" >|< v +con_visit nt v = "C_" >|< nt >|< "_v" >|< v + +-- field names +nm_inh nt v = "inh_" >|< nt >|< "_v" >|< v +nm_cont nt v = "cont_" >|< nt >|< "_v" >|< v +{-# LINE 187 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 563 "./src-ag/ExecutionPlan2Caml.ag" #-} + +-- more naming conventions +nm_inarg nm nt v = "i_" >|< nm >|< "_" >|< nt >|< "_v" >|< v +nm_outarg nm nt v = "o_" >|< nm >|< "_" >|< nt >|< "_v" >|< v +nm_outarg_cont = nm_outarg "_cont" + +conNmTVisit nt vId = "t_" >|< nt >|< "_v" >|< vId +conNmTVisitIn nt vId = "t_" >|< nt >|< "_vIn" >|< vId +conNmTVisitOut nt vId = "t_" >|< nt >|< "_vOut" >|< vId + +-- todo: remove ppMonadType +ppMonadType :: Options -> PP_Doc +ppMonadType opts + | parallelInvoke opts = text "IO" + | otherwise = text "Identity" +{-# LINE 205 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 776 "./src-ag/ExecutionPlan2Caml.ag" #-} + +nm_visit v = "__v" >|< v +nm_k st = "__k" >|< st +nm_st st = "__st" >|< st + +mklets :: (PP b, PP c) => [b] -> c -> PP_Doc +mklets defs body = res where + ppLet def = "let" >#< def >#< "in" + res = vlist (map ppLet defs) >-< body +{-# LINE 217 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 818 "./src-ag/ExecutionPlan2Caml.ag" #-} + +resultValName :: String +resultValName = "__result_" + +nextStName :: String +nextStName = "__st_" +{-# LINE 226 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 959 "./src-ag/ExecutionPlan2Caml.ag" #-} + +stname :: Identifier -> Int -> String +stname child st = "_" ++ getName child ++ "X" ++ show st + +-- should actually return some conversion info +compatibleAttach :: VisitKind -> NontermIdent -> Options -> Bool +compatibleAttach _ _ _ = True +{-# LINE 236 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 1026 "./src-ag/ExecutionPlan2Caml.ag" #-} + +dummyPat :: Options -> Bool -> PP_Doc +dummyPat opts noArgs + | not noArgs = empty + | strictDummyToken opts = text "()" + | otherwise = text "(_ : unit)" + +dummyArg :: Options -> Bool -> PP_Doc +dummyArg opts noArgs + | not noArgs = empty + | otherwise = text "()" + +dummyType :: Options -> Bool -> PP_Doc +dummyType opts noArgs + | not noArgs = empty + | otherwise = text "unit" +{-# LINE 255 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 1102 "./src-ag/ExecutionPlan2Caml.ag" #-} + +data NonLocalAttr + = AttrInh Identifier Identifier + | AttrSyn Identifier Identifier deriving Show + +mkNonLocalAttr :: Bool -> Identifier -> Identifier -> NonLocalAttr +mkNonLocalAttr True = AttrInh -- True: inherited attr +mkNonLocalAttr False = AttrSyn + +lookupAttrType :: NonLocalAttr -> Map Identifier Attributes -> Map Identifier Attributes -> Map Identifier Type -> Maybe PP_Doc +lookupAttrType (AttrInh child name) inhs _ = lookupType child name inhs +lookupAttrType (AttrSyn child name) _ syns = lookupType child name syns + +-- Note: if the child takes type parameters, the type of an attribute of this child may refer to these parameters. This means that +-- the actual type of the attribute needs to have its type parameters substituted with the actual type argument of the child. +-- However, for now we simply decide to return Nothing in this case, which skips the type annotation. +lookupType :: Identifier -> Identifier -> Map Identifier Attributes -> Map Identifier Type -> Maybe PP_Doc +lookupType child name attrMp childMp + | noParameters childTp = Just ppDoc + | otherwise = Nothing + where + attrTp = Map.findWithDefault (error "lookupType: the attribute is not in the attrs of the child") name childAttrs + childAttrs = Map.findWithDefault (error "lookupType: the attributes of the nonterm are not in the map") nonterm attrMp + nonterm = extractNonterminal childTp + childTp = Map.findWithDefault (error ("lookupType: the child " ++ show child ++ "is not in the appropriate map")) child childMp + ppDoc = ppTp attrTp + +noParameters :: Type -> Bool +noParameters (Haskell _) = True +noParameters (NT _ args _) = null args +{-# LINE 288 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 1199 "./src-ag/ExecutionPlan2Caml.ag" #-} + +contNm = text "__cont_" +inpsNm = text "__inps_" + +-- a `compatibleKind` b means: can kind b be invoked from a +compatibleKind :: VisitKind -> VisitKind -> Bool +compatibleKind _ _ = True + +compatibleRule :: VisitKind -> Bool -> Bool +compatibleRule (VisitPure _) False = False +compatibleRule _ _ = True +{-# LINE 302 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 1224 "./src-ag/ExecutionPlan2Caml.ag" #-} + +unionWithSum = Map.unionWith (+) +{-# LINE 307 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 1247 "./src-ag/ExecutionPlan2Caml.ag" #-} + +uwSetUnion :: (Ord a, Ord b) => Map a (Set b) -> Map a (Set b) -> Map a (Set b) +uwSetUnion = Map.unionWith Set.union + +uwMapUnion :: (Ord a, Ord b) => Map a (Map b c) -> Map a (Map b c) -> Map a (Map b c) +uwMapUnion = Map.unionWith Map.union +{-# LINE 316 "dist/build/ExecutionPlan2Caml.hs" #-} +-- EChild ------------------------------------------------------ +{- + visit 0: + inherited attributes: + allInitStates : Map NontermIdent Int + con : ConstructorIdent + mainFile : String + mainName : String + nt : NontermIdent + options : Options + synthesized attributes: + argnamesw : PP_Doc + childTypes : Map Identifier Type + childintros : Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) + sigs : [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)] + terminaldefs : Set String + alternatives: + alternative EChild: + child name : {Identifier} + child tp : {Type} + child kind : {ChildKind} + child hasAround : {Bool} + child merges : {Maybe [Identifier]} + child isMerged : {Bool} + visit 0: + local tpDocFor : _ + local tpDocDefor : _ + local fieldNm : _ + local childNm : _ + local field : _ + local isDefor : _ + local valcode : _ + local aroundcode : _ + local introcode : _ + local nt : _ + local initSt : _ + alternative ETerm: + child name : {Identifier} + child tp : {Type} + visit 0: + local tpDocFor : _ + local tpDocDefor : _ + local fieldNm : _ + local childNm : _ + local field : _ +-} +-- cata +sem_EChild :: EChild -> + T_EChild +sem_EChild (EChild _name _tp _kind _hasAround _merges _isMerged) = + (sem_EChild_EChild _name _tp _kind _hasAround _merges _isMerged) +sem_EChild (ETerm _name _tp) = + (sem_EChild_ETerm _name _tp) +-- semantic domain +newtype T_EChild = T_EChild ((Map NontermIdent Int) -> + ConstructorIdent -> + String -> + String -> + NontermIdent -> + Options -> + ( ( PP_Doc ),(Map Identifier Type),(Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),([(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]),(Set String))) +data Inh_EChild = Inh_EChild {allInitStates_Inh_EChild :: (Map NontermIdent Int),con_Inh_EChild :: ConstructorIdent,mainFile_Inh_EChild :: String,mainName_Inh_EChild :: String,nt_Inh_EChild :: NontermIdent,options_Inh_EChild :: Options} +data Syn_EChild = Syn_EChild {argnamesw_Syn_EChild :: ( PP_Doc ),childTypes_Syn_EChild :: (Map Identifier Type),childintros_Syn_EChild :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),sigs_Syn_EChild :: ([(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]),terminaldefs_Syn_EChild :: (Set String)} +wrap_EChild :: T_EChild -> + Inh_EChild -> + Syn_EChild +wrap_EChild (T_EChild sem) (Inh_EChild _lhsIallInitStates _lhsIcon _lhsImainFile _lhsImainName _lhsInt _lhsIoptions) = + (let ( _lhsOargnamesw,_lhsOchildTypes,_lhsOchildintros,_lhsOsigs,_lhsOterminaldefs) = sem _lhsIallInitStates _lhsIcon _lhsImainFile _lhsImainName _lhsInt _lhsIoptions + in (Syn_EChild _lhsOargnamesw _lhsOchildTypes _lhsOchildintros _lhsOsigs _lhsOterminaldefs)) +sem_EChild_EChild :: Identifier -> + Type -> + ChildKind -> + Bool -> + (Maybe [Identifier]) -> + Bool -> + T_EChild +sem_EChild_EChild name_ tp_ kind_ hasAround_ merges_ isMerged_ = + (T_EChild (\ _lhsIallInitStates + _lhsIcon + _lhsImainFile + _lhsImainName + _lhsInt + _lhsIoptions -> + (let _lhsOsigs :: ([(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) + _lhsOargnamesw :: ( PP_Doc ) + _lhsOchildintros :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _lhsOchildTypes :: (Map Identifier Type) + _lhsOterminaldefs :: (Set String) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 275, column 7) + _tpDocFor = + ({-# LINE 275 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppTp $ removeDeforested tp_ + {-# LINE 409 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 276, column 7) + _tpDocDefor = + ({-# LINE 276 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppTp $ forceDeforested tp_ + {-# LINE 415 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 277, column 7) + _fieldNm = + ({-# LINE 277 "./src-ag/ExecutionPlan2Caml.ag" #-} + text $ recordFieldname _lhsInt _lhsIcon name_ + {-# LINE 421 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 278, column 7) + _childNm = + ({-# LINE 278 "./src-ag/ExecutionPlan2Caml.ag" #-} + text (fieldname name_) + {-# LINE 427 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 279, column 7) + _field = + ({-# LINE 279 "./src-ag/ExecutionPlan2Caml.ag" #-} + (_fieldNm , _childNm , _tpDocDefor , _tpDocFor ) + {-# LINE 433 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 280, column 13) + _lhsOsigs = + ({-# LINE 280 "./src-ag/ExecutionPlan2Caml.ag" #-} + case kind_ of + ChildAttr -> [] + _ -> [_field ] + {-# LINE 441 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 392, column 12) + _lhsOargnamesw = + ({-# LINE 392 "./src-ag/ExecutionPlan2Caml.ag" #-} + case kind_ of + ChildSyntax -> "(" >#< prefix _lhsIoptions >|< _nt >#< name_ >|< "_" >#< ")" + ChildAttr -> empty + ChildReplace tp -> "(" >#< prefix _lhsIoptions >|< extractNonterminal tp >#< name_ >|< "_" >#< ")" + {-# LINE 450 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 919, column 12) + _lhsOchildintros = + ({-# LINE 919 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton name_ _introcode + {-# LINE 456 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 920, column 12) + _isDefor = + ({-# LINE 920 "./src-ag/ExecutionPlan2Caml.ag" #-} + case tp_ of + NT _ _ defor -> defor + _ -> False + {-# LINE 464 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 923, column 12) + _valcode = + ({-# LINE 923 "./src-ag/ExecutionPlan2Caml.ag" #-} + case kind_ of + ChildSyntax -> name_ >|< "_" + ChildAttr -> + let head | not _isDefor = if lateHigherOrderBinding _lhsIoptions + then lateSemNtLabel _nt >#< lhsname True idLateBindingAttr + else prefix _lhsIoptions >|< _nt + | otherwise = empty + in pp_parens (head >#< instname name_) + ChildReplace _ -> + pp_parens (instname name_ >#< name_ >|< "_") + {-# LINE 479 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 934, column 12) + _aroundcode = + ({-# LINE 934 "./src-ag/ExecutionPlan2Caml.ag" #-} + if hasAround_ + then locname name_ >|< "_around" + else empty + {-# LINE 487 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 937, column 12) + _introcode = + ({-# LINE 937 "./src-ag/ExecutionPlan2Caml.ag" #-} + \kind -> let pat = text $ stname name_ _initSt + attach = pp_parens (_aroundcode >#< _valcode ) >|< "." >|< nm_attach _nt >#< "()" + decl = pat >#< "=" >#< attach + in if compatibleAttach kind _nt _lhsIoptions + then Right ( "let" >#< decl >#< "in" + , Set.singleton (stname name_ _initSt ) + , case kind_ of + ChildAttr -> Map.insert (instname name_) Nothing $ + ( if _isDefor || not (lateHigherOrderBinding _lhsIoptions) + then id + else Map.insert (lhsname True idLateBindingAttr) (Just $ AttrInh _LHS idLateBindingAttr) + ) $ + ( if hasAround_ + then Map.insert (locname (name_) ++ "_around") Nothing + else id + ) $ Map.empty + ChildReplace _ -> Map.singleton (instname name_) Nothing + ChildSyntax -> Map.empty + ) + else Left $ IncompatibleAttachKind name_ kind + {-# LINE 512 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 957, column 12) + _nt = + ({-# LINE 957 "./src-ag/ExecutionPlan2Caml.ag" #-} + extractNonterminal tp_ + {-# LINE 518 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1419, column 3) + _lhsOchildTypes = + ({-# LINE 1419 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton name_ tp_ + {-# LINE 524 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1463, column 3) + _initSt = + ({-# LINE 1463 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.findWithDefault (error "nonterminal not in allInitStates map") _nt _lhsIallInitStates + {-# LINE 530 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1258, column 42) + _lhsOterminaldefs = + ({-# LINE 1258 "./src-ag/ExecutionPlan2Caml.ag" #-} + Set.empty + {-# LINE 536 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOargnamesw,_lhsOchildTypes,_lhsOchildintros,_lhsOsigs,_lhsOterminaldefs)))) +sem_EChild_ETerm :: Identifier -> + Type -> + T_EChild +sem_EChild_ETerm name_ tp_ = + (T_EChild (\ _lhsIallInitStates + _lhsIcon + _lhsImainFile + _lhsImainName + _lhsInt + _lhsIoptions -> + (let _lhsOsigs :: ([(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) + _lhsOargnamesw :: ( PP_Doc ) + _lhsOchildintros :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _lhsOterminaldefs :: (Set String) + _lhsOchildTypes :: (Map Identifier Type) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 275, column 7) + _tpDocFor = + ({-# LINE 275 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppTp $ removeDeforested tp_ + {-# LINE 558 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 276, column 7) + _tpDocDefor = + ({-# LINE 276 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppTp $ forceDeforested tp_ + {-# LINE 564 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 277, column 7) + _fieldNm = + ({-# LINE 277 "./src-ag/ExecutionPlan2Caml.ag" #-} + text $ recordFieldname _lhsInt _lhsIcon name_ + {-# LINE 570 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 278, column 7) + _childNm = + ({-# LINE 278 "./src-ag/ExecutionPlan2Caml.ag" #-} + text (fieldname name_) + {-# LINE 576 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 279, column 7) + _field = + ({-# LINE 279 "./src-ag/ExecutionPlan2Caml.ag" #-} + (_fieldNm , _childNm , _tpDocDefor , _tpDocFor ) + {-# LINE 582 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 283, column 13) + _lhsOsigs = + ({-# LINE 283 "./src-ag/ExecutionPlan2Caml.ag" #-} + [_field ] + {-# LINE 588 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 396, column 12) + _lhsOargnamesw = + ({-# LINE 396 "./src-ag/ExecutionPlan2Caml.ag" #-} + text $ fieldname name_ + {-# LINE 594 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 918, column 12) + _lhsOchildintros = + ({-# LINE 918 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton name_ (\_ -> Right (empty, Set.empty, Map.empty)) + {-# LINE 600 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1261, column 3) + _lhsOterminaldefs = + ({-# LINE 1261 "./src-ag/ExecutionPlan2Caml.ag" #-} + Set.singleton $ fieldname name_ + {-# LINE 606 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1419, column 3) + _lhsOchildTypes = + ({-# LINE 1419 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton name_ tp_ + {-# LINE 612 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOargnamesw,_lhsOchildTypes,_lhsOchildintros,_lhsOsigs,_lhsOterminaldefs)))) +-- EChildren --------------------------------------------------- +{- + visit 0: + inherited attributes: + allInitStates : Map NontermIdent Int + con : ConstructorIdent + mainFile : String + mainName : String + nt : NontermIdent + options : Options + synthesized attributes: + argnamesw : [PP_Doc] + childTypes : Map Identifier Type + childintros : Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) + sigs : [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)] + terminaldefs : Set String + alternatives: + alternative Cons: + child hd : EChild + child tl : EChildren + alternative Nil: +-} +-- cata +sem_EChildren :: EChildren -> + T_EChildren +sem_EChildren list = + (Prelude.foldr sem_EChildren_Cons sem_EChildren_Nil (Prelude.map sem_EChild list)) +-- semantic domain +newtype T_EChildren = T_EChildren ((Map NontermIdent Int) -> + ConstructorIdent -> + String -> + String -> + NontermIdent -> + Options -> + ( ([PP_Doc]),(Map Identifier Type),(Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),([(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]),(Set String))) +data Inh_EChildren = Inh_EChildren {allInitStates_Inh_EChildren :: (Map NontermIdent Int),con_Inh_EChildren :: ConstructorIdent,mainFile_Inh_EChildren :: String,mainName_Inh_EChildren :: String,nt_Inh_EChildren :: NontermIdent,options_Inh_EChildren :: Options} +data Syn_EChildren = Syn_EChildren {argnamesw_Syn_EChildren :: ([PP_Doc]),childTypes_Syn_EChildren :: (Map Identifier Type),childintros_Syn_EChildren :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),sigs_Syn_EChildren :: ([(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]),terminaldefs_Syn_EChildren :: (Set String)} +wrap_EChildren :: T_EChildren -> + Inh_EChildren -> + Syn_EChildren +wrap_EChildren (T_EChildren sem) (Inh_EChildren _lhsIallInitStates _lhsIcon _lhsImainFile _lhsImainName _lhsInt _lhsIoptions) = + (let ( _lhsOargnamesw,_lhsOchildTypes,_lhsOchildintros,_lhsOsigs,_lhsOterminaldefs) = sem _lhsIallInitStates _lhsIcon _lhsImainFile _lhsImainName _lhsInt _lhsIoptions + in (Syn_EChildren _lhsOargnamesw _lhsOchildTypes _lhsOchildintros _lhsOsigs _lhsOterminaldefs)) +sem_EChildren_Cons :: T_EChild -> + T_EChildren -> + T_EChildren +sem_EChildren_Cons (T_EChild hd_) (T_EChildren tl_) = + (T_EChildren (\ _lhsIallInitStates + _lhsIcon + _lhsImainFile + _lhsImainName + _lhsInt + _lhsIoptions -> + (let _lhsOargnamesw :: ([PP_Doc]) + _lhsOchildTypes :: (Map Identifier Type) + _lhsOchildintros :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _lhsOsigs :: ([(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) + _lhsOterminaldefs :: (Set String) + _hdOallInitStates :: (Map NontermIdent Int) + _hdOcon :: ConstructorIdent + _hdOmainFile :: String + _hdOmainName :: String + _hdOnt :: NontermIdent + _hdOoptions :: Options + _tlOallInitStates :: (Map NontermIdent Int) + _tlOcon :: ConstructorIdent + _tlOmainFile :: String + _tlOmainName :: String + _tlOnt :: NontermIdent + _tlOoptions :: Options + _hdIargnamesw :: ( PP_Doc ) + _hdIchildTypes :: (Map Identifier Type) + _hdIchildintros :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _hdIsigs :: ([(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) + _hdIterminaldefs :: (Set String) + _tlIargnamesw :: ([PP_Doc]) + _tlIchildTypes :: (Map Identifier Type) + _tlIchildintros :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _tlIsigs :: ([(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) + _tlIterminaldefs :: (Set String) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 389, column 32) + _lhsOargnamesw = + ({-# LINE 389 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIargnamesw : _tlIargnamesw + {-# LINE 699 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1412, column 40) + _lhsOchildTypes = + ({-# LINE 1412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIchildTypes `mappend` _tlIchildTypes + {-# LINE 705 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 909, column 21) + _lhsOchildintros = + ({-# LINE 909 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIchildintros `Map.union` _tlIchildintros + {-# LINE 711 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 271, column 34) + _lhsOsigs = + ({-# LINE 271 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIsigs ++ _tlIsigs + {-# LINE 717 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1258, column 42) + _lhsOterminaldefs = + ({-# LINE 1258 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIterminaldefs `Set.union` _tlIterminaldefs + {-# LINE 723 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 729 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 86 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIcon + {-# LINE 735 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOmainFile = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainFile + {-# LINE 741 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOmainName = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainName + {-# LINE 747 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 82 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInt + {-# LINE 753 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 759 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 765 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 86 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIcon + {-# LINE 771 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOmainFile = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainFile + {-# LINE 777 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOmainName = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainName + {-# LINE 783 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 82 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInt + {-# LINE 789 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 795 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _hdIargnamesw,_hdIchildTypes,_hdIchildintros,_hdIsigs,_hdIterminaldefs) = + hd_ _hdOallInitStates _hdOcon _hdOmainFile _hdOmainName _hdOnt _hdOoptions + ( _tlIargnamesw,_tlIchildTypes,_tlIchildintros,_tlIsigs,_tlIterminaldefs) = + tl_ _tlOallInitStates _tlOcon _tlOmainFile _tlOmainName _tlOnt _tlOoptions + in ( _lhsOargnamesw,_lhsOchildTypes,_lhsOchildintros,_lhsOsigs,_lhsOterminaldefs)))) +sem_EChildren_Nil :: T_EChildren +sem_EChildren_Nil = + (T_EChildren (\ _lhsIallInitStates + _lhsIcon + _lhsImainFile + _lhsImainName + _lhsInt + _lhsIoptions -> + (let _lhsOargnamesw :: ([PP_Doc]) + _lhsOchildTypes :: (Map Identifier Type) + _lhsOchildintros :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _lhsOsigs :: ([(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) + _lhsOterminaldefs :: (Set String) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 389, column 32) + _lhsOargnamesw = + ({-# LINE 389 "./src-ag/ExecutionPlan2Caml.ag" #-} + [] + {-# LINE 819 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1412, column 40) + _lhsOchildTypes = + ({-# LINE 1412 "./src-ag/ExecutionPlan2Caml.ag" #-} + mempty + {-# LINE 825 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 909, column 21) + _lhsOchildintros = + ({-# LINE 909 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 831 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 271, column 34) + _lhsOsigs = + ({-# LINE 271 "./src-ag/ExecutionPlan2Caml.ag" #-} + [] + {-# LINE 837 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1258, column 42) + _lhsOterminaldefs = + ({-# LINE 1258 "./src-ag/ExecutionPlan2Caml.ag" #-} + Set.empty + {-# LINE 843 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOargnamesw,_lhsOchildTypes,_lhsOchildintros,_lhsOsigs,_lhsOterminaldefs)))) +-- ENonterminal ------------------------------------------------ +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInitStates : Map NontermIdent Int + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + inhmap : Map NontermIdent Attributes + localAttrTypes : Map NontermIdent (Map ConstructorIdent (Map Identifier Type)) + mainFile : String + mainName : String + options : Options + synmap : Map NontermIdent Attributes + typeSyns : TypeSyns + wrappers : Set NontermIdent + synthesized attributes: + childvisit : Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) + code : PP_Doc + datas : PP_Doc + errors : Seq Error + fromToStates : Map VisitIdentifier (Int,Int) + initStates : Map NontermIdent Int + modules : PP_Doc + semFunBndDefs : Seq PP_Doc + semFunBndTps : Seq PP_Doc + visitKinds : Map VisitIdentifier VisitKind + visitdefs : Map VisitIdentifier (Set Identifier) + visituses : Map VisitIdentifier (Set Identifier) + alternatives: + alternative ENonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child classCtxs : {ClassContext} + child initial : {StateIdentifier} + child initialv : {Maybe VisitIdentifier} + child nextVisits : {Map StateIdentifier StateCtx} + child prevVisits : {Map StateIdentifier StateCtx} + child prods : EProductions + child recursive : {Bool} + child hoInfo : {HigherOrderInfo} + visit 0: + local hasWrapper : _ + local t_params : _ + local aliasPre : _ + local aliasMod : _ + local datatypeNt : _ + local datatypeCon : _ + local moduleDecl : _ + local datatypeProds : _ + local fsemname : _ + local semname : _ + local frecarg : _ + local sem_param_tp : _ + local sem_res_tp : _ + local sem_tp : _ + local o_sigs : _ + local sem_nt_body : _ + local sem_nt : _ + local allstates : _ + local stvisits : _ + local t_type : _ + local t_c_params : _ + local t_init : _ + local t_states : _ + local c_states : _ + local wr_inh : _ + local wr_syn : _ + local genwrap : _ + local inhAttrs : _ + local wr_inhs : _ + local wr_inhs1 : _ + local wr_filter : _ + local wr_syns : _ + local wrapname : _ + local inhname : _ + local synname : _ + local firstVisitInfo : _ + local wrapArgSemTp : _ + local wrapArgInhTp : _ + local wrapArgPats : _ + local wrapResTp : _ + local wrapper : _ + local wrapperPreamble : _ + local wrapperBody : _ + local semFunBndDef : _ + local semFunBndTp : _ + local semFunBndNm : _ + local ntType : _ +-} +-- cata +sem_ENonterminal :: ENonterminal -> + T_ENonterminal +sem_ENonterminal (ENonterminal _nt _params _classCtxs _initial _initialv _nextVisits _prevVisits _prods _recursive _hoInfo) = + (sem_ENonterminal_ENonterminal _nt _params _classCtxs _initial _initialv _nextVisits _prevVisits (sem_EProductions _prods) _recursive _hoInfo) +-- semantic domain +newtype T_ENonterminal = T_ENonterminal ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Int) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map NontermIdent Attributes) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) -> + String -> + String -> + Options -> + (Map NontermIdent Attributes) -> + TypeSyns -> + (Set NontermIdent) -> + ( (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),PP_Doc,PP_Doc,(Seq Error),(Map VisitIdentifier (Int,Int)),(Map NontermIdent Int),PP_Doc,(Seq PP_Doc),(Seq PP_Doc),(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier)))) +data Inh_ENonterminal = Inh_ENonterminal {allFromToStates_Inh_ENonterminal :: (Map VisitIdentifier (Int,Int)),allInitStates_Inh_ENonterminal :: (Map NontermIdent Int),allVisitKinds_Inh_ENonterminal :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_ENonterminal :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),avisitdefs_Inh_ENonterminal :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_ENonterminal :: (Map VisitIdentifier (Set Identifier)),inhmap_Inh_ENonterminal :: (Map NontermIdent Attributes),localAttrTypes_Inh_ENonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))),mainFile_Inh_ENonterminal :: String,mainName_Inh_ENonterminal :: String,options_Inh_ENonterminal :: Options,synmap_Inh_ENonterminal :: (Map NontermIdent Attributes),typeSyns_Inh_ENonterminal :: TypeSyns,wrappers_Inh_ENonterminal :: (Set NontermIdent)} +data Syn_ENonterminal = Syn_ENonterminal {childvisit_Syn_ENonterminal :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),code_Syn_ENonterminal :: PP_Doc,datas_Syn_ENonterminal :: PP_Doc,errors_Syn_ENonterminal :: (Seq Error),fromToStates_Syn_ENonterminal :: (Map VisitIdentifier (Int,Int)),initStates_Syn_ENonterminal :: (Map NontermIdent Int),modules_Syn_ENonterminal :: PP_Doc,semFunBndDefs_Syn_ENonterminal :: (Seq PP_Doc),semFunBndTps_Syn_ENonterminal :: (Seq PP_Doc),visitKinds_Syn_ENonterminal :: (Map VisitIdentifier VisitKind),visitdefs_Syn_ENonterminal :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_ENonterminal :: (Map VisitIdentifier (Set Identifier))} +wrap_ENonterminal :: T_ENonterminal -> + Inh_ENonterminal -> + Syn_ENonterminal +wrap_ENonterminal (T_ENonterminal sem) (Inh_ENonterminal _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers) = + (let ( _lhsOchildvisit,_lhsOcode,_lhsOdatas,_lhsOerrors,_lhsOfromToStates,_lhsOinitStates,_lhsOmodules,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers + in (Syn_ENonterminal _lhsOchildvisit _lhsOcode _lhsOdatas _lhsOerrors _lhsOfromToStates _lhsOinitStates _lhsOmodules _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses)) +sem_ENonterminal_ENonterminal :: NontermIdent -> + ([Identifier]) -> + ClassContext -> + StateIdentifier -> + (Maybe VisitIdentifier) -> + (Map StateIdentifier StateCtx) -> + (Map StateIdentifier StateCtx) -> + T_EProductions -> + Bool -> + HigherOrderInfo -> + T_ENonterminal +sem_ENonterminal_ENonterminal nt_ params_ classCtxs_ initial_ initialv_ nextVisits_ prevVisits_ (T_EProductions prods_) recursive_ hoInfo_ = + (T_ENonterminal (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsIoptions + _lhsIsynmap + _lhsItypeSyns + _lhsIwrappers -> + (let _prodsOrename :: Bool + _prodsOnt :: NontermIdent + _prodsOparams :: ([Identifier]) + _lhsOdatas :: PP_Doc + _lhsOcode :: PP_Doc + _lhsOmodules :: PP_Doc + _prodsOinhmap :: Attributes + _prodsOsynmap :: Attributes + _prodsOallInhmap :: (Map NontermIdent Attributes) + _prodsOallSynmap :: (Map NontermIdent Attributes) + _lhsOsemFunBndDefs :: (Seq PP_Doc) + _lhsOsemFunBndTps :: (Seq PP_Doc) + _prodsOinitial :: StateIdentifier + _prodsOallstates :: ([StateIdentifier]) + _prodsOnextVisits :: (Map StateIdentifier StateCtx) + _prodsOprevVisits :: (Map StateIdentifier StateCtx) + _prodsOlocalAttrTypes :: (Map ConstructorIdent (Map Identifier Type)) + _lhsOinitStates :: (Map NontermIdent Int) + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + _prodsOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _prodsOallInitStates :: (Map NontermIdent Int) + _prodsOallVisitKinds :: (Map VisitIdentifier VisitKind) + _prodsOallchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _prodsOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _prodsOavisituses :: (Map VisitIdentifier (Set Identifier)) + _prodsOmainFile :: String + _prodsOmainName :: String + _prodsOntType :: Type + _prodsOoptions :: Options + _prodsIallvisits :: ([VisitStateState]) + _prodsIchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _prodsIcount :: Int + _prodsIdatatype :: ([PP_Doc]) + _prodsIdatatype_call :: ([PP_Doc]) + _prodsIdatatype_con :: ([PP_Doc]) + _prodsIerrors :: (Seq Error) + _prodsIfromToStates :: (Map VisitIdentifier (Int,Int)) + _prodsIsemFunBndDefs :: (Seq PP_Doc) + _prodsIsemFunBndTps :: (Seq PP_Doc) + _prodsIsem_nt :: PP_Doc + _prodsIsem_prod :: PP_Doc + _prodsIt_visits :: PP_Doc + _prodsIvisitKinds :: (Map VisitIdentifier VisitKind) + _prodsIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _prodsIvisituses :: (Map VisitIdentifier (Set Identifier)) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 76, column 3) + _prodsOrename = + ({-# LINE 76 "./src-ag/ExecutionPlan2Caml.ag" #-} + rename _lhsIoptions + {-# LINE 1047 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 84, column 3) + _prodsOnt = + ({-# LINE 84 "./src-ag/ExecutionPlan2Caml.ag" #-} + nt_ + {-# LINE 1053 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 94, column 3) + _prodsOparams = + ({-# LINE 94 "./src-ag/ExecutionPlan2Caml.ag" #-} + params_ + {-# LINE 1059 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 113, column 3) + _lhsOdatas = + ({-# LINE 113 "./src-ag/ExecutionPlan2Caml.ag" #-} + ( text "" + >-< "(* *** " ++ getName nt_ ++ " *** [data] *)") + >-< (if dataTypes _lhsIoptions + then pp "(* data *)" + >-< _datatypeNt + >-< _datatypeProds + >-< "" + else empty) + >-< (if _hasWrapper + then pp "(* wrapper *)" + >-< _wr_inh + >-< _wr_syn + >-< "" + else empty) + >-< (if semfuns _lhsIoptions + then pp "(* semantic domain *)" + >-< _t_init + >-< _t_states + >-< _c_states + >-< _prodsIt_visits + >-< "" + else empty) + {-# LINE 1086 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 136, column 3) + _lhsOcode = + ({-# LINE 136 "./src-ag/ExecutionPlan2Caml.ag" #-} + ( text "" + >-< "(* *** " ++ getName nt_ ++ " *** [code] *)") + >-< (if dataTypes _lhsIoptions + then pp "(* constructor functions *)" + >-< _datatypeCon + else empty) + >-< (if _hasWrapper + then pp "(* wrapper *)" + >-< _wrapper + >-< "" + else empty) + >-< (if folds _lhsIoptions + then "(* cata *)" + >-< _sem_nt + >-< "" + else empty) + >-< (if semfuns _lhsIoptions + then "(* semantic domain *)" + >-< _prodsIsem_prod + >-< "" + else empty) + {-# LINE 1112 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 161, column 3) + _lhsOmodules = + ({-# LINE 161 "./src-ag/ExecutionPlan2Caml.ag" #-} + _moduleDecl + {-# LINE 1118 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 163, column 3) + _hasWrapper = + ({-# LINE 163 "./src-ag/ExecutionPlan2Caml.ag" #-} + nt_ `Set.member` _lhsIwrappers + {-# LINE 1124 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 214, column 3) + _t_params = + ({-# LINE 214 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppTypeParams params_ + {-# LINE 1130 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 215, column 3) + _aliasPre = + ({-# LINE 215 "./src-ag/ExecutionPlan2Caml.ag" #-} + "and" >#< _t_params >#< nt_ >#< "=" + {-# LINE 1136 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 216, column 3) + _aliasMod = + ({-# LINE 216 "./src-ag/ExecutionPlan2Caml.ag" #-} + _aliasPre >#< modName nt_ >|< ".t" + {-# LINE 1142 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 217, column 3) + _datatypeNt = + ({-# LINE 217 "./src-ag/ExecutionPlan2Caml.ag" #-} + case lookup nt_ _lhsItypeSyns of + Just (List t) -> _aliasPre >#< ppTp t >#< "list" + Just (Maybe t) -> _aliasPre >#< ppTp t >#< "option" + Just (Tuple ts) -> _aliasPre >#< (pp_block "(" ")" " * " $ map (ppTp . snd) ts) + Just (Map k v) -> _aliasMod + Just (IntMap t) -> _aliasMod + Just (OrdSet t) -> _aliasMod + Just IntSet -> _aliasMod + _ -> "and" >#< _t_params >#< nt_ >#< "=" + >-< ( if null _prodsIdatatype + then pp "unit" + else indent 2 $ vlist _prodsIdatatype_call + ) + {-# LINE 1160 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 236, column 3) + _datatypeCon = + ({-# LINE 236 "./src-ag/ExecutionPlan2Caml.ag" #-} + case lookup nt_ _lhsItypeSyns of + Just _ -> empty + Nothing -> vlist _prodsIdatatype_con + {-# LINE 1168 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 241, column 3) + _moduleDecl = + ({-# LINE 241 "./src-ag/ExecutionPlan2Caml.ag" #-} + let ppModule expr = "module" >#< modName nt_ >#< "=" + in case lookup nt_ _lhsItypeSyns of + Just (Map k _) -> ppModule ("Map.Make" >#< pp_parens (ppTp k)) + Just (IntMap _) -> ppModule ("Map.Make ()") + Just (OrdSet t) -> ppModule ("Set.Make" >#< pp_parens (ppTp t)) + Just IntSet -> ppModule ("Set.Make (struct type t = int let compare = Pervasives.compare end)") + _ -> empty + {-# LINE 1180 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 250, column 3) + _datatypeProds = + ({-# LINE 250 "./src-ag/ExecutionPlan2Caml.ag" #-} + vlist _prodsIdatatype + {-# LINE 1186 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 310, column 3) + _fsemname = + ({-# LINE 310 "./src-ag/ExecutionPlan2Caml.ag" #-} + \x -> prefix _lhsIoptions ++ show x + {-# LINE 1192 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 311, column 3) + _semname = + ({-# LINE 311 "./src-ag/ExecutionPlan2Caml.ag" #-} + _fsemname nt_ + {-# LINE 1198 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 312, column 3) + _frecarg = + ({-# LINE 312 "./src-ag/ExecutionPlan2Caml.ag" #-} + \t x -> case t of + NT nt _ _ -> pp_parens (_fsemname nt >#< x) + _ -> x + {-# LINE 1206 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 316, column 3) + _sem_param_tp = + ({-# LINE 316 "./src-ag/ExecutionPlan2Caml.ag" #-} + _t_params >#< nt_ + {-# LINE 1212 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 317, column 3) + _sem_res_tp = + ({-# LINE 317 "./src-ag/ExecutionPlan2Caml.ag" #-} + _t_params >#< _t_type + {-# LINE 1218 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 318, column 3) + _sem_tp = + ({-# LINE 318 "./src-ag/ExecutionPlan2Caml.ag" #-} + _sem_param_tp >#< "->" >#< _sem_res_tp + {-# LINE 1224 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 320, column 3) + _o_sigs = + ({-# LINE 320 "./src-ag/ExecutionPlan2Caml.ag" #-} + typeSigs _lhsIoptions + {-# LINE 1230 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 321, column 3) + _sem_nt_body = + ({-# LINE 321 "./src-ag/ExecutionPlan2Caml.ag" #-} + "match arg with" >-< (indent 2 $ _prodsIsem_nt) + {-# LINE 1236 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 322, column 3) + _sem_nt = + ({-# LINE 322 "./src-ag/ExecutionPlan2Caml.ag" #-} + let genSem nm body = "and" >#< ppFunDecl _o_sigs (pp _semname ) [(pp nm, _sem_param_tp )] _sem_res_tp body + genAlias alts = genSem (pp "arg") (pp "match arg with" >-< (indent 2 $ vlist $ map (pp "|" >#<) alts)) + genMap v = let body = modName nt_ >|< ".fold" >#< _semname >|< "_Entry" >#< _semname >|< "_Nil" >#< els + els = case v of + NT nt _ _ -> pp_parens (modName nt_ >|< ".map" >#< _fsemname nt >#< "m") + _ -> pp "m" + in genSem "m" body + genSet mbNt = let body = "List.fold_right" >#< _semname >|< "_Entry" >#< + els (pp_parens (modName nt_ >|< ".elements" >#< "s")) >#< _semname >|< "_Nil" + els r = maybe r (\nt -> pp_parens ("List.map" >#< _fsemname nt >#< r)) mbNt + in genSem "s" body + in case lookup nt_ _lhsItypeSyns of + Just (List t) -> let body = "List.fold_right" >#< _semname >|< "_Cons" >#< els >#< _semname >|< "_Nil" + els = case t of + NT nt _ _ -> pp_parens ("List.map" >#< _fsemname nt >#< "list") + _ -> pp "list" + in genSem "list" body + Just (Tuple ts) -> let pat = pp_parens (ppCommas $ map fst ts) + body = _semname >|< "_Tuple" >#< ppSpaced (map (\t -> _frecarg (snd t) (pp $ fst t)) ts) + in genSem pat body + Just (Map _ v) -> genMap v + Just (IntMap v) -> genMap v + Just (Maybe t) -> genAlias + [ "None" >#< "->" >#< "=" >#< _semname >|< "_Nothing" + , "Some" >#< "just" >#< "->" >#< _semname >|< "_Just" >#< _frecarg t (pp "just") + ] + Just (OrdSet t) -> genSet $ case t of + NT nt _ _ -> Just nt + _ -> Nothing + Just (IntSet) -> genSet Nothing + _ -> genSem "arg" _sem_nt_body + {-# LINE 1272 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 416, column 19) + (Just _prodsOinhmap) = + ({-# LINE 416 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.lookup nt_ _lhsIinhmap + {-# LINE 1278 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 417, column 19) + (Just _prodsOsynmap) = + ({-# LINE 417 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.lookup nt_ _lhsIsynmap + {-# LINE 1284 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 418, column 18) + _prodsOallInhmap = + ({-# LINE 418 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 1290 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 419, column 18) + _prodsOallSynmap = + ({-# LINE 419 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 1296 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 440, column 3) + _allstates = + ({-# LINE 440 "./src-ag/ExecutionPlan2Caml.ag" #-} + orderStates initial_ _prodsIallvisits + {-# LINE 1302 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 441, column 3) + _stvisits = + ({-# LINE 441 "./src-ag/ExecutionPlan2Caml.ag" #-} + \st -> filter (\(v,f,t) -> f == st) _prodsIallvisits + {-# LINE 1308 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 442, column 3) + _t_type = + ({-# LINE 442 "./src-ag/ExecutionPlan2Caml.ag" #-} + type_nt_sem_top nt_ + {-# LINE 1314 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 443, column 3) + _t_c_params = + ({-# LINE 443 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppTypeParams (cont_tvar : map pp params_) + {-# LINE 1320 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 446, column 3) + _t_init = + ({-# LINE 446 "./src-ag/ExecutionPlan2Caml.ag" #-} + "and" >#< _t_params >#< _t_type >#< "=" >#< pp_braces ( nm_attach nt_ >#< ":" >#< "unit" >#< "->" >#< _t_params >#< type_nt_sem nt_ initial_) + {-# LINE 1326 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 449, column 3) + _t_states = + ({-# LINE 449 "./src-ag/ExecutionPlan2Caml.ag" #-} + vlist $ map (\st -> + let s_st = type_nt_state nt_ st + t_st = type_nt_sem nt_ st + c_st = type_caller nt_ st + nextVisits = Map.findWithDefault ManyVis st nextVisits_ + decl = "and" >#< _t_params >#< t_st >#< "=" + in case nextVisits of + NoneVis -> decl >#< "unit" + _ -> decl >#< ppRecordVal [ nm_invoke nt_ st >#< ":" >#< cont_tvar >#< "." >#< _t_c_params >#< c_st >#< "->" >#< cont_tvar ] + ) _allstates + {-# LINE 1341 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 502, column 3) + _c_states = + ({-# LINE 502 "./src-ag/ExecutionPlan2Caml.ag" #-} + vlist $ map (\st -> + let nt_st = type_nt_state nt_ st + c_st = type_caller nt_ st + outg = filter (\(_,f,_) -> f == st) _prodsIallvisits + nextVisits = Map.findWithDefault ManyVis st nextVisits_ + declHead = "and" >#< _t_c_params >#< c_st >#< "=" + visitcons = vlist $ map (\(v,_,_) -> + "|" >#< con_visit nt_ v >#< "of" >#< _t_c_params >#< type_caller_visit nt_ v + ) outg + in case nextVisits of + NoneVis -> empty + OneVis v -> declHead >#< _t_c_params >#< type_caller_visit nt_ v + ManyVis -> declHead >-< indent 3 visitcons + ) _allstates + {-# LINE 1360 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 584, column 3) + _wr_inh = + ({-# LINE 584 "./src-ag/ExecutionPlan2Caml.ag" #-} + _genwrap "inh" _wr_inhs1 + {-# LINE 1366 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 585, column 3) + _wr_syn = + ({-# LINE 585 "./src-ag/ExecutionPlan2Caml.ag" #-} + _genwrap "syn" _wr_syns + {-# LINE 1372 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 586, column 3) + _genwrap = + ({-# LINE 586 "./src-ag/ExecutionPlan2Caml.ag" #-} + \nm attrs -> + "and" >#< _t_params >#< nm >|< "_" >|< nt_ >#< "=" >#< ppRecordTp + [ i >|< "_" >|< nm >|< "_" >|< nt_ >#< ":" >#< ppTp t | (i,t) <- attrs ] + {-# LINE 1380 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 590, column 3) + _inhAttrs = + ({-# LINE 590 "./src-ag/ExecutionPlan2Caml.ag" #-} + fromJust $ Map.lookup nt_ _lhsIinhmap + {-# LINE 1386 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 591, column 3) + _wr_inhs = + ({-# LINE 591 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.toList $ _wr_filter $ _inhAttrs + {-# LINE 1392 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 592, column 3) + _wr_inhs1 = + ({-# LINE 592 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.toList _inhAttrs + {-# LINE 1398 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 593, column 3) + _wr_filter = + ({-# LINE 593 "./src-ag/ExecutionPlan2Caml.ag" #-} + if kennedyWarren _lhsIoptions && lateHigherOrderBinding _lhsIoptions + then Map.delete idLateBindingAttr + else id + {-# LINE 1406 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 596, column 3) + _wr_syns = + ({-# LINE 596 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.toList $ fromJust $ Map.lookup nt_ _lhsIsynmap + {-# LINE 1412 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 598, column 3) + _wrapname = + ({-# LINE 598 "./src-ag/ExecutionPlan2Caml.ag" #-} + text ("wrap_" ++ show nt_) + {-# LINE 1418 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 599, column 3) + _inhname = + ({-# LINE 599 "./src-ag/ExecutionPlan2Caml.ag" #-} + text ("inh_" ++ show nt_) + {-# LINE 1424 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 600, column 3) + _synname = + ({-# LINE 600 "./src-ag/ExecutionPlan2Caml.ag" #-} + text ("syn_" ++ show nt_) + {-# LINE 1430 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 601, column 3) + _firstVisitInfo = + ({-# LINE 601 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.findWithDefault ManyVis initial_ nextVisits_ + {-# LINE 1436 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 603, column 3) + _wrapArgSemTp = + ({-# LINE 603 "./src-ag/ExecutionPlan2Caml.ag" #-} + _t_params >#< _t_type + {-# LINE 1442 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 604, column 3) + _wrapArgInhTp = + ({-# LINE 604 "./src-ag/ExecutionPlan2Caml.ag" #-} + _t_params >#< _inhname + {-# LINE 1448 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 605, column 3) + _wrapArgPats = + ({-# LINE 605 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppRecordVal [ i >|< "_inh_" >|< nt_ >#< "=" >#< lhsname True i | (i,_) <- _wr_inhs1 ] + {-# LINE 1454 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 606, column 3) + _wrapResTp = + ({-# LINE 606 "./src-ag/ExecutionPlan2Caml.ag" #-} + _t_params >#< _synname + {-# LINE 1460 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 607, column 3) + _wrapper = + ({-# LINE 607 "./src-ag/ExecutionPlan2Caml.ag" #-} + "and" >#< ppFunDecl _o_sigs _wrapname [(pp "act", _wrapArgSemTp ), (_wrapArgPats , _wrapArgInhTp )] _wrapResTp _wrapperPreamble + {-# LINE 1466 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 608, column 3) + _wrapperPreamble = + ({-# LINE 608 "./src-ag/ExecutionPlan2Caml.ag" #-} + ( if lateHigherOrderBinding _lhsIoptions + then "let" >#< lhsname True idLateBindingAttr >#< "=" >#< lateBindingFieldNm _lhsImainName >#< "in" + else empty + ) + >-< _wrapperBody + {-# LINE 1476 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 614, column 3) + _wrapperBody = + ({-# LINE 614 "./src-ag/ExecutionPlan2Caml.ag" #-} + case initialv_ of + Nothing -> text "{ }" + Just initv -> + let attach = "let" >#< "sem" >#< "=" >#< "act." >|< nm_attach nt_ >#< "()" >#< "in" + pat = ppRecordVal [ nm_outarg i nt_ initv >#< "=" >#< lhsname False i | (i,_) <- _wr_syns ] + bld = ppRecordVal [ i >|< "_syn_" >|< nt_ >#< "=" >#< lhsname False i | (i,_) <- _wr_syns ] + res = "let res = function" >#< pat >#< "->" >#< bld >#< "in" + inps = "let" >#< "inps" >#< "=" >#< ppRecordVal [ nm_inarg i nt_ initv >#< "=" >#< lhsname True i | (i,_) <- _wr_inhs ] >#< "in" + arg = "let" >#< "arg" >#< "=" >#< argcon >#< argrec >#< "in" + argcon = case _firstVisitInfo of + ManyVis -> con_visit nt_ initv + _ -> empty + argrec = ppRecordVal + [ nm_inh nt_ initv >#< "=" >#< "inps" + , nm_cont nt_ initv >#< "=" >#< "res" + ] + invoke = "sem." >|< nm_invoke nt_ initial_ >#< "arg" + in attach >-< res >-< inps >-< arg >-< invoke + {-# LINE 1499 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 644, column 3) + _lhsOsemFunBndDefs = + ({-# LINE 644 "./src-ag/ExecutionPlan2Caml.ag" #-} + _semFunBndDef Seq.<| _prodsIsemFunBndDefs + {-# LINE 1505 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 645, column 3) + _lhsOsemFunBndTps = + ({-# LINE 645 "./src-ag/ExecutionPlan2Caml.ag" #-} + _semFunBndTp Seq.<| _prodsIsemFunBndTps + {-# LINE 1511 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 646, column 3) + _semFunBndDef = + ({-# LINE 646 "./src-ag/ExecutionPlan2Caml.ag" #-} + _semFunBndNm >#< "=" >#< _semname + {-# LINE 1517 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 647, column 3) + _semFunBndTp = + ({-# LINE 647 "./src-ag/ExecutionPlan2Caml.ag" #-} + _semFunBndNm >#< ":" >#< _sem_tp + {-# LINE 1523 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 648, column 3) + _semFunBndNm = + ({-# LINE 648 "./src-ag/ExecutionPlan2Caml.ag" #-} + lateSemNtLabel nt_ + {-# LINE 1529 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 678, column 3) + _prodsOinitial = + ({-# LINE 678 "./src-ag/ExecutionPlan2Caml.ag" #-} + initial_ + {-# LINE 1535 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 679, column 3) + _prodsOallstates = + ({-# LINE 679 "./src-ag/ExecutionPlan2Caml.ag" #-} + _allstates + {-# LINE 1541 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1385, column 3) + _prodsOnextVisits = + ({-# LINE 1385 "./src-ag/ExecutionPlan2Caml.ag" #-} + nextVisits_ + {-# LINE 1547 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1386, column 3) + _prodsOprevVisits = + ({-# LINE 1386 "./src-ag/ExecutionPlan2Caml.ag" #-} + prevVisits_ + {-# LINE 1553 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1430, column 3) + _prodsOlocalAttrTypes = + ({-# LINE 1430 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIlocalAttrTypes + {-# LINE 1559 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1457, column 3) + _lhsOinitStates = + ({-# LINE 1457 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton nt_ initial_ + {-# LINE 1565 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1471, column 3) + _ntType = + ({-# LINE 1471 "./src-ag/ExecutionPlan2Caml.ag" #-} + NT nt_ (map show params_) False + {-# LINE 1571 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1147, column 37) + _lhsOchildvisit = + ({-# LINE 1147 "./src-ag/ExecutionPlan2Caml.ag" #-} + _prodsIchildvisit + {-# LINE 1577 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + _prodsIerrors + {-# LINE 1583 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1393, column 22) + _lhsOfromToStates = + ({-# LINE 1393 "./src-ag/ExecutionPlan2Caml.ag" #-} + _prodsIfromToStates + {-# LINE 1589 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1440, column 68) + _lhsOvisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _prodsIvisitKinds + {-# LINE 1595 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1296, column 36) + _lhsOvisitdefs = + ({-# LINE 1296 "./src-ag/ExecutionPlan2Caml.ag" #-} + _prodsIvisitdefs + {-# LINE 1601 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1297, column 36) + _lhsOvisituses = + ({-# LINE 1297 "./src-ag/ExecutionPlan2Caml.ag" #-} + _prodsIvisituses + {-# LINE 1607 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _prodsOallFromToStates = + ({-# LINE 1396 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallFromToStates + {-# LINE 1613 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _prodsOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 1619 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _prodsOallVisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallVisitKinds + {-# LINE 1625 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _prodsOallchildvisit = + ({-# LINE 1146 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallchildvisit + {-# LINE 1631 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _prodsOavisitdefs = + ({-# LINE 1306 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisitdefs + {-# LINE 1637 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _prodsOavisituses = + ({-# LINE 1307 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisituses + {-# LINE 1643 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _prodsOmainFile = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainFile + {-# LINE 1649 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _prodsOmainName = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainName + {-# LINE 1655 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (from local) + _prodsOntType = + ({-# LINE 1469 "./src-ag/ExecutionPlan2Caml.ag" #-} + _ntType + {-# LINE 1661 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _prodsOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 1667 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _prodsIallvisits,_prodsIchildvisit,_prodsIcount,_prodsIdatatype,_prodsIdatatype_call,_prodsIdatatype_con,_prodsIerrors,_prodsIfromToStates,_prodsIsemFunBndDefs,_prodsIsemFunBndTps,_prodsIsem_nt,_prodsIsem_prod,_prodsIt_visits,_prodsIvisitKinds,_prodsIvisitdefs,_prodsIvisituses) = + prods_ _prodsOallFromToStates _prodsOallInhmap _prodsOallInitStates _prodsOallSynmap _prodsOallVisitKinds _prodsOallchildvisit _prodsOallstates _prodsOavisitdefs _prodsOavisituses _prodsOinhmap _prodsOinitial _prodsOlocalAttrTypes _prodsOmainFile _prodsOmainName _prodsOnextVisits _prodsOnt _prodsOntType _prodsOoptions _prodsOparams _prodsOprevVisits _prodsOrename _prodsOsynmap + in ( _lhsOchildvisit,_lhsOcode,_lhsOdatas,_lhsOerrors,_lhsOfromToStates,_lhsOinitStates,_lhsOmodules,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +-- ENonterminals ----------------------------------------------- +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInitStates : Map NontermIdent Int + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + inhmap : Map NontermIdent Attributes + localAttrTypes : Map NontermIdent (Map ConstructorIdent (Map Identifier Type)) + mainFile : String + mainName : String + options : Options + synmap : Map NontermIdent Attributes + typeSyns : TypeSyns + wrappers : Set NontermIdent + synthesized attributes: + childvisit : Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) + code : PP_Doc + datas : PP_Doc + errors : Seq Error + fromToStates : Map VisitIdentifier (Int,Int) + initStates : Map NontermIdent Int + modules : PP_Doc + semFunBndDefs : Seq PP_Doc + semFunBndTps : Seq PP_Doc + visitKinds : Map VisitIdentifier VisitKind + visitdefs : Map VisitIdentifier (Set Identifier) + visituses : Map VisitIdentifier (Set Identifier) + alternatives: + alternative Cons: + child hd : ENonterminal + child tl : ENonterminals + alternative Nil: +-} +-- cata +sem_ENonterminals :: ENonterminals -> + T_ENonterminals +sem_ENonterminals list = + (Prelude.foldr sem_ENonterminals_Cons sem_ENonterminals_Nil (Prelude.map sem_ENonterminal list)) +-- semantic domain +newtype T_ENonterminals = T_ENonterminals ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Int) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map NontermIdent Attributes) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) -> + String -> + String -> + Options -> + (Map NontermIdent Attributes) -> + TypeSyns -> + (Set NontermIdent) -> + ( (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),PP_Doc,PP_Doc,(Seq Error),(Map VisitIdentifier (Int,Int)),(Map NontermIdent Int),PP_Doc,(Seq PP_Doc),(Seq PP_Doc),(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier)))) +data Inh_ENonterminals = Inh_ENonterminals {allFromToStates_Inh_ENonterminals :: (Map VisitIdentifier (Int,Int)),allInitStates_Inh_ENonterminals :: (Map NontermIdent Int),allVisitKinds_Inh_ENonterminals :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_ENonterminals :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),avisitdefs_Inh_ENonterminals :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_ENonterminals :: (Map VisitIdentifier (Set Identifier)),inhmap_Inh_ENonterminals :: (Map NontermIdent Attributes),localAttrTypes_Inh_ENonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))),mainFile_Inh_ENonterminals :: String,mainName_Inh_ENonterminals :: String,options_Inh_ENonterminals :: Options,synmap_Inh_ENonterminals :: (Map NontermIdent Attributes),typeSyns_Inh_ENonterminals :: TypeSyns,wrappers_Inh_ENonterminals :: (Set NontermIdent)} +data Syn_ENonterminals = Syn_ENonterminals {childvisit_Syn_ENonterminals :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),code_Syn_ENonterminals :: PP_Doc,datas_Syn_ENonterminals :: PP_Doc,errors_Syn_ENonterminals :: (Seq Error),fromToStates_Syn_ENonterminals :: (Map VisitIdentifier (Int,Int)),initStates_Syn_ENonterminals :: (Map NontermIdent Int),modules_Syn_ENonterminals :: PP_Doc,semFunBndDefs_Syn_ENonterminals :: (Seq PP_Doc),semFunBndTps_Syn_ENonterminals :: (Seq PP_Doc),visitKinds_Syn_ENonterminals :: (Map VisitIdentifier VisitKind),visitdefs_Syn_ENonterminals :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_ENonterminals :: (Map VisitIdentifier (Set Identifier))} +wrap_ENonterminals :: T_ENonterminals -> + Inh_ENonterminals -> + Syn_ENonterminals +wrap_ENonterminals (T_ENonterminals sem) (Inh_ENonterminals _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers) = + (let ( _lhsOchildvisit,_lhsOcode,_lhsOdatas,_lhsOerrors,_lhsOfromToStates,_lhsOinitStates,_lhsOmodules,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers + in (Syn_ENonterminals _lhsOchildvisit _lhsOcode _lhsOdatas _lhsOerrors _lhsOfromToStates _lhsOinitStates _lhsOmodules _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses)) +sem_ENonterminals_Cons :: T_ENonterminal -> + T_ENonterminals -> + T_ENonterminals +sem_ENonterminals_Cons (T_ENonterminal hd_) (T_ENonterminals tl_) = + (T_ENonterminals (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsIoptions + _lhsIsynmap + _lhsItypeSyns + _lhsIwrappers -> + (let _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _lhsOcode :: PP_Doc + _lhsOdatas :: PP_Doc + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOinitStates :: (Map NontermIdent Int) + _lhsOmodules :: PP_Doc + _lhsOsemFunBndDefs :: (Seq PP_Doc) + _lhsOsemFunBndTps :: (Seq PP_Doc) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + _hdOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _hdOallInitStates :: (Map NontermIdent Int) + _hdOallVisitKinds :: (Map VisitIdentifier VisitKind) + _hdOallchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _hdOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _hdOavisituses :: (Map VisitIdentifier (Set Identifier)) + _hdOinhmap :: (Map NontermIdent Attributes) + _hdOlocalAttrTypes :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) + _hdOmainFile :: String + _hdOmainName :: String + _hdOoptions :: Options + _hdOsynmap :: (Map NontermIdent Attributes) + _hdOtypeSyns :: TypeSyns + _hdOwrappers :: (Set NontermIdent) + _tlOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _tlOallInitStates :: (Map NontermIdent Int) + _tlOallVisitKinds :: (Map VisitIdentifier VisitKind) + _tlOallchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _tlOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _tlOavisituses :: (Map VisitIdentifier (Set Identifier)) + _tlOinhmap :: (Map NontermIdent Attributes) + _tlOlocalAttrTypes :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) + _tlOmainFile :: String + _tlOmainName :: String + _tlOoptions :: Options + _tlOsynmap :: (Map NontermIdent Attributes) + _tlOtypeSyns :: TypeSyns + _tlOwrappers :: (Set NontermIdent) + _hdIchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _hdIcode :: PP_Doc + _hdIdatas :: PP_Doc + _hdIerrors :: (Seq Error) + _hdIfromToStates :: (Map VisitIdentifier (Int,Int)) + _hdIinitStates :: (Map NontermIdent Int) + _hdImodules :: PP_Doc + _hdIsemFunBndDefs :: (Seq PP_Doc) + _hdIsemFunBndTps :: (Seq PP_Doc) + _hdIvisitKinds :: (Map VisitIdentifier VisitKind) + _hdIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _hdIvisituses :: (Map VisitIdentifier (Set Identifier)) + _tlIchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _tlIcode :: PP_Doc + _tlIdatas :: PP_Doc + _tlIerrors :: (Seq Error) + _tlIfromToStates :: (Map VisitIdentifier (Int,Int)) + _tlIinitStates :: (Map NontermIdent Int) + _tlImodules :: PP_Doc + _tlIsemFunBndDefs :: (Seq PP_Doc) + _tlIsemFunBndTps :: (Seq PP_Doc) + _tlIvisitKinds :: (Map VisitIdentifier VisitKind) + _tlIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _tlIvisituses :: (Map VisitIdentifier (Set Identifier)) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1147, column 37) + _lhsOchildvisit = + ({-# LINE 1147 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIchildvisit `Map.union` _tlIchildvisit + {-# LINE 1824 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 107, column 58) + _lhsOcode = + ({-# LINE 107 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIcode >-< _tlIcode + {-# LINE 1830 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 107, column 58) + _lhsOdatas = + ({-# LINE 107 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIdatas >-< _tlIdatas + {-# LINE 1836 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 1842 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1393, column 22) + _lhsOfromToStates = + ({-# LINE 1393 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIfromToStates `mappend` _tlIfromToStates + {-# LINE 1848 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1452, column 50) + _lhsOinitStates = + ({-# LINE 1452 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIinitStates `mappend` _tlIinitStates + {-# LINE 1854 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 107, column 58) + _lhsOmodules = + ({-# LINE 107 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdImodules >-< _tlImodules + {-# LINE 1860 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 642, column 92) + _lhsOsemFunBndDefs = + ({-# LINE 642 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIsemFunBndDefs Seq.>< _tlIsemFunBndDefs + {-# LINE 1866 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 642, column 92) + _lhsOsemFunBndTps = + ({-# LINE 642 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIsemFunBndTps Seq.>< _tlIsemFunBndTps + {-# LINE 1872 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1440, column 68) + _lhsOvisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIvisitKinds `mappend` _tlIvisitKinds + {-# LINE 1878 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1296, column 36) + _lhsOvisitdefs = + ({-# LINE 1296 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIvisitdefs `uwSetUnion` _tlIvisitdefs + {-# LINE 1884 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1297, column 36) + _lhsOvisituses = + ({-# LINE 1297 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIvisituses `uwSetUnion` _tlIvisituses + {-# LINE 1890 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallFromToStates = + ({-# LINE 1396 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallFromToStates + {-# LINE 1896 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 1902 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallVisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallVisitKinds + {-# LINE 1908 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 1146 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallchildvisit + {-# LINE 1914 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 1306 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisitdefs + {-# LINE 1920 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 1307 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisituses + {-# LINE 1926 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 403 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 1932 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOlocalAttrTypes = + ({-# LINE 1425 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 1938 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOmainFile = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainFile + {-# LINE 1944 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOmainName = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainName + {-# LINE 1950 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 1956 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 404 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 1962 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOtypeSyns = + ({-# LINE 168 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsItypeSyns + {-# LINE 1968 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOwrappers = + ({-# LINE 107 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIwrappers + {-# LINE 1974 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallFromToStates = + ({-# LINE 1396 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallFromToStates + {-# LINE 1980 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 1986 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallVisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallVisitKinds + {-# LINE 1992 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 1146 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallchildvisit + {-# LINE 1998 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 1306 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisitdefs + {-# LINE 2004 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 1307 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisituses + {-# LINE 2010 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 403 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 2016 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOlocalAttrTypes = + ({-# LINE 1425 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 2022 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOmainFile = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainFile + {-# LINE 2028 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOmainName = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainName + {-# LINE 2034 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 2040 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 404 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 2046 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOtypeSyns = + ({-# LINE 168 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsItypeSyns + {-# LINE 2052 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOwrappers = + ({-# LINE 107 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIwrappers + {-# LINE 2058 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _hdIchildvisit,_hdIcode,_hdIdatas,_hdIerrors,_hdIfromToStates,_hdIinitStates,_hdImodules,_hdIsemFunBndDefs,_hdIsemFunBndTps,_hdIvisitKinds,_hdIvisitdefs,_hdIvisituses) = + hd_ _hdOallFromToStates _hdOallInitStates _hdOallVisitKinds _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOinhmap _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOoptions _hdOsynmap _hdOtypeSyns _hdOwrappers + ( _tlIchildvisit,_tlIcode,_tlIdatas,_tlIerrors,_tlIfromToStates,_tlIinitStates,_tlImodules,_tlIsemFunBndDefs,_tlIsemFunBndTps,_tlIvisitKinds,_tlIvisitdefs,_tlIvisituses) = + tl_ _tlOallFromToStates _tlOallInitStates _tlOallVisitKinds _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOinhmap _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOoptions _tlOsynmap _tlOtypeSyns _tlOwrappers + in ( _lhsOchildvisit,_lhsOcode,_lhsOdatas,_lhsOerrors,_lhsOfromToStates,_lhsOinitStates,_lhsOmodules,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +sem_ENonterminals_Nil :: T_ENonterminals +sem_ENonterminals_Nil = + (T_ENonterminals (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsIoptions + _lhsIsynmap + _lhsItypeSyns + _lhsIwrappers -> + (let _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _lhsOcode :: PP_Doc + _lhsOdatas :: PP_Doc + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOinitStates :: (Map NontermIdent Int) + _lhsOmodules :: PP_Doc + _lhsOsemFunBndDefs :: (Seq PP_Doc) + _lhsOsemFunBndTps :: (Seq PP_Doc) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1147, column 37) + _lhsOchildvisit = + ({-# LINE 1147 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 2097 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 107, column 58) + _lhsOcode = + ({-# LINE 107 "./src-ag/ExecutionPlan2Caml.ag" #-} + empty + {-# LINE 2103 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 107, column 58) + _lhsOdatas = + ({-# LINE 107 "./src-ag/ExecutionPlan2Caml.ag" #-} + empty + {-# LINE 2109 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + Seq.empty + {-# LINE 2115 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1393, column 22) + _lhsOfromToStates = + ({-# LINE 1393 "./src-ag/ExecutionPlan2Caml.ag" #-} + mempty + {-# LINE 2121 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1452, column 50) + _lhsOinitStates = + ({-# LINE 1452 "./src-ag/ExecutionPlan2Caml.ag" #-} + mempty + {-# LINE 2127 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 107, column 58) + _lhsOmodules = + ({-# LINE 107 "./src-ag/ExecutionPlan2Caml.ag" #-} + empty + {-# LINE 2133 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 642, column 92) + _lhsOsemFunBndDefs = + ({-# LINE 642 "./src-ag/ExecutionPlan2Caml.ag" #-} + Seq.empty + {-# LINE 2139 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 642, column 92) + _lhsOsemFunBndTps = + ({-# LINE 642 "./src-ag/ExecutionPlan2Caml.ag" #-} + Seq.empty + {-# LINE 2145 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1440, column 68) + _lhsOvisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + mempty + {-# LINE 2151 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1296, column 36) + _lhsOvisitdefs = + ({-# LINE 1296 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 2157 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1297, column 36) + _lhsOvisituses = + ({-# LINE 1297 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 2163 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOchildvisit,_lhsOcode,_lhsOdatas,_lhsOerrors,_lhsOfromToStates,_lhsOinitStates,_lhsOmodules,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +-- EProduction ------------------------------------------------- +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInhmap : Map NontermIdent Attributes + allInitStates : Map NontermIdent Int + allSynmap : Map NontermIdent Attributes + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) + allstates : [StateIdentifier] + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + inhmap : Attributes + initial : StateIdentifier + localAttrTypes : Map ConstructorIdent (Map Identifier Type) + mainFile : String + mainName : String + nextVisits : Map StateIdentifier StateCtx + nt : NontermIdent + ntType : Type + options : Options + params : [Identifier] + prevVisits : Map StateIdentifier StateCtx + rename : Bool + synmap : Attributes + synthesized attributes: + allvisits : [VisitStateState] + childvisit : Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) + count : Int + datatype : PP_Doc + datatype_call : PP_Doc + datatype_con : PP_Doc + errors : Seq Error + fromToStates : Map VisitIdentifier (Int,Int) + semFunBndDefs : Seq PP_Doc + semFunBndTps : Seq PP_Doc + sem_nt : PP_Doc + sem_prod : PP_Doc + t_visits : PP_Doc + visitKinds : Map VisitIdentifier VisitKind + visitdefs : Map VisitIdentifier (Set Identifier) + visituses : Map VisitIdentifier (Set Identifier) + alternatives: + alternative EProduction: + child con : {ConstructorIdent} + child params : {[Identifier]} + child constraints : {[Type]} + child rules : ERules + child children : EChildren + child visits : Visits + visit 0: + local o_records : _ + local t_params : _ + local t_c_params : _ + local conname : _ + local recname : _ + local semFunBndDef : _ + local semFunBndTp : _ + local semFunBndNm : _ + local o_sigs : _ + local t_type : _ + local semname : _ + local sem_res_tp : _ + local sem_tp : _ + local initializer : _ + local sem_prod : _ + local prod_body : _ + local statefuns : _ + local genstfn : _ + local stargs : _ + local stvisits : _ + local stks : _ + local stvs : _ + local lazyIntras : _ + local childTypes : _ + local localAttrTypes : _ +-} +-- cata +sem_EProduction :: EProduction -> + T_EProduction +sem_EProduction (EProduction _con _params _constraints _rules _children _visits) = + (sem_EProduction_EProduction _con _params _constraints (sem_ERules _rules) (sem_EChildren _children) (sem_Visits _visits)) +-- semantic domain +newtype T_EProduction = T_EProduction ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Attributes) -> + (Map NontermIdent Int) -> + (Map NontermIdent Attributes) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> + ([StateIdentifier]) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + Attributes -> + StateIdentifier -> + (Map ConstructorIdent (Map Identifier Type)) -> + String -> + String -> + (Map StateIdentifier StateCtx) -> + NontermIdent -> + Type -> + Options -> + ([Identifier]) -> + (Map StateIdentifier StateCtx) -> + Bool -> + Attributes -> + ( ([VisitStateState]),(Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),Int,PP_Doc,PP_Doc,PP_Doc,(Seq Error),(Map VisitIdentifier (Int,Int)),(Seq PP_Doc),(Seq PP_Doc),PP_Doc,PP_Doc,PP_Doc,(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier)))) +data Inh_EProduction = Inh_EProduction {allFromToStates_Inh_EProduction :: (Map VisitIdentifier (Int,Int)),allInhmap_Inh_EProduction :: (Map NontermIdent Attributes),allInitStates_Inh_EProduction :: (Map NontermIdent Int),allSynmap_Inh_EProduction :: (Map NontermIdent Attributes),allVisitKinds_Inh_EProduction :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_EProduction :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),allstates_Inh_EProduction :: ([StateIdentifier]),avisitdefs_Inh_EProduction :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_EProduction :: (Map VisitIdentifier (Set Identifier)),inhmap_Inh_EProduction :: Attributes,initial_Inh_EProduction :: StateIdentifier,localAttrTypes_Inh_EProduction :: (Map ConstructorIdent (Map Identifier Type)),mainFile_Inh_EProduction :: String,mainName_Inh_EProduction :: String,nextVisits_Inh_EProduction :: (Map StateIdentifier StateCtx),nt_Inh_EProduction :: NontermIdent,ntType_Inh_EProduction :: Type,options_Inh_EProduction :: Options,params_Inh_EProduction :: ([Identifier]),prevVisits_Inh_EProduction :: (Map StateIdentifier StateCtx),rename_Inh_EProduction :: Bool,synmap_Inh_EProduction :: Attributes} +data Syn_EProduction = Syn_EProduction {allvisits_Syn_EProduction :: ([VisitStateState]),childvisit_Syn_EProduction :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),count_Syn_EProduction :: Int,datatype_Syn_EProduction :: PP_Doc,datatype_call_Syn_EProduction :: PP_Doc,datatype_con_Syn_EProduction :: PP_Doc,errors_Syn_EProduction :: (Seq Error),fromToStates_Syn_EProduction :: (Map VisitIdentifier (Int,Int)),semFunBndDefs_Syn_EProduction :: (Seq PP_Doc),semFunBndTps_Syn_EProduction :: (Seq PP_Doc),sem_nt_Syn_EProduction :: PP_Doc,sem_prod_Syn_EProduction :: PP_Doc,t_visits_Syn_EProduction :: PP_Doc,visitKinds_Syn_EProduction :: (Map VisitIdentifier VisitKind),visitdefs_Syn_EProduction :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_EProduction :: (Map VisitIdentifier (Set Identifier))} +wrap_EProduction :: T_EProduction -> + Inh_EProduction -> + Syn_EProduction +wrap_EProduction (T_EProduction sem) (Inh_EProduction _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOcount,_lhsOdatatype,_lhsOdatatype_call,_lhsOdatatype_con,_lhsOerrors,_lhsOfromToStates,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap + in (Syn_EProduction _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOdatatype_call _lhsOdatatype_con _lhsOerrors _lhsOfromToStates _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses)) +sem_EProduction_EProduction :: ConstructorIdent -> + ([Identifier]) -> + ([Type]) -> + T_ERules -> + T_EChildren -> + T_Visits -> + T_EProduction +sem_EProduction_EProduction con_ params_ constraints_ (T_ERules rules_) (T_EChildren children_) (T_Visits visits_) = + (T_EProduction (\ _lhsIallFromToStates + _lhsIallInhmap + _lhsIallInitStates + _lhsIallSynmap + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIallstates + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIinitial + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsInextVisits + _lhsInt + _lhsIntType + _lhsIoptions + _lhsIparams + _lhsIprevVisits + _lhsIrename + _lhsIsynmap -> + (let _childrenOcon :: ConstructorIdent + _rulesOcon :: ConstructorIdent + _visitsOcon :: ConstructorIdent + _lhsOdatatype :: PP_Doc + _lhsOdatatype_call :: PP_Doc + _lhsOdatatype_con :: PP_Doc + _lhsOcount :: Int + _lhsOsem_nt :: PP_Doc + _lhsOsemFunBndDefs :: (Seq PP_Doc) + _lhsOsemFunBndTps :: (Seq PP_Doc) + _visitsOmrules :: (Map Identifier (VisitKind -> Either Error PP_Doc)) + _visitsOchildintros :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _rulesOusageInfo :: (Map Identifier Int) + _rulesOruleKinds :: (Map Identifier (Set VisitKind)) + _visitsOallintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _visitsOterminaldefs :: (Set String) + _visitsOruledefs :: (Map Identifier (Set String)) + _visitsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOt_visits :: PP_Doc + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + _lhsOallvisits :: ([VisitStateState]) + _lhsOsem_prod :: PP_Doc + _rulesOallInhmap :: (Map NontermIdent Attributes) + _rulesOallSynmap :: (Map NontermIdent Attributes) + _rulesOchildTypes :: (Map Identifier Type) + _rulesOinhmap :: Attributes + _rulesOlazyIntras :: (Set String) + _rulesOlocalAttrTypes :: (Map Identifier Type) + _rulesOmainFile :: String + _rulesOmainName :: String + _rulesOnt :: NontermIdent + _rulesOoptions :: Options + _rulesOsynmap :: Attributes + _childrenOallInitStates :: (Map NontermIdent Int) + _childrenOmainFile :: String + _childrenOmainName :: String + _childrenOnt :: NontermIdent + _childrenOoptions :: Options + _visitsOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _visitsOallInhmap :: (Map NontermIdent Attributes) + _visitsOallInitStates :: (Map NontermIdent Int) + _visitsOallSynmap :: (Map NontermIdent Attributes) + _visitsOallVisitKinds :: (Map VisitIdentifier VisitKind) + _visitsOallchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _visitsOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _visitsOavisituses :: (Map VisitIdentifier (Set Identifier)) + _visitsOchildTypes :: (Map Identifier Type) + _visitsOinhmap :: Attributes + _visitsOnextVisits :: (Map StateIdentifier StateCtx) + _visitsOnt :: NontermIdent + _visitsOoptions :: Options + _visitsOparams :: ([Identifier]) + _visitsOprevVisits :: (Map StateIdentifier StateCtx) + _visitsOsynmap :: Attributes + _rulesIerrors :: (Seq Error) + _rulesImrules :: (Map Identifier (VisitKind -> Either Error PP_Doc)) + _rulesIruledefs :: (Map Identifier (Set String)) + _rulesIruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _rulesIsem_rules :: PP_Doc + _childrenIargnamesw :: ([PP_Doc]) + _childrenIchildTypes :: (Map Identifier Type) + _childrenIchildintros :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _childrenIsigs :: ([(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) + _childrenIterminaldefs :: (Set String) + _visitsIallvisits :: ([VisitStateState]) + _visitsIchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _visitsIerrors :: (Seq Error) + _visitsIfromToStates :: (Map VisitIdentifier (Int,Int)) + _visitsIintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _visitsIlazyIntras :: (Set String) + _visitsIruleKinds :: (Map Identifier (Set VisitKind)) + _visitsIruleUsage :: (Map Identifier Int) + _visitsIsem_visit :: ( [(StateIdentifier,PP_Doc)] ) + _visitsIt_visits :: PP_Doc + _visitsIvisitKinds :: (Map VisitIdentifier VisitKind) + _visitsIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _visitsIvisituses :: (Map VisitIdentifier (Set Identifier)) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 88, column 31) + _childrenOcon = + ({-# LINE 88 "./src-ag/ExecutionPlan2Caml.ag" #-} + con_ + {-# LINE 2397 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 89, column 3) + _rulesOcon = + ({-# LINE 89 "./src-ag/ExecutionPlan2Caml.ag" #-} + con_ + {-# LINE 2403 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 90, column 3) + _visitsOcon = + ({-# LINE 90 "./src-ag/ExecutionPlan2Caml.ag" #-} + con_ + {-# LINE 2409 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 256, column 3) + _o_records = + ({-# LINE 256 "./src-ag/ExecutionPlan2Caml.ag" #-} + dataRecords _lhsIoptions + {-# LINE 2415 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 257, column 3) + _t_params = + ({-# LINE 257 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppTypeParams _lhsIparams + {-# LINE 2421 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 258, column 3) + _t_c_params = + ({-# LINE 258 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppTypeParams (cont_tvar : map pp params_) + {-# LINE 2427 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 259, column 3) + _conname = + ({-# LINE 259 "./src-ag/ExecutionPlan2Caml.ag" #-} + conname _lhsIrename _lhsInt con_ + {-# LINE 2433 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 260, column 3) + _recname = + ({-# LINE 260 "./src-ag/ExecutionPlan2Caml.ag" #-} + pp "fields_" >|< _conname + {-# LINE 2439 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 261, column 3) + _lhsOdatatype = + ({-# LINE 261 "./src-ag/ExecutionPlan2Caml.ag" #-} + "and" >#< _t_params >#< _recname >#< "=" + >#< ppFieldsType _o_records False _childrenIsigs + {-# LINE 2446 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 263, column 3) + _lhsOdatatype_call = + ({-# LINE 263 "./src-ag/ExecutionPlan2Caml.ag" #-} + pp "|" >#< _conname >#< "of" >#< pp_parens (_t_params >#< _recname ) + {-# LINE 2452 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 264, column 3) + _lhsOdatatype_con = + ({-# LINE 264 "./src-ag/ExecutionPlan2Caml.ag" #-} + let funNm = _lhsInt >|< "_" >|< con_ + decl = "and" >#< ppFunDecl _o_sigs funNm params (_t_params >#< _lhsInt) body + params = [ (x, t) | (_,x,_,t) <- _childrenIsigs ] + body = _conname >#< ppFieldsVal _o_records _childrenIsigs + in decl + {-# LINE 2462 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 380, column 32) + _lhsOcount = + ({-# LINE 380 "./src-ag/ExecutionPlan2Caml.ag" #-} + 1 + {-# LINE 2468 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 385, column 3) + _lhsOsem_nt = + ({-# LINE 385 "./src-ag/ExecutionPlan2Caml.ag" #-} + "|" >#< conname _lhsIrename _lhsInt con_ >#< ppFieldsVal _o_records _childrenIsigs >#< "->" >#< + prefix _lhsIoptions >|< _lhsInt >|< "_" >|< con_ >#< ppSpaced _childrenIargnamesw + {-# LINE 2475 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 651, column 3) + _lhsOsemFunBndDefs = + ({-# LINE 651 "./src-ag/ExecutionPlan2Caml.ag" #-} + Seq.singleton _semFunBndDef + {-# LINE 2481 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 652, column 3) + _lhsOsemFunBndTps = + ({-# LINE 652 "./src-ag/ExecutionPlan2Caml.ag" #-} + Seq.singleton _semFunBndTp + {-# LINE 2487 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 653, column 3) + _semFunBndDef = + ({-# LINE 653 "./src-ag/ExecutionPlan2Caml.ag" #-} + _semFunBndNm >#< "=" >#< _semname + {-# LINE 2493 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 654, column 3) + _semFunBndTp = + ({-# LINE 654 "./src-ag/ExecutionPlan2Caml.ag" #-} + _semFunBndNm >#< ":" >#< _sem_tp + {-# LINE 2499 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 655, column 3) + _semFunBndNm = + ({-# LINE 655 "./src-ag/ExecutionPlan2Caml.ag" #-} + lateSemConLabel _lhsInt con_ + {-# LINE 2505 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 682, column 3) + _o_sigs = + ({-# LINE 682 "./src-ag/ExecutionPlan2Caml.ag" #-} + typeSigs _lhsIoptions + {-# LINE 2511 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 683, column 3) + _t_type = + ({-# LINE 683 "./src-ag/ExecutionPlan2Caml.ag" #-} + type_nt_sem_top _lhsInt + {-# LINE 2517 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 684, column 3) + _semname = + ({-# LINE 684 "./src-ag/ExecutionPlan2Caml.ag" #-} + prefix _lhsIoptions >|< _lhsInt >|< "_" >|< con_ + {-# LINE 2523 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 685, column 3) + _sem_res_tp = + ({-# LINE 685 "./src-ag/ExecutionPlan2Caml.ag" #-} + _t_params >#< _t_type + {-# LINE 2529 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 686, column 3) + _sem_tp = + ({-# LINE 686 "./src-ag/ExecutionPlan2Caml.ag" #-} + pp_block "" "" "->" [ d | (_,_,d,_) <- _childrenIsigs ] >#< "->" >#< _sem_res_tp + {-# LINE 2535 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 688, column 3) + _initializer = + ({-# LINE 688 "./src-ag/ExecutionPlan2Caml.ag" #-} + empty + {-# LINE 2541 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 695, column 3) + _sem_prod = + ({-# LINE 695 "./src-ag/ExecutionPlan2Caml.ag" #-} + "and" >#< ppFunDecl _o_sigs _semname [ (x,d) | (_,x,d,_) <- _childrenIsigs ] _sem_res_tp _prod_body + {-# LINE 2547 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 696, column 3) + _prod_body = + ({-# LINE 696 "./src-ag/ExecutionPlan2Caml.ag" #-} + _initializer + >-< "{" >#< nm_attach _lhsInt >#< "=" >#< "function () ->" + >-< indent 2 + ( "(* rules of production" >#< con_ >#< "*)" + >-< _rulesIsem_rules + >-< "(* states of production" >#< con_ >#< "*)" + >-< vlist _statefuns + >-< nm_st _lhsIinitial + ) + >#< "}" + {-# LINE 2562 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 713, column 3) + _statefuns = + ({-# LINE 713 "./src-ag/ExecutionPlan2Caml.ag" #-} + map _genstfn _lhsIallstates + {-# LINE 2568 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 714, column 3) + _genstfn = + ({-# LINE 714 "./src-ag/ExecutionPlan2Caml.ag" #-} + \st -> let nextVisitInfo = Map.findWithDefault ManyVis st _lhsInextVisits + stNm = nm_st st + stDef body = "let" >#< stNm >#< (if st == _lhsIinitial then empty else _stargs st) >#< "=" + >-< indent 2 body >#< "in" + in case nextVisitInfo of + NoneVis -> + if st == _lhsIinitial + then stDef (pp "unit") + else empty + _ -> stDef $ mklets (_stvs st ++ _stks st) $ ppRecordVal + [ nm_invoke _lhsInt st >#< "=" >#< nm_k st ] + {-# LINE 2584 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 734, column 3) + _stargs = + ({-# LINE 734 "./src-ag/ExecutionPlan2Caml.ag" #-} + \st -> let attrs = maybe Map.empty id $ Map.lookup st _visitsIintramap in ppSpaced + [ case mbAttr of + Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs _lhsIoptions) -> + case Map.lookup nm _localAttrTypes of + Just tp -> pp_parens (strNm >#< ":" >#< ppTp tp) + Nothing -> pp strNm + Just attr | not (noPerStateTypeSigs _lhsIoptions) -> + case lookupAttrType attr _lhsIallInhmap _lhsIallSynmap _childTypes of + Just tpDoc -> pp_parens (strNm >#< ":" >#< tpDoc) + Nothing -> pp strNm + _ -> pp strNm + | (strNm, mbAttr) <- Map.assocs attrs + ] >#< dummyPat _lhsIoptions (Map.null attrs) + {-# LINE 2602 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 750, column 3) + _stvisits = + ({-# LINE 750 "./src-ag/ExecutionPlan2Caml.ag" #-} + \st -> filter (\(_,f,_) -> f == st) _visitsIallvisits + {-# LINE 2608 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 751, column 3) + _stks = + ({-# LINE 751 "./src-ag/ExecutionPlan2Caml.ag" #-} + \st -> let stvisits = _stvisits st + def = ppFunDecl False (pp $ nm_k st) + [(pp "arg", _t_c_params >#< type_caller _lhsInt st)] (pp cont_tvar) body + nextVisitInfo = Map.findWithDefault ManyVis st _lhsInextVisits + body = case nextVisitInfo of + NoneVis -> text "?no next visit?" + OneVis v -> dispatch "arg" v + ManyVis -> let alt (v,_,_) = "|" >#< con_visit _lhsInt v >#< "chosen" >#< "->" >-< indent 2 (dispatch "chosen" v) + in "match arg with" >-< (indent 2 $ vlist $ map alt stvisits) + dispatch nm v = "let" >#< ppRecordVal + [ nm_inh _lhsInt v >#< "=" >#< "inp" + , nm_cont _lhsInt v >#< "=" >#< "cont" ] + >#< "=" >#< pp nm + >-< "in" >#< "cont" >#< pp_parens (nm_visit v >#< "inp") + in if null stvisits + then [] + else [ "(* k-function for production" >#< con_ >#< " *)" >-< def ] + {-# LINE 2630 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 773, column 3) + _stvs = + ({-# LINE 773 "./src-ag/ExecutionPlan2Caml.ag" #-} + \st -> [ppf | (f,ppf) <- _visitsIsem_visit, f == st] + {-# LINE 2636 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 774, column 3) + _visitsOmrules = + ({-# LINE 774 "./src-ag/ExecutionPlan2Caml.ag" #-} + _rulesImrules + {-# LINE 2642 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 915, column 3) + _visitsOchildintros = + ({-# LINE 915 "./src-ag/ExecutionPlan2Caml.ag" #-} + _childrenIchildintros + {-# LINE 2648 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1220, column 32) + _rulesOusageInfo = + ({-# LINE 1220 "./src-ag/ExecutionPlan2Caml.ag" #-} + _visitsIruleUsage + {-# LINE 2654 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1235, column 3) + _rulesOruleKinds = + ({-# LINE 1235 "./src-ag/ExecutionPlan2Caml.ag" #-} + _visitsIruleKinds + {-# LINE 2660 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1264, column 3) + _visitsOallintramap = + ({-# LINE 1264 "./src-ag/ExecutionPlan2Caml.ag" #-} + _visitsIintramap + {-# LINE 2666 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1265, column 3) + _visitsOterminaldefs = + ({-# LINE 1265 "./src-ag/ExecutionPlan2Caml.ag" #-} + _childrenIterminaldefs + {-# LINE 2672 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1289, column 17) + _visitsOruledefs = + ({-# LINE 1289 "./src-ag/ExecutionPlan2Caml.ag" #-} + _rulesIruledefs + {-# LINE 2678 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1290, column 17) + _visitsOruleuses = + ({-# LINE 1290 "./src-ag/ExecutionPlan2Caml.ag" #-} + _rulesIruleuses + {-# LINE 2684 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1344, column 3) + _lazyIntras = + ({-# LINE 1344 "./src-ag/ExecutionPlan2Caml.ag" #-} + _visitsIlazyIntras + {-# LINE 2690 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1416, column 3) + _childTypes = + ({-# LINE 1416 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton _LHS _lhsIntType `Map.union` _childrenIchildTypes + {-# LINE 2696 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1433, column 3) + _localAttrTypes = + ({-# LINE 1433 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIlocalAttrTypes + {-# LINE 2702 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1147, column 37) + _lhsOchildvisit = + ({-# LINE 1147 "./src-ag/ExecutionPlan2Caml.ag" #-} + _visitsIchildvisit + {-# LINE 2708 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + _rulesIerrors Seq.>< _visitsIerrors + {-# LINE 2714 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1393, column 22) + _lhsOfromToStates = + ({-# LINE 1393 "./src-ag/ExecutionPlan2Caml.ag" #-} + _visitsIfromToStates + {-# LINE 2720 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 527, column 59) + _lhsOt_visits = + ({-# LINE 527 "./src-ag/ExecutionPlan2Caml.ag" #-} + _visitsIt_visits + {-# LINE 2726 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1440, column 68) + _lhsOvisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _visitsIvisitKinds + {-# LINE 2732 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1296, column 36) + _lhsOvisitdefs = + ({-# LINE 1296 "./src-ag/ExecutionPlan2Caml.ag" #-} + _visitsIvisitdefs + {-# LINE 2738 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1297, column 36) + _lhsOvisituses = + ({-# LINE 1297 "./src-ag/ExecutionPlan2Caml.ag" #-} + _visitsIvisituses + {-# LINE 2744 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (up) + _lhsOallvisits = + ({-# LINE 429 "./src-ag/ExecutionPlan2Caml.ag" #-} + _visitsIallvisits + {-# LINE 2750 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (from local) + _lhsOsem_prod = + ({-# LINE 672 "./src-ag/ExecutionPlan2Caml.ag" #-} + _sem_prod + {-# LINE 2756 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _rulesOallInhmap = + ({-# LINE 412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInhmap + {-# LINE 2762 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _rulesOallSynmap = + ({-# LINE 413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallSynmap + {-# LINE 2768 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (from local) + _rulesOchildTypes = + ({-# LINE 1413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _childTypes + {-# LINE 2774 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _rulesOinhmap = + ({-# LINE 410 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 2780 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (from local) + _rulesOlazyIntras = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lazyIntras + {-# LINE 2786 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (from local) + _rulesOlocalAttrTypes = + ({-# LINE 1427 "./src-ag/ExecutionPlan2Caml.ag" #-} + _localAttrTypes + {-# LINE 2792 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _rulesOmainFile = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainFile + {-# LINE 2798 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _rulesOmainName = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainName + {-# LINE 2804 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _rulesOnt = + ({-# LINE 82 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInt + {-# LINE 2810 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _rulesOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 2816 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _rulesOsynmap = + ({-# LINE 411 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 2822 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _childrenOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 2828 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _childrenOmainFile = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainFile + {-# LINE 2834 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _childrenOmainName = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainName + {-# LINE 2840 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _childrenOnt = + ({-# LINE 82 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInt + {-# LINE 2846 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _childrenOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 2852 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _visitsOallFromToStates = + ({-# LINE 1396 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallFromToStates + {-# LINE 2858 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _visitsOallInhmap = + ({-# LINE 412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInhmap + {-# LINE 2864 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _visitsOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 2870 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _visitsOallSynmap = + ({-# LINE 413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallSynmap + {-# LINE 2876 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _visitsOallVisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallVisitKinds + {-# LINE 2882 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _visitsOallchildvisit = + ({-# LINE 1146 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallchildvisit + {-# LINE 2888 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _visitsOavisitdefs = + ({-# LINE 1306 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisitdefs + {-# LINE 2894 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _visitsOavisituses = + ({-# LINE 1307 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisituses + {-# LINE 2900 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (from local) + _visitsOchildTypes = + ({-# LINE 1413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _childTypes + {-# LINE 2906 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _visitsOinhmap = + ({-# LINE 410 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 2912 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _visitsOnextVisits = + ({-# LINE 1382 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInextVisits + {-# LINE 2918 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _visitsOnt = + ({-# LINE 82 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInt + {-# LINE 2924 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _visitsOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 2930 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _visitsOparams = + ({-# LINE 92 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIparams + {-# LINE 2936 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _visitsOprevVisits = + ({-# LINE 1382 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIprevVisits + {-# LINE 2942 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _visitsOsynmap = + ({-# LINE 411 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 2948 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _rulesIerrors,_rulesImrules,_rulesIruledefs,_rulesIruleuses,_rulesIsem_rules) = + rules_ _rulesOallInhmap _rulesOallSynmap _rulesOchildTypes _rulesOcon _rulesOinhmap _rulesOlazyIntras _rulesOlocalAttrTypes _rulesOmainFile _rulesOmainName _rulesOnt _rulesOoptions _rulesOruleKinds _rulesOsynmap _rulesOusageInfo + ( _childrenIargnamesw,_childrenIchildTypes,_childrenIchildintros,_childrenIsigs,_childrenIterminaldefs) = + children_ _childrenOallInitStates _childrenOcon _childrenOmainFile _childrenOmainName _childrenOnt _childrenOoptions + ( _visitsIallvisits,_visitsIchildvisit,_visitsIerrors,_visitsIfromToStates,_visitsIintramap,_visitsIlazyIntras,_visitsIruleKinds,_visitsIruleUsage,_visitsIsem_visit,_visitsIt_visits,_visitsIvisitKinds,_visitsIvisitdefs,_visitsIvisituses) = + visits_ _visitsOallFromToStates _visitsOallInhmap _visitsOallInitStates _visitsOallSynmap _visitsOallVisitKinds _visitsOallchildvisit _visitsOallintramap _visitsOavisitdefs _visitsOavisituses _visitsOchildTypes _visitsOchildintros _visitsOcon _visitsOinhmap _visitsOmrules _visitsOnextVisits _visitsOnt _visitsOoptions _visitsOparams _visitsOprevVisits _visitsOruledefs _visitsOruleuses _visitsOsynmap _visitsOterminaldefs + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOcount,_lhsOdatatype,_lhsOdatatype_call,_lhsOdatatype_con,_lhsOerrors,_lhsOfromToStates,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +-- EProductions ------------------------------------------------ +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInhmap : Map NontermIdent Attributes + allInitStates : Map NontermIdent Int + allSynmap : Map NontermIdent Attributes + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) + allstates : [StateIdentifier] + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + inhmap : Attributes + initial : StateIdentifier + localAttrTypes : Map ConstructorIdent (Map Identifier Type) + mainFile : String + mainName : String + nextVisits : Map StateIdentifier StateCtx + nt : NontermIdent + ntType : Type + options : Options + params : [Identifier] + prevVisits : Map StateIdentifier StateCtx + rename : Bool + synmap : Attributes + synthesized attributes: + allvisits : [VisitStateState] + childvisit : Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) + count : Int + datatype : [PP_Doc] + datatype_call : [PP_Doc] + datatype_con : [PP_Doc] + errors : Seq Error + fromToStates : Map VisitIdentifier (Int,Int) + semFunBndDefs : Seq PP_Doc + semFunBndTps : Seq PP_Doc + sem_nt : PP_Doc + sem_prod : PP_Doc + t_visits : PP_Doc + visitKinds : Map VisitIdentifier VisitKind + visitdefs : Map VisitIdentifier (Set Identifier) + visituses : Map VisitIdentifier (Set Identifier) + alternatives: + alternative Cons: + child hd : EProduction + child tl : EProductions + alternative Nil: +-} +-- cata +sem_EProductions :: EProductions -> + T_EProductions +sem_EProductions list = + (Prelude.foldr sem_EProductions_Cons sem_EProductions_Nil (Prelude.map sem_EProduction list)) +-- semantic domain +newtype T_EProductions = T_EProductions ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Attributes) -> + (Map NontermIdent Int) -> + (Map NontermIdent Attributes) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> + ([StateIdentifier]) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + Attributes -> + StateIdentifier -> + (Map ConstructorIdent (Map Identifier Type)) -> + String -> + String -> + (Map StateIdentifier StateCtx) -> + NontermIdent -> + Type -> + Options -> + ([Identifier]) -> + (Map StateIdentifier StateCtx) -> + Bool -> + Attributes -> + ( ([VisitStateState]),(Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),Int,([PP_Doc]),([PP_Doc]),([PP_Doc]),(Seq Error),(Map VisitIdentifier (Int,Int)),(Seq PP_Doc),(Seq PP_Doc),PP_Doc,PP_Doc,PP_Doc,(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier)))) +data Inh_EProductions = Inh_EProductions {allFromToStates_Inh_EProductions :: (Map VisitIdentifier (Int,Int)),allInhmap_Inh_EProductions :: (Map NontermIdent Attributes),allInitStates_Inh_EProductions :: (Map NontermIdent Int),allSynmap_Inh_EProductions :: (Map NontermIdent Attributes),allVisitKinds_Inh_EProductions :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_EProductions :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),allstates_Inh_EProductions :: ([StateIdentifier]),avisitdefs_Inh_EProductions :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_EProductions :: (Map VisitIdentifier (Set Identifier)),inhmap_Inh_EProductions :: Attributes,initial_Inh_EProductions :: StateIdentifier,localAttrTypes_Inh_EProductions :: (Map ConstructorIdent (Map Identifier Type)),mainFile_Inh_EProductions :: String,mainName_Inh_EProductions :: String,nextVisits_Inh_EProductions :: (Map StateIdentifier StateCtx),nt_Inh_EProductions :: NontermIdent,ntType_Inh_EProductions :: Type,options_Inh_EProductions :: Options,params_Inh_EProductions :: ([Identifier]),prevVisits_Inh_EProductions :: (Map StateIdentifier StateCtx),rename_Inh_EProductions :: Bool,synmap_Inh_EProductions :: Attributes} +data Syn_EProductions = Syn_EProductions {allvisits_Syn_EProductions :: ([VisitStateState]),childvisit_Syn_EProductions :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),count_Syn_EProductions :: Int,datatype_Syn_EProductions :: ([PP_Doc]),datatype_call_Syn_EProductions :: ([PP_Doc]),datatype_con_Syn_EProductions :: ([PP_Doc]),errors_Syn_EProductions :: (Seq Error),fromToStates_Syn_EProductions :: (Map VisitIdentifier (Int,Int)),semFunBndDefs_Syn_EProductions :: (Seq PP_Doc),semFunBndTps_Syn_EProductions :: (Seq PP_Doc),sem_nt_Syn_EProductions :: PP_Doc,sem_prod_Syn_EProductions :: PP_Doc,t_visits_Syn_EProductions :: PP_Doc,visitKinds_Syn_EProductions :: (Map VisitIdentifier VisitKind),visitdefs_Syn_EProductions :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_EProductions :: (Map VisitIdentifier (Set Identifier))} +wrap_EProductions :: T_EProductions -> + Inh_EProductions -> + Syn_EProductions +wrap_EProductions (T_EProductions sem) (Inh_EProductions _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOcount,_lhsOdatatype,_lhsOdatatype_call,_lhsOdatatype_con,_lhsOerrors,_lhsOfromToStates,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap + in (Syn_EProductions _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOdatatype_call _lhsOdatatype_con _lhsOerrors _lhsOfromToStates _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses)) +sem_EProductions_Cons :: T_EProduction -> + T_EProductions -> + T_EProductions +sem_EProductions_Cons (T_EProduction hd_) (T_EProductions tl_) = + (T_EProductions (\ _lhsIallFromToStates + _lhsIallInhmap + _lhsIallInitStates + _lhsIallSynmap + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIallstates + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIinitial + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsInextVisits + _lhsInt + _lhsIntType + _lhsIoptions + _lhsIparams + _lhsIprevVisits + _lhsIrename + _lhsIsynmap -> + (let _lhsOallvisits :: ([VisitStateState]) + _lhsOt_visits :: PP_Doc + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _lhsOcount :: Int + _lhsOdatatype :: ([PP_Doc]) + _lhsOdatatype_call :: ([PP_Doc]) + _lhsOdatatype_con :: ([PP_Doc]) + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOsemFunBndDefs :: (Seq PP_Doc) + _lhsOsemFunBndTps :: (Seq PP_Doc) + _lhsOsem_nt :: PP_Doc + _lhsOsem_prod :: PP_Doc + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + _hdOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _hdOallInhmap :: (Map NontermIdent Attributes) + _hdOallInitStates :: (Map NontermIdent Int) + _hdOallSynmap :: (Map NontermIdent Attributes) + _hdOallVisitKinds :: (Map VisitIdentifier VisitKind) + _hdOallchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _hdOallstates :: ([StateIdentifier]) + _hdOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _hdOavisituses :: (Map VisitIdentifier (Set Identifier)) + _hdOinhmap :: Attributes + _hdOinitial :: StateIdentifier + _hdOlocalAttrTypes :: (Map ConstructorIdent (Map Identifier Type)) + _hdOmainFile :: String + _hdOmainName :: String + _hdOnextVisits :: (Map StateIdentifier StateCtx) + _hdOnt :: NontermIdent + _hdOntType :: Type + _hdOoptions :: Options + _hdOparams :: ([Identifier]) + _hdOprevVisits :: (Map StateIdentifier StateCtx) + _hdOrename :: Bool + _hdOsynmap :: Attributes + _tlOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _tlOallInhmap :: (Map NontermIdent Attributes) + _tlOallInitStates :: (Map NontermIdent Int) + _tlOallSynmap :: (Map NontermIdent Attributes) + _tlOallVisitKinds :: (Map VisitIdentifier VisitKind) + _tlOallchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _tlOallstates :: ([StateIdentifier]) + _tlOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _tlOavisituses :: (Map VisitIdentifier (Set Identifier)) + _tlOinhmap :: Attributes + _tlOinitial :: StateIdentifier + _tlOlocalAttrTypes :: (Map ConstructorIdent (Map Identifier Type)) + _tlOmainFile :: String + _tlOmainName :: String + _tlOnextVisits :: (Map StateIdentifier StateCtx) + _tlOnt :: NontermIdent + _tlOntType :: Type + _tlOoptions :: Options + _tlOparams :: ([Identifier]) + _tlOprevVisits :: (Map StateIdentifier StateCtx) + _tlOrename :: Bool + _tlOsynmap :: Attributes + _hdIallvisits :: ([VisitStateState]) + _hdIchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _hdIcount :: Int + _hdIdatatype :: PP_Doc + _hdIdatatype_call :: PP_Doc + _hdIdatatype_con :: PP_Doc + _hdIerrors :: (Seq Error) + _hdIfromToStates :: (Map VisitIdentifier (Int,Int)) + _hdIsemFunBndDefs :: (Seq PP_Doc) + _hdIsemFunBndTps :: (Seq PP_Doc) + _hdIsem_nt :: PP_Doc + _hdIsem_prod :: PP_Doc + _hdIt_visits :: PP_Doc + _hdIvisitKinds :: (Map VisitIdentifier VisitKind) + _hdIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _hdIvisituses :: (Map VisitIdentifier (Set Identifier)) + _tlIallvisits :: ([VisitStateState]) + _tlIchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _tlIcount :: Int + _tlIdatatype :: ([PP_Doc]) + _tlIdatatype_call :: ([PP_Doc]) + _tlIdatatype_con :: ([PP_Doc]) + _tlIerrors :: (Seq Error) + _tlIfromToStates :: (Map VisitIdentifier (Int,Int)) + _tlIsemFunBndDefs :: (Seq PP_Doc) + _tlIsemFunBndTps :: (Seq PP_Doc) + _tlIsem_nt :: PP_Doc + _tlIsem_prod :: PP_Doc + _tlIt_visits :: PP_Doc + _tlIvisitKinds :: (Map VisitIdentifier VisitKind) + _tlIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _tlIvisituses :: (Map VisitIdentifier (Set Identifier)) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 435, column 10) + _lhsOallvisits = + ({-# LINE 435 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIallvisits + {-# LINE 3165 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 530, column 3) + _lhsOt_visits = + ({-# LINE 530 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIt_visits + {-# LINE 3171 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1147, column 37) + _lhsOchildvisit = + ({-# LINE 1147 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIchildvisit `Map.union` _tlIchildvisit + {-# LINE 3177 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 379, column 43) + _lhsOcount = + ({-# LINE 379 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIcount + _tlIcount + {-# LINE 3183 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 253, column 63) + _lhsOdatatype = + ({-# LINE 253 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIdatatype : _tlIdatatype + {-# LINE 3189 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 253, column 63) + _lhsOdatatype_call = + ({-# LINE 253 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIdatatype_call : _tlIdatatype_call + {-# LINE 3195 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 253, column 63) + _lhsOdatatype_con = + ({-# LINE 253 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIdatatype_con : _tlIdatatype_con + {-# LINE 3201 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 3207 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1393, column 22) + _lhsOfromToStates = + ({-# LINE 1393 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIfromToStates `mappend` _tlIfromToStates + {-# LINE 3213 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 642, column 92) + _lhsOsemFunBndDefs = + ({-# LINE 642 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIsemFunBndDefs Seq.>< _tlIsemFunBndDefs + {-# LINE 3219 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 642, column 92) + _lhsOsemFunBndTps = + ({-# LINE 642 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIsemFunBndTps Seq.>< _tlIsemFunBndTps + {-# LINE 3225 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 383, column 44) + _lhsOsem_nt = + ({-# LINE 383 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIsem_nt >-< _tlIsem_nt + {-# LINE 3231 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 673, column 34) + _lhsOsem_prod = + ({-# LINE 673 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIsem_prod >-< _tlIsem_prod + {-# LINE 3237 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1440, column 68) + _lhsOvisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIvisitKinds `mappend` _tlIvisitKinds + {-# LINE 3243 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1296, column 36) + _lhsOvisitdefs = + ({-# LINE 1296 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIvisitdefs `uwSetUnion` _tlIvisitdefs + {-# LINE 3249 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1297, column 36) + _lhsOvisituses = + ({-# LINE 1297 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIvisituses `uwSetUnion` _tlIvisituses + {-# LINE 3255 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallFromToStates = + ({-# LINE 1396 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallFromToStates + {-# LINE 3261 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallInhmap = + ({-# LINE 412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInhmap + {-# LINE 3267 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 3273 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallSynmap = + ({-# LINE 413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallSynmap + {-# LINE 3279 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallVisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallVisitKinds + {-# LINE 3285 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 1146 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallchildvisit + {-# LINE 3291 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallstates = + ({-# LINE 676 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallstates + {-# LINE 3297 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 1306 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisitdefs + {-# LINE 3303 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 1307 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisituses + {-# LINE 3309 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 410 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 3315 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOinitial = + ({-# LINE 675 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinitial + {-# LINE 3321 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOlocalAttrTypes = + ({-# LINE 1426 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 3327 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOmainFile = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainFile + {-# LINE 3333 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOmainName = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainName + {-# LINE 3339 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOnextVisits = + ({-# LINE 1382 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInextVisits + {-# LINE 3345 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 82 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInt + {-# LINE 3351 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOntType = + ({-# LINE 1469 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIntType + {-# LINE 3357 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 3363 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOparams = + ({-# LINE 92 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIparams + {-# LINE 3369 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOprevVisits = + ({-# LINE 1382 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIprevVisits + {-# LINE 3375 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOrename = + ({-# LINE 73 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIrename + {-# LINE 3381 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 411 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 3387 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallFromToStates = + ({-# LINE 1396 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallFromToStates + {-# LINE 3393 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallInhmap = + ({-# LINE 412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInhmap + {-# LINE 3399 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 3405 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallSynmap = + ({-# LINE 413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallSynmap + {-# LINE 3411 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallVisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallVisitKinds + {-# LINE 3417 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 1146 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallchildvisit + {-# LINE 3423 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallstates = + ({-# LINE 676 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallstates + {-# LINE 3429 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 1306 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisitdefs + {-# LINE 3435 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 1307 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisituses + {-# LINE 3441 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 410 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 3447 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOinitial = + ({-# LINE 675 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinitial + {-# LINE 3453 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOlocalAttrTypes = + ({-# LINE 1426 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 3459 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOmainFile = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainFile + {-# LINE 3465 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOmainName = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainName + {-# LINE 3471 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOnextVisits = + ({-# LINE 1382 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInextVisits + {-# LINE 3477 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 82 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInt + {-# LINE 3483 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOntType = + ({-# LINE 1469 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIntType + {-# LINE 3489 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 3495 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOparams = + ({-# LINE 92 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIparams + {-# LINE 3501 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOprevVisits = + ({-# LINE 1382 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIprevVisits + {-# LINE 3507 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOrename = + ({-# LINE 73 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIrename + {-# LINE 3513 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 411 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 3519 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _hdIallvisits,_hdIchildvisit,_hdIcount,_hdIdatatype,_hdIdatatype_call,_hdIdatatype_con,_hdIerrors,_hdIfromToStates,_hdIsemFunBndDefs,_hdIsemFunBndTps,_hdIsem_nt,_hdIsem_prod,_hdIt_visits,_hdIvisitKinds,_hdIvisitdefs,_hdIvisituses) = + hd_ _hdOallFromToStates _hdOallInhmap _hdOallInitStates _hdOallSynmap _hdOallVisitKinds _hdOallchildvisit _hdOallstates _hdOavisitdefs _hdOavisituses _hdOinhmap _hdOinitial _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOnextVisits _hdOnt _hdOntType _hdOoptions _hdOparams _hdOprevVisits _hdOrename _hdOsynmap + ( _tlIallvisits,_tlIchildvisit,_tlIcount,_tlIdatatype,_tlIdatatype_call,_tlIdatatype_con,_tlIerrors,_tlIfromToStates,_tlIsemFunBndDefs,_tlIsemFunBndTps,_tlIsem_nt,_tlIsem_prod,_tlIt_visits,_tlIvisitKinds,_tlIvisitdefs,_tlIvisituses) = + tl_ _tlOallFromToStates _tlOallInhmap _tlOallInitStates _tlOallSynmap _tlOallVisitKinds _tlOallchildvisit _tlOallstates _tlOavisitdefs _tlOavisituses _tlOinhmap _tlOinitial _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOnextVisits _tlOnt _tlOntType _tlOoptions _tlOparams _tlOprevVisits _tlOrename _tlOsynmap + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOcount,_lhsOdatatype,_lhsOdatatype_call,_lhsOdatatype_con,_lhsOerrors,_lhsOfromToStates,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +sem_EProductions_Nil :: T_EProductions +sem_EProductions_Nil = + (T_EProductions (\ _lhsIallFromToStates + _lhsIallInhmap + _lhsIallInitStates + _lhsIallSynmap + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIallstates + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIinitial + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsInextVisits + _lhsInt + _lhsIntType + _lhsIoptions + _lhsIparams + _lhsIprevVisits + _lhsIrename + _lhsIsynmap -> + (let _lhsOallvisits :: ([VisitStateState]) + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _lhsOcount :: Int + _lhsOdatatype :: ([PP_Doc]) + _lhsOdatatype_call :: ([PP_Doc]) + _lhsOdatatype_con :: ([PP_Doc]) + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOsemFunBndDefs :: (Seq PP_Doc) + _lhsOsemFunBndTps :: (Seq PP_Doc) + _lhsOsem_nt :: PP_Doc + _lhsOsem_prod :: PP_Doc + _lhsOt_visits :: PP_Doc + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 436, column 10) + _lhsOallvisits = + ({-# LINE 436 "./src-ag/ExecutionPlan2Caml.ag" #-} + error "Every nonterminal should have at least 1 production" + {-# LINE 3570 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1147, column 37) + _lhsOchildvisit = + ({-# LINE 1147 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 3576 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 379, column 43) + _lhsOcount = + ({-# LINE 379 "./src-ag/ExecutionPlan2Caml.ag" #-} + 0 + {-# LINE 3582 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 253, column 63) + _lhsOdatatype = + ({-# LINE 253 "./src-ag/ExecutionPlan2Caml.ag" #-} + [] + {-# LINE 3588 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 253, column 63) + _lhsOdatatype_call = + ({-# LINE 253 "./src-ag/ExecutionPlan2Caml.ag" #-} + [] + {-# LINE 3594 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 253, column 63) + _lhsOdatatype_con = + ({-# LINE 253 "./src-ag/ExecutionPlan2Caml.ag" #-} + [] + {-# LINE 3600 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + Seq.empty + {-# LINE 3606 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1393, column 22) + _lhsOfromToStates = + ({-# LINE 1393 "./src-ag/ExecutionPlan2Caml.ag" #-} + mempty + {-# LINE 3612 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 642, column 92) + _lhsOsemFunBndDefs = + ({-# LINE 642 "./src-ag/ExecutionPlan2Caml.ag" #-} + Seq.empty + {-# LINE 3618 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 642, column 92) + _lhsOsemFunBndTps = + ({-# LINE 642 "./src-ag/ExecutionPlan2Caml.ag" #-} + Seq.empty + {-# LINE 3624 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 383, column 44) + _lhsOsem_nt = + ({-# LINE 383 "./src-ag/ExecutionPlan2Caml.ag" #-} + empty + {-# LINE 3630 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 673, column 34) + _lhsOsem_prod = + ({-# LINE 673 "./src-ag/ExecutionPlan2Caml.ag" #-} + empty + {-# LINE 3636 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 527, column 59) + _lhsOt_visits = + ({-# LINE 527 "./src-ag/ExecutionPlan2Caml.ag" #-} + empty + {-# LINE 3642 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1440, column 68) + _lhsOvisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + mempty + {-# LINE 3648 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1296, column 36) + _lhsOvisitdefs = + ({-# LINE 1296 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 3654 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1297, column 36) + _lhsOvisituses = + ({-# LINE 1297 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 3660 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOcount,_lhsOdatatype,_lhsOdatatype_call,_lhsOdatatype_con,_lhsOerrors,_lhsOfromToStates,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +-- ERule ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allInhmap : Map NontermIdent Attributes + allSynmap : Map NontermIdent Attributes + childTypes : Map Identifier Type + con : ConstructorIdent + inhmap : Attributes + lazyIntras : Set String + localAttrTypes : Map Identifier Type + mainFile : String + mainName : String + nt : NontermIdent + options : Options + ruleKinds : Map Identifier (Set VisitKind) + synmap : Attributes + usageInfo : Map Identifier Int + synthesized attributes: + errors : Seq Error + mrules : Map Identifier (VisitKind -> Either Error PP_Doc) + ruledefs : Map Identifier (Set String) + ruleuses : Map Identifier (Map String (Maybe NonLocalAttr)) + sem_rules : PP_Doc + alternatives: + alternative ERule: + child name : {Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + child pure : {Bool} + child mbError : {Maybe Error} + visit 0: + local rulecode : _ + local pragma : _ + local endpragma : _ + local genpragma : _ + local haspos : _ + local declHead : _ + local argPats : _ + local argExprs : _ + local stepcode : _ + local used : _ + local kinds : _ + local anyLazyKind : _ +-} +-- cata +sem_ERule :: ERule -> + T_ERule +sem_ERule (ERule _name _pattern _rhs _owrt _origin _explicit _pure _mbError) = + (sem_ERule_ERule _name (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin _explicit _pure _mbError) +-- semantic domain +newtype T_ERule = T_ERule ((Map NontermIdent Attributes) -> + (Map NontermIdent Attributes) -> + (Map Identifier Type) -> + ConstructorIdent -> + Attributes -> + (Set String) -> + (Map Identifier Type) -> + String -> + String -> + NontermIdent -> + Options -> + (Map Identifier (Set VisitKind)) -> + Attributes -> + (Map Identifier Int) -> + ( (Seq Error),(Map Identifier (VisitKind -> Either Error PP_Doc)),(Map Identifier (Set String)),(Map Identifier (Map String (Maybe NonLocalAttr))),PP_Doc)) +data Inh_ERule = Inh_ERule {allInhmap_Inh_ERule :: (Map NontermIdent Attributes),allSynmap_Inh_ERule :: (Map NontermIdent Attributes),childTypes_Inh_ERule :: (Map Identifier Type),con_Inh_ERule :: ConstructorIdent,inhmap_Inh_ERule :: Attributes,lazyIntras_Inh_ERule :: (Set String),localAttrTypes_Inh_ERule :: (Map Identifier Type),mainFile_Inh_ERule :: String,mainName_Inh_ERule :: String,nt_Inh_ERule :: NontermIdent,options_Inh_ERule :: Options,ruleKinds_Inh_ERule :: (Map Identifier (Set VisitKind)),synmap_Inh_ERule :: Attributes,usageInfo_Inh_ERule :: (Map Identifier Int)} +data Syn_ERule = Syn_ERule {errors_Syn_ERule :: (Seq Error),mrules_Syn_ERule :: (Map Identifier (VisitKind -> Either Error PP_Doc)),ruledefs_Syn_ERule :: (Map Identifier (Set String)),ruleuses_Syn_ERule :: (Map Identifier (Map String (Maybe NonLocalAttr))),sem_rules_Syn_ERule :: PP_Doc} +wrap_ERule :: T_ERule -> + Inh_ERule -> + Syn_ERule +wrap_ERule (T_ERule sem) (Inh_ERule _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsIusageInfo) = + (let ( _lhsOerrors,_lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules) = sem _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsIusageInfo + in (Syn_ERule _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules)) +sem_ERule_ERule :: Identifier -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + Bool -> + (Maybe Error) -> + T_ERule +sem_ERule_ERule name_ (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ explicit_ pure_ mbError_ = + (T_ERule (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIchildTypes + _lhsIcon + _lhsIinhmap + _lhsIlazyIntras + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsInt + _lhsIoptions + _lhsIruleKinds + _lhsIsynmap + _lhsIusageInfo -> + (let _lhsOsem_rules :: PP_Doc + _lhsOmrules :: (Map Identifier (VisitKind -> Either Error PP_Doc)) + _lhsOruledefs :: (Map Identifier (Set String)) + _lhsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _lhsOerrors :: (Seq Error) + _patternOallInhmap :: (Map NontermIdent Attributes) + _patternOallSynmap :: (Map NontermIdent Attributes) + _patternOanyLazyKind :: Bool + _patternOinhmap :: Attributes + _patternOlocalAttrTypes :: (Map Identifier Type) + _patternOoptions :: Options + _patternOsynmap :: Attributes + _patternIattrTypes :: PP_Doc + _patternIattrs :: (Set String) + _patternIcopy :: Pattern + _patternIextraDefs :: ([(PP_Doc,PP_Doc)]) + _patternIisUnderscore :: Bool + _patternIsem_lhs :: ( PP_Doc ) + _rhsIattrs :: (Map String (Maybe NonLocalAttr)) + _rhsIpos :: Pos + _rhsIsemfunc :: PP_Doc + _rhsItks :: ([HsToken]) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 973, column 6) + _lhsOsem_rules = + ({-# LINE 973 "./src-ag/ExecutionPlan2Caml.ag" #-} + if _used == 0 + then empty + else _rulecode + {-# LINE 3792 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 976, column 6) + _rulecode = + ({-# LINE 976 "./src-ag/ExecutionPlan2Caml.ag" #-} + ( if _genpragma + then _pragma + else empty + ) + >-< _declHead + >-< indent ((column _rhsIpos - 2) `max` 2) + ( if _genpragma + then _pragma >-< _rhsIsemfunc >-< _endpragma + else _rhsIsemfunc + ) + >#< "in" + {-# LINE 3808 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 989, column 7) + _pragma = + ({-# LINE 989 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppLinePragma _lhsIoptions (line _rhsIpos) (file _rhsIpos) + {-# LINE 3814 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 990, column 7) + _endpragma = + ({-# LINE 990 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppWithLineNr (\ln -> ppLinePragma _lhsIoptions (ln+1) _lhsImainFile) + {-# LINE 3820 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 991, column 7) + _genpragma = + ({-# LINE 991 "./src-ag/ExecutionPlan2Caml.ag" #-} + genLinePragmas _lhsIoptions && explicit_ && _haspos + {-# LINE 3826 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 992, column 7) + _haspos = + ({-# LINE 992 "./src-ag/ExecutionPlan2Caml.ag" #-} + line _rhsIpos > 0 && column _rhsIpos >= 0 && not (null (file _rhsIpos)) + {-# LINE 3832 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 996, column 7) + _declHead = + ({-# LINE 996 "./src-ag/ExecutionPlan2Caml.ag" #-} + "let" >#< name_ >#< _argPats >#< dummyPat _lhsIoptions (Map.null _rhsIattrs) >#< "=" + {-# LINE 3838 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 997, column 7) + _argPats = + ({-# LINE 997 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppSpaced + [ case mbAttr of + Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs _lhsIoptions) -> + case Map.lookup nm _lhsIlocalAttrTypes of + Just tp -> pp_parens (strNm >#< ":" >#< ppTp tp) + Nothing -> pp strNm + Just attr | not (noPerStateTypeSigs _lhsIoptions) -> + case lookupAttrType attr _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes of + Just tpDoc -> pp_parens (strNm >#< ":" >#< tpDoc) + Nothing -> pp strNm + _ -> pp strNm + | (strNm, mbAttr) <- Map.assocs _rhsIattrs + ] + {-# LINE 3856 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1012, column 7) + _argExprs = + ({-# LINE 1012 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppSpaced $ Map.keys _rhsIattrs + {-# LINE 3862 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1013, column 7) + _stepcode = + ({-# LINE 1013 "./src-ag/ExecutionPlan2Caml.ag" #-} + \kind -> + let mkBind (pat,expr) = "let" >#< pat >#< "=" >#< expr >#< "in" + in if kind `compatibleRule` pure_ + then Right $ mkBind (_patternIsem_lhs, name_ >#< _argExprs >#< dummyArg _lhsIoptions (Map.null _rhsIattrs)) + >-< vlist (map mkBind _patternIextraDefs) + else Left $ IncompatibleRuleKind name_ kind + {-# LINE 3873 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1020, column 7) + _lhsOmrules = + ({-# LINE 1020 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton name_ _stepcode + {-# LINE 3879 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1222, column 32) + _used = + ({-# LINE 1222 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.findWithDefault 0 name_ _lhsIusageInfo + {-# LINE 3885 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1238, column 3) + _kinds = + ({-# LINE 1238 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.findWithDefault Set.empty name_ _lhsIruleKinds + {-# LINE 3891 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1239, column 3) + _anyLazyKind = + ({-# LINE 1239 "./src-ag/ExecutionPlan2Caml.ag" #-} + Set.fold (\k r -> isLazyKind k || r) False _kinds + {-# LINE 3897 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1285, column 11) + _lhsOruledefs = + ({-# LINE 1285 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton name_ _patternIattrs + {-# LINE 3903 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1286, column 11) + _lhsOruleuses = + ({-# LINE 1286 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton name_ _rhsIattrs + {-# LINE 3909 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1480, column 3) + _lhsOerrors = + ({-# LINE 1480 "./src-ag/ExecutionPlan2Caml.ag" #-} + case mbError_ of + Just e | _used > 0 -> Seq.singleton e + _ -> Seq.empty + {-# LINE 3917 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patternOallInhmap = + ({-# LINE 412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInhmap + {-# LINE 3923 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patternOallSynmap = + ({-# LINE 413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallSynmap + {-# LINE 3929 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (from local) + _patternOanyLazyKind = + ({-# LINE 1241 "./src-ag/ExecutionPlan2Caml.ag" #-} + _anyLazyKind + {-# LINE 3935 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patternOinhmap = + ({-# LINE 410 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 3941 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patternOlocalAttrTypes = + ({-# LINE 1427 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 3947 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patternOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 3953 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patternOsynmap = + ({-# LINE 411 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 3959 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _patternIattrTypes,_patternIattrs,_patternIcopy,_patternIextraDefs,_patternIisUnderscore,_patternIsem_lhs) = + pattern_ _patternOallInhmap _patternOallSynmap _patternOanyLazyKind _patternOinhmap _patternOlocalAttrTypes _patternOoptions _patternOsynmap + ( _rhsIattrs,_rhsIpos,_rhsIsemfunc,_rhsItks) = + rhs_ + in ( _lhsOerrors,_lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules)))) +-- ERules ------------------------------------------------------ +{- + visit 0: + inherited attributes: + allInhmap : Map NontermIdent Attributes + allSynmap : Map NontermIdent Attributes + childTypes : Map Identifier Type + con : ConstructorIdent + inhmap : Attributes + lazyIntras : Set String + localAttrTypes : Map Identifier Type + mainFile : String + mainName : String + nt : NontermIdent + options : Options + ruleKinds : Map Identifier (Set VisitKind) + synmap : Attributes + usageInfo : Map Identifier Int + synthesized attributes: + errors : Seq Error + mrules : Map Identifier (VisitKind -> Either Error PP_Doc) + ruledefs : Map Identifier (Set String) + ruleuses : Map Identifier (Map String (Maybe NonLocalAttr)) + sem_rules : PP_Doc + alternatives: + alternative Cons: + child hd : ERule + child tl : ERules + alternative Nil: +-} +-- cata +sem_ERules :: ERules -> + T_ERules +sem_ERules list = + (Prelude.foldr sem_ERules_Cons sem_ERules_Nil (Prelude.map sem_ERule list)) +-- semantic domain +newtype T_ERules = T_ERules ((Map NontermIdent Attributes) -> + (Map NontermIdent Attributes) -> + (Map Identifier Type) -> + ConstructorIdent -> + Attributes -> + (Set String) -> + (Map Identifier Type) -> + String -> + String -> + NontermIdent -> + Options -> + (Map Identifier (Set VisitKind)) -> + Attributes -> + (Map Identifier Int) -> + ( (Seq Error),(Map Identifier (VisitKind -> Either Error PP_Doc)),(Map Identifier (Set String)),(Map Identifier (Map String (Maybe NonLocalAttr))),PP_Doc)) +data Inh_ERules = Inh_ERules {allInhmap_Inh_ERules :: (Map NontermIdent Attributes),allSynmap_Inh_ERules :: (Map NontermIdent Attributes),childTypes_Inh_ERules :: (Map Identifier Type),con_Inh_ERules :: ConstructorIdent,inhmap_Inh_ERules :: Attributes,lazyIntras_Inh_ERules :: (Set String),localAttrTypes_Inh_ERules :: (Map Identifier Type),mainFile_Inh_ERules :: String,mainName_Inh_ERules :: String,nt_Inh_ERules :: NontermIdent,options_Inh_ERules :: Options,ruleKinds_Inh_ERules :: (Map Identifier (Set VisitKind)),synmap_Inh_ERules :: Attributes,usageInfo_Inh_ERules :: (Map Identifier Int)} +data Syn_ERules = Syn_ERules {errors_Syn_ERules :: (Seq Error),mrules_Syn_ERules :: (Map Identifier (VisitKind -> Either Error PP_Doc)),ruledefs_Syn_ERules :: (Map Identifier (Set String)),ruleuses_Syn_ERules :: (Map Identifier (Map String (Maybe NonLocalAttr))),sem_rules_Syn_ERules :: PP_Doc} +wrap_ERules :: T_ERules -> + Inh_ERules -> + Syn_ERules +wrap_ERules (T_ERules sem) (Inh_ERules _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsIusageInfo) = + (let ( _lhsOerrors,_lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules) = sem _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsIusageInfo + in (Syn_ERules _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules)) +sem_ERules_Cons :: T_ERule -> + T_ERules -> + T_ERules +sem_ERules_Cons (T_ERule hd_) (T_ERules tl_) = + (T_ERules (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIchildTypes + _lhsIcon + _lhsIinhmap + _lhsIlazyIntras + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsInt + _lhsIoptions + _lhsIruleKinds + _lhsIsynmap + _lhsIusageInfo -> + (let _lhsOerrors :: (Seq Error) + _lhsOmrules :: (Map Identifier (VisitKind -> Either Error PP_Doc)) + _lhsOruledefs :: (Map Identifier (Set String)) + _lhsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _lhsOsem_rules :: PP_Doc + _hdOallInhmap :: (Map NontermIdent Attributes) + _hdOallSynmap :: (Map NontermIdent Attributes) + _hdOchildTypes :: (Map Identifier Type) + _hdOcon :: ConstructorIdent + _hdOinhmap :: Attributes + _hdOlazyIntras :: (Set String) + _hdOlocalAttrTypes :: (Map Identifier Type) + _hdOmainFile :: String + _hdOmainName :: String + _hdOnt :: NontermIdent + _hdOoptions :: Options + _hdOruleKinds :: (Map Identifier (Set VisitKind)) + _hdOsynmap :: Attributes + _hdOusageInfo :: (Map Identifier Int) + _tlOallInhmap :: (Map NontermIdent Attributes) + _tlOallSynmap :: (Map NontermIdent Attributes) + _tlOchildTypes :: (Map Identifier Type) + _tlOcon :: ConstructorIdent + _tlOinhmap :: Attributes + _tlOlazyIntras :: (Set String) + _tlOlocalAttrTypes :: (Map Identifier Type) + _tlOmainFile :: String + _tlOmainName :: String + _tlOnt :: NontermIdent + _tlOoptions :: Options + _tlOruleKinds :: (Map Identifier (Set VisitKind)) + _tlOsynmap :: Attributes + _tlOusageInfo :: (Map Identifier Int) + _hdIerrors :: (Seq Error) + _hdImrules :: (Map Identifier (VisitKind -> Either Error PP_Doc)) + _hdIruledefs :: (Map Identifier (Set String)) + _hdIruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _hdIsem_rules :: PP_Doc + _tlIerrors :: (Seq Error) + _tlImrules :: (Map Identifier (VisitKind -> Either Error PP_Doc)) + _tlIruledefs :: (Map Identifier (Set String)) + _tlIruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _tlIsem_rules :: PP_Doc + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 4090 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 970, column 32) + _lhsOmrules = + ({-# LINE 970 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdImrules `Map.union` _tlImrules + {-# LINE 4096 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1278, column 34) + _lhsOruledefs = + ({-# LINE 1278 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIruledefs `uwSetUnion` _tlIruledefs + {-# LINE 4102 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1279, column 34) + _lhsOruleuses = + ({-# LINE 1279 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIruleuses `uwMapUnion` _tlIruleuses + {-# LINE 4108 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 969, column 35) + _lhsOsem_rules = + ({-# LINE 969 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIsem_rules >-< _tlIsem_rules + {-# LINE 4114 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallInhmap = + ({-# LINE 412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInhmap + {-# LINE 4120 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallSynmap = + ({-# LINE 413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallSynmap + {-# LINE 4126 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOchildTypes = + ({-# LINE 1413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildTypes + {-# LINE 4132 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 86 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIcon + {-# LINE 4138 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 410 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 4144 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOlazyIntras = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlazyIntras + {-# LINE 4150 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOlocalAttrTypes = + ({-# LINE 1427 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 4156 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOmainFile = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainFile + {-# LINE 4162 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOmainName = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainName + {-# LINE 4168 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 82 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInt + {-# LINE 4174 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 4180 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOruleKinds = + ({-# LINE 1233 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruleKinds + {-# LINE 4186 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 411 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 4192 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOusageInfo = + ({-# LINE 1218 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIusageInfo + {-# LINE 4198 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallInhmap = + ({-# LINE 412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInhmap + {-# LINE 4204 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallSynmap = + ({-# LINE 413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallSynmap + {-# LINE 4210 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOchildTypes = + ({-# LINE 1413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildTypes + {-# LINE 4216 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 86 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIcon + {-# LINE 4222 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 410 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 4228 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOlazyIntras = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlazyIntras + {-# LINE 4234 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOlocalAttrTypes = + ({-# LINE 1427 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 4240 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOmainFile = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainFile + {-# LINE 4246 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOmainName = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainName + {-# LINE 4252 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 82 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInt + {-# LINE 4258 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 4264 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOruleKinds = + ({-# LINE 1233 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruleKinds + {-# LINE 4270 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 411 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 4276 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOusageInfo = + ({-# LINE 1218 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIusageInfo + {-# LINE 4282 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _hdIerrors,_hdImrules,_hdIruledefs,_hdIruleuses,_hdIsem_rules) = + hd_ _hdOallInhmap _hdOallSynmap _hdOchildTypes _hdOcon _hdOinhmap _hdOlazyIntras _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOnt _hdOoptions _hdOruleKinds _hdOsynmap _hdOusageInfo + ( _tlIerrors,_tlImrules,_tlIruledefs,_tlIruleuses,_tlIsem_rules) = + tl_ _tlOallInhmap _tlOallSynmap _tlOchildTypes _tlOcon _tlOinhmap _tlOlazyIntras _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOnt _tlOoptions _tlOruleKinds _tlOsynmap _tlOusageInfo + in ( _lhsOerrors,_lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules)))) +sem_ERules_Nil :: T_ERules +sem_ERules_Nil = + (T_ERules (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIchildTypes + _lhsIcon + _lhsIinhmap + _lhsIlazyIntras + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsInt + _lhsIoptions + _lhsIruleKinds + _lhsIsynmap + _lhsIusageInfo -> + (let _lhsOerrors :: (Seq Error) + _lhsOmrules :: (Map Identifier (VisitKind -> Either Error PP_Doc)) + _lhsOruledefs :: (Map Identifier (Set String)) + _lhsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _lhsOsem_rules :: PP_Doc + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + Seq.empty + {-# LINE 4314 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 970, column 32) + _lhsOmrules = + ({-# LINE 970 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 4320 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1278, column 34) + _lhsOruledefs = + ({-# LINE 1278 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 4326 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1279, column 34) + _lhsOruleuses = + ({-# LINE 1279 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 4332 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 969, column 35) + _lhsOsem_rules = + ({-# LINE 969 "./src-ag/ExecutionPlan2Caml.ag" #-} + empty + {-# LINE 4338 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOerrors,_lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules)))) +-- ExecutionPlan ----------------------------------------------- +{- + visit 0: + inherited attributes: + inhmap : Map NontermIdent Attributes + localAttrTypes : Map NontermIdent (Map ConstructorIdent (Map Identifier Type)) + mainFile : String + mainName : String + options : Options + synmap : Map NontermIdent Attributes + synthesized attributes: + code : PP_Doc + datas : PP_Doc + errors : Seq Error + modules : PP_Doc + alternatives: + alternative ExecutionPlan: + child nonts : ENonterminals + child typeSyns : {TypeSyns} + child wrappers : {Set NontermIdent} + child derivings : {Derivings} + visit 0: + local wrappersExtra : _ + local commonExtra : _ + local lateSemBndTp : _ + local lateSemBndDef : _ +-} +-- cata +sem_ExecutionPlan :: ExecutionPlan -> + T_ExecutionPlan +sem_ExecutionPlan (ExecutionPlan _nonts _typeSyns _wrappers _derivings) = + (sem_ExecutionPlan_ExecutionPlan (sem_ENonterminals _nonts) _typeSyns _wrappers _derivings) +-- semantic domain +newtype T_ExecutionPlan = T_ExecutionPlan ((Map NontermIdent Attributes) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) -> + String -> + String -> + Options -> + (Map NontermIdent Attributes) -> + ( PP_Doc,PP_Doc,(Seq Error),PP_Doc)) +data Inh_ExecutionPlan = Inh_ExecutionPlan {inhmap_Inh_ExecutionPlan :: (Map NontermIdent Attributes),localAttrTypes_Inh_ExecutionPlan :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))),mainFile_Inh_ExecutionPlan :: String,mainName_Inh_ExecutionPlan :: String,options_Inh_ExecutionPlan :: Options,synmap_Inh_ExecutionPlan :: (Map NontermIdent Attributes)} +data Syn_ExecutionPlan = Syn_ExecutionPlan {code_Syn_ExecutionPlan :: PP_Doc,datas_Syn_ExecutionPlan :: PP_Doc,errors_Syn_ExecutionPlan :: (Seq Error),modules_Syn_ExecutionPlan :: PP_Doc} +wrap_ExecutionPlan :: T_ExecutionPlan -> + Inh_ExecutionPlan -> + Syn_ExecutionPlan +wrap_ExecutionPlan (T_ExecutionPlan sem) (Inh_ExecutionPlan _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap) = + (let ( _lhsOcode,_lhsOdatas,_lhsOerrors,_lhsOmodules) = sem _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap + in (Syn_ExecutionPlan _lhsOcode _lhsOdatas _lhsOerrors _lhsOmodules)) +sem_ExecutionPlan_ExecutionPlan :: T_ENonterminals -> + TypeSyns -> + (Set NontermIdent) -> + Derivings -> + T_ExecutionPlan +sem_ExecutionPlan_ExecutionPlan (T_ENonterminals nonts_) typeSyns_ wrappers_ derivings_ = + (T_ExecutionPlan (\ _lhsIinhmap + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsIoptions + _lhsIsynmap -> + (let _lhsOcode :: PP_Doc + _lhsOdatas :: PP_Doc + _nontsOwrappers :: (Set NontermIdent) + _nontsOtypeSyns :: TypeSyns + _nontsOallchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _nontsOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _nontsOavisituses :: (Map VisitIdentifier (Set Identifier)) + _nontsOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _nontsOallVisitKinds :: (Map VisitIdentifier VisitKind) + _nontsOallInitStates :: (Map NontermIdent Int) + _lhsOerrors :: (Seq Error) + _lhsOmodules :: PP_Doc + _nontsOinhmap :: (Map NontermIdent Attributes) + _nontsOlocalAttrTypes :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) + _nontsOmainFile :: String + _nontsOmainName :: String + _nontsOoptions :: Options + _nontsOsynmap :: (Map NontermIdent Attributes) + _nontsIchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _nontsIcode :: PP_Doc + _nontsIdatas :: PP_Doc + _nontsIerrors :: (Seq Error) + _nontsIfromToStates :: (Map VisitIdentifier (Int,Int)) + _nontsIinitStates :: (Map NontermIdent Int) + _nontsImodules :: PP_Doc + _nontsIsemFunBndDefs :: (Seq PP_Doc) + _nontsIsemFunBndTps :: (Seq PP_Doc) + _nontsIvisitKinds :: (Map VisitIdentifier VisitKind) + _nontsIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _nontsIvisituses :: (Map VisitIdentifier (Set Identifier)) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 103, column 3) + _lhsOcode = + ({-# LINE 103 "./src-ag/ExecutionPlan2Caml.ag" #-} + _nontsIcode >-< _wrappersExtra + {-# LINE 4435 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 104, column 3) + _lhsOdatas = + ({-# LINE 104 "./src-ag/ExecutionPlan2Caml.ag" #-} + _nontsIdatas >-< _commonExtra + {-# LINE 4441 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 110, column 3) + _nontsOwrappers = + ({-# LINE 110 "./src-ag/ExecutionPlan2Caml.ag" #-} + wrappers_ + {-# LINE 4447 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 171, column 3) + _nontsOtypeSyns = + ({-# LINE 171 "./src-ag/ExecutionPlan2Caml.ag" #-} + typeSyns_ + {-# LINE 4453 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 659, column 3) + _wrappersExtra = + ({-# LINE 659 "./src-ag/ExecutionPlan2Caml.ag" #-} + if lateHigherOrderBinding _lhsIoptions + then _lateSemBndDef + else empty + {-# LINE 4461 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 662, column 3) + _commonExtra = + ({-# LINE 662 "./src-ag/ExecutionPlan2Caml.ag" #-} + if lateHigherOrderBinding _lhsIoptions + then _lateSemBndTp + else empty + {-# LINE 4469 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 665, column 3) + _lateSemBndTp = + ({-# LINE 665 "./src-ag/ExecutionPlan2Caml.ag" #-} + "and" >#< lateBindingTypeNm _lhsImainName >#< "=" >#< ppRecordTp (toList _nontsIsemFunBndTps) + {-# LINE 4475 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 666, column 3) + _lateSemBndDef = + ({-# LINE 666 "./src-ag/ExecutionPlan2Caml.ag" #-} + "and" >#< lateBindingFieldNm _lhsImainName >#< ":" >#< lateBindingTypeNm _lhsImainName >#< "=" + >-< (indent 2 $ ppRecordVal $ toList _nontsIsemFunBndDefs) + {-# LINE 4482 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1152, column 19) + _nontsOallchildvisit = + ({-# LINE 1152 "./src-ag/ExecutionPlan2Caml.ag" #-} + _nontsIchildvisit + {-# LINE 4488 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1310, column 19) + _nontsOavisitdefs = + ({-# LINE 1310 "./src-ag/ExecutionPlan2Caml.ag" #-} + _nontsIvisitdefs + {-# LINE 4494 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1311, column 19) + _nontsOavisituses = + ({-# LINE 1311 "./src-ag/ExecutionPlan2Caml.ag" #-} + _nontsIvisituses + {-# LINE 4500 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1402, column 3) + _nontsOallFromToStates = + ({-# LINE 1402 "./src-ag/ExecutionPlan2Caml.ag" #-} + _nontsIfromToStates + {-# LINE 4506 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1446, column 3) + _nontsOallVisitKinds = + ({-# LINE 1446 "./src-ag/ExecutionPlan2Caml.ag" #-} + _nontsIvisitKinds + {-# LINE 4512 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1460, column 3) + _nontsOallInitStates = + ({-# LINE 1460 "./src-ag/ExecutionPlan2Caml.ag" #-} + _nontsIinitStates + {-# LINE 4518 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + _nontsIerrors + {-# LINE 4524 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (up) + _lhsOmodules = + ({-# LINE 100 "./src-ag/ExecutionPlan2Caml.ag" #-} + _nontsImodules + {-# LINE 4530 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _nontsOinhmap = + ({-# LINE 403 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 4536 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _nontsOlocalAttrTypes = + ({-# LINE 1425 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 4542 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _nontsOmainFile = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainFile + {-# LINE 4548 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _nontsOmainName = + ({-# LINE 60 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImainName + {-# LINE 4554 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _nontsOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 4560 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _nontsOsynmap = + ({-# LINE 404 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 4566 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _nontsIchildvisit,_nontsIcode,_nontsIdatas,_nontsIerrors,_nontsIfromToStates,_nontsIinitStates,_nontsImodules,_nontsIsemFunBndDefs,_nontsIsemFunBndTps,_nontsIvisitKinds,_nontsIvisitdefs,_nontsIvisituses) = + nonts_ _nontsOallFromToStates _nontsOallInitStates _nontsOallVisitKinds _nontsOallchildvisit _nontsOavisitdefs _nontsOavisituses _nontsOinhmap _nontsOlocalAttrTypes _nontsOmainFile _nontsOmainName _nontsOoptions _nontsOsynmap _nontsOtypeSyns _nontsOwrappers + in ( _lhsOcode,_lhsOdatas,_lhsOerrors,_lhsOmodules)))) +-- Expression -------------------------------------------------- +{- + visit 0: + synthesized attributes: + attrs : Map String (Maybe NonLocalAttr) + pos : Pos + semfunc : PP_Doc + tks : [HsToken] + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression _pos _tks) = + (sem_Expression_Expression _pos _tks) +-- semantic domain +newtype T_Expression = T_Expression (( (Map String (Maybe NonLocalAttr)),Pos,PP_Doc,([HsToken]))) +data Inh_Expression = Inh_Expression {} +data Syn_Expression = Syn_Expression {attrs_Syn_Expression :: (Map String (Maybe NonLocalAttr)),pos_Syn_Expression :: Pos,semfunc_Syn_Expression :: PP_Doc,tks_Syn_Expression :: ([HsToken])} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem) (Inh_Expression) = + (let ( _lhsOattrs,_lhsOpos,_lhsOsemfunc,_lhsOtks) = sem + in (Syn_Expression _lhsOattrs _lhsOpos _lhsOsemfunc _lhsOtks)) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (let _lhsOtks :: ([HsToken]) + _lhsOpos :: Pos + _lhsOattrs :: (Map String (Maybe NonLocalAttr)) + _lhsOsemfunc :: PP_Doc + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1024, column 16) + _lhsOtks = + ({-# LINE 1024 "./src-ag/ExecutionPlan2Caml.ag" #-} + tks_ + {-# LINE 4611 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1045, column 29) + _lhsOpos = + ({-# LINE 1045 "./src-ag/ExecutionPlan2Caml.ag" #-} + pos_ + {-# LINE 4617 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1137, column 16) + _lhsOattrs = + ({-# LINE 1137 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.unions $ map (\tok -> attrs_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_ + {-# LINE 4623 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1138, column 16) + _lhsOsemfunc = + ({-# LINE 1138 "./src-ag/ExecutionPlan2Caml.ag" #-} + vlist $ showTokens $ map (\tok -> tok_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_ + {-# LINE 4629 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOattrs,_lhsOpos,_lhsOsemfunc,_lhsOtks))) +-- HsToken ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + attrs : Map String (Maybe NonLocalAttr) + tok : (Pos,String) + alternatives: + alternative AGLocal: + child var : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local tok : _ + alternative AGField: + child field : {Identifier} + child attr : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local mbAttr : _ + local addTrace : _ + alternative HsToken: + child value : {String} + child pos : {Pos} + alternative CharToken: + child value : {String} + child pos : {Pos} + alternative StrToken: + child value : {String} + child pos : {Pos} + alternative Err: + child mesg : {String} + child pos : {Pos} +-} +-- cata +sem_HsToken :: HsToken -> + T_HsToken +sem_HsToken (AGLocal _var _pos _rdesc) = + (sem_HsToken_AGLocal _var _pos _rdesc) +sem_HsToken (AGField _field _attr _pos _rdesc) = + (sem_HsToken_AGField _field _attr _pos _rdesc) +sem_HsToken (HsToken _value _pos) = + (sem_HsToken_HsToken _value _pos) +sem_HsToken (CharToken _value _pos) = + (sem_HsToken_CharToken _value _pos) +sem_HsToken (StrToken _value _pos) = + (sem_HsToken_StrToken _value _pos) +sem_HsToken (Err _mesg _pos) = + (sem_HsToken_Err _mesg _pos) +-- semantic domain +newtype T_HsToken = T_HsToken (( (Map String (Maybe NonLocalAttr)),((Pos,String)))) +data Inh_HsToken = Inh_HsToken {} +data Syn_HsToken = Syn_HsToken {attrs_Syn_HsToken :: (Map String (Maybe NonLocalAttr)),tok_Syn_HsToken :: ((Pos,String))} +wrap_HsToken :: T_HsToken -> + Inh_HsToken -> + Syn_HsToken +wrap_HsToken (T_HsToken sem) (Inh_HsToken) = + (let ( _lhsOattrs,_lhsOtok) = sem + in (Syn_HsToken _lhsOattrs _lhsOtok)) +sem_HsToken_AGLocal :: Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGLocal var_ pos_ rdesc_ = + (T_HsToken (let _lhsOattrs :: (Map String (Maybe NonLocalAttr)) + _lhsOtok :: ((Pos,String)) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1096, column 15) + _lhsOattrs = + ({-# LINE 1096 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton (fieldname var_) Nothing + {-# LINE 4702 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1358, column 15) + _tok = + ({-# LINE 1358 "./src-ag/ExecutionPlan2Caml.ag" #-} + (pos_,fieldname var_) + {-# LINE 4708 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (from local) + _lhsOtok = + ({-# LINE 1360 "./src-ag/ExecutionPlan2Caml.ag" #-} + _tok + {-# LINE 4714 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok))) +sem_HsToken_AGField :: Identifier -> + Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGField field_ attr_ pos_ rdesc_ = + (T_HsToken (let _lhsOattrs :: (Map String (Maybe NonLocalAttr)) + _lhsOtok :: ((Pos,String)) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1097, column 15) + _mbAttr = + ({-# LINE 1097 "./src-ag/ExecutionPlan2Caml.ag" #-} + if field_ == _INST || field_ == _FIELD || field_ == _INST' + then Nothing + else Just $ mkNonLocalAttr (field_ == _LHS) field_ attr_ + {-# LINE 4731 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1100, column 15) + _lhsOattrs = + ({-# LINE 1100 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton (attrname True field_ attr_) _mbAttr + {-# LINE 4737 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1362, column 8) + _addTrace = + ({-# LINE 1362 "./src-ag/ExecutionPlan2Caml.ag" #-} + case rdesc_ of + Just d -> \x -> "(prerr_endline " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ "; " ++ x ++ ")" + Nothing -> id + {-# LINE 4745 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1365, column 8) + _lhsOtok = + ({-# LINE 1365 "./src-ag/ExecutionPlan2Caml.ag" #-} + (pos_, _addTrace $ attrname True field_ attr_) + {-# LINE 4751 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok))) +sem_HsToken_HsToken :: String -> + Pos -> + T_HsToken +sem_HsToken_HsToken value_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Map String (Maybe NonLocalAttr)) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1367, column 14) + _lhsOtok = + ({-# LINE 1367 "./src-ag/ExecutionPlan2Caml.ag" #-} + (pos_, value_) + {-# LINE 4764 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1094, column 37) + _lhsOattrs = + ({-# LINE 1094 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 4770 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok))) +sem_HsToken_CharToken :: String -> + Pos -> + T_HsToken +sem_HsToken_CharToken value_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Map String (Maybe NonLocalAttr)) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1369, column 16) + _lhsOtok = + ({-# LINE 1369 "./src-ag/ExecutionPlan2Caml.ag" #-} + (pos_, if null value_ + then "" + else showCharShort (head value_) + ) + {-# LINE 4786 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1094, column 37) + _lhsOattrs = + ({-# LINE 1094 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 4792 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok))) +sem_HsToken_StrToken :: String -> + Pos -> + T_HsToken +sem_HsToken_StrToken value_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Map String (Maybe NonLocalAttr)) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1374, column 16) + _lhsOtok = + ({-# LINE 1374 "./src-ag/ExecutionPlan2Caml.ag" #-} + (pos_, showStrShort value_) + {-# LINE 4805 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1094, column 37) + _lhsOattrs = + ({-# LINE 1094 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 4811 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok))) +sem_HsToken_Err :: String -> + Pos -> + T_HsToken +sem_HsToken_Err mesg_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Map String (Maybe NonLocalAttr)) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1375, column 16) + _lhsOtok = + ({-# LINE 1375 "./src-ag/ExecutionPlan2Caml.ag" #-} + (pos_, "") + {-# LINE 4824 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1094, column 37) + _lhsOattrs = + ({-# LINE 1094 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 4830 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok))) +-- HsTokens ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + tks : [(Pos,String)] + alternatives: + alternative Cons: + child hd : HsToken + child tl : HsTokens + alternative Nil: +-} +-- cata +sem_HsTokens :: HsTokens -> + T_HsTokens +sem_HsTokens list = + (Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list)) +-- semantic domain +newtype T_HsTokens = T_HsTokens (( ([(Pos,String)]))) +data Inh_HsTokens = Inh_HsTokens {} +data Syn_HsTokens = Syn_HsTokens {tks_Syn_HsTokens :: ([(Pos,String)])} +wrap_HsTokens :: T_HsTokens -> + Inh_HsTokens -> + Syn_HsTokens +wrap_HsTokens (T_HsTokens sem) (Inh_HsTokens) = + (let ( _lhsOtks) = sem + in (Syn_HsTokens _lhsOtks)) +sem_HsTokens_Cons :: T_HsToken -> + T_HsTokens -> + T_HsTokens +sem_HsTokens_Cons (T_HsToken hd_) (T_HsTokens tl_) = + (T_HsTokens (let _lhsOtks :: ([(Pos,String)]) + _hdIattrs :: (Map String (Maybe NonLocalAttr)) + _hdItok :: ((Pos,String)) + _tlItks :: ([(Pos,String)]) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1354, column 10) + _lhsOtks = + ({-# LINE 1354 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdItok : _tlItks + {-# LINE 4871 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _hdIattrs,_hdItok) = + hd_ + ( _tlItks) = + tl_ + in ( _lhsOtks))) +sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil = + (T_HsTokens (let _lhsOtks :: ([(Pos,String)]) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1355, column 10) + _lhsOtks = + ({-# LINE 1355 "./src-ag/ExecutionPlan2Caml.ag" #-} + [] + {-# LINE 4885 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOtks))) +-- HsTokensRoot ------------------------------------------------ +{- + 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 (( )) +data Inh_HsTokensRoot = Inh_HsTokensRoot {} +data Syn_HsTokensRoot = Syn_HsTokensRoot {} +wrap_HsTokensRoot :: T_HsTokensRoot -> + Inh_HsTokensRoot -> + Syn_HsTokensRoot +wrap_HsTokensRoot (T_HsTokensRoot sem) (Inh_HsTokensRoot) = + (let ( ) = sem + in (Syn_HsTokensRoot)) +sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> + T_HsTokensRoot +sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_) = + (T_HsTokensRoot (let _tokensItks :: ([(Pos,String)]) + ( _tokensItks) = + tokens_ + in ( ))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allInhmap : Map NontermIdent Attributes + allSynmap : Map NontermIdent Attributes + anyLazyKind : Bool + inhmap : Attributes + localAttrTypes : Map Identifier Type + options : Options + synmap : Attributes + synthesized attributes: + attrTypes : PP_Doc + attrs : Set String + copy : Pattern + extraDefs : [(PP_Doc,PP_Doc)] + isUnderscore : Bool + sem_lhs : PP_Doc + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local var : _ + local hasTp : _ + local o_sigs : _ + local mbTp : _ + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern (Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern (Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern (Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +sem_Pattern (Underscore _pos) = + (sem_Pattern_Underscore _pos) +-- semantic domain +newtype T_Pattern = T_Pattern ((Map NontermIdent Attributes) -> + (Map NontermIdent Attributes) -> + Bool -> + Attributes -> + (Map Identifier Type) -> + Options -> + Attributes -> + ( PP_Doc,(Set String),Pattern,([(PP_Doc,PP_Doc)]),Bool,( PP_Doc ))) +data Inh_Pattern = Inh_Pattern {allInhmap_Inh_Pattern :: (Map NontermIdent Attributes),allSynmap_Inh_Pattern :: (Map NontermIdent Attributes),anyLazyKind_Inh_Pattern :: Bool,inhmap_Inh_Pattern :: Attributes,localAttrTypes_Inh_Pattern :: (Map Identifier Type),options_Inh_Pattern :: Options,synmap_Inh_Pattern :: Attributes} +data Syn_Pattern = Syn_Pattern {attrTypes_Syn_Pattern :: PP_Doc,attrs_Syn_Pattern :: (Set String),copy_Syn_Pattern :: Pattern,extraDefs_Syn_Pattern :: ([(PP_Doc,PP_Doc)]),isUnderscore_Syn_Pattern :: Bool,sem_lhs_Syn_Pattern :: ( PP_Doc )} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) = + (let ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOextraDefs,_lhsOisUnderscore,_lhsOsem_lhs) = sem _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap + in (Syn_Pattern _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOextraDefs _lhsOisUnderscore _lhsOsem_lhs)) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_) = + (T_Pattern (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIanyLazyKind + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsIoptions + _lhsIsynmap -> + (let _lhsOsem_lhs :: ( PP_Doc ) + _lhsOisUnderscore :: Bool + _lhsOattrTypes :: PP_Doc + _lhsOattrs :: (Set String) + _lhsOextraDefs :: ([(PP_Doc,PP_Doc)]) + _lhsOcopy :: Pattern + _patsOallInhmap :: (Map NontermIdent Attributes) + _patsOallSynmap :: (Map NontermIdent Attributes) + _patsOanyLazyKind :: Bool + _patsOinhmap :: Attributes + _patsOlocalAttrTypes :: (Map Identifier Type) + _patsOoptions :: Options + _patsOsynmap :: Attributes + _patsIattrTypes :: PP_Doc + _patsIattrs :: (Set String) + _patsIcopy :: Patterns + _patsIextraDefs :: ([(PP_Doc,PP_Doc)]) + _patsIsem_lhs :: ([PP_Doc]) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1062, column 17) + _lhsOsem_lhs = + ({-# LINE 1062 "./src-ag/ExecutionPlan2Caml.ag" #-} + pp_parens $ name_ >#< pp_block "(" ")" "," _patsIsem_lhs + {-# LINE 5027 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1071, column 16) + _lhsOisUnderscore = + ({-# LINE 1071 "./src-ag/ExecutionPlan2Caml.ag" #-} + False + {-# LINE 5033 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1083, column 40) + _lhsOattrTypes = + ({-# LINE 1083 "./src-ag/ExecutionPlan2Caml.ag" #-} + _patsIattrTypes + {-# LINE 5039 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1077, column 36) + _lhsOattrs = + ({-# LINE 1077 "./src-ag/ExecutionPlan2Caml.ag" #-} + _patsIattrs + {-# LINE 5045 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1050, column 39) + _lhsOextraDefs = + ({-# LINE 1050 "./src-ag/ExecutionPlan2Caml.ag" #-} + _patsIextraDefs + {-# LINE 5051 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 5057 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 5063 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patsOallInhmap = + ({-# LINE 412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInhmap + {-# LINE 5069 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patsOallSynmap = + ({-# LINE 413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallSynmap + {-# LINE 5075 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patsOanyLazyKind = + ({-# LINE 1241 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIanyLazyKind + {-# LINE 5081 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patsOinhmap = + ({-# LINE 410 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 5087 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patsOlocalAttrTypes = + ({-# LINE 1427 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 5093 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patsOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 5099 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patsOsynmap = + ({-# LINE 411 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 5105 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _patsIattrTypes,_patsIattrs,_patsIcopy,_patsIextraDefs,_patsIsem_lhs) = + pats_ _patsOallInhmap _patsOallSynmap _patsOanyLazyKind _patsOinhmap _patsOlocalAttrTypes _patsOoptions _patsOsynmap + in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOextraDefs,_lhsOisUnderscore,_lhsOsem_lhs)))) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_) = + (T_Pattern (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIanyLazyKind + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsIoptions + _lhsIsynmap -> + (let _lhsOsem_lhs :: ( PP_Doc ) + _lhsOisUnderscore :: Bool + _lhsOattrTypes :: PP_Doc + _lhsOattrs :: (Set String) + _lhsOextraDefs :: ([(PP_Doc,PP_Doc)]) + _lhsOcopy :: Pattern + _patsOallInhmap :: (Map NontermIdent Attributes) + _patsOallSynmap :: (Map NontermIdent Attributes) + _patsOanyLazyKind :: Bool + _patsOinhmap :: Attributes + _patsOlocalAttrTypes :: (Map Identifier Type) + _patsOoptions :: Options + _patsOsynmap :: Attributes + _patsIattrTypes :: PP_Doc + _patsIattrs :: (Set String) + _patsIcopy :: Patterns + _patsIextraDefs :: ([(PP_Doc,PP_Doc)]) + _patsIsem_lhs :: ([PP_Doc]) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1061, column 17) + _lhsOsem_lhs = + ({-# LINE 1061 "./src-ag/ExecutionPlan2Caml.ag" #-} + pp_block "(" ")" "," _patsIsem_lhs + {-# LINE 5143 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1072, column 16) + _lhsOisUnderscore = + ({-# LINE 1072 "./src-ag/ExecutionPlan2Caml.ag" #-} + False + {-# LINE 5149 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1083, column 40) + _lhsOattrTypes = + ({-# LINE 1083 "./src-ag/ExecutionPlan2Caml.ag" #-} + _patsIattrTypes + {-# LINE 5155 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1077, column 36) + _lhsOattrs = + ({-# LINE 1077 "./src-ag/ExecutionPlan2Caml.ag" #-} + _patsIattrs + {-# LINE 5161 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1050, column 39) + _lhsOextraDefs = + ({-# LINE 1050 "./src-ag/ExecutionPlan2Caml.ag" #-} + _patsIextraDefs + {-# LINE 5167 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 5173 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 5179 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patsOallInhmap = + ({-# LINE 412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInhmap + {-# LINE 5185 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patsOallSynmap = + ({-# LINE 413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallSynmap + {-# LINE 5191 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patsOanyLazyKind = + ({-# LINE 1241 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIanyLazyKind + {-# LINE 5197 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patsOinhmap = + ({-# LINE 410 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 5203 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patsOlocalAttrTypes = + ({-# LINE 1427 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 5209 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patsOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 5215 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patsOsynmap = + ({-# LINE 411 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 5221 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _patsIattrTypes,_patsIattrs,_patsIcopy,_patsIextraDefs,_patsIsem_lhs) = + pats_ _patsOallInhmap _patsOallSynmap _patsOanyLazyKind _patsOinhmap _patsOlocalAttrTypes _patsOoptions _patsOsynmap + in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOextraDefs,_lhsOisUnderscore,_lhsOsem_lhs)))) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_) = + (T_Pattern (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIanyLazyKind + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsIoptions + _lhsIsynmap -> + (let _lhsOsem_lhs :: ( PP_Doc ) + _lhsOextraDefs :: ([(PP_Doc,PP_Doc)]) + _lhsOisUnderscore :: Bool + _lhsOattrs :: (Set String) + _lhsOattrTypes :: PP_Doc + _lhsOcopy :: Pattern + _patOallInhmap :: (Map NontermIdent Attributes) + _patOallSynmap :: (Map NontermIdent Attributes) + _patOanyLazyKind :: Bool + _patOinhmap :: Attributes + _patOlocalAttrTypes :: (Map Identifier Type) + _patOoptions :: Options + _patOsynmap :: Attributes + _patIattrTypes :: PP_Doc + _patIattrs :: (Set String) + _patIcopy :: Pattern + _patIextraDefs :: ([(PP_Doc,PP_Doc)]) + _patIisUnderscore :: Bool + _patIsem_lhs :: ( PP_Doc ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1053, column 17) + _var = + ({-# LINE 1053 "./src-ag/ExecutionPlan2Caml.ag" #-} + text $ attrname False field_ attr_ + {-# LINE 5261 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1054, column 17) + _hasTp = + ({-# LINE 1054 "./src-ag/ExecutionPlan2Caml.ag" #-} + isJust _mbTp + {-# LINE 5267 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1055, column 17) + _o_sigs = + ({-# LINE 1055 "./src-ag/ExecutionPlan2Caml.ag" #-} + typeSigs _lhsIoptions + {-# LINE 5273 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1057, column 17) + _lhsOsem_lhs = + ({-# LINE 1057 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppArg (_hasTp && _o_sigs ) _var (maybe (text "?no type?") ppTp _mbTp ) + {-# LINE 5279 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1058, column 17) + _lhsOextraDefs = + ({-# LINE 1058 "./src-ag/ExecutionPlan2Caml.ag" #-} + if _patIisUnderscore + then [] + else [ (_patIsem_lhs, _var ) ] + {-# LINE 5287 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1073, column 16) + _lhsOisUnderscore = + ({-# LINE 1073 "./src-ag/ExecutionPlan2Caml.ag" #-} + False + {-# LINE 5293 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1079, column 3) + _lhsOattrs = + ({-# LINE 1079 "./src-ag/ExecutionPlan2Caml.ag" #-} + Set.insert (attrname False field_ attr_) _patIattrs + {-# LINE 5299 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1085, column 3) + _mbTp = + ({-# LINE 1085 "./src-ag/ExecutionPlan2Caml.ag" #-} + if field_ == _LHS + then Map.lookup attr_ _lhsIsynmap + else if field_ == _LOC + then Map.lookup attr_ _lhsIlocalAttrTypes + else Nothing + {-# LINE 5309 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1090, column 3) + _lhsOattrTypes = + ({-# LINE 1090 "./src-ag/ExecutionPlan2Caml.ag" #-} + maybe empty (\tp -> (attrname False field_ attr_) >#< "::" >#< ppTp tp) _mbTp + >-< _patIattrTypes + {-# LINE 5316 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 5322 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 5328 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patOallInhmap = + ({-# LINE 412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInhmap + {-# LINE 5334 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patOallSynmap = + ({-# LINE 413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallSynmap + {-# LINE 5340 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patOanyLazyKind = + ({-# LINE 1241 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIanyLazyKind + {-# LINE 5346 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patOinhmap = + ({-# LINE 410 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 5352 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patOlocalAttrTypes = + ({-# LINE 1427 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 5358 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 5364 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patOsynmap = + ({-# LINE 411 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 5370 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _patIattrTypes,_patIattrs,_patIcopy,_patIextraDefs,_patIisUnderscore,_patIsem_lhs) = + pat_ _patOallInhmap _patOallSynmap _patOanyLazyKind _patOinhmap _patOlocalAttrTypes _patOoptions _patOsynmap + in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOextraDefs,_lhsOisUnderscore,_lhsOsem_lhs)))) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_) = + (T_Pattern (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIanyLazyKind + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsIoptions + _lhsIsynmap -> + (let _lhsOsem_lhs :: ( PP_Doc ) + _lhsOattrTypes :: PP_Doc + _lhsOattrs :: (Set String) + _lhsOextraDefs :: ([(PP_Doc,PP_Doc)]) + _lhsOcopy :: Pattern + _lhsOisUnderscore :: Bool + _patOallInhmap :: (Map NontermIdent Attributes) + _patOallSynmap :: (Map NontermIdent Attributes) + _patOanyLazyKind :: Bool + _patOinhmap :: Attributes + _patOlocalAttrTypes :: (Map Identifier Type) + _patOoptions :: Options + _patOsynmap :: Attributes + _patIattrTypes :: PP_Doc + _patIattrs :: (Set String) + _patIcopy :: Pattern + _patIextraDefs :: ([(PP_Doc,PP_Doc)]) + _patIisUnderscore :: Bool + _patIsem_lhs :: ( PP_Doc ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1064, column 17) + _lhsOsem_lhs = + ({-# LINE 1064 "./src-ag/ExecutionPlan2Caml.ag" #-} + pp_parens (text "lazy" >#< _patIsem_lhs) + {-# LINE 5408 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1083, column 40) + _lhsOattrTypes = + ({-# LINE 1083 "./src-ag/ExecutionPlan2Caml.ag" #-} + _patIattrTypes + {-# LINE 5414 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1077, column 36) + _lhsOattrs = + ({-# LINE 1077 "./src-ag/ExecutionPlan2Caml.ag" #-} + _patIattrs + {-# LINE 5420 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1050, column 39) + _lhsOextraDefs = + ({-# LINE 1050 "./src-ag/ExecutionPlan2Caml.ag" #-} + _patIextraDefs + {-# LINE 5426 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 5432 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 5438 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (up) + _lhsOisUnderscore = + ({-# LINE 1069 "./src-ag/ExecutionPlan2Caml.ag" #-} + _patIisUnderscore + {-# LINE 5444 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patOallInhmap = + ({-# LINE 412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInhmap + {-# LINE 5450 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patOallSynmap = + ({-# LINE 413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallSynmap + {-# LINE 5456 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patOanyLazyKind = + ({-# LINE 1241 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIanyLazyKind + {-# LINE 5462 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patOinhmap = + ({-# LINE 410 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 5468 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patOlocalAttrTypes = + ({-# LINE 1427 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 5474 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 5480 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _patOsynmap = + ({-# LINE 411 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 5486 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _patIattrTypes,_patIattrs,_patIcopy,_patIextraDefs,_patIisUnderscore,_patIsem_lhs) = + pat_ _patOallInhmap _patOallSynmap _patOanyLazyKind _patOinhmap _patOlocalAttrTypes _patOoptions _patOsynmap + in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOextraDefs,_lhsOisUnderscore,_lhsOsem_lhs)))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIanyLazyKind + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsIoptions + _lhsIsynmap -> + (let _lhsOsem_lhs :: ( PP_Doc ) + _lhsOisUnderscore :: Bool + _lhsOattrTypes :: PP_Doc + _lhsOattrs :: (Set String) + _lhsOextraDefs :: ([(PP_Doc,PP_Doc)]) + _lhsOcopy :: Pattern + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1063, column 17) + _lhsOsem_lhs = + ({-# LINE 1063 "./src-ag/ExecutionPlan2Caml.ag" #-} + text "_" + {-# LINE 5511 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1074, column 16) + _lhsOisUnderscore = + ({-# LINE 1074 "./src-ag/ExecutionPlan2Caml.ag" #-} + True + {-# LINE 5517 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1083, column 40) + _lhsOattrTypes = + ({-# LINE 1083 "./src-ag/ExecutionPlan2Caml.ag" #-} + empty + {-# LINE 5523 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1077, column 36) + _lhsOattrs = + ({-# LINE 1077 "./src-ag/ExecutionPlan2Caml.ag" #-} + Set.empty + {-# LINE 5529 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1050, column 39) + _lhsOextraDefs = + ({-# LINE 1050 "./src-ag/ExecutionPlan2Caml.ag" #-} + [] + {-# LINE 5535 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 5541 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 5547 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOextraDefs,_lhsOisUnderscore,_lhsOsem_lhs)))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + inherited attributes: + allInhmap : Map NontermIdent Attributes + allSynmap : Map NontermIdent Attributes + anyLazyKind : Bool + inhmap : Attributes + localAttrTypes : Map Identifier Type + options : Options + synmap : Attributes + synthesized attributes: + attrTypes : PP_Doc + attrs : Set String + copy : Patterns + extraDefs : [(PP_Doc,PP_Doc)] + sem_lhs : [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 ((Map NontermIdent Attributes) -> + (Map NontermIdent Attributes) -> + Bool -> + Attributes -> + (Map Identifier Type) -> + Options -> + Attributes -> + ( PP_Doc,(Set String),Patterns,([(PP_Doc,PP_Doc)]),([PP_Doc]))) +data Inh_Patterns = Inh_Patterns {allInhmap_Inh_Patterns :: (Map NontermIdent Attributes),allSynmap_Inh_Patterns :: (Map NontermIdent Attributes),anyLazyKind_Inh_Patterns :: Bool,inhmap_Inh_Patterns :: Attributes,localAttrTypes_Inh_Patterns :: (Map Identifier Type),options_Inh_Patterns :: Options,synmap_Inh_Patterns :: Attributes} +data Syn_Patterns = Syn_Patterns {attrTypes_Syn_Patterns :: PP_Doc,attrs_Syn_Patterns :: (Set String),copy_Syn_Patterns :: Patterns,extraDefs_Syn_Patterns :: ([(PP_Doc,PP_Doc)]),sem_lhs_Syn_Patterns :: ([PP_Doc])} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) = + (let ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOextraDefs,_lhsOsem_lhs) = sem _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap + in (Syn_Patterns _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOextraDefs _lhsOsem_lhs)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = + (T_Patterns (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIanyLazyKind + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsIoptions + _lhsIsynmap -> + (let _lhsOattrTypes :: PP_Doc + _lhsOattrs :: (Set String) + _lhsOextraDefs :: ([(PP_Doc,PP_Doc)]) + _lhsOsem_lhs :: ([PP_Doc]) + _lhsOcopy :: Patterns + _hdOallInhmap :: (Map NontermIdent Attributes) + _hdOallSynmap :: (Map NontermIdent Attributes) + _hdOanyLazyKind :: Bool + _hdOinhmap :: Attributes + _hdOlocalAttrTypes :: (Map Identifier Type) + _hdOoptions :: Options + _hdOsynmap :: Attributes + _tlOallInhmap :: (Map NontermIdent Attributes) + _tlOallSynmap :: (Map NontermIdent Attributes) + _tlOanyLazyKind :: Bool + _tlOinhmap :: Attributes + _tlOlocalAttrTypes :: (Map Identifier Type) + _tlOoptions :: Options + _tlOsynmap :: Attributes + _hdIattrTypes :: PP_Doc + _hdIattrs :: (Set String) + _hdIcopy :: Pattern + _hdIextraDefs :: ([(PP_Doc,PP_Doc)]) + _hdIisUnderscore :: Bool + _hdIsem_lhs :: ( PP_Doc ) + _tlIattrTypes :: PP_Doc + _tlIattrs :: (Set String) + _tlIcopy :: Patterns + _tlIextraDefs :: ([(PP_Doc,PP_Doc)]) + _tlIsem_lhs :: ([PP_Doc]) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1083, column 40) + _lhsOattrTypes = + ({-# LINE 1083 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIattrTypes >-< _tlIattrTypes + {-# LINE 5644 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1077, column 36) + _lhsOattrs = + ({-# LINE 1077 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIattrs `Set.union` _tlIattrs + {-# LINE 5650 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1050, column 39) + _lhsOextraDefs = + ({-# LINE 1050 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIextraDefs ++ _tlIextraDefs + {-# LINE 5656 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1049, column 29) + _lhsOsem_lhs = + ({-# LINE 1049 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIsem_lhs : _tlIsem_lhs + {-# LINE 5662 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 5668 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 5674 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallInhmap = + ({-# LINE 412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInhmap + {-# LINE 5680 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallSynmap = + ({-# LINE 413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallSynmap + {-# LINE 5686 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOanyLazyKind = + ({-# LINE 1241 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIanyLazyKind + {-# LINE 5692 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 410 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 5698 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOlocalAttrTypes = + ({-# LINE 1427 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 5704 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 5710 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 411 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 5716 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallInhmap = + ({-# LINE 412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInhmap + {-# LINE 5722 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallSynmap = + ({-# LINE 413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallSynmap + {-# LINE 5728 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOanyLazyKind = + ({-# LINE 1241 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIanyLazyKind + {-# LINE 5734 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 410 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 5740 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOlocalAttrTypes = + ({-# LINE 1427 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 5746 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 5752 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 411 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 5758 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _hdIattrTypes,_hdIattrs,_hdIcopy,_hdIextraDefs,_hdIisUnderscore,_hdIsem_lhs) = + hd_ _hdOallInhmap _hdOallSynmap _hdOanyLazyKind _hdOinhmap _hdOlocalAttrTypes _hdOoptions _hdOsynmap + ( _tlIattrTypes,_tlIattrs,_tlIcopy,_tlIextraDefs,_tlIsem_lhs) = + tl_ _tlOallInhmap _tlOallSynmap _tlOanyLazyKind _tlOinhmap _tlOlocalAttrTypes _tlOoptions _tlOsynmap + in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOextraDefs,_lhsOsem_lhs)))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIanyLazyKind + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsIoptions + _lhsIsynmap -> + (let _lhsOattrTypes :: PP_Doc + _lhsOattrs :: (Set String) + _lhsOextraDefs :: ([(PP_Doc,PP_Doc)]) + _lhsOsem_lhs :: ([PP_Doc]) + _lhsOcopy :: Patterns + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1083, column 40) + _lhsOattrTypes = + ({-# LINE 1083 "./src-ag/ExecutionPlan2Caml.ag" #-} + empty + {-# LINE 5783 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1077, column 36) + _lhsOattrs = + ({-# LINE 1077 "./src-ag/ExecutionPlan2Caml.ag" #-} + Set.empty + {-# LINE 5789 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1050, column 39) + _lhsOextraDefs = + ({-# LINE 1050 "./src-ag/ExecutionPlan2Caml.ag" #-} + [] + {-# LINE 5795 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1049, column 29) + _lhsOsem_lhs = + ({-# LINE 1049 "./src-ag/ExecutionPlan2Caml.ag" #-} + [] + {-# LINE 5801 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 5807 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 5813 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOextraDefs,_lhsOsem_lhs)))) +-- Visit ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInhmap : Map NontermIdent Attributes + allInitStates : Map NontermIdent Int + allSynmap : Map NontermIdent Attributes + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) + allintramap : Map StateIdentifier (Map String (Maybe NonLocalAttr)) + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + childTypes : Map Identifier Type + childintros : Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) + con : ConstructorIdent + inhmap : Attributes + mrules : Map Identifier (VisitKind -> Either Error PP_Doc) + nextVisits : Map StateIdentifier StateCtx + nt : NontermIdent + options : Options + params : [Identifier] + prevVisits : Map StateIdentifier StateCtx + ruledefs : Map Identifier (Set String) + ruleuses : Map Identifier (Map String (Maybe NonLocalAttr)) + synmap : Attributes + terminaldefs : Set String + synthesized attributes: + allvisits : VisitStateState + childvisit : Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) + errors : Seq Error + fromToStates : Map VisitIdentifier (Int,Int) + intramap : Map StateIdentifier (Map String (Maybe NonLocalAttr)) + lazyIntras : Set String + ruleKinds : Map Identifier (Set VisitKind) + ruleUsage : Map Identifier Int + sem_visit : (StateIdentifier,PP_Doc) + t_visits : PP_Doc + visitKinds : Map VisitIdentifier VisitKind + visitdefs : Map VisitIdentifier (Set Identifier) + visituses : Map VisitIdentifier (Set Identifier) + alternatives: + alternative Visit: + child ident : {VisitIdentifier} + child from : {StateIdentifier} + child to : {StateIdentifier} + child inh : {Set Identifier} + child syn : {Set Identifier} + child steps : VisitSteps + child kind : {VisitKind} + visit 0: + local nameTIn_visit : _ + local nameTOut_visit : _ + local nameNextState : _ + local nameCaller_visit : _ + local nextVisitInfo : _ + local t_params : _ + local t_c_params : _ + local contpart : _ + local inhpart : _ + local synpart : _ + local ppTypeList : _ + local o_sigs : _ + local nextArgsMp : _ + local nextArgs : _ + local nextStExp : _ + local resultval : _ + local nextStBuild : _ + local nextStRefExp : _ + local prevVisitInfo : _ + local invokecode : _ + local thisintra : _ + local nextintra : _ + local uses : _ + local inhVarNms : _ + local defs : _ + local defsAsMap : _ + local lazyIntrasInh : _ +-} +-- cata +sem_Visit :: Visit -> + T_Visit +sem_Visit (Visit _ident _from _to _inh _syn _steps _kind) = + (sem_Visit_Visit _ident _from _to _inh _syn (sem_VisitSteps _steps) _kind) +-- semantic domain +newtype T_Visit = T_Visit ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Attributes) -> + (Map NontermIdent Int) -> + (Map NontermIdent Attributes) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> + (Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map Identifier Type) -> + (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> + ConstructorIdent -> + Attributes -> + (Map Identifier (VisitKind -> Either Error PP_Doc)) -> + (Map StateIdentifier StateCtx) -> + NontermIdent -> + Options -> + ([Identifier]) -> + (Map StateIdentifier StateCtx) -> + (Map Identifier (Set String)) -> + (Map Identifier (Map String (Maybe NonLocalAttr))) -> + Attributes -> + (Set String) -> + ( ( VisitStateState ),(Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),(Seq Error),(Map VisitIdentifier (Int,Int)),(Map StateIdentifier (Map String (Maybe NonLocalAttr))),(Set String),(Map Identifier (Set VisitKind)),(Map Identifier Int),( (StateIdentifier,PP_Doc) ),PP_Doc,(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier)))) +data Inh_Visit = Inh_Visit {allFromToStates_Inh_Visit :: (Map VisitIdentifier (Int,Int)),allInhmap_Inh_Visit :: (Map NontermIdent Attributes),allInitStates_Inh_Visit :: (Map NontermIdent Int),allSynmap_Inh_Visit :: (Map NontermIdent Attributes),allVisitKinds_Inh_Visit :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_Visit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),allintramap_Inh_Visit :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))),avisitdefs_Inh_Visit :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_Visit :: (Map VisitIdentifier (Set Identifier)),childTypes_Inh_Visit :: (Map Identifier Type),childintros_Inh_Visit :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),con_Inh_Visit :: ConstructorIdent,inhmap_Inh_Visit :: Attributes,mrules_Inh_Visit :: (Map Identifier (VisitKind -> Either Error PP_Doc)),nextVisits_Inh_Visit :: (Map StateIdentifier StateCtx),nt_Inh_Visit :: NontermIdent,options_Inh_Visit :: Options,params_Inh_Visit :: ([Identifier]),prevVisits_Inh_Visit :: (Map StateIdentifier StateCtx),ruledefs_Inh_Visit :: (Map Identifier (Set String)),ruleuses_Inh_Visit :: (Map Identifier (Map String (Maybe NonLocalAttr))),synmap_Inh_Visit :: Attributes,terminaldefs_Inh_Visit :: (Set String)} +data Syn_Visit = Syn_Visit {allvisits_Syn_Visit :: ( VisitStateState ),childvisit_Syn_Visit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),errors_Syn_Visit :: (Seq Error),fromToStates_Syn_Visit :: (Map VisitIdentifier (Int,Int)),intramap_Syn_Visit :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))),lazyIntras_Syn_Visit :: (Set String),ruleKinds_Syn_Visit :: (Map Identifier (Set VisitKind)),ruleUsage_Syn_Visit :: (Map Identifier Int),sem_visit_Syn_Visit :: ( (StateIdentifier,PP_Doc) ),t_visits_Syn_Visit :: PP_Doc,visitKinds_Syn_Visit :: (Map VisitIdentifier VisitKind),visitdefs_Syn_Visit :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_Visit :: (Map VisitIdentifier (Set Identifier))} +wrap_Visit :: T_Visit -> + Inh_Visit -> + Syn_Visit +wrap_Visit (T_Visit sem) (Inh_Visit _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOintramap,_lhsOlazyIntras,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_visit,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs + in (Syn_Visit _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses)) +sem_Visit_Visit :: VisitIdentifier -> + StateIdentifier -> + StateIdentifier -> + (Set Identifier) -> + (Set Identifier) -> + T_VisitSteps -> + VisitKind -> + T_Visit +sem_Visit_Visit ident_ from_ to_ inh_ syn_ (T_VisitSteps steps_) kind_ = + (T_Visit (\ _lhsIallFromToStates + _lhsIallInhmap + _lhsIallInitStates + _lhsIallSynmap + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIallintramap + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIcon + _lhsIinhmap + _lhsImrules + _lhsInextVisits + _lhsInt + _lhsIoptions + _lhsIparams + _lhsIprevVisits + _lhsIruledefs + _lhsIruleuses + _lhsIsynmap + _lhsIterminaldefs -> + (let _lhsOallvisits :: ( VisitStateState ) + _lhsOt_visits :: PP_Doc + _lhsOsem_visit :: ( (StateIdentifier,PP_Doc) ) + _stepsOfollow :: PP_Doc + _stepsOkind :: VisitKind + _stepsOindex :: Int + _stepsOprevMaxSimRefs :: Int + _stepsOuseParallel :: Bool + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _lhsOintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + _lhsOlazyIntras :: (Set String) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOerrors :: (Seq Error) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _stepsOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _stepsOallInitStates :: (Map NontermIdent Int) + _stepsOallVisitKinds :: (Map VisitIdentifier VisitKind) + _stepsOallchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _stepsOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _stepsOavisituses :: (Map VisitIdentifier (Set Identifier)) + _stepsOchildTypes :: (Map Identifier Type) + _stepsOchildintros :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _stepsOmrules :: (Map Identifier (VisitKind -> Either Error PP_Doc)) + _stepsOoptions :: Options + _stepsOruledefs :: (Map Identifier (Set String)) + _stepsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _stepsIdefs :: (Set String) + _stepsIerrors :: (Seq Error) + _stepsIindex :: Int + _stepsIisLast :: Bool + _stepsIlazyIntras :: (Set String) + _stepsIprevMaxSimRefs :: Int + _stepsIruleKinds :: (Map Identifier (Set VisitKind)) + _stepsIruleUsage :: (Map Identifier Int) + _stepsIsem_steps :: PP_Doc + _stepsIsize :: Int + _stepsIuses :: (Map String (Maybe NonLocalAttr)) + _stepsIvisitKinds :: (Map VisitIdentifier VisitKind) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 432, column 11) + _lhsOallvisits = + ({-# LINE 432 "./src-ag/ExecutionPlan2Caml.ag" #-} + (ident_, from_, to_) + {-# LINE 6011 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 535, column 3) + _nameTIn_visit = + ({-# LINE 535 "./src-ag/ExecutionPlan2Caml.ag" #-} + conNmTVisitIn _lhsInt ident_ + {-# LINE 6017 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 536, column 3) + _nameTOut_visit = + ({-# LINE 536 "./src-ag/ExecutionPlan2Caml.ag" #-} + conNmTVisitOut _lhsInt ident_ + {-# LINE 6023 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 537, column 3) + _nameNextState = + ({-# LINE 537 "./src-ag/ExecutionPlan2Caml.ag" #-} + type_nt_sem _lhsInt to_ + {-# LINE 6029 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 538, column 3) + _nameCaller_visit = + ({-# LINE 538 "./src-ag/ExecutionPlan2Caml.ag" #-} + type_caller_visit _lhsInt ident_ + {-# LINE 6035 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 540, column 3) + _nextVisitInfo = + ({-# LINE 540 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.findWithDefault ManyVis to_ _lhsInextVisits + {-# LINE 6041 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 542, column 3) + _t_params = + ({-# LINE 542 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppTypeParams _lhsIparams + {-# LINE 6047 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 543, column 3) + _t_c_params = + ({-# LINE 543 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppTypeParams (cont_tvar : map pp _lhsIparams) + {-# LINE 6053 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 547, column 3) + _lhsOt_visits = + ({-# LINE 547 "./src-ag/ExecutionPlan2Caml.ag" #-} + "and" >#< _t_c_params >#< _nameCaller_visit >#< "=" >#< ppRecordTp + [ nm_inh _lhsInt ident_ >#< ":" >#< _t_params >#< conNmTVisitIn _lhsInt ident_ + , nm_cont _lhsInt ident_ >#< ":" >#< _t_params >#< conNmTVisitOut _lhsInt ident_ >#< "->" >#< cont_tvar + ] + >-< "and" >#< _t_params >#< _nameTIn_visit >#< "=" >#< ppRecordTp _inhpart + >-< "and" >#< _t_params >#< _nameTOut_visit >#< "=" >#< ppRecordTp (_synpart ++ _contpart ) + {-# LINE 6064 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 554, column 3) + _contpart = + ({-# LINE 554 "./src-ag/ExecutionPlan2Caml.ag" #-} + case _nextVisitInfo of + NoneVis -> [] + _ -> [ nm_outarg_cont _lhsInt ident_ >#< ":" >#< _t_params >#< _nameNextState ] + {-# LINE 6072 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 558, column 3) + _inhpart = + ({-# LINE 558 "./src-ag/ExecutionPlan2Caml.ag" #-} + _ppTypeList nm_inarg inh_ _lhsIinhmap + {-# LINE 6078 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 559, column 3) + _synpart = + ({-# LINE 559 "./src-ag/ExecutionPlan2Caml.ag" #-} + _ppTypeList nm_outarg syn_ _lhsIsynmap + {-# LINE 6084 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 560, column 3) + _ppTypeList = + ({-# LINE 560 "./src-ag/ExecutionPlan2Caml.ag" #-} + \f s m -> map (\i -> case Map.lookup i m of + Just tp -> f i _lhsInt ident_ >#< ":" >#< ppTp tp ) $ Set.toList s + {-# LINE 6091 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 794, column 3) + _o_sigs = + ({-# LINE 794 "./src-ag/ExecutionPlan2Caml.ag" #-} + typeSigs _lhsIoptions + {-# LINE 6097 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 795, column 3) + _lhsOsem_visit = + ({-# LINE 795 "./src-ag/ExecutionPlan2Caml.ag" #-} + ( from_ + , let resTp = _t_params >#< _nameTOut_visit + argTp = _t_params >#< _nameTIn_visit + argMatch = ppRecordVal [ nm_inarg i _lhsInt ident_ >#< "=" >#< lhsname True i | i <- Set.toList inh_ ] + in ppFunDecl _o_sigs (nm_visit ident_) [(argMatch, argTp)] resTp _stepsIsem_steps + ) + {-# LINE 6108 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 802, column 3) + _stepsOfollow = + ({-# LINE 802 "./src-ag/ExecutionPlan2Caml.ag" #-} + _nextStBuild >-< _resultval + {-# LINE 6114 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 804, column 3) + _nextArgsMp = + ({-# LINE 804 "./src-ag/ExecutionPlan2Caml.ag" #-} + maybe Map.empty id $ Map.lookup to_ _lhsIallintramap + {-# LINE 6120 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 805, column 3) + _nextArgs = + ({-# LINE 805 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppSpaced $ Map.keys $ _nextArgsMp + {-# LINE 6126 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 806, column 3) + _nextStExp = + ({-# LINE 806 "./src-ag/ExecutionPlan2Caml.ag" #-} + nm_st to_ >#< _nextArgs >#< dummyArg _lhsIoptions (Map.null _nextArgsMp ) + {-# LINE 6132 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 808, column 3) + _resultval = + ({-# LINE 808 "./src-ag/ExecutionPlan2Caml.ag" #-} + ppRecordVal + ( [ nm_outarg i _lhsInt ident_ >#< "=" >#< lhsname False i | i <- Set.toList syn_ ] + ++ [ _nextStRefExp ]) + {-# LINE 6140 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 812, column 3) + (_nextStBuild,_nextStRefExp) = + ({-# LINE 812 "./src-ag/ExecutionPlan2Caml.ag" #-} + case _nextVisitInfo of + NoneVis -> (empty, empty) + _ -> ( "let" >#< nextStName >#< "=" >#< _nextStExp >#< "in" + , nm_outarg_cont _lhsInt ident_ >#< "=" >#< nextStName) + {-# LINE 6149 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 828, column 20) + _stepsOkind = + ({-# LINE 828 "./src-ag/ExecutionPlan2Caml.ag" #-} + kind_ + {-# LINE 6155 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 880, column 22) + _stepsOindex = + ({-# LINE 880 "./src-ag/ExecutionPlan2Caml.ag" #-} + 0 + {-# LINE 6161 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 887, column 22) + _stepsOprevMaxSimRefs = + ({-# LINE 887 "./src-ag/ExecutionPlan2Caml.ag" #-} + 0 + {-# LINE 6167 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 904, column 22) + _stepsOuseParallel = + ({-# LINE 904 "./src-ag/ExecutionPlan2Caml.ag" #-} + False + {-# LINE 6173 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1160, column 3) + _prevVisitInfo = + ({-# LINE 1160 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.findWithDefault ManyVis from_ _lhsInextVisits + {-# LINE 6179 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1161, column 3) + _lhsOchildvisit = + ({-# LINE 1161 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton ident_ _invokecode + {-# LINE 6185 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1162, column 3) + _invokecode = + ({-# LINE 1162 "./src-ag/ExecutionPlan2Caml.ag" #-} + \chld childTp kind follow -> + let code = cont >-< inps >-< call + childNmTo = text $ stname chld to_ + childNmFrom = text $ stname chld from_ + childTpArgs = case childTp of + NT _ args _ -> args + _ -> error "generate visit call: type of the child is not a nonterminal!" + cont = "let" >#< contNm >#< ppArg _o_sigs (ppRecordVal cont_in) cont_in_tp >#< "=" + >-< indent 2 follow + >#< "in" + cont_in = [ nm_outarg i _lhsInt ident_ >#< "=" >#< attrname True chld i | i <- Set.toList syn_ ] + ++ case _nextVisitInfo of + NoneVis -> [] + _ -> [ nm_outarg_cont _lhsInt ident_ >#< "=" >#< childNmTo ] + cont_in_tp = ppTypeParams childTpArgs >#< _nameTOut_visit + inps = "let" >#< inpsNm >#< "=" >#< ppRecordVal + [ nm_inh _lhsInt ident_ >#< "=" >#< ppRecordVal inps_in + , nm_cont _lhsInt ident_ >#< "=" >#< contNm + ] >#< "in" + inps_in = [ nm_inarg i _lhsInt ident_ >#< "=" >#< attrname False chld i | i <- Set.toList inh_ ] + call = childNmFrom >|< "." >|< nm_invoke _lhsInt from_ >#< arg + arg = case _prevVisitInfo of + NoneVis -> error "error: invocation of a visit from a state that has no next visits" + OneVis _ -> pp inpsNm + ManyVis -> pp_parens (con_visit _lhsInt ident_ >#< inpsNm) + in if kind `compatibleKind` kind_ + then Right code + else Left $ IncompatibleVisitKind chld ident_ kind kind_ + {-# LINE 6218 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1268, column 11) + _thisintra = + ({-# LINE 1268 "./src-ag/ExecutionPlan2Caml.ag" #-} + (_uses `Map.union` _nextintra ) `Map.difference` _defsAsMap + {-# LINE 6224 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1269, column 11) + _lhsOintramap = + ({-# LINE 1269 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton from_ _thisintra + {-# LINE 6230 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1270, column 11) + _nextintra = + ({-# LINE 1270 "./src-ag/ExecutionPlan2Caml.ag" #-} + maybe Map.empty id $ Map.lookup to_ _lhsIallintramap + {-# LINE 6236 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1271, column 11) + _uses = + ({-# LINE 1271 "./src-ag/ExecutionPlan2Caml.ag" #-} + let mp1 = _stepsIuses + mp2 = Map.fromList [ (lhsname False i, Just (AttrSyn _LHS i)) | i <- Set.elems syn_ ] + in mp1 `Map.union` mp2 + {-# LINE 6244 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1274, column 11) + _inhVarNms = + ({-# LINE 1274 "./src-ag/ExecutionPlan2Caml.ag" #-} + Set.map (lhsname True) inh_ + {-# LINE 6250 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1275, column 11) + _defs = + ({-# LINE 1275 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIdefs `Set.union` _inhVarNms `Set.union` _lhsIterminaldefs + {-# LINE 6256 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1276, column 11) + _defsAsMap = + ({-# LINE 1276 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.fromList [ (a, Nothing) | a <- Set.elems _defs ] + {-# LINE 6262 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1300, column 11) + _lhsOvisitdefs = + ({-# LINE 1300 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton ident_ syn_ + {-# LINE 6268 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1301, column 11) + _lhsOvisituses = + ({-# LINE 1301 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton ident_ inh_ + {-# LINE 6274 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1333, column 3) + _lazyIntrasInh = + ({-# LINE 1333 "./src-ag/ExecutionPlan2Caml.ag" #-} + case kind_ of + VisitPure False -> _inhVarNms `Set.union` _stepsIdefs + _ -> Set.empty + {-# LINE 6282 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1336, column 3) + _lhsOlazyIntras = + ({-# LINE 1336 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lazyIntrasInh `Set.union` _stepsIlazyIntras + {-# LINE 6288 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1399, column 3) + _lhsOfromToStates = + ({-# LINE 1399 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton ident_ (from_, to_) + {-# LINE 6294 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1443, column 3) + _lhsOvisitKinds = + ({-# LINE 1443 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton ident_ kind_ + {-# LINE 6300 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIerrors + {-# LINE 6306 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1229, column 56) + _lhsOruleKinds = + ({-# LINE 1229 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIruleKinds + {-# LINE 6312 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1217, column 56) + _lhsOruleUsage = + ({-# LINE 1217 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIruleUsage + {-# LINE 6318 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOallFromToStates = + ({-# LINE 1396 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallFromToStates + {-# LINE 6324 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 6330 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOallVisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallVisitKinds + {-# LINE 6336 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOallchildvisit = + ({-# LINE 1149 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallchildvisit + {-# LINE 6342 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOavisitdefs = + ({-# LINE 1306 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisitdefs + {-# LINE 6348 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOavisituses = + ({-# LINE 1307 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisituses + {-# LINE 6354 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOchildTypes = + ({-# LINE 1413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildTypes + {-# LINE 6360 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOchildintros = + ({-# LINE 912 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildintros + {-# LINE 6366 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOmrules = + ({-# LINE 835 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImrules + {-# LINE 6372 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 6378 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOruledefs = + ({-# LINE 1281 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruledefs + {-# LINE 6384 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOruleuses = + ({-# LINE 1282 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruleuses + {-# LINE 6390 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _stepsIdefs,_stepsIerrors,_stepsIindex,_stepsIisLast,_stepsIlazyIntras,_stepsIprevMaxSimRefs,_stepsIruleKinds,_stepsIruleUsage,_stepsIsem_steps,_stepsIsize,_stepsIuses,_stepsIvisitKinds) = + steps_ _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfollow _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOprevMaxSimRefs _stepsOruledefs _stepsOruleuses _stepsOuseParallel + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOintramap,_lhsOlazyIntras,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_visit,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +-- VisitStep --------------------------------------------------- +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInitStates : Map NontermIdent Int + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + childTypes : Map Identifier Type + childintros : Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) + follow : PP_Doc + kind : VisitKind + mrules : Map Identifier (VisitKind -> Either Error PP_Doc) + options : Options + ruledefs : Map Identifier (Set String) + ruleuses : Map Identifier (Map String (Maybe NonLocalAttr)) + useParallel : Bool + chained attributes: + index : Int + isLast : Bool + prevMaxSimRefs : Int + synthesized attributes: + defs : Set String + errors : Seq Error + lazyIntras : Set String + ruleKinds : Map Identifier (Set VisitKind) + ruleUsage : Map Identifier Int + sem_steps : PP_Doc + uses : Map String (Maybe NonLocalAttr) + visitKinds : Map VisitIdentifier VisitKind + alternatives: + alternative Sem: + child name : {Identifier} + visit 0: + local ruleItf : _ + local sem_steps : _ + alternative ChildVisit: + child child : {Identifier} + child nonterm : {NontermIdent} + child visit : {VisitIdentifier} + visit 0: + local visitItf : _ + local childType : _ + local from : _ + local to : _ + alternative PureGroup: + child steps : VisitSteps + child ordered : {Bool} + alternative Sim: + child steps : VisitSteps + visit 0: + local useParallel : _ + alternative ChildIntro: + child child : {Identifier} + visit 0: + local attachItf : _ + local sem_steps : _ +-} +-- cata +sem_VisitStep :: VisitStep -> + T_VisitStep +sem_VisitStep (Sem _name) = + (sem_VisitStep_Sem _name) +sem_VisitStep (ChildVisit _child _nonterm _visit) = + (sem_VisitStep_ChildVisit _child _nonterm _visit) +sem_VisitStep (PureGroup _steps _ordered) = + (sem_VisitStep_PureGroup (sem_VisitSteps _steps) _ordered) +sem_VisitStep (Sim _steps) = + (sem_VisitStep_Sim (sem_VisitSteps _steps)) +sem_VisitStep (ChildIntro _child) = + (sem_VisitStep_ChildIntro _child) +-- semantic domain +newtype T_VisitStep = T_VisitStep ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Int) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map Identifier Type) -> + (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> + PP_Doc -> + Int -> + Bool -> + VisitKind -> + (Map Identifier (VisitKind -> Either Error PP_Doc)) -> + Options -> + Int -> + (Map Identifier (Set String)) -> + (Map Identifier (Map String (Maybe NonLocalAttr))) -> + Bool -> + ( (Set String),(Seq Error),Int,Bool,(Set String),Int,(Map Identifier (Set VisitKind)),(Map Identifier Int),PP_Doc,(Map String (Maybe NonLocalAttr)),(Map VisitIdentifier VisitKind))) +data Inh_VisitStep = Inh_VisitStep {allFromToStates_Inh_VisitStep :: (Map VisitIdentifier (Int,Int)),allInitStates_Inh_VisitStep :: (Map NontermIdent Int),allVisitKinds_Inh_VisitStep :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_VisitStep :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),avisitdefs_Inh_VisitStep :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_VisitStep :: (Map VisitIdentifier (Set Identifier)),childTypes_Inh_VisitStep :: (Map Identifier Type),childintros_Inh_VisitStep :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),follow_Inh_VisitStep :: PP_Doc,index_Inh_VisitStep :: Int,isLast_Inh_VisitStep :: Bool,kind_Inh_VisitStep :: VisitKind,mrules_Inh_VisitStep :: (Map Identifier (VisitKind -> Either Error PP_Doc)),options_Inh_VisitStep :: Options,prevMaxSimRefs_Inh_VisitStep :: Int,ruledefs_Inh_VisitStep :: (Map Identifier (Set String)),ruleuses_Inh_VisitStep :: (Map Identifier (Map String (Maybe NonLocalAttr))),useParallel_Inh_VisitStep :: Bool} +data Syn_VisitStep = Syn_VisitStep {defs_Syn_VisitStep :: (Set String),errors_Syn_VisitStep :: (Seq Error),index_Syn_VisitStep :: Int,isLast_Syn_VisitStep :: Bool,lazyIntras_Syn_VisitStep :: (Set String),prevMaxSimRefs_Syn_VisitStep :: Int,ruleKinds_Syn_VisitStep :: (Map Identifier (Set VisitKind)),ruleUsage_Syn_VisitStep :: (Map Identifier Int),sem_steps_Syn_VisitStep :: PP_Doc,uses_Syn_VisitStep :: (Map String (Maybe NonLocalAttr)),visitKinds_Syn_VisitStep :: (Map VisitIdentifier VisitKind)} +wrap_VisitStep :: T_VisitStep -> + Inh_VisitStep -> + Syn_VisitStep +wrap_VisitStep (T_VisitStep sem) (Inh_VisitStep _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfollow _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) = + (let ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOuses,_lhsOvisitKinds) = sem _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfollow _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel + in (Syn_VisitStep _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOuses _lhsOvisitKinds)) +sem_VisitStep_Sem :: Identifier -> + T_VisitStep +sem_VisitStep_Sem name_ = + (T_VisitStep (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIfollow + _lhsIindex + _lhsIisLast + _lhsIkind + _lhsImrules + _lhsIoptions + _lhsIprevMaxSimRefs + _lhsIruledefs + _lhsIruleuses + _lhsIuseParallel -> + (let _lhsOerrors :: (Seq Error) + _lhsOsem_steps :: PP_Doc + _lhsOruleUsage :: (Map Identifier Int) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOdefs :: (Set String) + _lhsOuses :: (Map String (Maybe NonLocalAttr)) + _lhsOlazyIntras :: (Set String) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOindex :: Int + _lhsOisLast :: Bool + _lhsOprevMaxSimRefs :: Int + -- "./src-ag/ExecutionPlan2Caml.ag"(line 845, column 16) + _ruleItf = + ({-# LINE 845 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.findWithDefault (error $ "Rule " ++ show name_ ++ " not found") name_ _lhsImrules + {-# LINE 6532 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 846, column 16) + (_lhsOerrors,_sem_steps) = + ({-# LINE 846 "./src-ag/ExecutionPlan2Caml.ag" #-} + case _ruleItf _lhsIkind of + Left e -> (Seq.singleton e, empty) + Right stmt -> (Seq.empty, stmt) + {-# LINE 6540 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 849, column 16) + _lhsOsem_steps = + ({-# LINE 849 "./src-ag/ExecutionPlan2Caml.ag" #-} + _sem_steps >-< _lhsIfollow + {-# LINE 6546 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1221, column 32) + _lhsOruleUsage = + ({-# LINE 1221 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton name_ 1 + {-# LINE 6552 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1231, column 3) + _lhsOruleKinds = + ({-# LINE 1231 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.singleton name_ (Set.singleton _lhsIkind) + {-# LINE 6558 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1316, column 16) + _lhsOdefs = + ({-# LINE 1316 "./src-ag/ExecutionPlan2Caml.ag" #-} + maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruledefs + {-# LINE 6564 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1317, column 16) + _lhsOuses = + ({-# LINE 1317 "./src-ag/ExecutionPlan2Caml.ag" #-} + maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruleuses + {-# LINE 6570 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1329, column 57) + _lhsOlazyIntras = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Caml.ag" #-} + Set.empty + {-# LINE 6576 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1440, column 68) + _lhsOvisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + mempty + {-# LINE 6582 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (chain) + _lhsOindex = + ({-# LINE 875 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIindex + {-# LINE 6588 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (chain) + _lhsOisLast = + ({-# LINE 894 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIisLast + {-# LINE 6594 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (chain) + _lhsOprevMaxSimRefs = + ({-# LINE 886 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIprevMaxSimRefs + {-# LINE 6600 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOuses,_lhsOvisitKinds)))) +sem_VisitStep_ChildVisit :: Identifier -> + NontermIdent -> + VisitIdentifier -> + T_VisitStep +sem_VisitStep_ChildVisit child_ nonterm_ visit_ = + (T_VisitStep (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIfollow + _lhsIindex + _lhsIisLast + _lhsIkind + _lhsImrules + _lhsIoptions + _lhsIprevMaxSimRefs + _lhsIruledefs + _lhsIruleuses + _lhsIuseParallel -> + (let _lhsOerrors :: (Seq Error) + _lhsOsem_steps :: PP_Doc + _lhsOdefs :: (Set String) + _lhsOuses :: (Map String (Maybe NonLocalAttr)) + _lhsOlazyIntras :: (Set String) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOindex :: Int + _lhsOisLast :: Bool + _lhsOprevMaxSimRefs :: Int + -- "./src-ag/ExecutionPlan2Caml.ag"(line 856, column 16) + _visitItf = + ({-# LINE 856 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.findWithDefault (error $ "Visit " ++ show visit_ ++ " not found") visit_ _lhsIallchildvisit + {-# LINE 6641 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 857, column 16) + _childType = + ({-# LINE 857 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.findWithDefault (error ("type of child " ++ show child_ ++ " is not in the childTypes map! " ++ show _lhsIchildTypes)) child_ _lhsIchildTypes + {-# LINE 6647 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 858, column 16) + (_lhsOerrors,_lhsOsem_steps) = + ({-# LINE 858 "./src-ag/ExecutionPlan2Caml.ag" #-} + case _visitItf child_ _childType _lhsIkind _lhsIfollow of + Left e -> (Seq.singleton e, empty) + Right steps -> (Seq.empty, steps) + {-# LINE 6655 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1318, column 16) + _lhsOdefs = + ({-# LINE 1318 "./src-ag/ExecutionPlan2Caml.ag" #-} + Set.insert (stname child_ _to) $ maybe (error "Visit not found") (Set.map $ attrname True child_) $ Map.lookup visit_ _lhsIavisitdefs + {-# LINE 6661 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1319, column 16) + _lhsOuses = + ({-# LINE 1319 "./src-ag/ExecutionPlan2Caml.ag" #-} + let convert attrs = Map.fromList [ (attrname False child_ attr, Just $ mkNonLocalAttr True child_ attr) | attr <- Set.elems attrs ] + in Map.insert (stname child_ _from) Nothing $ convert $ + maybe (error "Visit not found") id $ Map.lookup visit_ _lhsIavisituses + {-# LINE 6669 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1405, column 3) + (_from,_to) = + ({-# LINE 1405 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.findWithDefault (error "visit not in allFromToStates") visit_ _lhsIallFromToStates + {-# LINE 6675 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1329, column 57) + _lhsOlazyIntras = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Caml.ag" #-} + Set.empty + {-# LINE 6681 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1229, column 56) + _lhsOruleKinds = + ({-# LINE 1229 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 6687 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1217, column 56) + _lhsOruleUsage = + ({-# LINE 1217 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 6693 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1440, column 68) + _lhsOvisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + mempty + {-# LINE 6699 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (chain) + _lhsOindex = + ({-# LINE 875 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIindex + {-# LINE 6705 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (chain) + _lhsOisLast = + ({-# LINE 894 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIisLast + {-# LINE 6711 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (chain) + _lhsOprevMaxSimRefs = + ({-# LINE 886 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIprevMaxSimRefs + {-# LINE 6717 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOuses,_lhsOvisitKinds)))) +sem_VisitStep_PureGroup :: T_VisitSteps -> + Bool -> + T_VisitStep +sem_VisitStep_PureGroup (T_VisitSteps steps_) ordered_ = + (T_VisitStep (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIfollow + _lhsIindex + _lhsIisLast + _lhsIkind + _lhsImrules + _lhsIoptions + _lhsIprevMaxSimRefs + _lhsIruledefs + _lhsIruleuses + _lhsIuseParallel -> + (let _stepsOkind :: VisitKind + _lhsOlazyIntras :: (Set String) + _lhsOdefs :: (Set String) + _lhsOerrors :: (Seq Error) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOsem_steps :: PP_Doc + _lhsOuses :: (Map String (Maybe NonLocalAttr)) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOindex :: Int + _lhsOisLast :: Bool + _lhsOprevMaxSimRefs :: Int + _stepsOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _stepsOallInitStates :: (Map NontermIdent Int) + _stepsOallVisitKinds :: (Map VisitIdentifier VisitKind) + _stepsOallchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _stepsOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _stepsOavisituses :: (Map VisitIdentifier (Set Identifier)) + _stepsOchildTypes :: (Map Identifier Type) + _stepsOchildintros :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _stepsOfollow :: PP_Doc + _stepsOindex :: Int + _stepsOmrules :: (Map Identifier (VisitKind -> Either Error PP_Doc)) + _stepsOoptions :: Options + _stepsOprevMaxSimRefs :: Int + _stepsOruledefs :: (Map Identifier (Set String)) + _stepsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _stepsOuseParallel :: Bool + _stepsIdefs :: (Set String) + _stepsIerrors :: (Seq Error) + _stepsIindex :: Int + _stepsIisLast :: Bool + _stepsIlazyIntras :: (Set String) + _stepsIprevMaxSimRefs :: Int + _stepsIruleKinds :: (Map Identifier (Set VisitKind)) + _stepsIruleUsage :: (Map Identifier Int) + _stepsIsem_steps :: PP_Doc + _stepsIsize :: Int + _stepsIuses :: (Map String (Maybe NonLocalAttr)) + _stepsIvisitKinds :: (Map VisitIdentifier VisitKind) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 832, column 3) + _stepsOkind = + ({-# LINE 832 "./src-ag/ExecutionPlan2Caml.ag" #-} + VisitPure ordered_ + {-# LINE 6786 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 1339, column 3) + _lhsOlazyIntras = + ({-# LINE 1339 "./src-ag/ExecutionPlan2Caml.ag" #-} + if ordered_ + then _stepsIlazyIntras + else _stepsIdefs + {-# LINE 6794 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1313, column 38) + _lhsOdefs = + ({-# LINE 1313 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIdefs + {-# LINE 6800 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIerrors + {-# LINE 6806 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1229, column 56) + _lhsOruleKinds = + ({-# LINE 1229 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIruleKinds + {-# LINE 6812 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1217, column 56) + _lhsOruleUsage = + ({-# LINE 1217 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIruleUsage + {-# LINE 6818 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 836, column 59) + _lhsOsem_steps = + ({-# LINE 836 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIsem_steps + {-# LINE 6824 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1314, column 38) + _lhsOuses = + ({-# LINE 1314 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIuses + {-# LINE 6830 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1440, column 68) + _lhsOvisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIvisitKinds + {-# LINE 6836 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (up) + _lhsOindex = + ({-# LINE 875 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIindex + {-# LINE 6842 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (up) + _lhsOisLast = + ({-# LINE 894 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIisLast + {-# LINE 6848 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (up) + _lhsOprevMaxSimRefs = + ({-# LINE 886 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIprevMaxSimRefs + {-# LINE 6854 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOallFromToStates = + ({-# LINE 1396 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallFromToStates + {-# LINE 6860 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 6866 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOallVisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallVisitKinds + {-# LINE 6872 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOallchildvisit = + ({-# LINE 1149 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallchildvisit + {-# LINE 6878 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOavisitdefs = + ({-# LINE 1306 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisitdefs + {-# LINE 6884 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOavisituses = + ({-# LINE 1307 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisituses + {-# LINE 6890 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOchildTypes = + ({-# LINE 1413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildTypes + {-# LINE 6896 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOchildintros = + ({-# LINE 912 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildintros + {-# LINE 6902 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOfollow = + ({-# LINE 836 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIfollow + {-# LINE 6908 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOindex = + ({-# LINE 875 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIindex + {-# LINE 6914 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOmrules = + ({-# LINE 835 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImrules + {-# LINE 6920 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 6926 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOprevMaxSimRefs = + ({-# LINE 886 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIprevMaxSimRefs + {-# LINE 6932 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOruledefs = + ({-# LINE 1281 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruledefs + {-# LINE 6938 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOruleuses = + ({-# LINE 1282 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruleuses + {-# LINE 6944 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOuseParallel = + ({-# LINE 903 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIuseParallel + {-# LINE 6950 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _stepsIdefs,_stepsIerrors,_stepsIindex,_stepsIisLast,_stepsIlazyIntras,_stepsIprevMaxSimRefs,_stepsIruleKinds,_stepsIruleUsage,_stepsIsem_steps,_stepsIsize,_stepsIuses,_stepsIvisitKinds) = + steps_ _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfollow _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOprevMaxSimRefs _stepsOruledefs _stepsOruleuses _stepsOuseParallel + in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOuses,_lhsOvisitKinds)))) +sem_VisitStep_Sim :: T_VisitSteps -> + T_VisitStep +sem_VisitStep_Sim (T_VisitSteps steps_) = + (T_VisitStep (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIfollow + _lhsIindex + _lhsIisLast + _lhsIkind + _lhsImrules + _lhsIoptions + _lhsIprevMaxSimRefs + _lhsIruledefs + _lhsIruleuses + _lhsIuseParallel -> + (let _stepsOindex :: Int + _lhsOindex :: Int + _lhsOprevMaxSimRefs :: Int + _lhsOdefs :: (Set String) + _lhsOerrors :: (Seq Error) + _lhsOlazyIntras :: (Set String) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOsem_steps :: PP_Doc + _lhsOuses :: (Map String (Maybe NonLocalAttr)) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOisLast :: Bool + _stepsOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _stepsOallInitStates :: (Map NontermIdent Int) + _stepsOallVisitKinds :: (Map VisitIdentifier VisitKind) + _stepsOallchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _stepsOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _stepsOavisituses :: (Map VisitIdentifier (Set Identifier)) + _stepsOchildTypes :: (Map Identifier Type) + _stepsOchildintros :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _stepsOfollow :: PP_Doc + _stepsOkind :: VisitKind + _stepsOmrules :: (Map Identifier (VisitKind -> Either Error PP_Doc)) + _stepsOoptions :: Options + _stepsOprevMaxSimRefs :: Int + _stepsOruledefs :: (Map Identifier (Set String)) + _stepsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _stepsOuseParallel :: Bool + _stepsIdefs :: (Set String) + _stepsIerrors :: (Seq Error) + _stepsIindex :: Int + _stepsIisLast :: Bool + _stepsIlazyIntras :: (Set String) + _stepsIprevMaxSimRefs :: Int + _stepsIruleKinds :: (Map Identifier (Set VisitKind)) + _stepsIruleUsage :: (Map Identifier Int) + _stepsIsem_steps :: PP_Doc + _stepsIsize :: Int + _stepsIuses :: (Map String (Maybe NonLocalAttr)) + _stepsIvisitKinds :: (Map VisitIdentifier VisitKind) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 881, column 22) + _stepsOindex = + ({-# LINE 881 "./src-ag/ExecutionPlan2Caml.ag" #-} + 0 + {-# LINE 7020 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 882, column 22) + _lhsOindex = + ({-# LINE 882 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIindex + {-# LINE 7026 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 889, column 3) + _lhsOprevMaxSimRefs = + ({-# LINE 889 "./src-ag/ExecutionPlan2Caml.ag" #-} + if _useParallel + then _lhsIprevMaxSimRefs `max` (_stepsIindex - 1) + else _lhsIprevMaxSimRefs + {-# LINE 7034 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 905, column 22) + _useParallel = + ({-# LINE 905 "./src-ag/ExecutionPlan2Caml.ag" #-} + parallelInvoke _lhsIoptions && _stepsIsize > 1 + {-# LINE 7040 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1313, column 38) + _lhsOdefs = + ({-# LINE 1313 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIdefs + {-# LINE 7046 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIerrors + {-# LINE 7052 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1329, column 57) + _lhsOlazyIntras = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIlazyIntras + {-# LINE 7058 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1229, column 56) + _lhsOruleKinds = + ({-# LINE 1229 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIruleKinds + {-# LINE 7064 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1217, column 56) + _lhsOruleUsage = + ({-# LINE 1217 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIruleUsage + {-# LINE 7070 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 836, column 59) + _lhsOsem_steps = + ({-# LINE 836 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIsem_steps + {-# LINE 7076 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1314, column 38) + _lhsOuses = + ({-# LINE 1314 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIuses + {-# LINE 7082 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1440, column 68) + _lhsOvisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIvisitKinds + {-# LINE 7088 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (up) + _lhsOisLast = + ({-# LINE 894 "./src-ag/ExecutionPlan2Caml.ag" #-} + _stepsIisLast + {-# LINE 7094 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOallFromToStates = + ({-# LINE 1396 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallFromToStates + {-# LINE 7100 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 7106 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOallVisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallVisitKinds + {-# LINE 7112 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOallchildvisit = + ({-# LINE 1149 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallchildvisit + {-# LINE 7118 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOavisitdefs = + ({-# LINE 1306 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisitdefs + {-# LINE 7124 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOavisituses = + ({-# LINE 1307 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisituses + {-# LINE 7130 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOchildTypes = + ({-# LINE 1413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildTypes + {-# LINE 7136 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOchildintros = + ({-# LINE 912 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildintros + {-# LINE 7142 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOfollow = + ({-# LINE 836 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIfollow + {-# LINE 7148 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOkind = + ({-# LINE 827 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIkind + {-# LINE 7154 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOmrules = + ({-# LINE 835 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImrules + {-# LINE 7160 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 7166 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOprevMaxSimRefs = + ({-# LINE 886 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIprevMaxSimRefs + {-# LINE 7172 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOruledefs = + ({-# LINE 1281 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruledefs + {-# LINE 7178 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _stepsOruleuses = + ({-# LINE 1282 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruleuses + {-# LINE 7184 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (from local) + _stepsOuseParallel = + ({-# LINE 903 "./src-ag/ExecutionPlan2Caml.ag" #-} + _useParallel + {-# LINE 7190 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _stepsIdefs,_stepsIerrors,_stepsIindex,_stepsIisLast,_stepsIlazyIntras,_stepsIprevMaxSimRefs,_stepsIruleKinds,_stepsIruleUsage,_stepsIsem_steps,_stepsIsize,_stepsIuses,_stepsIvisitKinds) = + steps_ _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfollow _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOprevMaxSimRefs _stepsOruledefs _stepsOruleuses _stepsOuseParallel + in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOuses,_lhsOvisitKinds)))) +sem_VisitStep_ChildIntro :: Identifier -> + T_VisitStep +sem_VisitStep_ChildIntro child_ = + (T_VisitStep (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIfollow + _lhsIindex + _lhsIisLast + _lhsIkind + _lhsImrules + _lhsIoptions + _lhsIprevMaxSimRefs + _lhsIruledefs + _lhsIruleuses + _lhsIuseParallel -> + (let _lhsOerrors :: (Seq Error) + _lhsOdefs :: (Set String) + _lhsOuses :: (Map String (Maybe NonLocalAttr)) + _lhsOsem_steps :: PP_Doc + _lhsOlazyIntras :: (Set String) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOindex :: Int + _lhsOisLast :: Bool + _lhsOprevMaxSimRefs :: Int + -- "./src-ag/ExecutionPlan2Caml.ag"(line 850, column 16) + _attachItf = + ({-# LINE 850 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.findWithDefault (error $ "Child " ++ show child_ ++ " not found") child_ _lhsIchildintros + {-# LINE 7231 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 851, column 16) + (_lhsOerrors,_sem_steps,_lhsOdefs,_lhsOuses) = + ({-# LINE 851 "./src-ag/ExecutionPlan2Caml.ag" #-} + case _attachItf _lhsIkind of + Left e -> (Seq.singleton e, empty, Set.empty, Map.empty) + Right (code, defs, uses) -> (Seq.empty, code, defs, uses) + {-# LINE 7239 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 855, column 16) + _lhsOsem_steps = + ({-# LINE 855 "./src-ag/ExecutionPlan2Caml.ag" #-} + _sem_steps >-< _lhsIfollow + {-# LINE 7245 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1329, column 57) + _lhsOlazyIntras = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Caml.ag" #-} + Set.empty + {-# LINE 7251 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1229, column 56) + _lhsOruleKinds = + ({-# LINE 1229 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 7257 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1217, column 56) + _lhsOruleUsage = + ({-# LINE 1217 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 7263 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1440, column 68) + _lhsOvisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + mempty + {-# LINE 7269 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (chain) + _lhsOindex = + ({-# LINE 875 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIindex + {-# LINE 7275 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (chain) + _lhsOisLast = + ({-# LINE 894 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIisLast + {-# LINE 7281 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (chain) + _lhsOprevMaxSimRefs = + ({-# LINE 886 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIprevMaxSimRefs + {-# LINE 7287 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOuses,_lhsOvisitKinds)))) +-- VisitSteps -------------------------------------------------- +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInitStates : Map NontermIdent Int + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + childTypes : Map Identifier Type + childintros : Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) + follow : PP_Doc + kind : VisitKind + mrules : Map Identifier (VisitKind -> Either Error PP_Doc) + options : Options + ruledefs : Map Identifier (Set String) + ruleuses : Map Identifier (Map String (Maybe NonLocalAttr)) + useParallel : Bool + chained attributes: + index : Int + prevMaxSimRefs : Int + synthesized attributes: + defs : Set String + errors : Seq Error + isLast : Bool + lazyIntras : Set String + ruleKinds : Map Identifier (Set VisitKind) + ruleUsage : Map Identifier Int + sem_steps : PP_Doc + size : Int + uses : Map String (Maybe NonLocalAttr) + visitKinds : Map VisitIdentifier VisitKind + alternatives: + alternative Cons: + child hd : VisitStep + child tl : VisitSteps + alternative Nil: +-} +-- cata +sem_VisitSteps :: VisitSteps -> + T_VisitSteps +sem_VisitSteps list = + (Prelude.foldr sem_VisitSteps_Cons sem_VisitSteps_Nil (Prelude.map sem_VisitStep list)) +-- semantic domain +newtype T_VisitSteps = T_VisitSteps ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Int) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map Identifier Type) -> + (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> + PP_Doc -> + Int -> + VisitKind -> + (Map Identifier (VisitKind -> Either Error PP_Doc)) -> + Options -> + Int -> + (Map Identifier (Set String)) -> + (Map Identifier (Map String (Maybe NonLocalAttr))) -> + Bool -> + ( (Set String),(Seq Error),Int,Bool,(Set String),Int,(Map Identifier (Set VisitKind)),(Map Identifier Int),PP_Doc,Int,(Map String (Maybe NonLocalAttr)),(Map VisitIdentifier VisitKind))) +data Inh_VisitSteps = Inh_VisitSteps {allFromToStates_Inh_VisitSteps :: (Map VisitIdentifier (Int,Int)),allInitStates_Inh_VisitSteps :: (Map NontermIdent Int),allVisitKinds_Inh_VisitSteps :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_VisitSteps :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),avisitdefs_Inh_VisitSteps :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_VisitSteps :: (Map VisitIdentifier (Set Identifier)),childTypes_Inh_VisitSteps :: (Map Identifier Type),childintros_Inh_VisitSteps :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),follow_Inh_VisitSteps :: PP_Doc,index_Inh_VisitSteps :: Int,kind_Inh_VisitSteps :: VisitKind,mrules_Inh_VisitSteps :: (Map Identifier (VisitKind -> Either Error PP_Doc)),options_Inh_VisitSteps :: Options,prevMaxSimRefs_Inh_VisitSteps :: Int,ruledefs_Inh_VisitSteps :: (Map Identifier (Set String)),ruleuses_Inh_VisitSteps :: (Map Identifier (Map String (Maybe NonLocalAttr))),useParallel_Inh_VisitSteps :: Bool} +data Syn_VisitSteps = Syn_VisitSteps {defs_Syn_VisitSteps :: (Set String),errors_Syn_VisitSteps :: (Seq Error),index_Syn_VisitSteps :: Int,isLast_Syn_VisitSteps :: Bool,lazyIntras_Syn_VisitSteps :: (Set String),prevMaxSimRefs_Syn_VisitSteps :: Int,ruleKinds_Syn_VisitSteps :: (Map Identifier (Set VisitKind)),ruleUsage_Syn_VisitSteps :: (Map Identifier Int),sem_steps_Syn_VisitSteps :: PP_Doc,size_Syn_VisitSteps :: Int,uses_Syn_VisitSteps :: (Map String (Maybe NonLocalAttr)),visitKinds_Syn_VisitSteps :: (Map VisitIdentifier VisitKind)} +wrap_VisitSteps :: T_VisitSteps -> + Inh_VisitSteps -> + Syn_VisitSteps +wrap_VisitSteps (T_VisitSteps sem) (Inh_VisitSteps _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfollow _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) = + (let ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsize,_lhsOuses,_lhsOvisitKinds) = sem _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfollow _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel + in (Syn_VisitSteps _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsize _lhsOuses _lhsOvisitKinds)) +sem_VisitSteps_Cons :: T_VisitStep -> + T_VisitSteps -> + T_VisitSteps +sem_VisitSteps_Cons (T_VisitStep hd_) (T_VisitSteps tl_) = + (T_VisitSteps (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIfollow + _lhsIindex + _lhsIkind + _lhsImrules + _lhsIoptions + _lhsIprevMaxSimRefs + _lhsIruledefs + _lhsIruleuses + _lhsIuseParallel -> + (let _hdOfollow :: PP_Doc + _lhsOsem_steps :: PP_Doc + _lhsOsize :: Int + _hdOindex :: Int + _tlOindex :: Int + _lhsOindex :: Int + _lhsOisLast :: Bool + _hdOisLast :: Bool + _lhsOdefs :: (Set String) + _lhsOerrors :: (Seq Error) + _lhsOlazyIntras :: (Set String) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOuses :: (Map String (Maybe NonLocalAttr)) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOprevMaxSimRefs :: Int + _hdOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _hdOallInitStates :: (Map NontermIdent Int) + _hdOallVisitKinds :: (Map VisitIdentifier VisitKind) + _hdOallchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _hdOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _hdOavisituses :: (Map VisitIdentifier (Set Identifier)) + _hdOchildTypes :: (Map Identifier Type) + _hdOchildintros :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _hdOkind :: VisitKind + _hdOmrules :: (Map Identifier (VisitKind -> Either Error PP_Doc)) + _hdOoptions :: Options + _hdOprevMaxSimRefs :: Int + _hdOruledefs :: (Map Identifier (Set String)) + _hdOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _hdOuseParallel :: Bool + _tlOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _tlOallInitStates :: (Map NontermIdent Int) + _tlOallVisitKinds :: (Map VisitIdentifier VisitKind) + _tlOallchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _tlOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _tlOavisituses :: (Map VisitIdentifier (Set Identifier)) + _tlOchildTypes :: (Map Identifier Type) + _tlOchildintros :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _tlOfollow :: PP_Doc + _tlOkind :: VisitKind + _tlOmrules :: (Map Identifier (VisitKind -> Either Error PP_Doc)) + _tlOoptions :: Options + _tlOprevMaxSimRefs :: Int + _tlOruledefs :: (Map Identifier (Set String)) + _tlOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _tlOuseParallel :: Bool + _hdIdefs :: (Set String) + _hdIerrors :: (Seq Error) + _hdIindex :: Int + _hdIisLast :: Bool + _hdIlazyIntras :: (Set String) + _hdIprevMaxSimRefs :: Int + _hdIruleKinds :: (Map Identifier (Set VisitKind)) + _hdIruleUsage :: (Map Identifier Int) + _hdIsem_steps :: PP_Doc + _hdIuses :: (Map String (Maybe NonLocalAttr)) + _hdIvisitKinds :: (Map VisitIdentifier VisitKind) + _tlIdefs :: (Set String) + _tlIerrors :: (Seq Error) + _tlIindex :: Int + _tlIisLast :: Bool + _tlIlazyIntras :: (Set String) + _tlIprevMaxSimRefs :: Int + _tlIruleKinds :: (Map Identifier (Set VisitKind)) + _tlIruleUsage :: (Map Identifier Int) + _tlIsem_steps :: PP_Doc + _tlIsize :: Int + _tlIuses :: (Map String (Maybe NonLocalAttr)) + _tlIvisitKinds :: (Map VisitIdentifier VisitKind) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 840, column 11) + _hdOfollow = + ({-# LINE 840 "./src-ag/ExecutionPlan2Caml.ag" #-} + _tlIsem_steps + {-# LINE 7456 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 841, column 11) + _lhsOsem_steps = + ({-# LINE 841 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIsem_steps + {-# LINE 7462 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 872, column 10) + _lhsOsize = + ({-# LINE 872 "./src-ag/ExecutionPlan2Caml.ag" #-} + 1 + _tlIsize + {-# LINE 7468 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 877, column 3) + _hdOindex = + ({-# LINE 877 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIindex + {-# LINE 7474 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 878, column 3) + _tlOindex = + ({-# LINE 878 "./src-ag/ExecutionPlan2Caml.ag" #-} + 1 + _lhsIindex + {-# LINE 7480 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 879, column 3) + _lhsOindex = + ({-# LINE 879 "./src-ag/ExecutionPlan2Caml.ag" #-} + _tlIindex + {-# LINE 7486 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 898, column 11) + _lhsOisLast = + ({-# LINE 898 "./src-ag/ExecutionPlan2Caml.ag" #-} + False + {-# LINE 7492 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 899, column 11) + _hdOisLast = + ({-# LINE 899 "./src-ag/ExecutionPlan2Caml.ag" #-} + _tlIisLast + {-# LINE 7498 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1313, column 38) + _lhsOdefs = + ({-# LINE 1313 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIdefs `Set.union` _tlIdefs + {-# LINE 7504 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 7510 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1329, column 57) + _lhsOlazyIntras = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIlazyIntras `Set.union` _tlIlazyIntras + {-# LINE 7516 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1229, column 56) + _lhsOruleKinds = + ({-# LINE 1229 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIruleKinds `unionWithMappend` _tlIruleKinds + {-# LINE 7522 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1217, column 56) + _lhsOruleUsage = + ({-# LINE 1217 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIruleUsage `unionWithSum` _tlIruleUsage + {-# LINE 7528 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1314, column 38) + _lhsOuses = + ({-# LINE 1314 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIuses `Map.union` _tlIuses + {-# LINE 7534 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1440, column 68) + _lhsOvisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIvisitKinds `mappend` _tlIvisitKinds + {-# LINE 7540 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (up) + _lhsOprevMaxSimRefs = + ({-# LINE 886 "./src-ag/ExecutionPlan2Caml.ag" #-} + _tlIprevMaxSimRefs + {-# LINE 7546 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallFromToStates = + ({-# LINE 1396 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallFromToStates + {-# LINE 7552 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 7558 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallVisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallVisitKinds + {-# LINE 7564 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 1149 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallchildvisit + {-# LINE 7570 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 1306 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisitdefs + {-# LINE 7576 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 1307 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisituses + {-# LINE 7582 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOchildTypes = + ({-# LINE 1413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildTypes + {-# LINE 7588 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOchildintros = + ({-# LINE 912 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildintros + {-# LINE 7594 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOkind = + ({-# LINE 827 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIkind + {-# LINE 7600 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOmrules = + ({-# LINE 835 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImrules + {-# LINE 7606 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 7612 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOprevMaxSimRefs = + ({-# LINE 886 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIprevMaxSimRefs + {-# LINE 7618 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOruledefs = + ({-# LINE 1281 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruledefs + {-# LINE 7624 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOruleuses = + ({-# LINE 1282 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruleuses + {-# LINE 7630 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOuseParallel = + ({-# LINE 903 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIuseParallel + {-# LINE 7636 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallFromToStates = + ({-# LINE 1396 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallFromToStates + {-# LINE 7642 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 7648 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallVisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallVisitKinds + {-# LINE 7654 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 1149 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallchildvisit + {-# LINE 7660 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 1306 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisitdefs + {-# LINE 7666 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 1307 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisituses + {-# LINE 7672 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOchildTypes = + ({-# LINE 1413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildTypes + {-# LINE 7678 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOchildintros = + ({-# LINE 912 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildintros + {-# LINE 7684 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOfollow = + ({-# LINE 836 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIfollow + {-# LINE 7690 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOkind = + ({-# LINE 827 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIkind + {-# LINE 7696 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOmrules = + ({-# LINE 835 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImrules + {-# LINE 7702 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 7708 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (chain) + _tlOprevMaxSimRefs = + ({-# LINE 886 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIprevMaxSimRefs + {-# LINE 7714 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOruledefs = + ({-# LINE 1281 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruledefs + {-# LINE 7720 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOruleuses = + ({-# LINE 1282 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruleuses + {-# LINE 7726 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOuseParallel = + ({-# LINE 903 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIuseParallel + {-# LINE 7732 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _hdIdefs,_hdIerrors,_hdIindex,_hdIisLast,_hdIlazyIntras,_hdIprevMaxSimRefs,_hdIruleKinds,_hdIruleUsage,_hdIsem_steps,_hdIuses,_hdIvisitKinds) = + hd_ _hdOallFromToStates _hdOallInitStates _hdOallVisitKinds _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOchildTypes _hdOchildintros _hdOfollow _hdOindex _hdOisLast _hdOkind _hdOmrules _hdOoptions _hdOprevMaxSimRefs _hdOruledefs _hdOruleuses _hdOuseParallel + ( _tlIdefs,_tlIerrors,_tlIindex,_tlIisLast,_tlIlazyIntras,_tlIprevMaxSimRefs,_tlIruleKinds,_tlIruleUsage,_tlIsem_steps,_tlIsize,_tlIuses,_tlIvisitKinds) = + tl_ _tlOallFromToStates _tlOallInitStates _tlOallVisitKinds _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOchildTypes _tlOchildintros _tlOfollow _tlOindex _tlOkind _tlOmrules _tlOoptions _tlOprevMaxSimRefs _tlOruledefs _tlOruleuses _tlOuseParallel + in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsize,_lhsOuses,_lhsOvisitKinds)))) +sem_VisitSteps_Nil :: T_VisitSteps +sem_VisitSteps_Nil = + (T_VisitSteps (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIfollow + _lhsIindex + _lhsIkind + _lhsImrules + _lhsIoptions + _lhsIprevMaxSimRefs + _lhsIruledefs + _lhsIruleuses + _lhsIuseParallel -> + (let _lhsOsem_steps :: PP_Doc + _lhsOsize :: Int + _lhsOisLast :: Bool + _lhsOdefs :: (Set String) + _lhsOerrors :: (Seq Error) + _lhsOlazyIntras :: (Set String) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOuses :: (Map String (Maybe NonLocalAttr)) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOindex :: Int + _lhsOprevMaxSimRefs :: Int + -- "./src-ag/ExecutionPlan2Caml.ag"(line 842, column 11) + _lhsOsem_steps = + ({-# LINE 842 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIfollow + {-# LINE 7774 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 871, column 10) + _lhsOsize = + ({-# LINE 871 "./src-ag/ExecutionPlan2Caml.ag" #-} + 0 + {-# LINE 7780 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Caml.ag"(line 897, column 11) + _lhsOisLast = + ({-# LINE 897 "./src-ag/ExecutionPlan2Caml.ag" #-} + True + {-# LINE 7786 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1313, column 38) + _lhsOdefs = + ({-# LINE 1313 "./src-ag/ExecutionPlan2Caml.ag" #-} + Set.empty + {-# LINE 7792 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + Seq.empty + {-# LINE 7798 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1329, column 57) + _lhsOlazyIntras = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Caml.ag" #-} + Set.empty + {-# LINE 7804 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1229, column 56) + _lhsOruleKinds = + ({-# LINE 1229 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 7810 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1217, column 56) + _lhsOruleUsage = + ({-# LINE 1217 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 7816 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1314, column 38) + _lhsOuses = + ({-# LINE 1314 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 7822 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1440, column 68) + _lhsOvisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + mempty + {-# LINE 7828 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (chain) + _lhsOindex = + ({-# LINE 875 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIindex + {-# LINE 7834 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (chain) + _lhsOprevMaxSimRefs = + ({-# LINE 886 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIprevMaxSimRefs + {-# LINE 7840 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsize,_lhsOuses,_lhsOvisitKinds)))) +-- Visits ------------------------------------------------------ +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInhmap : Map NontermIdent Attributes + allInitStates : Map NontermIdent Int + allSynmap : Map NontermIdent Attributes + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) + allintramap : Map StateIdentifier (Map String (Maybe NonLocalAttr)) + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + childTypes : Map Identifier Type + childintros : Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) + con : ConstructorIdent + inhmap : Attributes + mrules : Map Identifier (VisitKind -> Either Error PP_Doc) + nextVisits : Map StateIdentifier StateCtx + nt : NontermIdent + options : Options + params : [Identifier] + prevVisits : Map StateIdentifier StateCtx + ruledefs : Map Identifier (Set String) + ruleuses : Map Identifier (Map String (Maybe NonLocalAttr)) + synmap : Attributes + terminaldefs : Set String + synthesized attributes: + allvisits : [VisitStateState] + childvisit : Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) + errors : Seq Error + fromToStates : Map VisitIdentifier (Int,Int) + intramap : Map StateIdentifier (Map String (Maybe NonLocalAttr)) + lazyIntras : Set String + ruleKinds : Map Identifier (Set VisitKind) + ruleUsage : Map Identifier Int + sem_visit : [(StateIdentifier,PP_Doc)] + t_visits : PP_Doc + visitKinds : Map VisitIdentifier VisitKind + visitdefs : Map VisitIdentifier (Set Identifier) + visituses : Map VisitIdentifier (Set Identifier) + alternatives: + alternative Cons: + child hd : Visit + child tl : Visits + alternative Nil: +-} +-- cata +sem_Visits :: Visits -> + T_Visits +sem_Visits list = + (Prelude.foldr sem_Visits_Cons sem_Visits_Nil (Prelude.map sem_Visit list)) +-- semantic domain +newtype T_Visits = T_Visits ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Attributes) -> + (Map NontermIdent Int) -> + (Map NontermIdent Attributes) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> + (Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map Identifier Type) -> + (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> + ConstructorIdent -> + Attributes -> + (Map Identifier (VisitKind -> Either Error PP_Doc)) -> + (Map StateIdentifier StateCtx) -> + NontermIdent -> + Options -> + ([Identifier]) -> + (Map StateIdentifier StateCtx) -> + (Map Identifier (Set String)) -> + (Map Identifier (Map String (Maybe NonLocalAttr))) -> + Attributes -> + (Set String) -> + ( ([VisitStateState]),(Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),(Seq Error),(Map VisitIdentifier (Int,Int)),(Map StateIdentifier (Map String (Maybe NonLocalAttr))),(Set String),(Map Identifier (Set VisitKind)),(Map Identifier Int),( [(StateIdentifier,PP_Doc)] ),PP_Doc,(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier)))) +data Inh_Visits = Inh_Visits {allFromToStates_Inh_Visits :: (Map VisitIdentifier (Int,Int)),allInhmap_Inh_Visits :: (Map NontermIdent Attributes),allInitStates_Inh_Visits :: (Map NontermIdent Int),allSynmap_Inh_Visits :: (Map NontermIdent Attributes),allVisitKinds_Inh_Visits :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_Visits :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),allintramap_Inh_Visits :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))),avisitdefs_Inh_Visits :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_Visits :: (Map VisitIdentifier (Set Identifier)),childTypes_Inh_Visits :: (Map Identifier Type),childintros_Inh_Visits :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),con_Inh_Visits :: ConstructorIdent,inhmap_Inh_Visits :: Attributes,mrules_Inh_Visits :: (Map Identifier (VisitKind -> Either Error PP_Doc)),nextVisits_Inh_Visits :: (Map StateIdentifier StateCtx),nt_Inh_Visits :: NontermIdent,options_Inh_Visits :: Options,params_Inh_Visits :: ([Identifier]),prevVisits_Inh_Visits :: (Map StateIdentifier StateCtx),ruledefs_Inh_Visits :: (Map Identifier (Set String)),ruleuses_Inh_Visits :: (Map Identifier (Map String (Maybe NonLocalAttr))),synmap_Inh_Visits :: Attributes,terminaldefs_Inh_Visits :: (Set String)} +data Syn_Visits = Syn_Visits {allvisits_Syn_Visits :: ([VisitStateState]),childvisit_Syn_Visits :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)),errors_Syn_Visits :: (Seq Error),fromToStates_Syn_Visits :: (Map VisitIdentifier (Int,Int)),intramap_Syn_Visits :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))),lazyIntras_Syn_Visits :: (Set String),ruleKinds_Syn_Visits :: (Map Identifier (Set VisitKind)),ruleUsage_Syn_Visits :: (Map Identifier Int),sem_visit_Syn_Visits :: ( [(StateIdentifier,PP_Doc)] ),t_visits_Syn_Visits :: PP_Doc,visitKinds_Syn_Visits :: (Map VisitIdentifier VisitKind),visitdefs_Syn_Visits :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_Visits :: (Map VisitIdentifier (Set Identifier))} +wrap_Visits :: T_Visits -> + Inh_Visits -> + Syn_Visits +wrap_Visits (T_Visits sem) (Inh_Visits _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOintramap,_lhsOlazyIntras,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_visit,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs + in (Syn_Visits _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses)) +sem_Visits_Cons :: T_Visit -> + T_Visits -> + T_Visits +sem_Visits_Cons (T_Visit hd_) (T_Visits tl_) = + (T_Visits (\ _lhsIallFromToStates + _lhsIallInhmap + _lhsIallInitStates + _lhsIallSynmap + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIallintramap + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIcon + _lhsIinhmap + _lhsImrules + _lhsInextVisits + _lhsInt + _lhsIoptions + _lhsIparams + _lhsIprevVisits + _lhsIruledefs + _lhsIruleuses + _lhsIsynmap + _lhsIterminaldefs -> + (let _lhsOallvisits :: ([VisitStateState]) + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _lhsOlazyIntras :: (Set String) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOsem_visit :: ( [(StateIdentifier,PP_Doc)] ) + _lhsOt_visits :: PP_Doc + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + _hdOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _hdOallInhmap :: (Map NontermIdent Attributes) + _hdOallInitStates :: (Map NontermIdent Int) + _hdOallSynmap :: (Map NontermIdent Attributes) + _hdOallVisitKinds :: (Map VisitIdentifier VisitKind) + _hdOallchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _hdOallintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _hdOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _hdOavisituses :: (Map VisitIdentifier (Set Identifier)) + _hdOchildTypes :: (Map Identifier Type) + _hdOchildintros :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _hdOcon :: ConstructorIdent + _hdOinhmap :: Attributes + _hdOmrules :: (Map Identifier (VisitKind -> Either Error PP_Doc)) + _hdOnextVisits :: (Map StateIdentifier StateCtx) + _hdOnt :: NontermIdent + _hdOoptions :: Options + _hdOparams :: ([Identifier]) + _hdOprevVisits :: (Map StateIdentifier StateCtx) + _hdOruledefs :: (Map Identifier (Set String)) + _hdOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _hdOsynmap :: Attributes + _hdOterminaldefs :: (Set String) + _tlOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _tlOallInhmap :: (Map NontermIdent Attributes) + _tlOallInitStates :: (Map NontermIdent Int) + _tlOallSynmap :: (Map NontermIdent Attributes) + _tlOallVisitKinds :: (Map VisitIdentifier VisitKind) + _tlOallchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _tlOallintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _tlOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _tlOavisituses :: (Map VisitIdentifier (Set Identifier)) + _tlOchildTypes :: (Map Identifier Type) + _tlOchildintros :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _tlOcon :: ConstructorIdent + _tlOinhmap :: Attributes + _tlOmrules :: (Map Identifier (VisitKind -> Either Error PP_Doc)) + _tlOnextVisits :: (Map StateIdentifier StateCtx) + _tlOnt :: NontermIdent + _tlOoptions :: Options + _tlOparams :: ([Identifier]) + _tlOprevVisits :: (Map StateIdentifier StateCtx) + _tlOruledefs :: (Map Identifier (Set String)) + _tlOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _tlOsynmap :: Attributes + _tlOterminaldefs :: (Set String) + _hdIallvisits :: ( VisitStateState ) + _hdIchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _hdIerrors :: (Seq Error) + _hdIfromToStates :: (Map VisitIdentifier (Int,Int)) + _hdIintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _hdIlazyIntras :: (Set String) + _hdIruleKinds :: (Map Identifier (Set VisitKind)) + _hdIruleUsage :: (Map Identifier Int) + _hdIsem_visit :: ( (StateIdentifier,PP_Doc) ) + _hdIt_visits :: PP_Doc + _hdIvisitKinds :: (Map VisitIdentifier VisitKind) + _hdIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _hdIvisituses :: (Map VisitIdentifier (Set Identifier)) + _tlIallvisits :: ([VisitStateState]) + _tlIchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _tlIerrors :: (Seq Error) + _tlIfromToStates :: (Map VisitIdentifier (Int,Int)) + _tlIintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _tlIlazyIntras :: (Set String) + _tlIruleKinds :: (Map Identifier (Set VisitKind)) + _tlIruleUsage :: (Map Identifier Int) + _tlIsem_visit :: ( [(StateIdentifier,PP_Doc)] ) + _tlIt_visits :: PP_Doc + _tlIvisitKinds :: (Map VisitIdentifier VisitKind) + _tlIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _tlIvisituses :: (Map VisitIdentifier (Set Identifier)) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 427, column 29) + _lhsOallvisits = + ({-# LINE 427 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIallvisits : _tlIallvisits + {-# LINE 8044 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1147, column 37) + _lhsOchildvisit = + ({-# LINE 1147 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIchildvisit `Map.union` _tlIchildvisit + {-# LINE 8050 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 8056 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1393, column 22) + _lhsOfromToStates = + ({-# LINE 1393 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIfromToStates `mappend` _tlIfromToStates + {-# LINE 8062 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1255, column 34) + _lhsOintramap = + ({-# LINE 1255 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIintramap `uwMapUnion` _tlIintramap + {-# LINE 8068 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1329, column 57) + _lhsOlazyIntras = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIlazyIntras `Set.union` _tlIlazyIntras + {-# LINE 8074 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1229, column 56) + _lhsOruleKinds = + ({-# LINE 1229 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIruleKinds `unionWithMappend` _tlIruleKinds + {-# LINE 8080 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1217, column 56) + _lhsOruleUsage = + ({-# LINE 1217 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIruleUsage `unionWithSum` _tlIruleUsage + {-# LINE 8086 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 791, column 29) + _lhsOsem_visit = + ({-# LINE 791 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIsem_visit : _tlIsem_visit + {-# LINE 8092 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 527, column 59) + _lhsOt_visits = + ({-# LINE 527 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIt_visits >-< _tlIt_visits + {-# LINE 8098 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1440, column 68) + _lhsOvisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIvisitKinds `mappend` _tlIvisitKinds + {-# LINE 8104 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1296, column 36) + _lhsOvisitdefs = + ({-# LINE 1296 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIvisitdefs `uwSetUnion` _tlIvisitdefs + {-# LINE 8110 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1297, column 36) + _lhsOvisituses = + ({-# LINE 1297 "./src-ag/ExecutionPlan2Caml.ag" #-} + _hdIvisituses `uwSetUnion` _tlIvisituses + {-# LINE 8116 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallFromToStates = + ({-# LINE 1396 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallFromToStates + {-# LINE 8122 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallInhmap = + ({-# LINE 412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInhmap + {-# LINE 8128 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 8134 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallSynmap = + ({-# LINE 413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallSynmap + {-# LINE 8140 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallVisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallVisitKinds + {-# LINE 8146 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 1146 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallchildvisit + {-# LINE 8152 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOallintramap = + ({-# LINE 1254 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallintramap + {-# LINE 8158 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 1306 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisitdefs + {-# LINE 8164 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 1307 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisituses + {-# LINE 8170 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOchildTypes = + ({-# LINE 1413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildTypes + {-# LINE 8176 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOchildintros = + ({-# LINE 912 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildintros + {-# LINE 8182 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 86 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIcon + {-# LINE 8188 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 410 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 8194 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOmrules = + ({-# LINE 835 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImrules + {-# LINE 8200 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOnextVisits = + ({-# LINE 1382 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInextVisits + {-# LINE 8206 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 82 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInt + {-# LINE 8212 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 8218 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOparams = + ({-# LINE 92 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIparams + {-# LINE 8224 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOprevVisits = + ({-# LINE 1382 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIprevVisits + {-# LINE 8230 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOruledefs = + ({-# LINE 1281 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruledefs + {-# LINE 8236 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOruleuses = + ({-# LINE 1282 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruleuses + {-# LINE 8242 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 411 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 8248 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _hdOterminaldefs = + ({-# LINE 1257 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIterminaldefs + {-# LINE 8254 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallFromToStates = + ({-# LINE 1396 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallFromToStates + {-# LINE 8260 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallInhmap = + ({-# LINE 412 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInhmap + {-# LINE 8266 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallInitStates = + ({-# LINE 1454 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallInitStates + {-# LINE 8272 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallSynmap = + ({-# LINE 413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallSynmap + {-# LINE 8278 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallVisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallVisitKinds + {-# LINE 8284 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 1146 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallchildvisit + {-# LINE 8290 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOallintramap = + ({-# LINE 1254 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIallintramap + {-# LINE 8296 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 1306 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisitdefs + {-# LINE 8302 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 1307 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIavisituses + {-# LINE 8308 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOchildTypes = + ({-# LINE 1413 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildTypes + {-# LINE 8314 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOchildintros = + ({-# LINE 912 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIchildintros + {-# LINE 8320 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 86 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIcon + {-# LINE 8326 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 410 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIinhmap + {-# LINE 8332 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOmrules = + ({-# LINE 835 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsImrules + {-# LINE 8338 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOnextVisits = + ({-# LINE 1382 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInextVisits + {-# LINE 8344 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 82 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsInt + {-# LINE 8350 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 72 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIoptions + {-# LINE 8356 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOparams = + ({-# LINE 92 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIparams + {-# LINE 8362 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOprevVisits = + ({-# LINE 1382 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIprevVisits + {-# LINE 8368 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOruledefs = + ({-# LINE 1281 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruledefs + {-# LINE 8374 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOruleuses = + ({-# LINE 1282 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIruleuses + {-# LINE 8380 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 411 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIsynmap + {-# LINE 8386 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- copy rule (down) + _tlOterminaldefs = + ({-# LINE 1257 "./src-ag/ExecutionPlan2Caml.ag" #-} + _lhsIterminaldefs + {-# LINE 8392 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + ( _hdIallvisits,_hdIchildvisit,_hdIerrors,_hdIfromToStates,_hdIintramap,_hdIlazyIntras,_hdIruleKinds,_hdIruleUsage,_hdIsem_visit,_hdIt_visits,_hdIvisitKinds,_hdIvisitdefs,_hdIvisituses) = + hd_ _hdOallFromToStates _hdOallInhmap _hdOallInitStates _hdOallSynmap _hdOallVisitKinds _hdOallchildvisit _hdOallintramap _hdOavisitdefs _hdOavisituses _hdOchildTypes _hdOchildintros _hdOcon _hdOinhmap _hdOmrules _hdOnextVisits _hdOnt _hdOoptions _hdOparams _hdOprevVisits _hdOruledefs _hdOruleuses _hdOsynmap _hdOterminaldefs + ( _tlIallvisits,_tlIchildvisit,_tlIerrors,_tlIfromToStates,_tlIintramap,_tlIlazyIntras,_tlIruleKinds,_tlIruleUsage,_tlIsem_visit,_tlIt_visits,_tlIvisitKinds,_tlIvisitdefs,_tlIvisituses) = + tl_ _tlOallFromToStates _tlOallInhmap _tlOallInitStates _tlOallSynmap _tlOallVisitKinds _tlOallchildvisit _tlOallintramap _tlOavisitdefs _tlOavisituses _tlOchildTypes _tlOchildintros _tlOcon _tlOinhmap _tlOmrules _tlOnextVisits _tlOnt _tlOoptions _tlOparams _tlOprevVisits _tlOruledefs _tlOruleuses _tlOsynmap _tlOterminaldefs + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOintramap,_lhsOlazyIntras,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_visit,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +sem_Visits_Nil :: T_Visits +sem_Visits_Nil = + (T_Visits (\ _lhsIallFromToStates + _lhsIallInhmap + _lhsIallInitStates + _lhsIallSynmap + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIallintramap + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIcon + _lhsIinhmap + _lhsImrules + _lhsInextVisits + _lhsInt + _lhsIoptions + _lhsIparams + _lhsIprevVisits + _lhsIruledefs + _lhsIruleuses + _lhsIsynmap + _lhsIterminaldefs -> + (let _lhsOallvisits :: ([VisitStateState]) + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _lhsOlazyIntras :: (Set String) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOsem_visit :: ( [(StateIdentifier,PP_Doc)] ) + _lhsOt_visits :: PP_Doc + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 427, column 29) + _lhsOallvisits = + ({-# LINE 427 "./src-ag/ExecutionPlan2Caml.ag" #-} + [] + {-# LINE 8441 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1147, column 37) + _lhsOchildvisit = + ({-# LINE 1147 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 8447 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1478, column 132) + _lhsOerrors = + ({-# LINE 1478 "./src-ag/ExecutionPlan2Caml.ag" #-} + Seq.empty + {-# LINE 8453 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1393, column 22) + _lhsOfromToStates = + ({-# LINE 1393 "./src-ag/ExecutionPlan2Caml.ag" #-} + mempty + {-# LINE 8459 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1255, column 34) + _lhsOintramap = + ({-# LINE 1255 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 8465 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1329, column 57) + _lhsOlazyIntras = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Caml.ag" #-} + Set.empty + {-# LINE 8471 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1229, column 56) + _lhsOruleKinds = + ({-# LINE 1229 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 8477 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1217, column 56) + _lhsOruleUsage = + ({-# LINE 1217 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 8483 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 791, column 29) + _lhsOsem_visit = + ({-# LINE 791 "./src-ag/ExecutionPlan2Caml.ag" #-} + [] + {-# LINE 8489 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 527, column 59) + _lhsOt_visits = + ({-# LINE 527 "./src-ag/ExecutionPlan2Caml.ag" #-} + empty + {-# LINE 8495 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1440, column 68) + _lhsOvisitKinds = + ({-# LINE 1440 "./src-ag/ExecutionPlan2Caml.ag" #-} + mempty + {-# LINE 8501 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1296, column 36) + _lhsOvisitdefs = + ({-# LINE 1296 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 8507 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Caml.ag"(line 1297, column 36) + _lhsOvisituses = + ({-# LINE 1297 "./src-ag/ExecutionPlan2Caml.ag" #-} + Map.empty + {-# LINE 8513 "dist/build/ExecutionPlan2Caml.hs" #-} + ) + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOintramap,_lhsOlazyIntras,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_visit,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) diff --git a/dist/build/ExecutionPlan2Hs.hs b/dist/build/ExecutionPlan2Hs.hs new file mode 100644 --- /dev/null +++ b/dist/build/ExecutionPlan2Hs.hs @@ -0,0 +1,9591 @@ + + +-- UUAGC 0.9.42.0 (src-ag/ExecutionPlan2Hs.ag) +module ExecutionPlan2Hs where +{-# LINE 7 "./src-ag/ExecutionPlan2Hs.ag" #-} + +import ExecutionPlan +import Pretty +import PPUtil +import Options +import Data.Monoid(mappend,mempty) +import Data.Maybe +import Debug.Trace +import System.IO +import System.Directory +import System.FilePath +import UU.Scanner.Position + +import TokenDef +import HsToken +import ErrorMessages + +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Sequence(Seq) +import qualified Data.Sequence as Seq +import Data.Foldable(toList) +{-# LINE 31 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 2 "./src-ag/ExecutionPlan.ag" #-} + +-- VisitSyntax.ag imports +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes +import ErrorMessages + +import qualified Data.Set as Set +import Data.Set(Set) +import qualified Data.Map as Map +import Data.Map(Map) +{-# LINE 45 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 52 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 2 "./src-ag/Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 58 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 2 "./src-ag/HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 64 "dist/build/ExecutionPlan2Hs.hs" #-} +{-# LINE 161 "./src-ag/ExecutionPlan2Hs.ag" #-} + +classCtxsToDocs :: ClassContext -> [PP_Doc] +classCtxsToDocs = map toDoc where + toDoc (ident,args) = (ident >#< ppSpaced (map pp_parens args)) + +classConstrsToDocs :: [Type] -> [PP_Doc] +classConstrsToDocs = map ppTp + +ppClasses :: [PP_Doc] -> PP_Doc +ppClasses [] = empty +ppClasses xs = pp_block "(" ")" "," xs >#< "=>" + +ppQuants :: [Identifier] -> PP_Doc +ppQuants [] = empty +ppQuants ps = "forall" >#< ppSpaced ps >#< "." +{-# LINE 81 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 190 "./src-ag/ExecutionPlan2Hs.ag" #-} + +-- first parameter indicates: generate a record or not +ppConFields :: Bool -> [PP_Doc] -> PP_Doc +ppConFields True flds = ppListSep "{" "}" ", " flds +ppConFields False flds = ppSpaced flds +{-# LINE 89 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 216 "./src-ag/ExecutionPlan2Hs.ag" #-} + +ppTp :: Type -> PP_Doc +ppTp = text . typeToHaskellString Nothing [] +{-# LINE 95 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 330 "./src-ag/ExecutionPlan2Hs.ag" #-} +type VisitStateState = (VisitIdentifier,StateIdentifier, StateIdentifier) +{-# LINE 99 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 426 "./src-ag/ExecutionPlan2Hs.ag" #-} + +conNmTVisit nt vId = "T_" >|< nt >|< "_v" >|< vId +conNmTVisitIn nt vId = "T_" >|< nt >|< "_vIn" >|< vId +conNmTVisitOut nt vId = "T_" >|< nt >|< "_vOut" >|< vId +conNmTNextVisit nt stId = "T_" >|< nt >|< "_s" >|< stId + +ppMonadType :: Options -> PP_Doc +ppMonadType opts + | parallelInvoke opts = text "IO" + | otherwise = text "Identity" +{-# LINE 112 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 576 "./src-ag/ExecutionPlan2Hs.ag" #-} + +ppDefor :: Type -> PP_Doc +ppDefor (NT nt args _) = "T_" >|< nt >#< ppSpaced (map pp_parens args) +ppDefor (Haskell s) = text s +{-# LINE 119 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 691 "./src-ag/ExecutionPlan2Hs.ag" #-} + +mklet :: (PP a, PP b, PP c) => a -> b -> c -> PP_Doc +mklet prefix defs body = + prefix >#< "let" + >-< indent 3 defs + >-< indent 2 "in" >#< body +{-# LINE 128 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 757 "./src-ag/ExecutionPlan2Hs.ag" #-} + +resultValName :: String +resultValName = "__result_" + +nextStName :: String +nextStName = "__st_" +{-# LINE 137 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 828 "./src-ag/ExecutionPlan2Hs.ag" #-} + +parResultName :: String +parResultName = "__outcome_" + +fmtDecl :: PP a => Bool -> FormatMode -> a -> PP_Doc +fmtDecl declPure fmt decl = case fmt of + FormatLetDecl -> pp decl + FormatLetLine -> "let" >#< decl >#< "in" + FormatDo | declPure -> "let" >#< decl + | otherwise -> pp decl +{-# LINE 150 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 943 "./src-ag/ExecutionPlan2Hs.ag" #-} + +stname :: Identifier -> Int -> String +stname child st = "_" ++ getName child ++ "X" ++ show st + +-- should actually return some conversion info +compatibleAttach :: VisitKind -> NontermIdent -> Options -> Bool +compatibleAttach _ _ _ = True + +unMon :: Options -> PP_Doc +unMon options + | parallelInvoke options = text "System.IO.Unsafe.unsafePerformIO" -- IO monad + | otherwise = text "Control.Monad.Identity.runIdentity" -- identity monad +{-# LINE 165 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 1047 "./src-ag/ExecutionPlan2Hs.ag" #-} + +dummyPat :: Options -> Bool -> PP_Doc +dummyPat opts noArgs + | not noArgs && tupleAsDummyToken opts = empty -- no unnecessary tuples + | tupleAsDummyToken opts = if strictDummyToken opts + then text "()" + else text "(_ :: ())" + | otherwise = let match | strictDummyToken opts = "!_" + | otherwise = "_" + in pp_parens (match >#< "::" >#< dummyType opts noArgs) + where match | strictDummyToken opts = "(!_)" + | otherwise = "_" + +dummyArg :: Options -> Bool -> PP_Doc +dummyArg opts noArgs + | not noArgs && tupleAsDummyToken opts = empty -- no unnecessary tuples + | tupleAsDummyToken opts = text "()" + | otherwise = text "GHC.Prim.realWorld#" + +dummyType :: Options -> Bool -> PP_Doc +dummyType opts noArgs + | not noArgs && tupleAsDummyToken opts = empty -- no unnecessary tuples + | tupleAsDummyToken opts = text "()" + | otherwise = text "(GHC.Prim.State# GHC.Prim.RealWorld)" +{-# LINE 192 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 1073 "./src-ag/ExecutionPlan2Hs.ag" #-} + +-- rules are "deinlined" to prevent needless code duplication. +-- if there is only a bit of duplication, we allow ghc to decide if it is worth it. +-- if the duplication crosses this threshold, however, we tell ghc definitely not to inline it. +ruleInlineThresholdSoft :: Int +ruleInlineThresholdSoft = 3 + +ruleInlineThresholdHard :: Int +ruleInlineThresholdHard = 5 + +reallyOftenUsedThreshold :: Int +reallyOftenUsedThreshold = 12 +{-# LINE 207 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 1139 "./src-ag/ExecutionPlan2Hs.ag" #-} + +data NonLocalAttr + = AttrInh Identifier Identifier + | AttrSyn Identifier Identifier deriving Show + +mkNonLocalAttr :: Bool -> Identifier -> Identifier -> NonLocalAttr +mkNonLocalAttr True = AttrInh -- True: inherited attr +mkNonLocalAttr False = AttrSyn + +lookupAttrType :: NonLocalAttr -> Map Identifier Attributes -> Map Identifier Attributes -> Map Identifier Type -> Maybe PP_Doc +lookupAttrType (AttrInh child name) inhs _ = lookupType child name inhs +lookupAttrType (AttrSyn child name) _ syns = lookupType child name syns + +-- Note: if the child takes type parameters, the type of an attribute of this child may refer to these parameters. This means that +-- the actual type of the attribute needs to have its type parameters substituted with the actual type argument of the child. +-- However, for now we simply decide to return Nothing in this case, which skips the type annotation. +lookupType :: Identifier -> Identifier -> Map Identifier Attributes -> Map Identifier Type -> Maybe PP_Doc +lookupType child name attrMp childMp + | noParameters childTp = Just ppDoc + | otherwise = Nothing + where + attrTp = Map.findWithDefault (error "lookupType: the attribute is not in the attrs of the child") name childAttrs + childAttrs = Map.findWithDefault (error "lookupType: the attributes of the nonterm are not in the map") nonterm attrMp + nonterm = extractNonterminal childTp + childTp = Map.findWithDefault (error ("lookupType: the child " ++ show child ++ "is not in the appropriate map")) child childMp + ppDoc = ppTp attrTp + +noParameters :: Type -> Bool +noParameters (Haskell _) = True +noParameters (NT _ args _) = null args +{-# LINE 240 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 1225 "./src-ag/ExecutionPlan2Hs.ag" #-} + +-- a `compatibleKind` b means: can kind b be invoked from a +compatibleKind :: VisitKind -> VisitKind -> Bool +compatibleKind _ _ = True + +compatibleRule :: VisitKind -> Bool -> Bool +compatibleRule (VisitPure _) False = False +compatibleRule _ _ = True +{-# LINE 251 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 1247 "./src-ag/ExecutionPlan2Hs.ag" #-} + +unionWithSum = Map.unionWith (+) +{-# LINE 256 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 1270 "./src-ag/ExecutionPlan2Hs.ag" #-} + +uwSetUnion :: (Ord a, Ord b) => Map a (Set b) -> Map a (Set b) -> Map a (Set b) +uwSetUnion = Map.unionWith Set.union + +uwMapUnion :: (Ord a, Ord b) => Map a (Map b c) -> Map a (Map b c) -> Map a (Map b c) +uwMapUnion = Map.unionWith Map.union +{-# LINE 265 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 1487 "./src-ag/ExecutionPlan2Hs.ag" #-} + +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 +{-# LINE 285 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 1634 "./src-ag/ExecutionPlan2Hs.ag" #-} + +ppNoInline :: PP a => a -> PP_Doc +ppNoInline = ppPragmaBinding "NOINLINE" + +ppInline :: PP a => a -> PP_Doc +ppInline = ppPragmaBinding "INLINE" + +ppInlinable :: PP a => a -> PP_Doc +ppInlinable = ppPragmaBinding "INLINABLE" + +ppPragmaBinding :: (PP a, PP b) => a -> b -> PP_Doc +ppPragmaBinding pragma nm = "{-#" >#< pragma >#< nm >#< "#-}" + +ppCostCentre :: PP a => a -> PP_Doc +ppCostCentre nm = "{-#" >#< "SCC" >#< "\"" >|< nm >|< "\"" >#< "#-}" + +warrenFlagsPP :: Options -> PP_Doc +warrenFlagsPP options = vlist + [ pp "{-# LANGUAGE Rank2Types, GADTs #-}" + , if bangpats options + then pp "{-# LANGUAGE BangPatterns #-}" + else empty + , if noPerRuleTypeSigs options && noPerStateTypeSigs options + then empty + else pp "{-# LANGUAGE ScopedTypeVariables #-}" + , if tupleAsDummyToken options + then empty + else pp "{-# LANGUAGE ScopedTypeVariables, MagicHash #-}" + , -- not that the meaning of "unbox" is here that strict fields in data types may be + -- unboxed if possible. This may affect user-defined data types declared in the module. + -- Unfortunately, we cannot turn it on for only the AG generated data types without + -- causing a zillion of warnings. + if unbox options && bangpats options + then pp $ "{-# OPTIONS_GHC -funbox-strict-fields -fstrictness #-}" + else empty + , if parallelInvoke options && not (noEagerBlackholing options) + then pp $ "{-# OPTIONS_GHC -feager-blackholing #-}" + else empty + ] +{-# LINE 327 "dist/build/ExecutionPlan2Hs.hs" #-} +-- EChild ------------------------------------------------------ +{- + visit 0: + inherited attributes: + allInitStates : Map NontermIdent Int + con : ConstructorIdent + importBlocks : PP_Doc + mainFile : String + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + nt : NontermIdent + options : Options + pragmaBlocks : String + textBlocks : PP_Doc + synthesized attributes: + argnamesw : PP_Doc + argpats : PP_Doc + argtps : PP_Doc + childTypes : Map Identifier Type + childintros : Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) + datatype : PP_Doc + terminaldefs : Set String + alternatives: + alternative EChild: + child name : {Identifier} + child tp : {Type} + child kind : {ChildKind} + child hasAround : {Bool} + child merges : {Maybe [Identifier]} + child isMerged : {Bool} + visit 0: + local tpDoc : _ + local strNm : _ + local field : _ + local addStrict : _ + local argpats : _ + local isDefor : _ + local valcode : _ + local aroundcode : _ + local introcode : _ + local nt : _ + local addbang : _ + local initSt : _ + alternative ETerm: + child name : {Identifier} + child tp : {Type} + visit 0: + local tpDoc : _ + local strNm : _ + local field : _ + local addStrict : _ + local argpats : _ + local addbang : _ +-} +-- cata +sem_EChild :: EChild -> + T_EChild +sem_EChild (EChild _name _tp _kind _hasAround _merges _isMerged) = + (sem_EChild_EChild _name _tp _kind _hasAround _merges _isMerged) +sem_EChild (ETerm _name _tp) = + (sem_EChild_ETerm _name _tp) +-- semantic domain +newtype T_EChild = T_EChild ((Map NontermIdent Int) -> + ConstructorIdent -> + PP_Doc -> + String -> + String -> + (String -> String -> String -> Bool -> String) -> + NontermIdent -> + Options -> + String -> + PP_Doc -> + ( ( PP_Doc ),( PP_Doc ),( PP_Doc ),(Map Identifier Type),(Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),PP_Doc,(Set String))) +data Inh_EChild = Inh_EChild {allInitStates_Inh_EChild :: (Map NontermIdent Int),con_Inh_EChild :: ConstructorIdent,importBlocks_Inh_EChild :: PP_Doc,mainFile_Inh_EChild :: String,mainName_Inh_EChild :: String,moduleHeader_Inh_EChild :: (String -> String -> String -> Bool -> String),nt_Inh_EChild :: NontermIdent,options_Inh_EChild :: Options,pragmaBlocks_Inh_EChild :: String,textBlocks_Inh_EChild :: PP_Doc} +data Syn_EChild = Syn_EChild {argnamesw_Syn_EChild :: ( PP_Doc ),argpats_Syn_EChild :: ( PP_Doc ),argtps_Syn_EChild :: ( PP_Doc ),childTypes_Syn_EChild :: (Map Identifier Type),childintros_Syn_EChild :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),datatype_Syn_EChild :: PP_Doc,terminaldefs_Syn_EChild :: (Set String)} +wrap_EChild :: T_EChild -> + Inh_EChild -> + Syn_EChild +wrap_EChild (T_EChild sem) (Inh_EChild _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks) = + (let ( _lhsOargnamesw,_lhsOargpats,_lhsOargtps,_lhsOchildTypes,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs) = sem _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks + in (Syn_EChild _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOterminaldefs)) +sem_EChild_EChild :: Identifier -> + Type -> + ChildKind -> + Bool -> + (Maybe [Identifier]) -> + Bool -> + T_EChild +sem_EChild_EChild name_ tp_ kind_ hasAround_ merges_ isMerged_ = + (T_EChild (\ _lhsIallInitStates + _lhsIcon + _lhsIimportBlocks + _lhsImainFile + _lhsImainName + _lhsImoduleHeader + _lhsInt + _lhsIoptions + _lhsIpragmaBlocks + _lhsItextBlocks -> + (let _lhsOdatatype :: PP_Doc + _lhsOargnamesw :: ( PP_Doc ) + _lhsOargtps :: ( PP_Doc ) + _lhsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _lhsOchildTypes :: (Map Identifier Type) + _lhsOterminaldefs :: (Set String) + _lhsOargpats :: ( PP_Doc ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 204, column 7) + _tpDoc = + ({-# LINE 204 "./src-ag/ExecutionPlan2Hs.ag" #-} + _addStrict $ pp_parens $ ppTp $ removeDeforested tp_ + {-# LINE 438 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 205, column 7) + _strNm = + ({-# LINE 205 "./src-ag/ExecutionPlan2Hs.ag" #-} + recordFieldname _lhsInt _lhsIcon name_ + {-# LINE 444 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 206, column 7) + _field = + ({-# LINE 206 "./src-ag/ExecutionPlan2Hs.ag" #-} + if dataRecords _lhsIoptions + then _strNm >#< "::" >#< _tpDoc + else _tpDoc + {-# LINE 452 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 209, column 7) + _addStrict = + ({-# LINE 209 "./src-ag/ExecutionPlan2Hs.ag" #-} + \x -> if strictData _lhsIoptions then "!" >|< x else x + {-# LINE 458 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 210, column 13) + _lhsOdatatype = + ({-# LINE 210 "./src-ag/ExecutionPlan2Hs.ag" #-} + case kind_ of + ChildAttr -> empty + _ -> _field + {-# LINE 466 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 298, column 12) + _lhsOargnamesw = + ({-# LINE 298 "./src-ag/ExecutionPlan2Hs.ag" #-} + case kind_ of + ChildSyntax -> "(" >#< "sem_" >|< _nt >#< name_ >|< "_" >#< ")" + ChildAttr -> empty + ChildReplace tp -> "(" >#< "sem_" >|< extractNonterminal tp >#< name_ >|< "_" >#< ")" + {-# LINE 475 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 565, column 12) + _lhsOargtps = + ({-# LINE 565 "./src-ag/ExecutionPlan2Hs.ag" #-} + case kind_ of + ChildSyntax -> ppDefor tp_ >#< "->" + ChildReplace tp -> ppDefor tp >#< "->" + _ -> empty + {-# LINE 484 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 569, column 12) + _argpats = + ({-# LINE 569 "./src-ag/ExecutionPlan2Hs.ag" #-} + case kind_ of + ChildSyntax -> name_ >|< "_" + ChildReplace _ -> name_ >|< "_" + _ -> empty + {-# LINE 493 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 897, column 12) + _lhsOchildintros = + ({-# LINE 897 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton name_ _introcode + {-# LINE 499 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 898, column 12) + _isDefor = + ({-# LINE 898 "./src-ag/ExecutionPlan2Hs.ag" #-} + case tp_ of + NT _ _ defor -> defor + _ -> False + {-# LINE 507 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 901, column 12) + _valcode = + ({-# LINE 901 "./src-ag/ExecutionPlan2Hs.ag" #-} + case kind_ of + ChildSyntax -> name_ >|< "_" + ChildAttr -> + let prefix | not _isDefor = if lateHigherOrderBinding _lhsIoptions + then lateSemNtLabel _nt >#< lhsname True idLateBindingAttr + else "sem_" >|< _nt + | otherwise = empty + in pp_parens (prefix >#< instname name_) + ChildReplace _ -> + pp_parens (instname name_ >#< name_ >|< "_") + {-# LINE 522 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 912, column 12) + _aroundcode = + ({-# LINE 912 "./src-ag/ExecutionPlan2Hs.ag" #-} + if hasAround_ + then locname name_ >|< "_around" + else empty + {-# LINE 530 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 915, column 12) + _introcode = + ({-# LINE 915 "./src-ag/ExecutionPlan2Hs.ag" #-} + \kind fmtMode -> + let pat = text $ stname name_ _initSt + patStrict = _addbang pat + attach = "attach_T_" >|< _nt >#< pp_parens (_aroundcode >#< _valcode ) + runAttach = unMon _lhsIoptions >#< pp_parens attach + decl = case kind of + VisitPure False -> pat >#< "=" >#< runAttach + VisitPure True -> patStrict >#< "=" >#< runAttach + VisitMonadic -> patStrict >#< "<-" >#< attach + in if compatibleAttach kind _nt _lhsIoptions + then Right ( fmtDecl False fmtMode decl + , Set.singleton (stname name_ _initSt ) + , case kind_ of + ChildAttr -> Map.insert (instname name_) Nothing $ + ( if _isDefor || not (lateHigherOrderBinding _lhsIoptions) + then id + else Map.insert (lhsname True idLateBindingAttr) (Just $ AttrInh _LHS idLateBindingAttr) + ) $ + ( if hasAround_ + then Map.insert (locname (name_) ++ "_around") Nothing + else id + ) $ Map.empty + ChildReplace _ -> Map.singleton (instname name_) Nothing + ChildSyntax -> Map.empty + ) + else Left $ IncompatibleAttachKind name_ kind + {-# LINE 561 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 941, column 12) + _nt = + ({-# LINE 941 "./src-ag/ExecutionPlan2Hs.ag" #-} + extractNonterminal tp_ + {-# LINE 567 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1515, column 37) + _addbang = + ({-# LINE 1515 "./src-ag/ExecutionPlan2Hs.ag" #-} + \x -> if bangpats _lhsIoptions then "!" >|< x else x + {-# LINE 573 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1567, column 3) + _lhsOchildTypes = + ({-# LINE 1567 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton name_ tp_ + {-# LINE 579 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1611, column 3) + _initSt = + ({-# LINE 1611 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.findWithDefault (error "nonterminal not in allInitStates map") _nt _lhsIallInitStates + {-# LINE 585 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1281, column 42) + _lhsOterminaldefs = + ({-# LINE 1281 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 591 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (from local) + _lhsOargpats = + ({-# LINE 560 "./src-ag/ExecutionPlan2Hs.ag" #-} + _argpats + {-# LINE 597 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOargnamesw,_lhsOargpats,_lhsOargtps,_lhsOchildTypes,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs)))) +sem_EChild_ETerm :: Identifier -> + Type -> + T_EChild +sem_EChild_ETerm name_ tp_ = + (T_EChild (\ _lhsIallInitStates + _lhsIcon + _lhsIimportBlocks + _lhsImainFile + _lhsImainName + _lhsImoduleHeader + _lhsInt + _lhsIoptions + _lhsIpragmaBlocks + _lhsItextBlocks -> + (let _lhsOdatatype :: PP_Doc + _lhsOargnamesw :: ( PP_Doc ) + _lhsOargtps :: ( PP_Doc ) + _lhsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _lhsOterminaldefs :: (Set String) + _lhsOchildTypes :: (Map Identifier Type) + _lhsOargpats :: ( PP_Doc ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 204, column 7) + _tpDoc = + ({-# LINE 204 "./src-ag/ExecutionPlan2Hs.ag" #-} + _addStrict $ pp_parens $ ppTp $ removeDeforested tp_ + {-# LINE 625 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 205, column 7) + _strNm = + ({-# LINE 205 "./src-ag/ExecutionPlan2Hs.ag" #-} + recordFieldname _lhsInt _lhsIcon name_ + {-# LINE 631 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 206, column 7) + _field = + ({-# LINE 206 "./src-ag/ExecutionPlan2Hs.ag" #-} + if dataRecords _lhsIoptions + then _strNm >#< "::" >#< _tpDoc + else _tpDoc + {-# LINE 639 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 209, column 7) + _addStrict = + ({-# LINE 209 "./src-ag/ExecutionPlan2Hs.ag" #-} + \x -> if strictData _lhsIoptions then "!" >|< x else x + {-# LINE 645 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 214, column 13) + _lhsOdatatype = + ({-# LINE 214 "./src-ag/ExecutionPlan2Hs.ag" #-} + _field + {-# LINE 651 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 302, column 12) + _lhsOargnamesw = + ({-# LINE 302 "./src-ag/ExecutionPlan2Hs.ag" #-} + text $ fieldname name_ + {-# LINE 657 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 573, column 12) + _lhsOargtps = + ({-# LINE 573 "./src-ag/ExecutionPlan2Hs.ag" #-} + (pp_parens $ show tp_) >#< "->" + {-# LINE 663 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 574, column 12) + _argpats = + ({-# LINE 574 "./src-ag/ExecutionPlan2Hs.ag" #-} + _addbang $ text $ fieldname name_ + {-# LINE 669 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 896, column 12) + _lhsOchildintros = + ({-# LINE 896 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton name_ (\_ _ -> Right (empty, Set.empty, Map.empty)) + {-# LINE 675 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1284, column 3) + _lhsOterminaldefs = + ({-# LINE 1284 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.singleton $ fieldname name_ + {-# LINE 681 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1516, column 37) + _addbang = + ({-# LINE 1516 "./src-ag/ExecutionPlan2Hs.ag" #-} + \x -> if bangpats _lhsIoptions then "!" >|< x else x + {-# LINE 687 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1567, column 3) + _lhsOchildTypes = + ({-# LINE 1567 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton name_ tp_ + {-# LINE 693 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (from local) + _lhsOargpats = + ({-# LINE 560 "./src-ag/ExecutionPlan2Hs.ag" #-} + _argpats + {-# LINE 699 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOargnamesw,_lhsOargpats,_lhsOargtps,_lhsOchildTypes,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs)))) +-- EChildren --------------------------------------------------- +{- + visit 0: + inherited attributes: + allInitStates : Map NontermIdent Int + con : ConstructorIdent + importBlocks : PP_Doc + mainFile : String + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + nt : NontermIdent + options : Options + pragmaBlocks : String + textBlocks : PP_Doc + synthesized attributes: + argnamesw : [PP_Doc] + argpats : [PP_Doc] + argtps : [PP_Doc] + childTypes : Map Identifier Type + childintros : Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) + datatype : [PP_Doc] + terminaldefs : Set String + alternatives: + alternative Cons: + child hd : EChild + child tl : EChildren + alternative Nil: +-} +-- cata +sem_EChildren :: EChildren -> + T_EChildren +sem_EChildren list = + (Prelude.foldr sem_EChildren_Cons sem_EChildren_Nil (Prelude.map sem_EChild list)) +-- semantic domain +newtype T_EChildren = T_EChildren ((Map NontermIdent Int) -> + ConstructorIdent -> + PP_Doc -> + String -> + String -> + (String -> String -> String -> Bool -> String) -> + NontermIdent -> + Options -> + String -> + PP_Doc -> + ( ([PP_Doc]),( [PP_Doc] ),( [PP_Doc] ),(Map Identifier Type),(Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),([PP_Doc]),(Set String))) +data Inh_EChildren = Inh_EChildren {allInitStates_Inh_EChildren :: (Map NontermIdent Int),con_Inh_EChildren :: ConstructorIdent,importBlocks_Inh_EChildren :: PP_Doc,mainFile_Inh_EChildren :: String,mainName_Inh_EChildren :: String,moduleHeader_Inh_EChildren :: (String -> String -> String -> Bool -> String),nt_Inh_EChildren :: NontermIdent,options_Inh_EChildren :: Options,pragmaBlocks_Inh_EChildren :: String,textBlocks_Inh_EChildren :: PP_Doc} +data Syn_EChildren = Syn_EChildren {argnamesw_Syn_EChildren :: ([PP_Doc]),argpats_Syn_EChildren :: ( [PP_Doc] ),argtps_Syn_EChildren :: ( [PP_Doc] ),childTypes_Syn_EChildren :: (Map Identifier Type),childintros_Syn_EChildren :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),datatype_Syn_EChildren :: ([PP_Doc]),terminaldefs_Syn_EChildren :: (Set String)} +wrap_EChildren :: T_EChildren -> + Inh_EChildren -> + Syn_EChildren +wrap_EChildren (T_EChildren sem) (Inh_EChildren _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks) = + (let ( _lhsOargnamesw,_lhsOargpats,_lhsOargtps,_lhsOchildTypes,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs) = sem _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks + in (Syn_EChildren _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOterminaldefs)) +sem_EChildren_Cons :: T_EChild -> + T_EChildren -> + T_EChildren +sem_EChildren_Cons (T_EChild hd_) (T_EChildren tl_) = + (T_EChildren (\ _lhsIallInitStates + _lhsIcon + _lhsIimportBlocks + _lhsImainFile + _lhsImainName + _lhsImoduleHeader + _lhsInt + _lhsIoptions + _lhsIpragmaBlocks + _lhsItextBlocks -> + (let _lhsOargnamesw :: ([PP_Doc]) + _lhsOargpats :: ( [PP_Doc] ) + _lhsOargtps :: ( [PP_Doc] ) + _lhsOchildTypes :: (Map Identifier Type) + _lhsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _lhsOdatatype :: ([PP_Doc]) + _lhsOterminaldefs :: (Set String) + _hdOallInitStates :: (Map NontermIdent Int) + _hdOcon :: ConstructorIdent + _hdOimportBlocks :: PP_Doc + _hdOmainFile :: String + _hdOmainName :: String + _hdOmoduleHeader :: (String -> String -> String -> Bool -> String) + _hdOnt :: NontermIdent + _hdOoptions :: Options + _hdOpragmaBlocks :: String + _hdOtextBlocks :: PP_Doc + _tlOallInitStates :: (Map NontermIdent Int) + _tlOcon :: ConstructorIdent + _tlOimportBlocks :: PP_Doc + _tlOmainFile :: String + _tlOmainName :: String + _tlOmoduleHeader :: (String -> String -> String -> Bool -> String) + _tlOnt :: NontermIdent + _tlOoptions :: Options + _tlOpragmaBlocks :: String + _tlOtextBlocks :: PP_Doc + _hdIargnamesw :: ( PP_Doc ) + _hdIargpats :: ( PP_Doc ) + _hdIargtps :: ( PP_Doc ) + _hdIchildTypes :: (Map Identifier Type) + _hdIchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _hdIdatatype :: PP_Doc + _hdIterminaldefs :: (Set String) + _tlIargnamesw :: ([PP_Doc]) + _tlIargpats :: ( [PP_Doc] ) + _tlIargtps :: ( [PP_Doc] ) + _tlIchildTypes :: (Map Identifier Type) + _tlIchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _tlIdatatype :: ([PP_Doc]) + _tlIterminaldefs :: (Set String) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 295, column 32) + _lhsOargnamesw = + ({-# LINE 295 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIargnamesw : _tlIargnamesw + {-# LINE 814 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 562, column 30) + _lhsOargpats = + ({-# LINE 562 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIargpats : _tlIargpats + {-# LINE 820 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 561, column 30) + _lhsOargtps = + ({-# LINE 561 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIargtps : _tlIargtps + {-# LINE 826 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1560, column 40) + _lhsOchildTypes = + ({-# LINE 1560 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIchildTypes `mappend` _tlIchildTypes + {-# LINE 832 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 887, column 41) + _lhsOchildintros = + ({-# LINE 887 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIchildintros `Map.union` _tlIchildintros + {-# LINE 838 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 199, column 31) + _lhsOdatatype = + ({-# LINE 199 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIdatatype : _tlIdatatype + {-# LINE 844 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1281, column 42) + _lhsOterminaldefs = + ({-# LINE 1281 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIterminaldefs `Set.union` _tlIterminaldefs + {-# LINE 850 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 856 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 66 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIcon + {-# LINE 862 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOimportBlocks = + ({-# LINE 34 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIimportBlocks + {-# LINE 868 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmainFile = + ({-# LINE 38 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainFile + {-# LINE 874 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmainName = + ({-# LINE 39 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainName + {-# LINE 880 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmoduleHeader = + ({-# LINE 37 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImoduleHeader + {-# LINE 886 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 61 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 892 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 898 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOpragmaBlocks = + ({-# LINE 35 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIpragmaBlocks + {-# LINE 904 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOtextBlocks = + ({-# LINE 36 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsItextBlocks + {-# LINE 910 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 916 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 66 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIcon + {-# LINE 922 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOimportBlocks = + ({-# LINE 34 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIimportBlocks + {-# LINE 928 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmainFile = + ({-# LINE 38 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainFile + {-# LINE 934 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmainName = + ({-# LINE 39 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainName + {-# LINE 940 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmoduleHeader = + ({-# LINE 37 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImoduleHeader + {-# LINE 946 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 61 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 952 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 958 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOpragmaBlocks = + ({-# LINE 35 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIpragmaBlocks + {-# LINE 964 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOtextBlocks = + ({-# LINE 36 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsItextBlocks + {-# LINE 970 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _hdIargnamesw,_hdIargpats,_hdIargtps,_hdIchildTypes,_hdIchildintros,_hdIdatatype,_hdIterminaldefs) = + hd_ _hdOallInitStates _hdOcon _hdOimportBlocks _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnt _hdOoptions _hdOpragmaBlocks _hdOtextBlocks + ( _tlIargnamesw,_tlIargpats,_tlIargtps,_tlIchildTypes,_tlIchildintros,_tlIdatatype,_tlIterminaldefs) = + tl_ _tlOallInitStates _tlOcon _tlOimportBlocks _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnt _tlOoptions _tlOpragmaBlocks _tlOtextBlocks + in ( _lhsOargnamesw,_lhsOargpats,_lhsOargtps,_lhsOchildTypes,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs)))) +sem_EChildren_Nil :: T_EChildren +sem_EChildren_Nil = + (T_EChildren (\ _lhsIallInitStates + _lhsIcon + _lhsIimportBlocks + _lhsImainFile + _lhsImainName + _lhsImoduleHeader + _lhsInt + _lhsIoptions + _lhsIpragmaBlocks + _lhsItextBlocks -> + (let _lhsOargnamesw :: ([PP_Doc]) + _lhsOargpats :: ( [PP_Doc] ) + _lhsOargtps :: ( [PP_Doc] ) + _lhsOchildTypes :: (Map Identifier Type) + _lhsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _lhsOdatatype :: ([PP_Doc]) + _lhsOterminaldefs :: (Set String) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 295, column 32) + _lhsOargnamesw = + ({-# LINE 295 "./src-ag/ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 1000 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 562, column 30) + _lhsOargpats = + ({-# LINE 562 "./src-ag/ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 1006 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 561, column 30) + _lhsOargtps = + ({-# LINE 561 "./src-ag/ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 1012 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1560, column 40) + _lhsOchildTypes = + ({-# LINE 1560 "./src-ag/ExecutionPlan2Hs.ag" #-} + mempty + {-# LINE 1018 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 887, column 41) + _lhsOchildintros = + ({-# LINE 887 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 1024 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 199, column 31) + _lhsOdatatype = + ({-# LINE 199 "./src-ag/ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 1030 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1281, column 42) + _lhsOterminaldefs = + ({-# LINE 1281 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 1036 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOargnamesw,_lhsOargpats,_lhsOargtps,_lhsOchildTypes,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs)))) +-- ENonterminal ------------------------------------------------ +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInitStates : Map NontermIdent Int + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + derivings : Derivings + importBlocks : PP_Doc + inhmap : Map NontermIdent Attributes + localAttrTypes : Map NontermIdent (Map ConstructorIdent (Map Identifier Type)) + mainFile : String + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + options : Options + pragmaBlocks : String + synmap : Map NontermIdent Attributes + textBlocks : PP_Doc + typeSyns : TypeSyns + wrappers : Set NontermIdent + synthesized attributes: + appendCommon : PP_Doc + appendMain : PP_Doc + childvisit : Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) + errors : Seq Error + fromToStates : Map VisitIdentifier (Int,Int) + genProdIO : IO () + imports : [PP_Doc] + initStates : Map NontermIdent Int + output : PP_Doc + semFunBndDefs : Seq PP_Doc + semFunBndTps : Seq PP_Doc + visitKinds : Map VisitIdentifier VisitKind + visitdefs : Map VisitIdentifier (Set Identifier) + visituses : Map VisitIdentifier (Set Identifier) + alternatives: + alternative ENonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child classCtxs : {ClassContext} + child initial : {StateIdentifier} + child initialv : {Maybe VisitIdentifier} + child nextVisits : {Map StateIdentifier StateCtx} + child prevVisits : {Map StateIdentifier StateCtx} + child prods : EProductions + child recursive : {Bool} + child hoInfo : {HigherOrderInfo} + visit 0: + local hasWrapper : _ + local classPP : _ + local aliasPre : _ + local datatype : _ + local derivings : _ + local fsemname : _ + local semname : _ + local frecarg : _ + local sem_tp : _ + local quantPP : _ + local sem_nt : _ + local inlineNt : _ + local semPragma : _ + local outedges : _ + local inedges : _ + local allstates : _ + local stvisits : _ + local t_type : _ + local t_params : _ + local t_init : _ + local t_states : _ + local k_type : _ + local k_states : _ + local wr_inh : _ + local wr_syn : _ + local genwrap : _ + local synAttrs : _ + local wr_inhs : _ + local wr_inhs1 : _ + local wr_filter : _ + local wr_syns : _ + local inhlist : _ + local inhlist1 : _ + local synlist : _ + local wrapname : _ + local inhname : _ + local synname : _ + local firstVisitInfo : _ + local wrapper : _ + local wrapPragma : _ + local semFunBndDef : _ + local semFunBndTp : _ + local semFunBndNm : _ + local addbang : _ + local addbangWrap : _ + local ntType : _ +-} +-- cata +sem_ENonterminal :: ENonterminal -> + T_ENonterminal +sem_ENonterminal (ENonterminal _nt _params _classCtxs _initial _initialv _nextVisits _prevVisits _prods _recursive _hoInfo) = + (sem_ENonterminal_ENonterminal _nt _params _classCtxs _initial _initialv _nextVisits _prevVisits (sem_EProductions _prods) _recursive _hoInfo) +-- semantic domain +newtype T_ENonterminal = T_ENonterminal ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Int) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + Derivings -> + PP_Doc -> + (Map NontermIdent Attributes) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) -> + String -> + String -> + (String -> String -> String -> Bool -> String) -> + Options -> + String -> + (Map NontermIdent Attributes) -> + PP_Doc -> + TypeSyns -> + (Set NontermIdent) -> + ( ( PP_Doc ),( PP_Doc ),(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),(Seq Error),(Map VisitIdentifier (Int,Int)),(IO ()),([PP_Doc]),(Map NontermIdent Int),PP_Doc,(Seq PP_Doc),(Seq PP_Doc),(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier)))) +data Inh_ENonterminal = Inh_ENonterminal {allFromToStates_Inh_ENonterminal :: (Map VisitIdentifier (Int,Int)),allInitStates_Inh_ENonterminal :: (Map NontermIdent Int),allVisitKinds_Inh_ENonterminal :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_ENonterminal :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),avisitdefs_Inh_ENonterminal :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_ENonterminal :: (Map VisitIdentifier (Set Identifier)),derivings_Inh_ENonterminal :: Derivings,importBlocks_Inh_ENonterminal :: PP_Doc,inhmap_Inh_ENonterminal :: (Map NontermIdent Attributes),localAttrTypes_Inh_ENonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))),mainFile_Inh_ENonterminal :: String,mainName_Inh_ENonterminal :: String,moduleHeader_Inh_ENonterminal :: (String -> String -> String -> Bool -> String),options_Inh_ENonterminal :: Options,pragmaBlocks_Inh_ENonterminal :: String,synmap_Inh_ENonterminal :: (Map NontermIdent Attributes),textBlocks_Inh_ENonterminal :: PP_Doc,typeSyns_Inh_ENonterminal :: TypeSyns,wrappers_Inh_ENonterminal :: (Set NontermIdent)} +data Syn_ENonterminal = Syn_ENonterminal {appendCommon_Syn_ENonterminal :: ( PP_Doc ),appendMain_Syn_ENonterminal :: ( PP_Doc ),childvisit_Syn_ENonterminal :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),errors_Syn_ENonterminal :: (Seq Error),fromToStates_Syn_ENonterminal :: (Map VisitIdentifier (Int,Int)),genProdIO_Syn_ENonterminal :: (IO ()),imports_Syn_ENonterminal :: ([PP_Doc]),initStates_Syn_ENonterminal :: (Map NontermIdent Int),output_Syn_ENonterminal :: PP_Doc,semFunBndDefs_Syn_ENonterminal :: (Seq PP_Doc),semFunBndTps_Syn_ENonterminal :: (Seq PP_Doc),visitKinds_Syn_ENonterminal :: (Map VisitIdentifier VisitKind),visitdefs_Syn_ENonterminal :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_ENonterminal :: (Map VisitIdentifier (Set Identifier))} +wrap_ENonterminal :: T_ENonterminal -> + Inh_ENonterminal -> + Syn_ENonterminal +wrap_ENonterminal (T_ENonterminal sem) (Inh_ENonterminal _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers) = + (let ( _lhsOappendCommon,_lhsOappendMain,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOinitStates,_lhsOoutput,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers + in (Syn_ENonterminal _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses)) +sem_ENonterminal_ENonterminal :: NontermIdent -> + ([Identifier]) -> + ClassContext -> + StateIdentifier -> + (Maybe VisitIdentifier) -> + (Map StateIdentifier StateCtx) -> + (Map StateIdentifier StateCtx) -> + T_EProductions -> + Bool -> + HigherOrderInfo -> + T_ENonterminal +sem_ENonterminal_ENonterminal nt_ params_ classCtxs_ initial_ initialv_ nextVisits_ prevVisits_ (T_EProductions prods_) recursive_ hoInfo_ = + (T_ENonterminal (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIderivings + _lhsIimportBlocks + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsImoduleHeader + _lhsIoptions + _lhsIpragmaBlocks + _lhsIsynmap + _lhsItextBlocks + _lhsItypeSyns + _lhsIwrappers -> + (let _prodsOrename :: Bool + _prodsOnt :: NontermIdent + _prodsOparams :: ([Identifier]) + _prodsOclassCtxs :: ClassContext + _lhsOoutput :: PP_Doc + _prodsOinhmap :: Attributes + _prodsOsynmap :: Attributes + _prodsOallInhmap :: (Map NontermIdent Attributes) + _prodsOallSynmap :: (Map NontermIdent Attributes) + _lhsOsemFunBndDefs :: (Seq PP_Doc) + _lhsOsemFunBndTps :: (Seq PP_Doc) + _prodsOinitial :: StateIdentifier + _prodsOallstates :: (Set StateIdentifier) + _lhsOappendMain :: ( PP_Doc ) + _lhsOappendCommon :: ( PP_Doc ) + _prodsOnextVisits :: (Map StateIdentifier StateCtx) + _prodsOprevVisits :: (Map StateIdentifier StateCtx) + _prodsOlocalAttrTypes :: (Map ConstructorIdent (Map Identifier Type)) + _lhsOinitStates :: (Map NontermIdent Int) + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOgenProdIO :: (IO ()) + _lhsOimports :: ([PP_Doc]) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + _prodsOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _prodsOallInitStates :: (Map NontermIdent Int) + _prodsOallVisitKinds :: (Map VisitIdentifier VisitKind) + _prodsOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _prodsOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _prodsOavisituses :: (Map VisitIdentifier (Set Identifier)) + _prodsOimportBlocks :: PP_Doc + _prodsOmainFile :: String + _prodsOmainName :: String + _prodsOmoduleHeader :: (String -> String -> String -> Bool -> String) + _prodsOntType :: Type + _prodsOoptions :: Options + _prodsOpragmaBlocks :: String + _prodsOtextBlocks :: PP_Doc + _prodsIallvisits :: ([VisitStateState]) + _prodsIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _prodsIcount :: Int + _prodsIdatatype :: ([PP_Doc]) + _prodsIerrors :: (Seq Error) + _prodsIfromToStates :: (Map VisitIdentifier (Int,Int)) + _prodsIgenProdIO :: (IO ()) + _prodsIimports :: ([PP_Doc]) + _prodsIsemFunBndDefs :: (Seq PP_Doc) + _prodsIsemFunBndTps :: (Seq PP_Doc) + _prodsIsem_nt :: PP_Doc + _prodsIsem_prod :: PP_Doc + _prodsIt_visits :: PP_Doc + _prodsIvisitKinds :: (Map VisitIdentifier VisitKind) + _prodsIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _prodsIvisituses :: (Map VisitIdentifier (Set Identifier)) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 55, column 18) + _prodsOrename = + ({-# LINE 55 "./src-ag/ExecutionPlan2Hs.ag" #-} + rename _lhsIoptions + {-# LINE 1263 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 63, column 18) + _prodsOnt = + ({-# LINE 63 "./src-ag/ExecutionPlan2Hs.ag" #-} + nt_ + {-# LINE 1269 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 75, column 3) + _prodsOparams = + ({-# LINE 75 "./src-ag/ExecutionPlan2Hs.ag" #-} + params_ + {-# LINE 1275 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 79, column 3) + _prodsOclassCtxs = + ({-# LINE 79 "./src-ag/ExecutionPlan2Hs.ag" #-} + classCtxs_ + {-# LINE 1281 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 96, column 18) + _lhsOoutput = + ({-# LINE 96 "./src-ag/ExecutionPlan2Hs.ag" #-} + ("-- " ++ getName nt_ ++ " " ++ replicate (60 - length (getName nt_)) '-') + >-< (if dataTypes _lhsIoptions + then "-- data" + >-< _datatype + >-< "" + else empty) + >-< (if _hasWrapper + then "-- wrapper" + >-< _wr_inh + >-< _wr_syn + >-< _wrapper + >-< "" + else empty) + >-< (if folds _lhsIoptions + then "-- cata" + >-< _sem_nt + >-< "" + else empty) + >-< (if semfuns _lhsIoptions + then "-- semantic domain" + >-< _t_init + >-< _t_states + >-< _k_states + >-< _prodsIt_visits + >-< _prodsIsem_prod + >-< "" + else empty) + {-# LINE 1313 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 123, column 18) + _hasWrapper = + ({-# LINE 123 "./src-ag/ExecutionPlan2Hs.ag" #-} + nt_ `Set.member` _lhsIwrappers + {-# LINE 1319 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 136, column 18) + _classPP = + ({-# LINE 136 "./src-ag/ExecutionPlan2Hs.ag" #-} + ppClasses $ classCtxsToDocs classCtxs_ + {-# LINE 1325 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 137, column 18) + _aliasPre = + ({-# LINE 137 "./src-ag/ExecutionPlan2Hs.ag" #-} + "type" >#< _classPP >#< nt_ >#< _t_params >#< "=" + {-# LINE 1331 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 138, column 18) + _datatype = + ({-# LINE 138 "./src-ag/ExecutionPlan2Hs.ag" #-} + case lookup nt_ _lhsItypeSyns of + Nothing -> "data" >#< _classPP >#< nt_ >#< _t_params + >-< ( if null _prodsIdatatype + then empty + else indent 2 $ vlist $ ( ("=" >#< head _prodsIdatatype) + : (map ("|" >#<) $ tail _prodsIdatatype)) + ) + >-< indent 2 _derivings + Just (List t) -> _aliasPre >#< "[" >#< show t >#< "]" + Just (Maybe t) -> _aliasPre >#< "Maybe" >#< show t + Just (Tuple ts) -> _aliasPre >#< pp_parens (ppCommas $ map (show . snd) ts) + Just (Either l r) -> _aliasPre >#< "Either" >#< show l >#< show r + Just (Map k v) -> _aliasPre >#< "Data.Map" >#< pp_parens (show k) >#< show v + Just (IntMap t) -> _aliasPre >#< "Data.IntMap.IntMap" >#< show t + Just (OrdSet t) -> _aliasPre >#< "Data.Set.Set" >#< show t + Just IntSet -> _aliasPre >#< "Data.IntSet.IntSet" + {-# LINE 1352 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 155, column 18) + _derivings = + ({-# LINE 155 "./src-ag/ExecutionPlan2Hs.ag" #-} + case Map.lookup nt_ _lhsIderivings of + Nothing -> empty + Just s -> if Set.null s + then empty + else "deriving" >#< (pp_parens $ ppCommas $ map pp $ Set.toList s) + {-# LINE 1362 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 225, column 18) + _fsemname = + ({-# LINE 225 "./src-ag/ExecutionPlan2Hs.ag" #-} + \x -> "sem_" ++ show x + {-# LINE 1368 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 226, column 18) + _semname = + ({-# LINE 226 "./src-ag/ExecutionPlan2Hs.ag" #-} + _fsemname nt_ + {-# LINE 1374 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 227, column 18) + _frecarg = + ({-# LINE 227 "./src-ag/ExecutionPlan2Hs.ag" #-} + \t x -> case t of + NT nt _ _ -> pp_parens (_fsemname nt >#< x) + _ -> pp x + {-# LINE 1382 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 233, column 18) + _sem_tp = + ({-# LINE 233 "./src-ag/ExecutionPlan2Hs.ag" #-} + _quantPP >#< _classPP >#< nt_ >#< _t_params >#< "->" >#< _t_type >#< _t_params + {-# LINE 1388 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 234, column 18) + _quantPP = + ({-# LINE 234 "./src-ag/ExecutionPlan2Hs.ag" #-} + ppQuants params_ + {-# LINE 1394 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 235, column 18) + _sem_nt = + ({-# LINE 235 "./src-ag/ExecutionPlan2Hs.ag" #-} + _semPragma + >-< _semname >#< "::" >#< _sem_tp + >-< case lookup nt_ _lhsItypeSyns of + Nothing -> _prodsIsem_nt + Just (List t) -> _semname >#< "list" >#< "=" >#< "Prelude.foldr" >#< _semname >|< "_Cons" + >#< _semname >|< "_Nil" + >#< case t of + NT nt _ _ -> pp_parens ("Prelude.map" >#< _fsemname nt >#< "list") + _ -> pp "list" + Just (Maybe t) -> _semname >#< "Prelude.Nothing" >#< "=" >#< _semname >|< "_Nothing" + >-< _semname >#< pp_parens ("Prelude.Just just") >#< "=" + >#< _semname >|< "_Just" >#< _frecarg t "just" + Just (Tuple ts) -> _semname >#< pp_parens (ppCommas $ map fst ts) >#< "=" + >#< _semname >|< "_Tuple" >#< ppSpaced (map (\t -> _frecarg (snd t) (show $ fst t)) ts) + Just (Either l r) -> _semname >#< "(Prelude.Left left)" >#< "=" >#< _semname >|< "_Left" >#< _frecarg l "left" + >-< _semname >#< "(Prelude.Right right)" >#< "=" >#< _semname >|< "_Right" >#< _frecarg r "right" + Just (Map k v) -> _semname >#< "m" >#< "=" >#< "Data.Map.foldrWithKey" + >#< _semname >|< "_Entry" >#< _semname >|< "_Nil" + >#< case v of + NT nt _ _ -> pp_parens ("Data.Map.map" >#< _fsemname nt >#< "m") + _ -> pp "m" + Just (IntMap v) -> _semname >#< "m" >#< "=" >#< "Data.IntMap.foldWithKey" + >#< _semname >|< "_Entry" >#< _semname >|< "_Nil" + >#< case v of + NT nt _ _ -> pp_parens ("Data.IntMap.map" >#< _fsemname nt >#< "m") + _ -> pp "m" + Just (OrdSet t) -> _semname >#< "s" >#< "=" >#< "Prelude.foldr" >#< _semname >|< "_Entry" + >#< _semname >|< "_Nil" + >#< pp_parens ( + ( case t of + NT nt _ _ -> pp_parens ("Prelude.map" >#< _fsemname nt) + _ -> empty + ) >#< pp_parens ("Data.IntSet.elems" >#< "s") + ) + Just IntSet -> _semname >#< "s" >#< "=" >#< "Prelude.foldr" >#< _semname >|< "_Entry" + >#< _semname >|< "_Nil" + >#< pp_parens ("Data.IntSet.elems" >#< "s") + {-# LINE 1436 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 275, column 17) + _inlineNt = + ({-# LINE 275 "./src-ag/ExecutionPlan2Hs.ag" #-} + not (lateHigherOrderBinding _lhsIoptions) && not recursive_ && (_prodsIcount == 1 || (aggressiveInlinePragmas _lhsIoptions && not _hasWrapper )) + {-# LINE 1442 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 276, column 17) + _semPragma = + ({-# LINE 276 "./src-ag/ExecutionPlan2Hs.ag" #-} + if noInlinePragmas _lhsIoptions + then empty + else if _inlineNt + then ppInline _semname + else if helpInlining _lhsIoptions && not (lateHigherOrderBinding _lhsIoptions) + then ppInlinable _semname + else ppNoInline _semname + {-# LINE 1454 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 322, column 19) + (Just _prodsOinhmap) = + ({-# LINE 322 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.lookup nt_ _lhsIinhmap + {-# LINE 1460 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 323, column 19) + (Just _prodsOsynmap) = + ({-# LINE 323 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.lookup nt_ _lhsIsynmap + {-# LINE 1466 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 324, column 18) + _prodsOallInhmap = + ({-# LINE 324 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 1472 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 325, column 18) + _prodsOallSynmap = + ({-# LINE 325 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 1478 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 346, column 18) + _outedges = + ({-# LINE 346 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.fromList $ map (\(_,f,_) -> f) _prodsIallvisits + {-# LINE 1484 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 347, column 18) + _inedges = + ({-# LINE 347 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.fromList $ map (\(_,_,t) -> t) _prodsIallvisits + {-# LINE 1490 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 348, column 18) + _allstates = + ({-# LINE 348 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.insert initial_ $ _inedges `Set.union` _outedges + {-# LINE 1496 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 349, column 18) + _stvisits = + ({-# LINE 349 "./src-ag/ExecutionPlan2Hs.ag" #-} + \st -> filter (\(v,f,t) -> f == st) _prodsIallvisits + {-# LINE 1502 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 350, column 18) + _t_type = + ({-# LINE 350 "./src-ag/ExecutionPlan2Hs.ag" #-} + "T_" >|< nt_ + {-# LINE 1508 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 351, column 18) + _t_params = + ({-# LINE 351 "./src-ag/ExecutionPlan2Hs.ag" #-} + ppSpaced params_ + {-# LINE 1514 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 352, column 18) + _t_init = + ({-# LINE 352 "./src-ag/ExecutionPlan2Hs.ag" #-} + "newtype" >#< _t_type >#< _t_params >#< "=" >#< _t_type >#< + pp_braces ( + "attach_">|< _t_type >#< "::" + >#< ppMonadType _lhsIoptions >#< pp_parens (_t_type >|< "_s" >|< initial_ >#< _t_params )) + {-# LINE 1523 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 356, column 18) + _t_states = + ({-# LINE 356 "./src-ag/ExecutionPlan2Hs.ag" #-} + vlist $ map (\st -> + let nt_st = nt_ >|< "_s" >|< st + t_st = "T_" >|< nt_st + k_st = "K_" >|< nt_st + c_st = "C_" >|< nt_st + inv_st = "inv_" >|< nt_st + nextVisit = Map.findWithDefault ManyVis st nextVisits_ + in case nextVisit of + NoneVis -> "data" >#< t_st >#< _t_params >#< "=" >#< c_st + OneVis vId -> "newtype" >#< t_st >#< _t_params >#< "=" >#< c_st + >#< (pp_braces $ inv_st >#< "::" >#< pp_parens (conNmTVisit nt_ vId >#< _t_params )) + ManyVis -> "data" >#< t_st >#< _t_params >#< "where" >#< c_st >#< "::" + >#< (pp_braces $ inv_st >#< "::" >#< "!" >|< pp_parens ("forall t." >#< k_st >#< _t_params >#< "t" >#< "->" >#< "t")) + >#< "->" >#< t_st >#< _t_params + ) $ Set.toList _allstates + {-# LINE 1543 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 374, column 18) + _k_type = + ({-# LINE 374 "./src-ag/ExecutionPlan2Hs.ag" #-} + "K_" ++ show nt_ + {-# LINE 1549 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 375, column 18) + _k_states = + ({-# LINE 375 "./src-ag/ExecutionPlan2Hs.ag" #-} + vlist $ map (\st -> + let nt_st = nt_ >|< "_s" >|< st + k_st = "K_" >|< nt_st + outg = filter (\(v,f,t) -> f == st) _prodsIallvisits + visitlist = vlist $ map (\(v,f,t) -> + _k_type >|< "_v" >|< v >#< "::" >#< k_st >#< _t_params >#< pp_parens (_t_type >|< "_v" >|< v >#< _t_params ) + ) outg + nextVisit = Map.findWithDefault ManyVis st nextVisits_ + decl = "data" >#< k_st >#< "k" >#< _t_params >#< "where" >-< indent 3 visitlist + in case nextVisit of + NoneVis -> empty + OneVis _ -> empty + ManyVis -> decl + ) $ Set.toList _allstates + {-# LINE 1568 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 442, column 18) + _wr_inh = + ({-# LINE 442 "./src-ag/ExecutionPlan2Hs.ag" #-} + _genwrap "Inh" _wr_inhs + {-# LINE 1574 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 443, column 18) + _wr_syn = + ({-# LINE 443 "./src-ag/ExecutionPlan2Hs.ag" #-} + _genwrap "Syn" _wr_syns + {-# LINE 1580 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 444, column 18) + _genwrap = + ({-# LINE 444 "./src-ag/ExecutionPlan2Hs.ag" #-} + \nm attr -> "data" >#< nm >|< "_" >|< nt_ >#< _t_params >#< "=" >#< nm >|< "_" >|< nt_ >#< "{" + >#< (ppCommas $ map (\(i,t) -> i >|< "_" >|< nm >|< "_" >|< nt_ >#< "::" + >#< (_addbang $ pp_parens $ typeToHaskellString (Just nt_) [] t)) attr) >#< "}" + {-# LINE 1588 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 447, column 18) + _synAttrs = + ({-# LINE 447 "./src-ag/ExecutionPlan2Hs.ag" #-} + fromJust $ Map.lookup nt_ _lhsIinhmap + {-# LINE 1594 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 448, column 18) + _wr_inhs = + ({-# LINE 448 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.toList $ _wr_filter $ _synAttrs + {-# LINE 1600 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 449, column 18) + _wr_inhs1 = + ({-# LINE 449 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.toList _synAttrs + {-# LINE 1606 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 450, column 18) + _wr_filter = + ({-# LINE 450 "./src-ag/ExecutionPlan2Hs.ag" #-} + if lateHigherOrderBinding _lhsIoptions + then Map.delete idLateBindingAttr + else id + {-# LINE 1614 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 453, column 18) + _wr_syns = + ({-# LINE 453 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.toList $ fromJust $ Map.lookup nt_ _lhsIsynmap + {-# LINE 1620 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 454, column 18) + _inhlist = + ({-# LINE 454 "./src-ag/ExecutionPlan2Hs.ag" #-} + map (lhsname True . fst) _wr_inhs + {-# LINE 1626 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 455, column 18) + _inhlist1 = + ({-# LINE 455 "./src-ag/ExecutionPlan2Hs.ag" #-} + map (lhsname True . fst) _wr_inhs1 + {-# LINE 1632 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 456, column 18) + _synlist = + ({-# LINE 456 "./src-ag/ExecutionPlan2Hs.ag" #-} + map (lhsname False . fst) _wr_syns + {-# LINE 1638 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 457, column 18) + _wrapname = + ({-# LINE 457 "./src-ag/ExecutionPlan2Hs.ag" #-} + "wrap_" ++ show nt_ + {-# LINE 1644 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 458, column 18) + _inhname = + ({-# LINE 458 "./src-ag/ExecutionPlan2Hs.ag" #-} + "Inh_" ++ show nt_ + {-# LINE 1650 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 459, column 18) + _synname = + ({-# LINE 459 "./src-ag/ExecutionPlan2Hs.ag" #-} + "Syn_" ++ show nt_ + {-# LINE 1656 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 460, column 18) + _firstVisitInfo = + ({-# LINE 460 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.findWithDefault ManyVis initial_ nextVisits_ + {-# LINE 1662 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 461, column 18) + _wrapper = + ({-# LINE 461 "./src-ag/ExecutionPlan2Hs.ag" #-} + _wrapPragma + >-< (_wrapname >#< "::" >#< _quantPP >#< _classPP >#< _t_type >#< _t_params >#< "->" + >#< _inhname >#< _t_params >#< "->" >#< ( if monadicWrappers _lhsIoptions then ppMonadType _lhsIoptions else empty) >#< pp_parens (_synname >#< _t_params )) + >-< (_wrapname >#< (_addbang $ pp_parens (_t_type >#< pp "act")) + >#< (_addbang $ pp_parens (_inhname + >#< (ppSpaced $ map (_addbangWrap . pp) _inhlist )) >#< "=")) + >-< + indent 3 (case initialv_ of + Nothing -> _synname >#< " { }" + Just initv -> + let inCon = conNmTVisitIn nt_ initv + outCon = conNmTVisitOut nt_ initv + pat = _addbang $ pp_parens $ pat0 + pat0 = outCon >#< ppSpaced _synlist + arg = inCon >#< ppSpaced _inhlist1 + ind = case _firstVisitInfo of + NoneVis -> error "wrapper: initial state should have a next visit but it has none" + OneVis _ -> empty + ManyVis -> _k_type >|< "_v" >|< initv + extra = if dummyTokenVisit _lhsIoptions + then pp $ dummyArg _lhsIoptions True + else empty + convert = case Map.lookup initv _lhsIallVisitKinds of + Just kind -> case kind of + VisitPure _ -> text "return" + VisitMonadic -> empty + unMonad | monadicWrappers _lhsIoptions = empty + | otherwise = unMon _lhsIoptions + in unMonad >#< "(" + >-< indent 2 ( + "do" >#< ( _addbang (pp "sem") >#< "<-" >#< "act" + >-< "let" >#< _addbangWrap (pp "arg") >#< "=" >#< arg + >-< pat >#< "<-" >#< convert >#< pp_parens ("inv_" >|< nt_ >|< "_s" >|< initial_ >#< "sem" >#< ind >#< "arg" >#< extra) + >-< "return" >#< pp_parens (_synname >#< ppSpaced _synlist ) + ) + ) + >-< ")" ) + >-< if lateHigherOrderBinding _lhsIoptions + then indent 2 ("where" >#< lhsname True idLateBindingAttr >#< "=" >#< lateBindingFieldNm _lhsImainName) + else empty + {-# LINE 1707 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 502, column 18) + _wrapPragma = + ({-# LINE 502 "./src-ag/ExecutionPlan2Hs.ag" #-} + if parallelInvoke _lhsIoptions && not (monadicWrappers _lhsIoptions) + then ppNoInline _wrapname + else if noInlinePragmas _lhsIoptions + then empty + else ppInlinable _wrapname + {-# LINE 1717 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 514, column 3) + _lhsOsemFunBndDefs = + ({-# LINE 514 "./src-ag/ExecutionPlan2Hs.ag" #-} + _semFunBndDef Seq.<| _prodsIsemFunBndDefs + {-# LINE 1723 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 515, column 3) + _lhsOsemFunBndTps = + ({-# LINE 515 "./src-ag/ExecutionPlan2Hs.ag" #-} + _semFunBndTp Seq.<| _prodsIsemFunBndTps + {-# LINE 1729 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 516, column 3) + _semFunBndDef = + ({-# LINE 516 "./src-ag/ExecutionPlan2Hs.ag" #-} + _semFunBndNm >#< "=" >#< _semname + {-# LINE 1735 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 517, column 3) + _semFunBndTp = + ({-# LINE 517 "./src-ag/ExecutionPlan2Hs.ag" #-} + _semFunBndNm >#< "::" >#< _sem_tp + {-# LINE 1741 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 518, column 3) + _semFunBndNm = + ({-# LINE 518 "./src-ag/ExecutionPlan2Hs.ag" #-} + lateSemNtLabel nt_ + {-# LINE 1747 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 556, column 18) + _prodsOinitial = + ({-# LINE 556 "./src-ag/ExecutionPlan2Hs.ag" #-} + initial_ + {-# LINE 1753 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 557, column 18) + _prodsOallstates = + ({-# LINE 557 "./src-ag/ExecutionPlan2Hs.ag" #-} + _allstates + {-# LINE 1759 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1447, column 18) + _lhsOappendMain = + ({-# LINE 1447 "./src-ag/ExecutionPlan2Hs.ag" #-} + (if nt_ `Set.member` _lhsIwrappers + then _wr_inh + >-< _wr_syn + >-< _wrapper + else empty) + >-< _sem_nt + {-# LINE 1770 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1453, column 18) + _lhsOappendCommon = + ({-# LINE 1453 "./src-ag/ExecutionPlan2Hs.ag" #-} + (if dataTypes _lhsIoptions then _datatype else empty) + >-< _t_init + >-< _t_states + >-< _k_states + >-< _prodsIt_visits + {-# LINE 1780 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1513, column 37) + _addbang = + ({-# LINE 1513 "./src-ag/ExecutionPlan2Hs.ag" #-} + \x -> if bangpats _lhsIoptions then "!" >|< x else x + {-# LINE 1786 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1521, column 37) + _addbangWrap = + ({-# LINE 1521 "./src-ag/ExecutionPlan2Hs.ag" #-} + if strictWrap _lhsIoptions then _addbang else id + {-# LINE 1792 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1533, column 3) + _prodsOnextVisits = + ({-# LINE 1533 "./src-ag/ExecutionPlan2Hs.ag" #-} + nextVisits_ + {-# LINE 1798 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1534, column 3) + _prodsOprevVisits = + ({-# LINE 1534 "./src-ag/ExecutionPlan2Hs.ag" #-} + prevVisits_ + {-# LINE 1804 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1578, column 3) + _prodsOlocalAttrTypes = + ({-# LINE 1578 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIlocalAttrTypes + {-# LINE 1810 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1605, column 3) + _lhsOinitStates = + ({-# LINE 1605 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton nt_ initial_ + {-# LINE 1816 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1619, column 3) + _ntType = + ({-# LINE 1619 "./src-ag/ExecutionPlan2Hs.ag" #-} + NT nt_ (map show params_) False + {-# LINE 1822 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1184, column 37) + _lhsOchildvisit = + ({-# LINE 1184 "./src-ag/ExecutionPlan2Hs.ag" #-} + _prodsIchildvisit + {-# LINE 1828 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + _prodsIerrors + {-# LINE 1834 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1541, column 22) + _lhsOfromToStates = + ({-# LINE 1541 "./src-ag/ExecutionPlan2Hs.ag" #-} + _prodsIfromToStates + {-# LINE 1840 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1461, column 49) + _lhsOgenProdIO = + ({-# LINE 1461 "./src-ag/ExecutionPlan2Hs.ag" #-} + _prodsIgenProdIO + {-# LINE 1846 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1460, column 47) + _lhsOimports = + ({-# LINE 1460 "./src-ag/ExecutionPlan2Hs.ag" #-} + _prodsIimports + {-# LINE 1852 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1588, column 68) + _lhsOvisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _prodsIvisitKinds + {-# LINE 1858 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1319, column 36) + _lhsOvisitdefs = + ({-# LINE 1319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _prodsIvisitdefs + {-# LINE 1864 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1320, column 36) + _lhsOvisituses = + ({-# LINE 1320 "./src-ag/ExecutionPlan2Hs.ag" #-} + _prodsIvisituses + {-# LINE 1870 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOallFromToStates = + ({-# LINE 1544 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallFromToStates + {-# LINE 1876 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 1882 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOallVisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallVisitKinds + {-# LINE 1888 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOallchildvisit = + ({-# LINE 1183 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 1894 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOavisitdefs = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 1900 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOavisituses = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 1906 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOimportBlocks = + ({-# LINE 34 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIimportBlocks + {-# LINE 1912 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOmainFile = + ({-# LINE 38 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainFile + {-# LINE 1918 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOmainName = + ({-# LINE 39 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainName + {-# LINE 1924 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOmoduleHeader = + ({-# LINE 37 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImoduleHeader + {-# LINE 1930 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (from local) + _prodsOntType = + ({-# LINE 1617 "./src-ag/ExecutionPlan2Hs.ag" #-} + _ntType + {-# LINE 1936 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 1942 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOpragmaBlocks = + ({-# LINE 35 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIpragmaBlocks + {-# LINE 1948 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOtextBlocks = + ({-# LINE 36 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsItextBlocks + {-# LINE 1954 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _prodsIallvisits,_prodsIchildvisit,_prodsIcount,_prodsIdatatype,_prodsIerrors,_prodsIfromToStates,_prodsIgenProdIO,_prodsIimports,_prodsIsemFunBndDefs,_prodsIsemFunBndTps,_prodsIsem_nt,_prodsIsem_prod,_prodsIt_visits,_prodsIvisitKinds,_prodsIvisitdefs,_prodsIvisituses) = + prods_ _prodsOallFromToStates _prodsOallInhmap _prodsOallInitStates _prodsOallSynmap _prodsOallVisitKinds _prodsOallchildvisit _prodsOallstates _prodsOavisitdefs _prodsOavisituses _prodsOclassCtxs _prodsOimportBlocks _prodsOinhmap _prodsOinitial _prodsOlocalAttrTypes _prodsOmainFile _prodsOmainName _prodsOmoduleHeader _prodsOnextVisits _prodsOnt _prodsOntType _prodsOoptions _prodsOparams _prodsOpragmaBlocks _prodsOprevVisits _prodsOrename _prodsOsynmap _prodsOtextBlocks + in ( _lhsOappendCommon,_lhsOappendMain,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOinitStates,_lhsOoutput,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +-- ENonterminals ----------------------------------------------- +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInitStates : Map NontermIdent Int + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + derivings : Derivings + importBlocks : PP_Doc + inhmap : Map NontermIdent Attributes + localAttrTypes : Map NontermIdent (Map ConstructorIdent (Map Identifier Type)) + mainFile : String + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + options : Options + pragmaBlocks : String + synmap : Map NontermIdent Attributes + textBlocks : PP_Doc + typeSyns : TypeSyns + wrappers : Set NontermIdent + synthesized attributes: + appendCommon : [PP_Doc] + appendMain : [PP_Doc] + childvisit : Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) + errors : Seq Error + fromToStates : Map VisitIdentifier (Int,Int) + genProdIO : IO () + imports : [PP_Doc] + initStates : Map NontermIdent Int + output : PP_Doc + semFunBndDefs : Seq PP_Doc + semFunBndTps : Seq PP_Doc + visitKinds : Map VisitIdentifier VisitKind + visitdefs : Map VisitIdentifier (Set Identifier) + visituses : Map VisitIdentifier (Set Identifier) + alternatives: + alternative Cons: + child hd : ENonterminal + child tl : ENonterminals + alternative Nil: +-} +-- cata +sem_ENonterminals :: ENonterminals -> + T_ENonterminals +sem_ENonterminals list = + (Prelude.foldr sem_ENonterminals_Cons sem_ENonterminals_Nil (Prelude.map sem_ENonterminal list)) +-- semantic domain +newtype T_ENonterminals = T_ENonterminals ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Int) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + Derivings -> + PP_Doc -> + (Map NontermIdent Attributes) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) -> + String -> + String -> + (String -> String -> String -> Bool -> String) -> + Options -> + String -> + (Map NontermIdent Attributes) -> + PP_Doc -> + TypeSyns -> + (Set NontermIdent) -> + ( ([PP_Doc]),([PP_Doc]),(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),(Seq Error),(Map VisitIdentifier (Int,Int)),(IO ()),([PP_Doc]),(Map NontermIdent Int),PP_Doc,(Seq PP_Doc),(Seq PP_Doc),(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier)))) +data Inh_ENonterminals = Inh_ENonterminals {allFromToStates_Inh_ENonterminals :: (Map VisitIdentifier (Int,Int)),allInitStates_Inh_ENonterminals :: (Map NontermIdent Int),allVisitKinds_Inh_ENonterminals :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_ENonterminals :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),avisitdefs_Inh_ENonterminals :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_ENonterminals :: (Map VisitIdentifier (Set Identifier)),derivings_Inh_ENonterminals :: Derivings,importBlocks_Inh_ENonterminals :: PP_Doc,inhmap_Inh_ENonterminals :: (Map NontermIdent Attributes),localAttrTypes_Inh_ENonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))),mainFile_Inh_ENonterminals :: String,mainName_Inh_ENonterminals :: String,moduleHeader_Inh_ENonterminals :: (String -> String -> String -> Bool -> String),options_Inh_ENonterminals :: Options,pragmaBlocks_Inh_ENonterminals :: String,synmap_Inh_ENonterminals :: (Map NontermIdent Attributes),textBlocks_Inh_ENonterminals :: PP_Doc,typeSyns_Inh_ENonterminals :: TypeSyns,wrappers_Inh_ENonterminals :: (Set NontermIdent)} +data Syn_ENonterminals = Syn_ENonterminals {appendCommon_Syn_ENonterminals :: ([PP_Doc]),appendMain_Syn_ENonterminals :: ([PP_Doc]),childvisit_Syn_ENonterminals :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),errors_Syn_ENonterminals :: (Seq Error),fromToStates_Syn_ENonterminals :: (Map VisitIdentifier (Int,Int)),genProdIO_Syn_ENonterminals :: (IO ()),imports_Syn_ENonterminals :: ([PP_Doc]),initStates_Syn_ENonterminals :: (Map NontermIdent Int),output_Syn_ENonterminals :: PP_Doc,semFunBndDefs_Syn_ENonterminals :: (Seq PP_Doc),semFunBndTps_Syn_ENonterminals :: (Seq PP_Doc),visitKinds_Syn_ENonterminals :: (Map VisitIdentifier VisitKind),visitdefs_Syn_ENonterminals :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_ENonterminals :: (Map VisitIdentifier (Set Identifier))} +wrap_ENonterminals :: T_ENonterminals -> + Inh_ENonterminals -> + Syn_ENonterminals +wrap_ENonterminals (T_ENonterminals sem) (Inh_ENonterminals _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers) = + (let ( _lhsOappendCommon,_lhsOappendMain,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOinitStates,_lhsOoutput,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers + in (Syn_ENonterminals _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses)) +sem_ENonterminals_Cons :: T_ENonterminal -> + T_ENonterminals -> + T_ENonterminals +sem_ENonterminals_Cons (T_ENonterminal hd_) (T_ENonterminals tl_) = + (T_ENonterminals (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIderivings + _lhsIimportBlocks + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsImoduleHeader + _lhsIoptions + _lhsIpragmaBlocks + _lhsIsynmap + _lhsItextBlocks + _lhsItypeSyns + _lhsIwrappers -> + (let _lhsOappendCommon :: ([PP_Doc]) + _lhsOappendMain :: ([PP_Doc]) + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOgenProdIO :: (IO ()) + _lhsOimports :: ([PP_Doc]) + _lhsOinitStates :: (Map NontermIdent Int) + _lhsOoutput :: PP_Doc + _lhsOsemFunBndDefs :: (Seq PP_Doc) + _lhsOsemFunBndTps :: (Seq PP_Doc) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + _hdOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _hdOallInitStates :: (Map NontermIdent Int) + _hdOallVisitKinds :: (Map VisitIdentifier VisitKind) + _hdOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _hdOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _hdOavisituses :: (Map VisitIdentifier (Set Identifier)) + _hdOderivings :: Derivings + _hdOimportBlocks :: PP_Doc + _hdOinhmap :: (Map NontermIdent Attributes) + _hdOlocalAttrTypes :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) + _hdOmainFile :: String + _hdOmainName :: String + _hdOmoduleHeader :: (String -> String -> String -> Bool -> String) + _hdOoptions :: Options + _hdOpragmaBlocks :: String + _hdOsynmap :: (Map NontermIdent Attributes) + _hdOtextBlocks :: PP_Doc + _hdOtypeSyns :: TypeSyns + _hdOwrappers :: (Set NontermIdent) + _tlOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _tlOallInitStates :: (Map NontermIdent Int) + _tlOallVisitKinds :: (Map VisitIdentifier VisitKind) + _tlOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _tlOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _tlOavisituses :: (Map VisitIdentifier (Set Identifier)) + _tlOderivings :: Derivings + _tlOimportBlocks :: PP_Doc + _tlOinhmap :: (Map NontermIdent Attributes) + _tlOlocalAttrTypes :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) + _tlOmainFile :: String + _tlOmainName :: String + _tlOmoduleHeader :: (String -> String -> String -> Bool -> String) + _tlOoptions :: Options + _tlOpragmaBlocks :: String + _tlOsynmap :: (Map NontermIdent Attributes) + _tlOtextBlocks :: PP_Doc + _tlOtypeSyns :: TypeSyns + _tlOwrappers :: (Set NontermIdent) + _hdIappendCommon :: ( PP_Doc ) + _hdIappendMain :: ( PP_Doc ) + _hdIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _hdIerrors :: (Seq Error) + _hdIfromToStates :: (Map VisitIdentifier (Int,Int)) + _hdIgenProdIO :: (IO ()) + _hdIimports :: ([PP_Doc]) + _hdIinitStates :: (Map NontermIdent Int) + _hdIoutput :: PP_Doc + _hdIsemFunBndDefs :: (Seq PP_Doc) + _hdIsemFunBndTps :: (Seq PP_Doc) + _hdIvisitKinds :: (Map VisitIdentifier VisitKind) + _hdIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _hdIvisituses :: (Map VisitIdentifier (Set Identifier)) + _tlIappendCommon :: ([PP_Doc]) + _tlIappendMain :: ([PP_Doc]) + _tlIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _tlIerrors :: (Seq Error) + _tlIfromToStates :: (Map VisitIdentifier (Int,Int)) + _tlIgenProdIO :: (IO ()) + _tlIimports :: ([PP_Doc]) + _tlIinitStates :: (Map NontermIdent Int) + _tlIoutput :: PP_Doc + _tlIsemFunBndDefs :: (Seq PP_Doc) + _tlIsemFunBndTps :: (Seq PP_Doc) + _tlIvisitKinds :: (Map VisitIdentifier VisitKind) + _tlIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _tlIvisituses :: (Map VisitIdentifier (Set Identifier)) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1444, column 51) + _lhsOappendCommon = + ({-# LINE 1444 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIappendCommon : _tlIappendCommon + {-# LINE 2144 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1444, column 51) + _lhsOappendMain = + ({-# LINE 1444 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIappendMain : _tlIappendMain + {-# LINE 2150 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1184, column 37) + _lhsOchildvisit = + ({-# LINE 1184 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIchildvisit `Map.union` _tlIchildvisit + {-# LINE 2156 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 2162 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1541, column 22) + _lhsOfromToStates = + ({-# LINE 1541 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIfromToStates `mappend` _tlIfromToStates + {-# LINE 2168 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1461, column 49) + _lhsOgenProdIO = + ({-# LINE 1461 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIgenProdIO >> _tlIgenProdIO + {-# LINE 2174 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1460, column 47) + _lhsOimports = + ({-# LINE 1460 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIimports ++ _tlIimports + {-# LINE 2180 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1600, column 50) + _lhsOinitStates = + ({-# LINE 1600 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIinitStates `mappend` _tlIinitStates + {-# LINE 2186 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 90, column 45) + _lhsOoutput = + ({-# LINE 90 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIoutput >-< _tlIoutput + {-# LINE 2192 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 512, column 92) + _lhsOsemFunBndDefs = + ({-# LINE 512 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIsemFunBndDefs Seq.>< _tlIsemFunBndDefs + {-# LINE 2198 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 512, column 92) + _lhsOsemFunBndTps = + ({-# LINE 512 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIsemFunBndTps Seq.>< _tlIsemFunBndTps + {-# LINE 2204 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1588, column 68) + _lhsOvisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIvisitKinds `mappend` _tlIvisitKinds + {-# LINE 2210 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1319, column 36) + _lhsOvisitdefs = + ({-# LINE 1319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIvisitdefs `uwSetUnion` _tlIvisitdefs + {-# LINE 2216 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1320, column 36) + _lhsOvisituses = + ({-# LINE 1320 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIvisituses `uwSetUnion` _tlIvisituses + {-# LINE 2222 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallFromToStates = + ({-# LINE 1544 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallFromToStates + {-# LINE 2228 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 2234 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallVisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallVisitKinds + {-# LINE 2240 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 1183 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 2246 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 2252 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 2258 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOderivings = + ({-# LINE 129 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIderivings + {-# LINE 2264 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOimportBlocks = + ({-# LINE 34 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIimportBlocks + {-# LINE 2270 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 309 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 2276 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOlocalAttrTypes = + ({-# LINE 1573 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 2282 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmainFile = + ({-# LINE 38 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainFile + {-# LINE 2288 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmainName = + ({-# LINE 39 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainName + {-# LINE 2294 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmoduleHeader = + ({-# LINE 37 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImoduleHeader + {-# LINE 2300 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 2306 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOpragmaBlocks = + ({-# LINE 35 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIpragmaBlocks + {-# LINE 2312 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 310 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 2318 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOtextBlocks = + ({-# LINE 36 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsItextBlocks + {-# LINE 2324 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOtypeSyns = + ({-# LINE 128 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsItypeSyns + {-# LINE 2330 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOwrappers = + ({-# LINE 89 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIwrappers + {-# LINE 2336 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallFromToStates = + ({-# LINE 1544 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallFromToStates + {-# LINE 2342 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 2348 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallVisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallVisitKinds + {-# LINE 2354 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 1183 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 2360 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 2366 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 2372 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOderivings = + ({-# LINE 129 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIderivings + {-# LINE 2378 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOimportBlocks = + ({-# LINE 34 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIimportBlocks + {-# LINE 2384 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 309 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 2390 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOlocalAttrTypes = + ({-# LINE 1573 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 2396 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmainFile = + ({-# LINE 38 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainFile + {-# LINE 2402 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmainName = + ({-# LINE 39 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainName + {-# LINE 2408 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmoduleHeader = + ({-# LINE 37 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImoduleHeader + {-# LINE 2414 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 2420 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOpragmaBlocks = + ({-# LINE 35 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIpragmaBlocks + {-# LINE 2426 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 310 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 2432 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOtextBlocks = + ({-# LINE 36 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsItextBlocks + {-# LINE 2438 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOtypeSyns = + ({-# LINE 128 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsItypeSyns + {-# LINE 2444 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOwrappers = + ({-# LINE 89 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIwrappers + {-# LINE 2450 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _hdIappendCommon,_hdIappendMain,_hdIchildvisit,_hdIerrors,_hdIfromToStates,_hdIgenProdIO,_hdIimports,_hdIinitStates,_hdIoutput,_hdIsemFunBndDefs,_hdIsemFunBndTps,_hdIvisitKinds,_hdIvisitdefs,_hdIvisituses) = + hd_ _hdOallFromToStates _hdOallInitStates _hdOallVisitKinds _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOderivings _hdOimportBlocks _hdOinhmap _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOoptions _hdOpragmaBlocks _hdOsynmap _hdOtextBlocks _hdOtypeSyns _hdOwrappers + ( _tlIappendCommon,_tlIappendMain,_tlIchildvisit,_tlIerrors,_tlIfromToStates,_tlIgenProdIO,_tlIimports,_tlIinitStates,_tlIoutput,_tlIsemFunBndDefs,_tlIsemFunBndTps,_tlIvisitKinds,_tlIvisitdefs,_tlIvisituses) = + tl_ _tlOallFromToStates _tlOallInitStates _tlOallVisitKinds _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOderivings _tlOimportBlocks _tlOinhmap _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOoptions _tlOpragmaBlocks _tlOsynmap _tlOtextBlocks _tlOtypeSyns _tlOwrappers + in ( _lhsOappendCommon,_lhsOappendMain,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOinitStates,_lhsOoutput,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +sem_ENonterminals_Nil :: T_ENonterminals +sem_ENonterminals_Nil = + (T_ENonterminals (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIderivings + _lhsIimportBlocks + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsImoduleHeader + _lhsIoptions + _lhsIpragmaBlocks + _lhsIsynmap + _lhsItextBlocks + _lhsItypeSyns + _lhsIwrappers -> + (let _lhsOappendCommon :: ([PP_Doc]) + _lhsOappendMain :: ([PP_Doc]) + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOgenProdIO :: (IO ()) + _lhsOimports :: ([PP_Doc]) + _lhsOinitStates :: (Map NontermIdent Int) + _lhsOoutput :: PP_Doc + _lhsOsemFunBndDefs :: (Seq PP_Doc) + _lhsOsemFunBndTps :: (Seq PP_Doc) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1444, column 51) + _lhsOappendCommon = + ({-# LINE 1444 "./src-ag/ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 2496 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1444, column 51) + _lhsOappendMain = + ({-# LINE 1444 "./src-ag/ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 2502 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1184, column 37) + _lhsOchildvisit = + ({-# LINE 1184 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 2508 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + Seq.empty + {-# LINE 2514 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1541, column 22) + _lhsOfromToStates = + ({-# LINE 1541 "./src-ag/ExecutionPlan2Hs.ag" #-} + mempty + {-# LINE 2520 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1461, column 49) + _lhsOgenProdIO = + ({-# LINE 1461 "./src-ag/ExecutionPlan2Hs.ag" #-} + return () + {-# LINE 2526 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1460, column 47) + _lhsOimports = + ({-# LINE 1460 "./src-ag/ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 2532 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1600, column 50) + _lhsOinitStates = + ({-# LINE 1600 "./src-ag/ExecutionPlan2Hs.ag" #-} + mempty + {-# LINE 2538 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 90, column 45) + _lhsOoutput = + ({-# LINE 90 "./src-ag/ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 2544 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 512, column 92) + _lhsOsemFunBndDefs = + ({-# LINE 512 "./src-ag/ExecutionPlan2Hs.ag" #-} + Seq.empty + {-# LINE 2550 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 512, column 92) + _lhsOsemFunBndTps = + ({-# LINE 512 "./src-ag/ExecutionPlan2Hs.ag" #-} + Seq.empty + {-# LINE 2556 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1588, column 68) + _lhsOvisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + mempty + {-# LINE 2562 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1319, column 36) + _lhsOvisitdefs = + ({-# LINE 1319 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 2568 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1320, column 36) + _lhsOvisituses = + ({-# LINE 1320 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 2574 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOappendCommon,_lhsOappendMain,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOinitStates,_lhsOoutput,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +-- EProduction ------------------------------------------------- +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInhmap : Map NontermIdent Attributes + allInitStates : Map NontermIdent Int + allSynmap : Map NontermIdent Attributes + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) + allstates : Set StateIdentifier + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + classCtxs : ClassContext + importBlocks : PP_Doc + inhmap : Attributes + initial : StateIdentifier + localAttrTypes : Map ConstructorIdent (Map Identifier Type) + mainFile : String + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + nextVisits : Map StateIdentifier StateCtx + nt : NontermIdent + ntType : Type + options : Options + params : [Identifier] + pragmaBlocks : String + prevVisits : Map StateIdentifier StateCtx + rename : Bool + synmap : Attributes + textBlocks : PP_Doc + synthesized attributes: + allvisits : [VisitStateState] + childvisit : Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) + count : Int + datatype : PP_Doc + errors : Seq Error + fromToStates : Map VisitIdentifier (Int,Int) + genProdIO : IO () + imports : [PP_Doc] + semFunBndDefs : Seq PP_Doc + semFunBndTps : Seq PP_Doc + sem_nt : PP_Doc + sem_prod : PP_Doc + t_visits : PP_Doc + visitKinds : Map VisitIdentifier VisitKind + visitdefs : Map VisitIdentifier (Set Identifier) + visituses : Map VisitIdentifier (Set Identifier) + alternatives: + alternative EProduction: + child con : {ConstructorIdent} + child params : {[Identifier]} + child constraints : {[Type]} + child rules : ERules + child children : EChildren + child visits : Visits + visit 0: + local classPP1 : _ + local quantPP1 : _ + local semFunBndDef : _ + local semFunBndTp : _ + local semFunBndNm : _ + local t_type : _ + local t_params : _ + local args : _ + local semname : _ + local sem_tp : _ + local classPP2 : _ + local quantPP2 : _ + local sem_prod : _ + local mkSemBody : _ + local mbInitializer : _ + local scc : _ + local semInlinePragma : _ + local outerlet : _ + local statefns : _ + local genstfn : _ + local stargs : _ + local stks : _ + local stvisits : _ + local stvs : _ + local lazyIntras : _ + local moduleName : _ + local suffix : _ + local outputfile : _ + local ppMonadImports : _ + local addbang : _ + local childTypes : _ + local localAttrTypes : _ +-} +-- cata +sem_EProduction :: EProduction -> + T_EProduction +sem_EProduction (EProduction _con _params _constraints _rules _children _visits) = + (sem_EProduction_EProduction _con _params _constraints (sem_ERules _rules) (sem_EChildren _children) (sem_Visits _visits)) +-- semantic domain +newtype T_EProduction = T_EProduction ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Attributes) -> + (Map NontermIdent Int) -> + (Map NontermIdent Attributes) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> + (Set StateIdentifier) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + ClassContext -> + PP_Doc -> + Attributes -> + StateIdentifier -> + (Map ConstructorIdent (Map Identifier Type)) -> + String -> + String -> + (String -> String -> String -> Bool -> String) -> + (Map StateIdentifier StateCtx) -> + NontermIdent -> + Type -> + Options -> + ([Identifier]) -> + String -> + (Map StateIdentifier StateCtx) -> + Bool -> + Attributes -> + PP_Doc -> + ( ([VisitStateState]),(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),Int,PP_Doc,(Seq Error),(Map VisitIdentifier (Int,Int)),(IO ()),([PP_Doc]),(Seq PP_Doc),(Seq PP_Doc),PP_Doc,PP_Doc,PP_Doc,(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier)))) +data Inh_EProduction = Inh_EProduction {allFromToStates_Inh_EProduction :: (Map VisitIdentifier (Int,Int)),allInhmap_Inh_EProduction :: (Map NontermIdent Attributes),allInitStates_Inh_EProduction :: (Map NontermIdent Int),allSynmap_Inh_EProduction :: (Map NontermIdent Attributes),allVisitKinds_Inh_EProduction :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_EProduction :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),allstates_Inh_EProduction :: (Set StateIdentifier),avisitdefs_Inh_EProduction :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_EProduction :: (Map VisitIdentifier (Set Identifier)),classCtxs_Inh_EProduction :: ClassContext,importBlocks_Inh_EProduction :: PP_Doc,inhmap_Inh_EProduction :: Attributes,initial_Inh_EProduction :: StateIdentifier,localAttrTypes_Inh_EProduction :: (Map ConstructorIdent (Map Identifier Type)),mainFile_Inh_EProduction :: String,mainName_Inh_EProduction :: String,moduleHeader_Inh_EProduction :: (String -> String -> String -> Bool -> String),nextVisits_Inh_EProduction :: (Map StateIdentifier StateCtx),nt_Inh_EProduction :: NontermIdent,ntType_Inh_EProduction :: Type,options_Inh_EProduction :: Options,params_Inh_EProduction :: ([Identifier]),pragmaBlocks_Inh_EProduction :: String,prevVisits_Inh_EProduction :: (Map StateIdentifier StateCtx),rename_Inh_EProduction :: Bool,synmap_Inh_EProduction :: Attributes,textBlocks_Inh_EProduction :: PP_Doc} +data Syn_EProduction = Syn_EProduction {allvisits_Syn_EProduction :: ([VisitStateState]),childvisit_Syn_EProduction :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),count_Syn_EProduction :: Int,datatype_Syn_EProduction :: PP_Doc,errors_Syn_EProduction :: (Seq Error),fromToStates_Syn_EProduction :: (Map VisitIdentifier (Int,Int)),genProdIO_Syn_EProduction :: (IO ()),imports_Syn_EProduction :: ([PP_Doc]),semFunBndDefs_Syn_EProduction :: (Seq PP_Doc),semFunBndTps_Syn_EProduction :: (Seq PP_Doc),sem_nt_Syn_EProduction :: PP_Doc,sem_prod_Syn_EProduction :: PP_Doc,t_visits_Syn_EProduction :: PP_Doc,visitKinds_Syn_EProduction :: (Map VisitIdentifier VisitKind),visitdefs_Syn_EProduction :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_EProduction :: (Map VisitIdentifier (Set Identifier))} +wrap_EProduction :: T_EProduction -> + Inh_EProduction -> + Syn_EProduction +wrap_EProduction (T_EProduction sem) (Inh_EProduction _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIpragmaBlocks _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOcount,_lhsOdatatype,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIpragmaBlocks _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks + in (Syn_EProduction _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses)) +sem_EProduction_EProduction :: ConstructorIdent -> + ([Identifier]) -> + ([Type]) -> + T_ERules -> + T_EChildren -> + T_Visits -> + T_EProduction +sem_EProduction_EProduction con_ params_ constraints_ (T_ERules rules_) (T_EChildren children_) (T_Visits visits_) = + (T_EProduction (\ _lhsIallFromToStates + _lhsIallInhmap + _lhsIallInitStates + _lhsIallSynmap + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIallstates + _lhsIavisitdefs + _lhsIavisituses + _lhsIclassCtxs + _lhsIimportBlocks + _lhsIinhmap + _lhsIinitial + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsImoduleHeader + _lhsInextVisits + _lhsInt + _lhsIntType + _lhsIoptions + _lhsIparams + _lhsIpragmaBlocks + _lhsIprevVisits + _lhsIrename + _lhsIsynmap + _lhsItextBlocks -> + (let _childrenOcon :: ConstructorIdent + _rulesOcon :: ConstructorIdent + _visitsOcon :: ConstructorIdent + _lhsOdatatype :: PP_Doc + _lhsOcount :: Int + _lhsOsem_nt :: PP_Doc + _lhsOsemFunBndDefs :: (Seq PP_Doc) + _lhsOsemFunBndTps :: (Seq PP_Doc) + _visitsOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) + _visitsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _rulesOusageInfo :: (Map Identifier Int) + _rulesOruleKinds :: (Map Identifier (Set VisitKind)) + _visitsOallintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _visitsOterminaldefs :: (Set String) + _visitsOruledefs :: (Map Identifier (Set String)) + _visitsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _lhsOimports :: ([PP_Doc]) + _lhsOgenProdIO :: (IO ()) + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOt_visits :: PP_Doc + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + _lhsOallvisits :: ([VisitStateState]) + _lhsOsem_prod :: PP_Doc + _rulesOallInhmap :: (Map NontermIdent Attributes) + _rulesOallSynmap :: (Map NontermIdent Attributes) + _rulesOchildTypes :: (Map Identifier Type) + _rulesOimportBlocks :: PP_Doc + _rulesOinhmap :: Attributes + _rulesOlazyIntras :: (Set String) + _rulesOlocalAttrTypes :: (Map Identifier Type) + _rulesOmainFile :: String + _rulesOmainName :: String + _rulesOmoduleHeader :: (String -> String -> String -> Bool -> String) + _rulesOnt :: NontermIdent + _rulesOoptions :: Options + _rulesOpragmaBlocks :: String + _rulesOsynmap :: Attributes + _rulesOtextBlocks :: PP_Doc + _childrenOallInitStates :: (Map NontermIdent Int) + _childrenOimportBlocks :: PP_Doc + _childrenOmainFile :: String + _childrenOmainName :: String + _childrenOmoduleHeader :: (String -> String -> String -> Bool -> String) + _childrenOnt :: NontermIdent + _childrenOoptions :: Options + _childrenOpragmaBlocks :: String + _childrenOtextBlocks :: PP_Doc + _visitsOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _visitsOallInhmap :: (Map NontermIdent Attributes) + _visitsOallInitStates :: (Map NontermIdent Int) + _visitsOallSynmap :: (Map NontermIdent Attributes) + _visitsOallVisitKinds :: (Map VisitIdentifier VisitKind) + _visitsOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _visitsOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _visitsOavisituses :: (Map VisitIdentifier (Set Identifier)) + _visitsOchildTypes :: (Map Identifier Type) + _visitsOinhmap :: Attributes + _visitsOnextVisits :: (Map StateIdentifier StateCtx) + _visitsOnt :: NontermIdent + _visitsOoptions :: Options + _visitsOparams :: ([Identifier]) + _visitsOprevVisits :: (Map StateIdentifier StateCtx) + _visitsOsynmap :: Attributes + _rulesIerrors :: (Seq Error) + _rulesImrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) + _rulesIruledefs :: (Map Identifier (Set String)) + _rulesIruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _rulesIsem_rules :: PP_Doc + _childrenIargnamesw :: ([PP_Doc]) + _childrenIargpats :: ( [PP_Doc] ) + _childrenIargtps :: ( [PP_Doc] ) + _childrenIchildTypes :: (Map Identifier Type) + _childrenIchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _childrenIdatatype :: ([PP_Doc]) + _childrenIterminaldefs :: (Set String) + _visitsIallvisits :: ([VisitStateState]) + _visitsIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _visitsIerrors :: (Seq Error) + _visitsIfromToStates :: (Map VisitIdentifier (Int,Int)) + _visitsIintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _visitsIlazyIntras :: (Set String) + _visitsIruleKinds :: (Map Identifier (Set VisitKind)) + _visitsIruleUsage :: (Map Identifier Int) + _visitsIsem_visit :: ( [(StateIdentifier,Bool -> PP_Doc)] ) + _visitsIt_visits :: PP_Doc + _visitsIvisitKinds :: (Map VisitIdentifier VisitKind) + _visitsIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _visitsIvisituses :: (Map VisitIdentifier (Set Identifier)) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 69, column 17) + _childrenOcon = + ({-# LINE 69 "./src-ag/ExecutionPlan2Hs.ag" #-} + con_ + {-# LINE 2840 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 70, column 17) + _rulesOcon = + ({-# LINE 70 "./src-ag/ExecutionPlan2Hs.ag" #-} + con_ + {-# LINE 2846 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 71, column 17) + _visitsOcon = + ({-# LINE 71 "./src-ag/ExecutionPlan2Hs.ag" #-} + con_ + {-# LINE 2852 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 184, column 17) + _lhsOdatatype = + ({-# LINE 184 "./src-ag/ExecutionPlan2Hs.ag" #-} + _quantPP1 >#< _classPP1 + >#< conname _lhsIrename _lhsInt con_ + >#< ppConFields (dataRecords _lhsIoptions) _childrenIdatatype + {-# LINE 2860 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 187, column 17) + _classPP1 = + ({-# LINE 187 "./src-ag/ExecutionPlan2Hs.ag" #-} + ppClasses (classConstrsToDocs constraints_) + {-# LINE 2866 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 188, column 17) + _quantPP1 = + ({-# LINE 188 "./src-ag/ExecutionPlan2Hs.ag" #-} + ppQuants params_ + {-# LINE 2872 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 286, column 32) + _lhsOcount = + ({-# LINE 286 "./src-ag/ExecutionPlan2Hs.ag" #-} + 1 + {-# LINE 2878 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 291, column 17) + _lhsOsem_nt = + ({-# LINE 291 "./src-ag/ExecutionPlan2Hs.ag" #-} + "sem_" >|< _lhsInt >#< "(" >#< conname _lhsIrename _lhsInt con_ >#< ppSpaced _childrenIargpats >#< ")" + >#< "=" >#< "sem_" >|< _lhsInt >|< "_" >|< con_ >#< ppSpaced _childrenIargnamesw + {-# LINE 2885 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 521, column 3) + _lhsOsemFunBndDefs = + ({-# LINE 521 "./src-ag/ExecutionPlan2Hs.ag" #-} + Seq.singleton _semFunBndDef + {-# LINE 2891 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 522, column 3) + _lhsOsemFunBndTps = + ({-# LINE 522 "./src-ag/ExecutionPlan2Hs.ag" #-} + Seq.singleton _semFunBndTp + {-# LINE 2897 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 523, column 3) + _semFunBndDef = + ({-# LINE 523 "./src-ag/ExecutionPlan2Hs.ag" #-} + _semFunBndNm >#< "=" >#< _semname + {-# LINE 2903 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 524, column 3) + _semFunBndTp = + ({-# LINE 524 "./src-ag/ExecutionPlan2Hs.ag" #-} + _semFunBndNm >#< "::" >#< _sem_tp + {-# LINE 2909 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 525, column 3) + _semFunBndNm = + ({-# LINE 525 "./src-ag/ExecutionPlan2Hs.ag" #-} + lateSemConLabel _lhsInt con_ + {-# LINE 2915 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 583, column 17) + _t_type = + ({-# LINE 583 "./src-ag/ExecutionPlan2Hs.ag" #-} + "T_" >|< _lhsInt + {-# LINE 2921 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 584, column 17) + _t_params = + ({-# LINE 584 "./src-ag/ExecutionPlan2Hs.ag" #-} + ppSpaced _lhsIparams + {-# LINE 2927 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 585, column 17) + _args = + ({-# LINE 585 "./src-ag/ExecutionPlan2Hs.ag" #-} + _childrenIargpats + {-# LINE 2933 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 586, column 17) + _semname = + ({-# LINE 586 "./src-ag/ExecutionPlan2Hs.ag" #-} + "sem_" ++ show _lhsInt ++ "_" ++ show con_ + {-# LINE 2939 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 587, column 17) + _sem_tp = + ({-# LINE 587 "./src-ag/ExecutionPlan2Hs.ag" #-} + _quantPP2 >#< _classPP2 >#< ppSpaced _childrenIargtps >#< _t_type >#< _t_params + {-# LINE 2945 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 588, column 17) + _classPP2 = + ({-# LINE 588 "./src-ag/ExecutionPlan2Hs.ag" #-} + ppClasses (classCtxsToDocs _lhsIclassCtxs ++ classConstrsToDocs constraints_) + {-# LINE 2951 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 589, column 17) + _quantPP2 = + ({-# LINE 589 "./src-ag/ExecutionPlan2Hs.ag" #-} + ppQuants (_lhsIparams ++ params_) + {-# LINE 2957 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 590, column 17) + _sem_prod = + ({-# LINE 590 "./src-ag/ExecutionPlan2Hs.ag" #-} + _semInlinePragma + >-< _semname >#< "::" >#< _sem_tp + >-< _mkSemBody (_semname >#< ppSpaced _args >#< "=" >#< _scc >#< _t_type ) + _mbInitializer _outerlet ("return" >#< "st" >|< _lhsIinitial) + {-# LINE 2966 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 594, column 17) + _mkSemBody = + ({-# LINE 594 "./src-ag/ExecutionPlan2Hs.ag" #-} + \prefix mbInit outerlet ret -> + case mbInit of + Nothing -> prefix >#< pp_parens ret >#< "where" + >-< indent 3 outerlet + Just m -> prefix >#< "(" >#< "do" + >-< indent 1 ( + m + >-< "let" + >-< indent 2 outerlet + >-< ret ) + >-< indent 1 ")" + {-# LINE 2982 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 606, column 17) + _mbInitializer = + ({-# LINE 606 "./src-ag/ExecutionPlan2Hs.ag" #-} + if parallelInvoke _lhsIoptions + then (Nothing :: Maybe PP_Doc) + else Nothing + {-# LINE 2990 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 612, column 17) + _scc = + ({-# LINE 612 "./src-ag/ExecutionPlan2Hs.ag" #-} + if genCostCentres _lhsIoptions + then ppCostCentre _semname + else empty + {-# LINE 2998 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 615, column 17) + _semInlinePragma = + ({-# LINE 615 "./src-ag/ExecutionPlan2Hs.ag" #-} + if noInlinePragmas _lhsIoptions + then empty + else ppNoInline _semname + {-# LINE 3006 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 618, column 17) + _outerlet = + ({-# LINE 618 "./src-ag/ExecutionPlan2Hs.ag" #-} + vlist _statefns >-< _rulesIsem_rules + {-# LINE 3012 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 619, column 17) + _statefns = + ({-# LINE 619 "./src-ag/ExecutionPlan2Hs.ag" #-} + map _genstfn $ Set.toList _lhsIallstates + {-# LINE 3018 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 620, column 17) + _genstfn = + ({-# LINE 620 "./src-ag/ExecutionPlan2Hs.ag" #-} + \st -> let nextVisitInfo = Map.findWithDefault ManyVis st _lhsInextVisits + prevVisitInfo = Map.findWithDefault ManyVis st _lhsIprevVisits + stNm = "st" >|< st + lhs = pragma >-< bang stNm >#< "=" >#< + ( + if st == _lhsIinitial + then empty + else "\\" >#< _stargs st >#< "->" + ) + pragma = if noInlinePragmas _lhsIoptions + then empty + else if helpInlining _lhsIoptions + then case prevVisitInfo of + ManyVis -> ppNoInline stNm + OneVis _ -> if aggressiveInlinePragmas _lhsIoptions + then ppInline stNm + else ppInlinable stNm + NoneVis -> if st /= _lhsIinitial + then error ("State " ++ show st ++ " is not reachable from the initial state.") + else if aggressiveInlinePragmas _lhsIoptions + then ppInline stNm + else ppInlinable stNm + else ppNoInline stNm + cCon = "C_" >|< _lhsInt >|< "_s" >|< st + bang | st == _lhsIinitial = _addbang + | otherwise = id + in case nextVisitInfo of + NoneVis -> + if st == _lhsIinitial + then lhs >#< cCon + else empty + OneVis vId -> mklet lhs (_stvs st False) (cCon >#< "v" >|< vId) + ManyVis -> mklet lhs (_stks st >-< _stvs st True) (cCon >#< "k" >|< st) + {-# LINE 3056 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 662, column 17) + _stargs = + ({-# LINE 662 "./src-ag/ExecutionPlan2Hs.ag" #-} + \st -> let attrs = maybe Map.empty id $ Map.lookup st _visitsIintramap + in ppSpaced [ let match | str `Set.member` _lazyIntras = pp str + | otherwise = _addbang (pp str) + in case mbAttr of + Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs _lhsIoptions) -> + case Map.lookup nm _localAttrTypes of + Just tp -> pp_parens (pp_parens match >#< "::" >#< ppTp tp) + Nothing -> match + Just attr | not (noPerStateTypeSigs _lhsIoptions) -> + case lookupAttrType attr _lhsIallInhmap _lhsIallSynmap _childTypes of + Just tpDoc -> pp_parens (pp_parens match >#< "::" >#< tpDoc) + Nothing -> match + _ -> match + | (str,mbAttr) <- Map.assocs attrs + ] >#< dummyPat _lhsIoptions (Map.null attrs) + {-# LINE 3076 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 678, column 17) + _stks = + ({-# LINE 678 "./src-ag/ExecutionPlan2Hs.ag" #-} + \st -> if null (_stvisits st) + then empty + else ( if not (noInlinePragmas _lhsIoptions) && helpInlining _lhsIoptions + then ppNoInline ("k" >|< st) + else empty + ) + >-< "k" >|< st >#< "::" >#< "K_" >|< _lhsInt >|< "_s" >|< st >#< _t_params >#< "t" >#< "->" >#< "t" + >-< vlist (map (\(v,f,t) -> "k" >|< st >#< "K_" >|< _lhsInt >|< "_v" >|< v >#< "=" + >#< "v" >|< v) $ _stvisits st) + {-# LINE 3090 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 687, column 17) + _stvisits = + ({-# LINE 687 "./src-ag/ExecutionPlan2Hs.ag" #-} + \st -> filter (\(v,f,t) -> f == st) _visitsIallvisits + {-# LINE 3096 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 688, column 17) + _stvs = + ({-# LINE 688 "./src-ag/ExecutionPlan2Hs.ag" #-} + \st inlinePragma -> vlist [ppf inlinePragma | (f,ppf) <- _visitsIsem_visit, f == st] + {-# LINE 3102 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 689, column 17) + _visitsOmrules = + ({-# LINE 689 "./src-ag/ExecutionPlan2Hs.ag" #-} + _rulesImrules + {-# LINE 3108 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 893, column 17) + _visitsOchildintros = + ({-# LINE 893 "./src-ag/ExecutionPlan2Hs.ag" #-} + _childrenIchildintros + {-# LINE 3114 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1243, column 32) + _rulesOusageInfo = + ({-# LINE 1243 "./src-ag/ExecutionPlan2Hs.ag" #-} + _visitsIruleUsage + {-# LINE 3120 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1258, column 3) + _rulesOruleKinds = + ({-# LINE 1258 "./src-ag/ExecutionPlan2Hs.ag" #-} + _visitsIruleKinds + {-# LINE 3126 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1287, column 3) + _visitsOallintramap = + ({-# LINE 1287 "./src-ag/ExecutionPlan2Hs.ag" #-} + _visitsIintramap + {-# LINE 3132 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1288, column 3) + _visitsOterminaldefs = + ({-# LINE 1288 "./src-ag/ExecutionPlan2Hs.ag" #-} + _childrenIterminaldefs + {-# LINE 3138 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1312, column 17) + _visitsOruledefs = + ({-# LINE 1312 "./src-ag/ExecutionPlan2Hs.ag" #-} + _rulesIruledefs + {-# LINE 3144 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1313, column 17) + _visitsOruleuses = + ({-# LINE 1313 "./src-ag/ExecutionPlan2Hs.ag" #-} + _rulesIruleuses + {-# LINE 3150 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1367, column 3) + _lazyIntras = + ({-# LINE 1367 "./src-ag/ExecutionPlan2Hs.ag" #-} + _visitsIlazyIntras + {-# LINE 3156 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1464, column 17) + _lhsOimports = + ({-# LINE 1464 "./src-ag/ExecutionPlan2Hs.ag" #-} + [pp $ "import " ++ _moduleName ] + {-# LINE 3162 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1465, column 17) + _moduleName = + ({-# LINE 1465 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainName ++ _suffix + {-# LINE 3168 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1466, column 17) + _suffix = + ({-# LINE 1466 "./src-ag/ExecutionPlan2Hs.ag" #-} + "_" ++ show _lhsInt ++ "_" ++ show con_ + {-# LINE 3174 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1467, column 17) + _outputfile = + ({-# LINE 1467 "./src-ag/ExecutionPlan2Hs.ag" #-} + replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ _suffix ) + {-# LINE 3180 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1468, column 17) + _ppMonadImports = + ({-# LINE 1468 "./src-ag/ExecutionPlan2Hs.ag" #-} + if parallelInvoke _lhsIoptions + then pp "import qualified System.IO.Unsafe(unsafePerformIO)" + >-< pp "import System.IO(IO)" + >-< pp "import Control.Concurrent(newEmptyMVar,forkIO,putMVar,takeMVar)" + else pp "import Control.Monad.Identity" + {-# LINE 3190 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1473, column 17) + _lhsOgenProdIO = + ({-# LINE 1473 "./src-ag/ExecutionPlan2Hs.ag" #-} + writeModule _outputfile + [ warrenFlagsPP _lhsIoptions + , pp $ _lhsIpragmaBlocks + , pp $ _lhsImoduleHeader _lhsImainName _suffix _semname True + , _lhsIimportBlocks + , _ppMonadImports + , ( if tupleAsDummyToken _lhsIoptions + then empty + else pp "import GHC.Prim" + ) + , pp $ "import " ++ _lhsImainName ++ "_common" + , _sem_prod + ] + {-# LINE 3208 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1514, column 37) + _addbang = + ({-# LINE 1514 "./src-ag/ExecutionPlan2Hs.ag" #-} + \x -> if bangpats _lhsIoptions then "!" >|< x else x + {-# LINE 3214 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1564, column 3) + _childTypes = + ({-# LINE 1564 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton _LHS _lhsIntType `Map.union` _childrenIchildTypes + {-# LINE 3220 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1581, column 3) + _localAttrTypes = + ({-# LINE 1581 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIlocalAttrTypes + {-# LINE 3226 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1184, column 37) + _lhsOchildvisit = + ({-# LINE 1184 "./src-ag/ExecutionPlan2Hs.ag" #-} + _visitsIchildvisit + {-# LINE 3232 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + _rulesIerrors Seq.>< _visitsIerrors + {-# LINE 3238 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1541, column 22) + _lhsOfromToStates = + ({-# LINE 1541 "./src-ag/ExecutionPlan2Hs.ag" #-} + _visitsIfromToStates + {-# LINE 3244 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 391, column 59) + _lhsOt_visits = + ({-# LINE 391 "./src-ag/ExecutionPlan2Hs.ag" #-} + _visitsIt_visits + {-# LINE 3250 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1588, column 68) + _lhsOvisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _visitsIvisitKinds + {-# LINE 3256 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1319, column 36) + _lhsOvisitdefs = + ({-# LINE 1319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _visitsIvisitdefs + {-# LINE 3262 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1320, column 36) + _lhsOvisituses = + ({-# LINE 1320 "./src-ag/ExecutionPlan2Hs.ag" #-} + _visitsIvisituses + {-# LINE 3268 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (up) + _lhsOallvisits = + ({-# LINE 335 "./src-ag/ExecutionPlan2Hs.ag" #-} + _visitsIallvisits + {-# LINE 3274 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (from local) + _lhsOsem_prod = + ({-# LINE 550 "./src-ag/ExecutionPlan2Hs.ag" #-} + _sem_prod + {-# LINE 3280 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _rulesOallInhmap = + ({-# LINE 318 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInhmap + {-# LINE 3286 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _rulesOallSynmap = + ({-# LINE 319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallSynmap + {-# LINE 3292 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (from local) + _rulesOchildTypes = + ({-# LINE 1561 "./src-ag/ExecutionPlan2Hs.ag" #-} + _childTypes + {-# LINE 3298 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _rulesOimportBlocks = + ({-# LINE 34 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIimportBlocks + {-# LINE 3304 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _rulesOinhmap = + ({-# LINE 316 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 3310 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (from local) + _rulesOlazyIntras = + ({-# LINE 1353 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lazyIntras + {-# LINE 3316 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (from local) + _rulesOlocalAttrTypes = + ({-# LINE 1575 "./src-ag/ExecutionPlan2Hs.ag" #-} + _localAttrTypes + {-# LINE 3322 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _rulesOmainFile = + ({-# LINE 38 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainFile + {-# LINE 3328 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _rulesOmainName = + ({-# LINE 39 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainName + {-# LINE 3334 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _rulesOmoduleHeader = + ({-# LINE 37 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImoduleHeader + {-# LINE 3340 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _rulesOnt = + ({-# LINE 61 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 3346 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _rulesOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 3352 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _rulesOpragmaBlocks = + ({-# LINE 35 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIpragmaBlocks + {-# LINE 3358 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _rulesOsynmap = + ({-# LINE 317 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 3364 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _rulesOtextBlocks = + ({-# LINE 36 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsItextBlocks + {-# LINE 3370 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _childrenOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 3376 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _childrenOimportBlocks = + ({-# LINE 34 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIimportBlocks + {-# LINE 3382 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _childrenOmainFile = + ({-# LINE 38 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainFile + {-# LINE 3388 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _childrenOmainName = + ({-# LINE 39 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainName + {-# LINE 3394 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _childrenOmoduleHeader = + ({-# LINE 37 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImoduleHeader + {-# LINE 3400 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _childrenOnt = + ({-# LINE 61 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 3406 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _childrenOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 3412 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _childrenOpragmaBlocks = + ({-# LINE 35 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIpragmaBlocks + {-# LINE 3418 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _childrenOtextBlocks = + ({-# LINE 36 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsItextBlocks + {-# LINE 3424 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOallFromToStates = + ({-# LINE 1544 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallFromToStates + {-# LINE 3430 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOallInhmap = + ({-# LINE 318 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInhmap + {-# LINE 3436 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 3442 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOallSynmap = + ({-# LINE 319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallSynmap + {-# LINE 3448 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOallVisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallVisitKinds + {-# LINE 3454 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOallchildvisit = + ({-# LINE 1183 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 3460 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOavisitdefs = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 3466 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOavisituses = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 3472 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (from local) + _visitsOchildTypes = + ({-# LINE 1561 "./src-ag/ExecutionPlan2Hs.ag" #-} + _childTypes + {-# LINE 3478 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOinhmap = + ({-# LINE 316 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 3484 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOnextVisits = + ({-# LINE 1530 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInextVisits + {-# LINE 3490 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOnt = + ({-# LINE 61 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 3496 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 3502 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOparams = + ({-# LINE 73 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIparams + {-# LINE 3508 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOprevVisits = + ({-# LINE 1530 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIprevVisits + {-# LINE 3514 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOsynmap = + ({-# LINE 317 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 3520 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _rulesIerrors,_rulesImrules,_rulesIruledefs,_rulesIruleuses,_rulesIsem_rules) = + rules_ _rulesOallInhmap _rulesOallSynmap _rulesOchildTypes _rulesOcon _rulesOimportBlocks _rulesOinhmap _rulesOlazyIntras _rulesOlocalAttrTypes _rulesOmainFile _rulesOmainName _rulesOmoduleHeader _rulesOnt _rulesOoptions _rulesOpragmaBlocks _rulesOruleKinds _rulesOsynmap _rulesOtextBlocks _rulesOusageInfo + ( _childrenIargnamesw,_childrenIargpats,_childrenIargtps,_childrenIchildTypes,_childrenIchildintros,_childrenIdatatype,_childrenIterminaldefs) = + children_ _childrenOallInitStates _childrenOcon _childrenOimportBlocks _childrenOmainFile _childrenOmainName _childrenOmoduleHeader _childrenOnt _childrenOoptions _childrenOpragmaBlocks _childrenOtextBlocks + ( _visitsIallvisits,_visitsIchildvisit,_visitsIerrors,_visitsIfromToStates,_visitsIintramap,_visitsIlazyIntras,_visitsIruleKinds,_visitsIruleUsage,_visitsIsem_visit,_visitsIt_visits,_visitsIvisitKinds,_visitsIvisitdefs,_visitsIvisituses) = + visits_ _visitsOallFromToStates _visitsOallInhmap _visitsOallInitStates _visitsOallSynmap _visitsOallVisitKinds _visitsOallchildvisit _visitsOallintramap _visitsOavisitdefs _visitsOavisituses _visitsOchildTypes _visitsOchildintros _visitsOcon _visitsOinhmap _visitsOmrules _visitsOnextVisits _visitsOnt _visitsOoptions _visitsOparams _visitsOprevVisits _visitsOruledefs _visitsOruleuses _visitsOsynmap _visitsOterminaldefs + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOcount,_lhsOdatatype,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +-- EProductions ------------------------------------------------ +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInhmap : Map NontermIdent Attributes + allInitStates : Map NontermIdent Int + allSynmap : Map NontermIdent Attributes + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) + allstates : Set StateIdentifier + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + classCtxs : ClassContext + importBlocks : PP_Doc + inhmap : Attributes + initial : StateIdentifier + localAttrTypes : Map ConstructorIdent (Map Identifier Type) + mainFile : String + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + nextVisits : Map StateIdentifier StateCtx + nt : NontermIdent + ntType : Type + options : Options + params : [Identifier] + pragmaBlocks : String + prevVisits : Map StateIdentifier StateCtx + rename : Bool + synmap : Attributes + textBlocks : PP_Doc + synthesized attributes: + allvisits : [VisitStateState] + childvisit : Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) + count : Int + datatype : [PP_Doc] + errors : Seq Error + fromToStates : Map VisitIdentifier (Int,Int) + genProdIO : IO () + imports : [PP_Doc] + semFunBndDefs : Seq PP_Doc + semFunBndTps : Seq PP_Doc + sem_nt : PP_Doc + sem_prod : PP_Doc + t_visits : PP_Doc + visitKinds : Map VisitIdentifier VisitKind + visitdefs : Map VisitIdentifier (Set Identifier) + visituses : Map VisitIdentifier (Set Identifier) + alternatives: + alternative Cons: + child hd : EProduction + child tl : EProductions + alternative Nil: +-} +-- cata +sem_EProductions :: EProductions -> + T_EProductions +sem_EProductions list = + (Prelude.foldr sem_EProductions_Cons sem_EProductions_Nil (Prelude.map sem_EProduction list)) +-- semantic domain +newtype T_EProductions = T_EProductions ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Attributes) -> + (Map NontermIdent Int) -> + (Map NontermIdent Attributes) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> + (Set StateIdentifier) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + ClassContext -> + PP_Doc -> + Attributes -> + StateIdentifier -> + (Map ConstructorIdent (Map Identifier Type)) -> + String -> + String -> + (String -> String -> String -> Bool -> String) -> + (Map StateIdentifier StateCtx) -> + NontermIdent -> + Type -> + Options -> + ([Identifier]) -> + String -> + (Map StateIdentifier StateCtx) -> + Bool -> + Attributes -> + PP_Doc -> + ( ([VisitStateState]),(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),Int,([PP_Doc]),(Seq Error),(Map VisitIdentifier (Int,Int)),(IO ()),([PP_Doc]),(Seq PP_Doc),(Seq PP_Doc),PP_Doc,PP_Doc,PP_Doc,(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier)))) +data Inh_EProductions = Inh_EProductions {allFromToStates_Inh_EProductions :: (Map VisitIdentifier (Int,Int)),allInhmap_Inh_EProductions :: (Map NontermIdent Attributes),allInitStates_Inh_EProductions :: (Map NontermIdent Int),allSynmap_Inh_EProductions :: (Map NontermIdent Attributes),allVisitKinds_Inh_EProductions :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_EProductions :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),allstates_Inh_EProductions :: (Set StateIdentifier),avisitdefs_Inh_EProductions :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_EProductions :: (Map VisitIdentifier (Set Identifier)),classCtxs_Inh_EProductions :: ClassContext,importBlocks_Inh_EProductions :: PP_Doc,inhmap_Inh_EProductions :: Attributes,initial_Inh_EProductions :: StateIdentifier,localAttrTypes_Inh_EProductions :: (Map ConstructorIdent (Map Identifier Type)),mainFile_Inh_EProductions :: String,mainName_Inh_EProductions :: String,moduleHeader_Inh_EProductions :: (String -> String -> String -> Bool -> String),nextVisits_Inh_EProductions :: (Map StateIdentifier StateCtx),nt_Inh_EProductions :: NontermIdent,ntType_Inh_EProductions :: Type,options_Inh_EProductions :: Options,params_Inh_EProductions :: ([Identifier]),pragmaBlocks_Inh_EProductions :: String,prevVisits_Inh_EProductions :: (Map StateIdentifier StateCtx),rename_Inh_EProductions :: Bool,synmap_Inh_EProductions :: Attributes,textBlocks_Inh_EProductions :: PP_Doc} +data Syn_EProductions = Syn_EProductions {allvisits_Syn_EProductions :: ([VisitStateState]),childvisit_Syn_EProductions :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),count_Syn_EProductions :: Int,datatype_Syn_EProductions :: ([PP_Doc]),errors_Syn_EProductions :: (Seq Error),fromToStates_Syn_EProductions :: (Map VisitIdentifier (Int,Int)),genProdIO_Syn_EProductions :: (IO ()),imports_Syn_EProductions :: ([PP_Doc]),semFunBndDefs_Syn_EProductions :: (Seq PP_Doc),semFunBndTps_Syn_EProductions :: (Seq PP_Doc),sem_nt_Syn_EProductions :: PP_Doc,sem_prod_Syn_EProductions :: PP_Doc,t_visits_Syn_EProductions :: PP_Doc,visitKinds_Syn_EProductions :: (Map VisitIdentifier VisitKind),visitdefs_Syn_EProductions :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_EProductions :: (Map VisitIdentifier (Set Identifier))} +wrap_EProductions :: T_EProductions -> + Inh_EProductions -> + Syn_EProductions +wrap_EProductions (T_EProductions sem) (Inh_EProductions _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIpragmaBlocks _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOcount,_lhsOdatatype,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIpragmaBlocks _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks + in (Syn_EProductions _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses)) +sem_EProductions_Cons :: T_EProduction -> + T_EProductions -> + T_EProductions +sem_EProductions_Cons (T_EProduction hd_) (T_EProductions tl_) = + (T_EProductions (\ _lhsIallFromToStates + _lhsIallInhmap + _lhsIallInitStates + _lhsIallSynmap + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIallstates + _lhsIavisitdefs + _lhsIavisituses + _lhsIclassCtxs + _lhsIimportBlocks + _lhsIinhmap + _lhsIinitial + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsImoduleHeader + _lhsInextVisits + _lhsInt + _lhsIntType + _lhsIoptions + _lhsIparams + _lhsIpragmaBlocks + _lhsIprevVisits + _lhsIrename + _lhsIsynmap + _lhsItextBlocks -> + (let _lhsOallvisits :: ([VisitStateState]) + _lhsOt_visits :: PP_Doc + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _lhsOcount :: Int + _lhsOdatatype :: ([PP_Doc]) + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOgenProdIO :: (IO ()) + _lhsOimports :: ([PP_Doc]) + _lhsOsemFunBndDefs :: (Seq PP_Doc) + _lhsOsemFunBndTps :: (Seq PP_Doc) + _lhsOsem_nt :: PP_Doc + _lhsOsem_prod :: PP_Doc + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + _hdOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _hdOallInhmap :: (Map NontermIdent Attributes) + _hdOallInitStates :: (Map NontermIdent Int) + _hdOallSynmap :: (Map NontermIdent Attributes) + _hdOallVisitKinds :: (Map VisitIdentifier VisitKind) + _hdOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _hdOallstates :: (Set StateIdentifier) + _hdOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _hdOavisituses :: (Map VisitIdentifier (Set Identifier)) + _hdOclassCtxs :: ClassContext + _hdOimportBlocks :: PP_Doc + _hdOinhmap :: Attributes + _hdOinitial :: StateIdentifier + _hdOlocalAttrTypes :: (Map ConstructorIdent (Map Identifier Type)) + _hdOmainFile :: String + _hdOmainName :: String + _hdOmoduleHeader :: (String -> String -> String -> Bool -> String) + _hdOnextVisits :: (Map StateIdentifier StateCtx) + _hdOnt :: NontermIdent + _hdOntType :: Type + _hdOoptions :: Options + _hdOparams :: ([Identifier]) + _hdOpragmaBlocks :: String + _hdOprevVisits :: (Map StateIdentifier StateCtx) + _hdOrename :: Bool + _hdOsynmap :: Attributes + _hdOtextBlocks :: PP_Doc + _tlOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _tlOallInhmap :: (Map NontermIdent Attributes) + _tlOallInitStates :: (Map NontermIdent Int) + _tlOallSynmap :: (Map NontermIdent Attributes) + _tlOallVisitKinds :: (Map VisitIdentifier VisitKind) + _tlOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _tlOallstates :: (Set StateIdentifier) + _tlOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _tlOavisituses :: (Map VisitIdentifier (Set Identifier)) + _tlOclassCtxs :: ClassContext + _tlOimportBlocks :: PP_Doc + _tlOinhmap :: Attributes + _tlOinitial :: StateIdentifier + _tlOlocalAttrTypes :: (Map ConstructorIdent (Map Identifier Type)) + _tlOmainFile :: String + _tlOmainName :: String + _tlOmoduleHeader :: (String -> String -> String -> Bool -> String) + _tlOnextVisits :: (Map StateIdentifier StateCtx) + _tlOnt :: NontermIdent + _tlOntType :: Type + _tlOoptions :: Options + _tlOparams :: ([Identifier]) + _tlOpragmaBlocks :: String + _tlOprevVisits :: (Map StateIdentifier StateCtx) + _tlOrename :: Bool + _tlOsynmap :: Attributes + _tlOtextBlocks :: PP_Doc + _hdIallvisits :: ([VisitStateState]) + _hdIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _hdIcount :: Int + _hdIdatatype :: PP_Doc + _hdIerrors :: (Seq Error) + _hdIfromToStates :: (Map VisitIdentifier (Int,Int)) + _hdIgenProdIO :: (IO ()) + _hdIimports :: ([PP_Doc]) + _hdIsemFunBndDefs :: (Seq PP_Doc) + _hdIsemFunBndTps :: (Seq PP_Doc) + _hdIsem_nt :: PP_Doc + _hdIsem_prod :: PP_Doc + _hdIt_visits :: PP_Doc + _hdIvisitKinds :: (Map VisitIdentifier VisitKind) + _hdIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _hdIvisituses :: (Map VisitIdentifier (Set Identifier)) + _tlIallvisits :: ([VisitStateState]) + _tlIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _tlIcount :: Int + _tlIdatatype :: ([PP_Doc]) + _tlIerrors :: (Seq Error) + _tlIfromToStates :: (Map VisitIdentifier (Int,Int)) + _tlIgenProdIO :: (IO ()) + _tlIimports :: ([PP_Doc]) + _tlIsemFunBndDefs :: (Seq PP_Doc) + _tlIsemFunBndTps :: (Seq PP_Doc) + _tlIsem_nt :: PP_Doc + _tlIsem_prod :: PP_Doc + _tlIt_visits :: PP_Doc + _tlIvisitKinds :: (Map VisitIdentifier VisitKind) + _tlIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _tlIvisituses :: (Map VisitIdentifier (Set Identifier)) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 341, column 10) + _lhsOallvisits = + ({-# LINE 341 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIallvisits + {-# LINE 3762 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 394, column 10) + _lhsOt_visits = + ({-# LINE 394 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIt_visits + {-# LINE 3768 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1184, column 37) + _lhsOchildvisit = + ({-# LINE 1184 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIchildvisit `Map.union` _tlIchildvisit + {-# LINE 3774 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 285, column 43) + _lhsOcount = + ({-# LINE 285 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIcount + _tlIcount + {-# LINE 3780 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 179, column 34) + _lhsOdatatype = + ({-# LINE 179 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIdatatype : _tlIdatatype + {-# LINE 3786 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 3792 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1541, column 22) + _lhsOfromToStates = + ({-# LINE 1541 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIfromToStates `mappend` _tlIfromToStates + {-# LINE 3798 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1461, column 49) + _lhsOgenProdIO = + ({-# LINE 1461 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIgenProdIO >> _tlIgenProdIO + {-# LINE 3804 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1460, column 47) + _lhsOimports = + ({-# LINE 1460 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIimports ++ _tlIimports + {-# LINE 3810 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 512, column 92) + _lhsOsemFunBndDefs = + ({-# LINE 512 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIsemFunBndDefs Seq.>< _tlIsemFunBndDefs + {-# LINE 3816 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 512, column 92) + _lhsOsemFunBndTps = + ({-# LINE 512 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIsemFunBndTps Seq.>< _tlIsemFunBndTps + {-# LINE 3822 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 289, column 44) + _lhsOsem_nt = + ({-# LINE 289 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIsem_nt >-< _tlIsem_nt + {-# LINE 3828 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 551, column 34) + _lhsOsem_prod = + ({-# LINE 551 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIsem_prod >-< _tlIsem_prod + {-# LINE 3834 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1588, column 68) + _lhsOvisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIvisitKinds `mappend` _tlIvisitKinds + {-# LINE 3840 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1319, column 36) + _lhsOvisitdefs = + ({-# LINE 1319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIvisitdefs `uwSetUnion` _tlIvisitdefs + {-# LINE 3846 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1320, column 36) + _lhsOvisituses = + ({-# LINE 1320 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIvisituses `uwSetUnion` _tlIvisituses + {-# LINE 3852 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallFromToStates = + ({-# LINE 1544 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallFromToStates + {-# LINE 3858 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallInhmap = + ({-# LINE 318 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInhmap + {-# LINE 3864 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 3870 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallSynmap = + ({-# LINE 319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallSynmap + {-# LINE 3876 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallVisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallVisitKinds + {-# LINE 3882 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 1183 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 3888 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallstates = + ({-# LINE 554 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallstates + {-# LINE 3894 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 3900 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 3906 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOclassCtxs = + ({-# LINE 77 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIclassCtxs + {-# LINE 3912 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOimportBlocks = + ({-# LINE 34 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIimportBlocks + {-# LINE 3918 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 316 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 3924 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOinitial = + ({-# LINE 553 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinitial + {-# LINE 3930 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOlocalAttrTypes = + ({-# LINE 1574 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 3936 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmainFile = + ({-# LINE 38 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainFile + {-# LINE 3942 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmainName = + ({-# LINE 39 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainName + {-# LINE 3948 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmoduleHeader = + ({-# LINE 37 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImoduleHeader + {-# LINE 3954 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOnextVisits = + ({-# LINE 1530 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInextVisits + {-# LINE 3960 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 61 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 3966 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOntType = + ({-# LINE 1617 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIntType + {-# LINE 3972 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 3978 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOparams = + ({-# LINE 73 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIparams + {-# LINE 3984 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOpragmaBlocks = + ({-# LINE 35 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIpragmaBlocks + {-# LINE 3990 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOprevVisits = + ({-# LINE 1530 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIprevVisits + {-# LINE 3996 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOrename = + ({-# LINE 52 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIrename + {-# LINE 4002 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 317 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 4008 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOtextBlocks = + ({-# LINE 36 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsItextBlocks + {-# LINE 4014 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallFromToStates = + ({-# LINE 1544 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallFromToStates + {-# LINE 4020 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallInhmap = + ({-# LINE 318 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInhmap + {-# LINE 4026 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 4032 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallSynmap = + ({-# LINE 319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallSynmap + {-# LINE 4038 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallVisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallVisitKinds + {-# LINE 4044 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 1183 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 4050 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallstates = + ({-# LINE 554 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallstates + {-# LINE 4056 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 4062 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 4068 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOclassCtxs = + ({-# LINE 77 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIclassCtxs + {-# LINE 4074 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOimportBlocks = + ({-# LINE 34 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIimportBlocks + {-# LINE 4080 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 316 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 4086 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOinitial = + ({-# LINE 553 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinitial + {-# LINE 4092 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOlocalAttrTypes = + ({-# LINE 1574 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 4098 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmainFile = + ({-# LINE 38 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainFile + {-# LINE 4104 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmainName = + ({-# LINE 39 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainName + {-# LINE 4110 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmoduleHeader = + ({-# LINE 37 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImoduleHeader + {-# LINE 4116 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOnextVisits = + ({-# LINE 1530 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInextVisits + {-# LINE 4122 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 61 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 4128 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOntType = + ({-# LINE 1617 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIntType + {-# LINE 4134 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 4140 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOparams = + ({-# LINE 73 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIparams + {-# LINE 4146 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOpragmaBlocks = + ({-# LINE 35 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIpragmaBlocks + {-# LINE 4152 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOprevVisits = + ({-# LINE 1530 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIprevVisits + {-# LINE 4158 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOrename = + ({-# LINE 52 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIrename + {-# LINE 4164 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 317 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 4170 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOtextBlocks = + ({-# LINE 36 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsItextBlocks + {-# LINE 4176 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _hdIallvisits,_hdIchildvisit,_hdIcount,_hdIdatatype,_hdIerrors,_hdIfromToStates,_hdIgenProdIO,_hdIimports,_hdIsemFunBndDefs,_hdIsemFunBndTps,_hdIsem_nt,_hdIsem_prod,_hdIt_visits,_hdIvisitKinds,_hdIvisitdefs,_hdIvisituses) = + hd_ _hdOallFromToStates _hdOallInhmap _hdOallInitStates _hdOallSynmap _hdOallVisitKinds _hdOallchildvisit _hdOallstates _hdOavisitdefs _hdOavisituses _hdOclassCtxs _hdOimportBlocks _hdOinhmap _hdOinitial _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnextVisits _hdOnt _hdOntType _hdOoptions _hdOparams _hdOpragmaBlocks _hdOprevVisits _hdOrename _hdOsynmap _hdOtextBlocks + ( _tlIallvisits,_tlIchildvisit,_tlIcount,_tlIdatatype,_tlIerrors,_tlIfromToStates,_tlIgenProdIO,_tlIimports,_tlIsemFunBndDefs,_tlIsemFunBndTps,_tlIsem_nt,_tlIsem_prod,_tlIt_visits,_tlIvisitKinds,_tlIvisitdefs,_tlIvisituses) = + tl_ _tlOallFromToStates _tlOallInhmap _tlOallInitStates _tlOallSynmap _tlOallVisitKinds _tlOallchildvisit _tlOallstates _tlOavisitdefs _tlOavisituses _tlOclassCtxs _tlOimportBlocks _tlOinhmap _tlOinitial _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnextVisits _tlOnt _tlOntType _tlOoptions _tlOparams _tlOpragmaBlocks _tlOprevVisits _tlOrename _tlOsynmap _tlOtextBlocks + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOcount,_lhsOdatatype,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +sem_EProductions_Nil :: T_EProductions +sem_EProductions_Nil = + (T_EProductions (\ _lhsIallFromToStates + _lhsIallInhmap + _lhsIallInitStates + _lhsIallSynmap + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIallstates + _lhsIavisitdefs + _lhsIavisituses + _lhsIclassCtxs + _lhsIimportBlocks + _lhsIinhmap + _lhsIinitial + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsImoduleHeader + _lhsInextVisits + _lhsInt + _lhsIntType + _lhsIoptions + _lhsIparams + _lhsIpragmaBlocks + _lhsIprevVisits + _lhsIrename + _lhsIsynmap + _lhsItextBlocks -> + (let _lhsOallvisits :: ([VisitStateState]) + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _lhsOcount :: Int + _lhsOdatatype :: ([PP_Doc]) + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOgenProdIO :: (IO ()) + _lhsOimports :: ([PP_Doc]) + _lhsOsemFunBndDefs :: (Seq PP_Doc) + _lhsOsemFunBndTps :: (Seq PP_Doc) + _lhsOsem_nt :: PP_Doc + _lhsOsem_prod :: PP_Doc + _lhsOt_visits :: PP_Doc + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 342, column 10) + _lhsOallvisits = + ({-# LINE 342 "./src-ag/ExecutionPlan2Hs.ag" #-} + error "Every nonterminal should have at least 1 production" + {-# LINE 4232 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1184, column 37) + _lhsOchildvisit = + ({-# LINE 1184 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 4238 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 285, column 43) + _lhsOcount = + ({-# LINE 285 "./src-ag/ExecutionPlan2Hs.ag" #-} + 0 + {-# LINE 4244 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 179, column 34) + _lhsOdatatype = + ({-# LINE 179 "./src-ag/ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 4250 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + Seq.empty + {-# LINE 4256 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1541, column 22) + _lhsOfromToStates = + ({-# LINE 1541 "./src-ag/ExecutionPlan2Hs.ag" #-} + mempty + {-# LINE 4262 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1461, column 49) + _lhsOgenProdIO = + ({-# LINE 1461 "./src-ag/ExecutionPlan2Hs.ag" #-} + return () + {-# LINE 4268 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1460, column 47) + _lhsOimports = + ({-# LINE 1460 "./src-ag/ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 4274 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 512, column 92) + _lhsOsemFunBndDefs = + ({-# LINE 512 "./src-ag/ExecutionPlan2Hs.ag" #-} + Seq.empty + {-# LINE 4280 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 512, column 92) + _lhsOsemFunBndTps = + ({-# LINE 512 "./src-ag/ExecutionPlan2Hs.ag" #-} + Seq.empty + {-# LINE 4286 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 289, column 44) + _lhsOsem_nt = + ({-# LINE 289 "./src-ag/ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 4292 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 551, column 34) + _lhsOsem_prod = + ({-# LINE 551 "./src-ag/ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 4298 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 391, column 59) + _lhsOt_visits = + ({-# LINE 391 "./src-ag/ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 4304 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1588, column 68) + _lhsOvisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + mempty + {-# LINE 4310 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1319, column 36) + _lhsOvisitdefs = + ({-# LINE 1319 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 4316 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1320, column 36) + _lhsOvisituses = + ({-# LINE 1320 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 4322 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOcount,_lhsOdatatype,_lhsOerrors,_lhsOfromToStates,_lhsOgenProdIO,_lhsOimports,_lhsOsemFunBndDefs,_lhsOsemFunBndTps,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +-- ERule ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allInhmap : Map NontermIdent Attributes + allSynmap : Map NontermIdent Attributes + childTypes : Map Identifier Type + con : ConstructorIdent + importBlocks : PP_Doc + inhmap : Attributes + lazyIntras : Set String + localAttrTypes : Map Identifier Type + mainFile : String + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + nt : NontermIdent + options : Options + pragmaBlocks : String + ruleKinds : Map Identifier (Set VisitKind) + synmap : Attributes + textBlocks : PP_Doc + usageInfo : Map Identifier Int + synthesized attributes: + errors : Seq Error + mrules : Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc) + ruledefs : Map Identifier (Set String) + ruleuses : Map Identifier (Map String (Maybe NonLocalAttr)) + sem_rules : PP_Doc + alternatives: + alternative ERule: + child name : {Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + child pure : {Bool} + child mbError : {Maybe Error} + visit 0: + local rulecode : _ + local rulePragma : _ + local scc : _ + local pragma : _ + local endpragma : _ + local genpragma : _ + local haspos : _ + local lambda : _ + local argPats : _ + local argExprs : _ + local stepcode : _ + local used : _ + local kinds : _ + local anyLazyKind : _ + local addbang : _ + local addbang1 : _ +-} +-- cata +sem_ERule :: ERule -> + T_ERule +sem_ERule (ERule _name _pattern _rhs _owrt _origin _explicit _pure _mbError) = + (sem_ERule_ERule _name (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin _explicit _pure _mbError) +-- semantic domain +newtype T_ERule = T_ERule ((Map NontermIdent Attributes) -> + (Map NontermIdent Attributes) -> + (Map Identifier Type) -> + ConstructorIdent -> + PP_Doc -> + Attributes -> + (Set String) -> + (Map Identifier Type) -> + String -> + String -> + (String -> String -> String -> Bool -> String) -> + NontermIdent -> + Options -> + String -> + (Map Identifier (Set VisitKind)) -> + Attributes -> + PP_Doc -> + (Map Identifier Int) -> + ( (Seq Error),(Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),(Map Identifier (Set String)),(Map Identifier (Map String (Maybe NonLocalAttr))),PP_Doc)) +data Inh_ERule = Inh_ERule {allInhmap_Inh_ERule :: (Map NontermIdent Attributes),allSynmap_Inh_ERule :: (Map NontermIdent Attributes),childTypes_Inh_ERule :: (Map Identifier Type),con_Inh_ERule :: ConstructorIdent,importBlocks_Inh_ERule :: PP_Doc,inhmap_Inh_ERule :: Attributes,lazyIntras_Inh_ERule :: (Set String),localAttrTypes_Inh_ERule :: (Map Identifier Type),mainFile_Inh_ERule :: String,mainName_Inh_ERule :: String,moduleHeader_Inh_ERule :: (String -> String -> String -> Bool -> String),nt_Inh_ERule :: NontermIdent,options_Inh_ERule :: Options,pragmaBlocks_Inh_ERule :: String,ruleKinds_Inh_ERule :: (Map Identifier (Set VisitKind)),synmap_Inh_ERule :: Attributes,textBlocks_Inh_ERule :: PP_Doc,usageInfo_Inh_ERule :: (Map Identifier Int)} +data Syn_ERule = Syn_ERule {errors_Syn_ERule :: (Seq Error),mrules_Syn_ERule :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),ruledefs_Syn_ERule :: (Map Identifier (Set String)),ruleuses_Syn_ERule :: (Map Identifier (Map String (Maybe NonLocalAttr))),sem_rules_Syn_ERule :: PP_Doc} +wrap_ERule :: T_ERule -> + Inh_ERule -> + Syn_ERule +wrap_ERule (T_ERule sem) (Inh_ERule _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo) = + (let ( _lhsOerrors,_lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules) = sem _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo + in (Syn_ERule _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules)) +sem_ERule_ERule :: Identifier -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + Bool -> + (Maybe Error) -> + T_ERule +sem_ERule_ERule name_ (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ explicit_ pure_ mbError_ = + (T_ERule (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIchildTypes + _lhsIcon + _lhsIimportBlocks + _lhsIinhmap + _lhsIlazyIntras + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsImoduleHeader + _lhsInt + _lhsIoptions + _lhsIpragmaBlocks + _lhsIruleKinds + _lhsIsynmap + _lhsItextBlocks + _lhsIusageInfo -> + (let _lhsOsem_rules :: PP_Doc + _lhsOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) + _lhsOruledefs :: (Map Identifier (Set String)) + _lhsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _lhsOerrors :: (Seq Error) + _patternOallInhmap :: (Map NontermIdent Attributes) + _patternOallSynmap :: (Map NontermIdent Attributes) + _patternOanyLazyKind :: Bool + _patternOinhmap :: Attributes + _patternOlocalAttrTypes :: (Map Identifier Type) + _patternOoptions :: Options + _patternOsynmap :: Attributes + _patternIattrTypes :: PP_Doc + _patternIattrs :: (Set String) + _patternIcopy :: Pattern + _patternIisUnderscore :: Bool + _patternIsem_lhs :: ( PP_Doc ) + _rhsIattrs :: (Map String (Maybe NonLocalAttr)) + _rhsIpos :: Pos + _rhsIsemfunc :: PP_Doc + _rhsItks :: ([HsToken]) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 962, column 6) + _lhsOsem_rules = + ({-# LINE 962 "./src-ag/ExecutionPlan2Hs.ag" #-} + if _used == 0 + then empty + else _rulePragma >-< _rulecode + {-# LINE 4469 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 965, column 6) + _rulecode = + ({-# LINE 965 "./src-ag/ExecutionPlan2Hs.ag" #-} + ( if _genpragma + then _pragma + else empty + ) + >-< _lambda >#< _scc + >-< indent ((column _rhsIpos - 2) `max` 2) + ( if _genpragma + then _pragma >-< _rhsIsemfunc >-< _endpragma + else _rhsIsemfunc + ) + {-# LINE 4484 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 977, column 7) + _rulePragma = + ({-# LINE 977 "./src-ag/ExecutionPlan2Hs.ag" #-} + ( let reallyInlineStr = "INLINE" + reallyNoInlineStr = "NOINLINE" + in if noInlinePragmas _lhsIoptions + then empty + else if _used == 1 + then ppPragmaBinding reallyInlineStr name_ + else if helpInlining _lhsIoptions + then if not explicit_ && _used <= reallyOftenUsedThreshold + then ppPragmaBinding "INLINE[1]" name_ + else if _used > ruleInlineThresholdSoft && explicit_ + then if _used > ruleInlineThresholdHard + then ppPragmaBinding reallyNoInlineStr name_ + else if aggressiveInlinePragmas _lhsIoptions + then ppPragmaBinding "NOINLINE[2]" name_ + else ppNoInline name_ + else if aggressiveInlinePragmas _lhsIoptions + then ppPragmaBinding "NOINLINE[1]" name_ + else ppNoInline name_ + else if not explicit_ || _used <= ruleInlineThresholdSoft + then ppPragmaBinding "NOINLINE[1]" name_ + else ppNoInline name_ + ) + {-# LINE 4511 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 999, column 7) + _scc = + ({-# LINE 999 "./src-ag/ExecutionPlan2Hs.ag" #-} + if genCostCentres _lhsIoptions && explicit_ && pure_ && not (noPerRuleCostCentres _lhsIoptions) + then ppCostCentre (name_ >|< "_" >|< line _rhsIpos >|< "_" >|< _lhsInt >|< "_" >|< _lhsIcon) + else empty + {-# LINE 4519 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1002, column 7) + _pragma = + ({-# LINE 1002 "./src-ag/ExecutionPlan2Hs.ag" #-} + "{-# LINE" >#< show (line _rhsIpos) >#< show (file _rhsIpos) >#< "#-}" + {-# LINE 4525 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1003, column 7) + _endpragma = + ({-# LINE 1003 "./src-ag/ExecutionPlan2Hs.ag" #-} + ppWithLineNr (\ln -> "{-# LINE " ++ show (ln+1) ++ " " ++ show _lhsImainFile ++ "#-}") + {-# LINE 4531 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1004, column 7) + _genpragma = + ({-# LINE 1004 "./src-ag/ExecutionPlan2Hs.ag" #-} + genLinePragmas _lhsIoptions && explicit_ && _haspos + {-# LINE 4537 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1005, column 7) + _haspos = + ({-# LINE 1005 "./src-ag/ExecutionPlan2Hs.ag" #-} + line _rhsIpos > 0 && column _rhsIpos >= 0 && not (null (file _rhsIpos)) + {-# LINE 4543 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1014, column 7) + _lambda = + ({-# LINE 1014 "./src-ag/ExecutionPlan2Hs.ag" #-} + name_ >#< "=" >#< "\\" >#< _argPats >#< dummyPat _lhsIoptions (Map.null _rhsIattrs) >#< "->" + {-# LINE 4549 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1016, column 7) + _argPats = + ({-# LINE 1016 "./src-ag/ExecutionPlan2Hs.ag" #-} + ppSpaced [ let match | str `Set.member` _lhsIlazyIntras = pp str + | otherwise = _addbang1 (pp str) + in case mbAttr of + Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs _lhsIoptions) -> + case Map.lookup nm _lhsIlocalAttrTypes of + Just tp -> pp_parens (pp_parens match >#< "::" >#< ppTp tp) + Nothing -> match + Just attr | not (noPerRuleTypeSigs _lhsIoptions) -> + case lookupAttrType attr _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes of + Just tpDoc -> pp_parens (pp_parens match >#< "::" >#< tpDoc) + Nothing -> match + _ -> match + | (str,mbAttr) <- Map.assocs _rhsIattrs + ] + {-# LINE 4568 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1030, column 7) + _argExprs = + ({-# LINE 1030 "./src-ag/ExecutionPlan2Hs.ag" #-} + ppSpaced $ Map.keys _rhsIattrs + {-# LINE 4574 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1031, column 7) + _stepcode = + ({-# LINE 1031 "./src-ag/ExecutionPlan2Hs.ag" #-} + \kind fmtMode -> if kind `compatibleRule` pure_ + then Right $ let oper | pure_ = "=" + | otherwise = "<-" + decl = _patternIsem_lhs >#< oper >#< name_ >#< _argExprs >#< dummyArg _lhsIoptions (Map.null _rhsIattrs) + tp = if pure_ && not (noPerRuleTypeSigs _lhsIoptions) + then _patternIattrTypes + else empty + in fmtDecl pure_ fmtMode (tp >-< decl) + else Left $ IncompatibleRuleKind name_ kind + {-# LINE 4588 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1041, column 7) + _lhsOmrules = + ({-# LINE 1041 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton name_ _stepcode + {-# LINE 4594 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1245, column 32) + _used = + ({-# LINE 1245 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.findWithDefault 0 name_ _lhsIusageInfo + {-# LINE 4600 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1261, column 3) + _kinds = + ({-# LINE 1261 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.findWithDefault Set.empty name_ _lhsIruleKinds + {-# LINE 4606 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1262, column 3) + _anyLazyKind = + ({-# LINE 1262 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.fold (\k r -> isLazyKind k || r) False _kinds + {-# LINE 4612 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1308, column 11) + _lhsOruledefs = + ({-# LINE 1308 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton name_ _patternIattrs + {-# LINE 4618 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1309, column 11) + _lhsOruleuses = + ({-# LINE 1309 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton name_ _rhsIattrs + {-# LINE 4624 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1511, column 37) + _addbang = + ({-# LINE 1511 "./src-ag/ExecutionPlan2Hs.ag" #-} + \x -> if bangpats _lhsIoptions then "!" >|< x else x + {-# LINE 4630 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1522, column 37) + _addbang1 = + ({-# LINE 1522 "./src-ag/ExecutionPlan2Hs.ag" #-} + if _anyLazyKind then id else _addbang + {-# LINE 4636 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1628, column 3) + _lhsOerrors = + ({-# LINE 1628 "./src-ag/ExecutionPlan2Hs.ag" #-} + case mbError_ of + Just e | _used > 0 -> Seq.singleton e + _ -> Seq.empty + {-# LINE 4644 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patternOallInhmap = + ({-# LINE 318 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInhmap + {-# LINE 4650 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patternOallSynmap = + ({-# LINE 319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallSynmap + {-# LINE 4656 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (from local) + _patternOanyLazyKind = + ({-# LINE 1264 "./src-ag/ExecutionPlan2Hs.ag" #-} + _anyLazyKind + {-# LINE 4662 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patternOinhmap = + ({-# LINE 316 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 4668 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patternOlocalAttrTypes = + ({-# LINE 1575 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 4674 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patternOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 4680 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patternOsynmap = + ({-# LINE 317 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 4686 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _patternIattrTypes,_patternIattrs,_patternIcopy,_patternIisUnderscore,_patternIsem_lhs) = + pattern_ _patternOallInhmap _patternOallSynmap _patternOanyLazyKind _patternOinhmap _patternOlocalAttrTypes _patternOoptions _patternOsynmap + ( _rhsIattrs,_rhsIpos,_rhsIsemfunc,_rhsItks) = + rhs_ + in ( _lhsOerrors,_lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules)))) +-- ERules ------------------------------------------------------ +{- + visit 0: + inherited attributes: + allInhmap : Map NontermIdent Attributes + allSynmap : Map NontermIdent Attributes + childTypes : Map Identifier Type + con : ConstructorIdent + importBlocks : PP_Doc + inhmap : Attributes + lazyIntras : Set String + localAttrTypes : Map Identifier Type + mainFile : String + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + nt : NontermIdent + options : Options + pragmaBlocks : String + ruleKinds : Map Identifier (Set VisitKind) + synmap : Attributes + textBlocks : PP_Doc + usageInfo : Map Identifier Int + synthesized attributes: + errors : Seq Error + mrules : Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc) + ruledefs : Map Identifier (Set String) + ruleuses : Map Identifier (Map String (Maybe NonLocalAttr)) + sem_rules : PP_Doc + alternatives: + alternative Cons: + child hd : ERule + child tl : ERules + alternative Nil: +-} +-- cata +sem_ERules :: ERules -> + T_ERules +sem_ERules list = + (Prelude.foldr sem_ERules_Cons sem_ERules_Nil (Prelude.map sem_ERule list)) +-- semantic domain +newtype T_ERules = T_ERules ((Map NontermIdent Attributes) -> + (Map NontermIdent Attributes) -> + (Map Identifier Type) -> + ConstructorIdent -> + PP_Doc -> + Attributes -> + (Set String) -> + (Map Identifier Type) -> + String -> + String -> + (String -> String -> String -> Bool -> String) -> + NontermIdent -> + Options -> + String -> + (Map Identifier (Set VisitKind)) -> + Attributes -> + PP_Doc -> + (Map Identifier Int) -> + ( (Seq Error),(Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),(Map Identifier (Set String)),(Map Identifier (Map String (Maybe NonLocalAttr))),PP_Doc)) +data Inh_ERules = Inh_ERules {allInhmap_Inh_ERules :: (Map NontermIdent Attributes),allSynmap_Inh_ERules :: (Map NontermIdent Attributes),childTypes_Inh_ERules :: (Map Identifier Type),con_Inh_ERules :: ConstructorIdent,importBlocks_Inh_ERules :: PP_Doc,inhmap_Inh_ERules :: Attributes,lazyIntras_Inh_ERules :: (Set String),localAttrTypes_Inh_ERules :: (Map Identifier Type),mainFile_Inh_ERules :: String,mainName_Inh_ERules :: String,moduleHeader_Inh_ERules :: (String -> String -> String -> Bool -> String),nt_Inh_ERules :: NontermIdent,options_Inh_ERules :: Options,pragmaBlocks_Inh_ERules :: String,ruleKinds_Inh_ERules :: (Map Identifier (Set VisitKind)),synmap_Inh_ERules :: Attributes,textBlocks_Inh_ERules :: PP_Doc,usageInfo_Inh_ERules :: (Map Identifier Int)} +data Syn_ERules = Syn_ERules {errors_Syn_ERules :: (Seq Error),mrules_Syn_ERules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),ruledefs_Syn_ERules :: (Map Identifier (Set String)),ruleuses_Syn_ERules :: (Map Identifier (Map String (Maybe NonLocalAttr))),sem_rules_Syn_ERules :: PP_Doc} +wrap_ERules :: T_ERules -> + Inh_ERules -> + Syn_ERules +wrap_ERules (T_ERules sem) (Inh_ERules _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo) = + (let ( _lhsOerrors,_lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules) = sem _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo + in (Syn_ERules _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules)) +sem_ERules_Cons :: T_ERule -> + T_ERules -> + T_ERules +sem_ERules_Cons (T_ERule hd_) (T_ERules tl_) = + (T_ERules (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIchildTypes + _lhsIcon + _lhsIimportBlocks + _lhsIinhmap + _lhsIlazyIntras + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsImoduleHeader + _lhsInt + _lhsIoptions + _lhsIpragmaBlocks + _lhsIruleKinds + _lhsIsynmap + _lhsItextBlocks + _lhsIusageInfo -> + (let _lhsOerrors :: (Seq Error) + _lhsOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) + _lhsOruledefs :: (Map Identifier (Set String)) + _lhsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _lhsOsem_rules :: PP_Doc + _hdOallInhmap :: (Map NontermIdent Attributes) + _hdOallSynmap :: (Map NontermIdent Attributes) + _hdOchildTypes :: (Map Identifier Type) + _hdOcon :: ConstructorIdent + _hdOimportBlocks :: PP_Doc + _hdOinhmap :: Attributes + _hdOlazyIntras :: (Set String) + _hdOlocalAttrTypes :: (Map Identifier Type) + _hdOmainFile :: String + _hdOmainName :: String + _hdOmoduleHeader :: (String -> String -> String -> Bool -> String) + _hdOnt :: NontermIdent + _hdOoptions :: Options + _hdOpragmaBlocks :: String + _hdOruleKinds :: (Map Identifier (Set VisitKind)) + _hdOsynmap :: Attributes + _hdOtextBlocks :: PP_Doc + _hdOusageInfo :: (Map Identifier Int) + _tlOallInhmap :: (Map NontermIdent Attributes) + _tlOallSynmap :: (Map NontermIdent Attributes) + _tlOchildTypes :: (Map Identifier Type) + _tlOcon :: ConstructorIdent + _tlOimportBlocks :: PP_Doc + _tlOinhmap :: Attributes + _tlOlazyIntras :: (Set String) + _tlOlocalAttrTypes :: (Map Identifier Type) + _tlOmainFile :: String + _tlOmainName :: String + _tlOmoduleHeader :: (String -> String -> String -> Bool -> String) + _tlOnt :: NontermIdent + _tlOoptions :: Options + _tlOpragmaBlocks :: String + _tlOruleKinds :: (Map Identifier (Set VisitKind)) + _tlOsynmap :: Attributes + _tlOtextBlocks :: PP_Doc + _tlOusageInfo :: (Map Identifier Int) + _hdIerrors :: (Seq Error) + _hdImrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) + _hdIruledefs :: (Map Identifier (Set String)) + _hdIruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _hdIsem_rules :: PP_Doc + _tlIerrors :: (Seq Error) + _tlImrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) + _tlIruledefs :: (Map Identifier (Set String)) + _tlIruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _tlIsem_rules :: PP_Doc + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 4837 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 959, column 32) + _lhsOmrules = + ({-# LINE 959 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdImrules `Map.union` _tlImrules + {-# LINE 4843 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1301, column 34) + _lhsOruledefs = + ({-# LINE 1301 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIruledefs `uwSetUnion` _tlIruledefs + {-# LINE 4849 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1302, column 34) + _lhsOruleuses = + ({-# LINE 1302 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIruleuses `uwMapUnion` _tlIruleuses + {-# LINE 4855 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 958, column 35) + _lhsOsem_rules = + ({-# LINE 958 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIsem_rules >-< _tlIsem_rules + {-# LINE 4861 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallInhmap = + ({-# LINE 318 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInhmap + {-# LINE 4867 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallSynmap = + ({-# LINE 319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallSynmap + {-# LINE 4873 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOchildTypes = + ({-# LINE 1561 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildTypes + {-# LINE 4879 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 66 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIcon + {-# LINE 4885 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOimportBlocks = + ({-# LINE 34 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIimportBlocks + {-# LINE 4891 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 316 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 4897 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOlazyIntras = + ({-# LINE 1353 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlazyIntras + {-# LINE 4903 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOlocalAttrTypes = + ({-# LINE 1575 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 4909 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmainFile = + ({-# LINE 38 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainFile + {-# LINE 4915 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmainName = + ({-# LINE 39 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainName + {-# LINE 4921 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmoduleHeader = + ({-# LINE 37 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImoduleHeader + {-# LINE 4927 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 61 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 4933 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 4939 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOpragmaBlocks = + ({-# LINE 35 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIpragmaBlocks + {-# LINE 4945 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOruleKinds = + ({-# LINE 1256 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruleKinds + {-# LINE 4951 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 317 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 4957 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOtextBlocks = + ({-# LINE 36 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsItextBlocks + {-# LINE 4963 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOusageInfo = + ({-# LINE 1241 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIusageInfo + {-# LINE 4969 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallInhmap = + ({-# LINE 318 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInhmap + {-# LINE 4975 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallSynmap = + ({-# LINE 319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallSynmap + {-# LINE 4981 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOchildTypes = + ({-# LINE 1561 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildTypes + {-# LINE 4987 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 66 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIcon + {-# LINE 4993 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOimportBlocks = + ({-# LINE 34 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIimportBlocks + {-# LINE 4999 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 316 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 5005 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOlazyIntras = + ({-# LINE 1353 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlazyIntras + {-# LINE 5011 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOlocalAttrTypes = + ({-# LINE 1575 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 5017 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmainFile = + ({-# LINE 38 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainFile + {-# LINE 5023 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmainName = + ({-# LINE 39 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainName + {-# LINE 5029 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmoduleHeader = + ({-# LINE 37 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImoduleHeader + {-# LINE 5035 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 61 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 5041 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 5047 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOpragmaBlocks = + ({-# LINE 35 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIpragmaBlocks + {-# LINE 5053 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOruleKinds = + ({-# LINE 1256 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruleKinds + {-# LINE 5059 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 317 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 5065 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOtextBlocks = + ({-# LINE 36 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsItextBlocks + {-# LINE 5071 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOusageInfo = + ({-# LINE 1241 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIusageInfo + {-# LINE 5077 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _hdIerrors,_hdImrules,_hdIruledefs,_hdIruleuses,_hdIsem_rules) = + hd_ _hdOallInhmap _hdOallSynmap _hdOchildTypes _hdOcon _hdOimportBlocks _hdOinhmap _hdOlazyIntras _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnt _hdOoptions _hdOpragmaBlocks _hdOruleKinds _hdOsynmap _hdOtextBlocks _hdOusageInfo + ( _tlIerrors,_tlImrules,_tlIruledefs,_tlIruleuses,_tlIsem_rules) = + tl_ _tlOallInhmap _tlOallSynmap _tlOchildTypes _tlOcon _tlOimportBlocks _tlOinhmap _tlOlazyIntras _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnt _tlOoptions _tlOpragmaBlocks _tlOruleKinds _tlOsynmap _tlOtextBlocks _tlOusageInfo + in ( _lhsOerrors,_lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules)))) +sem_ERules_Nil :: T_ERules +sem_ERules_Nil = + (T_ERules (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIchildTypes + _lhsIcon + _lhsIimportBlocks + _lhsIinhmap + _lhsIlazyIntras + _lhsIlocalAttrTypes + _lhsImainFile + _lhsImainName + _lhsImoduleHeader + _lhsInt + _lhsIoptions + _lhsIpragmaBlocks + _lhsIruleKinds + _lhsIsynmap + _lhsItextBlocks + _lhsIusageInfo -> + (let _lhsOerrors :: (Seq Error) + _lhsOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) + _lhsOruledefs :: (Map Identifier (Set String)) + _lhsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _lhsOsem_rules :: PP_Doc + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + Seq.empty + {-# LINE 5113 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 959, column 32) + _lhsOmrules = + ({-# LINE 959 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 5119 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1301, column 34) + _lhsOruledefs = + ({-# LINE 1301 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 5125 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1302, column 34) + _lhsOruleuses = + ({-# LINE 1302 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 5131 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 958, column 35) + _lhsOsem_rules = + ({-# LINE 958 "./src-ag/ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 5137 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOerrors,_lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules)))) +-- ExecutionPlan ----------------------------------------------- +{- + visit 0: + inherited attributes: + importBlocks : PP_Doc + inhmap : Map NontermIdent Attributes + localAttrTypes : Map NontermIdent (Map ConstructorIdent (Map Identifier Type)) + mainBlocksDoc : PP_Doc + mainFile : String + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + options : Options + pragmaBlocks : String + synmap : Map NontermIdent Attributes + textBlockMap : Map BlockInfo PP_Doc + textBlocks : PP_Doc + synthesized attributes: + errors : Seq Error + genIO : IO () + output : PP_Doc + alternatives: + alternative ExecutionPlan: + child nonts : ENonterminals + child typeSyns : {TypeSyns} + child wrappers : {Set NontermIdent} + child derivings : {Derivings} + visit 0: + local wrappersExtra : _ + local commonExtra : _ + local lateSemBndTp : _ + local lateSemBndDef : _ + local mainModuleFile : _ + local ppMonadImports : _ + local genMainModule : _ + local commonFile : _ + local genCommonModule : _ +-} +-- cata +sem_ExecutionPlan :: ExecutionPlan -> + T_ExecutionPlan +sem_ExecutionPlan (ExecutionPlan _nonts _typeSyns _wrappers _derivings) = + (sem_ExecutionPlan_ExecutionPlan (sem_ENonterminals _nonts) _typeSyns _wrappers _derivings) +-- semantic domain +newtype T_ExecutionPlan = T_ExecutionPlan (PP_Doc -> + (Map NontermIdent Attributes) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) -> + PP_Doc -> + String -> + String -> + (String -> String -> String -> Bool -> String) -> + Options -> + String -> + (Map NontermIdent Attributes) -> + (Map BlockInfo PP_Doc) -> + PP_Doc -> + ( (Seq Error),(IO ()),PP_Doc)) +data Inh_ExecutionPlan = Inh_ExecutionPlan {importBlocks_Inh_ExecutionPlan :: PP_Doc,inhmap_Inh_ExecutionPlan :: (Map NontermIdent Attributes),localAttrTypes_Inh_ExecutionPlan :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))),mainBlocksDoc_Inh_ExecutionPlan :: PP_Doc,mainFile_Inh_ExecutionPlan :: String,mainName_Inh_ExecutionPlan :: String,moduleHeader_Inh_ExecutionPlan :: (String -> String -> String -> Bool -> String),options_Inh_ExecutionPlan :: Options,pragmaBlocks_Inh_ExecutionPlan :: String,synmap_Inh_ExecutionPlan :: (Map NontermIdent Attributes),textBlockMap_Inh_ExecutionPlan :: (Map BlockInfo PP_Doc),textBlocks_Inh_ExecutionPlan :: PP_Doc} +data Syn_ExecutionPlan = Syn_ExecutionPlan {errors_Syn_ExecutionPlan :: (Seq Error),genIO_Syn_ExecutionPlan :: (IO ()),output_Syn_ExecutionPlan :: PP_Doc} +wrap_ExecutionPlan :: T_ExecutionPlan -> + Inh_ExecutionPlan -> + Syn_ExecutionPlan +wrap_ExecutionPlan (T_ExecutionPlan sem) (Inh_ExecutionPlan _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlockMap _lhsItextBlocks) = + (let ( _lhsOerrors,_lhsOgenIO,_lhsOoutput) = sem _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlockMap _lhsItextBlocks + in (Syn_ExecutionPlan _lhsOerrors _lhsOgenIO _lhsOoutput)) +sem_ExecutionPlan_ExecutionPlan :: T_ENonterminals -> + TypeSyns -> + (Set NontermIdent) -> + Derivings -> + T_ExecutionPlan +sem_ExecutionPlan_ExecutionPlan (T_ENonterminals nonts_) typeSyns_ wrappers_ derivings_ = + (T_ExecutionPlan (\ _lhsIimportBlocks + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsImainBlocksDoc + _lhsImainFile + _lhsImainName + _lhsImoduleHeader + _lhsIoptions + _lhsIpragmaBlocks + _lhsIsynmap + _lhsItextBlockMap + _lhsItextBlocks -> + (let _lhsOoutput :: PP_Doc + _nontsOwrappers :: (Set NontermIdent) + _nontsOtypeSyns :: TypeSyns + _nontsOderivings :: Derivings + _nontsOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _nontsOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _nontsOavisituses :: (Map VisitIdentifier (Set Identifier)) + _lhsOgenIO :: (IO ()) + _nontsOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _nontsOallVisitKinds :: (Map VisitIdentifier VisitKind) + _nontsOallInitStates :: (Map NontermIdent Int) + _lhsOerrors :: (Seq Error) + _nontsOimportBlocks :: PP_Doc + _nontsOinhmap :: (Map NontermIdent Attributes) + _nontsOlocalAttrTypes :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) + _nontsOmainFile :: String + _nontsOmainName :: String + _nontsOmoduleHeader :: (String -> String -> String -> Bool -> String) + _nontsOoptions :: Options + _nontsOpragmaBlocks :: String + _nontsOsynmap :: (Map NontermIdent Attributes) + _nontsOtextBlocks :: PP_Doc + _nontsIappendCommon :: ([PP_Doc]) + _nontsIappendMain :: ([PP_Doc]) + _nontsIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _nontsIerrors :: (Seq Error) + _nontsIfromToStates :: (Map VisitIdentifier (Int,Int)) + _nontsIgenProdIO :: (IO ()) + _nontsIimports :: ([PP_Doc]) + _nontsIinitStates :: (Map NontermIdent Int) + _nontsIoutput :: PP_Doc + _nontsIsemFunBndDefs :: (Seq PP_Doc) + _nontsIsemFunBndTps :: (Seq PP_Doc) + _nontsIvisitKinds :: (Map VisitIdentifier VisitKind) + _nontsIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _nontsIvisituses :: (Map VisitIdentifier (Set Identifier)) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 87, column 19) + _lhsOoutput = + ({-# LINE 87 "./src-ag/ExecutionPlan2Hs.ag" #-} + _nontsIoutput >-< _commonExtra >-< _wrappersExtra + {-# LINE 5262 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 93, column 19) + _nontsOwrappers = + ({-# LINE 93 "./src-ag/ExecutionPlan2Hs.ag" #-} + wrappers_ + {-# LINE 5268 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 132, column 19) + _nontsOtypeSyns = + ({-# LINE 132 "./src-ag/ExecutionPlan2Hs.ag" #-} + typeSyns_ + {-# LINE 5274 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 133, column 19) + _nontsOderivings = + ({-# LINE 133 "./src-ag/ExecutionPlan2Hs.ag" #-} + derivings_ + {-# LINE 5280 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 529, column 3) + _wrappersExtra = + ({-# LINE 529 "./src-ag/ExecutionPlan2Hs.ag" #-} + if lateHigherOrderBinding _lhsIoptions + then _lateSemBndDef + else empty + {-# LINE 5288 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 532, column 3) + _commonExtra = + ({-# LINE 532 "./src-ag/ExecutionPlan2Hs.ag" #-} + if lateHigherOrderBinding _lhsIoptions + then _lateSemBndTp + else empty + {-# LINE 5296 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 535, column 3) + _lateSemBndTp = + ({-# LINE 535 "./src-ag/ExecutionPlan2Hs.ag" #-} + "data" >#< lateBindingTypeNm _lhsImainName >#< "=" >#< lateBindingTypeNm _lhsImainName + >-< (indent 2 $ pp_block "{" "}" "," $ toList _nontsIsemFunBndTps) + {-# LINE 5303 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 537, column 3) + _lateSemBndDef = + ({-# LINE 537 "./src-ag/ExecutionPlan2Hs.ag" #-} + ( if noInlinePragmas _lhsIoptions + then empty + else if helpInlining _lhsIoptions && Set.size wrappers_ == 1 + then ppInline $ lateBindingFieldNm _lhsImainName + else ppNoInline $ lateBindingFieldNm _lhsImainName + ) + >-< lateBindingFieldNm _lhsImainName >#< "::" >#< lateBindingTypeNm _lhsImainName + >-< lateBindingFieldNm _lhsImainName >#< "=" >#< lateBindingTypeNm _lhsImainName + >-< (indent 2 $ pp_block "{" "}" "," $ toList _nontsIsemFunBndDefs ) + {-# LINE 5317 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1189, column 19) + _nontsOallchildvisit = + ({-# LINE 1189 "./src-ag/ExecutionPlan2Hs.ag" #-} + _nontsIchildvisit + {-# LINE 5323 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1333, column 19) + _nontsOavisitdefs = + ({-# LINE 1333 "./src-ag/ExecutionPlan2Hs.ag" #-} + _nontsIvisitdefs + {-# LINE 5329 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1334, column 19) + _nontsOavisituses = + ({-# LINE 1334 "./src-ag/ExecutionPlan2Hs.ag" #-} + _nontsIvisituses + {-# LINE 5335 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1405, column 19) + _lhsOgenIO = + ({-# LINE 1405 "./src-ag/ExecutionPlan2Hs.ag" #-} + do _genMainModule + _genCommonModule + _nontsIgenProdIO + {-# LINE 5343 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1408, column 19) + _mainModuleFile = + ({-# LINE 1408 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainFile + {-# LINE 5349 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1409, column 19) + _ppMonadImports = + ({-# LINE 1409 "./src-ag/ExecutionPlan2Hs.ag" #-} + ( if tupleAsDummyToken _lhsIoptions + then empty + else pp "import GHC.Prim" + ) + >-< if parallelInvoke _lhsIoptions + then pp "import qualified System.IO.Unsafe(unsafePerformIO)" + >-< pp "import System.IO(IO)" + >-< pp "import Control.Concurrent(newEmptyMVar,forkIO,putMVar,takeMVar)" + else pp "import Control.Monad.Identity" + {-# LINE 5363 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1418, column 19) + _genMainModule = + ({-# LINE 1418 "./src-ag/ExecutionPlan2Hs.ag" #-} + writeModule _mainModuleFile + ( [ warrenFlagsPP _lhsIoptions + , pp $ _lhsIpragmaBlocks + , pp $ _lhsImoduleHeader _lhsImainName "" "" False + , _ppMonadImports + , pp $ "import " ++ _lhsImainName ++ "_common" + ] + ++ _nontsIimports + ++ [_lhsImainBlocksDoc] + ++ [_wrappersExtra ] + ++ _nontsIappendMain + ) + {-# LINE 5380 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1430, column 19) + _commonFile = + ({-# LINE 1430 "./src-ag/ExecutionPlan2Hs.ag" #-} + replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ "_common") + {-# LINE 5386 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1431, column 19) + _genCommonModule = + ({-# LINE 1431 "./src-ag/ExecutionPlan2Hs.ag" #-} + writeModule _commonFile + ( [ pp $ "{-# LANGUAGE Rank2Types, GADTs #-}" + , pp $ _lhsIpragmaBlocks + , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True + , _ppMonadImports + , _lhsIimportBlocks + , _lhsItextBlocks + , _commonExtra + ] + ++ _nontsIappendCommon + ) + {-# LINE 5402 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1550, column 3) + _nontsOallFromToStates = + ({-# LINE 1550 "./src-ag/ExecutionPlan2Hs.ag" #-} + _nontsIfromToStates + {-# LINE 5408 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1594, column 3) + _nontsOallVisitKinds = + ({-# LINE 1594 "./src-ag/ExecutionPlan2Hs.ag" #-} + _nontsIvisitKinds + {-# LINE 5414 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1608, column 3) + _nontsOallInitStates = + ({-# LINE 1608 "./src-ag/ExecutionPlan2Hs.ag" #-} + _nontsIinitStates + {-# LINE 5420 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + _nontsIerrors + {-# LINE 5426 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOimportBlocks = + ({-# LINE 34 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIimportBlocks + {-# LINE 5432 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOinhmap = + ({-# LINE 309 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 5438 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOlocalAttrTypes = + ({-# LINE 1573 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 5444 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOmainFile = + ({-# LINE 38 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainFile + {-# LINE 5450 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOmainName = + ({-# LINE 39 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImainName + {-# LINE 5456 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOmoduleHeader = + ({-# LINE 37 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImoduleHeader + {-# LINE 5462 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 5468 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOpragmaBlocks = + ({-# LINE 35 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIpragmaBlocks + {-# LINE 5474 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOsynmap = + ({-# LINE 310 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 5480 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOtextBlocks = + ({-# LINE 36 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsItextBlocks + {-# LINE 5486 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _nontsIappendCommon,_nontsIappendMain,_nontsIchildvisit,_nontsIerrors,_nontsIfromToStates,_nontsIgenProdIO,_nontsIimports,_nontsIinitStates,_nontsIoutput,_nontsIsemFunBndDefs,_nontsIsemFunBndTps,_nontsIvisitKinds,_nontsIvisitdefs,_nontsIvisituses) = + nonts_ _nontsOallFromToStates _nontsOallInitStates _nontsOallVisitKinds _nontsOallchildvisit _nontsOavisitdefs _nontsOavisituses _nontsOderivings _nontsOimportBlocks _nontsOinhmap _nontsOlocalAttrTypes _nontsOmainFile _nontsOmainName _nontsOmoduleHeader _nontsOoptions _nontsOpragmaBlocks _nontsOsynmap _nontsOtextBlocks _nontsOtypeSyns _nontsOwrappers + in ( _lhsOerrors,_lhsOgenIO,_lhsOoutput)))) +-- Expression -------------------------------------------------- +{- + visit 0: + synthesized attributes: + attrs : Map String (Maybe NonLocalAttr) + pos : Pos + semfunc : PP_Doc + tks : [HsToken] + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression _pos _tks) = + (sem_Expression_Expression _pos _tks) +-- semantic domain +newtype T_Expression = T_Expression (( (Map String (Maybe NonLocalAttr)),Pos,PP_Doc,([HsToken]))) +data Inh_Expression = Inh_Expression {} +data Syn_Expression = Syn_Expression {attrs_Syn_Expression :: (Map String (Maybe NonLocalAttr)),pos_Syn_Expression :: Pos,semfunc_Syn_Expression :: PP_Doc,tks_Syn_Expression :: ([HsToken])} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem) (Inh_Expression) = + (let ( _lhsOattrs,_lhsOpos,_lhsOsemfunc,_lhsOtks) = sem + in (Syn_Expression _lhsOattrs _lhsOpos _lhsOsemfunc _lhsOtks)) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (let _lhsOtks :: ([HsToken]) + _lhsOpos :: Pos + _lhsOattrs :: (Map String (Maybe NonLocalAttr)) + _lhsOsemfunc :: PP_Doc + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1045, column 16) + _lhsOtks = + ({-# LINE 1045 "./src-ag/ExecutionPlan2Hs.ag" #-} + tks_ + {-# LINE 5531 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1088, column 29) + _lhsOpos = + ({-# LINE 1088 "./src-ag/ExecutionPlan2Hs.ag" #-} + pos_ + {-# LINE 5537 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1174, column 16) + _lhsOattrs = + ({-# LINE 1174 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.unions $ map (\tok -> attrs_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_ + {-# LINE 5543 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1175, column 16) + _lhsOsemfunc = + ({-# LINE 1175 "./src-ag/ExecutionPlan2Hs.ag" #-} + vlist $ showTokens $ map (\tok -> tok_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_ + {-# LINE 5549 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOpos,_lhsOsemfunc,_lhsOtks))) +-- HsToken ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + attrs : Map String (Maybe NonLocalAttr) + tok : (Pos,String) + alternatives: + alternative AGLocal: + child var : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local tok : _ + alternative AGField: + child field : {Identifier} + child attr : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local mbAttr : _ + local addTrace : _ + alternative HsToken: + child value : {String} + child pos : {Pos} + alternative CharToken: + child value : {String} + child pos : {Pos} + alternative StrToken: + child value : {String} + child pos : {Pos} + alternative Err: + child mesg : {String} + child pos : {Pos} +-} +-- cata +sem_HsToken :: HsToken -> + T_HsToken +sem_HsToken (AGLocal _var _pos _rdesc) = + (sem_HsToken_AGLocal _var _pos _rdesc) +sem_HsToken (AGField _field _attr _pos _rdesc) = + (sem_HsToken_AGField _field _attr _pos _rdesc) +sem_HsToken (HsToken _value _pos) = + (sem_HsToken_HsToken _value _pos) +sem_HsToken (CharToken _value _pos) = + (sem_HsToken_CharToken _value _pos) +sem_HsToken (StrToken _value _pos) = + (sem_HsToken_StrToken _value _pos) +sem_HsToken (Err _mesg _pos) = + (sem_HsToken_Err _mesg _pos) +-- semantic domain +newtype T_HsToken = T_HsToken (( (Map String (Maybe NonLocalAttr)),((Pos,String)))) +data Inh_HsToken = Inh_HsToken {} +data Syn_HsToken = Syn_HsToken {attrs_Syn_HsToken :: (Map String (Maybe NonLocalAttr)),tok_Syn_HsToken :: ((Pos,String))} +wrap_HsToken :: T_HsToken -> + Inh_HsToken -> + Syn_HsToken +wrap_HsToken (T_HsToken sem) (Inh_HsToken) = + (let ( _lhsOattrs,_lhsOtok) = sem + in (Syn_HsToken _lhsOattrs _lhsOtok)) +sem_HsToken_AGLocal :: Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGLocal var_ pos_ rdesc_ = + (T_HsToken (let _lhsOattrs :: (Map String (Maybe NonLocalAttr)) + _lhsOtok :: ((Pos,String)) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1133, column 15) + _lhsOattrs = + ({-# LINE 1133 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton (fieldname var_) Nothing + {-# LINE 5622 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1378, column 15) + _tok = + ({-# LINE 1378 "./src-ag/ExecutionPlan2Hs.ag" #-} + (pos_,fieldname var_) + {-# LINE 5628 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (from local) + _lhsOtok = + ({-# LINE 1380 "./src-ag/ExecutionPlan2Hs.ag" #-} + _tok + {-# LINE 5634 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok))) +sem_HsToken_AGField :: Identifier -> + Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGField field_ attr_ pos_ rdesc_ = + (T_HsToken (let _lhsOattrs :: (Map String (Maybe NonLocalAttr)) + _lhsOtok :: ((Pos,String)) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1134, column 15) + _mbAttr = + ({-# LINE 1134 "./src-ag/ExecutionPlan2Hs.ag" #-} + if field_ == _INST || field_ == _FIELD || field_ == _INST' + then Nothing + else Just $ mkNonLocalAttr (field_ == _LHS) field_ attr_ + {-# LINE 5651 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1137, column 15) + _lhsOattrs = + ({-# LINE 1137 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton (attrname True field_ attr_) _mbAttr + {-# LINE 5657 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1382, column 8) + _addTrace = + ({-# LINE 1382 "./src-ag/ExecutionPlan2Hs.ag" #-} + case rdesc_ of + Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))" + Nothing -> id + {-# LINE 5665 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1385, column 8) + _lhsOtok = + ({-# LINE 1385 "./src-ag/ExecutionPlan2Hs.ag" #-} + (pos_, _addTrace $ attrname True field_ attr_) + {-# LINE 5671 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok))) +sem_HsToken_HsToken :: String -> + Pos -> + T_HsToken +sem_HsToken_HsToken value_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Map String (Maybe NonLocalAttr)) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1387, column 14) + _lhsOtok = + ({-# LINE 1387 "./src-ag/ExecutionPlan2Hs.ag" #-} + (pos_, value_) + {-# LINE 5684 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1131, column 37) + _lhsOattrs = + ({-# LINE 1131 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 5690 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok))) +sem_HsToken_CharToken :: String -> + Pos -> + T_HsToken +sem_HsToken_CharToken value_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Map String (Maybe NonLocalAttr)) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1389, column 16) + _lhsOtok = + ({-# LINE 1389 "./src-ag/ExecutionPlan2Hs.ag" #-} + (pos_, if null value_ + then "" + else showCharShort (head value_) + ) + {-# LINE 5706 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1131, column 37) + _lhsOattrs = + ({-# LINE 1131 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 5712 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok))) +sem_HsToken_StrToken :: String -> + Pos -> + T_HsToken +sem_HsToken_StrToken value_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Map String (Maybe NonLocalAttr)) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1394, column 16) + _lhsOtok = + ({-# LINE 1394 "./src-ag/ExecutionPlan2Hs.ag" #-} + (pos_, showStrShort value_) + {-# LINE 5725 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1131, column 37) + _lhsOattrs = + ({-# LINE 1131 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 5731 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok))) +sem_HsToken_Err :: String -> + Pos -> + T_HsToken +sem_HsToken_Err mesg_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Map String (Maybe NonLocalAttr)) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1395, column 16) + _lhsOtok = + ({-# LINE 1395 "./src-ag/ExecutionPlan2Hs.ag" #-} + (pos_, "") + {-# LINE 5744 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1131, column 37) + _lhsOattrs = + ({-# LINE 1131 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 5750 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok))) +-- HsTokens ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + tks : [(Pos,String)] + alternatives: + alternative Cons: + child hd : HsToken + child tl : HsTokens + alternative Nil: +-} +-- cata +sem_HsTokens :: HsTokens -> + T_HsTokens +sem_HsTokens list = + (Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list)) +-- semantic domain +newtype T_HsTokens = T_HsTokens (( ([(Pos,String)]))) +data Inh_HsTokens = Inh_HsTokens {} +data Syn_HsTokens = Syn_HsTokens {tks_Syn_HsTokens :: ([(Pos,String)])} +wrap_HsTokens :: T_HsTokens -> + Inh_HsTokens -> + Syn_HsTokens +wrap_HsTokens (T_HsTokens sem) (Inh_HsTokens) = + (let ( _lhsOtks) = sem + in (Syn_HsTokens _lhsOtks)) +sem_HsTokens_Cons :: T_HsToken -> + T_HsTokens -> + T_HsTokens +sem_HsTokens_Cons (T_HsToken hd_) (T_HsTokens tl_) = + (T_HsTokens (let _lhsOtks :: ([(Pos,String)]) + _hdIattrs :: (Map String (Maybe NonLocalAttr)) + _hdItok :: ((Pos,String)) + _tlItks :: ([(Pos,String)]) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1374, column 10) + _lhsOtks = + ({-# LINE 1374 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdItok : _tlItks + {-# LINE 5791 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _hdIattrs,_hdItok) = + hd_ + ( _tlItks) = + tl_ + in ( _lhsOtks))) +sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil = + (T_HsTokens (let _lhsOtks :: ([(Pos,String)]) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1375, column 10) + _lhsOtks = + ({-# LINE 1375 "./src-ag/ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 5805 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOtks))) +-- HsTokensRoot ------------------------------------------------ +{- + 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 (( )) +data Inh_HsTokensRoot = Inh_HsTokensRoot {} +data Syn_HsTokensRoot = Syn_HsTokensRoot {} +wrap_HsTokensRoot :: T_HsTokensRoot -> + Inh_HsTokensRoot -> + Syn_HsTokensRoot +wrap_HsTokensRoot (T_HsTokensRoot sem) (Inh_HsTokensRoot) = + (let ( ) = sem + in (Syn_HsTokensRoot)) +sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> + T_HsTokensRoot +sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_) = + (T_HsTokensRoot (let _tokensItks :: ([(Pos,String)]) + ( _tokensItks) = + tokens_ + in ( ))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allInhmap : Map NontermIdent Attributes + allSynmap : Map NontermIdent Attributes + anyLazyKind : Bool + inhmap : Attributes + localAttrTypes : Map Identifier Type + options : Options + synmap : Attributes + synthesized attributes: + attrTypes : PP_Doc + attrs : Set String + copy : Pattern + isUnderscore : Bool + sem_lhs : PP_Doc + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local addbang : _ + local addbang1 : _ + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local addbang : _ + local addbang1 : _ + local copy : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local varPat : _ + local patExpr : _ + local mbTp : _ + local addbang : _ + local addbang1 : _ + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern (Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern (Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern (Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +sem_Pattern (Underscore _pos) = + (sem_Pattern_Underscore _pos) +-- semantic domain +newtype T_Pattern = T_Pattern ((Map NontermIdent Attributes) -> + (Map NontermIdent Attributes) -> + Bool -> + Attributes -> + (Map Identifier Type) -> + Options -> + Attributes -> + ( PP_Doc,(Set String),Pattern,Bool,( PP_Doc ))) +data Inh_Pattern = Inh_Pattern {allInhmap_Inh_Pattern :: (Map NontermIdent Attributes),allSynmap_Inh_Pattern :: (Map NontermIdent Attributes),anyLazyKind_Inh_Pattern :: Bool,inhmap_Inh_Pattern :: Attributes,localAttrTypes_Inh_Pattern :: (Map Identifier Type),options_Inh_Pattern :: Options,synmap_Inh_Pattern :: Attributes} +data Syn_Pattern = Syn_Pattern {attrTypes_Syn_Pattern :: PP_Doc,attrs_Syn_Pattern :: (Set String),copy_Syn_Pattern :: Pattern,isUnderscore_Syn_Pattern :: Bool,sem_lhs_Syn_Pattern :: ( PP_Doc )} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) = + (let ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOisUnderscore,_lhsOsem_lhs) = sem _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap + in (Syn_Pattern _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs)) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_) = + (T_Pattern (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIanyLazyKind + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsIoptions + _lhsIsynmap -> + (let _lhsOsem_lhs :: ( PP_Doc ) + _lhsOisUnderscore :: Bool + _lhsOattrTypes :: PP_Doc + _lhsOattrs :: (Set String) + _lhsOcopy :: Pattern + _patsOallInhmap :: (Map NontermIdent Attributes) + _patsOallSynmap :: (Map NontermIdent Attributes) + _patsOanyLazyKind :: Bool + _patsOinhmap :: Attributes + _patsOlocalAttrTypes :: (Map Identifier Type) + _patsOoptions :: Options + _patsOsynmap :: Attributes + _patsIattrTypes :: PP_Doc + _patsIattrs :: (Set String) + _patsIcopy :: Patterns + _patsIsem_lhs :: ([PP_Doc]) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1102, column 17) + _lhsOsem_lhs = + ({-# LINE 1102 "./src-ag/ExecutionPlan2Hs.ag" #-} + _addbang1 $ pp_parens $ name_ >#< hv_sp _patsIsem_lhs + {-# LINE 5949 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1109, column 16) + _lhsOisUnderscore = + ({-# LINE 1109 "./src-ag/ExecutionPlan2Hs.ag" #-} + False + {-# LINE 5955 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1518, column 37) + _addbang = + ({-# LINE 1518 "./src-ag/ExecutionPlan2Hs.ag" #-} + \x -> if bangpats _lhsIoptions then "!" >|< x else x + {-# LINE 5961 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1523, column 37) + _addbang1 = + ({-# LINE 1523 "./src-ag/ExecutionPlan2Hs.ag" #-} + if _lhsIanyLazyKind then id else _addbang + {-# LINE 5967 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1120, column 40) + _lhsOattrTypes = + ({-# LINE 1120 "./src-ag/ExecutionPlan2Hs.ag" #-} + _patsIattrTypes + {-# LINE 5973 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1115, column 36) + _lhsOattrs = + ({-# LINE 1115 "./src-ag/ExecutionPlan2Hs.ag" #-} + _patsIattrs + {-# LINE 5979 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 5985 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 5991 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patsOallInhmap = + ({-# LINE 318 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInhmap + {-# LINE 5997 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patsOallSynmap = + ({-# LINE 319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallSynmap + {-# LINE 6003 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patsOanyLazyKind = + ({-# LINE 1264 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIanyLazyKind + {-# LINE 6009 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patsOinhmap = + ({-# LINE 316 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 6015 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patsOlocalAttrTypes = + ({-# LINE 1575 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 6021 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patsOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 6027 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patsOsynmap = + ({-# LINE 317 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 6033 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _patsIattrTypes,_patsIattrs,_patsIcopy,_patsIsem_lhs) = + pats_ _patsOallInhmap _patsOallSynmap _patsOanyLazyKind _patsOinhmap _patsOlocalAttrTypes _patsOoptions _patsOsynmap + in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOisUnderscore,_lhsOsem_lhs)))) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_) = + (T_Pattern (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIanyLazyKind + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsIoptions + _lhsIsynmap -> + (let _lhsOsem_lhs :: ( PP_Doc ) + _lhsOisUnderscore :: Bool + _lhsOattrTypes :: PP_Doc + _lhsOattrs :: (Set String) + _lhsOcopy :: Pattern + _patsOallInhmap :: (Map NontermIdent Attributes) + _patsOallSynmap :: (Map NontermIdent Attributes) + _patsOanyLazyKind :: Bool + _patsOinhmap :: Attributes + _patsOlocalAttrTypes :: (Map Identifier Type) + _patsOoptions :: Options + _patsOsynmap :: Attributes + _patsIattrTypes :: PP_Doc + _patsIattrs :: (Set String) + _patsIcopy :: Patterns + _patsIsem_lhs :: ([PP_Doc]) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1101, column 17) + _lhsOsem_lhs = + ({-# LINE 1101 "./src-ag/ExecutionPlan2Hs.ag" #-} + _addbang1 $ pp_block "(" ")" "," _patsIsem_lhs + {-# LINE 6069 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1110, column 16) + _lhsOisUnderscore = + ({-# LINE 1110 "./src-ag/ExecutionPlan2Hs.ag" #-} + False + {-# LINE 6075 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1518, column 37) + _addbang = + ({-# LINE 1518 "./src-ag/ExecutionPlan2Hs.ag" #-} + \x -> if bangpats _lhsIoptions then "!" >|< x else x + {-# LINE 6081 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1523, column 37) + _addbang1 = + ({-# LINE 1523 "./src-ag/ExecutionPlan2Hs.ag" #-} + if _lhsIanyLazyKind then id else _addbang + {-# LINE 6087 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1120, column 40) + _lhsOattrTypes = + ({-# LINE 1120 "./src-ag/ExecutionPlan2Hs.ag" #-} + _patsIattrTypes + {-# LINE 6093 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1115, column 36) + _lhsOattrs = + ({-# LINE 1115 "./src-ag/ExecutionPlan2Hs.ag" #-} + _patsIattrs + {-# LINE 6099 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 6105 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 6111 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patsOallInhmap = + ({-# LINE 318 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInhmap + {-# LINE 6117 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patsOallSynmap = + ({-# LINE 319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallSynmap + {-# LINE 6123 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patsOanyLazyKind = + ({-# LINE 1264 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIanyLazyKind + {-# LINE 6129 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patsOinhmap = + ({-# LINE 316 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 6135 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patsOlocalAttrTypes = + ({-# LINE 1575 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 6141 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patsOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 6147 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patsOsynmap = + ({-# LINE 317 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 6153 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _patsIattrTypes,_patsIattrs,_patsIcopy,_patsIsem_lhs) = + pats_ _patsOallInhmap _patsOallSynmap _patsOanyLazyKind _patsOinhmap _patsOlocalAttrTypes _patsOoptions _patsOsynmap + in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOisUnderscore,_lhsOsem_lhs)))) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_) = + (T_Pattern (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIanyLazyKind + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsIoptions + _lhsIsynmap -> + (let _lhsOsem_lhs :: ( PP_Doc ) + _lhsOisUnderscore :: Bool + _lhsOattrs :: (Set String) + _lhsOattrTypes :: PP_Doc + _lhsOcopy :: Pattern + _patOallInhmap :: (Map NontermIdent Attributes) + _patOallSynmap :: (Map NontermIdent Attributes) + _patOanyLazyKind :: Bool + _patOinhmap :: Attributes + _patOlocalAttrTypes :: (Map Identifier Type) + _patOoptions :: Options + _patOsynmap :: Attributes + _patIattrTypes :: PP_Doc + _patIattrs :: (Set String) + _patIcopy :: Pattern + _patIisUnderscore :: Bool + _patIsem_lhs :: ( PP_Doc ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1096, column 17) + _varPat = + ({-# LINE 1096 "./src-ag/ExecutionPlan2Hs.ag" #-} + text $ attrname False field_ attr_ + {-# LINE 6191 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1097, column 17) + _patExpr = + ({-# LINE 1097 "./src-ag/ExecutionPlan2Hs.ag" #-} + if _patIisUnderscore + then _varPat + else _varPat >|< "@" >|< _patIsem_lhs + {-# LINE 6199 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1100, column 17) + _lhsOsem_lhs = + ({-# LINE 1100 "./src-ag/ExecutionPlan2Hs.ag" #-} + _addbang1 _patExpr + {-# LINE 6205 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1111, column 16) + _lhsOisUnderscore = + ({-# LINE 1111 "./src-ag/ExecutionPlan2Hs.ag" #-} + False + {-# LINE 6211 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1117, column 3) + _lhsOattrs = + ({-# LINE 1117 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.insert (attrname False field_ attr_) _patIattrs + {-# LINE 6217 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1122, column 3) + _mbTp = + ({-# LINE 1122 "./src-ag/ExecutionPlan2Hs.ag" #-} + if field_ == _LHS + then Map.lookup attr_ _lhsIsynmap + else if field_ == _LOC + then Map.lookup attr_ _lhsIlocalAttrTypes + else Nothing + {-# LINE 6227 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1127, column 3) + _lhsOattrTypes = + ({-# LINE 1127 "./src-ag/ExecutionPlan2Hs.ag" #-} + maybe empty (\tp -> (attrname False field_ attr_) >#< "::" >#< ppTp tp) _mbTp + >-< _patIattrTypes + {-# LINE 6234 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1518, column 37) + _addbang = + ({-# LINE 1518 "./src-ag/ExecutionPlan2Hs.ag" #-} + \x -> if bangpats _lhsIoptions then "!" >|< x else x + {-# LINE 6240 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1523, column 37) + _addbang1 = + ({-# LINE 1523 "./src-ag/ExecutionPlan2Hs.ag" #-} + if _lhsIanyLazyKind then id else _addbang + {-# LINE 6246 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 6252 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 6258 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patOallInhmap = + ({-# LINE 318 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInhmap + {-# LINE 6264 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patOallSynmap = + ({-# LINE 319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallSynmap + {-# LINE 6270 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patOanyLazyKind = + ({-# LINE 1264 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIanyLazyKind + {-# LINE 6276 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patOinhmap = + ({-# LINE 316 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 6282 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patOlocalAttrTypes = + ({-# LINE 1575 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 6288 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 6294 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patOsynmap = + ({-# LINE 317 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 6300 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _patIattrTypes,_patIattrs,_patIcopy,_patIisUnderscore,_patIsem_lhs) = + pat_ _patOallInhmap _patOallSynmap _patOanyLazyKind _patOinhmap _patOlocalAttrTypes _patOoptions _patOsynmap + in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOisUnderscore,_lhsOsem_lhs)))) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_) = + (T_Pattern (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIanyLazyKind + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsIoptions + _lhsIsynmap -> + (let _lhsOsem_lhs :: ( PP_Doc ) + _lhsOattrTypes :: PP_Doc + _lhsOattrs :: (Set String) + _lhsOcopy :: Pattern + _lhsOisUnderscore :: Bool + _patOallInhmap :: (Map NontermIdent Attributes) + _patOallSynmap :: (Map NontermIdent Attributes) + _patOanyLazyKind :: Bool + _patOinhmap :: Attributes + _patOlocalAttrTypes :: (Map Identifier Type) + _patOoptions :: Options + _patOsynmap :: Attributes + _patIattrTypes :: PP_Doc + _patIattrs :: (Set String) + _patIcopy :: Pattern + _patIisUnderscore :: Bool + _patIsem_lhs :: ( PP_Doc ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1104, column 17) + _lhsOsem_lhs = + ({-# LINE 1104 "./src-ag/ExecutionPlan2Hs.ag" #-} + text "~" >|< pp_parens _patIsem_lhs + {-# LINE 6336 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1120, column 40) + _lhsOattrTypes = + ({-# LINE 1120 "./src-ag/ExecutionPlan2Hs.ag" #-} + _patIattrTypes + {-# LINE 6342 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1115, column 36) + _lhsOattrs = + ({-# LINE 1115 "./src-ag/ExecutionPlan2Hs.ag" #-} + _patIattrs + {-# LINE 6348 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 6354 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 6360 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (up) + _lhsOisUnderscore = + ({-# LINE 1107 "./src-ag/ExecutionPlan2Hs.ag" #-} + _patIisUnderscore + {-# LINE 6366 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patOallInhmap = + ({-# LINE 318 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInhmap + {-# LINE 6372 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patOallSynmap = + ({-# LINE 319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallSynmap + {-# LINE 6378 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patOanyLazyKind = + ({-# LINE 1264 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIanyLazyKind + {-# LINE 6384 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patOinhmap = + ({-# LINE 316 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 6390 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patOlocalAttrTypes = + ({-# LINE 1575 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 6396 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 6402 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _patOsynmap = + ({-# LINE 317 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 6408 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _patIattrTypes,_patIattrs,_patIcopy,_patIisUnderscore,_patIsem_lhs) = + pat_ _patOallInhmap _patOallSynmap _patOanyLazyKind _patOinhmap _patOlocalAttrTypes _patOoptions _patOsynmap + in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOisUnderscore,_lhsOsem_lhs)))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIanyLazyKind + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsIoptions + _lhsIsynmap -> + (let _lhsOsem_lhs :: ( PP_Doc ) + _lhsOisUnderscore :: Bool + _lhsOattrTypes :: PP_Doc + _lhsOattrs :: (Set String) + _lhsOcopy :: Pattern + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1103, column 17) + _lhsOsem_lhs = + ({-# LINE 1103 "./src-ag/ExecutionPlan2Hs.ag" #-} + text "_" + {-# LINE 6432 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1112, column 16) + _lhsOisUnderscore = + ({-# LINE 1112 "./src-ag/ExecutionPlan2Hs.ag" #-} + True + {-# LINE 6438 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1120, column 40) + _lhsOattrTypes = + ({-# LINE 1120 "./src-ag/ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 6444 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1115, column 36) + _lhsOattrs = + ({-# LINE 1115 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 6450 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 6456 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 6462 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOisUnderscore,_lhsOsem_lhs)))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + inherited attributes: + allInhmap : Map NontermIdent Attributes + allSynmap : Map NontermIdent Attributes + anyLazyKind : Bool + inhmap : Attributes + localAttrTypes : Map Identifier Type + options : Options + synmap : Attributes + synthesized attributes: + attrTypes : PP_Doc + attrs : Set String + copy : Patterns + sem_lhs : [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 ((Map NontermIdent Attributes) -> + (Map NontermIdent Attributes) -> + Bool -> + Attributes -> + (Map Identifier Type) -> + Options -> + Attributes -> + ( PP_Doc,(Set String),Patterns,([PP_Doc]))) +data Inh_Patterns = Inh_Patterns {allInhmap_Inh_Patterns :: (Map NontermIdent Attributes),allSynmap_Inh_Patterns :: (Map NontermIdent Attributes),anyLazyKind_Inh_Patterns :: Bool,inhmap_Inh_Patterns :: Attributes,localAttrTypes_Inh_Patterns :: (Map Identifier Type),options_Inh_Patterns :: Options,synmap_Inh_Patterns :: Attributes} +data Syn_Patterns = Syn_Patterns {attrTypes_Syn_Patterns :: PP_Doc,attrs_Syn_Patterns :: (Set String),copy_Syn_Patterns :: Patterns,sem_lhs_Syn_Patterns :: ([PP_Doc])} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) = + (let ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOsem_lhs) = sem _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap + in (Syn_Patterns _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOsem_lhs)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = + (T_Patterns (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIanyLazyKind + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsIoptions + _lhsIsynmap -> + (let _lhsOattrTypes :: PP_Doc + _lhsOattrs :: (Set String) + _lhsOsem_lhs :: ([PP_Doc]) + _lhsOcopy :: Patterns + _hdOallInhmap :: (Map NontermIdent Attributes) + _hdOallSynmap :: (Map NontermIdent Attributes) + _hdOanyLazyKind :: Bool + _hdOinhmap :: Attributes + _hdOlocalAttrTypes :: (Map Identifier Type) + _hdOoptions :: Options + _hdOsynmap :: Attributes + _tlOallInhmap :: (Map NontermIdent Attributes) + _tlOallSynmap :: (Map NontermIdent Attributes) + _tlOanyLazyKind :: Bool + _tlOinhmap :: Attributes + _tlOlocalAttrTypes :: (Map Identifier Type) + _tlOoptions :: Options + _tlOsynmap :: Attributes + _hdIattrTypes :: PP_Doc + _hdIattrs :: (Set String) + _hdIcopy :: Pattern + _hdIisUnderscore :: Bool + _hdIsem_lhs :: ( PP_Doc ) + _tlIattrTypes :: PP_Doc + _tlIattrs :: (Set String) + _tlIcopy :: Patterns + _tlIsem_lhs :: ([PP_Doc]) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1120, column 40) + _lhsOattrTypes = + ({-# LINE 1120 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIattrTypes >-< _tlIattrTypes + {-# LINE 6555 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1115, column 36) + _lhsOattrs = + ({-# LINE 1115 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIattrs `Set.union` _tlIattrs + {-# LINE 6561 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1092, column 29) + _lhsOsem_lhs = + ({-# LINE 1092 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIsem_lhs : _tlIsem_lhs + {-# LINE 6567 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 6573 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 6579 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallInhmap = + ({-# LINE 318 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInhmap + {-# LINE 6585 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallSynmap = + ({-# LINE 319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallSynmap + {-# LINE 6591 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOanyLazyKind = + ({-# LINE 1264 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIanyLazyKind + {-# LINE 6597 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 316 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 6603 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOlocalAttrTypes = + ({-# LINE 1575 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 6609 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 6615 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 317 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 6621 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallInhmap = + ({-# LINE 318 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInhmap + {-# LINE 6627 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallSynmap = + ({-# LINE 319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallSynmap + {-# LINE 6633 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOanyLazyKind = + ({-# LINE 1264 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIanyLazyKind + {-# LINE 6639 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 316 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 6645 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOlocalAttrTypes = + ({-# LINE 1575 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIlocalAttrTypes + {-# LINE 6651 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 6657 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 317 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 6663 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _hdIattrTypes,_hdIattrs,_hdIcopy,_hdIisUnderscore,_hdIsem_lhs) = + hd_ _hdOallInhmap _hdOallSynmap _hdOanyLazyKind _hdOinhmap _hdOlocalAttrTypes _hdOoptions _hdOsynmap + ( _tlIattrTypes,_tlIattrs,_tlIcopy,_tlIsem_lhs) = + tl_ _tlOallInhmap _tlOallSynmap _tlOanyLazyKind _tlOinhmap _tlOlocalAttrTypes _tlOoptions _tlOsynmap + in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOsem_lhs)))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (\ _lhsIallInhmap + _lhsIallSynmap + _lhsIanyLazyKind + _lhsIinhmap + _lhsIlocalAttrTypes + _lhsIoptions + _lhsIsynmap -> + (let _lhsOattrTypes :: PP_Doc + _lhsOattrs :: (Set String) + _lhsOsem_lhs :: ([PP_Doc]) + _lhsOcopy :: Patterns + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1120, column 40) + _lhsOattrTypes = + ({-# LINE 1120 "./src-ag/ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 6687 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1115, column 36) + _lhsOattrs = + ({-# LINE 1115 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 6693 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1092, column 29) + _lhsOsem_lhs = + ({-# LINE 1092 "./src-ag/ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 6699 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 6705 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 6711 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrTypes,_lhsOattrs,_lhsOcopy,_lhsOsem_lhs)))) +-- Visit ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInhmap : Map NontermIdent Attributes + allInitStates : Map NontermIdent Int + allSynmap : Map NontermIdent Attributes + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) + allintramap : Map StateIdentifier (Map String (Maybe NonLocalAttr)) + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + childTypes : Map Identifier Type + childintros : Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) + con : ConstructorIdent + inhmap : Attributes + mrules : Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc) + nextVisits : Map StateIdentifier StateCtx + nt : NontermIdent + options : Options + params : [Identifier] + prevVisits : Map StateIdentifier StateCtx + ruledefs : Map Identifier (Set String) + ruleuses : Map Identifier (Map String (Maybe NonLocalAttr)) + synmap : Attributes + terminaldefs : Set String + synthesized attributes: + allvisits : VisitStateState + childvisit : Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) + errors : Seq Error + fromToStates : Map VisitIdentifier (Int,Int) + intramap : Map StateIdentifier (Map String (Maybe NonLocalAttr)) + lazyIntras : Set String + ruleKinds : Map Identifier (Set VisitKind) + ruleUsage : Map Identifier Int + sem_visit : (StateIdentifier,Bool -> PP_Doc) + t_visits : PP_Doc + visitKinds : Map VisitIdentifier VisitKind + visitdefs : Map VisitIdentifier (Set Identifier) + visituses : Map VisitIdentifier (Set Identifier) + alternatives: + alternative Visit: + child ident : {VisitIdentifier} + child from : {StateIdentifier} + child to : {StateIdentifier} + child inh : {Set Identifier} + child syn : {Set Identifier} + child steps : VisitSteps + child kind : {VisitKind} + visit 0: + local nameT_visit : _ + local nameTIn_visit : _ + local nameTOut_visit : _ + local nameTNext_visit : _ + local nextVisitInfo : _ + local typecon : _ + local t_params : _ + local inhpart : _ + local synpart : _ + local ppTypeList : _ + local stepsInitial : _ + local stepsClosing : _ + local vname : _ + local inhpats : _ + local inhargs : _ + local synargs : _ + local nextargsMp : _ + local nextargs : _ + local nextst : _ + local resultval : _ + local nextStBuild : _ + local nextStRef : _ + local prevVisitInfo : _ + local invokecode : _ + local thisintra : _ + local nextintra : _ + local uses : _ + local inhVarNms : _ + local defs : _ + local defsAsMap : _ + local lazyIntrasInh : _ + local addbang : _ + local addbang1 : _ +-} +-- cata +sem_Visit :: Visit -> + T_Visit +sem_Visit (Visit _ident _from _to _inh _syn _steps _kind) = + (sem_Visit_Visit _ident _from _to _inh _syn (sem_VisitSteps _steps) _kind) +-- semantic domain +newtype T_Visit = T_Visit ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Attributes) -> + (Map NontermIdent Int) -> + (Map NontermIdent Attributes) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> + (Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map Identifier Type) -> + (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> + ConstructorIdent -> + Attributes -> + (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> + (Map StateIdentifier StateCtx) -> + NontermIdent -> + Options -> + ([Identifier]) -> + (Map StateIdentifier StateCtx) -> + (Map Identifier (Set String)) -> + (Map Identifier (Map String (Maybe NonLocalAttr))) -> + Attributes -> + (Set String) -> + ( ( VisitStateState ),(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),(Seq Error),(Map VisitIdentifier (Int,Int)),(Map StateIdentifier (Map String (Maybe NonLocalAttr))),(Set String),(Map Identifier (Set VisitKind)),(Map Identifier Int),( (StateIdentifier,Bool -> PP_Doc) ),PP_Doc,(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier)))) +data Inh_Visit = Inh_Visit {allFromToStates_Inh_Visit :: (Map VisitIdentifier (Int,Int)),allInhmap_Inh_Visit :: (Map NontermIdent Attributes),allInitStates_Inh_Visit :: (Map NontermIdent Int),allSynmap_Inh_Visit :: (Map NontermIdent Attributes),allVisitKinds_Inh_Visit :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_Visit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),allintramap_Inh_Visit :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))),avisitdefs_Inh_Visit :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_Visit :: (Map VisitIdentifier (Set Identifier)),childTypes_Inh_Visit :: (Map Identifier Type),childintros_Inh_Visit :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),con_Inh_Visit :: ConstructorIdent,inhmap_Inh_Visit :: Attributes,mrules_Inh_Visit :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),nextVisits_Inh_Visit :: (Map StateIdentifier StateCtx),nt_Inh_Visit :: NontermIdent,options_Inh_Visit :: Options,params_Inh_Visit :: ([Identifier]),prevVisits_Inh_Visit :: (Map StateIdentifier StateCtx),ruledefs_Inh_Visit :: (Map Identifier (Set String)),ruleuses_Inh_Visit :: (Map Identifier (Map String (Maybe NonLocalAttr))),synmap_Inh_Visit :: Attributes,terminaldefs_Inh_Visit :: (Set String)} +data Syn_Visit = Syn_Visit {allvisits_Syn_Visit :: ( VisitStateState ),childvisit_Syn_Visit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),errors_Syn_Visit :: (Seq Error),fromToStates_Syn_Visit :: (Map VisitIdentifier (Int,Int)),intramap_Syn_Visit :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))),lazyIntras_Syn_Visit :: (Set String),ruleKinds_Syn_Visit :: (Map Identifier (Set VisitKind)),ruleUsage_Syn_Visit :: (Map Identifier Int),sem_visit_Syn_Visit :: ( (StateIdentifier,Bool -> PP_Doc) ),t_visits_Syn_Visit :: PP_Doc,visitKinds_Syn_Visit :: (Map VisitIdentifier VisitKind),visitdefs_Syn_Visit :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_Visit :: (Map VisitIdentifier (Set Identifier))} +wrap_Visit :: T_Visit -> + Inh_Visit -> + Syn_Visit +wrap_Visit (T_Visit sem) (Inh_Visit _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOintramap,_lhsOlazyIntras,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_visit,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs + in (Syn_Visit _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses)) +sem_Visit_Visit :: VisitIdentifier -> + StateIdentifier -> + StateIdentifier -> + (Set Identifier) -> + (Set Identifier) -> + T_VisitSteps -> + VisitKind -> + T_Visit +sem_Visit_Visit ident_ from_ to_ inh_ syn_ (T_VisitSteps steps_) kind_ = + (T_Visit (\ _lhsIallFromToStates + _lhsIallInhmap + _lhsIallInitStates + _lhsIallSynmap + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIallintramap + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIcon + _lhsIinhmap + _lhsImrules + _lhsInextVisits + _lhsInt + _lhsIoptions + _lhsIparams + _lhsIprevVisits + _lhsIruledefs + _lhsIruleuses + _lhsIsynmap + _lhsIterminaldefs -> + (let _lhsOallvisits :: ( VisitStateState ) + _lhsOt_visits :: PP_Doc + _lhsOsem_visit :: ( (StateIdentifier,Bool -> PP_Doc) ) + _stepsOkind :: VisitKind + _stepsOfmtMode :: FormatMode + _stepsOindex :: Int + _stepsOprevMaxSimRefs :: Int + _stepsOuseParallel :: Bool + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _lhsOintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + _lhsOlazyIntras :: (Set String) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOerrors :: (Seq Error) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _stepsOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _stepsOallInitStates :: (Map NontermIdent Int) + _stepsOallVisitKinds :: (Map VisitIdentifier VisitKind) + _stepsOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _stepsOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _stepsOavisituses :: (Map VisitIdentifier (Set Identifier)) + _stepsOchildTypes :: (Map Identifier Type) + _stepsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _stepsOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) + _stepsOoptions :: Options + _stepsOruledefs :: (Map Identifier (Set String)) + _stepsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _stepsIdefs :: (Set String) + _stepsIerrors :: (Seq Error) + _stepsIindex :: Int + _stepsIisLast :: Bool + _stepsIlazyIntras :: (Set String) + _stepsIprevMaxSimRefs :: Int + _stepsIruleKinds :: (Map Identifier (Set VisitKind)) + _stepsIruleUsage :: (Map Identifier Int) + _stepsIsem_steps :: PP_Doc + _stepsIsize :: Int + _stepsIsync_steps :: PP_Doc + _stepsIuses :: (Map String (Maybe NonLocalAttr)) + _stepsIvisitKinds :: (Map VisitIdentifier VisitKind) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 338, column 11) + _lhsOallvisits = + ({-# LINE 338 "./src-ag/ExecutionPlan2Hs.ag" #-} + (ident_, from_, to_) + {-# LINE 6916 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 397, column 11) + _nameT_visit = + ({-# LINE 397 "./src-ag/ExecutionPlan2Hs.ag" #-} + conNmTVisit _lhsInt ident_ + {-# LINE 6922 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 398, column 11) + _nameTIn_visit = + ({-# LINE 398 "./src-ag/ExecutionPlan2Hs.ag" #-} + conNmTVisitIn _lhsInt ident_ + {-# LINE 6928 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 399, column 11) + _nameTOut_visit = + ({-# LINE 399 "./src-ag/ExecutionPlan2Hs.ag" #-} + conNmTVisitOut _lhsInt ident_ + {-# LINE 6934 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 400, column 11) + _nameTNext_visit = + ({-# LINE 400 "./src-ag/ExecutionPlan2Hs.ag" #-} + conNmTNextVisit _lhsInt to_ + {-# LINE 6940 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 402, column 11) + _nextVisitInfo = + ({-# LINE 402 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.findWithDefault ManyVis to_ _lhsInextVisits + {-# LINE 6946 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 403, column 11) + _typecon = + ({-# LINE 403 "./src-ag/ExecutionPlan2Hs.ag" #-} + case kind_ of + VisitPure _ -> empty + VisitMonadic -> ppMonadType _lhsIoptions + {-# LINE 6954 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 407, column 11) + _t_params = + ({-# LINE 407 "./src-ag/ExecutionPlan2Hs.ag" #-} + ppSpaced _lhsIparams + {-# LINE 6960 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 408, column 11) + _lhsOt_visits = + ({-# LINE 408 "./src-ag/ExecutionPlan2Hs.ag" #-} + "type" >#< _nameT_visit >#< _t_params >#< "=" >#< + pp_parens (_nameTIn_visit >#< _t_params ) + >#< ( if dummyTokenVisit _lhsIoptions + then "->" >#< dummyType _lhsIoptions True + else empty + ) + >#< "->" >#< _typecon >#< pp_parens (_nameTOut_visit >#< _t_params ) + >-< "data" >#< _nameTIn_visit >#< _t_params >#< "=" >#< _nameTIn_visit >#< + _inhpart + >-< "data" >#< _nameTOut_visit >#< _t_params >#< "=" >#< _nameTOut_visit >#< + _synpart >#< case _nextVisitInfo of + NoneVis -> empty + _ -> _addbang1 $ pp_parens (_nameTNext_visit >#< _t_params ) + {-# LINE 6978 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 421, column 11) + _inhpart = + ({-# LINE 421 "./src-ag/ExecutionPlan2Hs.ag" #-} + _ppTypeList inh_ _lhsIinhmap + {-# LINE 6984 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 422, column 11) + _synpart = + ({-# LINE 422 "./src-ag/ExecutionPlan2Hs.ag" #-} + _ppTypeList syn_ _lhsIsynmap + {-# LINE 6990 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 423, column 11) + _ppTypeList = + ({-# LINE 423 "./src-ag/ExecutionPlan2Hs.ag" #-} + \s m -> ppSpaced $ map (\i -> _addbang1 $ pp_parens $ case Map.lookup i m of + Just tp -> ppTp tp ) $ Set.toList s + {-# LINE 6997 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 706, column 11) + _lhsOsem_visit = + ({-# LINE 706 "./src-ag/ExecutionPlan2Hs.ag" #-} + ( from_ + , \addInlinePragma -> + ( if noInlinePragmas _lhsIoptions + then empty + else if addInlinePragma && aggressiveInlinePragmas _lhsIoptions + then ppInline _vname + else if helpInlining _lhsIoptions + then ppNoInline _vname + else empty + ) + >-< "v" >|< ident_ >#< "::" >#< _nameT_visit >#< _t_params + >-< "v" >|< ident_ >#< "=" >#< "\\" >#< (_addbang $ pp_parens (_nameTIn_visit >#< _inhpats )) + >#< ( if dummyTokenVisit _lhsIoptions + then pp $ dummyPat _lhsIoptions True + else empty + ) + >#< "->" + >#< ( if genCostCentres _lhsIoptions + then ppCostCentre (_vname >|< "_" >|< _lhsInt >|< "_" >|< _lhsIcon) + else empty + ) >#< "(" >#< _stepsInitial + >-< indent 3 (_stepsIsem_steps >-< _stepsClosing >#< ")") + ) + {-# LINE 7025 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 731, column 11) + _stepsInitial = + ({-# LINE 731 "./src-ag/ExecutionPlan2Hs.ag" #-} + case kind_ of + VisitPure False -> text "let" + VisitPure True -> empty + VisitMonadic -> text "do" + {-# LINE 7034 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 735, column 11) + _stepsClosing = + ({-# LINE 735 "./src-ag/ExecutionPlan2Hs.ag" #-} + let decls = _nextStBuild + >-< _addbang (pp resultValName) >#< "=" >#< _resultval + in case kind_ of + VisitPure False -> decls + >-< "in" >#< resultValName + VisitPure True -> "let" >#< decls + >-< indent 1 ("in" >#< resultValName) + VisitMonadic -> "let" >#< decls + >-< "return" >#< resultValName + {-# LINE 7048 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 744, column 11) + _vname = + ({-# LINE 744 "./src-ag/ExecutionPlan2Hs.ag" #-} + "v" >|< ident_ + {-# LINE 7054 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 745, column 11) + _inhpats = + ({-# LINE 745 "./src-ag/ExecutionPlan2Hs.ag" #-} + ppSpaced $ map (\arg -> _addbang $ pp $ attrname True _LHS arg) $ Set.toList inh_ + {-# LINE 7060 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 746, column 11) + _inhargs = + ({-# LINE 746 "./src-ag/ExecutionPlan2Hs.ag" #-} + \chn -> ppSpaced $ map (attrname False chn) $ Set.toList inh_ + {-# LINE 7066 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 747, column 11) + _synargs = + ({-# LINE 747 "./src-ag/ExecutionPlan2Hs.ag" #-} + ppSpaced $ map (\arg -> attrname False _LHS arg) $ Set.toList syn_ + {-# LINE 7072 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 748, column 11) + _nextargsMp = + ({-# LINE 748 "./src-ag/ExecutionPlan2Hs.ag" #-} + maybe Map.empty id $ Map.lookup to_ _lhsIallintramap + {-# LINE 7078 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 749, column 11) + _nextargs = + ({-# LINE 749 "./src-ag/ExecutionPlan2Hs.ag" #-} + ppSpaced $ Map.keys $ _nextargsMp + {-# LINE 7084 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 750, column 11) + _nextst = + ({-# LINE 750 "./src-ag/ExecutionPlan2Hs.ag" #-} + "st" >|< to_ >#< _nextargs >#< dummyArg _lhsIoptions (Map.null _nextargsMp ) + {-# LINE 7090 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 751, column 11) + _resultval = + ({-# LINE 751 "./src-ag/ExecutionPlan2Hs.ag" #-} + _nameTOut_visit >#< _synargs >#< _nextStRef + {-# LINE 7096 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 752, column 11) + (_nextStBuild,_nextStRef) = + ({-# LINE 752 "./src-ag/ExecutionPlan2Hs.ag" #-} + case _nextVisitInfo of + NoneVis -> (empty, empty) + _ -> (_addbang (pp nextStName) >#< "=" >#< _nextst , pp nextStName) + {-# LINE 7104 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 767, column 20) + _stepsOkind = + ({-# LINE 767 "./src-ag/ExecutionPlan2Hs.ag" #-} + kind_ + {-# LINE 7110 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 818, column 3) + _stepsOfmtMode = + ({-# LINE 818 "./src-ag/ExecutionPlan2Hs.ag" #-} + case kind_ of + VisitPure False -> FormatLetDecl + VisitPure True -> FormatLetLine + VisitMonadic -> FormatDo + {-# LINE 7119 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 856, column 22) + _stepsOindex = + ({-# LINE 856 "./src-ag/ExecutionPlan2Hs.ag" #-} + 0 + {-# LINE 7125 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 863, column 22) + _stepsOprevMaxSimRefs = + ({-# LINE 863 "./src-ag/ExecutionPlan2Hs.ag" #-} + 0 + {-# LINE 7131 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 879, column 22) + _stepsOuseParallel = + ({-# LINE 879 "./src-ag/ExecutionPlan2Hs.ag" #-} + False + {-# LINE 7137 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1193, column 6) + _prevVisitInfo = + ({-# LINE 1193 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.findWithDefault ManyVis from_ _lhsInextVisits + {-# LINE 7143 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1194, column 6) + _lhsOchildvisit = + ({-# LINE 1194 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton ident_ _invokecode + {-# LINE 7149 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1195, column 6) + _invokecode = + ({-# LINE 1195 "./src-ag/ExecutionPlan2Hs.ag" #-} + \chn kind -> + if kind `compatibleKind` kind_ + then Right $ + let pat | isLazyKind kind_ = pat0 + | otherwise = _addbang pat0 + pat0 = pp_parens pat1 + pat1 = _nameTOut_visit >#< (ppSpaced $ map (attrname True chn) $ Set.toList syn_) + >#< cont + cont = case _nextVisitInfo of + NoneVis -> empty + _ -> ch1 + ch0 = text $ stname chn from_ + ch1 = text $ stname chn to_ + expr = case (kind, kind_) of + (VisitPure _, VisitPure _) -> expr0 + (VisitPure _, VisitMonadic) -> unMon _lhsIoptions >#< expr0 + (VisitMonadic, VisitPure _) -> "return" >#< expr0 + (VisitMonadic, VisitMonadic) -> expr0 + expr0 = case _prevVisitInfo of + NoneVis -> error "error: invocation of a visit from a state that has no next visits" + OneVis _ -> "inv_" >|< _lhsInt >|< "_s" >|< from_ >#< ch0 >#< args + ManyVis -> "inv_" >|< _lhsInt >|< "_s" >|< from_ >#< ch0 + >#< "K_" >|< _lhsInt >|< "_v" >|< ident_ >#< args + args = pp_parens args0 >#< args1 + args0 = _nameTIn_visit >#< _inhargs chn + args1 | dummyTokenVisit _lhsIoptions = pp $ dummyArg _lhsIoptions True + | otherwise = empty + in (pat, expr) + else Left $ IncompatibleVisitKind chn ident_ kind kind_ + {-# LINE 7183 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1291, column 11) + _thisintra = + ({-# LINE 1291 "./src-ag/ExecutionPlan2Hs.ag" #-} + (_uses `Map.union` _nextintra ) `Map.difference` _defsAsMap + {-# LINE 7189 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1292, column 11) + _lhsOintramap = + ({-# LINE 1292 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton from_ _thisintra + {-# LINE 7195 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1293, column 11) + _nextintra = + ({-# LINE 1293 "./src-ag/ExecutionPlan2Hs.ag" #-} + maybe Map.empty id $ Map.lookup to_ _lhsIallintramap + {-# LINE 7201 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1294, column 11) + _uses = + ({-# LINE 1294 "./src-ag/ExecutionPlan2Hs.ag" #-} + let mp1 = _stepsIuses + mp2 = Map.fromList [ (lhsname False i, Just (AttrSyn _LHS i)) | i <- Set.elems syn_ ] + in mp1 `Map.union` mp2 + {-# LINE 7209 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1297, column 11) + _inhVarNms = + ({-# LINE 1297 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.map (lhsname True) inh_ + {-# LINE 7215 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1298, column 11) + _defs = + ({-# LINE 1298 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIdefs `Set.union` _inhVarNms `Set.union` _lhsIterminaldefs + {-# LINE 7221 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1299, column 11) + _defsAsMap = + ({-# LINE 1299 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.fromList [ (a, Nothing) | a <- Set.elems _defs ] + {-# LINE 7227 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1323, column 11) + _lhsOvisitdefs = + ({-# LINE 1323 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton ident_ syn_ + {-# LINE 7233 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1324, column 11) + _lhsOvisituses = + ({-# LINE 1324 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton ident_ inh_ + {-# LINE 7239 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1356, column 3) + _lazyIntrasInh = + ({-# LINE 1356 "./src-ag/ExecutionPlan2Hs.ag" #-} + case kind_ of + VisitPure False -> _inhVarNms `Set.union` _stepsIdefs + _ -> Set.empty + {-# LINE 7247 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1359, column 3) + _lhsOlazyIntras = + ({-# LINE 1359 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lazyIntrasInh `Set.union` _stepsIlazyIntras + {-# LINE 7253 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1512, column 37) + _addbang = + ({-# LINE 1512 "./src-ag/ExecutionPlan2Hs.ag" #-} + \x -> if bangpats _lhsIoptions then "!" >|< x else x + {-# LINE 7259 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1520, column 37) + _addbang1 = + ({-# LINE 1520 "./src-ag/ExecutionPlan2Hs.ag" #-} + if isLazyKind kind_ then id else _addbang + {-# LINE 7265 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1547, column 3) + _lhsOfromToStates = + ({-# LINE 1547 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton ident_ (from_, to_) + {-# LINE 7271 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1591, column 3) + _lhsOvisitKinds = + ({-# LINE 1591 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton ident_ kind_ + {-# LINE 7277 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIerrors + {-# LINE 7283 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1252, column 56) + _lhsOruleKinds = + ({-# LINE 1252 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIruleKinds + {-# LINE 7289 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1240, column 56) + _lhsOruleUsage = + ({-# LINE 1240 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIruleUsage + {-# LINE 7295 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallFromToStates = + ({-# LINE 1544 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallFromToStates + {-# LINE 7301 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 7307 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallVisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallVisitKinds + {-# LINE 7313 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallchildvisit = + ({-# LINE 1186 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 7319 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOavisitdefs = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 7325 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOavisituses = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 7331 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOchildTypes = + ({-# LINE 1561 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildTypes + {-# LINE 7337 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOchildintros = + ({-# LINE 890 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 7343 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOmrules = + ({-# LINE 773 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 7349 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 7355 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOruledefs = + ({-# LINE 1304 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 7361 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOruleuses = + ({-# LINE 1305 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 7367 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _stepsIdefs,_stepsIerrors,_stepsIindex,_stepsIisLast,_stepsIlazyIntras,_stepsIprevMaxSimRefs,_stepsIruleKinds,_stepsIruleUsage,_stepsIsem_steps,_stepsIsize,_stepsIsync_steps,_stepsIuses,_stepsIvisitKinds) = + steps_ _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfmtMode _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOprevMaxSimRefs _stepsOruledefs _stepsOruleuses _stepsOuseParallel + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOintramap,_lhsOlazyIntras,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_visit,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +-- VisitStep --------------------------------------------------- +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInitStates : Map NontermIdent Int + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + childTypes : Map Identifier Type + childintros : Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) + fmtMode : FormatMode + kind : VisitKind + mrules : Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc) + options : Options + ruledefs : Map Identifier (Set String) + ruleuses : Map Identifier (Map String (Maybe NonLocalAttr)) + useParallel : Bool + chained attributes: + index : Int + isLast : Bool + prevMaxSimRefs : Int + synthesized attributes: + defs : Set String + errors : Seq Error + lazyIntras : Set String + ruleKinds : Map Identifier (Set VisitKind) + ruleUsage : Map Identifier Int + sem_steps : PP_Doc + sync_steps : PP_Doc + uses : Map String (Maybe NonLocalAttr) + visitKinds : Map VisitIdentifier VisitKind + alternatives: + alternative Sem: + child name : {Identifier} + visit 0: + local ruleItf : _ + local sem_steps : _ + alternative ChildVisit: + child child : {Identifier} + child nonterm : {NontermIdent} + child visit : {VisitIdentifier} + visit 0: + local visitItf : _ + local patPP : _ + local exprPP : _ + local useParallel : _ + local convToMonad : _ + local callKind : _ + local addbang : _ + local from : _ + local to : _ + alternative PureGroup: + child steps : VisitSteps + child ordered : {Bool} + alternative Sim: + child steps : VisitSteps + visit 0: + local useParallel : _ + local isMonadic : _ + alternative ChildIntro: + child child : {Identifier} + visit 0: + local attachItf : _ +-} +-- cata +sem_VisitStep :: VisitStep -> + T_VisitStep +sem_VisitStep (Sem _name) = + (sem_VisitStep_Sem _name) +sem_VisitStep (ChildVisit _child _nonterm _visit) = + (sem_VisitStep_ChildVisit _child _nonterm _visit) +sem_VisitStep (PureGroup _steps _ordered) = + (sem_VisitStep_PureGroup (sem_VisitSteps _steps) _ordered) +sem_VisitStep (Sim _steps) = + (sem_VisitStep_Sim (sem_VisitSteps _steps)) +sem_VisitStep (ChildIntro _child) = + (sem_VisitStep_ChildIntro _child) +-- semantic domain +newtype T_VisitStep = T_VisitStep ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Int) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map Identifier Type) -> + (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> + FormatMode -> + Int -> + Bool -> + VisitKind -> + (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> + Options -> + Int -> + (Map Identifier (Set String)) -> + (Map Identifier (Map String (Maybe NonLocalAttr))) -> + Bool -> + ( (Set String),(Seq Error),Int,Bool,(Set String),Int,(Map Identifier (Set VisitKind)),(Map Identifier Int),PP_Doc,PP_Doc,(Map String (Maybe NonLocalAttr)),(Map VisitIdentifier VisitKind))) +data Inh_VisitStep = Inh_VisitStep {allFromToStates_Inh_VisitStep :: (Map VisitIdentifier (Int,Int)),allInitStates_Inh_VisitStep :: (Map NontermIdent Int),allVisitKinds_Inh_VisitStep :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_VisitStep :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),avisitdefs_Inh_VisitStep :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_VisitStep :: (Map VisitIdentifier (Set Identifier)),childTypes_Inh_VisitStep :: (Map Identifier Type),childintros_Inh_VisitStep :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),fmtMode_Inh_VisitStep :: FormatMode,index_Inh_VisitStep :: Int,isLast_Inh_VisitStep :: Bool,kind_Inh_VisitStep :: VisitKind,mrules_Inh_VisitStep :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),options_Inh_VisitStep :: Options,prevMaxSimRefs_Inh_VisitStep :: Int,ruledefs_Inh_VisitStep :: (Map Identifier (Set String)),ruleuses_Inh_VisitStep :: (Map Identifier (Map String (Maybe NonLocalAttr))),useParallel_Inh_VisitStep :: Bool} +data Syn_VisitStep = Syn_VisitStep {defs_Syn_VisitStep :: (Set String),errors_Syn_VisitStep :: (Seq Error),index_Syn_VisitStep :: Int,isLast_Syn_VisitStep :: Bool,lazyIntras_Syn_VisitStep :: (Set String),prevMaxSimRefs_Syn_VisitStep :: Int,ruleKinds_Syn_VisitStep :: (Map Identifier (Set VisitKind)),ruleUsage_Syn_VisitStep :: (Map Identifier Int),sem_steps_Syn_VisitStep :: PP_Doc,sync_steps_Syn_VisitStep :: PP_Doc,uses_Syn_VisitStep :: (Map String (Maybe NonLocalAttr)),visitKinds_Syn_VisitStep :: (Map VisitIdentifier VisitKind)} +wrap_VisitStep :: T_VisitStep -> + Inh_VisitStep -> + Syn_VisitStep +wrap_VisitStep (T_VisitStep sem) (Inh_VisitStep _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) = + (let ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds) = sem _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel + in (Syn_VisitStep _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsync_steps _lhsOuses _lhsOvisitKinds)) +sem_VisitStep_Sem :: Identifier -> + T_VisitStep +sem_VisitStep_Sem name_ = + (T_VisitStep (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIfmtMode + _lhsIindex + _lhsIisLast + _lhsIkind + _lhsImrules + _lhsIoptions + _lhsIprevMaxSimRefs + _lhsIruledefs + _lhsIruleuses + _lhsIuseParallel -> + (let _lhsOerrors :: (Seq Error) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOdefs :: (Set String) + _lhsOuses :: (Map String (Maybe NonLocalAttr)) + _lhsOlazyIntras :: (Set String) + _lhsOsem_steps :: PP_Doc + _lhsOsync_steps :: PP_Doc + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOindex :: Int + _lhsOisLast :: Bool + _lhsOprevMaxSimRefs :: Int + -- "./src-ag/ExecutionPlan2Hs.ag"(line 776, column 16) + _ruleItf = + ({-# LINE 776 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.findWithDefault (error $ "Rule " ++ show name_ ++ " not found") name_ _lhsImrules + {-# LINE 7516 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 777, column 16) + (_lhsOerrors,_sem_steps) = + ({-# LINE 777 "./src-ag/ExecutionPlan2Hs.ag" #-} + case _ruleItf _lhsIkind _lhsIfmtMode of + Left e -> (Seq.singleton e, empty) + Right stmt -> (Seq.empty, stmt) + {-# LINE 7524 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1244, column 32) + _lhsOruleUsage = + ({-# LINE 1244 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton name_ 1 + {-# LINE 7530 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1254, column 3) + _lhsOruleKinds = + ({-# LINE 1254 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.singleton name_ (Set.singleton _lhsIkind) + {-# LINE 7536 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1339, column 16) + _lhsOdefs = + ({-# LINE 1339 "./src-ag/ExecutionPlan2Hs.ag" #-} + maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruledefs + {-# LINE 7542 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1340, column 16) + _lhsOuses = + ({-# LINE 1340 "./src-ag/ExecutionPlan2Hs.ag" #-} + maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruleuses + {-# LINE 7548 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1352, column 57) + _lhsOlazyIntras = + ({-# LINE 1352 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 7554 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 774, column 43) + _lhsOsem_steps = + ({-# LINE 774 "./src-ag/ExecutionPlan2Hs.ag" #-} + _sem_steps + {-# LINE 7560 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 807, column 44) + _lhsOsync_steps = + ({-# LINE 807 "./src-ag/ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 7566 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1588, column 68) + _lhsOvisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + mempty + {-# LINE 7572 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (chain) + _lhsOindex = + ({-# LINE 851 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIindex + {-# LINE 7578 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (chain) + _lhsOisLast = + ({-# LINE 870 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIisLast + {-# LINE 7584 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (chain) + _lhsOprevMaxSimRefs = + ({-# LINE 862 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIprevMaxSimRefs + {-# LINE 7590 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds)))) +sem_VisitStep_ChildVisit :: Identifier -> + NontermIdent -> + VisitIdentifier -> + T_VisitStep +sem_VisitStep_ChildVisit child_ nonterm_ visit_ = + (T_VisitStep (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIfmtMode + _lhsIindex + _lhsIisLast + _lhsIkind + _lhsImrules + _lhsIoptions + _lhsIprevMaxSimRefs + _lhsIruledefs + _lhsIruleuses + _lhsIuseParallel -> + (let _lhsOerrors :: (Seq Error) + _lhsOsem_steps :: PP_Doc + _lhsOsync_steps :: PP_Doc + _lhsOdefs :: (Set String) + _lhsOuses :: (Map String (Maybe NonLocalAttr)) + _lhsOlazyIntras :: (Set String) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOindex :: Int + _lhsOisLast :: Bool + _lhsOprevMaxSimRefs :: Int + -- "./src-ag/ExecutionPlan2Hs.ag"(line 785, column 16) + _visitItf = + ({-# LINE 785 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.findWithDefault (error $ "Visit " ++ show visit_ ++ " not found") visit_ _lhsIallchildvisit + {-# LINE 7632 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 786, column 16) + (_lhsOerrors,_patPP,_exprPP) = + ({-# LINE 786 "./src-ag/ExecutionPlan2Hs.ag" #-} + case _visitItf child_ _lhsIkind of + Left e -> (Seq.singleton e, empty, empty) + Right (pat,expr) -> (Seq.empty, pat, expr) + {-# LINE 7640 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 790, column 16) + _useParallel = + ({-# LINE 790 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIuseParallel && not _lhsIisLast + {-# LINE 7646 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 791, column 16) + _lhsOsem_steps = + ({-# LINE 791 "./src-ag/ExecutionPlan2Hs.ag" #-} + if _useParallel + then _addbang ("sync_" >|< _lhsIindex) >#< "<- newEmptyMVar" + >-< "forkIO" >#< pp_parens (_convToMonad >#< pp_parens _exprPP >#< ">>= \\" >#< _addbang (pp parResultName) >#< " -> putMVar sync_" >|< _lhsIindex >#< parResultName) + else let decl = case _lhsIkind of + VisitPure _ -> _patPP >#< "=" >#< _exprPP + VisitMonadic -> _patPP >#< "<-" >#< _exprPP + in fmtDecl False _lhsIfmtMode decl + {-# LINE 7658 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 798, column 16) + _convToMonad = + ({-# LINE 798 "./src-ag/ExecutionPlan2Hs.ag" #-} + case _callKind of + VisitPure _ -> text "return" + VisitMonadic -> empty + {-# LINE 7666 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 801, column 16) + _callKind = + ({-# LINE 801 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.findWithDefault (error "visit kind should be in the map") visit_ _lhsIallVisitKinds + {-# LINE 7672 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 809, column 3) + _lhsOsync_steps = + ({-# LINE 809 "./src-ag/ExecutionPlan2Hs.ag" #-} + if _useParallel + then _patPP >#< "<-" >#< "takeMVar sync_" >|< _lhsIindex + else empty + {-# LINE 7680 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1341, column 16) + _lhsOdefs = + ({-# LINE 1341 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.insert (stname child_ _to) $ maybe (error "Visit not found") (Set.map $ attrname True child_) $ Map.lookup visit_ _lhsIavisitdefs + {-# LINE 7686 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1342, column 16) + _lhsOuses = + ({-# LINE 1342 "./src-ag/ExecutionPlan2Hs.ag" #-} + let convert attrs = Map.fromList [ (attrname False child_ attr, Just $ mkNonLocalAttr True child_ attr) | attr <- Set.elems attrs ] + in Map.insert (stname child_ _from) Nothing $ convert $ + maybe (error "Visit not found") id $ Map.lookup visit_ _lhsIavisituses + {-# LINE 7694 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1517, column 37) + _addbang = + ({-# LINE 1517 "./src-ag/ExecutionPlan2Hs.ag" #-} + \x -> if bangpats _lhsIoptions then "!" >|< x else x + {-# LINE 7700 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1553, column 3) + (_from,_to) = + ({-# LINE 1553 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.findWithDefault (error "visit not in allFromToStates") visit_ _lhsIallFromToStates + {-# LINE 7706 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1352, column 57) + _lhsOlazyIntras = + ({-# LINE 1352 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 7712 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1252, column 56) + _lhsOruleKinds = + ({-# LINE 1252 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 7718 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1240, column 56) + _lhsOruleUsage = + ({-# LINE 1240 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 7724 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1588, column 68) + _lhsOvisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + mempty + {-# LINE 7730 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (chain) + _lhsOindex = + ({-# LINE 851 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIindex + {-# LINE 7736 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (chain) + _lhsOisLast = + ({-# LINE 870 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIisLast + {-# LINE 7742 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (chain) + _lhsOprevMaxSimRefs = + ({-# LINE 862 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIprevMaxSimRefs + {-# LINE 7748 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds)))) +sem_VisitStep_PureGroup :: T_VisitSteps -> + Bool -> + T_VisitStep +sem_VisitStep_PureGroup (T_VisitSteps steps_) ordered_ = + (T_VisitStep (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIfmtMode + _lhsIindex + _lhsIisLast + _lhsIkind + _lhsImrules + _lhsIoptions + _lhsIprevMaxSimRefs + _lhsIruledefs + _lhsIruleuses + _lhsIuseParallel -> + (let _stepsOkind :: VisitKind + _lhsOsem_steps :: PP_Doc + _stepsOfmtMode :: FormatMode + _lhsOlazyIntras :: (Set String) + _lhsOdefs :: (Set String) + _lhsOerrors :: (Seq Error) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOsync_steps :: PP_Doc + _lhsOuses :: (Map String (Maybe NonLocalAttr)) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOindex :: Int + _lhsOisLast :: Bool + _lhsOprevMaxSimRefs :: Int + _stepsOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _stepsOallInitStates :: (Map NontermIdent Int) + _stepsOallVisitKinds :: (Map VisitIdentifier VisitKind) + _stepsOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _stepsOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _stepsOavisituses :: (Map VisitIdentifier (Set Identifier)) + _stepsOchildTypes :: (Map Identifier Type) + _stepsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _stepsOindex :: Int + _stepsOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) + _stepsOoptions :: Options + _stepsOprevMaxSimRefs :: Int + _stepsOruledefs :: (Map Identifier (Set String)) + _stepsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _stepsOuseParallel :: Bool + _stepsIdefs :: (Set String) + _stepsIerrors :: (Seq Error) + _stepsIindex :: Int + _stepsIisLast :: Bool + _stepsIlazyIntras :: (Set String) + _stepsIprevMaxSimRefs :: Int + _stepsIruleKinds :: (Map Identifier (Set VisitKind)) + _stepsIruleUsage :: (Map Identifier Int) + _stepsIsem_steps :: PP_Doc + _stepsIsize :: Int + _stepsIsync_steps :: PP_Doc + _stepsIuses :: (Map String (Maybe NonLocalAttr)) + _stepsIvisitKinds :: (Map VisitIdentifier VisitKind) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 771, column 3) + _stepsOkind = + ({-# LINE 771 "./src-ag/ExecutionPlan2Hs.ag" #-} + VisitPure ordered_ + {-# LINE 7819 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 803, column 16) + _lhsOsem_steps = + ({-# LINE 803 "./src-ag/ExecutionPlan2Hs.ag" #-} + case _lhsIfmtMode of + FormatDo -> "let" >#< _stepsIsem_steps + _ -> _stepsIsem_steps + {-# LINE 7827 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 824, column 3) + _stepsOfmtMode = + ({-# LINE 824 "./src-ag/ExecutionPlan2Hs.ag" #-} + case _lhsIfmtMode of + FormatDo -> FormatLetDecl + mode -> mode + {-# LINE 7835 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 1362, column 3) + _lhsOlazyIntras = + ({-# LINE 1362 "./src-ag/ExecutionPlan2Hs.ag" #-} + if ordered_ + then _stepsIlazyIntras + else _stepsIdefs + {-# LINE 7843 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1336, column 38) + _lhsOdefs = + ({-# LINE 1336 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIdefs + {-# LINE 7849 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIerrors + {-# LINE 7855 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1252, column 56) + _lhsOruleKinds = + ({-# LINE 1252 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIruleKinds + {-# LINE 7861 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1240, column 56) + _lhsOruleUsage = + ({-# LINE 1240 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIruleUsage + {-# LINE 7867 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 807, column 44) + _lhsOsync_steps = + ({-# LINE 807 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIsync_steps + {-# LINE 7873 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1337, column 38) + _lhsOuses = + ({-# LINE 1337 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIuses + {-# LINE 7879 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1588, column 68) + _lhsOvisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIvisitKinds + {-# LINE 7885 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (up) + _lhsOindex = + ({-# LINE 851 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIindex + {-# LINE 7891 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (up) + _lhsOisLast = + ({-# LINE 870 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIisLast + {-# LINE 7897 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (up) + _lhsOprevMaxSimRefs = + ({-# LINE 862 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIprevMaxSimRefs + {-# LINE 7903 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallFromToStates = + ({-# LINE 1544 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallFromToStates + {-# LINE 7909 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 7915 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallVisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallVisitKinds + {-# LINE 7921 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallchildvisit = + ({-# LINE 1186 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 7927 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOavisitdefs = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 7933 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOavisituses = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 7939 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOchildTypes = + ({-# LINE 1561 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildTypes + {-# LINE 7945 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOchildintros = + ({-# LINE 890 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 7951 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOindex = + ({-# LINE 851 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIindex + {-# LINE 7957 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOmrules = + ({-# LINE 773 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 7963 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 7969 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOprevMaxSimRefs = + ({-# LINE 862 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIprevMaxSimRefs + {-# LINE 7975 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOruledefs = + ({-# LINE 1304 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 7981 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOruleuses = + ({-# LINE 1305 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 7987 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOuseParallel = + ({-# LINE 878 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIuseParallel + {-# LINE 7993 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _stepsIdefs,_stepsIerrors,_stepsIindex,_stepsIisLast,_stepsIlazyIntras,_stepsIprevMaxSimRefs,_stepsIruleKinds,_stepsIruleUsage,_stepsIsem_steps,_stepsIsize,_stepsIsync_steps,_stepsIuses,_stepsIvisitKinds) = + steps_ _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfmtMode _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOprevMaxSimRefs _stepsOruledefs _stepsOruleuses _stepsOuseParallel + in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds)))) +sem_VisitStep_Sim :: T_VisitSteps -> + T_VisitStep +sem_VisitStep_Sim (T_VisitSteps steps_) = + (T_VisitStep (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIfmtMode + _lhsIindex + _lhsIisLast + _lhsIkind + _lhsImrules + _lhsIoptions + _lhsIprevMaxSimRefs + _lhsIruledefs + _lhsIruleuses + _lhsIuseParallel -> + (let _lhsOsem_steps :: PP_Doc + _stepsOindex :: Int + _lhsOindex :: Int + _lhsOprevMaxSimRefs :: Int + _lhsOdefs :: (Set String) + _lhsOerrors :: (Seq Error) + _lhsOlazyIntras :: (Set String) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOsync_steps :: PP_Doc + _lhsOuses :: (Map String (Maybe NonLocalAttr)) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOisLast :: Bool + _stepsOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _stepsOallInitStates :: (Map NontermIdent Int) + _stepsOallVisitKinds :: (Map VisitIdentifier VisitKind) + _stepsOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _stepsOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _stepsOavisituses :: (Map VisitIdentifier (Set Identifier)) + _stepsOchildTypes :: (Map Identifier Type) + _stepsOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _stepsOfmtMode :: FormatMode + _stepsOkind :: VisitKind + _stepsOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) + _stepsOoptions :: Options + _stepsOprevMaxSimRefs :: Int + _stepsOruledefs :: (Map Identifier (Set String)) + _stepsOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _stepsOuseParallel :: Bool + _stepsIdefs :: (Set String) + _stepsIerrors :: (Seq Error) + _stepsIindex :: Int + _stepsIisLast :: Bool + _stepsIlazyIntras :: (Set String) + _stepsIprevMaxSimRefs :: Int + _stepsIruleKinds :: (Map Identifier (Set VisitKind)) + _stepsIruleUsage :: (Map Identifier Int) + _stepsIsem_steps :: PP_Doc + _stepsIsize :: Int + _stepsIsync_steps :: PP_Doc + _stepsIuses :: (Map String (Maybe NonLocalAttr)) + _stepsIvisitKinds :: (Map VisitIdentifier VisitKind) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 802, column 16) + _lhsOsem_steps = + ({-# LINE 802 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIsem_steps >-< _stepsIsync_steps + {-# LINE 8065 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 857, column 22) + _stepsOindex = + ({-# LINE 857 "./src-ag/ExecutionPlan2Hs.ag" #-} + 0 + {-# LINE 8071 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 858, column 22) + _lhsOindex = + ({-# LINE 858 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIindex + {-# LINE 8077 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 865, column 3) + _lhsOprevMaxSimRefs = + ({-# LINE 865 "./src-ag/ExecutionPlan2Hs.ag" #-} + if _useParallel + then _lhsIprevMaxSimRefs `max` (_stepsIindex - 1) + else _lhsIprevMaxSimRefs + {-# LINE 8085 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 880, column 22) + _useParallel = + ({-# LINE 880 "./src-ag/ExecutionPlan2Hs.ag" #-} + parallelInvoke _lhsIoptions && _stepsIsize > 1 && _isMonadic + {-# LINE 8091 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 881, column 22) + _isMonadic = + ({-# LINE 881 "./src-ag/ExecutionPlan2Hs.ag" #-} + case _lhsIkind of + VisitMonadic -> True + _ -> False + {-# LINE 8099 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1336, column 38) + _lhsOdefs = + ({-# LINE 1336 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIdefs + {-# LINE 8105 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIerrors + {-# LINE 8111 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1352, column 57) + _lhsOlazyIntras = + ({-# LINE 1352 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIlazyIntras + {-# LINE 8117 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1252, column 56) + _lhsOruleKinds = + ({-# LINE 1252 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIruleKinds + {-# LINE 8123 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1240, column 56) + _lhsOruleUsage = + ({-# LINE 1240 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIruleUsage + {-# LINE 8129 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 807, column 44) + _lhsOsync_steps = + ({-# LINE 807 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIsync_steps + {-# LINE 8135 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1337, column 38) + _lhsOuses = + ({-# LINE 1337 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIuses + {-# LINE 8141 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1588, column 68) + _lhsOvisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIvisitKinds + {-# LINE 8147 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (up) + _lhsOisLast = + ({-# LINE 870 "./src-ag/ExecutionPlan2Hs.ag" #-} + _stepsIisLast + {-# LINE 8153 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallFromToStates = + ({-# LINE 1544 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallFromToStates + {-# LINE 8159 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 8165 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallVisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallVisitKinds + {-# LINE 8171 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallchildvisit = + ({-# LINE 1186 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 8177 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOavisitdefs = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 8183 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOavisituses = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 8189 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOchildTypes = + ({-# LINE 1561 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildTypes + {-# LINE 8195 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOchildintros = + ({-# LINE 890 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 8201 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOfmtMode = + ({-# LINE 816 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIfmtMode + {-# LINE 8207 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOkind = + ({-# LINE 766 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIkind + {-# LINE 8213 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOmrules = + ({-# LINE 773 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 8219 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 8225 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOprevMaxSimRefs = + ({-# LINE 862 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIprevMaxSimRefs + {-# LINE 8231 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOruledefs = + ({-# LINE 1304 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 8237 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOruleuses = + ({-# LINE 1305 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 8243 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (from local) + _stepsOuseParallel = + ({-# LINE 878 "./src-ag/ExecutionPlan2Hs.ag" #-} + _useParallel + {-# LINE 8249 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _stepsIdefs,_stepsIerrors,_stepsIindex,_stepsIisLast,_stepsIlazyIntras,_stepsIprevMaxSimRefs,_stepsIruleKinds,_stepsIruleUsage,_stepsIsem_steps,_stepsIsize,_stepsIsync_steps,_stepsIuses,_stepsIvisitKinds) = + steps_ _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfmtMode _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOprevMaxSimRefs _stepsOruledefs _stepsOruleuses _stepsOuseParallel + in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds)))) +sem_VisitStep_ChildIntro :: Identifier -> + T_VisitStep +sem_VisitStep_ChildIntro child_ = + (T_VisitStep (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIfmtMode + _lhsIindex + _lhsIisLast + _lhsIkind + _lhsImrules + _lhsIoptions + _lhsIprevMaxSimRefs + _lhsIruledefs + _lhsIruleuses + _lhsIuseParallel -> + (let _lhsOerrors :: (Seq Error) + _lhsOsem_steps :: PP_Doc + _lhsOdefs :: (Set String) + _lhsOuses :: (Map String (Maybe NonLocalAttr)) + _lhsOlazyIntras :: (Set String) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOsync_steps :: PP_Doc + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOindex :: Int + _lhsOisLast :: Bool + _lhsOprevMaxSimRefs :: Int + -- "./src-ag/ExecutionPlan2Hs.ag"(line 780, column 16) + _attachItf = + ({-# LINE 780 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.findWithDefault (error $ "Child " ++ show child_ ++ " not found") child_ _lhsIchildintros + {-# LINE 8291 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 781, column 16) + (_lhsOerrors,_lhsOsem_steps,_lhsOdefs,_lhsOuses) = + ({-# LINE 781 "./src-ag/ExecutionPlan2Hs.ag" #-} + case _attachItf _lhsIkind _lhsIfmtMode of + Left e -> (Seq.singleton e, empty, Set.empty, Map.empty) + Right (code, defs, uses) -> (Seq.empty, code, defs, uses) + {-# LINE 8299 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1352, column 57) + _lhsOlazyIntras = + ({-# LINE 1352 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 8305 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1252, column 56) + _lhsOruleKinds = + ({-# LINE 1252 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 8311 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1240, column 56) + _lhsOruleUsage = + ({-# LINE 1240 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 8317 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 807, column 44) + _lhsOsync_steps = + ({-# LINE 807 "./src-ag/ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 8323 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1588, column 68) + _lhsOvisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + mempty + {-# LINE 8329 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (chain) + _lhsOindex = + ({-# LINE 851 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIindex + {-# LINE 8335 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (chain) + _lhsOisLast = + ({-# LINE 870 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIisLast + {-# LINE 8341 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (chain) + _lhsOprevMaxSimRefs = + ({-# LINE 862 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIprevMaxSimRefs + {-# LINE 8347 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds)))) +-- VisitSteps -------------------------------------------------- +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInitStates : Map NontermIdent Int + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + childTypes : Map Identifier Type + childintros : Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) + fmtMode : FormatMode + kind : VisitKind + mrules : Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc) + options : Options + ruledefs : Map Identifier (Set String) + ruleuses : Map Identifier (Map String (Maybe NonLocalAttr)) + useParallel : Bool + chained attributes: + index : Int + prevMaxSimRefs : Int + synthesized attributes: + defs : Set String + errors : Seq Error + isLast : Bool + lazyIntras : Set String + ruleKinds : Map Identifier (Set VisitKind) + ruleUsage : Map Identifier Int + sem_steps : PP_Doc + size : Int + sync_steps : PP_Doc + uses : Map String (Maybe NonLocalAttr) + visitKinds : Map VisitIdentifier VisitKind + alternatives: + alternative Cons: + child hd : VisitStep + child tl : VisitSteps + alternative Nil: +-} +-- cata +sem_VisitSteps :: VisitSteps -> + T_VisitSteps +sem_VisitSteps list = + (Prelude.foldr sem_VisitSteps_Cons sem_VisitSteps_Nil (Prelude.map sem_VisitStep list)) +-- semantic domain +newtype T_VisitSteps = T_VisitSteps ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Int) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map Identifier Type) -> + (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> + FormatMode -> + Int -> + VisitKind -> + (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> + Options -> + Int -> + (Map Identifier (Set String)) -> + (Map Identifier (Map String (Maybe NonLocalAttr))) -> + Bool -> + ( (Set String),(Seq Error),Int,Bool,(Set String),Int,(Map Identifier (Set VisitKind)),(Map Identifier Int),PP_Doc,Int,PP_Doc,(Map String (Maybe NonLocalAttr)),(Map VisitIdentifier VisitKind))) +data Inh_VisitSteps = Inh_VisitSteps {allFromToStates_Inh_VisitSteps :: (Map VisitIdentifier (Int,Int)),allInitStates_Inh_VisitSteps :: (Map NontermIdent Int),allVisitKinds_Inh_VisitSteps :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_VisitSteps :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),avisitdefs_Inh_VisitSteps :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_VisitSteps :: (Map VisitIdentifier (Set Identifier)),childTypes_Inh_VisitSteps :: (Map Identifier Type),childintros_Inh_VisitSteps :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),fmtMode_Inh_VisitSteps :: FormatMode,index_Inh_VisitSteps :: Int,kind_Inh_VisitSteps :: VisitKind,mrules_Inh_VisitSteps :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),options_Inh_VisitSteps :: Options,prevMaxSimRefs_Inh_VisitSteps :: Int,ruledefs_Inh_VisitSteps :: (Map Identifier (Set String)),ruleuses_Inh_VisitSteps :: (Map Identifier (Map String (Maybe NonLocalAttr))),useParallel_Inh_VisitSteps :: Bool} +data Syn_VisitSteps = Syn_VisitSteps {defs_Syn_VisitSteps :: (Set String),errors_Syn_VisitSteps :: (Seq Error),index_Syn_VisitSteps :: Int,isLast_Syn_VisitSteps :: Bool,lazyIntras_Syn_VisitSteps :: (Set String),prevMaxSimRefs_Syn_VisitSteps :: Int,ruleKinds_Syn_VisitSteps :: (Map Identifier (Set VisitKind)),ruleUsage_Syn_VisitSteps :: (Map Identifier Int),sem_steps_Syn_VisitSteps :: PP_Doc,size_Syn_VisitSteps :: Int,sync_steps_Syn_VisitSteps :: PP_Doc,uses_Syn_VisitSteps :: (Map String (Maybe NonLocalAttr)),visitKinds_Syn_VisitSteps :: (Map VisitIdentifier VisitKind)} +wrap_VisitSteps :: T_VisitSteps -> + Inh_VisitSteps -> + Syn_VisitSteps +wrap_VisitSteps (T_VisitSteps sem) (Inh_VisitSteps _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) = + (let ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsize,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds) = sem _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel + in (Syn_VisitSteps _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsize _lhsOsync_steps _lhsOuses _lhsOvisitKinds)) +sem_VisitSteps_Cons :: T_VisitStep -> + T_VisitSteps -> + T_VisitSteps +sem_VisitSteps_Cons (T_VisitStep hd_) (T_VisitSteps tl_) = + (T_VisitSteps (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIfmtMode + _lhsIindex + _lhsIkind + _lhsImrules + _lhsIoptions + _lhsIprevMaxSimRefs + _lhsIruledefs + _lhsIruleuses + _lhsIuseParallel -> + (let _lhsOsize :: Int + _hdOindex :: Int + _tlOindex :: Int + _lhsOindex :: Int + _lhsOisLast :: Bool + _hdOisLast :: Bool + _lhsOdefs :: (Set String) + _lhsOerrors :: (Seq Error) + _lhsOlazyIntras :: (Set String) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOsem_steps :: PP_Doc + _lhsOsync_steps :: PP_Doc + _lhsOuses :: (Map String (Maybe NonLocalAttr)) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOprevMaxSimRefs :: Int + _hdOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _hdOallInitStates :: (Map NontermIdent Int) + _hdOallVisitKinds :: (Map VisitIdentifier VisitKind) + _hdOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _hdOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _hdOavisituses :: (Map VisitIdentifier (Set Identifier)) + _hdOchildTypes :: (Map Identifier Type) + _hdOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _hdOfmtMode :: FormatMode + _hdOkind :: VisitKind + _hdOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) + _hdOoptions :: Options + _hdOprevMaxSimRefs :: Int + _hdOruledefs :: (Map Identifier (Set String)) + _hdOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _hdOuseParallel :: Bool + _tlOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _tlOallInitStates :: (Map NontermIdent Int) + _tlOallVisitKinds :: (Map VisitIdentifier VisitKind) + _tlOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _tlOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _tlOavisituses :: (Map VisitIdentifier (Set Identifier)) + _tlOchildTypes :: (Map Identifier Type) + _tlOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _tlOfmtMode :: FormatMode + _tlOkind :: VisitKind + _tlOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) + _tlOoptions :: Options + _tlOprevMaxSimRefs :: Int + _tlOruledefs :: (Map Identifier (Set String)) + _tlOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _tlOuseParallel :: Bool + _hdIdefs :: (Set String) + _hdIerrors :: (Seq Error) + _hdIindex :: Int + _hdIisLast :: Bool + _hdIlazyIntras :: (Set String) + _hdIprevMaxSimRefs :: Int + _hdIruleKinds :: (Map Identifier (Set VisitKind)) + _hdIruleUsage :: (Map Identifier Int) + _hdIsem_steps :: PP_Doc + _hdIsync_steps :: PP_Doc + _hdIuses :: (Map String (Maybe NonLocalAttr)) + _hdIvisitKinds :: (Map VisitIdentifier VisitKind) + _tlIdefs :: (Set String) + _tlIerrors :: (Seq Error) + _tlIindex :: Int + _tlIisLast :: Bool + _tlIlazyIntras :: (Set String) + _tlIprevMaxSimRefs :: Int + _tlIruleKinds :: (Map Identifier (Set VisitKind)) + _tlIruleUsage :: (Map Identifier Int) + _tlIsem_steps :: PP_Doc + _tlIsize :: Int + _tlIsync_steps :: PP_Doc + _tlIuses :: (Map String (Maybe NonLocalAttr)) + _tlIvisitKinds :: (Map VisitIdentifier VisitKind) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 848, column 10) + _lhsOsize = + ({-# LINE 848 "./src-ag/ExecutionPlan2Hs.ag" #-} + 1 + _tlIsize + {-# LINE 8520 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 853, column 3) + _hdOindex = + ({-# LINE 853 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIindex + {-# LINE 8526 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 854, column 3) + _tlOindex = + ({-# LINE 854 "./src-ag/ExecutionPlan2Hs.ag" #-} + 1 + _lhsIindex + {-# LINE 8532 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 855, column 3) + _lhsOindex = + ({-# LINE 855 "./src-ag/ExecutionPlan2Hs.ag" #-} + _tlIindex + {-# LINE 8538 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 874, column 11) + _lhsOisLast = + ({-# LINE 874 "./src-ag/ExecutionPlan2Hs.ag" #-} + False + {-# LINE 8544 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 875, column 11) + _hdOisLast = + ({-# LINE 875 "./src-ag/ExecutionPlan2Hs.ag" #-} + _tlIisLast + {-# LINE 8550 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1336, column 38) + _lhsOdefs = + ({-# LINE 1336 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIdefs `Set.union` _tlIdefs + {-# LINE 8556 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 8562 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1352, column 57) + _lhsOlazyIntras = + ({-# LINE 1352 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIlazyIntras `Set.union` _tlIlazyIntras + {-# LINE 8568 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1252, column 56) + _lhsOruleKinds = + ({-# LINE 1252 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIruleKinds `unionWithMappend` _tlIruleKinds + {-# LINE 8574 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1240, column 56) + _lhsOruleUsage = + ({-# LINE 1240 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIruleUsage `unionWithSum` _tlIruleUsage + {-# LINE 8580 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 774, column 43) + _lhsOsem_steps = + ({-# LINE 774 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIsem_steps >-< _tlIsem_steps + {-# LINE 8586 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 807, column 44) + _lhsOsync_steps = + ({-# LINE 807 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIsync_steps >-< _tlIsync_steps + {-# LINE 8592 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1337, column 38) + _lhsOuses = + ({-# LINE 1337 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIuses `Map.union` _tlIuses + {-# LINE 8598 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1588, column 68) + _lhsOvisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIvisitKinds `mappend` _tlIvisitKinds + {-# LINE 8604 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (up) + _lhsOprevMaxSimRefs = + ({-# LINE 862 "./src-ag/ExecutionPlan2Hs.ag" #-} + _tlIprevMaxSimRefs + {-# LINE 8610 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallFromToStates = + ({-# LINE 1544 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallFromToStates + {-# LINE 8616 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 8622 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallVisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallVisitKinds + {-# LINE 8628 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 1186 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 8634 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 8640 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 8646 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOchildTypes = + ({-# LINE 1561 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildTypes + {-# LINE 8652 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOchildintros = + ({-# LINE 890 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 8658 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOfmtMode = + ({-# LINE 816 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIfmtMode + {-# LINE 8664 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOkind = + ({-# LINE 766 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIkind + {-# LINE 8670 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmrules = + ({-# LINE 773 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 8676 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 8682 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOprevMaxSimRefs = + ({-# LINE 862 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIprevMaxSimRefs + {-# LINE 8688 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOruledefs = + ({-# LINE 1304 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 8694 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOruleuses = + ({-# LINE 1305 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 8700 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOuseParallel = + ({-# LINE 878 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIuseParallel + {-# LINE 8706 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallFromToStates = + ({-# LINE 1544 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallFromToStates + {-# LINE 8712 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 8718 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallVisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallVisitKinds + {-# LINE 8724 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 1186 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 8730 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 8736 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 8742 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOchildTypes = + ({-# LINE 1561 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildTypes + {-# LINE 8748 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOchildintros = + ({-# LINE 890 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 8754 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOfmtMode = + ({-# LINE 816 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIfmtMode + {-# LINE 8760 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOkind = + ({-# LINE 766 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIkind + {-# LINE 8766 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmrules = + ({-# LINE 773 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 8772 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 8778 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (chain) + _tlOprevMaxSimRefs = + ({-# LINE 862 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIprevMaxSimRefs + {-# LINE 8784 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOruledefs = + ({-# LINE 1304 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 8790 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOruleuses = + ({-# LINE 1305 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 8796 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOuseParallel = + ({-# LINE 878 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIuseParallel + {-# LINE 8802 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _hdIdefs,_hdIerrors,_hdIindex,_hdIisLast,_hdIlazyIntras,_hdIprevMaxSimRefs,_hdIruleKinds,_hdIruleUsage,_hdIsem_steps,_hdIsync_steps,_hdIuses,_hdIvisitKinds) = + hd_ _hdOallFromToStates _hdOallInitStates _hdOallVisitKinds _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOchildTypes _hdOchildintros _hdOfmtMode _hdOindex _hdOisLast _hdOkind _hdOmrules _hdOoptions _hdOprevMaxSimRefs _hdOruledefs _hdOruleuses _hdOuseParallel + ( _tlIdefs,_tlIerrors,_tlIindex,_tlIisLast,_tlIlazyIntras,_tlIprevMaxSimRefs,_tlIruleKinds,_tlIruleUsage,_tlIsem_steps,_tlIsize,_tlIsync_steps,_tlIuses,_tlIvisitKinds) = + tl_ _tlOallFromToStates _tlOallInitStates _tlOallVisitKinds _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOchildTypes _tlOchildintros _tlOfmtMode _tlOindex _tlOkind _tlOmrules _tlOoptions _tlOprevMaxSimRefs _tlOruledefs _tlOruleuses _tlOuseParallel + in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsize,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds)))) +sem_VisitSteps_Nil :: T_VisitSteps +sem_VisitSteps_Nil = + (T_VisitSteps (\ _lhsIallFromToStates + _lhsIallInitStates + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIfmtMode + _lhsIindex + _lhsIkind + _lhsImrules + _lhsIoptions + _lhsIprevMaxSimRefs + _lhsIruledefs + _lhsIruleuses + _lhsIuseParallel -> + (let _lhsOsize :: Int + _lhsOisLast :: Bool + _lhsOdefs :: (Set String) + _lhsOerrors :: (Seq Error) + _lhsOlazyIntras :: (Set String) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOsem_steps :: PP_Doc + _lhsOsync_steps :: PP_Doc + _lhsOuses :: (Map String (Maybe NonLocalAttr)) + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOindex :: Int + _lhsOprevMaxSimRefs :: Int + -- "./src-ag/ExecutionPlan2Hs.ag"(line 847, column 10) + _lhsOsize = + ({-# LINE 847 "./src-ag/ExecutionPlan2Hs.ag" #-} + 0 + {-# LINE 8845 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- "./src-ag/ExecutionPlan2Hs.ag"(line 873, column 11) + _lhsOisLast = + ({-# LINE 873 "./src-ag/ExecutionPlan2Hs.ag" #-} + True + {-# LINE 8851 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1336, column 38) + _lhsOdefs = + ({-# LINE 1336 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 8857 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + Seq.empty + {-# LINE 8863 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1352, column 57) + _lhsOlazyIntras = + ({-# LINE 1352 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 8869 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1252, column 56) + _lhsOruleKinds = + ({-# LINE 1252 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 8875 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1240, column 56) + _lhsOruleUsage = + ({-# LINE 1240 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 8881 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 774, column 43) + _lhsOsem_steps = + ({-# LINE 774 "./src-ag/ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 8887 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 807, column 44) + _lhsOsync_steps = + ({-# LINE 807 "./src-ag/ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 8893 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1337, column 38) + _lhsOuses = + ({-# LINE 1337 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 8899 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1588, column 68) + _lhsOvisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + mempty + {-# LINE 8905 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (chain) + _lhsOindex = + ({-# LINE 851 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIindex + {-# LINE 8911 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (chain) + _lhsOprevMaxSimRefs = + ({-# LINE 862 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIprevMaxSimRefs + {-# LINE 8917 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOdefs,_lhsOerrors,_lhsOindex,_lhsOisLast,_lhsOlazyIntras,_lhsOprevMaxSimRefs,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_steps,_lhsOsize,_lhsOsync_steps,_lhsOuses,_lhsOvisitKinds)))) +-- Visits ------------------------------------------------------ +{- + visit 0: + inherited attributes: + allFromToStates : Map VisitIdentifier (Int,Int) + allInhmap : Map NontermIdent Attributes + allInitStates : Map NontermIdent Int + allSynmap : Map NontermIdent Attributes + allVisitKinds : Map VisitIdentifier VisitKind + allchildvisit : Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) + allintramap : Map StateIdentifier (Map String (Maybe NonLocalAttr)) + avisitdefs : Map VisitIdentifier (Set Identifier) + avisituses : Map VisitIdentifier (Set Identifier) + childTypes : Map Identifier Type + childintros : Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) + con : ConstructorIdent + inhmap : Attributes + mrules : Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc) + nextVisits : Map StateIdentifier StateCtx + nt : NontermIdent + options : Options + params : [Identifier] + prevVisits : Map StateIdentifier StateCtx + ruledefs : Map Identifier (Set String) + ruleuses : Map Identifier (Map String (Maybe NonLocalAttr)) + synmap : Attributes + terminaldefs : Set String + synthesized attributes: + allvisits : [VisitStateState] + childvisit : Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) + errors : Seq Error + fromToStates : Map VisitIdentifier (Int,Int) + intramap : Map StateIdentifier (Map String (Maybe NonLocalAttr)) + lazyIntras : Set String + ruleKinds : Map Identifier (Set VisitKind) + ruleUsage : Map Identifier Int + sem_visit : [(StateIdentifier,Bool -> PP_Doc)] + t_visits : PP_Doc + visitKinds : Map VisitIdentifier VisitKind + visitdefs : Map VisitIdentifier (Set Identifier) + visituses : Map VisitIdentifier (Set Identifier) + alternatives: + alternative Cons: + child hd : Visit + child tl : Visits + alternative Nil: +-} +-- cata +sem_Visits :: Visits -> + T_Visits +sem_Visits list = + (Prelude.foldr sem_Visits_Cons sem_Visits_Nil (Prelude.map sem_Visit list)) +-- semantic domain +newtype T_Visits = T_Visits ((Map VisitIdentifier (Int,Int)) -> + (Map NontermIdent Attributes) -> + (Map NontermIdent Int) -> + (Map NontermIdent Attributes) -> + (Map VisitIdentifier VisitKind) -> + (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> + (Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map VisitIdentifier (Set Identifier)) -> + (Map Identifier Type) -> + (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> + ConstructorIdent -> + Attributes -> + (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> + (Map StateIdentifier StateCtx) -> + NontermIdent -> + Options -> + ([Identifier]) -> + (Map StateIdentifier StateCtx) -> + (Map Identifier (Set String)) -> + (Map Identifier (Map String (Maybe NonLocalAttr))) -> + Attributes -> + (Set String) -> + ( ([VisitStateState]),(Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),(Seq Error),(Map VisitIdentifier (Int,Int)),(Map StateIdentifier (Map String (Maybe NonLocalAttr))),(Set String),(Map Identifier (Set VisitKind)),(Map Identifier Int),( [(StateIdentifier,Bool -> PP_Doc)] ),PP_Doc,(Map VisitIdentifier VisitKind),(Map VisitIdentifier (Set Identifier)),(Map VisitIdentifier (Set Identifier)))) +data Inh_Visits = Inh_Visits {allFromToStates_Inh_Visits :: (Map VisitIdentifier (Int,Int)),allInhmap_Inh_Visits :: (Map NontermIdent Attributes),allInitStates_Inh_Visits :: (Map NontermIdent Int),allSynmap_Inh_Visits :: (Map NontermIdent Attributes),allVisitKinds_Inh_Visits :: (Map VisitIdentifier VisitKind),allchildvisit_Inh_Visits :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),allintramap_Inh_Visits :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))),avisitdefs_Inh_Visits :: (Map VisitIdentifier (Set Identifier)),avisituses_Inh_Visits :: (Map VisitIdentifier (Set Identifier)),childTypes_Inh_Visits :: (Map Identifier Type),childintros_Inh_Visits :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))),con_Inh_Visits :: ConstructorIdent,inhmap_Inh_Visits :: Attributes,mrules_Inh_Visits :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)),nextVisits_Inh_Visits :: (Map StateIdentifier StateCtx),nt_Inh_Visits :: NontermIdent,options_Inh_Visits :: Options,params_Inh_Visits :: ([Identifier]),prevVisits_Inh_Visits :: (Map StateIdentifier StateCtx),ruledefs_Inh_Visits :: (Map Identifier (Set String)),ruleuses_Inh_Visits :: (Map Identifier (Map String (Maybe NonLocalAttr))),synmap_Inh_Visits :: Attributes,terminaldefs_Inh_Visits :: (Set String)} +data Syn_Visits = Syn_Visits {allvisits_Syn_Visits :: ([VisitStateState]),childvisit_Syn_Visits :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))),errors_Syn_Visits :: (Seq Error),fromToStates_Syn_Visits :: (Map VisitIdentifier (Int,Int)),intramap_Syn_Visits :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))),lazyIntras_Syn_Visits :: (Set String),ruleKinds_Syn_Visits :: (Map Identifier (Set VisitKind)),ruleUsage_Syn_Visits :: (Map Identifier Int),sem_visit_Syn_Visits :: ( [(StateIdentifier,Bool -> PP_Doc)] ),t_visits_Syn_Visits :: PP_Doc,visitKinds_Syn_Visits :: (Map VisitIdentifier VisitKind),visitdefs_Syn_Visits :: (Map VisitIdentifier (Set Identifier)),visituses_Syn_Visits :: (Map VisitIdentifier (Set Identifier))} +wrap_Visits :: T_Visits -> + Inh_Visits -> + Syn_Visits +wrap_Visits (T_Visits sem) (Inh_Visits _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOintramap,_lhsOlazyIntras,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_visit,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs + in (Syn_Visits _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses)) +sem_Visits_Cons :: T_Visit -> + T_Visits -> + T_Visits +sem_Visits_Cons (T_Visit hd_) (T_Visits tl_) = + (T_Visits (\ _lhsIallFromToStates + _lhsIallInhmap + _lhsIallInitStates + _lhsIallSynmap + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIallintramap + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIcon + _lhsIinhmap + _lhsImrules + _lhsInextVisits + _lhsInt + _lhsIoptions + _lhsIparams + _lhsIprevVisits + _lhsIruledefs + _lhsIruleuses + _lhsIsynmap + _lhsIterminaldefs -> + (let _lhsOallvisits :: ([VisitStateState]) + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _lhsOlazyIntras :: (Set String) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOsem_visit :: ( [(StateIdentifier,Bool -> PP_Doc)] ) + _lhsOt_visits :: PP_Doc + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + _hdOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _hdOallInhmap :: (Map NontermIdent Attributes) + _hdOallInitStates :: (Map NontermIdent Int) + _hdOallSynmap :: (Map NontermIdent Attributes) + _hdOallVisitKinds :: (Map VisitIdentifier VisitKind) + _hdOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _hdOallintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _hdOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _hdOavisituses :: (Map VisitIdentifier (Set Identifier)) + _hdOchildTypes :: (Map Identifier Type) + _hdOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _hdOcon :: ConstructorIdent + _hdOinhmap :: Attributes + _hdOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) + _hdOnextVisits :: (Map StateIdentifier StateCtx) + _hdOnt :: NontermIdent + _hdOoptions :: Options + _hdOparams :: ([Identifier]) + _hdOprevVisits :: (Map StateIdentifier StateCtx) + _hdOruledefs :: (Map Identifier (Set String)) + _hdOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _hdOsynmap :: Attributes + _hdOterminaldefs :: (Set String) + _tlOallFromToStates :: (Map VisitIdentifier (Int,Int)) + _tlOallInhmap :: (Map NontermIdent Attributes) + _tlOallInitStates :: (Map NontermIdent Int) + _tlOallSynmap :: (Map NontermIdent Attributes) + _tlOallVisitKinds :: (Map VisitIdentifier VisitKind) + _tlOallchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _tlOallintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _tlOavisitdefs :: (Map VisitIdentifier (Set Identifier)) + _tlOavisituses :: (Map VisitIdentifier (Set Identifier)) + _tlOchildTypes :: (Map Identifier Type) + _tlOchildintros :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) + _tlOcon :: ConstructorIdent + _tlOinhmap :: Attributes + _tlOmrules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) + _tlOnextVisits :: (Map StateIdentifier StateCtx) + _tlOnt :: NontermIdent + _tlOoptions :: Options + _tlOparams :: ([Identifier]) + _tlOprevVisits :: (Map StateIdentifier StateCtx) + _tlOruledefs :: (Map Identifier (Set String)) + _tlOruleuses :: (Map Identifier (Map String (Maybe NonLocalAttr))) + _tlOsynmap :: Attributes + _tlOterminaldefs :: (Set String) + _hdIallvisits :: ( VisitStateState ) + _hdIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _hdIerrors :: (Seq Error) + _hdIfromToStates :: (Map VisitIdentifier (Int,Int)) + _hdIintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _hdIlazyIntras :: (Set String) + _hdIruleKinds :: (Map Identifier (Set VisitKind)) + _hdIruleUsage :: (Map Identifier Int) + _hdIsem_visit :: ( (StateIdentifier,Bool -> PP_Doc) ) + _hdIt_visits :: PP_Doc + _hdIvisitKinds :: (Map VisitIdentifier VisitKind) + _hdIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _hdIvisituses :: (Map VisitIdentifier (Set Identifier)) + _tlIallvisits :: ([VisitStateState]) + _tlIchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _tlIerrors :: (Seq Error) + _tlIfromToStates :: (Map VisitIdentifier (Int,Int)) + _tlIintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _tlIlazyIntras :: (Set String) + _tlIruleKinds :: (Map Identifier (Set VisitKind)) + _tlIruleUsage :: (Map Identifier Int) + _tlIsem_visit :: ( [(StateIdentifier,Bool -> PP_Doc)] ) + _tlIt_visits :: PP_Doc + _tlIvisitKinds :: (Map VisitIdentifier VisitKind) + _tlIvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _tlIvisituses :: (Map VisitIdentifier (Set Identifier)) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 333, column 29) + _lhsOallvisits = + ({-# LINE 333 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIallvisits : _tlIallvisits + {-# LINE 9121 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1184, column 37) + _lhsOchildvisit = + ({-# LINE 1184 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIchildvisit `Map.union` _tlIchildvisit + {-# LINE 9127 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 9133 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1541, column 22) + _lhsOfromToStates = + ({-# LINE 1541 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIfromToStates `mappend` _tlIfromToStates + {-# LINE 9139 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1278, column 34) + _lhsOintramap = + ({-# LINE 1278 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIintramap `uwMapUnion` _tlIintramap + {-# LINE 9145 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1352, column 57) + _lhsOlazyIntras = + ({-# LINE 1352 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIlazyIntras `Set.union` _tlIlazyIntras + {-# LINE 9151 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1252, column 56) + _lhsOruleKinds = + ({-# LINE 1252 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIruleKinds `unionWithMappend` _tlIruleKinds + {-# LINE 9157 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1240, column 56) + _lhsOruleUsage = + ({-# LINE 1240 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIruleUsage `unionWithSum` _tlIruleUsage + {-# LINE 9163 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 703, column 29) + _lhsOsem_visit = + ({-# LINE 703 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIsem_visit : _tlIsem_visit + {-# LINE 9169 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 391, column 59) + _lhsOt_visits = + ({-# LINE 391 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIt_visits >-< _tlIt_visits + {-# LINE 9175 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1588, column 68) + _lhsOvisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIvisitKinds `mappend` _tlIvisitKinds + {-# LINE 9181 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1319, column 36) + _lhsOvisitdefs = + ({-# LINE 1319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIvisitdefs `uwSetUnion` _tlIvisitdefs + {-# LINE 9187 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1320, column 36) + _lhsOvisituses = + ({-# LINE 1320 "./src-ag/ExecutionPlan2Hs.ag" #-} + _hdIvisituses `uwSetUnion` _tlIvisituses + {-# LINE 9193 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallFromToStates = + ({-# LINE 1544 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallFromToStates + {-# LINE 9199 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallInhmap = + ({-# LINE 318 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInhmap + {-# LINE 9205 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 9211 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallSynmap = + ({-# LINE 319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallSynmap + {-# LINE 9217 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallVisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallVisitKinds + {-# LINE 9223 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 1183 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 9229 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallintramap = + ({-# LINE 1277 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallintramap + {-# LINE 9235 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 9241 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 9247 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOchildTypes = + ({-# LINE 1561 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildTypes + {-# LINE 9253 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOchildintros = + ({-# LINE 890 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 9259 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 66 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIcon + {-# LINE 9265 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 316 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 9271 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmrules = + ({-# LINE 773 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 9277 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOnextVisits = + ({-# LINE 1530 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInextVisits + {-# LINE 9283 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 61 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 9289 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 9295 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOparams = + ({-# LINE 73 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIparams + {-# LINE 9301 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOprevVisits = + ({-# LINE 1530 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIprevVisits + {-# LINE 9307 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOruledefs = + ({-# LINE 1304 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 9313 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOruleuses = + ({-# LINE 1305 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 9319 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 317 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 9325 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOterminaldefs = + ({-# LINE 1280 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIterminaldefs + {-# LINE 9331 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallFromToStates = + ({-# LINE 1544 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallFromToStates + {-# LINE 9337 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallInhmap = + ({-# LINE 318 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInhmap + {-# LINE 9343 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallInitStates = + ({-# LINE 1602 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallInitStates + {-# LINE 9349 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallSynmap = + ({-# LINE 319 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallSynmap + {-# LINE 9355 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallVisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallVisitKinds + {-# LINE 9361 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 1183 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 9367 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallintramap = + ({-# LINE 1277 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIallintramap + {-# LINE 9373 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 1329 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 9379 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 1330 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 9385 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOchildTypes = + ({-# LINE 1561 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildTypes + {-# LINE 9391 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOchildintros = + ({-# LINE 890 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 9397 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 66 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIcon + {-# LINE 9403 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 316 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 9409 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmrules = + ({-# LINE 773 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 9415 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOnextVisits = + ({-# LINE 1530 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInextVisits + {-# LINE 9421 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 61 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 9427 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 51 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 9433 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOparams = + ({-# LINE 73 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIparams + {-# LINE 9439 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOprevVisits = + ({-# LINE 1530 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIprevVisits + {-# LINE 9445 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOruledefs = + ({-# LINE 1304 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 9451 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOruleuses = + ({-# LINE 1305 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 9457 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 317 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 9463 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOterminaldefs = + ({-# LINE 1280 "./src-ag/ExecutionPlan2Hs.ag" #-} + _lhsIterminaldefs + {-# LINE 9469 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + ( _hdIallvisits,_hdIchildvisit,_hdIerrors,_hdIfromToStates,_hdIintramap,_hdIlazyIntras,_hdIruleKinds,_hdIruleUsage,_hdIsem_visit,_hdIt_visits,_hdIvisitKinds,_hdIvisitdefs,_hdIvisituses) = + hd_ _hdOallFromToStates _hdOallInhmap _hdOallInitStates _hdOallSynmap _hdOallVisitKinds _hdOallchildvisit _hdOallintramap _hdOavisitdefs _hdOavisituses _hdOchildTypes _hdOchildintros _hdOcon _hdOinhmap _hdOmrules _hdOnextVisits _hdOnt _hdOoptions _hdOparams _hdOprevVisits _hdOruledefs _hdOruleuses _hdOsynmap _hdOterminaldefs + ( _tlIallvisits,_tlIchildvisit,_tlIerrors,_tlIfromToStates,_tlIintramap,_tlIlazyIntras,_tlIruleKinds,_tlIruleUsage,_tlIsem_visit,_tlIt_visits,_tlIvisitKinds,_tlIvisitdefs,_tlIvisituses) = + tl_ _tlOallFromToStates _tlOallInhmap _tlOallInitStates _tlOallSynmap _tlOallVisitKinds _tlOallchildvisit _tlOallintramap _tlOavisitdefs _tlOavisituses _tlOchildTypes _tlOchildintros _tlOcon _tlOinhmap _tlOmrules _tlOnextVisits _tlOnt _tlOoptions _tlOparams _tlOprevVisits _tlOruledefs _tlOruleuses _tlOsynmap _tlOterminaldefs + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOintramap,_lhsOlazyIntras,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_visit,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) +sem_Visits_Nil :: T_Visits +sem_Visits_Nil = + (T_Visits (\ _lhsIallFromToStates + _lhsIallInhmap + _lhsIallInitStates + _lhsIallSynmap + _lhsIallVisitKinds + _lhsIallchildvisit + _lhsIallintramap + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildTypes + _lhsIchildintros + _lhsIcon + _lhsIinhmap + _lhsImrules + _lhsInextVisits + _lhsInt + _lhsIoptions + _lhsIparams + _lhsIprevVisits + _lhsIruledefs + _lhsIruleuses + _lhsIsynmap + _lhsIterminaldefs -> + (let _lhsOallvisits :: ([VisitStateState]) + _lhsOchildvisit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) + _lhsOerrors :: (Seq Error) + _lhsOfromToStates :: (Map VisitIdentifier (Int,Int)) + _lhsOintramap :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))) + _lhsOlazyIntras :: (Set String) + _lhsOruleKinds :: (Map Identifier (Set VisitKind)) + _lhsOruleUsage :: (Map Identifier Int) + _lhsOsem_visit :: ( [(StateIdentifier,Bool -> PP_Doc)] ) + _lhsOt_visits :: PP_Doc + _lhsOvisitKinds :: (Map VisitIdentifier VisitKind) + _lhsOvisitdefs :: (Map VisitIdentifier (Set Identifier)) + _lhsOvisituses :: (Map VisitIdentifier (Set Identifier)) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 333, column 29) + _lhsOallvisits = + ({-# LINE 333 "./src-ag/ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 9518 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1184, column 37) + _lhsOchildvisit = + ({-# LINE 1184 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 9524 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1626, column 132) + _lhsOerrors = + ({-# LINE 1626 "./src-ag/ExecutionPlan2Hs.ag" #-} + Seq.empty + {-# LINE 9530 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1541, column 22) + _lhsOfromToStates = + ({-# LINE 1541 "./src-ag/ExecutionPlan2Hs.ag" #-} + mempty + {-# LINE 9536 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1278, column 34) + _lhsOintramap = + ({-# LINE 1278 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 9542 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1352, column 57) + _lhsOlazyIntras = + ({-# LINE 1352 "./src-ag/ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 9548 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1252, column 56) + _lhsOruleKinds = + ({-# LINE 1252 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 9554 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1240, column 56) + _lhsOruleUsage = + ({-# LINE 1240 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 9560 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 703, column 29) + _lhsOsem_visit = + ({-# LINE 703 "./src-ag/ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 9566 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 391, column 59) + _lhsOt_visits = + ({-# LINE 391 "./src-ag/ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 9572 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1588, column 68) + _lhsOvisitKinds = + ({-# LINE 1588 "./src-ag/ExecutionPlan2Hs.ag" #-} + mempty + {-# LINE 9578 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1319, column 36) + _lhsOvisitdefs = + ({-# LINE 1319 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 9584 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + -- use rule "./src-ag/ExecutionPlan2Hs.ag"(line 1320, column 36) + _lhsOvisituses = + ({-# LINE 1320 "./src-ag/ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 9590 "dist/build/ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOerrors,_lhsOfromToStates,_lhsOintramap,_lhsOlazyIntras,_lhsOruleKinds,_lhsOruleUsage,_lhsOsem_visit,_lhsOt_visits,_lhsOvisitKinds,_lhsOvisitdefs,_lhsOvisituses)))) diff --git a/dist/build/Expression.hs b/dist/build/Expression.hs new file mode 100644 --- /dev/null +++ b/dist/build/Expression.hs @@ -0,0 +1,17 @@ + + +-- UUAGC 0.9.42.0 (src-ag/Expression.ag) +module Expression where +{-# LINE 2 "./src-ag/Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 10 "dist/build/Expression.hs" #-} +-- Expression -------------------------------------------------- +{- + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} +-} +data Expression = Expression (Pos) (([HsToken])) diff --git a/dist/build/GenerateCode.hs b/dist/build/GenerateCode.hs new file mode 100644 --- /dev/null +++ b/dist/build/GenerateCode.hs @@ -0,0 +1,8044 @@ + + +-- UUAGC 0.9.42.0 (src-ag/GenerateCode.ag) +module GenerateCode where +{-# LINE 9 "./src-ag/GenerateCode.ag" #-} + +import CommonTypes +import SequentialTypes +import Code hiding (Type) +import qualified Code +import Options +import CodeSyntax +import ErrorMessages +import GrammarInfo +import DeclBlocks + +import qualified Data.Map as Map +import Data.Map(Map) +import qualified Data.Set as Set +import Data.Set(Set) +import qualified Data.Sequence as Seq +import Data.Sequence(Seq) +import UU.Scanner.Position +import TokenDef +import HsToken +import HsTokenScanner + +import Data.List(partition,intersperse,intersect,(\\)) +import Data.Maybe(fromJust,isJust) + +import Debug.Trace +{-# LINE 33 "dist/build/GenerateCode.hs" #-} + +{-# LINE 2 "./src-ag/CodeSyntax.ag" #-} + +import Patterns +import CommonTypes +import Data.Map(Map) +import Data.Set(Set) +{-# LINE 41 "dist/build/GenerateCode.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 48 "dist/build/GenerateCode.hs" #-} + +{-# LINE 2 "./src-ag/DeclBlocks.ag" #-} + +import Code (Decl,Expr) +{-# LINE 53 "dist/build/GenerateCode.hs" #-} +{-# LINE 107 "./src-ag/GenerateCode.ag" #-} + +-- remove possible @v references in the types of a data type. +cleanupArg :: String -> String +cleanupArg s + = case idEvalType (SimpleType s) of + SimpleType s' -> s' +{-# LINE 61 "dist/build/GenerateCode.hs" #-} + +{-# LINE 122 "./src-ag/GenerateCode.ag" #-} + +appContext :: ContextMap -> NontermIdent -> Code.Type -> Code.Type +appContext mp nt tp + = maybe tp (\ctx -> CtxApp (map (\(n,ns) -> (getName n, ns)) ctx) tp) $ Map.lookup nt mp + +appQuant :: QuantMap -> NontermIdent -> Code.Type -> Code.Type +appQuant mp nt tp + = foldr QuantApp tp $ Map.findWithDefault [] nt mp +{-# LINE 72 "dist/build/GenerateCode.hs" #-} + +{-# LINE 247 "./src-ag/GenerateCode.ag" #-} + +mkDecl True lhs rhs _ _ = Bind lhs rhs +mkDecl False lhs rhs s1 s2 = Decl lhs rhs s1 s2 + +unwrapSem :: Bool -> NontermIdent -> Expr -> Expr +unwrapSem False _ e = e +unwrapSem True nm e = Case e alts + where alts = [CaseAlt left right] + left = Fun (typeName nm 0) [SimpleExpr "x"] + right = SimpleExpr "x" +{-# LINE 85 "dist/build/GenerateCode.hs" #-} + +{-# LINE 537 "./src-ag/GenerateCode.ag" #-} + +mkLambdaArg :: String -> Maybe Code.Type -> Expr +mkLambdaArg nm Nothing = SimpleExpr nm +mkLambdaArg nm (Just tp) = TypedExpr (SimpleExpr nm) tp + +mkLambda :: Exprs -> Expr -> Expr +mkLambda [] e = e +mkLambda xs e = Lambda xs e + +mkSemFun :: Identifier -> Int -> Exprs -> Expr -> Expr +mkSemFun nt nr xs e = SemFun (typeName nt nr) xs e + +typeAppStrs nm params = TypeApp (SimpleType nm) (map SimpleType params) + +isHigherOrder :: ChildKind -> Bool +isHigherOrder ChildAttr = True +isHigherOrder _ = False + +pickOrigType :: (Identifier, Type, ChildKind) -> (Identifier, Type, ChildKind) +pickOrigType (nm, _, virt@(ChildReplace x)) = (nm, x, virt) +pickOrigType x = x +{-# LINE 109 "dist/build/GenerateCode.hs" #-} + +{-# LINE 633 "./src-ag/GenerateCode.ag" #-} + +mkPartitionedFunction :: String -> Bool -> [Decl] -> [String] -> DeclBlocks -> ([Decl], Expr) +mkPartitionedFunction prefix optCase nextVisitDecls lastExprVars cpsTree + = let inh = Inh_DeclBlocksRoot { prefix_Inh_DeclBlocksRoot = prefix + , optCase_Inh_DeclBlocksRoot = optCase + , nextVisitDecls_Inh_DeclBlocksRoot = nextVisitDecls + , lastExprVars_Inh_DeclBlocksRoot = lastExprVars + } + sem = sem_DeclBlocksRoot (DeclBlocksRoot cpsTree) + syn = wrap_DeclBlocksRoot sem inh + in (lambdas_Syn_DeclBlocksRoot syn, firstCall_Syn_DeclBlocksRoot syn) +{-# LINE 123 "dist/build/GenerateCode.hs" #-} + +{-# LINE 683 "./src-ag/GenerateCode.ag" #-} + +freevars :: [String] -> [Decl] -> [String] +freevars additional decls + = Set.toList (allused `Set.difference` alldefined) + where + allused = Set.unions (Set.fromList additional : map usedvars decls) + alldefined = Set.unions (map definedvars decls) + + usedvars (Decl _ _ _ uses) = uses + usedvars _ = Set.empty + + definedvars (Decl _ _ defs _) = defs + definedvars _ = Set.empty + +mkBlockLambda :: Bool -> String -> [String] -> [Decl] -> Expr -> Decl +mkBlockLambda optCase name args decls expr + = Decl lhs rhs Set.empty Set.empty + where + lhs = Fun name (map SimpleExpr args) + rhs = mkLet optCase decls expr +{-# LINE 146 "dist/build/GenerateCode.hs" #-} + +{-# LINE 761 "./src-ag/GenerateCode.ag" #-} + +typeToCodeType :: Maybe NontermIdent -> [String] -> Type -> Code.Type +typeToCodeType mbNt params tp + = case tp of + NT nt tps defor -> NontermType (getName nt) tps defor + Haskell t -> SimpleType t + +evalType :: (String -> String) -> Code.Type -> Code.Type +evalType replf t + = chase t + where + chase t + = case t of + Arr l r -> Arr (chase l) (chase r) + TypeApp f as -> TypeApp (chase f) (map chase as) + TupleType tps -> TupleType (map chase tps) + UnboxedTupleType tps -> UnboxedTupleType (map chase tps) + Code.List tp -> Code.List (chase tp) + SimpleType txt -> let tks = lexTokens (initPos txt) txt + tks' = map replaceTok tks + txt' = unlines . showTokens . tokensToStrings $ tks' + in SimpleType txt' + TMaybe m -> TMaybe (chase m) + TEither l r -> TEither (chase l) (chase r) + TMap k v -> TMap (chase k) (chase v) + TIntMap v -> TIntMap (chase v) + _ -> t + + replaceTok t + = case t of + AGLocal v p _ -> HsToken (replf $ getName v) p + _ -> t + +idEvalType :: Code.Type -> Code.Type +idEvalType = evalType id +{-# LINE 184 "dist/build/GenerateCode.hs" #-} + +{-# LINE 885 "./src-ag/GenerateCode.ag" #-} + +-- for a virtual child that already existed as a child, returns +isFirstOrder :: ChildKind -> Type -> Maybe Type +isFirstOrder ChildSyntax tp = Just tp +isFirstOrder ChildAttr _ = Nothing +isFirstOrder (ChildReplace tp) _ = Just tp +{-# LINE 193 "dist/build/GenerateCode.hs" #-} + +{-# LINE 906 "./src-ag/GenerateCode.ag" #-} + +makeLocalComment :: Int -> String -> Identifier -> Maybe Type -> String +makeLocalComment width what name tp = let x = getName name + y = maybe "_" (\t -> case t of (NT nt tps _) -> getName nt ++ " " ++ unwords tps; Haskell t -> '{':t++"}") tp + in ( what ++ " " ++ x ++ replicate ((width - length x) `max` 0) ' ' ++ " : " ++ y ) + +{-# LINE 202 "dist/build/GenerateCode.hs" #-} + +{-# LINE 937 "./src-ag/GenerateCode.ag" #-} + +-- Lets or nested Cases? +-- or even a do-expression? + +data DeclsType = DeclsLet | DeclsCase | DeclsDo + +mkDecls :: DeclsType -> Decls -> Expr -> Expr +mkDecls DeclsLet = mkLet False +mkDecls DeclsCase = mkLet True +mkDecls DeclsDo = \decls -> Do (map toBind decls) + where toBind (Decl lhs rhs _ _) = BindLet lhs rhs + toBind d = d + +mkLet :: Bool -> Decls -> Expr -> Expr +mkLet False decls body = Let decls body +mkLet True decls body = foldr oneCase body decls + +oneCase :: Decl -> Expr -> Expr +oneCase (Decl left rhs _ _) exp = Case rhs [CaseAlt left exp] +oneCase (Resume _ nt left rhs) exp = ResumeExpr nt rhs left exp +oneCase _ exp = exp + +-- Gives the name of the visit function +funname field 0 = show field ++ "_" +funname field nr = show field ++ "_" ++ show nr + +-- Gives the name of a semantic function +seqSemname :: String -> NontermIdent -> ConstructorIdent -> Int -> String +seqSemname pre nt con 0 = semname pre nt con +seqSemname pre nt con nr = semname pre nt con ++ "_" ++ show nr + +-- Gives the name of a type +typeName :: NontermIdent -> Int -> String +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 +{-# LINE 248 "dist/build/GenerateCode.hs" #-} + +{-# LINE 1026 "./src-ag/GenerateCode.ag" #-} + +toNamedType :: Bool -> NontermIdent -> ConstructorIdent -> Identifier -> Code.Type -> Code.NamedType +toNamedType genStrict nt con nm tp + = Code.Named genStrict strNm tp + where strNm = recordFieldname nt con nm +{-# LINE 256 "dist/build/GenerateCode.hs" #-} +-- CGrammar ---------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + errors : Seq Error + output : Program + alternatives: + alternative CGrammar: + child typeSyns : {TypeSyns} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : CNonterminals + child pragmas : {PragmaMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Set Identifier))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))} + child multivisit : {Bool} + visit 0: + local options : _ + local aroundMap : _ + local mergeMap : _ + local unfoldSemDom : _ +-} +-- cata +sem_CGrammar :: CGrammar -> + T_CGrammar +sem_CGrammar (CGrammar _typeSyns _derivings _wrappers _nonts _pragmas _paramMap _contextMap _quantMap _aroundsMap _mergeMap _multivisit) = + (sem_CGrammar_CGrammar _typeSyns _derivings _wrappers (sem_CNonterminals _nonts) _pragmas _paramMap _contextMap _quantMap _aroundsMap _mergeMap _multivisit) +-- 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)} +wrap_CGrammar :: T_CGrammar -> + Inh_CGrammar -> + Syn_CGrammar +wrap_CGrammar (T_CGrammar sem) (Inh_CGrammar _lhsIoptions) = + (let ( _lhsOerrors,_lhsOoutput) = sem _lhsIoptions + in (Syn_CGrammar _lhsOerrors _lhsOoutput)) +sem_CGrammar_CGrammar :: TypeSyns -> + Derivings -> + (Set NontermIdent) -> + T_CNonterminals -> + PragmaMap -> + ParamMap -> + ContextMap -> + QuantMap -> + (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> + Bool -> + T_CGrammar +sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ (T_CNonterminals nonts_) pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ = + (T_CGrammar (\ _lhsIoptions -> + (let _nontsOo_sig :: Bool + _nontsOo_cata :: Bool + _nontsOo_sem :: Bool + _nontsOo_newtypes :: Bool + _nontsOo_unbox :: Bool + _nontsOo_case :: Bool + _nontsOo_pretty :: Bool + _nontsOo_rename :: Bool + _nontsOo_strictwrap :: Bool + _nontsOo_splitsems :: Bool + _nontsOo_data :: (Maybe Bool) + _nontsOprefix :: String + _nontsOo_traces :: Bool + _nontsOo_costcentre :: Bool + _nontsOo_linePragmas :: Bool + _nontsOo_monadic :: Bool + _nontsOallPragmas :: PragmaMap + _nontsOparamMap :: ParamMap + _nontsOcontextMap :: ContextMap + _nontsOquantMap :: QuantMap + _nontsOallNts :: (Set NontermIdent) + _nontsOwith_sig :: Bool + _lhsOerrors :: (Seq Error) + _lhsOoutput :: Program + _nontsOtypeSyns :: TypeSyns + _nontsOderivings :: Derivings + _nontsOwrappers :: (Set NontermIdent) + _nontsOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Set Identifier))) + _nontsOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) + _nontsOoptions :: Options + _nontsOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _nontsIchunks :: Chunks + _nontsIgathNts :: (Set NontermIdent) + _nontsIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOo_sig = + ({-# LINE 53 "./src-ag/GenerateCode.ag" #-} + typeSigs _lhsIoptions + {-# LINE 352 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOo_cata = + ({-# LINE 54 "./src-ag/GenerateCode.ag" #-} + folds _lhsIoptions + {-# LINE 358 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOo_sem = + ({-# LINE 55 "./src-ag/GenerateCode.ag" #-} + semfuns _lhsIoptions + {-# LINE 364 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOo_newtypes = + ({-# LINE 56 "./src-ag/GenerateCode.ag" #-} + newtypes _lhsIoptions + {-# LINE 370 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOo_unbox = + ({-# LINE 57 "./src-ag/GenerateCode.ag" #-} + unbox _lhsIoptions + {-# LINE 376 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOo_case = + ({-# LINE 58 "./src-ag/GenerateCode.ag" #-} + cases _lhsIoptions + {-# LINE 382 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOo_pretty = + ({-# LINE 59 "./src-ag/GenerateCode.ag" #-} + attrInfo _lhsIoptions + {-# LINE 388 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOo_rename = + ({-# LINE 60 "./src-ag/GenerateCode.ag" #-} + rename _lhsIoptions + {-# LINE 394 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOo_strictwrap = + ({-# LINE 61 "./src-ag/GenerateCode.ag" #-} + strictWrap _lhsIoptions + {-# LINE 400 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOo_splitsems = + ({-# LINE 62 "./src-ag/GenerateCode.ag" #-} + splitSems _lhsIoptions + {-# LINE 406 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOo_data = + ({-# LINE 63 "./src-ag/GenerateCode.ag" #-} + if dataTypes _lhsIoptions then Just (strictData _lhsIoptions) else Nothing + {-# LINE 412 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOprefix = + ({-# LINE 64 "./src-ag/GenerateCode.ag" #-} + prefix _lhsIoptions + {-# LINE 418 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOo_traces = + ({-# LINE 65 "./src-ag/GenerateCode.ag" #-} + genTraces _lhsIoptions + {-# LINE 424 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOo_costcentre = + ({-# LINE 66 "./src-ag/GenerateCode.ag" #-} + genCostCentres _lhsIoptions + {-# LINE 430 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOo_linePragmas = + ({-# LINE 67 "./src-ag/GenerateCode.ag" #-} + genLinePragmas _lhsIoptions + {-# LINE 436 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 53, column 17) + _nontsOo_monadic = + ({-# LINE 68 "./src-ag/GenerateCode.ag" #-} + monadic _lhsIoptions + {-# LINE 442 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 71, column 3) + _options = + ({-# LINE 71 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions { breadthFirst = breadthFirst _lhsIoptions && visit _lhsIoptions && cases _lhsIoptions && multivisit_ } + {-# LINE 448 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 76, column 15) + _nontsOallPragmas = + ({-# LINE 76 "./src-ag/GenerateCode.ag" #-} + pragmas_ + {-# LINE 454 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 98, column 14) + _nontsOparamMap = + ({-# LINE 98 "./src-ag/GenerateCode.ag" #-} + paramMap_ + {-# LINE 460 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 119, column 7) + _nontsOcontextMap = + ({-# LINE 119 "./src-ag/GenerateCode.ag" #-} + contextMap_ + {-# LINE 466 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 120, column 7) + _nontsOquantMap = + ({-# LINE 120 "./src-ag/GenerateCode.ag" #-} + quantMap_ + {-# LINE 472 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 136, column 7) + _nontsOallNts = + ({-# LINE 136 "./src-ag/GenerateCode.ag" #-} + _nontsIgathNts + {-# LINE 478 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 582, column 34) + _aroundMap = + ({-# LINE 582 "./src-ag/GenerateCode.ag" #-} + aroundsMap_ + {-# LINE 484 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 598, column 34) + _mergeMap = + ({-# LINE 598 "./src-ag/GenerateCode.ag" #-} + mergeMap_ + {-# LINE 490 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 754, column 7) + _unfoldSemDom = + ({-# LINE 754 "./src-ag/GenerateCode.ag" #-} + \nt nr repl -> + 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 + in evalType replace tp + {-# LINE 500 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 854, column 14) + _nontsOwith_sig = + ({-# LINE 854 "./src-ag/GenerateCode.ag" #-} + typeSigs _lhsIoptions + {-# LINE 506 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 857, column 15) + _lhsOerrors = + ({-# LINE 857 "./src-ag/GenerateCode.ag" #-} + Seq.empty + {-# LINE 512 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 923, column 17) + _lhsOoutput = + ({-# LINE 923 "./src-ag/GenerateCode.ag" #-} + Program _nontsIchunks multivisit_ + {-# LINE 518 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 990, column 14) + _nontsOtypeSyns = + ({-# LINE 990 "./src-ag/GenerateCode.ag" #-} + typeSyns_ + {-# LINE 524 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 990, column 14) + _nontsOderivings = + ({-# LINE 991 "./src-ag/GenerateCode.ag" #-} + derivings_ + {-# LINE 530 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 990, column 14) + _nontsOwrappers = + ({-# LINE 992 "./src-ag/GenerateCode.ag" #-} + wrappers_ + {-# LINE 536 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _nontsOaroundMap = + ({-# LINE 575 "./src-ag/GenerateCode.ag" #-} + _aroundMap + {-# LINE 542 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _nontsOmergeMap = + ({-# LINE 591 "./src-ag/GenerateCode.ag" #-} + _mergeMap + {-# LINE 548 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _nontsOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _options + {-# LINE 554 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _nontsOunfoldSemDom = + ({-# LINE 750 "./src-ag/GenerateCode.ag" #-} + _unfoldSemDom + {-# LINE 560 "dist/build/GenerateCode.hs" #-} + ) + ( _nontsIchunks,_nontsIgathNts,_nontsIsemDomUnfoldGath) = + nonts_ _nontsOallNts _nontsOallPragmas _nontsOaroundMap _nontsOcontextMap _nontsOderivings _nontsOmergeMap _nontsOo_case _nontsOo_cata _nontsOo_costcentre _nontsOo_data _nontsOo_linePragmas _nontsOo_monadic _nontsOo_newtypes _nontsOo_pretty _nontsOo_rename _nontsOo_sem _nontsOo_sig _nontsOo_splitsems _nontsOo_strictwrap _nontsOo_traces _nontsOo_unbox _nontsOoptions _nontsOparamMap _nontsOprefix _nontsOquantMap _nontsOtypeSyns _nontsOunfoldSemDom _nontsOwith_sig _nontsOwrappers + in ( _lhsOerrors,_lhsOoutput)))) +-- CInterface -------------------------------------------------- +{- + visit 0: + inherited attributes: + inh : Attributes + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramMap : ParamMap + prefix : String + syn : Attributes + synthesized attributes: + comments : [String] + semDom : [Decl] + semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type) + wrapDecls : Decls + alternatives: + alternative CInterface: + child seg : CSegments +-} +-- cata +sem_CInterface :: CInterface -> + T_CInterface +sem_CInterface (CInterface _seg) = + (sem_CInterface_CInterface (sem_CSegments _seg)) +-- semantic domain +newtype T_CInterface = T_CInterface (Attributes -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + ParamMap -> + 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_monadic_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),options_Inh_CInterface :: !(Options),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 -> + Inh_CInterface -> + Syn_CInterface +wrap_CInterface (T_CInterface sem) (Inh_CInterface _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn) = + (let ( _lhsOcomments,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls) = sem _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn + in (Syn_CInterface _lhsOcomments _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls)) +sem_CInterface_CInterface :: T_CSegments -> + T_CInterface +sem_CInterface_CInterface (T_CSegments seg_) = + (T_CInterface (\ _lhsIinh + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIsyn -> + (let _segOnr :: Int + _lhsOsemDom :: ([Decl]) + _lhsOcomments :: ([String]) + _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _lhsOwrapDecls :: Decls + _segOinh :: Attributes + _segOnt :: NontermIdent + _segOo_case :: Bool + _segOo_cata :: Bool + _segOo_costcentre :: Bool + _segOo_data :: (Maybe Bool) + _segOo_linePragmas :: Bool + _segOo_monadic :: Bool + _segOo_newtypes :: Bool + _segOo_pretty :: Bool + _segOo_rename :: Bool + _segOo_sem :: Bool + _segOo_sig :: Bool + _segOo_splitsems :: Bool + _segOo_strictwrap :: Bool + _segOo_traces :: Bool + _segOo_unbox :: Bool + _segOoptions :: Options + _segOparamMap :: ParamMap + _segOprefix :: String + _segOsyn :: Attributes + _segIcomments :: ([String]) + _segIisNil :: Bool + _segIsemDom :: ([Decl]) + _segIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _segIwrapDecls :: Decls + -- "./src-ag/GenerateCode.ag"(line 284, column 17) + _segOnr = + ({-# LINE 284 "./src-ag/GenerateCode.ag" #-} + 0 + {-# LINE 694 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 712, column 18) + _lhsOsemDom = + ({-# LINE 712 "./src-ag/GenerateCode.ag" #-} + Comment "semantic domain" : _segIsemDom + {-# LINE 700 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 868, column 52) + _lhsOcomments = + ({-# LINE 868 "./src-ag/GenerateCode.ag" #-} + _segIcomments + {-# LINE 706 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 744, column 86) + _lhsOsemDomUnfoldGath = + ({-# LINE 744 "./src-ag/GenerateCode.ag" #-} + _segIsemDomUnfoldGath + {-# LINE 712 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 829, column 52) + _lhsOwrapDecls = + ({-# LINE 829 "./src-ag/GenerateCode.ag" #-} + _segIwrapDecls + {-# LINE 718 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOinh = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIinh + {-# LINE 724 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOnt = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsInt + {-# LINE 730 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 736 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 742 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 748 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 754 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 760 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 766 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 772 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 778 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 784 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 790 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 796 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 802 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 808 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 814 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 820 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 826 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 832 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 838 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _segOsyn = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 844 "dist/build/GenerateCode.hs" #-} + ) + ( _segIcomments,_segIisNil,_segIsemDom,_segIsemDomUnfoldGath,_segIwrapDecls) = + seg_ _segOinh _segOnr _segOnt _segOo_case _segOo_cata _segOo_costcentre _segOo_data _segOo_linePragmas _segOo_monadic _segOo_newtypes _segOo_pretty _segOo_rename _segOo_sem _segOo_sig _segOo_splitsems _segOo_strictwrap _segOo_traces _segOo_unbox _segOoptions _segOparamMap _segOprefix _segOsyn + in ( _lhsOcomments,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls)))) +-- CNonterminal ------------------------------------------------ +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + allPragmas : PragmaMap + aroundMap : Map NontermIdent (Map ConstructorIdent (Set Identifier)) + contextMap : ContextMap + derivings : Derivings + mergeMap : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramMap : ParamMap + prefix : String + quantMap : QuantMap + typeSyns : TypeSyns + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + with_sig : Bool + wrappers : Set NontermIdent + synthesized attributes: + chunks : Chunks + gathNts : Set NontermIdent + semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type) + alternatives: + alternative CNonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : CProductions + child inter : CInterface + visit 0: + local aroundMap : _ + local mergeMap : _ + local semWrapper : _ + local comment : _ + local dataDef : _ + local genCata : _ + local cataFun : _ +-} +-- cata +sem_CNonterminal :: CNonterminal -> + T_CNonterminal +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 ((Set NontermIdent) -> + PragmaMap -> + (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> + ContextMap -> + Derivings -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + ParamMap -> + String -> + QuantMap -> + TypeSyns -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + Bool -> + (Set NontermIdent) -> + ( Chunks,(Set NontermIdent),(Map (NontermIdent, Int) ([String], Code.Type)))) +data Inh_CNonterminal = Inh_CNonterminal {allNts_Inh_CNonterminal :: !((Set NontermIdent)),allPragmas_Inh_CNonterminal :: !(PragmaMap),aroundMap_Inh_CNonterminal :: !((Map NontermIdent (Map ConstructorIdent (Set Identifier)))),contextMap_Inh_CNonterminal :: !(ContextMap),derivings_Inh_CNonterminal :: !(Derivings),mergeMap_Inh_CNonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))))),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_monadic_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),options_Inh_CNonterminal :: !(Options),paramMap_Inh_CNonterminal :: !(ParamMap),prefix_Inh_CNonterminal :: !(String),quantMap_Inh_CNonterminal :: !(QuantMap),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 {chunks_Syn_CNonterminal :: !(Chunks),gathNts_Syn_CNonterminal :: !((Set NontermIdent)),semDomUnfoldGath_Syn_CNonterminal :: !((Map (NontermIdent, Int) ([String], Code.Type)))} +wrap_CNonterminal :: T_CNonterminal -> + Inh_CNonterminal -> + Syn_CNonterminal +wrap_CNonterminal (T_CNonterminal sem) (Inh_CNonterminal _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIderivings _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) = + (let ( _lhsOchunks,_lhsOgathNts,_lhsOsemDomUnfoldGath) = sem _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIderivings _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers + in (Syn_CNonterminal _lhsOchunks _lhsOgathNts _lhsOsemDomUnfoldGath)) +sem_CNonterminal_CNonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_CProductions -> + T_CInterface -> + T_CNonterminal +sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ (T_CProductions prods_) (T_CInterface inter_) = + (T_CNonterminal (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIcontextMap + _lhsIderivings + _lhsImergeMap + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsItypeSyns + _lhsIunfoldSemDom + _lhsIwith_sig + _lhsIwrappers -> + (let _interOinh :: Attributes + _interOsyn :: Attributes + _interOnt :: NontermIdent + _prodsOinh :: Attributes + _prodsOsyn :: Attributes + _prodsOnt :: NontermIdent + _lhsOgathNts :: (Set NontermIdent) + _lhsOchunks :: Chunks + _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _prodsOallNts :: (Set NontermIdent) + _prodsOallPragmas :: PragmaMap + _prodsOaroundMap :: (Map ConstructorIdent (Set Identifier)) + _prodsOcontextMap :: ContextMap + _prodsOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) + _prodsOo_case :: Bool + _prodsOo_cata :: Bool + _prodsOo_costcentre :: Bool + _prodsOo_data :: (Maybe Bool) + _prodsOo_linePragmas :: Bool + _prodsOo_monadic :: Bool + _prodsOo_newtypes :: Bool + _prodsOo_pretty :: Bool + _prodsOo_rename :: Bool + _prodsOo_sem :: Bool + _prodsOo_sig :: Bool + _prodsOo_splitsems :: Bool + _prodsOo_strictwrap :: Bool + _prodsOo_traces :: Bool + _prodsOo_unbox :: Bool + _prodsOoptions :: Options + _prodsOparamMap :: ParamMap + _prodsOprefix :: String + _prodsOquantMap :: QuantMap + _prodsOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _prodsOwith_sig :: Bool + _prodsOwrappers :: (Set NontermIdent) + _interOo_case :: Bool + _interOo_cata :: Bool + _interOo_costcentre :: Bool + _interOo_data :: (Maybe Bool) + _interOo_linePragmas :: Bool + _interOo_monadic :: Bool + _interOo_newtypes :: Bool + _interOo_pretty :: Bool + _interOo_rename :: Bool + _interOo_sem :: Bool + _interOo_sig :: Bool + _interOo_splitsems :: Bool + _interOo_strictwrap :: Bool + _interOo_traces :: Bool + _interOo_unbox :: Bool + _interOoptions :: Options + _interOparamMap :: ParamMap + _interOprefix :: String + _prodsIcataAlts :: Decls + _prodsIcomments :: ([String]) + _prodsIdataAlts :: DataAlts + _prodsIdecls :: Decls + _prodsIsemNames :: ([String]) + _interIcomments :: ([String]) + _interIsemDom :: ([Decl]) + _interIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _interIwrapDecls :: Decls + -- "./src-ag/GenerateCode.ag"(line 86, column 26) + (_interOinh,_interOsyn,_interOnt) = + ({-# LINE 86 "./src-ag/GenerateCode.ag" #-} + (inh_,syn_,nt_) + {-# LINE 1051 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 87, column 25) + (_prodsOinh,_prodsOsyn,_prodsOnt) = + ({-# LINE 87 "./src-ag/GenerateCode.ag" #-} + (inh_,syn_,nt_) + {-# LINE 1057 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 142, column 7) + _lhsOgathNts = + ({-# LINE 142 "./src-ag/GenerateCode.ag" #-} + Set.singleton nt_ + {-# LINE 1063 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 583, column 34) + _aroundMap = + ({-# LINE 583 "./src-ag/GenerateCode.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaroundMap + {-# LINE 1069 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 599, column 34) + _mergeMap = + ({-# LINE 599 "./src-ag/GenerateCode.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsImergeMap + {-# LINE 1075 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 803, column 18) + _semWrapper = + ({-# LINE 803 "./src-ag/GenerateCode.ag" #-} + let params' = map getName params_ + inhAttrs = Map.toList inh_ + synAttrs = Map.toList syn_ + inhVars = [ SimpleExpr (attrname True _LHS a) | (a,_) <- inhAttrs ] + synVars = [ SimpleExpr (attrname False _LHS a) | (a,_) <- synAttrs ] + var = "sem" + wrapNT = "wrap" ++ "_" ++ getName nt_ + inhNT = "Inh" ++ "_" ++ getName nt_ + synNT = "Syn" ++ "_" ++ getName nt_ + varPat = if _lhsIo_newtypes + then App (sdtype nt_) [SimpleExpr var] + else SimpleExpr var + evalTp | null params' = id + | otherwise = idEvalType + appParams nm = TypeApp (SimpleType nm) (map SimpleType params') + typeSig = TSig wrapNT (evalTp $ appParams (sdtype nt_) `Arr` (appParams inhNT `Arr` appParams synNT)) + mkstrict = Named _lhsIo_strictwrap + mkdata n attrs = Data n params' [Record n [mkstrict (getName f++"_"++n) $ evalTp $ typeToCodeType (Just nt_) params' $ removeDeforested t | (f,t) <- attrs]] False [] + datas = [mkdata inhNT inhAttrs, mkdata synNT synAttrs] + in datas ++ [ typeSig + , Decl (Fun wrapNT [varPat, App inhNT inhVars]) + (Let _interIwrapDecls (App synNT synVars)) + Set.empty Set.empty + ] + {-# LINE 1104 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 864, column 18) + _comment = + ({-# LINE 864 "./src-ag/GenerateCode.ag" #-} + Comment . unlines . map ind $ ( _interIcomments ++ ("alternatives:" : map ind _prodsIcomments) ) + {-# LINE 1110 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 926, column 19) + _lhsOchunks = + ({-# LINE 926 "./src-ag/GenerateCode.ag" #-} + [ Chunk (getName nt_) + (Comment (getName nt_ ++ " " ++ replicate (60 - length (getName nt_)) '-')) + (if _lhsIo_pretty then [_comment ] else []) + (if isJust _lhsIo_data then [_dataDef ] else []) + (if _lhsIo_cata && _genCata then _cataFun else []) + (if _lhsIo_sig then _interIsemDom else []) + (if nt_ `Set.member` _lhsIwrappers then _semWrapper else []) + (if _lhsIo_sem then _prodsIdecls else []) + (if _lhsIo_sem then _prodsIsemNames else []) + ] + {-# LINE 1125 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 995, column 18) + _dataDef = + ({-# LINE 995 "./src-ag/GenerateCode.ag" #-} + let params' = map getName params_ + typeSyn tp = let theType = + case tp of + CommonTypes.Maybe t -> TMaybe $ typeToCodeType (Just nt_) params' t + CommonTypes.Either t1 t2 -> TEither (typeToCodeType (Just nt_) params' t1) (typeToCodeType (Just nt_) params' t2) + CommonTypes.Map t1 t2 -> TMap (typeToCodeType (Just nt_) params' t1) (typeToCodeType (Just nt_) params' t2) + CommonTypes.IntMap t -> TIntMap $ typeToCodeType (Just nt_) params' t + CommonTypes.List t -> Code.List $ typeToCodeType (Just nt_) params' t + CommonTypes.Tuple ts -> Code.TupleType [typeToCodeType (Just nt_) params' t + | (_,t) <- ts + ] + 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 + {-# LINE 1145 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 1038, column 18) + _genCata = + ({-# LINE 1038 "./src-ag/GenerateCode.ag" #-} + not (nt_ `Set.member` nocatas _lhsIoptions) + {-# LINE 1151 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 1039, column 18) + _cataFun = + ({-# LINE 1039 "./src-ag/GenerateCode.ag" #-} + let appParams nm = TypeApp (SimpleType nm) (map SimpleType (map getName params_)) + evalTp | null params_ = id + | otherwise = idEvalType + tSig = TSig (cataname _lhsIprefix nt_) + (appQuant _lhsIquantMap nt_ $ appContext _lhsIcontextMap nt_ $ evalTp $ appParams (getName nt_) `Arr` appParams (sdtype nt_)) + special typ = case typ of + CommonTypes.List tp -> + let cons = SimpleExpr (semname _lhsIprefix nt_ (identifier "Cons")) + nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil" )) + arg = SimpleExpr "list" + rarg = case tp of + NT t _ _ -> let t' = maybe t id (deforestedNt t) + in SimpleExpr ("(Prelude.map " ++ (cataname _lhsIprefix t') ++ " list)") + _ -> arg + lhs = Fun (cataname _lhsIprefix nt_) [arg] + rhs = (App "Prelude.foldr" [cons,nil,rarg]) + in [Decl lhs rhs Set.empty Set.empty] + CommonTypes.Maybe tp -> + let just = semname _lhsIprefix nt_ (identifier "Just") + nothing = semname _lhsIprefix nt_ (identifier "Nothing" ) + arg = SimpleExpr "x" + rarg = case tp of + NT t _ _ -> let t' = maybe t id (deforestedNt t) + in App (cataname _lhsIprefix t') [arg] + _ -> arg + lhs a = Fun (cataname _lhsIprefix nt_) [a] + 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 _ _ -> let t' = maybe t id (deforestedNt t) + in App (cataname _lhsIprefix t') [arg] + _ -> arg + rarg1 = case tp2 of + NT t _ _ -> let t' = maybe t id (deforestedNt t) + in 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 _ _ -> let t' = maybe t id (deforestedNt t) + in App "Data.Map.map" [SimpleExpr $ cataname _lhsIprefix t', arg] + _ -> arg + lhs = Fun (cataname _lhsIprefix nt_) [arg] + rhs = App "Data.Map.foldrWithKey" [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 _ _ -> let t' = maybe t id (deforestedNt t) + in App "Data.IntMap.map" [SimpleExpr $ cataname _lhsIprefix t', arg] + _ -> arg + lhs = Fun (cataname _lhsIprefix nt_) [arg] + rhs = App "Data.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] + rargs = map rarg tps' + rarg (n, tp) = case tp of + NT t _ _ -> let t' = maybe t id (deforestedNt t) + in App (cataname _lhsIprefix t') [n] + _ -> n + lhs = Fun (cataname _lhsIprefix nt_) [TupleExpr (map fst tps')] + rhs = App con rargs + in [Decl lhs rhs Set.empty Set.empty] + in Comment "cata" : + (if _lhsIo_sig then [tSig] else []) ++ + maybe _prodsIcataAlts special (lookup nt_ _lhsItypeSyns) + {-# LINE 1237 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 744, column 86) + _lhsOsemDomUnfoldGath = + ({-# LINE 744 "./src-ag/GenerateCode.ag" #-} + _interIsemDomUnfoldGath + {-# LINE 1243 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOallNts = + ({-# LINE 132 "./src-ag/GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 1249 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOallPragmas = + ({-# LINE 73 "./src-ag/GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 1255 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _prodsOaroundMap = + ({-# LINE 578 "./src-ag/GenerateCode.ag" #-} + _aroundMap + {-# LINE 1261 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOcontextMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 1267 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _prodsOmergeMap = + ({-# LINE 594 "./src-ag/GenerateCode.ag" #-} + _mergeMap + {-# LINE 1273 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 1279 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 1285 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 1291 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 1297 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 1303 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 1309 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 1315 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 1321 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 1327 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 1333 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 1339 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 1345 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 1351 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 1357 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 1363 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 1369 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 1375 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 1381 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOquantMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 1387 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOunfoldSemDom = + ({-# LINE 750 "./src-ag/GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 1393 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOwith_sig = + ({-# LINE 851 "./src-ag/GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 1399 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _prodsOwrappers = + ({-# LINE 987 "./src-ag/GenerateCode.ag" #-} + _lhsIwrappers + {-# LINE 1405 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 1411 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 1417 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 1423 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 1429 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 1435 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 1441 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 1447 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 1453 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 1459 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 1465 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 1471 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 1477 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 1483 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 1489 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 1495 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 1501 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 1507 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _interOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 1513 "dist/build/GenerateCode.hs" #-} + ) + ( _prodsIcataAlts,_prodsIcomments,_prodsIdataAlts,_prodsIdecls,_prodsIsemNames) = + prods_ _prodsOallNts _prodsOallPragmas _prodsOaroundMap _prodsOcontextMap _prodsOinh _prodsOmergeMap _prodsOnt _prodsOo_case _prodsOo_cata _prodsOo_costcentre _prodsOo_data _prodsOo_linePragmas _prodsOo_monadic _prodsOo_newtypes _prodsOo_pretty _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_splitsems _prodsOo_strictwrap _prodsOo_traces _prodsOo_unbox _prodsOoptions _prodsOparamMap _prodsOprefix _prodsOquantMap _prodsOsyn _prodsOunfoldSemDom _prodsOwith_sig _prodsOwrappers + ( _interIcomments,_interIsemDom,_interIsemDomUnfoldGath,_interIwrapDecls) = + inter_ _interOinh _interOnt _interOo_case _interOo_cata _interOo_costcentre _interOo_data _interOo_linePragmas _interOo_monadic _interOo_newtypes _interOo_pretty _interOo_rename _interOo_sem _interOo_sig _interOo_splitsems _interOo_strictwrap _interOo_traces _interOo_unbox _interOoptions _interOparamMap _interOprefix _interOsyn + in ( _lhsOchunks,_lhsOgathNts,_lhsOsemDomUnfoldGath)))) +-- CNonterminals ----------------------------------------------- +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + allPragmas : PragmaMap + aroundMap : Map NontermIdent (Map ConstructorIdent (Set Identifier)) + contextMap : ContextMap + derivings : Derivings + mergeMap : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramMap : ParamMap + prefix : String + quantMap : QuantMap + typeSyns : TypeSyns + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + with_sig : Bool + wrappers : Set NontermIdent + synthesized attributes: + chunks : Chunks + gathNts : Set NontermIdent + semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type) + alternatives: + alternative Cons: + child hd : CNonterminal + child tl : CNonterminals + alternative Nil: +-} +-- cata +sem_CNonterminals :: CNonterminals -> + T_CNonterminals +sem_CNonterminals list = + (Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list)) +-- semantic domain +newtype T_CNonterminals = T_CNonterminals ((Set NontermIdent) -> + PragmaMap -> + (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> + ContextMap -> + Derivings -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + ParamMap -> + String -> + QuantMap -> + TypeSyns -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + Bool -> + (Set NontermIdent) -> + ( Chunks,(Set NontermIdent),(Map (NontermIdent, Int) ([String], Code.Type)))) +data Inh_CNonterminals = Inh_CNonterminals {allNts_Inh_CNonterminals :: !((Set NontermIdent)),allPragmas_Inh_CNonterminals :: !(PragmaMap),aroundMap_Inh_CNonterminals :: !((Map NontermIdent (Map ConstructorIdent (Set Identifier)))),contextMap_Inh_CNonterminals :: !(ContextMap),derivings_Inh_CNonterminals :: !(Derivings),mergeMap_Inh_CNonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))))),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_monadic_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),options_Inh_CNonterminals :: !(Options),paramMap_Inh_CNonterminals :: !(ParamMap),prefix_Inh_CNonterminals :: !(String),quantMap_Inh_CNonterminals :: !(QuantMap),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 {chunks_Syn_CNonterminals :: !(Chunks),gathNts_Syn_CNonterminals :: !((Set NontermIdent)),semDomUnfoldGath_Syn_CNonterminals :: !((Map (NontermIdent, Int) ([String], Code.Type)))} +wrap_CNonterminals :: T_CNonterminals -> + Inh_CNonterminals -> + Syn_CNonterminals +wrap_CNonterminals (T_CNonterminals sem) (Inh_CNonterminals _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIderivings _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) = + (let ( _lhsOchunks,_lhsOgathNts,_lhsOsemDomUnfoldGath) = sem _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIderivings _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers + in (Syn_CNonterminals _lhsOchunks _lhsOgathNts _lhsOsemDomUnfoldGath)) +sem_CNonterminals_Cons :: T_CNonterminal -> + T_CNonterminals -> + T_CNonterminals +sem_CNonterminals_Cons (T_CNonterminal hd_) (T_CNonterminals tl_) = + (T_CNonterminals (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIcontextMap + _lhsIderivings + _lhsImergeMap + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsItypeSyns + _lhsIunfoldSemDom + _lhsIwith_sig + _lhsIwrappers -> + (let _lhsOchunks :: Chunks + _lhsOgathNts :: (Set NontermIdent) + _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _hdOallNts :: (Set NontermIdent) + _hdOallPragmas :: PragmaMap + _hdOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Set Identifier))) + _hdOcontextMap :: ContextMap + _hdOderivings :: Derivings + _hdOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_costcentre :: Bool + _hdOo_data :: (Maybe Bool) + _hdOo_linePragmas :: Bool + _hdOo_monadic :: Bool + _hdOo_newtypes :: Bool + _hdOo_pretty :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_splitsems :: Bool + _hdOo_strictwrap :: Bool + _hdOo_traces :: Bool + _hdOo_unbox :: Bool + _hdOoptions :: Options + _hdOparamMap :: ParamMap + _hdOprefix :: String + _hdOquantMap :: QuantMap + _hdOtypeSyns :: TypeSyns + _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _hdOwith_sig :: Bool + _hdOwrappers :: (Set NontermIdent) + _tlOallNts :: (Set NontermIdent) + _tlOallPragmas :: PragmaMap + _tlOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Set Identifier))) + _tlOcontextMap :: ContextMap + _tlOderivings :: Derivings + _tlOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_costcentre :: Bool + _tlOo_data :: (Maybe Bool) + _tlOo_linePragmas :: Bool + _tlOo_monadic :: Bool + _tlOo_newtypes :: Bool + _tlOo_pretty :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_splitsems :: Bool + _tlOo_strictwrap :: Bool + _tlOo_traces :: Bool + _tlOo_unbox :: Bool + _tlOoptions :: Options + _tlOparamMap :: ParamMap + _tlOprefix :: String + _tlOquantMap :: QuantMap + _tlOtypeSyns :: TypeSyns + _tlOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _tlOwith_sig :: Bool + _tlOwrappers :: (Set NontermIdent) + _hdIchunks :: Chunks + _hdIgathNts :: (Set NontermIdent) + _hdIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _tlIchunks :: Chunks + _tlIgathNts :: (Set NontermIdent) + _tlIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + -- use rule "./src-ag/GenerateCode.ag"(line 918, column 49) + _lhsOchunks = + ({-# LINE 918 "./src-ag/GenerateCode.ag" #-} + _hdIchunks ++ _tlIchunks + {-# LINE 1711 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 138, column 47) + _lhsOgathNts = + ({-# LINE 138 "./src-ag/GenerateCode.ag" #-} + _hdIgathNts `Set.union` _tlIgathNts + {-# LINE 1717 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 744, column 86) + _lhsOsemDomUnfoldGath = + ({-# LINE 744 "./src-ag/GenerateCode.ag" #-} + _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath + {-# LINE 1723 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOallNts = + ({-# LINE 132 "./src-ag/GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 1729 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOallPragmas = + ({-# LINE 73 "./src-ag/GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 1735 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOaroundMap = + ({-# LINE 575 "./src-ag/GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 1741 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOcontextMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 1747 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOderivings = + ({-# LINE 986 "./src-ag/GenerateCode.ag" #-} + _lhsIderivings + {-# LINE 1753 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 591 "./src-ag/GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 1759 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 1765 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 1771 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 1777 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 1783 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 1789 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 1795 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 1801 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 1807 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 1813 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 1819 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 1825 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 1831 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 1837 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 1843 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 1849 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 1855 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 1861 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 1867 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOquantMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 1873 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOtypeSyns = + ({-# LINE 986 "./src-ag/GenerateCode.ag" #-} + _lhsItypeSyns + {-# LINE 1879 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOunfoldSemDom = + ({-# LINE 750 "./src-ag/GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 1885 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOwith_sig = + ({-# LINE 851 "./src-ag/GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 1891 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOwrappers = + ({-# LINE 987 "./src-ag/GenerateCode.ag" #-} + _lhsIwrappers + {-# LINE 1897 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOallNts = + ({-# LINE 132 "./src-ag/GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 1903 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOallPragmas = + ({-# LINE 73 "./src-ag/GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 1909 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOaroundMap = + ({-# LINE 575 "./src-ag/GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 1915 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOcontextMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 1921 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOderivings = + ({-# LINE 986 "./src-ag/GenerateCode.ag" #-} + _lhsIderivings + {-# LINE 1927 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 591 "./src-ag/GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 1933 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 1939 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 1945 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 1951 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 1957 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 1963 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 1969 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 1975 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 1981 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 1987 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 1993 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 1999 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 2005 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 2011 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 2017 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 2023 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 2029 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 2035 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 2041 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOquantMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 2047 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOtypeSyns = + ({-# LINE 986 "./src-ag/GenerateCode.ag" #-} + _lhsItypeSyns + {-# LINE 2053 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOunfoldSemDom = + ({-# LINE 750 "./src-ag/GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 2059 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOwith_sig = + ({-# LINE 851 "./src-ag/GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 2065 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOwrappers = + ({-# LINE 987 "./src-ag/GenerateCode.ag" #-} + _lhsIwrappers + {-# LINE 2071 "dist/build/GenerateCode.hs" #-} + ) + ( _hdIchunks,_hdIgathNts,_hdIsemDomUnfoldGath) = + hd_ _hdOallNts _hdOallPragmas _hdOaroundMap _hdOcontextMap _hdOderivings _hdOmergeMap _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_monadic _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOoptions _hdOparamMap _hdOprefix _hdOquantMap _hdOtypeSyns _hdOunfoldSemDom _hdOwith_sig _hdOwrappers + ( _tlIchunks,_tlIgathNts,_tlIsemDomUnfoldGath) = + tl_ _tlOallNts _tlOallPragmas _tlOaroundMap _tlOcontextMap _tlOderivings _tlOmergeMap _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_monadic _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOoptions _tlOparamMap _tlOprefix _tlOquantMap _tlOtypeSyns _tlOunfoldSemDom _tlOwith_sig _tlOwrappers + in ( _lhsOchunks,_lhsOgathNts,_lhsOsemDomUnfoldGath)))) +sem_CNonterminals_Nil :: T_CNonterminals +sem_CNonterminals_Nil = + (T_CNonterminals (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIcontextMap + _lhsIderivings + _lhsImergeMap + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsItypeSyns + _lhsIunfoldSemDom + _lhsIwith_sig + _lhsIwrappers -> + (let _lhsOchunks :: Chunks + _lhsOgathNts :: (Set NontermIdent) + _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + -- use rule "./src-ag/GenerateCode.ag"(line 918, column 49) + _lhsOchunks = + ({-# LINE 918 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 2116 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 138, column 47) + _lhsOgathNts = + ({-# LINE 138 "./src-ag/GenerateCode.ag" #-} + Set.empty + {-# LINE 2122 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 744, column 86) + _lhsOsemDomUnfoldGath = + ({-# LINE 744 "./src-ag/GenerateCode.ag" #-} + Map.empty + {-# LINE 2128 "dist/build/GenerateCode.hs" #-} + ) + in ( _lhsOchunks,_lhsOgathNts,_lhsOsemDomUnfoldGath)))) +-- CProduction ------------------------------------------------- +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + allPragmas : PragmaMap + aroundMap : Map ConstructorIdent (Set Identifier) + contextMap : ContextMap + inh : Attributes + mergeMap : Map ConstructorIdent (Map Identifier (Identifier, [Identifier])) + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramMap : ParamMap + prefix : String + quantMap : QuantMap + syn : Attributes + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + with_sig : Bool + wrappers : Set NontermIdent + synthesized attributes: + cataAlt : Decl + comments : [String] + dataAlt : DataAlt + decls : Decls + semNames : [String] + alternatives: + alternative CProduction: + child con : {ConstructorIdent} + child visits : CVisits + child children : {[(Identifier,Type,ChildKind)]} + child terminals : {[Identifier]} + visit 0: + local paramInstMap : _ + local aroundMap : _ + local mergeMap : _ + local firstOrderChildren : _ + local params : _ +-} +-- cata +sem_CProduction :: CProduction -> + T_CProduction +sem_CProduction (CProduction _con _visits _children _terminals) = + (sem_CProduction_CProduction _con (sem_CVisits _visits) _children _terminals) +-- semantic domain +newtype T_CProduction = T_CProduction ((Set NontermIdent) -> + PragmaMap -> + (Map ConstructorIdent (Set Identifier)) -> + ContextMap -> + Attributes -> + (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + ParamMap -> + String -> + QuantMap -> + Attributes -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + Bool -> + (Set NontermIdent) -> + ( Decl,([String]),DataAlt,Decls,([String]))) +data Inh_CProduction = Inh_CProduction {allNts_Inh_CProduction :: !((Set NontermIdent)),allPragmas_Inh_CProduction :: !(PragmaMap),aroundMap_Inh_CProduction :: !((Map ConstructorIdent (Set Identifier))),contextMap_Inh_CProduction :: !(ContextMap),inh_Inh_CProduction :: !(Attributes),mergeMap_Inh_CProduction :: !((Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))),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_monadic_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),options_Inh_CProduction :: !(Options),paramMap_Inh_CProduction :: !(ParamMap),prefix_Inh_CProduction :: !(String),quantMap_Inh_CProduction :: !(QuantMap),syn_Inh_CProduction :: !(Attributes),unfoldSemDom_Inh_CProduction :: !((NontermIdent -> Int -> [String] -> Code.Type)),with_sig_Inh_CProduction :: !(Bool),wrappers_Inh_CProduction :: !((Set NontermIdent))} +data Syn_CProduction = Syn_CProduction {cataAlt_Syn_CProduction :: !(Decl),comments_Syn_CProduction :: !(([String])),dataAlt_Syn_CProduction :: !(DataAlt),decls_Syn_CProduction :: !(Decls),semNames_Syn_CProduction :: !(([String]))} +wrap_CProduction :: T_CProduction -> + Inh_CProduction -> + Syn_CProduction +wrap_CProduction (T_CProduction sem) (Inh_CProduction _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIinh _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) = + (let ( _lhsOcataAlt,_lhsOcomments,_lhsOdataAlt,_lhsOdecls,_lhsOsemNames) = sem _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIinh _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers + in (Syn_CProduction _lhsOcataAlt _lhsOcomments _lhsOdataAlt _lhsOdecls _lhsOsemNames)) +sem_CProduction_CProduction :: ConstructorIdent -> + T_CVisits -> + ([(Identifier,Type,ChildKind)]) -> + ([Identifier]) -> + T_CProduction +sem_CProduction_CProduction con_ (T_CVisits visits_) children_ terminals_ = + (T_CProduction (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIcontextMap + _lhsIinh + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsIsyn + _lhsIunfoldSemDom + _lhsIwith_sig + _lhsIwrappers -> + (let _visitsOcon :: ConstructorIdent + _visitsOterminals :: ([Identifier]) + _visitsOvisitedSet :: (Set Identifier) + _visitsOnr :: Int + _visitsOchildren :: ([(Identifier,Type, ChildKind)]) + _visitsOinstVisitNrs :: (Map Identifier Int) + _lhsOcomments :: ([String]) + _lhsOdataAlt :: DataAlt + _lhsOcataAlt :: Decl + _lhsOdecls :: Decls + _lhsOsemNames :: ([String]) + _visitsOallNts :: (Set NontermIdent) + _visitsOallPragmas :: PragmaMap + _visitsOaroundMap :: (Set Identifier) + _visitsOcontextMap :: ContextMap + _visitsOinh :: Attributes + _visitsOmergeMap :: (Map Identifier (Identifier, [Identifier])) + _visitsOnt :: NontermIdent + _visitsOo_case :: Bool + _visitsOo_cata :: Bool + _visitsOo_costcentre :: Bool + _visitsOo_data :: (Maybe Bool) + _visitsOo_linePragmas :: Bool + _visitsOo_monadic :: Bool + _visitsOo_newtypes :: Bool + _visitsOo_pretty :: Bool + _visitsOo_rename :: Bool + _visitsOo_sem :: Bool + _visitsOo_sig :: Bool + _visitsOo_splitsems :: Bool + _visitsOo_strictwrap :: Bool + _visitsOo_traces :: Bool + _visitsOo_unbox :: Bool + _visitsOoptions :: Options + _visitsOparamInstMap :: (Map Identifier (NontermIdent, [String])) + _visitsOparamMap :: ParamMap + _visitsOprefix :: String + _visitsOquantMap :: QuantMap + _visitsOsyn :: Attributes + _visitsOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _visitsOwith_sig :: Bool + _visitsOwrappers :: (Set NontermIdent) + _visitsIcomments :: ([String]) + _visitsIdecls :: Decls + _visitsIgatherInstVisitNrs :: (Map Identifier Int) + _visitsIintra :: Exprs + _visitsIintraVars :: (Set String) + _visitsIisNil :: Bool + _visitsIsemNames :: ([String]) + _visitsIvisitedSet :: (Set Identifier) + -- "./src-ag/GenerateCode.ag"(line 92, column 19) + _visitsOcon = + ({-# LINE 92 "./src-ag/GenerateCode.ag" #-} + con_ + {-# LINE 2319 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 93, column 20) + _visitsOterminals = + ({-# LINE 93 "./src-ag/GenerateCode.ag" #-} + terminals_ + {-# LINE 2325 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 105, column 7) + _paramInstMap = + ({-# LINE 105 "./src-ag/GenerateCode.ag" #-} + Map.fromList [(nm, (extractNonterminal tp, tps)) | (nm,tp,_) <- children_, let tps = map cleanupArg $ nontermArgs tp, not (null tps) ] + {-# LINE 2331 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 146, column 32) + _visitsOvisitedSet = + ({-# LINE 146 "./src-ag/GenerateCode.ag" #-} + Set.empty + {-# LINE 2337 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 280, column 18) + _visitsOnr = + ({-# LINE 280 "./src-ag/GenerateCode.ag" #-} + 0 + {-# LINE 2343 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 412, column 18) + _visitsOchildren = + ({-# LINE 412 "./src-ag/GenerateCode.ag" #-} + children_ + {-# LINE 2349 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 564, column 7) + _visitsOinstVisitNrs = + ({-# LINE 564 "./src-ag/GenerateCode.ag" #-} + _visitsIgatherInstVisitNrs + {-# LINE 2355 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 584, column 34) + _aroundMap = + ({-# LINE 584 "./src-ag/GenerateCode.ag" #-} + Map.findWithDefault Set.empty con_ _lhsIaroundMap + {-# LINE 2361 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 600, column 34) + _mergeMap = + ({-# LINE 600 "./src-ag/GenerateCode.ag" #-} + Map.findWithDefault Map.empty con_ _lhsImergeMap + {-# LINE 2367 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 879, column 18) + _firstOrderChildren = + ({-# LINE 879 "./src-ag/GenerateCode.ag" #-} + [ (nm,fromJust mb,virt) | (nm,tp,virt) <- children_, let mb = isFirstOrder virt tp, isJust mb ] + {-# LINE 2373 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 880, column 18) + _lhsOcomments = + ({-# LINE 880 "./src-ag/GenerateCode.ag" #-} + ("alternative " ++ getName con_ ++ ":") + : map ind ( map (\(x,y,_) -> makeLocalComment 14 "child" x (Just y)) _firstOrderChildren + ++ _visitsIcomments + ) + {-# LINE 2382 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 1019, column 17) + _params = + ({-# LINE 1019 "./src-ag/GenerateCode.ag" #-} + map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap + {-# LINE 2388 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 1020, column 17) + _lhsOdataAlt = + ({-# LINE 1020 "./src-ag/GenerateCode.ag" #-} + let conNm = conname _lhsIo_rename _lhsInt con_ + mkFields f = map (\(nm,t,_) -> f _lhsInt con_ nm (typeToCodeType (Just _lhsInt) _params $ removeDeforested t)) _firstOrderChildren + in if dataRecords _lhsIoptions + then Record conNm $ mkFields $ toNamedType (strictData _lhsIoptions) + else DataAlt conNm $ mkFields $ \_ _ _ t -> t + {-# LINE 2398 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 1131, column 17) + _lhsOcataAlt = + ({-# LINE 1131 "./src-ag/GenerateCode.ag" #-} + let lhs = Fun (cataname _lhsIprefix _lhsInt) [lhs_pat] + lhs_pat = App (conname _lhsIo_rename _lhsInt con_) + (map (\(n,_,_) -> SimpleExpr $ locname $ n) _firstOrderChildren ) + rhs = App (semname _lhsIprefix _lhsInt con_) + (map argument _firstOrderChildren ) + argument (nm,NT tp _ _,_) = App (cataname _lhsIprefix tp) + [SimpleExpr (locname nm)] + argument (nm, _,_) = SimpleExpr (locname nm) + in Decl lhs rhs Set.empty Set.empty + {-# LINE 2412 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 919, column 44) + _lhsOdecls = + ({-# LINE 919 "./src-ag/GenerateCode.ag" #-} + _visitsIdecls + {-# LINE 2418 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 1146, column 61) + _lhsOsemNames = + ({-# LINE 1146 "./src-ag/GenerateCode.ag" #-} + _visitsIsemNames + {-# LINE 2424 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOallNts = + ({-# LINE 132 "./src-ag/GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 2430 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOallPragmas = + ({-# LINE 73 "./src-ag/GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 2436 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _visitsOaroundMap = + ({-# LINE 580 "./src-ag/GenerateCode.ag" #-} + _aroundMap + {-# LINE 2442 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOcontextMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 2448 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOinh = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIinh + {-# LINE 2454 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _visitsOmergeMap = + ({-# LINE 596 "./src-ag/GenerateCode.ag" #-} + _mergeMap + {-# LINE 2460 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOnt = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsInt + {-# LINE 2466 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 2472 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 2478 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 2484 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 2490 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 2496 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 2502 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 2508 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 2514 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 2520 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 2526 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 2532 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 2538 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 2544 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 2550 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 2556 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 2562 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _visitsOparamInstMap = + ({-# LINE 101 "./src-ag/GenerateCode.ag" #-} + _paramInstMap + {-# LINE 2568 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 2574 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 2580 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOquantMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 2586 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOsyn = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 2592 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOunfoldSemDom = + ({-# LINE 750 "./src-ag/GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 2598 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOwith_sig = + ({-# LINE 851 "./src-ag/GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 2604 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _visitsOwrappers = + ({-# LINE 987 "./src-ag/GenerateCode.ag" #-} + _lhsIwrappers + {-# LINE 2610 "dist/build/GenerateCode.hs" #-} + ) + ( _visitsIcomments,_visitsIdecls,_visitsIgatherInstVisitNrs,_visitsIintra,_visitsIintraVars,_visitsIisNil,_visitsIsemNames,_visitsIvisitedSet) = + visits_ _visitsOallNts _visitsOallPragmas _visitsOaroundMap _visitsOchildren _visitsOcon _visitsOcontextMap _visitsOinh _visitsOinstVisitNrs _visitsOmergeMap _visitsOnr _visitsOnt _visitsOo_case _visitsOo_cata _visitsOo_costcentre _visitsOo_data _visitsOo_linePragmas _visitsOo_monadic _visitsOo_newtypes _visitsOo_pretty _visitsOo_rename _visitsOo_sem _visitsOo_sig _visitsOo_splitsems _visitsOo_strictwrap _visitsOo_traces _visitsOo_unbox _visitsOoptions _visitsOparamInstMap _visitsOparamMap _visitsOprefix _visitsOquantMap _visitsOsyn _visitsOterminals _visitsOunfoldSemDom _visitsOvisitedSet _visitsOwith_sig _visitsOwrappers + in ( _lhsOcataAlt,_lhsOcomments,_lhsOdataAlt,_lhsOdecls,_lhsOsemNames)))) +-- CProductions ------------------------------------------------ +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + allPragmas : PragmaMap + aroundMap : Map ConstructorIdent (Set Identifier) + contextMap : ContextMap + inh : Attributes + mergeMap : Map ConstructorIdent (Map Identifier (Identifier, [Identifier])) + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramMap : ParamMap + prefix : String + quantMap : QuantMap + syn : Attributes + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + with_sig : Bool + wrappers : Set NontermIdent + synthesized attributes: + cataAlts : Decls + comments : [String] + dataAlts : DataAlts + decls : Decls + semNames : [String] + alternatives: + alternative Cons: + child hd : CProduction + child tl : CProductions + alternative Nil: +-} +-- cata +sem_CProductions :: CProductions -> + T_CProductions +sem_CProductions list = + (Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list)) +-- semantic domain +newtype T_CProductions = T_CProductions ((Set NontermIdent) -> + PragmaMap -> + (Map ConstructorIdent (Set Identifier)) -> + ContextMap -> + Attributes -> + (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + ParamMap -> + String -> + QuantMap -> + Attributes -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + Bool -> + (Set NontermIdent) -> + ( Decls,([String]),DataAlts,Decls,([String]))) +data Inh_CProductions = Inh_CProductions {allNts_Inh_CProductions :: !((Set NontermIdent)),allPragmas_Inh_CProductions :: !(PragmaMap),aroundMap_Inh_CProductions :: !((Map ConstructorIdent (Set Identifier))),contextMap_Inh_CProductions :: !(ContextMap),inh_Inh_CProductions :: !(Attributes),mergeMap_Inh_CProductions :: !((Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))),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_monadic_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),options_Inh_CProductions :: !(Options),paramMap_Inh_CProductions :: !(ParamMap),prefix_Inh_CProductions :: !(String),quantMap_Inh_CProductions :: !(QuantMap),syn_Inh_CProductions :: !(Attributes),unfoldSemDom_Inh_CProductions :: !((NontermIdent -> Int -> [String] -> Code.Type)),with_sig_Inh_CProductions :: !(Bool),wrappers_Inh_CProductions :: !((Set NontermIdent))} +data Syn_CProductions = Syn_CProductions {cataAlts_Syn_CProductions :: !(Decls),comments_Syn_CProductions :: !(([String])),dataAlts_Syn_CProductions :: !(DataAlts),decls_Syn_CProductions :: !(Decls),semNames_Syn_CProductions :: !(([String]))} +wrap_CProductions :: T_CProductions -> + Inh_CProductions -> + Syn_CProductions +wrap_CProductions (T_CProductions sem) (Inh_CProductions _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIinh _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) = + (let ( _lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOsemNames) = sem _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIinh _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers + in (Syn_CProductions _lhsOcataAlts _lhsOcomments _lhsOdataAlts _lhsOdecls _lhsOsemNames)) +sem_CProductions_Cons :: T_CProduction -> + T_CProductions -> + T_CProductions +sem_CProductions_Cons (T_CProduction hd_) (T_CProductions tl_) = + (T_CProductions (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIcontextMap + _lhsIinh + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsIsyn + _lhsIunfoldSemDom + _lhsIwith_sig + _lhsIwrappers -> + (let _lhsOdataAlts :: DataAlts + _lhsOcataAlts :: Decls + _lhsOcomments :: ([String]) + _lhsOdecls :: Decls + _lhsOsemNames :: ([String]) + _hdOallNts :: (Set NontermIdent) + _hdOallPragmas :: PragmaMap + _hdOaroundMap :: (Map ConstructorIdent (Set Identifier)) + _hdOcontextMap :: ContextMap + _hdOinh :: Attributes + _hdOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) + _hdOnt :: NontermIdent + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_costcentre :: Bool + _hdOo_data :: (Maybe Bool) + _hdOo_linePragmas :: Bool + _hdOo_monadic :: Bool + _hdOo_newtypes :: Bool + _hdOo_pretty :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_splitsems :: Bool + _hdOo_strictwrap :: Bool + _hdOo_traces :: Bool + _hdOo_unbox :: Bool + _hdOoptions :: Options + _hdOparamMap :: ParamMap + _hdOprefix :: String + _hdOquantMap :: QuantMap + _hdOsyn :: Attributes + _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _hdOwith_sig :: Bool + _hdOwrappers :: (Set NontermIdent) + _tlOallNts :: (Set NontermIdent) + _tlOallPragmas :: PragmaMap + _tlOaroundMap :: (Map ConstructorIdent (Set Identifier)) + _tlOcontextMap :: ContextMap + _tlOinh :: Attributes + _tlOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) + _tlOnt :: NontermIdent + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_costcentre :: Bool + _tlOo_data :: (Maybe Bool) + _tlOo_linePragmas :: Bool + _tlOo_monadic :: Bool + _tlOo_newtypes :: Bool + _tlOo_pretty :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_splitsems :: Bool + _tlOo_strictwrap :: Bool + _tlOo_traces :: Bool + _tlOo_unbox :: Bool + _tlOoptions :: Options + _tlOparamMap :: ParamMap + _tlOprefix :: String + _tlOquantMap :: QuantMap + _tlOsyn :: Attributes + _tlOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _tlOwith_sig :: Bool + _tlOwrappers :: (Set NontermIdent) + _hdIcataAlt :: Decl + _hdIcomments :: ([String]) + _hdIdataAlt :: DataAlt + _hdIdecls :: Decls + _hdIsemNames :: ([String]) + _tlIcataAlts :: Decls + _tlIcomments :: ([String]) + _tlIdataAlts :: DataAlts + _tlIdecls :: Decls + _tlIsemNames :: ([String]) + -- "./src-ag/GenerateCode.ag"(line 1015, column 17) + _lhsOdataAlts = + ({-# LINE 1015 "./src-ag/GenerateCode.ag" #-} + _hdIdataAlt : _tlIdataAlts + {-# LINE 2819 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 1127, column 10) + _lhsOcataAlts = + ({-# LINE 1127 "./src-ag/GenerateCode.ag" #-} + _hdIcataAlt : _tlIcataAlts + {-# LINE 2825 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 868, column 52) + _lhsOcomments = + ({-# LINE 868 "./src-ag/GenerateCode.ag" #-} + _hdIcomments ++ _tlIcomments + {-# LINE 2831 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 919, column 44) + _lhsOdecls = + ({-# LINE 919 "./src-ag/GenerateCode.ag" #-} + _hdIdecls ++ _tlIdecls + {-# LINE 2837 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 1146, column 61) + _lhsOsemNames = + ({-# LINE 1146 "./src-ag/GenerateCode.ag" #-} + _hdIsemNames ++ _tlIsemNames + {-# LINE 2843 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOallNts = + ({-# LINE 132 "./src-ag/GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 2849 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOallPragmas = + ({-# LINE 73 "./src-ag/GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 2855 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOaroundMap = + ({-# LINE 578 "./src-ag/GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 2861 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOcontextMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 2867 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIinh + {-# LINE 2873 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 594 "./src-ag/GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 2879 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsInt + {-# LINE 2885 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 2891 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 2897 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 2903 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 2909 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 2915 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 2921 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 2927 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 2933 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 2939 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 2945 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 2951 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 2957 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 2963 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 2969 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 2975 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 2981 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 2987 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 2993 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOquantMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 2999 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 3005 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOunfoldSemDom = + ({-# LINE 750 "./src-ag/GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 3011 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOwith_sig = + ({-# LINE 851 "./src-ag/GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 3017 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOwrappers = + ({-# LINE 987 "./src-ag/GenerateCode.ag" #-} + _lhsIwrappers + {-# LINE 3023 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOallNts = + ({-# LINE 132 "./src-ag/GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 3029 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOallPragmas = + ({-# LINE 73 "./src-ag/GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 3035 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOaroundMap = + ({-# LINE 578 "./src-ag/GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 3041 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOcontextMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 3047 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIinh + {-# LINE 3053 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 594 "./src-ag/GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 3059 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsInt + {-# LINE 3065 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 3071 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 3077 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 3083 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 3089 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 3095 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 3101 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 3107 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 3113 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 3119 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 3125 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 3131 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 3137 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 3143 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 3149 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 3155 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 3161 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 3167 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 3173 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOquantMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 3179 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 3185 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOunfoldSemDom = + ({-# LINE 750 "./src-ag/GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 3191 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOwith_sig = + ({-# LINE 851 "./src-ag/GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 3197 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOwrappers = + ({-# LINE 987 "./src-ag/GenerateCode.ag" #-} + _lhsIwrappers + {-# LINE 3203 "dist/build/GenerateCode.hs" #-} + ) + ( _hdIcataAlt,_hdIcomments,_hdIdataAlt,_hdIdecls,_hdIsemNames) = + hd_ _hdOallNts _hdOallPragmas _hdOaroundMap _hdOcontextMap _hdOinh _hdOmergeMap _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_monadic _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOoptions _hdOparamMap _hdOprefix _hdOquantMap _hdOsyn _hdOunfoldSemDom _hdOwith_sig _hdOwrappers + ( _tlIcataAlts,_tlIcomments,_tlIdataAlts,_tlIdecls,_tlIsemNames) = + tl_ _tlOallNts _tlOallPragmas _tlOaroundMap _tlOcontextMap _tlOinh _tlOmergeMap _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_monadic _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOoptions _tlOparamMap _tlOprefix _tlOquantMap _tlOsyn _tlOunfoldSemDom _tlOwith_sig _tlOwrappers + in ( _lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOsemNames)))) +sem_CProductions_Nil :: T_CProductions +sem_CProductions_Nil = + (T_CProductions (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIcontextMap + _lhsIinh + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsIsyn + _lhsIunfoldSemDom + _lhsIwith_sig + _lhsIwrappers -> + (let _lhsOdataAlts :: DataAlts + _lhsOcataAlts :: Decls + _lhsOcomments :: ([String]) + _lhsOdecls :: Decls + _lhsOsemNames :: ([String]) + -- "./src-ag/GenerateCode.ag"(line 1016, column 17) + _lhsOdataAlts = + ({-# LINE 1016 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 3251 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 1128, column 10) + _lhsOcataAlts = + ({-# LINE 1128 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 3257 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 868, column 52) + _lhsOcomments = + ({-# LINE 868 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 3263 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 919, column 44) + _lhsOdecls = + ({-# LINE 919 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 3269 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 1146, column 61) + _lhsOsemNames = + ({-# LINE 1146 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 3275 "dist/build/GenerateCode.hs" #-} + ) + in ( _lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOsemNames)))) +-- CRule ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + aroundMap : Set Identifier + children : [(Identifier,Type,ChildKind)] + con : ConstructorIdent + inh : Attributes + instVisitNrs : Map Identifier Int + mergeMap : Map Identifier (Identifier, [Identifier]) + nr : Int + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramInstMap : Map Identifier (NontermIdent, [String]) + paramMap : ParamMap + prefix : String + syn : Attributes + terminals : [Identifier] + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + what : String + chained attributes: + declsAbove : [Decl] + visitedSet : Set Identifier + synthesized attributes: + allTpsFound : Bool + bldBlocksFun : DeclBlocks -> DeclBlocks + comments : [String] + decls : Decls + definedInsts : [Identifier] + exprs : Exprs + tSigs : [Decl] + tps : [Type] + usedVars : Set String + alternatives: + alternative CRule: + child name : {Identifier} + child isIn : {Bool} + child hasCode : {Bool} + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child childnt : {Maybe NontermIdent} + child tp : {Maybe Type} + child pattern : Pattern + child rhs : {[String]} + child defines : {Map Int (Identifier,Identifier,Maybe Type)} + child owrt : {Bool} + child origin : {String} + child uses : {Set (Identifier, Identifier)} + child explicit : {Bool} + child mbNamed : {Maybe Identifier} + visit 0: + local instTypes : _ + local originComment : _ + local instDecls : _ + local patDescr : _ + local traceDescr : _ + local addTrace : _ + local costCentreDescr : _ + local addCostCentre : _ + local addLinePragma : _ + local decls : _ + local definedInsts : _ + local rulename : _ + local mkTp : _ + local orgParams : _ + local evalTp : _ + alternative CChildVisit: + child name : {Identifier} + child nt : {NontermIdent} + child nr : {Int} + child inh : {Attributes} + child syn : {Attributes} + child isLast : {Bool} + visit 0: + local visitedSet : _ + local costCentreDescr : _ + local addCostCentre : _ + local decls : _ + local isSuperfluousHigherOrderIntra : _ + local names : _ + local mkTp : _ + local definedTps : _ + local nextTp : _ + local orgParams : _ + local instParams : _ + local replParamMap : _ + local replace : _ + local evalTp : _ +-} +-- cata +sem_CRule :: CRule -> + T_CRule +sem_CRule (CRule _name _isIn _hasCode _nt _con _field _childnt _tp _pattern _rhs _defines _owrt _origin _uses _explicit _mbNamed) = + (sem_CRule_CRule _name _isIn _hasCode _nt _con _field _childnt _tp (sem_Pattern _pattern) _rhs _defines _owrt _origin _uses _explicit _mbNamed) +sem_CRule (CChildVisit _name _nt _nr _inh _syn _isLast) = + (sem_CRule_CChildVisit _name _nt _nr _inh _syn _isLast) +-- semantic domain +newtype T_CRule = T_CRule ((Set NontermIdent) -> + (Set Identifier) -> + ([(Identifier,Type,ChildKind)]) -> + ConstructorIdent -> + ([Decl]) -> + Attributes -> + (Map Identifier Int) -> + (Map Identifier (Identifier, [Identifier])) -> + Int -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + (Map Identifier (NontermIdent, [String])) -> + ParamMap -> + String -> + Attributes -> + ([Identifier]) -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + (Set Identifier) -> + String -> + ( Bool,(DeclBlocks -> DeclBlocks),([String]),Decls,([Decl]),([Identifier]),Exprs,([Decl]),([Type]),(Set String),(Set Identifier))) +data Inh_CRule = Inh_CRule {allNts_Inh_CRule :: !((Set NontermIdent)),aroundMap_Inh_CRule :: !((Set Identifier)),children_Inh_CRule :: !(([(Identifier,Type,ChildKind)])),con_Inh_CRule :: !(ConstructorIdent),declsAbove_Inh_CRule :: !(([Decl])),inh_Inh_CRule :: !(Attributes),instVisitNrs_Inh_CRule :: !((Map Identifier Int)),mergeMap_Inh_CRule :: !((Map Identifier (Identifier, [Identifier]))),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_monadic_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),options_Inh_CRule :: !(Options),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)),visitedSet_Inh_CRule :: !((Set 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])),exprs_Syn_CRule :: !(Exprs),tSigs_Syn_CRule :: !(([Decl])),tps_Syn_CRule :: !(([Type])),usedVars_Syn_CRule :: !((Set String)),visitedSet_Syn_CRule :: !((Set Identifier))} +wrap_CRule :: T_CRule -> + Inh_CRule -> + Syn_CRule +wrap_CRule (T_CRule sem) (Inh_CRule _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat) = + (let ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars,_lhsOvisitedSet) = sem _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat + in (Syn_CRule _lhsOallTpsFound _lhsObldBlocksFun _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars _lhsOvisitedSet)) +sem_CRule_CRule :: Identifier -> + Bool -> + Bool -> + NontermIdent -> + ConstructorIdent -> + Identifier -> + (Maybe NontermIdent) -> + (Maybe Type) -> + T_Pattern -> + ([String]) -> + (Map Int (Identifier,Identifier,Maybe Type)) -> + Bool -> + String -> + (Set (Identifier, Identifier)) -> + Bool -> + (Maybe Identifier) -> + T_CRule +sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ (T_Pattern pattern_) rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ = + (T_CRule (\ _lhsIallNts + _lhsIaroundMap + _lhsIchildren + _lhsIcon + _lhsIdeclsAbove + _lhsIinh + _lhsIinstVisitNrs + _lhsImergeMap + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamInstMap + _lhsIparamMap + _lhsIprefix + _lhsIsyn + _lhsIterminals + _lhsIunfoldSemDom + _lhsIvisitedSet + _lhsIwhat -> + (let _lhsOexprs :: Exprs + _lhsOusedVars :: (Set String) + _lhsOtSigs :: ([Decl]) + _lhsOtps :: ([Type]) + _lhsOallTpsFound :: Bool + _lhsOdeclsAbove :: ([Decl]) + _lhsObldBlocksFun :: (DeclBlocks -> DeclBlocks) + _lhsOcomments :: ([String]) + _lhsOdecls :: Decls + _lhsOdefinedInsts :: ([Identifier]) + _lhsOvisitedSet :: (Set Identifier) + _patternIcopy :: Pattern + _patternIdefinedInsts :: ([Identifier]) + _patternIpatternAttributes :: ([(Identifier, Identifier)]) + -- "./src-ag/GenerateCode.ag"(line 157, column 12) + _instTypes = + ({-# LINE 157 "./src-ag/GenerateCode.ag" #-} + [ (n, (t, mb, for)) | (n, NT t _ for, mb) <- _lhsIchildren ] + {-# LINE 3505 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 158, column 12) + _originComment = + ({-# LINE 158 "./src-ag/GenerateCode.ag" #-} + if _lhsIo_pretty + then (Comment origin_:) + else id + {-# LINE 3513 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 161, column 12) + _instDecls = + ({-# LINE 161 "./src-ag/GenerateCode.ag" #-} + [ mkDecl _lhsIo_monadic (Pattern3 (Alias _INST' inst (Underscore (getPos inst)))) + ( let (nm,mb,defor) = fromJust $ inst `lookup` _instTypes + in unwrapSem _lhsIo_newtypes nm + $ case mb of + ChildReplace tp' -> App instLocFieldName [SimpleExpr $ fieldname inst] + _ -> + if defor + then SimpleExpr instLocFieldName + else App (cataname _lhsIprefix nm) + [SimpleExpr instLocFieldName] + ) + (Set.singleton instSemFieldName) + (Set.singleton instLocFieldName) + | inst <- _definedInsts + , let instLocFieldName = attrname True _INST inst + instSemFieldName = attrname False _INST' inst + ] + {-# LINE 3535 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 178, column 12) + _patDescr = + ({-# LINE 178 "./src-ag/GenerateCode.ag" #-} + if isIn_ + then "_" + else concat $ intersperse "," (map (\(f,a) -> show f ++ "." ++ show a) _patternIpatternAttributes) + {-# LINE 3543 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 181, column 12) + _traceDescr = + ({-# LINE 181 "./src-ag/GenerateCode.ag" #-} + (maybe "" (\nm -> show nm ++ ":") mbNamed_) ++ show nt_ ++ " :: " ++ show con_ ++ " :: " ++ _patDescr + {-# LINE 3549 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 183, column 12) + _addTrace = + ({-# LINE 183 "./src-ag/GenerateCode.ag" #-} + \v -> if _lhsIo_traces + then Trace _traceDescr v + else v + {-# LINE 3557 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 186, column 12) + _costCentreDescr = + ({-# LINE 186 "./src-ag/GenerateCode.ag" #-} + show nt_ ++ ":" ++ show con_ ++ ":" ++ _patDescr + {-# LINE 3563 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 187, column 12) + _addCostCentre = + ({-# LINE 187 "./src-ag/GenerateCode.ag" #-} + \v -> if _lhsIo_costcentre + then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v + else v + {-# LINE 3571 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 190, column 12) + _addLinePragma = + ({-# LINE 190 "./src-ag/GenerateCode.ag" #-} + \v -> let p = getPos name_ + hasPos = line p > 0 && column p >= 0 && not (null (file p)) + in if _lhsIo_linePragmas && hasPos + then PragmaExpr True True ("LINE " ++ show (line p) ++ " " ++ show (file p)) + $ LineExpr + $ v + else v + {-# LINE 3583 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 197, column 12) + _decls = + ({-# LINE 197 "./src-ag/GenerateCode.ag" #-} + if hasCode_ + then _originComment ( mkDecl (_lhsIo_monadic && explicit_) (Pattern3 _patternIcopy) (_addTrace $ _addCostCentre $ _addLinePragma $ (TextExpr rhs_)) + (Set.fromList [attrname False fld nm | (fld,nm,_) <- Map.elems defines_]) + (Set.fromList [attrname True fld nm | (fld,nm) <- Set.toList uses_]) + : _instDecls ) + else _instDecls + {-# LINE 3594 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 266, column 12) + _definedInsts = + ({-# LINE 266 "./src-ag/GenerateCode.ag" #-} + if isIn_ then [] else _patternIdefinedInsts + {-# LINE 3600 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 336, column 12) + _rulename = + ({-# LINE 336 "./src-ag/GenerateCode.ag" #-} + if field_ == _LOC && name_ `elem` _lhsIterminals + then funname name_ 0 + else attrname isIn_ field_ name_ + {-# LINE 3608 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 339, column 12) + _lhsOexprs = + ({-# LINE 339 "./src-ag/GenerateCode.ag" #-} + [SimpleExpr _rulename ] + {-# LINE 3614 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 355, column 7) + _lhsOusedVars = + ({-# LINE 355 "./src-ag/GenerateCode.ag" #-} + Set.singleton _rulename + {-# LINE 3620 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 365, column 19) + _mkTp = + ({-# LINE 365 "./src-ag/GenerateCode.ag" #-} + typeToCodeType (Just _lhsInt) _orgParams + {-# LINE 3626 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 366, column 19) + _lhsOtSigs = + ({-# LINE 366 "./src-ag/GenerateCode.ag" #-} + [ TSig (attrname False field attr) tp' + | (field,attr,tp) <- Map.elems defines_, isJust tp + , let tp1 = _evalTp field $ _mkTp (fromJust tp) + tp' = case findOrigType attr _lhsIchildren of + Just tp' -> let tp2 = _evalTp field $ _mkTp tp' + in Arr tp2 tp1 + Nothing -> tp1 + findOrigType nm [] = Nothing + findOrigType nm ((n,_,kind) : r) + | nm == n = case kind of + ChildReplace orig -> Just orig + _ -> Nothing + | otherwise = findOrigType nm r + ] + {-# LINE 3645 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 381, column 19) + _orgParams = + ({-# LINE 381 "./src-ag/GenerateCode.ag" #-} + map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap + {-# LINE 3651 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 382, column 19) + _evalTp = + ({-# LINE 382 "./src-ag/GenerateCode.ag" #-} + \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 + in if null instParams + then if null _orgParams + then tp + else idEvalType tp + else evalType replace tp + {-# LINE 3665 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 418, column 23) + (_lhsOtps,_lhsOallTpsFound) = + ({-# LINE 418 "./src-ag/GenerateCode.ag" #-} + maybe ([],False) (\tp -> ([tp],True)) tp_ + {-# LINE 3671 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 616, column 7) + _lhsOdeclsAbove = + ({-# LINE 616 "./src-ag/GenerateCode.ag" #-} + _lhsIdeclsAbove ++ _decls + {-# LINE 3677 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 629, column 7) + _lhsObldBlocksFun = + ({-# LINE 629 "./src-ag/GenerateCode.ag" #-} + id + {-# LINE 3683 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 903, column 18) + _lhsOcomments = + ({-# LINE 903 "./src-ag/GenerateCode.ag" #-} + [ 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 ] + {-# LINE 3690 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 155, column 34) + _lhsOdecls = + ({-# LINE 155 "./src-ag/GenerateCode.ag" #-} + _decls + {-# LINE 3696 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 261, column 55) + _lhsOdefinedInsts = + ({-# LINE 261 "./src-ag/GenerateCode.ag" #-} + _definedInsts + {-# LINE 3702 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (chain) + _lhsOvisitedSet = + ({-# LINE 145 "./src-ag/GenerateCode.ag" #-} + _lhsIvisitedSet + {-# LINE 3708 "dist/build/GenerateCode.hs" #-} + ) + ( _patternIcopy,_patternIdefinedInsts,_patternIpatternAttributes) = + pattern_ + in ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars,_lhsOvisitedSet)))) +sem_CRule_CChildVisit :: Identifier -> + NontermIdent -> + Int -> + Attributes -> + Attributes -> + Bool -> + T_CRule +sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ = + (T_CRule (\ _lhsIallNts + _lhsIaroundMap + _lhsIchildren + _lhsIcon + _lhsIdeclsAbove + _lhsIinh + _lhsIinstVisitNrs + _lhsImergeMap + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamInstMap + _lhsIparamMap + _lhsIprefix + _lhsIsyn + _lhsIterminals + _lhsIunfoldSemDom + _lhsIvisitedSet + _lhsIwhat -> + (let _lhsOexprs :: Exprs + _lhsOusedVars :: (Set String) + _lhsOtSigs :: ([Decl]) + _lhsOtps :: ([Type]) + _lhsOdeclsAbove :: ([Decl]) + _lhsObldBlocksFun :: (DeclBlocks -> DeclBlocks) + _lhsOallTpsFound :: Bool + _lhsOcomments :: ([String]) + _lhsOdecls :: Decls + _lhsOdefinedInsts :: ([Identifier]) + _lhsOvisitedSet :: (Set Identifier) + -- "./src-ag/GenerateCode.ag"(line 147, column 26) + _visitedSet = + ({-# LINE 147 "./src-ag/GenerateCode.ag" #-} + Set.insert name_ _lhsIvisitedSet + {-# LINE 3770 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 203, column 18) + _costCentreDescr = + ({-# LINE 203 "./src-ag/GenerateCode.ag" #-} + show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show name_ ++ ":" ++ show nt_ ++ ":" ++ show nr_ + {-# LINE 3776 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 204, column 18) + _addCostCentre = + ({-# LINE 204 "./src-ag/GenerateCode.ag" #-} + \v -> if _lhsIo_costcentre + then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v + else v + {-# LINE 3784 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 207, column 18) + _decls = + ({-# LINE 207 "./src-ag/GenerateCode.ag" #-} + let lhsVars = map (attrname True name_) (Map.keys syn_) + ++ if isLast_ then [] else [unwrap ++ funname name_ (nr_+1)] + rhsVars = map (attrname False name_) (Map.keys inh_) + unwrap = if _lhsIo_newtypes then typeName nt_ (nr_ + 1) ++ " " else "" + tuple | isMerging = TupleLhs [locname name_ ++ "_comp"] + | otherwise = mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars + rhs = _addCostCentre $ Code.InvokeExpr (typeName nt_ nr_) (SimpleExpr fun) (map SimpleExpr rhsVars) + isVirtual _ [] = False + isVirtual nm ((n,t,kind) : r) + | nm == n = case kind of + ChildAttr -> True + _ -> False + | otherwise = isVirtual nm r + isMerged = name_ `Map.member` _lhsImergeMap + isMerging = name_ `elem` concatMap (\(_,cs) -> cs) (Map.elems _lhsImergeMap) + merges = [ (c,cs) | (c,(_,cs)) <- Map.assocs _lhsImergeMap, all (`Set.member` _visitedSet ) cs, name_ `elem` (c:cs) ] + baseNm = if nr_ == 0 && isVirtual name_ _lhsIchildren + then Ident (getName name_ ++ "_inst") (getPos name_) + else name_ + fun | nr_ == 0 && Set.member name_ _lhsIaroundMap + = locname name_ ++ "_around " ++ funname baseNm 0 + | otherwise = funname baseNm nr_ + outDecls | isMerged = [] + | otherwise = + if isMerging + then [mkDecl _lhsIo_monadic tuple rhs Set.empty Set.empty] + else [Resume _lhsIo_monadic (typeName nt_ nr_) tuple rhs] + outMerged | null merges || nr_ /= 0 = [] + | otherwise = let (c,cs) = head merges + tuple' = mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars' + lhsVars' = map (attrname True c) (Map.keys syn_) + ++ if isLast_ then [] else [unwrap ++ funname c (nr_+1)] + rhsVars = [ locname c ++ "_comp" | c <- cs ] + fun = locname c ++ "_merge" + rhs' = App fun (map SimpleExpr rhsVars) + in [Resume _lhsIo_monadic (typeName nt_ nr_) tuple' rhs'] + in + (outDecls ++ outMerged) + {-# LINE 3827 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 327, column 7) + _isSuperfluousHigherOrderIntra = + ({-# LINE 327 "./src-ag/GenerateCode.ag" #-} + _lhsInr <= Map.findWithDefault (-1) name_ _lhsIinstVisitNrs + {-# LINE 3833 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 341, column 8) + _names = + ({-# LINE 341 "./src-ag/GenerateCode.ag" #-} + if _isSuperfluousHigherOrderIntra + then [] + else [funname name_ (nr_+1)] + {-# LINE 3841 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 345, column 8) + _lhsOexprs = + ({-# LINE 345 "./src-ag/GenerateCode.ag" #-} + let wrap = if _lhsIo_newtypes then \x -> App (typeName nt_ (nr_ + 1)) [x] else id + addType expr | null _instParams = expr + | otherwise = TypedExpr expr (_lhsIunfoldSemDom nt_ (nr_+1) _instParams ) + in map (wrap . addType . SimpleExpr) _names + {-# LINE 3850 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 357, column 7) + _lhsOusedVars = + ({-# LINE 357 "./src-ag/GenerateCode.ag" #-} + Set.fromList _names + {-# LINE 3856 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 393, column 19) + _mkTp = + ({-# LINE 393 "./src-ag/GenerateCode.ag" #-} + _evalTp . typeToCodeType (Just nt_) _orgParams . removeDeforested + {-# LINE 3862 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 394, column 19) + _definedTps = + ({-# LINE 394 "./src-ag/GenerateCode.ag" #-} + [ TSig (attrname True name_ a) (_mkTp tp) | (a,tp) <- Map.toList syn_ ] + {-# LINE 3868 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 395, column 19) + _nextTp = + ({-# LINE 395 "./src-ag/GenerateCode.ag" #-} + typeName nt_ (nr_+1) + {-# LINE 3874 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 396, column 19) + _lhsOtSigs = + ({-# LINE 396 "./src-ag/GenerateCode.ag" #-} + (if isLast_ then id else (TSig (funname name_ (nr_+1)) (TypeApp (SimpleType _nextTp) (map SimpleType _instParams )) :)) _definedTps + {-# LINE 3880 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 398, column 19) + _orgParams = + ({-# LINE 398 "./src-ag/GenerateCode.ag" #-} + map getName $ Map.findWithDefault [] nt_ _lhsIparamMap + {-# LINE 3886 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 399, column 19) + _instParams = + ({-# LINE 399 "./src-ag/GenerateCode.ag" #-} + snd $ Map.findWithDefault (nt_,[]) name_ _lhsIparamInstMap + {-# LINE 3892 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 400, column 19) + _replParamMap = + ({-# LINE 400 "./src-ag/GenerateCode.ag" #-} + Map.fromList (zip _orgParams _instParams ) + {-# LINE 3898 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 401, column 19) + _replace = + ({-# LINE 401 "./src-ag/GenerateCode.ag" #-} + \k -> Map.findWithDefault k k _replParamMap + {-# LINE 3904 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 402, column 19) + _evalTp = + ({-# LINE 402 "./src-ag/GenerateCode.ag" #-} + if null _orgParams then id else evalType _replace + {-# LINE 3910 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 419, column 19) + _lhsOtps = + ({-# LINE 419 "./src-ag/GenerateCode.ag" #-} + if _isSuperfluousHigherOrderIntra + then [] + else [NT (ntOfVisit nt_ (nr_+1)) _instParams False] + {-# LINE 3918 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 618, column 7) + _lhsOdeclsAbove = + ({-# LINE 618 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 3924 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 631, column 7) + _lhsObldBlocksFun = + ({-# LINE 631 "./src-ag/GenerateCode.ag" #-} + DeclBlock _lhsIdeclsAbove (head _decls ) + {-# LINE 3930 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 416, column 39) + _lhsOallTpsFound = + ({-# LINE 416 "./src-ag/GenerateCode.ag" #-} + True + {-# LINE 3936 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 868, column 52) + _lhsOcomments = + ({-# LINE 868 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 3942 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 155, column 34) + _lhsOdecls = + ({-# LINE 155 "./src-ag/GenerateCode.ag" #-} + _decls + {-# LINE 3948 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 261, column 55) + _lhsOdefinedInsts = + ({-# LINE 261 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 3954 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _lhsOvisitedSet = + ({-# LINE 145 "./src-ag/GenerateCode.ag" #-} + _visitedSet + {-# LINE 3960 "dist/build/GenerateCode.hs" #-} + ) + in ( _lhsOallTpsFound,_lhsObldBlocksFun,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars,_lhsOvisitedSet)))) +-- CSegment ---------------------------------------------------- +{- + visit 0: + inherited attributes: + inh : Attributes + isLast : Bool + nr : Int + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramMap : ParamMap + prefix : String + syn : Attributes + synthesized attributes: + comments : [String] + semDom : [Decl] + semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type) + wrapDecls : Decls + alternatives: + alternative CSegment: + child inh : {Attributes} + child syn : {Attributes} + visit 0: + local altSemForm : _ + local tp : _ + local inhTps : _ + local inhTup : _ + local synTps : _ + local curTypeName : _ + local nextTypeName : _ + local indexName : _ + local dataIndex : _ + local indexExpr : _ + local indexStr : _ + local inhInstance : _ + local synInstance : _ + local continuation : _ + local params : _ +-} +-- cata +sem_CSegment :: CSegment -> + T_CSegment +sem_CSegment (CSegment _inh _syn) = + (sem_CSegment_CSegment _inh _syn) +-- semantic domain +newtype T_CSegment = T_CSegment (Attributes -> + Bool -> + Int -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + ParamMap -> + 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_monadic_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),options_Inh_CSegment :: !(Options),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 -> + Inh_CSegment -> + Syn_CSegment +wrap_CSegment (T_CSegment sem) (Inh_CSegment _lhsIinh _lhsIisLast _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn) = + (let ( _lhsOcomments,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls) = sem _lhsIinh _lhsIisLast _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn + in (Syn_CSegment _lhsOcomments _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls)) +sem_CSegment_CSegment :: Attributes -> + Attributes -> + T_CSegment +sem_CSegment_CSegment inh_ syn_ = + (T_CSegment (\ _lhsIinh + _lhsIisLast + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIsyn -> + (let _lhsOsemDom :: ([Decl]) + _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _lhsOwrapDecls :: Decls + _lhsOcomments :: ([String]) + -- "./src-ag/GenerateCode.ag"(line 715, column 15) + _altSemForm = + ({-# LINE 715 "./src-ag/GenerateCode.ag" #-} + breadthFirst _lhsIoptions + {-# LINE 4089 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 716, column 15) + _tp = + ({-# LINE 716 "./src-ag/GenerateCode.ag" #-} + if _altSemForm + then TypeApp (SimpleType "Child") [SimpleType "EvalInfo", _indexExpr ] + else foldr Arr _synTps _inhTps + {-# LINE 4097 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 719, column 15) + _inhTps = + ({-# LINE 719 "./src-ag/GenerateCode.ag" #-} + [typeToCodeType (Just _lhsInt) _params tp | tp <- Map.elems inh_] + {-# LINE 4103 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 720, column 15) + _inhTup = + ({-# LINE 720 "./src-ag/GenerateCode.ag" #-} + mkTupleType _lhsIo_unbox (null _inhTps ) _inhTps + {-# LINE 4109 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 721, column 15) + _synTps = + ({-# LINE 721 "./src-ag/GenerateCode.ag" #-} + mkTupleType _lhsIo_unbox (null _inhTps ) ([typeToCodeType (Just _lhsInt) _params tp | tp <- Map.elems syn_] ++ _continuation ) + {-# LINE 4115 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 722, column 15) + _curTypeName = + ({-# LINE 722 "./src-ag/GenerateCode.ag" #-} + typeName _lhsInt _lhsInr + {-# LINE 4121 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 723, column 15) + _nextTypeName = + ({-# LINE 723 "./src-ag/GenerateCode.ag" #-} + typeName _lhsInt (_lhsInr + 1) + {-# LINE 4127 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 724, column 15) + _indexName = + ({-# LINE 724 "./src-ag/GenerateCode.ag" #-} + "I_" ++ _curTypeName + {-# LINE 4133 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 725, column 15) + _dataIndex = + ({-# LINE 725 "./src-ag/GenerateCode.ag" #-} + Code.Data _indexName _params [DataAlt _indexName []] False [] + {-# LINE 4139 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 726, column 15) + _indexExpr = + ({-# LINE 726 "./src-ag/GenerateCode.ag" #-} + TypeApp (SimpleType _indexName ) (map (SimpleType . ('@':)) _params ) + {-# LINE 4145 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 727, column 15) + _indexStr = + ({-# LINE 727 "./src-ag/GenerateCode.ag" #-} + "(" ++ _indexName ++ concatMap (\p -> " " ++ p) _params ++ ")" + {-# LINE 4151 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 728, column 15) + _inhInstance = + ({-# LINE 728 "./src-ag/GenerateCode.ag" #-} + Code.Data "instance Inh" [_indexStr ] [DataAlt (typeName _lhsInt _lhsInr ++ "_Inh") [_inhTup ] ] False [] + {-# LINE 4157 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 729, column 15) + _synInstance = + ({-# LINE 729 "./src-ag/GenerateCode.ag" #-} + Code.Data "instance Syn" [_indexStr ] [DataAlt (typeName _lhsInt _lhsInr ++ "_Syn") [_synTps ] ] False [] + {-# LINE 4163 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 730, column 15) + _continuation = + ({-# LINE 730 "./src-ag/GenerateCode.ag" #-} + if _lhsIisLast + then [] + else [TypeApp (SimpleType _nextTypeName ) (map (SimpleType . ('@':)) _params )] + {-# LINE 4171 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 733, column 15) + _params = + ({-# LINE 733 "./src-ag/GenerateCode.ag" #-} + map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap + {-# LINE 4177 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 734, column 15) + _lhsOsemDom = + ({-# LINE 734 "./src-ag/GenerateCode.ag" #-} + let name = typeName _lhsInt _lhsInr + evalTp | null _params = id + | otherwise = idEvalType + in ( if _lhsIo_newtypes + then [ Code.NewType name _params name (evalTp _tp ) ] + else [ Code.Type name _params (evalTp _tp ) ] ) + ++ ( if _altSemForm + then [_dataIndex , _inhInstance , _synInstance ] + else [] ) + {-# LINE 4191 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 748, column 7) + _lhsOsemDomUnfoldGath = + ({-# LINE 748 "./src-ag/GenerateCode.ag" #-} + Map.singleton (_lhsInt, _lhsInr) (_params , _tp ) + {-# LINE 4197 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 831, column 15) + _lhsOwrapDecls = + ({-# LINE 831 "./src-ag/GenerateCode.ag" #-} + let lhsVars = map (lhsname False) (Map.keys syn_) + ++ if _lhsIisLast then [] else [unwrap ++ sem (_lhsInr+1)] + rhsVars = map (lhsname True) (Map.keys inh_) + rhs = map SimpleExpr rhsVars + unwrap = if _lhsIo_newtypes then typeName _lhsInt (_lhsInr + 1) ++ " " else "" + var = "sem" + sem 0 = var + sem n = var ++ "_" ++ show n + ntt = typeName _lhsInt _lhsInr + in [ EvalDecl ntt (mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars) (InvokeExpr ntt (SimpleExpr $ sem _lhsInr) rhs) ] + {-# LINE 4212 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 873, column 18) + _lhsOcomments = + ({-# LINE 873 "./src-ag/GenerateCode.ag" #-} + let body = map ind (showsSegment (CSegment inh_ syn_)) + in if null body + then [] + else ("visit " ++ show _lhsInr ++ ":") : body + {-# LINE 4221 "dist/build/GenerateCode.hs" #-} + ) + in ( _lhsOcomments,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls)))) +-- CSegments --------------------------------------------------- +{- + visit 0: + inherited attributes: + inh : Attributes + nr : Int + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramMap : ParamMap + prefix : String + syn : Attributes + synthesized attributes: + comments : [String] + isNil : Bool + semDom : [Decl] + semDomUnfoldGath : Map (NontermIdent, Int) ([String], Code.Type) + wrapDecls : Decls + alternatives: + alternative Cons: + child hd : CSegment + child tl : CSegments + alternative Nil: +-} +-- cata +sem_CSegments :: CSegments -> + T_CSegments +sem_CSegments list = + (Prelude.foldr sem_CSegments_Cons sem_CSegments_Nil (Prelude.map sem_CSegment list)) +-- semantic domain +newtype T_CSegments = T_CSegments (Attributes -> + Int -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + ParamMap -> + 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_monadic_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),options_Inh_CSegments :: !(Options),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 -> + Inh_CSegments -> + Syn_CSegments +wrap_CSegments (T_CSegments sem) (Inh_CSegments _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn) = + (let ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls) = sem _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn + in (Syn_CSegments _lhsOcomments _lhsOisNil _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls)) +sem_CSegments_Cons :: T_CSegment -> + T_CSegments -> + T_CSegments +sem_CSegments_Cons (T_CSegment hd_) (T_CSegments tl_) = + (T_CSegments (\ _lhsIinh + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIsyn -> + (let _tlOnr :: Int + _lhsOisNil :: Bool + _hdOisLast :: Bool + _lhsOcomments :: ([String]) + _lhsOsemDom :: ([Decl]) + _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _lhsOwrapDecls :: Decls + _hdOinh :: Attributes + _hdOnr :: Int + _hdOnt :: NontermIdent + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_costcentre :: Bool + _hdOo_data :: (Maybe Bool) + _hdOo_linePragmas :: Bool + _hdOo_monadic :: Bool + _hdOo_newtypes :: Bool + _hdOo_pretty :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_splitsems :: Bool + _hdOo_strictwrap :: Bool + _hdOo_traces :: Bool + _hdOo_unbox :: Bool + _hdOoptions :: Options + _hdOparamMap :: ParamMap + _hdOprefix :: String + _hdOsyn :: Attributes + _tlOinh :: Attributes + _tlOnt :: NontermIdent + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_costcentre :: Bool + _tlOo_data :: (Maybe Bool) + _tlOo_linePragmas :: Bool + _tlOo_monadic :: Bool + _tlOo_newtypes :: Bool + _tlOo_pretty :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_splitsems :: Bool + _tlOo_strictwrap :: Bool + _tlOo_traces :: Bool + _tlOo_unbox :: Bool + _tlOoptions :: Options + _tlOparamMap :: ParamMap + _tlOprefix :: String + _tlOsyn :: Attributes + _hdIcomments :: ([String]) + _hdIsemDom :: ([Decl]) + _hdIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _hdIwrapDecls :: Decls + _tlIcomments :: ([String]) + _tlIisNil :: Bool + _tlIsemDom :: ([Decl]) + _tlIsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _tlIwrapDecls :: Decls + -- "./src-ag/GenerateCode.ag"(line 286, column 11) + _tlOnr = + ({-# LINE 286 "./src-ag/GenerateCode.ag" #-} + _lhsInr + 1 + {-# LINE 4388 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 299, column 12) + _lhsOisNil = + ({-# LINE 299 "./src-ag/GenerateCode.ag" #-} + False + {-# LINE 4394 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 300, column 12) + _hdOisLast = + ({-# LINE 300 "./src-ag/GenerateCode.ag" #-} + _tlIisNil + {-# LINE 4400 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 868, column 52) + _lhsOcomments = + ({-# LINE 868 "./src-ag/GenerateCode.ag" #-} + _hdIcomments ++ _tlIcomments + {-# LINE 4406 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 710, column 50) + _lhsOsemDom = + ({-# LINE 710 "./src-ag/GenerateCode.ag" #-} + _hdIsemDom ++ _tlIsemDom + {-# LINE 4412 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 744, column 86) + _lhsOsemDomUnfoldGath = + ({-# LINE 744 "./src-ag/GenerateCode.ag" #-} + _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath + {-# LINE 4418 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 829, column 52) + _lhsOwrapDecls = + ({-# LINE 829 "./src-ag/GenerateCode.ag" #-} + _hdIwrapDecls ++ _tlIwrapDecls + {-# LINE 4424 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIinh + {-# LINE 4430 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOnr = + ({-# LINE 278 "./src-ag/GenerateCode.ag" #-} + _lhsInr + {-# LINE 4436 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsInt + {-# LINE 4442 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 4448 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 4454 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 4460 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 4466 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 4472 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 4478 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 4484 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 4490 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 4496 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 4502 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 4508 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 4514 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 4520 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 4526 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 4532 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 4538 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 4544 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 4550 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 4556 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIinh + {-# LINE 4562 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsInt + {-# LINE 4568 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 4574 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 4580 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 4586 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 4592 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 4598 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 4604 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 4610 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 4616 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 4622 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 4628 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 4634 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 4640 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 4646 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 4652 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 4658 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 4664 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 4670 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 4676 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 4682 "dist/build/GenerateCode.hs" #-} + ) + ( _hdIcomments,_hdIsemDom,_hdIsemDomUnfoldGath,_hdIwrapDecls) = + hd_ _hdOinh _hdOisLast _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_monadic _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOoptions _hdOparamMap _hdOprefix _hdOsyn + ( _tlIcomments,_tlIisNil,_tlIsemDom,_tlIsemDomUnfoldGath,_tlIwrapDecls) = + tl_ _tlOinh _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_monadic _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOoptions _tlOparamMap _tlOprefix _tlOsyn + in ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls)))) +sem_CSegments_Nil :: T_CSegments +sem_CSegments_Nil = + (T_CSegments (\ _lhsIinh + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamMap + _lhsIprefix + _lhsIsyn -> + (let _lhsOisNil :: Bool + _lhsOcomments :: ([String]) + _lhsOsemDom :: ([Decl]) + _lhsOsemDomUnfoldGath :: (Map (NontermIdent, Int) ([String], Code.Type)) + _lhsOwrapDecls :: Decls + -- "./src-ag/GenerateCode.ag"(line 301, column 10) + _lhsOisNil = + ({-# LINE 301 "./src-ag/GenerateCode.ag" #-} + True + {-# LINE 4722 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 868, column 52) + _lhsOcomments = + ({-# LINE 868 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 4728 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 710, column 50) + _lhsOsemDom = + ({-# LINE 710 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 4734 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 744, column 86) + _lhsOsemDomUnfoldGath = + ({-# LINE 744 "./src-ag/GenerateCode.ag" #-} + Map.empty + {-# LINE 4740 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 829, column 52) + _lhsOwrapDecls = + ({-# LINE 829 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 4746 "dist/build/GenerateCode.hs" #-} + ) + in ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls)))) +-- CVisit ------------------------------------------------------ +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + allPragmas : PragmaMap + aroundMap : Set Identifier + children : [(Identifier,Type, ChildKind)] + con : ConstructorIdent + contextMap : ContextMap + inh : Attributes + instVisitNrs : Map Identifier Int + isLast : Bool + mergeMap : Map Identifier (Identifier, [Identifier]) + nextIntra : Exprs + nextIntraVars : Set String + nr : Int + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramInstMap : Map Identifier (NontermIdent, [String]) + paramMap : ParamMap + prefix : String + quantMap : QuantMap + syn : Attributes + terminals : [Identifier] + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + with_sig : Bool + wrappers : Set NontermIdent + chained attributes: + decls : Decls + visitedSet : Set Identifier + synthesized attributes: + comments : [String] + gatherInstVisitNrs : Map Identifier Int + intra : Exprs + intraVars : Set String + semNames : [String] + alternatives: + alternative CVisit: + child inh : {Attributes} + child syn : {Attributes} + child vss : Sequence + child intra : Sequence + child ordered : {Bool} + visit 0: + local higherOrderChildren : _ + local firstOrderChildren : _ + local firstOrderOrig : _ + local funcname : _ + local nextVisitName : _ + local nextVisitDecl : _ + local isOneVisit : _ + local hasWrappers : _ + local refDecls : _ + local decls : _ + local lastExprVars : _ + local blockFunDecls : _ + local blockFirstFunCall : _ + local costCentreDescr : _ + local addCostCentre : _ + local params : _ + local semFun : _ + local tsig : _ + local semType : _ + local typeSigs : _ + local o_do : _ + local o_case : _ + local declsType : _ + local o_splitsems : _ +-} +-- cata +sem_CVisit :: CVisit -> + T_CVisit +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 ((Set NontermIdent) -> + PragmaMap -> + (Set Identifier) -> + ([(Identifier,Type, ChildKind)]) -> + ConstructorIdent -> + ContextMap -> + Decls -> + Attributes -> + (Map Identifier Int) -> + Bool -> + (Map Identifier (Identifier, [Identifier])) -> + Exprs -> + (Set String) -> + Int -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + (Map Identifier (NontermIdent, [String])) -> + ParamMap -> + String -> + QuantMap -> + Attributes -> + ([Identifier]) -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + (Set Identifier) -> + Bool -> + (Set NontermIdent) -> + ( ([String]),Decls,(Map Identifier Int),Exprs,(Set String),([String]),(Set Identifier))) +data Inh_CVisit = Inh_CVisit {allNts_Inh_CVisit :: !((Set NontermIdent)),allPragmas_Inh_CVisit :: !(PragmaMap),aroundMap_Inh_CVisit :: !((Set Identifier)),children_Inh_CVisit :: !(([(Identifier,Type, ChildKind)])),con_Inh_CVisit :: !(ConstructorIdent),contextMap_Inh_CVisit :: !(ContextMap),decls_Inh_CVisit :: !(Decls),inh_Inh_CVisit :: !(Attributes),instVisitNrs_Inh_CVisit :: !((Map Identifier Int)),isLast_Inh_CVisit :: !(Bool),mergeMap_Inh_CVisit :: !((Map Identifier (Identifier, [Identifier]))),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_monadic_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),options_Inh_CVisit :: !(Options),paramInstMap_Inh_CVisit :: !((Map Identifier (NontermIdent, [String]))),paramMap_Inh_CVisit :: !(ParamMap),prefix_Inh_CVisit :: !(String),quantMap_Inh_CVisit :: !(QuantMap),syn_Inh_CVisit :: !(Attributes),terminals_Inh_CVisit :: !(([Identifier])),unfoldSemDom_Inh_CVisit :: !((NontermIdent -> Int -> [String] -> Code.Type)),visitedSet_Inh_CVisit :: !((Set Identifier)),with_sig_Inh_CVisit :: !(Bool),wrappers_Inh_CVisit :: !((Set NontermIdent))} +data Syn_CVisit = Syn_CVisit {comments_Syn_CVisit :: !(([String])),decls_Syn_CVisit :: !(Decls),gatherInstVisitNrs_Syn_CVisit :: !((Map Identifier Int)),intra_Syn_CVisit :: !(Exprs),intraVars_Syn_CVisit :: !((Set String)),semNames_Syn_CVisit :: !(([String])),visitedSet_Syn_CVisit :: !((Set Identifier))} +wrap_CVisit :: T_CVisit -> + Inh_CVisit -> + Syn_CVisit +wrap_CVisit (T_CVisit sem) (Inh_CVisit _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIdecls _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsImergeMap _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwith_sig _lhsIwrappers) = + (let ( _lhsOcomments,_lhsOdecls,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOsemNames,_lhsOvisitedSet) = sem _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIdecls _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsImergeMap _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwith_sig _lhsIwrappers + in (Syn_CVisit _lhsOcomments _lhsOdecls _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOsemNames _lhsOvisitedSet)) +sem_CVisit_CVisit :: Attributes -> + Attributes -> + T_Sequence -> + T_Sequence -> + Bool -> + T_CVisit +sem_CVisit_CVisit inh_ syn_ (T_Sequence vss_) (T_Sequence intra_) ordered_ = + (T_CVisit (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIchildren + _lhsIcon + _lhsIcontextMap + _lhsIdecls + _lhsIinh + _lhsIinstVisitNrs + _lhsIisLast + _lhsImergeMap + _lhsInextIntra + _lhsInextIntraVars + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamInstMap + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsIsyn + _lhsIterminals + _lhsIunfoldSemDom + _lhsIvisitedSet + _lhsIwith_sig + _lhsIwrappers -> + (let _lhsOintra :: Exprs + _lhsOintraVars :: (Set String) + _vssOlastExpr :: Expr + _intraOlastExpr :: Expr + _lhsOdecls :: Decls + _lhsOgatherInstVisitNrs :: (Map Identifier Int) + _vssOdeclsAbove :: ([Decl]) + _intraOdeclsAbove :: ([Decl]) + _lhsOcomments :: ([String]) + _vssOwhat :: String + _intraOwhat :: String + _lhsOsemNames :: ([String]) + _lhsOvisitedSet :: (Set Identifier) + _vssOallNts :: (Set NontermIdent) + _vssOaroundMap :: (Set Identifier) + _vssOchildren :: ([(Identifier,Type,ChildKind)]) + _vssOcon :: ConstructorIdent + _vssOinh :: Attributes + _vssOinstVisitNrs :: (Map Identifier Int) + _vssOmergeMap :: (Map Identifier (Identifier, [Identifier])) + _vssOnr :: Int + _vssOnt :: NontermIdent + _vssOo_case :: Bool + _vssOo_cata :: Bool + _vssOo_costcentre :: Bool + _vssOo_data :: (Maybe Bool) + _vssOo_linePragmas :: Bool + _vssOo_monadic :: Bool + _vssOo_newtypes :: Bool + _vssOo_pretty :: Bool + _vssOo_rename :: Bool + _vssOo_sem :: Bool + _vssOo_sig :: Bool + _vssOo_splitsems :: Bool + _vssOo_strictwrap :: Bool + _vssOo_traces :: Bool + _vssOo_unbox :: Bool + _vssOoptions :: Options + _vssOparamInstMap :: (Map Identifier (NontermIdent, [String])) + _vssOparamMap :: ParamMap + _vssOprefix :: String + _vssOsyn :: Attributes + _vssOterminals :: ([Identifier]) + _vssOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _vssOvisitedSet :: (Set Identifier) + _intraOallNts :: (Set NontermIdent) + _intraOaroundMap :: (Set Identifier) + _intraOchildren :: ([(Identifier,Type,ChildKind)]) + _intraOcon :: ConstructorIdent + _intraOinh :: Attributes + _intraOinstVisitNrs :: (Map Identifier Int) + _intraOmergeMap :: (Map Identifier (Identifier, [Identifier])) + _intraOnr :: Int + _intraOnt :: NontermIdent + _intraOo_case :: Bool + _intraOo_cata :: Bool + _intraOo_costcentre :: Bool + _intraOo_data :: (Maybe Bool) + _intraOo_linePragmas :: Bool + _intraOo_monadic :: Bool + _intraOo_newtypes :: Bool + _intraOo_pretty :: Bool + _intraOo_rename :: Bool + _intraOo_sem :: Bool + _intraOo_sig :: Bool + _intraOo_splitsems :: Bool + _intraOo_strictwrap :: Bool + _intraOo_traces :: Bool + _intraOo_unbox :: Bool + _intraOoptions :: Options + _intraOparamInstMap :: (Map Identifier (NontermIdent, [String])) + _intraOparamMap :: ParamMap + _intraOprefix :: String + _intraOsyn :: Attributes + _intraOterminals :: ([Identifier]) + _intraOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _intraOvisitedSet :: (Set Identifier) + _vssIallTpsFound :: Bool + _vssIblockDecls :: DeclBlocks + _vssIcomments :: ([String]) + _vssIdecls :: Decls + _vssIdeclsAbove :: ([Decl]) + _vssIdefinedInsts :: ([Identifier]) + _vssIexprs :: Exprs + _vssItSigs :: ([Decl]) + _vssItps :: ([Type]) + _vssIusedVars :: (Set String) + _vssIvisitedSet :: (Set Identifier) + _intraIallTpsFound :: Bool + _intraIblockDecls :: DeclBlocks + _intraIcomments :: ([String]) + _intraIdecls :: Decls + _intraIdeclsAbove :: ([Decl]) + _intraIdefinedInsts :: ([Identifier]) + _intraIexprs :: Exprs + _intraItSigs :: ([Decl]) + _intraItps :: ([Type]) + _intraIusedVars :: (Set String) + _intraIvisitedSet :: (Set Identifier) + -- "./src-ag/GenerateCode.ag"(line 310, column 13) + _lhsOintra = + ({-# LINE 310 "./src-ag/GenerateCode.ag" #-} + _intraIexprs + {-# LINE 5041 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 311, column 13) + _lhsOintraVars = + ({-# LINE 311 "./src-ag/GenerateCode.ag" #-} + _intraIusedVars + {-# LINE 5047 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 441, column 13) + (_higherOrderChildren,_firstOrderChildren) = + ({-# LINE 441 "./src-ag/GenerateCode.ag" #-} + partition (\(_,_,virt) -> isHigherOrder virt) _lhsIchildren + {-# LINE 5053 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 442, column 13) + _firstOrderOrig = + ({-# LINE 442 "./src-ag/GenerateCode.ag" #-} + map pickOrigType _firstOrderChildren + {-# LINE 5059 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 443, column 13) + _funcname = + ({-# LINE 443 "./src-ag/GenerateCode.ag" #-} + seqSemname _lhsIprefix _lhsInt _lhsIcon _lhsInr + {-# LINE 5065 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 444, column 13) + _nextVisitName = + ({-# LINE 444 "./src-ag/GenerateCode.ag" #-} + if _lhsIisLast then [] else [visitname _lhsIprefix _lhsInt (_lhsInr+1)] + {-# LINE 5071 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 445, column 13) + _nextVisitDecl = + ({-# LINE 445 "./src-ag/GenerateCode.ag" #-} + let lhs = TupleLhs _nextVisitName + rhs = Let _lhsIdecls (SimpleExpr fun) + fun = seqSemname _lhsIprefix _lhsInt _lhsIcon (_lhsInr+1) + in if _lhsIisLast + then [] + else [Decl lhs rhs (Set.fromList _nextVisitName) _lhsInextIntraVars] + {-# LINE 5082 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 452, column 13) + _isOneVisit = + ({-# LINE 452 "./src-ag/GenerateCode.ag" #-} + _lhsIisLast && _lhsInr == 0 + {-# LINE 5088 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 453, column 13) + _hasWrappers = + ({-# LINE 453 "./src-ag/GenerateCode.ag" #-} + _lhsInt `Set.member` _lhsIwrappers + {-# LINE 5094 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 454, column 13) + _refDecls = + ({-# LINE 454 "./src-ag/GenerateCode.ag" #-} + if _isOneVisit && _hasWrappers && reference _lhsIoptions + then let synAttrs = Map.toList syn_ + synNT = "Syn" ++ "_" ++ getName _lhsInt + synVars = [ SimpleExpr (attrname False _LHS a) | (a,_) <- synAttrs ] + rhs = App synNT synVars + lhs = Fun "___node" [] + in [Decl lhs rhs Set.empty Set.empty] + else [] + {-# LINE 5107 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 462, column 13) + _decls = + ({-# LINE 462 "./src-ag/GenerateCode.ag" #-} + _typeSigs ++ _vssIdecls ++ _nextVisitDecl ++ _refDecls + {-# LINE 5113 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 463, column 13) + _vssOlastExpr = + ({-# LINE 463 "./src-ag/GenerateCode.ag" #-} + mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_) $ map (SimpleExpr . lhsname False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName + {-# LINE 5119 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 464, column 13) + _intraOlastExpr = + ({-# LINE 464 "./src-ag/GenerateCode.ag" #-} + error "lastExpr: not used here" + {-# LINE 5125 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 465, column 13) + _lastExprVars = + ({-# LINE 465 "./src-ag/GenerateCode.ag" #-} + map (lhsname False) (Map.keys syn_) ++ _nextVisitName + {-# LINE 5131 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 466, column 13) + (_blockFunDecls,_blockFirstFunCall) = + ({-# LINE 466 "./src-ag/GenerateCode.ag" #-} + mkPartitionedFunction _funcname _o_case _nextVisitDecl _lastExprVars _vssIblockDecls + {-# LINE 5137 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 468, column 13) + _costCentreDescr = + ({-# LINE 468 "./src-ag/GenerateCode.ag" #-} + "b" ++ ":" ++ show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show _lhsInr + {-# LINE 5143 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 469, column 13) + _addCostCentre = + ({-# LINE 469 "./src-ag/GenerateCode.ag" #-} + \v -> if _lhsIo_costcentre + then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v + else v + {-# LINE 5151 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 473, column 13) + _params = + ({-# LINE 473 "./src-ag/GenerateCode.ag" #-} + map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap + {-# LINE 5157 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 474, column 13) + _semFun = + ({-# LINE 474 "./src-ag/GenerateCode.ag" #-} + let lhs = Fun _funcname lhs_args + lhs_args = if _lhsInr == 0 then map field _firstOrderOrig else [] + field (name,NT tp tps _,_) = let unwrap | _lhsIo_newtypes = \x -> App (sdtype tp) [x] + | otherwise = id + addType expr | null tps = expr + | otherwise = TypedExpr expr (_lhsIunfoldSemDom tp 0 tps) + in unwrap $ addType $ SimpleExpr $ funname name 0 + field (name,tp,_) = let expr = SimpleExpr (funname name 0) + in if null _params + then expr + else TypedExpr expr (idEvalType $ typeToCodeType (Just _lhsInt) _params $ removeDeforested tp) + mbEvalTp | null _params = const Nothing + | otherwise = Just . idEvalType + rhs = wrap + . mkSemFun _lhsInt _lhsInr [mkLambdaArg (lhsname True nm) (mbEvalTp $ typeToCodeType (Just _lhsInt) _params $ removeDeforested tp) | (nm,tp) <- Map.assocs inh_] + $ _addCostCentre + $ if ordered_ && _o_splitsems + then _blockFirstFunCall + else mkDecls _declsType _decls + . ResultExpr (typeName _lhsInt _lhsInr) + . mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_) + $ map (SimpleExpr . lhsname False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName + wrap = if _lhsIo_newtypes + then \x -> App (typeName _lhsInt _lhsInr) [x] + else id + in Decl lhs rhs Set.empty Set.empty + {-# LINE 5188 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 505, column 13) + _tsig = + ({-# LINE 505 "./src-ag/GenerateCode.ag" #-} + TSig _funcname _semType + {-# LINE 5194 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 506, column 13) + _semType = + ({-# LINE 506 "./src-ag/GenerateCode.ag" #-} + let argType (NT tp tps _) r | tp /= _SELF = typeAppStrs (sdtype tp) tps `Arr` r + | tp == _SELF = error "GenerateCode: found an intra-type with type SELF, which should have been prevented by CRule.tps" + argType (Haskell tp) r = SimpleType tp `Arr` r + evalTp | null _params = id + | otherwise = idEvalType + in appQuant _lhsIquantMap _lhsInt $ appContext _lhsIcontextMap _lhsInt $ evalTp $ + if _lhsInr == 0 + then foldr argType (typeAppStrs (sdtype _lhsInt ) _params ) (map (\(_,t,_) -> t) _firstOrderOrig ) + else foldr argType (typeAppStrs (typeName _lhsInt _lhsInr) _params ) [] + {-# LINE 5208 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 517, column 13) + _lhsOdecls = + ({-# LINE 517 "./src-ag/GenerateCode.ag" #-} + ( if _lhsIwith_sig + then [_tsig, _semFun] + else [_semFun] + ) ++ + ( if ordered_ && _o_splitsems + then _blockFunDecls + else [] + ) + {-# LINE 5221 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 525, column 13) + _typeSigs = + ({-# LINE 525 "./src-ag/GenerateCode.ag" #-} + if _lhsIo_sig && not _o_case + then _vssItSigs + else [] + {-# LINE 5229 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 528, column 13) + _o_do = + ({-# LINE 528 "./src-ag/GenerateCode.ag" #-} + ordered_ && _lhsIo_monadic + {-# LINE 5235 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 529, column 13) + _o_case = + ({-# LINE 529 "./src-ag/GenerateCode.ag" #-} + not _o_do && _lhsIo_case && ordered_ && not (hasPragma _lhsIallPragmas _lhsInt _lhsIcon _NOCASE) + {-# LINE 5241 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 530, column 13) + _declsType = + ({-# LINE 530 "./src-ag/GenerateCode.ag" #-} + if _o_do + then DeclsDo + else if _o_case + then DeclsCase + else DeclsLet + {-# LINE 5251 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 535, column 13) + _o_splitsems = + ({-# LINE 535 "./src-ag/GenerateCode.ag" #-} + ordered_ && _lhsIo_splitsems + {-# LINE 5257 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 568, column 7) + _lhsOgatherInstVisitNrs = + ({-# LINE 568 "./src-ag/GenerateCode.ag" #-} + Map.fromList [(i,_lhsInr) | i <- _vssIdefinedInsts] + {-# LINE 5263 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 611, column 7) + _vssOdeclsAbove = + ({-# LINE 611 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 5269 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 612, column 7) + _intraOdeclsAbove = + ({-# LINE 612 "./src-ag/GenerateCode.ag" #-} + error "declsAbove: not used here" + {-# LINE 5275 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 894, column 18) + _lhsOcomments = + ({-# LINE 894 "./src-ag/GenerateCode.ag" #-} + let body = map ind (_vssIcomments ++ _intraIcomments) + in if null body + then [] + else ("visit " ++ show _lhsInr ++ ":") : body + {-# LINE 5284 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 898, column 18) + _vssOwhat = + ({-# LINE 898 "./src-ag/GenerateCode.ag" #-} + "local" + {-# LINE 5290 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 899, column 18) + _intraOwhat = + ({-# LINE 899 "./src-ag/GenerateCode.ag" #-} + "intra" + {-# LINE 5296 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 1156, column 7) + _lhsOsemNames = + ({-# LINE 1156 "./src-ag/GenerateCode.ag" #-} + [_funcname ] + {-# LINE 5302 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (up) + _lhsOvisitedSet = + ({-# LINE 145 "./src-ag/GenerateCode.ag" #-} + _intraIvisitedSet + {-# LINE 5308 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOallNts = + ({-# LINE 132 "./src-ag/GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 5314 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOaroundMap = + ({-# LINE 580 "./src-ag/GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 5320 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOchildren = + ({-# LINE 259 "./src-ag/GenerateCode.ag" #-} + _lhsIchildren + {-# LINE 5326 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOcon = + ({-# LINE 89 "./src-ag/GenerateCode.ag" #-} + _lhsIcon + {-# LINE 5332 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOinh = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIinh + {-# LINE 5338 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOinstVisitNrs = + ({-# LINE 560 "./src-ag/GenerateCode.ag" #-} + _lhsIinstVisitNrs + {-# LINE 5344 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOmergeMap = + ({-# LINE 596 "./src-ag/GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 5350 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOnr = + ({-# LINE 278 "./src-ag/GenerateCode.ag" #-} + _lhsInr + {-# LINE 5356 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOnt = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsInt + {-# LINE 5362 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _vssOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _o_case + {-# LINE 5368 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 5374 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 5380 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 5386 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 5392 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 5398 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 5404 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 5410 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 5416 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 5422 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 5428 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _vssOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _o_splitsems + {-# LINE 5434 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 5440 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 5446 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 5452 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 5458 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOparamInstMap = + ({-# LINE 101 "./src-ag/GenerateCode.ag" #-} + _lhsIparamInstMap + {-# LINE 5464 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 5470 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 5476 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOsyn = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 5482 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOterminals = + ({-# LINE 90 "./src-ag/GenerateCode.ag" #-} + _lhsIterminals + {-# LINE 5488 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOunfoldSemDom = + ({-# LINE 750 "./src-ag/GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 5494 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _vssOvisitedSet = + ({-# LINE 145 "./src-ag/GenerateCode.ag" #-} + _lhsIvisitedSet + {-# LINE 5500 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOallNts = + ({-# LINE 132 "./src-ag/GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 5506 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOaroundMap = + ({-# LINE 580 "./src-ag/GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 5512 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOchildren = + ({-# LINE 259 "./src-ag/GenerateCode.ag" #-} + _lhsIchildren + {-# LINE 5518 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOcon = + ({-# LINE 89 "./src-ag/GenerateCode.ag" #-} + _lhsIcon + {-# LINE 5524 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOinh = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIinh + {-# LINE 5530 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOinstVisitNrs = + ({-# LINE 560 "./src-ag/GenerateCode.ag" #-} + _lhsIinstVisitNrs + {-# LINE 5536 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOmergeMap = + ({-# LINE 596 "./src-ag/GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 5542 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOnr = + ({-# LINE 278 "./src-ag/GenerateCode.ag" #-} + _lhsInr + {-# LINE 5548 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOnt = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsInt + {-# LINE 5554 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _intraOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _o_case + {-# LINE 5560 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 5566 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 5572 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 5578 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 5584 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 5590 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 5596 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 5602 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 5608 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 5614 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 5620 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _intraOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _o_splitsems + {-# LINE 5626 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 5632 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 5638 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 5644 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 5650 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOparamInstMap = + ({-# LINE 101 "./src-ag/GenerateCode.ag" #-} + _lhsIparamInstMap + {-# LINE 5656 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 5662 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 5668 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOsyn = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 5674 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOterminals = + ({-# LINE 90 "./src-ag/GenerateCode.ag" #-} + _lhsIterminals + {-# LINE 5680 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _intraOunfoldSemDom = + ({-# LINE 750 "./src-ag/GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 5686 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (chain) + _intraOvisitedSet = + ({-# LINE 145 "./src-ag/GenerateCode.ag" #-} + _vssIvisitedSet + {-# LINE 5692 "dist/build/GenerateCode.hs" #-} + ) + ( _vssIallTpsFound,_vssIblockDecls,_vssIcomments,_vssIdecls,_vssIdeclsAbove,_vssIdefinedInsts,_vssIexprs,_vssItSigs,_vssItps,_vssIusedVars,_vssIvisitedSet) = + vss_ _vssOallNts _vssOaroundMap _vssOchildren _vssOcon _vssOdeclsAbove _vssOinh _vssOinstVisitNrs _vssOlastExpr _vssOmergeMap _vssOnr _vssOnt _vssOo_case _vssOo_cata _vssOo_costcentre _vssOo_data _vssOo_linePragmas _vssOo_monadic _vssOo_newtypes _vssOo_pretty _vssOo_rename _vssOo_sem _vssOo_sig _vssOo_splitsems _vssOo_strictwrap _vssOo_traces _vssOo_unbox _vssOoptions _vssOparamInstMap _vssOparamMap _vssOprefix _vssOsyn _vssOterminals _vssOunfoldSemDom _vssOvisitedSet _vssOwhat + ( _intraIallTpsFound,_intraIblockDecls,_intraIcomments,_intraIdecls,_intraIdeclsAbove,_intraIdefinedInsts,_intraIexprs,_intraItSigs,_intraItps,_intraIusedVars,_intraIvisitedSet) = + intra_ _intraOallNts _intraOaroundMap _intraOchildren _intraOcon _intraOdeclsAbove _intraOinh _intraOinstVisitNrs _intraOlastExpr _intraOmergeMap _intraOnr _intraOnt _intraOo_case _intraOo_cata _intraOo_costcentre _intraOo_data _intraOo_linePragmas _intraOo_monadic _intraOo_newtypes _intraOo_pretty _intraOo_rename _intraOo_sem _intraOo_sig _intraOo_splitsems _intraOo_strictwrap _intraOo_traces _intraOo_unbox _intraOoptions _intraOparamInstMap _intraOparamMap _intraOprefix _intraOsyn _intraOterminals _intraOunfoldSemDom _intraOvisitedSet _intraOwhat + in ( _lhsOcomments,_lhsOdecls,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOsemNames,_lhsOvisitedSet)))) +-- CVisits ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + allPragmas : PragmaMap + aroundMap : Set Identifier + children : [(Identifier,Type, ChildKind)] + con : ConstructorIdent + contextMap : ContextMap + inh : Attributes + instVisitNrs : Map Identifier Int + mergeMap : Map Identifier (Identifier, [Identifier]) + nr : Int + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramInstMap : Map Identifier (NontermIdent, [String]) + paramMap : ParamMap + prefix : String + quantMap : QuantMap + syn : Attributes + terminals : [Identifier] + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + with_sig : Bool + wrappers : Set NontermIdent + chained attribute: + visitedSet : Set Identifier + synthesized attributes: + comments : [String] + decls : Decls + gatherInstVisitNrs : Map Identifier Int + intra : Exprs + intraVars : Set String + isNil : Bool + semNames : [String] + alternatives: + alternative Cons: + child hd : CVisit + child tl : CVisits + alternative Nil: +-} +-- cata +sem_CVisits :: CVisits -> + T_CVisits +sem_CVisits list = + (Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list)) +-- semantic domain +newtype T_CVisits = T_CVisits ((Set NontermIdent) -> + PragmaMap -> + (Set Identifier) -> + ([(Identifier,Type, ChildKind)]) -> + ConstructorIdent -> + ContextMap -> + Attributes -> + (Map Identifier Int) -> + (Map Identifier (Identifier, [Identifier])) -> + Int -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + (Map Identifier (NontermIdent, [String])) -> + ParamMap -> + String -> + QuantMap -> + Attributes -> + ([Identifier]) -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + (Set Identifier) -> + Bool -> + (Set NontermIdent) -> + ( ([String]),Decls,(Map Identifier Int),Exprs,(Set String),Bool,([String]),(Set Identifier))) +data Inh_CVisits = Inh_CVisits {allNts_Inh_CVisits :: !((Set NontermIdent)),allPragmas_Inh_CVisits :: !(PragmaMap),aroundMap_Inh_CVisits :: !((Set Identifier)),children_Inh_CVisits :: !(([(Identifier,Type, ChildKind)])),con_Inh_CVisits :: !(ConstructorIdent),contextMap_Inh_CVisits :: !(ContextMap),inh_Inh_CVisits :: !(Attributes),instVisitNrs_Inh_CVisits :: !((Map Identifier Int)),mergeMap_Inh_CVisits :: !((Map Identifier (Identifier, [Identifier]))),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_monadic_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),options_Inh_CVisits :: !(Options),paramInstMap_Inh_CVisits :: !((Map Identifier (NontermIdent, [String]))),paramMap_Inh_CVisits :: !(ParamMap),prefix_Inh_CVisits :: !(String),quantMap_Inh_CVisits :: !(QuantMap),syn_Inh_CVisits :: !(Attributes),terminals_Inh_CVisits :: !(([Identifier])),unfoldSemDom_Inh_CVisits :: !((NontermIdent -> Int -> [String] -> Code.Type)),visitedSet_Inh_CVisits :: !((Set Identifier)),with_sig_Inh_CVisits :: !(Bool),wrappers_Inh_CVisits :: !((Set NontermIdent))} +data Syn_CVisits = Syn_CVisits {comments_Syn_CVisits :: !(([String])),decls_Syn_CVisits :: !(Decls),gatherInstVisitNrs_Syn_CVisits :: !((Map Identifier Int)),intra_Syn_CVisits :: !(Exprs),intraVars_Syn_CVisits :: !((Set String)),isNil_Syn_CVisits :: !(Bool),semNames_Syn_CVisits :: !(([String])),visitedSet_Syn_CVisits :: !((Set Identifier))} +wrap_CVisits :: T_CVisits -> + Inh_CVisits -> + Syn_CVisits +wrap_CVisits (T_CVisits sem) (Inh_CVisits _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwith_sig _lhsIwrappers) = + (let ( _lhsOcomments,_lhsOdecls,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames,_lhsOvisitedSet) = sem _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwith_sig _lhsIwrappers + in (Syn_CVisits _lhsOcomments _lhsOdecls _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOisNil _lhsOsemNames _lhsOvisitedSet)) +sem_CVisits_Cons :: T_CVisit -> + T_CVisits -> + T_CVisits +sem_CVisits_Cons (T_CVisit hd_) (T_CVisits tl_) = + (T_CVisits (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIchildren + _lhsIcon + _lhsIcontextMap + _lhsIinh + _lhsIinstVisitNrs + _lhsImergeMap + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamInstMap + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsIsyn + _lhsIterminals + _lhsIunfoldSemDom + _lhsIvisitedSet + _lhsIwith_sig + _lhsIwrappers -> + (let _tlOnr :: Int + _lhsOisNil :: Bool + _hdOisLast :: Bool + _hdOnextIntra :: Exprs + _hdOnextIntraVars :: (Set String) + _lhsOintra :: Exprs + _lhsOintraVars :: (Set String) + _lhsOdecls :: Decls + _hdOdecls :: Decls + _lhsOcomments :: ([String]) + _lhsOgatherInstVisitNrs :: (Map Identifier Int) + _lhsOsemNames :: ([String]) + _lhsOvisitedSet :: (Set Identifier) + _hdOallNts :: (Set NontermIdent) + _hdOallPragmas :: PragmaMap + _hdOaroundMap :: (Set Identifier) + _hdOchildren :: ([(Identifier,Type, ChildKind)]) + _hdOcon :: ConstructorIdent + _hdOcontextMap :: ContextMap + _hdOinh :: Attributes + _hdOinstVisitNrs :: (Map Identifier Int) + _hdOmergeMap :: (Map Identifier (Identifier, [Identifier])) + _hdOnr :: Int + _hdOnt :: NontermIdent + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_costcentre :: Bool + _hdOo_data :: (Maybe Bool) + _hdOo_linePragmas :: Bool + _hdOo_monadic :: Bool + _hdOo_newtypes :: Bool + _hdOo_pretty :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_splitsems :: Bool + _hdOo_strictwrap :: Bool + _hdOo_traces :: Bool + _hdOo_unbox :: Bool + _hdOoptions :: Options + _hdOparamInstMap :: (Map Identifier (NontermIdent, [String])) + _hdOparamMap :: ParamMap + _hdOprefix :: String + _hdOquantMap :: QuantMap + _hdOsyn :: Attributes + _hdOterminals :: ([Identifier]) + _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _hdOvisitedSet :: (Set Identifier) + _hdOwith_sig :: Bool + _hdOwrappers :: (Set NontermIdent) + _tlOallNts :: (Set NontermIdent) + _tlOallPragmas :: PragmaMap + _tlOaroundMap :: (Set Identifier) + _tlOchildren :: ([(Identifier,Type, ChildKind)]) + _tlOcon :: ConstructorIdent + _tlOcontextMap :: ContextMap + _tlOinh :: Attributes + _tlOinstVisitNrs :: (Map Identifier Int) + _tlOmergeMap :: (Map Identifier (Identifier, [Identifier])) + _tlOnt :: NontermIdent + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_costcentre :: Bool + _tlOo_data :: (Maybe Bool) + _tlOo_linePragmas :: Bool + _tlOo_monadic :: Bool + _tlOo_newtypes :: Bool + _tlOo_pretty :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_splitsems :: Bool + _tlOo_strictwrap :: Bool + _tlOo_traces :: Bool + _tlOo_unbox :: Bool + _tlOoptions :: Options + _tlOparamInstMap :: (Map Identifier (NontermIdent, [String])) + _tlOparamMap :: ParamMap + _tlOprefix :: String + _tlOquantMap :: QuantMap + _tlOsyn :: Attributes + _tlOterminals :: ([Identifier]) + _tlOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _tlOvisitedSet :: (Set Identifier) + _tlOwith_sig :: Bool + _tlOwrappers :: (Set NontermIdent) + _hdIcomments :: ([String]) + _hdIdecls :: Decls + _hdIgatherInstVisitNrs :: (Map Identifier Int) + _hdIintra :: Exprs + _hdIintraVars :: (Set String) + _hdIsemNames :: ([String]) + _hdIvisitedSet :: (Set Identifier) + _tlIcomments :: ([String]) + _tlIdecls :: Decls + _tlIgatherInstVisitNrs :: (Map Identifier Int) + _tlIintra :: Exprs + _tlIintraVars :: (Set String) + _tlIisNil :: Bool + _tlIsemNames :: ([String]) + _tlIvisitedSet :: (Set Identifier) + -- "./src-ag/GenerateCode.ag"(line 282, column 11) + _tlOnr = + ({-# LINE 282 "./src-ag/GenerateCode.ag" #-} + _lhsInr + 1 + {-# LINE 5953 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 295, column 12) + _lhsOisNil = + ({-# LINE 295 "./src-ag/GenerateCode.ag" #-} + False + {-# LINE 5959 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 296, column 12) + _hdOisLast = + ({-# LINE 296 "./src-ag/GenerateCode.ag" #-} + _tlIisNil + {-# LINE 5965 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 313, column 12) + _hdOnextIntra = + ({-# LINE 313 "./src-ag/GenerateCode.ag" #-} + _tlIintra + {-# LINE 5971 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 314, column 12) + _hdOnextIntraVars = + ({-# LINE 314 "./src-ag/GenerateCode.ag" #-} + _tlIintraVars + {-# LINE 5977 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 315, column 12) + _lhsOintra = + ({-# LINE 315 "./src-ag/GenerateCode.ag" #-} + _hdIintra + {-# LINE 5983 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 316, column 12) + _lhsOintraVars = + ({-# LINE 316 "./src-ag/GenerateCode.ag" #-} + _hdIintraVars + {-# LINE 5989 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 431, column 11) + _lhsOdecls = + ({-# LINE 431 "./src-ag/GenerateCode.ag" #-} + _hdIdecls + {-# LINE 5995 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 432, column 11) + _hdOdecls = + ({-# LINE 432 "./src-ag/GenerateCode.ag" #-} + _tlIdecls + {-# LINE 6001 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 868, column 52) + _lhsOcomments = + ({-# LINE 868 "./src-ag/GenerateCode.ag" #-} + _hdIcomments ++ _tlIcomments + {-# LINE 6007 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 561, column 44) + _lhsOgatherInstVisitNrs = + ({-# LINE 561 "./src-ag/GenerateCode.ag" #-} + _hdIgatherInstVisitNrs `Map.union` _tlIgatherInstVisitNrs + {-# LINE 6013 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 1146, column 61) + _lhsOsemNames = + ({-# LINE 1146 "./src-ag/GenerateCode.ag" #-} + _hdIsemNames ++ _tlIsemNames + {-# LINE 6019 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (up) + _lhsOvisitedSet = + ({-# LINE 145 "./src-ag/GenerateCode.ag" #-} + _tlIvisitedSet + {-# LINE 6025 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOallNts = + ({-# LINE 132 "./src-ag/GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 6031 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOallPragmas = + ({-# LINE 73 "./src-ag/GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 6037 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOaroundMap = + ({-# LINE 580 "./src-ag/GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 6043 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOchildren = + ({-# LINE 410 "./src-ag/GenerateCode.ag" #-} + _lhsIchildren + {-# LINE 6049 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 89 "./src-ag/GenerateCode.ag" #-} + _lhsIcon + {-# LINE 6055 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOcontextMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 6061 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIinh + {-# LINE 6067 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOinstVisitNrs = + ({-# LINE 560 "./src-ag/GenerateCode.ag" #-} + _lhsIinstVisitNrs + {-# LINE 6073 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 596 "./src-ag/GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 6079 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOnr = + ({-# LINE 278 "./src-ag/GenerateCode.ag" #-} + _lhsInr + {-# LINE 6085 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsInt + {-# LINE 6091 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 6097 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 6103 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 6109 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 6115 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 6121 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 6127 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 6133 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 6139 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 6145 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 6151 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 6157 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 6163 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 6169 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 6175 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 6181 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 6187 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOparamInstMap = + ({-# LINE 101 "./src-ag/GenerateCode.ag" #-} + _lhsIparamInstMap + {-# LINE 6193 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 6199 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 6205 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOquantMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 6211 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 6217 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOterminals = + ({-# LINE 90 "./src-ag/GenerateCode.ag" #-} + _lhsIterminals + {-# LINE 6223 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOunfoldSemDom = + ({-# LINE 750 "./src-ag/GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 6229 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOvisitedSet = + ({-# LINE 145 "./src-ag/GenerateCode.ag" #-} + _lhsIvisitedSet + {-# LINE 6235 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOwith_sig = + ({-# LINE 851 "./src-ag/GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 6241 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOwrappers = + ({-# LINE 987 "./src-ag/GenerateCode.ag" #-} + _lhsIwrappers + {-# LINE 6247 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOallNts = + ({-# LINE 132 "./src-ag/GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 6253 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOallPragmas = + ({-# LINE 73 "./src-ag/GenerateCode.ag" #-} + _lhsIallPragmas + {-# LINE 6259 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOaroundMap = + ({-# LINE 580 "./src-ag/GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 6265 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOchildren = + ({-# LINE 410 "./src-ag/GenerateCode.ag" #-} + _lhsIchildren + {-# LINE 6271 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 89 "./src-ag/GenerateCode.ag" #-} + _lhsIcon + {-# LINE 6277 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOcontextMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIcontextMap + {-# LINE 6283 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIinh + {-# LINE 6289 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOinstVisitNrs = + ({-# LINE 560 "./src-ag/GenerateCode.ag" #-} + _lhsIinstVisitNrs + {-# LINE 6295 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 596 "./src-ag/GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 6301 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsInt + {-# LINE 6307 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 6313 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 6319 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 6325 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 6331 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 6337 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 6343 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 6349 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 6355 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 6361 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 6367 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 6373 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 6379 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 6385 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 6391 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 6397 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 6403 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOparamInstMap = + ({-# LINE 101 "./src-ag/GenerateCode.ag" #-} + _lhsIparamInstMap + {-# LINE 6409 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 6415 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 6421 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOquantMap = + ({-# LINE 115 "./src-ag/GenerateCode.ag" #-} + _lhsIquantMap + {-# LINE 6427 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 6433 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOterminals = + ({-# LINE 90 "./src-ag/GenerateCode.ag" #-} + _lhsIterminals + {-# LINE 6439 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOunfoldSemDom = + ({-# LINE 750 "./src-ag/GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 6445 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (chain) + _tlOvisitedSet = + ({-# LINE 145 "./src-ag/GenerateCode.ag" #-} + _hdIvisitedSet + {-# LINE 6451 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOwith_sig = + ({-# LINE 851 "./src-ag/GenerateCode.ag" #-} + _lhsIwith_sig + {-# LINE 6457 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOwrappers = + ({-# LINE 987 "./src-ag/GenerateCode.ag" #-} + _lhsIwrappers + {-# LINE 6463 "dist/build/GenerateCode.hs" #-} + ) + ( _hdIcomments,_hdIdecls,_hdIgatherInstVisitNrs,_hdIintra,_hdIintraVars,_hdIsemNames,_hdIvisitedSet) = + hd_ _hdOallNts _hdOallPragmas _hdOaroundMap _hdOchildren _hdOcon _hdOcontextMap _hdOdecls _hdOinh _hdOinstVisitNrs _hdOisLast _hdOmergeMap _hdOnextIntra _hdOnextIntraVars _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_monadic _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOoptions _hdOparamInstMap _hdOparamMap _hdOprefix _hdOquantMap _hdOsyn _hdOterminals _hdOunfoldSemDom _hdOvisitedSet _hdOwith_sig _hdOwrappers + ( _tlIcomments,_tlIdecls,_tlIgatherInstVisitNrs,_tlIintra,_tlIintraVars,_tlIisNil,_tlIsemNames,_tlIvisitedSet) = + tl_ _tlOallNts _tlOallPragmas _tlOaroundMap _tlOchildren _tlOcon _tlOcontextMap _tlOinh _tlOinstVisitNrs _tlOmergeMap _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_monadic _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOoptions _tlOparamInstMap _tlOparamMap _tlOprefix _tlOquantMap _tlOsyn _tlOterminals _tlOunfoldSemDom _tlOvisitedSet _tlOwith_sig _tlOwrappers + in ( _lhsOcomments,_lhsOdecls,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames,_lhsOvisitedSet)))) +sem_CVisits_Nil :: T_CVisits +sem_CVisits_Nil = + (T_CVisits (\ _lhsIallNts + _lhsIallPragmas + _lhsIaroundMap + _lhsIchildren + _lhsIcon + _lhsIcontextMap + _lhsIinh + _lhsIinstVisitNrs + _lhsImergeMap + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamInstMap + _lhsIparamMap + _lhsIprefix + _lhsIquantMap + _lhsIsyn + _lhsIterminals + _lhsIunfoldSemDom + _lhsIvisitedSet + _lhsIwith_sig + _lhsIwrappers -> + (let _lhsOisNil :: Bool + _lhsOintra :: Exprs + _lhsOintraVars :: (Set String) + _lhsOdecls :: Decls + _lhsOcomments :: ([String]) + _lhsOgatherInstVisitNrs :: (Map Identifier Int) + _lhsOsemNames :: ([String]) + _lhsOvisitedSet :: (Set Identifier) + -- "./src-ag/GenerateCode.ag"(line 297, column 10) + _lhsOisNil = + ({-# LINE 297 "./src-ag/GenerateCode.ag" #-} + True + {-# LINE 6521 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 317, column 10) + _lhsOintra = + ({-# LINE 317 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 6527 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 318, column 10) + _lhsOintraVars = + ({-# LINE 318 "./src-ag/GenerateCode.ag" #-} + Set.empty + {-# LINE 6533 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 430, column 11) + _lhsOdecls = + ({-# LINE 430 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 6539 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 868, column 52) + _lhsOcomments = + ({-# LINE 868 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 6545 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 561, column 44) + _lhsOgatherInstVisitNrs = + ({-# LINE 561 "./src-ag/GenerateCode.ag" #-} + Map.empty + {-# LINE 6551 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 1146, column 61) + _lhsOsemNames = + ({-# LINE 1146 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 6557 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (chain) + _lhsOvisitedSet = + ({-# LINE 145 "./src-ag/GenerateCode.ag" #-} + _lhsIvisitedSet + {-# LINE 6563 "dist/build/GenerateCode.hs" #-} + ) + in ( _lhsOcomments,_lhsOdecls,_lhsOgatherInstVisitNrs,_lhsOintra,_lhsOintraVars,_lhsOisNil,_lhsOsemNames,_lhsOvisitedSet)))) +-- DeclBlocks -------------------------------------------------- +{- + visit 0: + inherited attributes: + blockNr : Int + lastExprVars : [String] + nextVisitDecls : [Decl] + optCase : Bool + prefix : String + synthesized attributes: + callExpr : Expr + decls : [Decl] + freeVars : [String] + alternatives: + alternative DeclBlock: + child defs : {[Decl]} + child visit : {Decl} + child next : DeclBlocks + visit 0: + local lambdaName : _ + local pragmaDecl : _ + local freeVars : _ + local decl : _ + alternative DeclTerminator: + child defs : {[Decl]} + child result : {Expr} + visit 0: + local lambdaName : _ + local pragmaDecl : _ + local freeVars : _ +-} +-- cata +sem_DeclBlocks :: DeclBlocks -> + T_DeclBlocks +sem_DeclBlocks (DeclBlock _defs _visit _next) = + (sem_DeclBlocks_DeclBlock _defs _visit (sem_DeclBlocks _next)) +sem_DeclBlocks (DeclTerminator _defs _result) = + (sem_DeclBlocks_DeclTerminator _defs _result) +-- semantic domain +newtype T_DeclBlocks = T_DeclBlocks (Int -> + ([String]) -> + ([Decl]) -> + 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]))} +wrap_DeclBlocks :: T_DeclBlocks -> + Inh_DeclBlocks -> + Syn_DeclBlocks +wrap_DeclBlocks (T_DeclBlocks sem) (Inh_DeclBlocks _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix) = + (let ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars) = sem _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix + in (Syn_DeclBlocks _lhsOcallExpr _lhsOdecls _lhsOfreeVars)) +sem_DeclBlocks_DeclBlock :: ([Decl]) -> + Decl -> + T_DeclBlocks -> + T_DeclBlocks +sem_DeclBlocks_DeclBlock defs_ visit_ (T_DeclBlocks next_) = + (T_DeclBlocks (\ _lhsIblockNr + _lhsIlastExprVars + _lhsInextVisitDecls + _lhsIoptCase + _lhsIprefix -> + (let _nextOblockNr :: Int + _lhsOcallExpr :: Expr + _lhsOdecls :: ([Decl]) + _lhsOfreeVars :: ([String]) + _nextOlastExprVars :: ([String]) + _nextOnextVisitDecls :: ([Decl]) + _nextOoptCase :: Bool + _nextOprefix :: String + _nextIcallExpr :: Expr + _nextIdecls :: ([Decl]) + _nextIfreeVars :: ([String]) + -- "./src-ag/GenerateCode.ag"(line 662, column 7) + _nextOblockNr = + ({-# LINE 662 "./src-ag/GenerateCode.ag" #-} + _lhsIblockNr + 1 + {-# LINE 6644 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 667, column 7) + _lambdaName = + ({-# LINE 667 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix ++ "_block" ++ show _lhsIblockNr + {-# LINE 6650 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 668, column 7) + _pragmaDecl = + ({-# LINE 668 "./src-ag/GenerateCode.ag" #-} + PragmaDecl ("NOINLINE " ++ _lambdaName ) + {-# LINE 6656 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 669, column 7) + _lhsOcallExpr = + ({-# LINE 669 "./src-ag/GenerateCode.ag" #-} + App _lambdaName (map SimpleExpr _freeVars ) + {-# LINE 6662 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 673, column 7) + _freeVars = + ({-# LINE 673 "./src-ag/GenerateCode.ag" #-} + freevars _nextIfreeVars (visit_ : defs_) + {-# LINE 6668 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 680, column 7) + _decl = + ({-# LINE 680 "./src-ag/GenerateCode.ag" #-} + mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ [visit_]) _nextIcallExpr + {-# LINE 6674 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 681, column 7) + _lhsOdecls = + ({-# LINE 681 "./src-ag/GenerateCode.ag" #-} + (if _lhsIblockNr > 1 then [_pragmaDecl ] else []) ++ [_decl ] ++ _nextIdecls + {-# LINE 6680 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _lhsOfreeVars = + ({-# LINE 664 "./src-ag/GenerateCode.ag" #-} + _freeVars + {-# LINE 6686 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _nextOlastExprVars = + ({-# LINE 648 "./src-ag/GenerateCode.ag" #-} + _lhsIlastExprVars + {-# LINE 6692 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _nextOnextVisitDecls = + ({-# LINE 648 "./src-ag/GenerateCode.ag" #-} + _lhsInextVisitDecls + {-# LINE 6698 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _nextOoptCase = + ({-# LINE 648 "./src-ag/GenerateCode.ag" #-} + _lhsIoptCase + {-# LINE 6704 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _nextOprefix = + ({-# LINE 648 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 6710 "dist/build/GenerateCode.hs" #-} + ) + ( _nextIcallExpr,_nextIdecls,_nextIfreeVars) = + next_ _nextOblockNr _nextOlastExprVars _nextOnextVisitDecls _nextOoptCase _nextOprefix + in ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars)))) +sem_DeclBlocks_DeclTerminator :: ([Decl]) -> + Expr -> + T_DeclBlocks +sem_DeclBlocks_DeclTerminator defs_ result_ = + (T_DeclBlocks (\ _lhsIblockNr + _lhsIlastExprVars + _lhsInextVisitDecls + _lhsIoptCase + _lhsIprefix -> + (let _lhsOcallExpr :: Expr + _lhsOdecls :: ([Decl]) + _lhsOfreeVars :: ([String]) + -- "./src-ag/GenerateCode.ag"(line 667, column 7) + _lambdaName = + ({-# LINE 667 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix ++ "_block" ++ show _lhsIblockNr + {-# LINE 6731 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 668, column 7) + _pragmaDecl = + ({-# LINE 668 "./src-ag/GenerateCode.ag" #-} + PragmaDecl ("NOINLINE " ++ _lambdaName ) + {-# LINE 6737 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 669, column 7) + _lhsOcallExpr = + ({-# LINE 669 "./src-ag/GenerateCode.ag" #-} + App _lambdaName (map SimpleExpr _freeVars ) + {-# LINE 6743 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 671, column 7) + _freeVars = + ({-# LINE 671 "./src-ag/GenerateCode.ag" #-} + freevars _lhsIlastExprVars (defs_ ++ _lhsInextVisitDecls) + {-# LINE 6749 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 678, column 7) + _lhsOdecls = + ({-# LINE 678 "./src-ag/GenerateCode.ag" #-} + [ mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ _lhsInextVisitDecls) result_ ] + {-# LINE 6755 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (from local) + _lhsOfreeVars = + ({-# LINE 664 "./src-ag/GenerateCode.ag" #-} + _freeVars + {-# LINE 6761 "dist/build/GenerateCode.hs" #-} + ) + in ( _lhsOcallExpr,_lhsOdecls,_lhsOfreeVars)))) +-- DeclBlocksRoot ---------------------------------------------- +{- + visit 0: + inherited attributes: + lastExprVars : [String] + nextVisitDecls : [Decl] + optCase : Bool + prefix : String + synthesized attributes: + firstCall : Expr + lambdas : [Decl] + alternatives: + alternative DeclBlocksRoot: + child blocks : DeclBlocks +-} +-- cata +sem_DeclBlocksRoot :: DeclBlocksRoot -> + T_DeclBlocksRoot +sem_DeclBlocksRoot (DeclBlocksRoot _blocks) = + (sem_DeclBlocksRoot_DeclBlocksRoot (sem_DeclBlocks _blocks)) +-- semantic domain +newtype T_DeclBlocksRoot = T_DeclBlocksRoot (([String]) -> + ([Decl]) -> + 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]))} +wrap_DeclBlocksRoot :: T_DeclBlocksRoot -> + Inh_DeclBlocksRoot -> + Syn_DeclBlocksRoot +wrap_DeclBlocksRoot (T_DeclBlocksRoot sem) (Inh_DeclBlocksRoot _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix) = + (let ( _lhsOfirstCall,_lhsOlambdas) = sem _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix + in (Syn_DeclBlocksRoot _lhsOfirstCall _lhsOlambdas)) +sem_DeclBlocksRoot_DeclBlocksRoot :: T_DeclBlocks -> + T_DeclBlocksRoot +sem_DeclBlocksRoot_DeclBlocksRoot (T_DeclBlocks blocks_) = + (T_DeclBlocksRoot (\ _lhsIlastExprVars + _lhsInextVisitDecls + _lhsIoptCase + _lhsIprefix -> + (let _lhsOlambdas :: ([Decl]) + _lhsOfirstCall :: Expr + _blocksOblockNr :: Int + _blocksOlastExprVars :: ([String]) + _blocksOnextVisitDecls :: ([Decl]) + _blocksOoptCase :: Bool + _blocksOprefix :: String + _blocksIcallExpr :: Expr + _blocksIdecls :: ([Decl]) + _blocksIfreeVars :: ([String]) + -- "./src-ag/GenerateCode.ag"(line 653, column 7) + _lhsOlambdas = + ({-# LINE 653 "./src-ag/GenerateCode.ag" #-} + _blocksIdecls + {-# LINE 6819 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 654, column 7) + _lhsOfirstCall = + ({-# LINE 654 "./src-ag/GenerateCode.ag" #-} + _blocksIcallExpr + {-# LINE 6825 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 659, column 7) + _blocksOblockNr = + ({-# LINE 659 "./src-ag/GenerateCode.ag" #-} + 1 + {-# LINE 6831 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _blocksOlastExprVars = + ({-# LINE 648 "./src-ag/GenerateCode.ag" #-} + _lhsIlastExprVars + {-# LINE 6837 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _blocksOnextVisitDecls = + ({-# LINE 648 "./src-ag/GenerateCode.ag" #-} + _lhsInextVisitDecls + {-# LINE 6843 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _blocksOoptCase = + ({-# LINE 648 "./src-ag/GenerateCode.ag" #-} + _lhsIoptCase + {-# LINE 6849 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _blocksOprefix = + ({-# LINE 648 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 6855 "dist/build/GenerateCode.hs" #-} + ) + ( _blocksIcallExpr,_blocksIdecls,_blocksIfreeVars) = + blocks_ _blocksOblockNr _blocksOlastExprVars _blocksOnextVisitDecls _blocksOoptCase _blocksOprefix + in ( _lhsOfirstCall,_lhsOlambdas)))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : Pattern + definedInsts : [Identifier] + patternAttributes : [(Identifier, Identifier)] + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern (Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern (Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern (Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +sem_Pattern (Underscore _pos) = + (sem_Pattern_Underscore _pos) +-- 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)]))} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem) (Inh_Pattern) = + (let ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes) = sem + in (Syn_Pattern _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes)) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_) = + (T_Pattern (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOpatternAttributes :: ([(Identifier, Identifier)]) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIdefinedInsts :: ([Identifier]) + _patsIpatternAttributes :: ([(Identifier, Identifier)]) + -- use rule "./src-ag/GenerateCode.ag"(line 261, column 55) + _lhsOdefinedInsts = + ({-# LINE 261 "./src-ag/GenerateCode.ag" #-} + _patsIdefinedInsts + {-# LINE 6930 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 268, column 47) + _lhsOpatternAttributes = + ({-# LINE 268 "./src-ag/GenerateCode.ag" #-} + _patsIpatternAttributes + {-# LINE 6936 "dist/build/GenerateCode.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 6942 "dist/build/GenerateCode.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 6948 "dist/build/GenerateCode.hs" #-} + ) + ( _patsIcopy,_patsIdefinedInsts,_patsIpatternAttributes) = + pats_ + in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes))) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_) = + (T_Pattern (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOpatternAttributes :: ([(Identifier, Identifier)]) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIdefinedInsts :: ([Identifier]) + _patsIpatternAttributes :: ([(Identifier, Identifier)]) + -- use rule "./src-ag/GenerateCode.ag"(line 261, column 55) + _lhsOdefinedInsts = + ({-# LINE 261 "./src-ag/GenerateCode.ag" #-} + _patsIdefinedInsts + {-# LINE 6967 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 268, column 47) + _lhsOpatternAttributes = + ({-# LINE 268 "./src-ag/GenerateCode.ag" #-} + _patsIpatternAttributes + {-# LINE 6973 "dist/build/GenerateCode.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 6979 "dist/build/GenerateCode.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 6985 "dist/build/GenerateCode.hs" #-} + ) + ( _patsIcopy,_patsIdefinedInsts,_patsIpatternAttributes) = + pats_ + in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes))) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_) = + (T_Pattern (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOpatternAttributes :: ([(Identifier, Identifier)]) + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIdefinedInsts :: ([Identifier]) + _patIpatternAttributes :: ([(Identifier, Identifier)]) + -- "./src-ag/GenerateCode.ag"(line 263, column 11) + _lhsOdefinedInsts = + ({-# LINE 263 "./src-ag/GenerateCode.ag" #-} + (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts + {-# LINE 7005 "dist/build/GenerateCode.hs" #-} + ) + -- "./src-ag/GenerateCode.ag"(line 271, column 7) + _lhsOpatternAttributes = + ({-# LINE 271 "./src-ag/GenerateCode.ag" #-} + (field_,attr_) : _patIpatternAttributes + {-# LINE 7011 "dist/build/GenerateCode.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 7017 "dist/build/GenerateCode.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 7023 "dist/build/GenerateCode.hs" #-} + ) + ( _patIcopy,_patIdefinedInsts,_patIpatternAttributes) = + pat_ + in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes))) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_) = + (T_Pattern (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOpatternAttributes :: ([(Identifier, Identifier)]) + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIdefinedInsts :: ([Identifier]) + _patIpatternAttributes :: ([(Identifier, Identifier)]) + -- use rule "./src-ag/GenerateCode.ag"(line 261, column 55) + _lhsOdefinedInsts = + ({-# LINE 261 "./src-ag/GenerateCode.ag" #-} + _patIdefinedInsts + {-# LINE 7041 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 268, column 47) + _lhsOpatternAttributes = + ({-# LINE 268 "./src-ag/GenerateCode.ag" #-} + _patIpatternAttributes + {-# LINE 7047 "dist/build/GenerateCode.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 7053 "dist/build/GenerateCode.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 7059 "dist/build/GenerateCode.hs" #-} + ) + ( _patIcopy,_patIdefinedInsts,_patIpatternAttributes) = + pat_ + in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOpatternAttributes :: ([(Identifier, Identifier)]) + _lhsOcopy :: Pattern + -- use rule "./src-ag/GenerateCode.ag"(line 261, column 55) + _lhsOdefinedInsts = + ({-# LINE 261 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 7074 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 268, column 47) + _lhsOpatternAttributes = + ({-# LINE 268 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 7080 "dist/build/GenerateCode.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 7086 "dist/build/GenerateCode.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 7092 "dist/build/GenerateCode.hs" #-} + ) + in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : Patterns + definedInsts : [Identifier] + patternAttributes : [(Identifier, Identifier)] + 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,([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)]))} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem) (Inh_Patterns) = + (let ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes) = sem + in (Syn_Patterns _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = + (T_Patterns (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOpatternAttributes :: ([(Identifier, Identifier)]) + _lhsOcopy :: Patterns + _hdIcopy :: Pattern + _hdIdefinedInsts :: ([Identifier]) + _hdIpatternAttributes :: ([(Identifier, Identifier)]) + _tlIcopy :: Patterns + _tlIdefinedInsts :: ([Identifier]) + _tlIpatternAttributes :: ([(Identifier, Identifier)]) + -- use rule "./src-ag/GenerateCode.ag"(line 261, column 55) + _lhsOdefinedInsts = + ({-# LINE 261 "./src-ag/GenerateCode.ag" #-} + _hdIdefinedInsts ++ _tlIdefinedInsts + {-# LINE 7144 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 268, column 47) + _lhsOpatternAttributes = + ({-# LINE 268 "./src-ag/GenerateCode.ag" #-} + _hdIpatternAttributes ++ _tlIpatternAttributes + {-# LINE 7150 "dist/build/GenerateCode.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 7156 "dist/build/GenerateCode.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 7162 "dist/build/GenerateCode.hs" #-} + ) + ( _hdIcopy,_hdIdefinedInsts,_hdIpatternAttributes) = + hd_ + ( _tlIcopy,_tlIdefinedInsts,_tlIpatternAttributes) = + tl_ + in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOdefinedInsts :: ([Identifier]) + _lhsOpatternAttributes :: ([(Identifier, Identifier)]) + _lhsOcopy :: Patterns + -- use rule "./src-ag/GenerateCode.ag"(line 261, column 55) + _lhsOdefinedInsts = + ({-# LINE 261 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 7178 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 268, column 47) + _lhsOpatternAttributes = + ({-# LINE 268 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 7184 "dist/build/GenerateCode.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 7190 "dist/build/GenerateCode.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 7196 "dist/build/GenerateCode.hs" #-} + ) + in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes))) +-- Sequence ---------------------------------------------------- +{- + visit 0: + inherited attributes: + allNts : Set NontermIdent + aroundMap : Set Identifier + children : [(Identifier,Type,ChildKind)] + con : ConstructorIdent + inh : Attributes + instVisitNrs : Map Identifier Int + lastExpr : Expr + mergeMap : Map Identifier (Identifier, [Identifier]) + nr : Int + nt : NontermIdent + o_case : Bool + o_cata : Bool + o_costcentre : Bool + o_data : Maybe Bool + o_linePragmas : Bool + o_monadic : Bool + o_newtypes : Bool + o_pretty : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_splitsems : Bool + o_strictwrap : Bool + o_traces : Bool + o_unbox : Bool + options : Options + paramInstMap : Map Identifier (NontermIdent, [String]) + paramMap : ParamMap + prefix : String + syn : Attributes + terminals : [Identifier] + unfoldSemDom : NontermIdent -> Int -> [String] -> Code.Type + what : String + chained attributes: + declsAbove : [Decl] + visitedSet : Set Identifier + synthesized attributes: + allTpsFound : Bool + blockDecls : DeclBlocks + comments : [String] + decls : Decls + definedInsts : [Identifier] + exprs : Exprs + tSigs : [Decl] + tps : [Type] + usedVars : Set String + alternatives: + alternative Cons: + child hd : CRule + child tl : Sequence + alternative Nil: +-} +-- cata +sem_Sequence :: Sequence -> + T_Sequence +sem_Sequence list = + (Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list)) +-- semantic domain +newtype T_Sequence = T_Sequence ((Set NontermIdent) -> + (Set Identifier) -> + ([(Identifier,Type,ChildKind)]) -> + ConstructorIdent -> + ([Decl]) -> + Attributes -> + (Map Identifier Int) -> + Expr -> + (Map Identifier (Identifier, [Identifier])) -> + Int -> + NontermIdent -> + Bool -> + Bool -> + Bool -> + (Maybe Bool) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Options -> + (Map Identifier (NontermIdent, [String])) -> + ParamMap -> + String -> + Attributes -> + ([Identifier]) -> + (NontermIdent -> Int -> [String] -> Code.Type) -> + (Set Identifier) -> + String -> + ( Bool,DeclBlocks,([String]),Decls,([Decl]),([Identifier]),Exprs,([Decl]),([Type]),(Set String),(Set Identifier))) +data Inh_Sequence = Inh_Sequence {allNts_Inh_Sequence :: !((Set NontermIdent)),aroundMap_Inh_Sequence :: !((Set Identifier)),children_Inh_Sequence :: !(([(Identifier,Type,ChildKind)])),con_Inh_Sequence :: !(ConstructorIdent),declsAbove_Inh_Sequence :: !(([Decl])),inh_Inh_Sequence :: !(Attributes),instVisitNrs_Inh_Sequence :: !((Map Identifier Int)),lastExpr_Inh_Sequence :: !(Expr),mergeMap_Inh_Sequence :: !((Map Identifier (Identifier, [Identifier]))),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_monadic_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),options_Inh_Sequence :: !(Options),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)),visitedSet_Inh_Sequence :: !((Set 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])),exprs_Syn_Sequence :: !(Exprs),tSigs_Syn_Sequence :: !(([Decl])),tps_Syn_Sequence :: !(([Type])),usedVars_Syn_Sequence :: !((Set String)),visitedSet_Syn_Sequence :: !((Set Identifier))} +wrap_Sequence :: T_Sequence -> + Inh_Sequence -> + Syn_Sequence +wrap_Sequence (T_Sequence sem) (Inh_Sequence _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat) = + (let ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars,_lhsOvisitedSet) = sem _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat + in (Syn_Sequence _lhsOallTpsFound _lhsOblockDecls _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars _lhsOvisitedSet)) +sem_Sequence_Cons :: T_CRule -> + T_Sequence -> + T_Sequence +sem_Sequence_Cons (T_CRule hd_) (T_Sequence tl_) = + (T_Sequence (\ _lhsIallNts + _lhsIaroundMap + _lhsIchildren + _lhsIcon + _lhsIdeclsAbove + _lhsIinh + _lhsIinstVisitNrs + _lhsIlastExpr + _lhsImergeMap + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamInstMap + _lhsIparamMap + _lhsIprefix + _lhsIsyn + _lhsIterminals + _lhsIunfoldSemDom + _lhsIvisitedSet + _lhsIwhat -> + (let _lhsOblockDecls :: DeclBlocks + _lhsOallTpsFound :: Bool + _lhsOcomments :: ([String]) + _lhsOdecls :: Decls + _lhsOdefinedInsts :: ([Identifier]) + _lhsOexprs :: Exprs + _lhsOtSigs :: ([Decl]) + _lhsOtps :: ([Type]) + _lhsOusedVars :: (Set String) + _lhsOdeclsAbove :: ([Decl]) + _lhsOvisitedSet :: (Set Identifier) + _hdOallNts :: (Set NontermIdent) + _hdOaroundMap :: (Set Identifier) + _hdOchildren :: ([(Identifier,Type,ChildKind)]) + _hdOcon :: ConstructorIdent + _hdOdeclsAbove :: ([Decl]) + _hdOinh :: Attributes + _hdOinstVisitNrs :: (Map Identifier Int) + _hdOmergeMap :: (Map Identifier (Identifier, [Identifier])) + _hdOnr :: Int + _hdOnt :: NontermIdent + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_costcentre :: Bool + _hdOo_data :: (Maybe Bool) + _hdOo_linePragmas :: Bool + _hdOo_monadic :: Bool + _hdOo_newtypes :: Bool + _hdOo_pretty :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_splitsems :: Bool + _hdOo_strictwrap :: Bool + _hdOo_traces :: Bool + _hdOo_unbox :: Bool + _hdOoptions :: Options + _hdOparamInstMap :: (Map Identifier (NontermIdent, [String])) + _hdOparamMap :: ParamMap + _hdOprefix :: String + _hdOsyn :: Attributes + _hdOterminals :: ([Identifier]) + _hdOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _hdOvisitedSet :: (Set Identifier) + _hdOwhat :: String + _tlOallNts :: (Set NontermIdent) + _tlOaroundMap :: (Set Identifier) + _tlOchildren :: ([(Identifier,Type,ChildKind)]) + _tlOcon :: ConstructorIdent + _tlOdeclsAbove :: ([Decl]) + _tlOinh :: Attributes + _tlOinstVisitNrs :: (Map Identifier Int) + _tlOlastExpr :: Expr + _tlOmergeMap :: (Map Identifier (Identifier, [Identifier])) + _tlOnr :: Int + _tlOnt :: NontermIdent + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_costcentre :: Bool + _tlOo_data :: (Maybe Bool) + _tlOo_linePragmas :: Bool + _tlOo_monadic :: Bool + _tlOo_newtypes :: Bool + _tlOo_pretty :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_splitsems :: Bool + _tlOo_strictwrap :: Bool + _tlOo_traces :: Bool + _tlOo_unbox :: Bool + _tlOoptions :: Options + _tlOparamInstMap :: (Map Identifier (NontermIdent, [String])) + _tlOparamMap :: ParamMap + _tlOprefix :: String + _tlOsyn :: Attributes + _tlOterminals :: ([Identifier]) + _tlOunfoldSemDom :: (NontermIdent -> Int -> [String] -> Code.Type) + _tlOvisitedSet :: (Set Identifier) + _tlOwhat :: String + _hdIallTpsFound :: Bool + _hdIbldBlocksFun :: (DeclBlocks -> DeclBlocks) + _hdIcomments :: ([String]) + _hdIdecls :: Decls + _hdIdeclsAbove :: ([Decl]) + _hdIdefinedInsts :: ([Identifier]) + _hdIexprs :: Exprs + _hdItSigs :: ([Decl]) + _hdItps :: ([Type]) + _hdIusedVars :: (Set String) + _hdIvisitedSet :: (Set Identifier) + _tlIallTpsFound :: Bool + _tlIblockDecls :: DeclBlocks + _tlIcomments :: ([String]) + _tlIdecls :: Decls + _tlIdeclsAbove :: ([Decl]) + _tlIdefinedInsts :: ([Identifier]) + _tlIexprs :: Exprs + _tlItSigs :: ([Decl]) + _tlItps :: ([Type]) + _tlIusedVars :: (Set String) + _tlIvisitedSet :: (Set Identifier) + -- "./src-ag/GenerateCode.ag"(line 622, column 7) + _lhsOblockDecls = + ({-# LINE 622 "./src-ag/GenerateCode.ag" #-} + _hdIbldBlocksFun _tlIblockDecls + {-# LINE 7450 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 416, column 39) + _lhsOallTpsFound = + ({-# LINE 416 "./src-ag/GenerateCode.ag" #-} + _hdIallTpsFound && _tlIallTpsFound + {-# LINE 7456 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 868, column 52) + _lhsOcomments = + ({-# LINE 868 "./src-ag/GenerateCode.ag" #-} + _hdIcomments ++ _tlIcomments + {-# LINE 7462 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 155, column 34) + _lhsOdecls = + ({-# LINE 155 "./src-ag/GenerateCode.ag" #-} + _hdIdecls ++ _tlIdecls + {-# LINE 7468 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 261, column 55) + _lhsOdefinedInsts = + ({-# LINE 261 "./src-ag/GenerateCode.ag" #-} + _hdIdefinedInsts ++ _tlIdefinedInsts + {-# LINE 7474 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 334, column 34) + _lhsOexprs = + ({-# LINE 334 "./src-ag/GenerateCode.ag" #-} + _hdIexprs ++ _tlIexprs + {-# LINE 7480 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 363, column 33) + _lhsOtSigs = + ({-# LINE 363 "./src-ag/GenerateCode.ag" #-} + _hdItSigs ++ _tlItSigs + {-# LINE 7486 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 415, column 31) + _lhsOtps = + ({-# LINE 415 "./src-ag/GenerateCode.ag" #-} + _hdItps ++ _tlItps + {-# LINE 7492 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 352, column 37) + _lhsOusedVars = + ({-# LINE 352 "./src-ag/GenerateCode.ag" #-} + _hdIusedVars `Set.union` _tlIusedVars + {-# LINE 7498 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (up) + _lhsOdeclsAbove = + ({-# LINE 608 "./src-ag/GenerateCode.ag" #-} + _tlIdeclsAbove + {-# LINE 7504 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (up) + _lhsOvisitedSet = + ({-# LINE 145 "./src-ag/GenerateCode.ag" #-} + _tlIvisitedSet + {-# LINE 7510 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOallNts = + ({-# LINE 132 "./src-ag/GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 7516 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOaroundMap = + ({-# LINE 580 "./src-ag/GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 7522 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOchildren = + ({-# LINE 259 "./src-ag/GenerateCode.ag" #-} + _lhsIchildren + {-# LINE 7528 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 89 "./src-ag/GenerateCode.ag" #-} + _lhsIcon + {-# LINE 7534 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOdeclsAbove = + ({-# LINE 608 "./src-ag/GenerateCode.ag" #-} + _lhsIdeclsAbove + {-# LINE 7540 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIinh + {-# LINE 7546 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOinstVisitNrs = + ({-# LINE 560 "./src-ag/GenerateCode.ag" #-} + _lhsIinstVisitNrs + {-# LINE 7552 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 596 "./src-ag/GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 7558 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOnr = + ({-# LINE 278 "./src-ag/GenerateCode.ag" #-} + _lhsInr + {-# LINE 7564 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsInt + {-# LINE 7570 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 7576 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 7582 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 7588 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 7594 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 7600 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 7606 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 7612 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 7618 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 7624 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 7630 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 7636 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 7642 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 7648 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 7654 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 7660 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 7666 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOparamInstMap = + ({-# LINE 101 "./src-ag/GenerateCode.ag" #-} + _lhsIparamInstMap + {-# LINE 7672 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 7678 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 7684 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 7690 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOterminals = + ({-# LINE 90 "./src-ag/GenerateCode.ag" #-} + _lhsIterminals + {-# LINE 7696 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOunfoldSemDom = + ({-# LINE 750 "./src-ag/GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 7702 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOvisitedSet = + ({-# LINE 145 "./src-ag/GenerateCode.ag" #-} + _lhsIvisitedSet + {-# LINE 7708 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _hdOwhat = + ({-# LINE 870 "./src-ag/GenerateCode.ag" #-} + _lhsIwhat + {-# LINE 7714 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOallNts = + ({-# LINE 132 "./src-ag/GenerateCode.ag" #-} + _lhsIallNts + {-# LINE 7720 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOaroundMap = + ({-# LINE 580 "./src-ag/GenerateCode.ag" #-} + _lhsIaroundMap + {-# LINE 7726 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOchildren = + ({-# LINE 259 "./src-ag/GenerateCode.ag" #-} + _lhsIchildren + {-# LINE 7732 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 89 "./src-ag/GenerateCode.ag" #-} + _lhsIcon + {-# LINE 7738 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (chain) + _tlOdeclsAbove = + ({-# LINE 608 "./src-ag/GenerateCode.ag" #-} + _hdIdeclsAbove + {-# LINE 7744 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIinh + {-# LINE 7750 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOinstVisitNrs = + ({-# LINE 560 "./src-ag/GenerateCode.ag" #-} + _lhsIinstVisitNrs + {-# LINE 7756 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOlastExpr = + ({-# LINE 606 "./src-ag/GenerateCode.ag" #-} + _lhsIlastExpr + {-# LINE 7762 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 596 "./src-ag/GenerateCode.ag" #-} + _lhsImergeMap + {-# LINE 7768 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOnr = + ({-# LINE 278 "./src-ag/GenerateCode.ag" #-} + _lhsInr + {-# LINE 7774 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsInt + {-# LINE 7780 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_case + {-# LINE 7786 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_cata + {-# LINE 7792 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_costcentre = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_costcentre + {-# LINE 7798 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_data = + ({-# LINE 48 "./src-ag/GenerateCode.ag" #-} + _lhsIo_data + {-# LINE 7804 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_linePragmas = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_linePragmas + {-# LINE 7810 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_monadic = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_monadic + {-# LINE 7816 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_newtypes + {-# LINE 7822 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_pretty = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_pretty + {-# LINE 7828 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_rename + {-# LINE 7834 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sem + {-# LINE 7840 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_sig + {-# LINE 7846 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_splitsems = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_splitsems + {-# LINE 7852 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_strictwrap = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_strictwrap + {-# LINE 7858 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_traces = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_traces + {-# LINE 7864 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 47 "./src-ag/GenerateCode.ag" #-} + _lhsIo_unbox + {-# LINE 7870 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 50 "./src-ag/GenerateCode.ag" #-} + _lhsIoptions + {-# LINE 7876 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOparamInstMap = + ({-# LINE 101 "./src-ag/GenerateCode.ag" #-} + _lhsIparamInstMap + {-# LINE 7882 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOparamMap = + ({-# LINE 95 "./src-ag/GenerateCode.ag" #-} + _lhsIparamMap + {-# LINE 7888 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 49 "./src-ag/GenerateCode.ag" #-} + _lhsIprefix + {-# LINE 7894 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 84 "./src-ag/GenerateCode.ag" #-} + _lhsIsyn + {-# LINE 7900 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOterminals = + ({-# LINE 90 "./src-ag/GenerateCode.ag" #-} + _lhsIterminals + {-# LINE 7906 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOunfoldSemDom = + ({-# LINE 750 "./src-ag/GenerateCode.ag" #-} + _lhsIunfoldSemDom + {-# LINE 7912 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (chain) + _tlOvisitedSet = + ({-# LINE 145 "./src-ag/GenerateCode.ag" #-} + _hdIvisitedSet + {-# LINE 7918 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (down) + _tlOwhat = + ({-# LINE 870 "./src-ag/GenerateCode.ag" #-} + _lhsIwhat + {-# LINE 7924 "dist/build/GenerateCode.hs" #-} + ) + ( _hdIallTpsFound,_hdIbldBlocksFun,_hdIcomments,_hdIdecls,_hdIdeclsAbove,_hdIdefinedInsts,_hdIexprs,_hdItSigs,_hdItps,_hdIusedVars,_hdIvisitedSet) = + hd_ _hdOallNts _hdOaroundMap _hdOchildren _hdOcon _hdOdeclsAbove _hdOinh _hdOinstVisitNrs _hdOmergeMap _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_monadic _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOoptions _hdOparamInstMap _hdOparamMap _hdOprefix _hdOsyn _hdOterminals _hdOunfoldSemDom _hdOvisitedSet _hdOwhat + ( _tlIallTpsFound,_tlIblockDecls,_tlIcomments,_tlIdecls,_tlIdeclsAbove,_tlIdefinedInsts,_tlIexprs,_tlItSigs,_tlItps,_tlIusedVars,_tlIvisitedSet) = + tl_ _tlOallNts _tlOaroundMap _tlOchildren _tlOcon _tlOdeclsAbove _tlOinh _tlOinstVisitNrs _tlOlastExpr _tlOmergeMap _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_monadic _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOoptions _tlOparamInstMap _tlOparamMap _tlOprefix _tlOsyn _tlOterminals _tlOunfoldSemDom _tlOvisitedSet _tlOwhat + in ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars,_lhsOvisitedSet)))) +sem_Sequence_Nil :: T_Sequence +sem_Sequence_Nil = + (T_Sequence (\ _lhsIallNts + _lhsIaroundMap + _lhsIchildren + _lhsIcon + _lhsIdeclsAbove + _lhsIinh + _lhsIinstVisitNrs + _lhsIlastExpr + _lhsImergeMap + _lhsInr + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_costcentre + _lhsIo_data + _lhsIo_linePragmas + _lhsIo_monadic + _lhsIo_newtypes + _lhsIo_pretty + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_splitsems + _lhsIo_strictwrap + _lhsIo_traces + _lhsIo_unbox + _lhsIoptions + _lhsIparamInstMap + _lhsIparamMap + _lhsIprefix + _lhsIsyn + _lhsIterminals + _lhsIunfoldSemDom + _lhsIvisitedSet + _lhsIwhat -> + (let _lhsOblockDecls :: DeclBlocks + _lhsOallTpsFound :: Bool + _lhsOcomments :: ([String]) + _lhsOdecls :: Decls + _lhsOdefinedInsts :: ([Identifier]) + _lhsOexprs :: Exprs + _lhsOtSigs :: ([Decl]) + _lhsOtps :: ([Type]) + _lhsOusedVars :: (Set String) + _lhsOdeclsAbove :: ([Decl]) + _lhsOvisitedSet :: (Set Identifier) + -- "./src-ag/GenerateCode.ag"(line 624, column 7) + _lhsOblockDecls = + ({-# LINE 624 "./src-ag/GenerateCode.ag" #-} + DeclTerminator _lhsIdeclsAbove _lhsIlastExpr + {-# LINE 7983 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 416, column 39) + _lhsOallTpsFound = + ({-# LINE 416 "./src-ag/GenerateCode.ag" #-} + True + {-# LINE 7989 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 868, column 52) + _lhsOcomments = + ({-# LINE 868 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 7995 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 155, column 34) + _lhsOdecls = + ({-# LINE 155 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 8001 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 261, column 55) + _lhsOdefinedInsts = + ({-# LINE 261 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 8007 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 334, column 34) + _lhsOexprs = + ({-# LINE 334 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 8013 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 363, column 33) + _lhsOtSigs = + ({-# LINE 363 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 8019 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 415, column 31) + _lhsOtps = + ({-# LINE 415 "./src-ag/GenerateCode.ag" #-} + [] + {-# LINE 8025 "dist/build/GenerateCode.hs" #-} + ) + -- use rule "./src-ag/GenerateCode.ag"(line 352, column 37) + _lhsOusedVars = + ({-# LINE 352 "./src-ag/GenerateCode.ag" #-} + Set.empty + {-# LINE 8031 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (chain) + _lhsOdeclsAbove = + ({-# LINE 608 "./src-ag/GenerateCode.ag" #-} + _lhsIdeclsAbove + {-# LINE 8037 "dist/build/GenerateCode.hs" #-} + ) + -- copy rule (chain) + _lhsOvisitedSet = + ({-# LINE 145 "./src-ag/GenerateCode.ag" #-} + _lhsIvisitedSet + {-# LINE 8043 "dist/build/GenerateCode.hs" #-} + ) + in ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars,_lhsOvisitedSet)))) diff --git a/dist/build/HsToken.hs b/dist/build/HsToken.hs new file mode 100644 --- /dev/null +++ b/dist/build/HsToken.hs @@ -0,0 +1,57 @@ + + +-- UUAGC 0.9.42.0 (src-ag/HsToken.ag) +module HsToken where +{-# LINE 2 "./src-ag/HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 10 "dist/build/HsToken.hs" #-} +-- HsToken ----------------------------------------------------- +{- + alternatives: + alternative AGLocal: + child var : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + alternative AGField: + child field : {Identifier} + child attr : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + alternative HsToken: + child value : {String} + child pos : {Pos} + alternative CharToken: + child value : {String} + child pos : {Pos} + alternative StrToken: + child value : {String} + child pos : {Pos} + alternative Err: + child mesg : {String} + child pos : {Pos} +-} +data HsToken = AGLocal (Identifier) (Pos) ((Maybe String)) + | AGField (Identifier) (Identifier) (Pos) ((Maybe String)) + | HsToken (String) (Pos) + | CharToken (String) (Pos) + | StrToken (String) (Pos) + | Err (String) (Pos) + deriving ( Show) +-- HsTokens ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : HsToken + child tl : HsTokens + alternative Nil: +-} +type HsTokens = [HsToken] +-- HsTokensRoot ------------------------------------------------ +{- + alternatives: + alternative HsTokensRoot: + child tokens : HsTokens +-} +data HsTokensRoot = HsTokensRoot (HsTokens) diff --git a/dist/build/Interfaces.hs b/dist/build/Interfaces.hs new file mode 100644 --- /dev/null +++ b/dist/build/Interfaces.hs @@ -0,0 +1,51 @@ + + +-- UUAGC 0.9.42.0 (src-ag/Interfaces.ag) +module Interfaces where +{-# LINE 2 "./src-ag/Interfaces.ag" #-} + +import CommonTypes +import SequentialTypes +{-# LINE 10 "dist/build/Interfaces.hs" #-} +-- IRoot ------------------------------------------------------- +{- + alternatives: + alternative IRoot: + child inters : Interfaces +-} +data IRoot = IRoot (Interfaces) +-- Interface --------------------------------------------------- +{- + alternatives: + alternative Interface: + child nt : {NontermIdent} + child cons : {[ConstructorIdent]} + child seg : Segments +-} +data Interface = Interface (NontermIdent) (([ConstructorIdent])) (Segments) +-- Interfaces -------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Interface + child tl : Interfaces + alternative Nil: +-} +type Interfaces = [Interface] +-- Segment ----------------------------------------------------- +{- + alternatives: + alternative Segment: + child inh : {[Vertex]} + child syn : {[Vertex]} +-} +data Segment = Segment (([Vertex])) (([Vertex])) +-- Segments ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : Segment + child tl : Segments + alternative Nil: +-} +type Segments = [Segment] diff --git a/dist/build/InterfacesRules.hs b/dist/build/InterfacesRules.hs new file mode 100644 --- /dev/null +++ b/dist/build/InterfacesRules.hs @@ -0,0 +1,1376 @@ +{-# OPTIONS_GHC -XBangPatterns #-} + +-- UUAGC 0.9.42.0 (src-ag/InterfacesRules.lag) +module InterfacesRules where +{-# LINE 10 "./src-ag/InterfacesRules.lag" #-} + +import Interfaces +import SequentialTypes +import CodeSyntax +import GrammarInfo + +import qualified Data.Sequence as Seq +import Data.Sequence(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 Data.Foldable(toList) + +import Debug.Trace(trace) +{-# LINE 27 "dist/build/InterfacesRules.hs" #-} + +{-# LINE 2 "./src-ag/Interfaces.ag" #-} + +import CommonTypes +import SequentialTypes +{-# LINE 33 "dist/build/InterfacesRules.hs" #-} +{-# LINE 58 "./src-ag/InterfacesRules.lag" #-} + +type VisitSS = [Vertex] +{-# LINE 37 "dist/build/InterfacesRules.hs" #-} + +{-# LINE 93 "./src-ag/InterfacesRules.lag" #-} + +gather :: Info -> [Vertex] -> [[Vertex]] +gather info = eqClasses comp + where comp a b = isEqualField (ruleTable info ! a) (ruleTable info ! b) +{-# LINE 44 "dist/build/InterfacesRules.hs" #-} + +{-# LINE 134 "./src-ag/InterfacesRules.lag" #-} + +-- 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) +{-# LINE 55 "dist/build/InterfacesRules.hs" #-} + +{-# LINE 157 "./src-ag/InterfacesRules.lag" #-} + +ed v (inh,syn) = map (\i -> (i,v)) inh ++ map (\s -> (v,s)) syn +{-# LINE 60 "dist/build/InterfacesRules.hs" #-} + +{-# LINE 244 "./src-ag/InterfacesRules.lag" #-} + +postorder (Node a ts) = postorderF ts ++ [a] +postorderF = concatMap postorder +postOrd g = postorderF . dfs g +topSort' g = postOrd g +{-# LINE 68 "dist/build/InterfacesRules.hs" #-} + +{-# LINE 323 "./src-ag/InterfacesRules.lag" #-} + +type IntraVisit = [Vertex] +{-# LINE 73 "dist/build/InterfacesRules.hs" #-} + +{-# LINE 345 "./src-ag/InterfacesRules.lag" #-} + +swap (a,b) = (b,a) +{-# LINE 78 "dist/build/InterfacesRules.hs" #-} + +{-# LINE 419 "./src-ag/InterfacesRules.lag" #-} + +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 +{-# LINE 89 "dist/build/InterfacesRules.hs" #-} +-- 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 -> + Inh_IRoot -> + Syn_IRoot +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 (({-# LINE 83 "./src-ag/InterfacesRules.lag" #-} + _lhsIinfo + {-# LINE 135 "dist/build/InterfacesRules.hs" #-} + )) of + { !_intersOinfo -> + (case (({-# LINE 85 "./src-ag/InterfacesRules.lag" #-} + snd (bounds _lhsItdp) + 1 + {-# LINE 140 "dist/build/InterfacesRules.hs" #-} + )) of + { !_intersOv -> + (case (inters_ _intersOinfo _intersOv) of + { ( !_intersIdescr,!_intersIfirstvisitvertices,!_intersInewedges,!_intersIv,!T_Interfaces_1 inters_1) -> + (case (({-# LINE 260 "./src-ag/InterfacesRules.lag" #-} + let terminals = [ v | (v,cr) <- assocs (ruleTable _lhsIinfo), not (getHasCode cr), isLocal cr ] + in _intersIfirstvisitvertices ++ terminals + {-# LINE 148 "dist/build/InterfacesRules.hs" #-} + )) of + { !_intersOprev -> + (case (({-# LINE 71 "./src-ag/InterfacesRules.lag" #-} + toList _intersInewedges + {-# LINE 153 "dist/build/InterfacesRules.hs" #-} + )) of + { !_newedges -> + (case (({-# LINE 72 "./src-ag/InterfacesRules.lag" #-} + let graph = buildG (0,_intersIv-1) es + es = _newedges ++ edges _lhsItdp + in transposeG graph + {-# LINE 160 "dist/build/InterfacesRules.hs" #-} + )) of + { !_visitssGraph -> + (case (({-# LINE 218 "./src-ag/InterfacesRules.lag" #-} + _visitssGraph + {-# LINE 165 "dist/build/InterfacesRules.hs" #-} + )) of + { !_intersOvssGraph -> + (case (({-# LINE 147 "./src-ag/InterfacesRules.lag" #-} + toList _intersIdescr + {-# LINE 170 "dist/build/InterfacesRules.hs" #-} + )) of + { !_descr -> + (case (({-# LINE 127 "./src-ag/InterfacesRules.lag" #-} + Map.fromList _descr + {-# LINE 175 "dist/build/InterfacesRules.hs" #-} + )) of + { !_intersOvisitDescr -> + (case (inters_1 _intersOprev _intersOvisitDescr _intersOvssGraph) of + { ( !_intersIinters,!T_Interfaces_2 inters_2) -> + (case (({-# LINE 380 "./src-ag/InterfacesRules.lag" #-} + _intersIinters + {-# LINE 182 "dist/build/InterfacesRules.hs" #-} + )) of + { !_intersOallInters -> + (case (({-# LINE 343 "./src-ag/InterfacesRules.lag" #-} + buildG (0,_intersIv-1) (map swap (_lhsIdpr ++ _newedges)) + {-# LINE 187 "dist/build/InterfacesRules.hs" #-} + )) of + { !_intersOddp -> + (case (inters_2 _intersOallInters _intersOddp) of + { ( !_intersIedp,!_intersIvisits) -> + (case (({-# LINE 442 "./src-ag/InterfacesRules.lag" #-} + toList _intersIedp + {-# LINE 194 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOedp -> + (case (({-# LINE 382 "./src-ag/InterfacesRules.lag" #-} + _intersIinters + {-# LINE 199 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOinters -> + (case (({-# LINE 383 "./src-ag/InterfacesRules.lag" #-} + _intersIvisits + {-# LINE 204 "dist/build/InterfacesRules.hs" #-} + )) 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 -> + Inh_Interface -> + Syn_Interface +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 (({-# LINE 83 "./src-ag/InterfacesRules.lag" #-} + _lhsIinfo + {-# LINE 281 "dist/build/InterfacesRules.hs" #-} + )) of + { !_segOinfo -> + (case (({-# LINE 205 "./src-ag/InterfacesRules.lag" #-} + 0 + {-# LINE 286 "dist/build/InterfacesRules.hs" #-} + )) of + { !_segOn -> + (case (({-# LINE 195 "./src-ag/InterfacesRules.lag" #-} + \a -> ruleTable _lhsIinfo ! a + {-# LINE 291 "dist/build/InterfacesRules.hs" #-} + )) of + { !_look -> + (case (({-# LINE 187 "./src-ag/InterfacesRules.lag" #-} + _lhsIv + {-# LINE 296 "dist/build/InterfacesRules.hs" #-} + )) of + { !_segOv -> + (case (seg_ _segOinfo _segOn _segOv) of + { ( !_segIdescr,!_segIgroups,!_segInewedges,!_segInewvertices,!_segIv,!T_Segments_1 seg_1) -> + (case (({-# LINE 188 "./src-ag/InterfacesRules.lag" #-} + _segIv + length _segInewvertices + {-# LINE 303 "dist/build/InterfacesRules.hs" #-} + )) of + { !_v -> + (case (({-# LINE 190 "./src-ag/InterfacesRules.lag" #-} + [_segIv .. _v-1] + {-# LINE 308 "dist/build/InterfacesRules.hs" #-} + )) of + { !_firstvisitvertices -> + (case (({-# LINE 196 "./src-ag/InterfacesRules.lag" #-} + zipWith (cv _look (-1)) _firstvisitvertices _segIgroups + {-# LINE 313 "dist/build/InterfacesRules.hs" #-} + )) of + { !_descr -> + (case (({-# LINE 197 "./src-ag/InterfacesRules.lag" #-} + _segIdescr Seq.>< Seq.fromList _descr + {-# LINE 318 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOdescr -> + (case (({-# LINE 258 "./src-ag/InterfacesRules.lag" #-} + _firstvisitvertices + {-# LINE 323 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOfirstvisitvertices -> + (case (({-# LINE 191 "./src-ag/InterfacesRules.lag" #-} + zip _firstvisitvertices _segInewvertices + {-# LINE 328 "dist/build/InterfacesRules.hs" #-} + )) of + { !_newedges -> + (case (({-# LINE 192 "./src-ag/InterfacesRules.lag" #-} + _segInewedges Seq.>< Seq.fromList _newedges + {-# LINE 333 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOnewedges -> + (case (({-# LINE 189 "./src-ag/InterfacesRules.lag" #-} + _v + {-# LINE 338 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOv -> + (case ((let sem_Interface_Interface_1 :: T_Interface_1 + sem_Interface_Interface_1 = + (T_Interface_1 (\ (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (({-# LINE 216 "./src-ag/InterfacesRules.lag" #-} + _lhsIvssGraph + {-# LINE 348 "dist/build/InterfacesRules.hs" #-} + )) of + { !_segOvssGraph -> + (case (({-# LINE 125 "./src-ag/InterfacesRules.lag" #-} + _lhsIvisitDescr + {-# LINE 353 "dist/build/InterfacesRules.hs" #-} + )) of + { !_segOvisitDescr -> + (case (({-# LINE 263 "./src-ag/InterfacesRules.lag" #-} + _lhsIprev + {-# LINE 358 "dist/build/InterfacesRules.hs" #-} + )) of + { !_segOprev -> + (case (({-# LINE 237 "./src-ag/InterfacesRules.lag" #-} + cons_ + {-# LINE 363 "dist/build/InterfacesRules.hs" #-} + )) of + { !_segOcons -> + (case (seg_1 _segOcons _segOprev _segOvisitDescr _segOvssGraph) of + { ( !_segIsegs,!T_Segments_2 seg_2) -> + (case (({-# LINE 395 "./src-ag/InterfacesRules.lag" #-} + CInterface _segIsegs + {-# LINE 370 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOinter -> + (case (({-# LINE 391 "./src-ag/InterfacesRules.lag" #-} + nt_ + {-# LINE 375 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOnt -> + (case ((let sem_Interface_Interface_2 :: T_Interface_2 + sem_Interface_Interface_2 = + (T_Interface_2 (\ (!_lhsIallInters) + (!_lhsIddp) -> + (case (({-# LINE 341 "./src-ag/InterfacesRules.lag" #-} + _lhsIddp + {-# LINE 384 "dist/build/InterfacesRules.hs" #-} + )) of + { !_segOddp -> + (case (({-# LINE 378 "./src-ag/InterfacesRules.lag" #-} + _lhsIallInters + {-# LINE 389 "dist/build/InterfacesRules.hs" #-} + )) of + { !_segOallInters -> + (case (({-# LINE 351 "./src-ag/InterfacesRules.lag" #-} + _lhsIprev + {-# LINE 394 "dist/build/InterfacesRules.hs" #-} + )) of + { !_segOfromLhs -> + (case (({-# LINE 314 "./src-ag/InterfacesRules.lag" #-} + True + {-# LINE 399 "dist/build/InterfacesRules.hs" #-} + )) of + { !_segOisFirst -> + (case (seg_2 _segOallInters _segOddp _segOfromLhs _segOisFirst) of + { ( !_segIcvisits,!_segIedp,!_segIfirstInh,!_segIhdIntravisits,!_segIprev) -> + (case (({-# LINE 437 "./src-ag/InterfacesRules.lag" #-} + _segIedp + {-# LINE 406 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOedp -> + (case (({-# LINE 396 "./src-ag/InterfacesRules.lag" #-} + Map.fromList (zip cons_ (transpose _segIcvisits)) + {-# LINE 411 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOvisits -> + ( _lhsOedp,_lhsOvisits) }) }) }) }) }) }) }))) + in sem_Interface_Interface_2)) of + { ( !sem_Interface_2) -> + ( _lhsOinter,_lhsOnt,sem_Interface_2) }) }) }) }) }) }) }) }))) + in sem_Interface_Interface_1)) of + { ( !sem_Interface_1) -> + ( _lhsOdescr,_lhsOfirstvisitvertices,_lhsOnewedges,_lhsOv,sem_Interface_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +-- 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 -> + Inh_Interfaces -> + Syn_Interfaces +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 (({-# LINE 82 "./src-ag/InterfacesRules.lag" #-} + _lhsIv + {-# LINE 486 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOv -> + (case (({-# LINE 83 "./src-ag/InterfacesRules.lag" #-} + _lhsIinfo + {-# LINE 491 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOinfo -> + (case (hd_ _hdOinfo _hdOv) of + { ( !_hdIdescr,!_hdIfirstvisitvertices,!_hdInewedges,!_hdIv,!T_Interface_1 hd_1) -> + (case (({-# LINE 82 "./src-ag/InterfacesRules.lag" #-} + _hdIv + {-# LINE 498 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOv -> + (case (({-# LINE 83 "./src-ag/InterfacesRules.lag" #-} + _lhsIinfo + {-# LINE 503 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOinfo -> + (case (tl_ _tlOinfo _tlOv) of + { ( !_tlIdescr,!_tlIfirstvisitvertices,!_tlInewedges,!_tlIv,!T_Interfaces_1 tl_1) -> + (case (({-# LINE 130 "./src-ag/InterfacesRules.lag" #-} + _hdIdescr Seq.>< _tlIdescr + {-# LINE 510 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOdescr -> + (case (({-# LINE 258 "./src-ag/InterfacesRules.lag" #-} + _hdIfirstvisitvertices ++ _tlIfirstvisitvertices + {-# LINE 515 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOfirstvisitvertices -> + (case (({-# LINE 129 "./src-ag/InterfacesRules.lag" #-} + _hdInewedges Seq.>< _tlInewedges + {-# LINE 520 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOnewedges -> + (case (({-# LINE 82 "./src-ag/InterfacesRules.lag" #-} + _tlIv + {-# LINE 525 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOv -> + (case ((let sem_Interfaces_Cons_1 :: T_Interfaces_1 + sem_Interfaces_Cons_1 = + (T_Interfaces_1 (\ (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (({-# LINE 216 "./src-ag/InterfacesRules.lag" #-} + _lhsIvssGraph + {-# LINE 535 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOvssGraph -> + (case (({-# LINE 125 "./src-ag/InterfacesRules.lag" #-} + _lhsIvisitDescr + {-# LINE 540 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOvisitDescr -> + (case (({-# LINE 258 "./src-ag/InterfacesRules.lag" #-} + _lhsIprev + {-# LINE 545 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOprev -> + (case (({-# LINE 216 "./src-ag/InterfacesRules.lag" #-} + _lhsIvssGraph + {-# LINE 550 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOvssGraph -> + (case (({-# LINE 125 "./src-ag/InterfacesRules.lag" #-} + _lhsIvisitDescr + {-# LINE 555 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOvisitDescr -> + (case (({-# LINE 258 "./src-ag/InterfacesRules.lag" #-} + _lhsIprev + {-# LINE 560 "dist/build/InterfacesRules.hs" #-} + )) 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 (({-# LINE 385 "./src-ag/InterfacesRules.lag" #-} + Map.insert _hdInt _hdIinter _tlIinters + {-# LINE 569 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOinters -> + (case ((let sem_Interfaces_Cons_2 :: T_Interfaces_2 + sem_Interfaces_Cons_2 = + (T_Interfaces_2 (\ (!_lhsIallInters) + (!_lhsIddp) -> + (case (({-# LINE 341 "./src-ag/InterfacesRules.lag" #-} + _lhsIddp + {-# LINE 578 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOddp -> + (case (({-# LINE 378 "./src-ag/InterfacesRules.lag" #-} + _lhsIallInters + {-# LINE 583 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOallInters -> + (case (tl_2 _tlOallInters _tlOddp) of + { ( !_tlIedp,!_tlIvisits) -> + (case (({-# LINE 341 "./src-ag/InterfacesRules.lag" #-} + _lhsIddp + {-# LINE 590 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOddp -> + (case (({-# LINE 378 "./src-ag/InterfacesRules.lag" #-} + _lhsIallInters + {-# LINE 595 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOallInters -> + (case (hd_2 _hdOallInters _hdOddp) of + { ( !_hdIedp,!_hdIvisits) -> + (case (({-# LINE 437 "./src-ag/InterfacesRules.lag" #-} + _hdIedp Seq.>< _tlIedp + {-# LINE 602 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOedp -> + (case (({-# LINE 386 "./src-ag/InterfacesRules.lag" #-} + Map.insert _hdInt _hdIvisits _tlIvisits + {-# LINE 607 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOvisits -> + ( _lhsOedp,_lhsOvisits) }) }) }) }) }) }) }) }))) + in sem_Interfaces_Cons_2)) of + { ( !sem_Interfaces_2) -> + ( _lhsOinters,sem_Interfaces_2) }) }) }) }) }) }) }) }) }) }))) + in sem_Interfaces_Cons_1)) of + { ( !sem_Interfaces_1) -> + ( _lhsOdescr,_lhsOfirstvisitvertices,_lhsOnewedges,_lhsOv,sem_Interfaces_1) }) }) }) }) }) }) }) }) }) }) }))) +sem_Interfaces_Nil :: T_Interfaces +sem_Interfaces_Nil = + (T_Interfaces (\ (!_lhsIinfo) + (!_lhsIv) -> + (case (({-# LINE 130 "./src-ag/InterfacesRules.lag" #-} + Seq.empty + {-# LINE 623 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOdescr -> + (case (({-# LINE 258 "./src-ag/InterfacesRules.lag" #-} + [] + {-# LINE 628 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOfirstvisitvertices -> + (case (({-# LINE 129 "./src-ag/InterfacesRules.lag" #-} + Seq.empty + {-# LINE 633 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOnewedges -> + (case (({-# LINE 82 "./src-ag/InterfacesRules.lag" #-} + _lhsIv + {-# LINE 638 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOv -> + (case ((let sem_Interfaces_Nil_1 :: T_Interfaces_1 + sem_Interfaces_Nil_1 = + (T_Interfaces_1 (\ (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (({-# LINE 387 "./src-ag/InterfacesRules.lag" #-} + Map.empty + {-# LINE 648 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOinters -> + (case ((let sem_Interfaces_Nil_2 :: T_Interfaces_2 + sem_Interfaces_Nil_2 = + (T_Interfaces_2 (\ (!_lhsIallInters) + (!_lhsIddp) -> + (case (({-# LINE 437 "./src-ag/InterfacesRules.lag" #-} + Seq.empty + {-# LINE 657 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOedp -> + (case (({-# LINE 388 "./src-ag/InterfacesRules.lag" #-} + Map.empty + {-# LINE 662 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOvisits -> + ( _lhsOedp,_lhsOvisits) }) }))) + in sem_Interfaces_Nil_2)) of + { ( !sem_Interfaces_2) -> + ( _lhsOinters,sem_Interfaces_2) }) }))) + in sem_Interfaces_Nil_1)) of + { ( !sem_Interfaces_1) -> + ( _lhsOdescr,_lhsOfirstvisitvertices,_lhsOnewedges,_lhsOv,sem_Interfaces_1) }) }) }) }) }))) +-- 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 : _ + 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 -> + Inh_Segment -> + Syn_Segment +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 (({-# LINE 106 "./src-ag/InterfacesRules.lag" #-} + \a -> ruleTable _lhsIinfo ! a + {-# LINE 791 "dist/build/InterfacesRules.hs" #-} + )) of + { !_look -> + (case (({-# LINE 109 "./src-ag/InterfacesRules.lag" #-} + \p us -> [ a | u <- us + , a <- tdsToTdp _lhsIinfo ! u + , p (_look a)] + {-# LINE 798 "dist/build/InterfacesRules.hs" #-} + )) of + { !_occurAs -> + (case (({-# LINE 113 "./src-ag/InterfacesRules.lag" #-} + let group as = gather _lhsIinfo (_occurAs isRhs as) + in map (partition (isInh . _look)) (group (inh_ ++ syn_)) + {-# LINE 804 "dist/build/InterfacesRules.hs" #-} + )) of + { !_groups -> + (case (({-# LINE 116 "./src-ag/InterfacesRules.lag" #-} + _lhsIv + length _groups + {-# LINE 809 "dist/build/InterfacesRules.hs" #-} + )) of + { !_v -> + (case (({-# LINE 82 "./src-ag/InterfacesRules.lag" #-} + _v + {-# LINE 814 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOv -> + (case ((let sem_Segment_Segment_1 :: T_Segment_1 + sem_Segment_Segment_1 = + (T_Segment_1 (\ (!_lhsIn) + (!_lhsInextNewvertices) -> + (case (({-# LINE 117 "./src-ag/InterfacesRules.lag" #-} + [_lhsIv .. _v -1] + {-# LINE 823 "dist/build/InterfacesRules.hs" #-} + )) of + { !_newvertices -> + (case (({-# LINE 132 "./src-ag/InterfacesRules.lag" #-} + Seq.fromList $ zipWith (cv _look _lhsIn) _newvertices _groups + {-# LINE 828 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOdescr -> + (case (({-# LINE 182 "./src-ag/InterfacesRules.lag" #-} + _groups + {-# LINE 833 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOgroups -> + (case (({-# LINE 174 "./src-ag/InterfacesRules.lag" #-} + zip _newvertices _lhsInextNewvertices + {-# LINE 838 "dist/build/InterfacesRules.hs" #-} + )) of + { !_visitedges -> + (case (({-# LINE 155 "./src-ag/InterfacesRules.lag" #-} + concat (zipWith ed _newvertices _groups) + {-# LINE 843 "dist/build/InterfacesRules.hs" #-} + )) of + { !_attredges -> + (case (({-# LINE 175 "./src-ag/InterfacesRules.lag" #-} + Seq.fromList _attredges Seq.>< Seq.fromList _visitedges + {-# LINE 848 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOnewedges -> + (case (({-# LINE 166 "./src-ag/InterfacesRules.lag" #-} + _newvertices + {-# LINE 853 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOnewvertices -> + (case ((let sem_Segment_Segment_2 :: T_Segment_2 + sem_Segment_Segment_2 = + (T_Segment_2 (\ (!_lhsIcons) + (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (({-# LINE 229 "./src-ag/InterfacesRules.lag" #-} + gather _lhsIinfo (_occurAs isLhs syn_) + {-# LINE 864 "dist/build/InterfacesRules.hs" #-} + )) of + { !_synOccur -> + (case (({-# LINE 230 "./src-ag/InterfacesRules.lag" #-} + 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 + {-# LINE 873 "dist/build/InterfacesRules.hs" #-} + )) of + { !_vss -> + (case (({-# LINE 270 "./src-ag/InterfacesRules.lag" #-} + map (\\ _lhsIprev) _vss + {-# LINE 878 "dist/build/InterfacesRules.hs" #-} + )) of + { !_visitss' -> + (case (({-# LINE 284 "./src-ag/InterfacesRules.lag" #-} + 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' + {-# LINE 898 "dist/build/InterfacesRules.hs" #-} + )) of + { !_visitss -> + (case (({-# LINE 271 "./src-ag/InterfacesRules.lag" #-} + let defines v = case Map.lookup v _lhsIvisitDescr of + Nothing -> [v] + Just (ChildVisit _ _ _ inh _) -> v:inh + in concatMap (concatMap defines) _visitss + {-# LINE 906 "dist/build/InterfacesRules.hs" #-} + )) of + { !_defined -> + (case (({-# LINE 275 "./src-ag/InterfacesRules.lag" #-} + _lhsIprev ++ _defined + {-# LINE 911 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOprev -> + (case (({-# LINE 409 "./src-ag/InterfacesRules.lag" #-} + let makemap = Map.fromList . map findType + findType v = getNtaNameType (attrTable _lhsIinfo ! v) + in (makemap inh_,makemap syn_) + {-# LINE 918 "dist/build/InterfacesRules.hs" #-} + )) of + { !__tup1 -> + (case (({-# LINE 409 "./src-ag/InterfacesRules.lag" #-} + __tup1 + {-# LINE 923 "dist/build/InterfacesRules.hs" #-} + )) of + { !(_,!_synmap) -> + (case (({-# LINE 409 "./src-ag/InterfacesRules.lag" #-} + __tup1 + {-# LINE 928 "dist/build/InterfacesRules.hs" #-} + )) of + { !(!_inhmap,_) -> + (case (({-# LINE 405 "./src-ag/InterfacesRules.lag" #-} + if False then undefined _lhsIvssGraph _lhsIvisitDescr _lhsIprev else CSegment _inhmap _synmap + {-# LINE 933 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOseg -> + (case ((let sem_Segment_Segment_3 :: T_Segment_3 + sem_Segment_Segment_3 = + (T_Segment_3 (\ (!_lhsIallInters) + (!_lhsIddp) + (!_lhsIfromLhs) + (!_lhsIisFirst) + (!_lhsInextInh) + (!_lhsInextIntravisits) -> + (case (({-# LINE 357 "./src-ag/InterfacesRules.lag" #-} + 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 + {-# LINE 949 "dist/build/InterfacesRules.hs" #-} + )) of + { !_computed -> + (case (({-# LINE 356 "./src-ag/InterfacesRules.lag" #-} + _occurAs isLhs inh_ ++ _lhsIfromLhs + {-# LINE 954 "dist/build/InterfacesRules.hs" #-} + )) of + { !_fromLhs -> + (case (({-# LINE 362 "./src-ag/InterfacesRules.lag" #-} + \vs next -> + let needed = concatMap (_lhsIddp !) vs + in nub (needed ++ next) \\ (_fromLhs ++ _computed) + {-# LINE 961 "dist/build/InterfacesRules.hs" #-} + )) of + { !_iv -> + (case (({-# LINE 361 "./src-ag/InterfacesRules.lag" #-} + zipWith _iv _visitss _lhsInextIntravisits + {-# LINE 966 "dist/build/InterfacesRules.hs" #-} + )) of + { !_intravisits -> + (case (({-# LINE 412 "./src-ag/InterfacesRules.lag" #-} + 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 + {-# LINE 976 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOcvisits -> + (case (({-# LINE 439 "./src-ag/InterfacesRules.lag" #-} + Seq.fromList [(i,s) | i <- inh_, s <- syn_] + Seq.>< Seq.fromList [(s,i) | s <- syn_, i <- _lhsInextInh ] + {-# LINE 982 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOedp -> + (case (({-# LINE 444 "./src-ag/InterfacesRules.lag" #-} + inh_ + {-# LINE 987 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOinh -> + (case (({-# LINE 327 "./src-ag/InterfacesRules.lag" #-} + _intravisits + {-# LINE 992 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOintravisits -> + (case (({-# LINE 269 "./src-ag/InterfacesRules.lag" #-} + _visitss + {-# LINE 997 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOvisitss -> + ( _lhsOcvisits,_lhsOedp,_lhsOinh,_lhsOintravisits,_lhsOvisitss) }) }) }) }) }) }) }) }) }))) + in sem_Segment_Segment_3)) of + { ( !sem_Segment_3) -> + ( _lhsOprev,_lhsOseg,sem_Segment_3) }) }) }) }) }) }) }) }) }) }) }))) + in sem_Segment_Segment_2)) of + { ( !sem_Segment_2) -> + ( _lhsOdescr,_lhsOgroups,_lhsOnewedges,_lhsOnewvertices,sem_Segment_2) }) }) }) }) }) }) }) }))) + in sem_Segment_Segment_1)) of + { ( !sem_Segment_1) -> + ( _lhsOv,sem_Segment_1) }) }) }) }) }) }))) +-- 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 -> + Inh_Segments -> + Syn_Segments +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 (({-# LINE 82 "./src-ag/InterfacesRules.lag" #-} + _lhsIv + {-# LINE 1088 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOv -> + (case (({-# LINE 83 "./src-ag/InterfacesRules.lag" #-} + _lhsIinfo + {-# LINE 1093 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOinfo -> + (case (hd_ _hdOinfo _hdOv) of + { ( !_hdIv,!T_Segment_1 hd_1) -> + (case (({-# LINE 82 "./src-ag/InterfacesRules.lag" #-} + _hdIv + {-# LINE 1100 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOv -> + (case (({-# LINE 83 "./src-ag/InterfacesRules.lag" #-} + _lhsIinfo + {-# LINE 1105 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOinfo -> + (case (({-# LINE 203 "./src-ag/InterfacesRules.lag" #-} + _lhsIn + {-# LINE 1110 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOn -> + (case (({-# LINE 207 "./src-ag/InterfacesRules.lag" #-} + _lhsIn + 1 + {-# LINE 1115 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOn -> + (case (tl_ _tlOinfo _tlOn _tlOv) of + { ( !_tlIdescr,!_tlIgroups,!_tlInewedges,!_tlInewvertices,!_tlIv,!T_Segments_1 tl_1) -> + (case (({-# LINE 169 "./src-ag/InterfacesRules.lag" #-} + _tlInewvertices + {-# LINE 1122 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOnextNewvertices -> + (case (hd_1 _hdOn _hdOnextNewvertices) of + { ( !_hdIdescr,!_hdIgroups,!_hdInewedges,!_hdInewvertices,!T_Segment_2 hd_2) -> + (case (({-# LINE 130 "./src-ag/InterfacesRules.lag" #-} + _hdIdescr Seq.>< _tlIdescr + {-# LINE 1129 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOdescr -> + (case (({-# LINE 184 "./src-ag/InterfacesRules.lag" #-} + _hdIgroups + {-# LINE 1134 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOgroups -> + (case (({-# LINE 129 "./src-ag/InterfacesRules.lag" #-} + _hdInewedges Seq.>< _tlInewedges + {-# LINE 1139 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOnewedges -> + (case (({-# LINE 170 "./src-ag/InterfacesRules.lag" #-} + _hdInewvertices + {-# LINE 1144 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOnewvertices -> + (case (({-# LINE 82 "./src-ag/InterfacesRules.lag" #-} + _tlIv + {-# LINE 1149 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOv -> + (case ((let sem_Segments_Cons_1 :: T_Segments_1 + sem_Segments_Cons_1 = + (T_Segments_1 (\ (!_lhsIcons) + (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (({-# LINE 216 "./src-ag/InterfacesRules.lag" #-} + _lhsIvssGraph + {-# LINE 1160 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOvssGraph -> + (case (({-# LINE 125 "./src-ag/InterfacesRules.lag" #-} + _lhsIvisitDescr + {-# LINE 1165 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOvisitDescr -> + (case (({-# LINE 216 "./src-ag/InterfacesRules.lag" #-} + _lhsIvssGraph + {-# LINE 1170 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOvssGraph -> + (case (({-# LINE 125 "./src-ag/InterfacesRules.lag" #-} + _lhsIvisitDescr + {-# LINE 1175 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOvisitDescr -> + (case (({-# LINE 263 "./src-ag/InterfacesRules.lag" #-} + _lhsIprev + {-# LINE 1180 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOprev -> + (case (({-# LINE 235 "./src-ag/InterfacesRules.lag" #-} + _lhsIcons + {-# LINE 1185 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOcons -> + (case (hd_2 _hdOcons _hdOprev _hdOvisitDescr _hdOvssGraph) of + { ( !_hdIprev,!_hdIseg,!T_Segment_3 hd_3) -> + (case (({-# LINE 263 "./src-ag/InterfacesRules.lag" #-} + _hdIprev + {-# LINE 1192 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOprev -> + (case (({-# LINE 235 "./src-ag/InterfacesRules.lag" #-} + _lhsIcons + {-# LINE 1197 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOcons -> + (case (tl_1 _tlOcons _tlOprev _tlOvisitDescr _tlOvssGraph) of + { ( !_tlIsegs,!T_Segments_2 tl_2) -> + (case (({-# LINE 400 "./src-ag/InterfacesRules.lag" #-} + _hdIseg : _tlIsegs + {-# LINE 1204 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOsegs -> + (case ((let sem_Segments_Cons_2 :: T_Segments_2 + sem_Segments_Cons_2 = + (T_Segments_2 (\ (!_lhsIallInters) + (!_lhsIddp) + (!_lhsIfromLhs) + (!_lhsIisFirst) -> + (case (({-# LINE 341 "./src-ag/InterfacesRules.lag" #-} + _lhsIddp + {-# LINE 1215 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOddp -> + (case (({-# LINE 378 "./src-ag/InterfacesRules.lag" #-} + _lhsIallInters + {-# LINE 1220 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOallInters -> + (case (({-# LINE 341 "./src-ag/InterfacesRules.lag" #-} + _lhsIddp + {-# LINE 1225 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOddp -> + (case (({-# LINE 378 "./src-ag/InterfacesRules.lag" #-} + _lhsIallInters + {-# LINE 1230 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOallInters -> + (case (({-# LINE 354 "./src-ag/InterfacesRules.lag" #-} + [] + {-# LINE 1235 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOfromLhs -> + (case (({-# LINE 353 "./src-ag/InterfacesRules.lag" #-} + _lhsIfromLhs + {-# LINE 1240 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOfromLhs -> + (case (({-# LINE 316 "./src-ag/InterfacesRules.lag" #-} + False + {-# LINE 1245 "dist/build/InterfacesRules.hs" #-} + )) of + { !_tlOisFirst -> + (case (tl_2 _tlOallInters _tlOddp _tlOfromLhs _tlOisFirst) of + { ( !_tlIcvisits,!_tlIedp,!_tlIfirstInh,!_tlIhdIntravisits,!_tlIprev) -> + (case (({-# LINE 329 "./src-ag/InterfacesRules.lag" #-} + _tlIhdIntravisits + {-# LINE 1252 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOnextIntravisits -> + (case (({-# LINE 312 "./src-ag/InterfacesRules.lag" #-} + _lhsIisFirst + {-# LINE 1257 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOisFirst -> + (case (({-# LINE 446 "./src-ag/InterfacesRules.lag" #-} + _tlIfirstInh + {-# LINE 1262 "dist/build/InterfacesRules.hs" #-} + )) of + { !_hdOnextInh -> + (case (hd_3 _hdOallInters _hdOddp _hdOfromLhs _hdOisFirst _hdOnextInh _hdOnextIntravisits) of + { ( !_hdIcvisits,!_hdIedp,!_hdIinh,!_hdIintravisits,!_hdIvisitss) -> + (case (({-# LINE 399 "./src-ag/InterfacesRules.lag" #-} + _hdIcvisits : _tlIcvisits + {-# LINE 1269 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOcvisits -> + (case (({-# LINE 437 "./src-ag/InterfacesRules.lag" #-} + _hdIedp Seq.>< _tlIedp + {-# LINE 1274 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOedp -> + (case (({-# LINE 447 "./src-ag/InterfacesRules.lag" #-} + _hdIinh + {-# LINE 1279 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOfirstInh -> + (case (({-# LINE 330 "./src-ag/InterfacesRules.lag" #-} + _hdIintravisits + {-# LINE 1284 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOhdIntravisits -> + (case (({-# LINE 263 "./src-ag/InterfacesRules.lag" #-} + _tlIprev + {-# LINE 1289 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOprev -> + ( _lhsOcvisits,_lhsOedp,_lhsOfirstInh,_lhsOhdIntravisits,_lhsOprev) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_Segments_Cons_2)) of + { ( !sem_Segments_2) -> + ( _lhsOsegs,sem_Segments_2) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_Segments_Cons_1)) of + { ( !sem_Segments_1) -> + ( _lhsOdescr,_lhsOgroups,_lhsOnewedges,_lhsOnewvertices,_lhsOv,sem_Segments_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Segments_Nil :: T_Segments +sem_Segments_Nil = + (T_Segments (\ (!_lhsIinfo) + (!_lhsIn) + (!_lhsIv) -> + (case (({-# LINE 130 "./src-ag/InterfacesRules.lag" #-} + Seq.empty + {-# LINE 1306 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOdescr -> + (case (({-# LINE 185 "./src-ag/InterfacesRules.lag" #-} + [] + {-# LINE 1311 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOgroups -> + (case (({-# LINE 129 "./src-ag/InterfacesRules.lag" #-} + Seq.empty + {-# LINE 1316 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOnewedges -> + (case (({-# LINE 171 "./src-ag/InterfacesRules.lag" #-} + [] + {-# LINE 1321 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOnewvertices -> + (case (({-# LINE 82 "./src-ag/InterfacesRules.lag" #-} + _lhsIv + {-# LINE 1326 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOv -> + (case ((let sem_Segments_Nil_1 :: T_Segments_1 + sem_Segments_Nil_1 = + (T_Segments_1 (\ (!_lhsIcons) + (!_lhsIprev) + (!_lhsIvisitDescr) + (!_lhsIvssGraph) -> + (case (({-# LINE 401 "./src-ag/InterfacesRules.lag" #-} + [] + {-# LINE 1337 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOsegs -> + (case ((let sem_Segments_Nil_2 :: T_Segments_2 + sem_Segments_Nil_2 = + (T_Segments_2 (\ (!_lhsIallInters) + (!_lhsIddp) + (!_lhsIfromLhs) + (!_lhsIisFirst) -> + (case (({-# LINE 399 "./src-ag/InterfacesRules.lag" #-} + [] + {-# LINE 1348 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOcvisits -> + (case (({-# LINE 437 "./src-ag/InterfacesRules.lag" #-} + Seq.empty + {-# LINE 1353 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOedp -> + (case (({-# LINE 448 "./src-ag/InterfacesRules.lag" #-} + [] + {-# LINE 1358 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOfirstInh -> + (case (({-# LINE 331 "./src-ag/InterfacesRules.lag" #-} + repeat [] + {-# LINE 1363 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOhdIntravisits -> + (case (({-# LINE 263 "./src-ag/InterfacesRules.lag" #-} + _lhsIprev + {-# LINE 1368 "dist/build/InterfacesRules.hs" #-} + )) of + { !_lhsOprev -> + ( _lhsOcvisits,_lhsOedp,_lhsOfirstInh,_lhsOhdIntravisits,_lhsOprev) }) }) }) }) }))) + in sem_Segments_Nil_2)) of + { ( !sem_Segments_2) -> + ( _lhsOsegs,sem_Segments_2) }) }))) + in sem_Segments_Nil_1)) of + { ( !sem_Segments_1) -> + ( _lhsOdescr,_lhsOgroups,_lhsOnewedges,_lhsOnewvertices,_lhsOv,sem_Segments_1) }) }) }) }) }) }))) diff --git a/dist/build/KWOrder.hs b/dist/build/KWOrder.hs new file mode 100644 --- /dev/null +++ b/dist/build/KWOrder.hs @@ -0,0 +1,2812 @@ + + +-- UUAGC 0.9.42.0 (src-ag/KWOrder.ag) +module KWOrder where +{-# LINE 8 "./src-ag/KWOrder.ag" #-} + +import AbstractSyntax +import HsToken +import Expression +import Patterns +import Options +import PPUtil +import Pretty +import Knuth1 +import KennedyWarren +import ExecutionPlan +import Data.Maybe +import Debug.Trace +import Data.Set(Set) +import Data.Map(Map) +import Data.Sequence(Seq) +import qualified Data.Set as Set +import qualified Data.Map as Map +import qualified Data.Sequence as Seq +import Data.Monoid(mappend,mempty) +{-# LINE 27 "dist/build/KWOrder.hs" #-} + +{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import Macro --marcos +import CommonTypes +import ErrorMessages +{-# LINE 39 "dist/build/KWOrder.hs" #-} + +{-# LINE 2 "./src-ag/HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 45 "dist/build/KWOrder.hs" #-} + +{-# LINE 2 "./src-ag/Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 51 "dist/build/KWOrder.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 58 "dist/build/KWOrder.hs" #-} +{-# LINE 275 "./src-ag/KWOrder.ag" #-} + +-- a depends on b, thus a is a successor of b +depToEdge :: Dependency -> Edge +depToEdge (Dependency a b) = (occToVertex False b, occToVertex True a) + +occToVertex :: Bool -> Occurrence -> Vertex +occToVertex _ (OccRule nm) = VRule nm +occToVertex isDependency (OccAttr c a) + | c == _LOC = VAttr Syn c a -- local attributes are treated as synthesized attrs of 'loc' + | c == _INST = VChild a -- higher-order attributes are treated as children + | otherwise = VAttr kind c a where + kind | isDependency && c == _LHS = Inh -- these dependencies have the property that + | isDependency && c /= _LHS = Syn -- they can all be faked by writing a 'const' rule + | not isDependency && c == _LHS = Syn -- Perhaps we should also allow other forms of dependencies + | not isDependency && c /= _LHS = Inh -- as well, such as two inherited attributes, which would + -- force them in different visits +{-# LINE 76 "dist/build/KWOrder.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + inherited attributes: + aroundMap : Map Identifier [Expression] + inhMap : Map Identifier Attributes + mergeMap : Map Identifier (Identifier, [Identifier], Expression) + mergedChildren : Set Identifier + options : Options + synMap : Map Identifier Attributes + synthesized attributes: + echilds : EChild + edges : Set.Set Edge + nontnames : [(Identifier, Identifier)] + refHoNts : Set NontermIdent + refNts : Set NontermIdent + vertices : Set.Set Vertex + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child kind : {ChildKind} + visit 0: + local refNts : _ + local refHoNts : _ + local isHigherOrder : _ + local hasArounds : _ + local merges : _ + local isMerged : _ + local vertex : _ + local synvertices : _ + local inhvertices : _ + local childIsDeforested : _ + local higherOrderEdges : _ + local aroundEdges : _ + local edgesout : _ + local edgesin : _ + local chnt : _ + local inh : _ + local syn : _ +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child (Child _name _tp _kind) = + (sem_Child_Child _name _tp _kind) +-- semantic domain +newtype T_Child = T_Child ((Map Identifier [Expression]) -> + (Map Identifier Attributes) -> + (Map Identifier (Identifier, [Identifier], Expression)) -> + (Set Identifier) -> + Options -> + (Map Identifier Attributes) -> + ( EChild,(Set.Set Edge),([(Identifier, Identifier)]),(Set NontermIdent),(Set NontermIdent),(Set.Set Vertex))) +data Inh_Child = Inh_Child {aroundMap_Inh_Child :: (Map Identifier [Expression]),inhMap_Inh_Child :: (Map Identifier Attributes),mergeMap_Inh_Child :: (Map Identifier (Identifier, [Identifier], Expression)),mergedChildren_Inh_Child :: (Set Identifier),options_Inh_Child :: Options,synMap_Inh_Child :: (Map Identifier Attributes)} +data Syn_Child = Syn_Child {echilds_Syn_Child :: EChild,edges_Syn_Child :: (Set.Set Edge),nontnames_Syn_Child :: ([(Identifier, Identifier)]),refHoNts_Syn_Child :: (Set NontermIdent),refNts_Syn_Child :: (Set NontermIdent),vertices_Syn_Child :: (Set.Set Vertex)} +wrap_Child :: T_Child -> + Inh_Child -> + Syn_Child +wrap_Child (T_Child sem) (Inh_Child _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap) = + (let ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOrefHoNts,_lhsOrefNts,_lhsOvertices) = sem _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap + in (Syn_Child _lhsOechilds _lhsOedges _lhsOnontnames _lhsOrefHoNts _lhsOrefNts _lhsOvertices)) +sem_Child_Child :: Identifier -> + Type -> + ChildKind -> + T_Child +sem_Child_Child name_ tp_ kind_ = + (T_Child (\ _lhsIaroundMap + _lhsIinhMap + _lhsImergeMap + _lhsImergedChildren + _lhsIoptions + _lhsIsynMap -> + (let _lhsOechilds :: EChild + _lhsOvertices :: (Set.Set Vertex) + _lhsOedges :: (Set.Set Edge) + _lhsOnontnames :: ([(Identifier, Identifier)]) + _lhsOrefHoNts :: (Set NontermIdent) + _lhsOrefNts :: (Set NontermIdent) + -- "./src-ag/KWOrder.ag"(line 74, column 3) + _refNts = + ({-# LINE 74 "./src-ag/KWOrder.ag" #-} + case tp_ of + NT nt _ _ -> Set.singleton nt + _ -> mempty + {-# LINE 162 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 77, column 3) + _refHoNts = + ({-# LINE 77 "./src-ag/KWOrder.ag" #-} + if _isHigherOrder then _refNts else mempty + {-# LINE 168 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 78, column 3) + _isHigherOrder = + ({-# LINE 78 "./src-ag/KWOrder.ag" #-} + case kind_ of + ChildSyntax -> False + _ -> True + {-# LINE 176 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 108, column 3) + _hasArounds = + ({-# LINE 108 "./src-ag/KWOrder.ag" #-} + case Map.lookup name_ _lhsIaroundMap of + Nothing -> False + Just as -> not (null as) + {-# LINE 184 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 136, column 3) + _merges = + ({-# LINE 136 "./src-ag/KWOrder.ag" #-} + maybe Nothing (\(_,ms,_) -> Just ms) $ Map.lookup name_ _lhsImergeMap + {-# LINE 190 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 137, column 3) + _isMerged = + ({-# LINE 137 "./src-ag/KWOrder.ag" #-} + name_ `Set.member` _lhsImergedChildren + {-# LINE 196 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 178, column 11) + _lhsOechilds = + ({-# LINE 178 "./src-ag/KWOrder.ag" #-} + case tp_ of + NT _ _ _ -> EChild name_ tp_ kind_ _hasArounds _merges _isMerged + _ -> ETerm name_ tp_ + {-# LINE 204 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 215, column 12) + _vertex = + ({-# LINE 215 "./src-ag/KWOrder.ag" #-} + VChild name_ + {-# LINE 210 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 216, column 12) + _synvertices = + ({-# LINE 216 "./src-ag/KWOrder.ag" #-} + map (VAttr Syn name_) . Map.keys $ _syn + {-# LINE 216 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 217, column 12) + _inhvertices = + ({-# LINE 217 "./src-ag/KWOrder.ag" #-} + map (VAttr Inh name_) . Map.keys $ _inh + {-# LINE 222 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 218, column 12) + _lhsOvertices = + ({-# LINE 218 "./src-ag/KWOrder.ag" #-} + case tp_ of + NT _ _ _ -> Set.insert _vertex $ Set.fromList (_synvertices ++ _inhvertices ) + _ -> Set.empty + {-# LINE 230 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 248, column 3) + _childIsDeforested = + ({-# LINE 248 "./src-ag/KWOrder.ag" #-} + case tp_ of + NT _ _ defor -> defor + _ -> False + {-# LINE 238 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 251, column 3) + _higherOrderEdges = + ({-# LINE 251 "./src-ag/KWOrder.ag" #-} + case kind_ of + ChildAttr | lateHigherOrderBinding _lhsIoptions && not _childIsDeforested + -> [(_vertex , VAttr Inh _LHS idLateBindingAttr)] + _ -> [] + {-# LINE 247 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 255, column 3) + _aroundEdges = + ({-# LINE 255 "./src-ag/KWOrder.ag" #-} + if _hasArounds + then [(_vertex , VAttr Syn _LOC (Ident (getName name_ ++ "_around") (getPos name_)))] + else [] + {-# LINE 255 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 261, column 12) + _edgesout = + ({-# LINE 261 "./src-ag/KWOrder.ag" #-} + _higherOrderEdges + {-# LINE 261 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 262, column 12) + _edgesin = + ({-# LINE 262 "./src-ag/KWOrder.ag" #-} + map (flip (,) _vertex ) _synvertices + {-# LINE 267 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 263, column 12) + _lhsOedges = + ({-# LINE 263 "./src-ag/KWOrder.ag" #-} + Set.fromList (_edgesout ++ _edgesin ) + {-# LINE 273 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 301, column 12) + _lhsOnontnames = + ({-# LINE 301 "./src-ag/KWOrder.ag" #-} + case tp_ of + NT nont _ _ -> [(name_, nont)] + _ -> [] + {-# LINE 281 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 19, column 11) + _chnt = + ({-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + case tp_ of + NT nt _ _ -> nt + Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") + Haskell t -> identifier "" + {-# LINE 290 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 23, column 11) + _inh = + ({-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIinhMap + {-# LINE 296 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 24, column 11) + _syn = + ({-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIsynMap + {-# LINE 302 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 56, column 67) + _lhsOrefHoNts = + ({-# LINE 56 "./src-ag/KWOrder.ag" #-} + _refHoNts + {-# LINE 308 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 56, column 67) + _lhsOrefNts = + ({-# LINE 56 "./src-ag/KWOrder.ag" #-} + _refNts + {-# LINE 314 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOrefHoNts,_lhsOrefNts,_lhsOvertices)))) +-- Children ---------------------------------------------------- +{- + visit 0: + inherited attributes: + aroundMap : Map Identifier [Expression] + inhMap : Map Identifier Attributes + mergeMap : Map Identifier (Identifier, [Identifier], Expression) + mergedChildren : Set Identifier + options : Options + synMap : Map Identifier Attributes + synthesized attributes: + echilds : EChildren + edges : Set.Set Edge + nontnames : [(Identifier, Identifier)] + refHoNts : Set NontermIdent + refNts : Set NontermIdent + vertices : Set.Set Vertex + alternatives: + alternative Cons: + child hd : Child + child tl : Children + alternative Nil: +-} +-- 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 ((Map Identifier [Expression]) -> + (Map Identifier Attributes) -> + (Map Identifier (Identifier, [Identifier], Expression)) -> + (Set Identifier) -> + Options -> + (Map Identifier Attributes) -> + ( EChildren,(Set.Set Edge),([(Identifier, Identifier)]),(Set NontermIdent),(Set NontermIdent),(Set.Set Vertex))) +data Inh_Children = Inh_Children {aroundMap_Inh_Children :: (Map Identifier [Expression]),inhMap_Inh_Children :: (Map Identifier Attributes),mergeMap_Inh_Children :: (Map Identifier (Identifier, [Identifier], Expression)),mergedChildren_Inh_Children :: (Set Identifier),options_Inh_Children :: Options,synMap_Inh_Children :: (Map Identifier Attributes)} +data Syn_Children = Syn_Children {echilds_Syn_Children :: EChildren,edges_Syn_Children :: (Set.Set Edge),nontnames_Syn_Children :: ([(Identifier, Identifier)]),refHoNts_Syn_Children :: (Set NontermIdent),refNts_Syn_Children :: (Set NontermIdent),vertices_Syn_Children :: (Set.Set Vertex)} +wrap_Children :: T_Children -> + Inh_Children -> + Syn_Children +wrap_Children (T_Children sem) (Inh_Children _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap) = + (let ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOrefHoNts,_lhsOrefNts,_lhsOvertices) = sem _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap + in (Syn_Children _lhsOechilds _lhsOedges _lhsOnontnames _lhsOrefHoNts _lhsOrefNts _lhsOvertices)) +sem_Children_Cons :: T_Child -> + T_Children -> + T_Children +sem_Children_Cons (T_Child hd_) (T_Children tl_) = + (T_Children (\ _lhsIaroundMap + _lhsIinhMap + _lhsImergeMap + _lhsImergedChildren + _lhsIoptions + _lhsIsynMap -> + (let _lhsOechilds :: EChildren + _lhsOedges :: (Set.Set Edge) + _lhsOnontnames :: ([(Identifier, Identifier)]) + _lhsOrefHoNts :: (Set NontermIdent) + _lhsOrefNts :: (Set NontermIdent) + _lhsOvertices :: (Set.Set Vertex) + _hdOaroundMap :: (Map Identifier [Expression]) + _hdOinhMap :: (Map Identifier Attributes) + _hdOmergeMap :: (Map Identifier (Identifier, [Identifier], Expression)) + _hdOmergedChildren :: (Set Identifier) + _hdOoptions :: Options + _hdOsynMap :: (Map Identifier Attributes) + _tlOaroundMap :: (Map Identifier [Expression]) + _tlOinhMap :: (Map Identifier Attributes) + _tlOmergeMap :: (Map Identifier (Identifier, [Identifier], Expression)) + _tlOmergedChildren :: (Set Identifier) + _tlOoptions :: Options + _tlOsynMap :: (Map Identifier Attributes) + _hdIechilds :: EChild + _hdIedges :: (Set.Set Edge) + _hdInontnames :: ([(Identifier, Identifier)]) + _hdIrefHoNts :: (Set NontermIdent) + _hdIrefNts :: (Set NontermIdent) + _hdIvertices :: (Set.Set Vertex) + _tlIechilds :: EChildren + _tlIedges :: (Set.Set Edge) + _tlInontnames :: ([(Identifier, Identifier)]) + _tlIrefHoNts :: (Set NontermIdent) + _tlIrefNts :: (Set NontermIdent) + _tlIvertices :: (Set.Set Vertex) + -- use rule "./src-ag/KWOrder.ag"(line 175, column 29) + _lhsOechilds = + ({-# LINE 175 "./src-ag/KWOrder.ag" #-} + _hdIechilds : _tlIechilds + {-# LINE 405 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 233, column 33) + _lhsOedges = + ({-# LINE 233 "./src-ag/KWOrder.ag" #-} + _hdIedges `Set.union` _tlIedges + {-# LINE 411 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 298, column 37) + _lhsOnontnames = + ({-# LINE 298 "./src-ag/KWOrder.ag" #-} + _hdInontnames ++ _tlInontnames + {-# LINE 417 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 56, column 67) + _lhsOrefHoNts = + ({-# LINE 56 "./src-ag/KWOrder.ag" #-} + _hdIrefHoNts `mappend` _tlIrefHoNts + {-# LINE 423 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 56, column 67) + _lhsOrefNts = + ({-# LINE 56 "./src-ag/KWOrder.ag" #-} + _hdIrefNts `mappend` _tlIrefNts + {-# LINE 429 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 189, column 36) + _lhsOvertices = + ({-# LINE 189 "./src-ag/KWOrder.ag" #-} + _hdIvertices `Set.union` _tlIvertices + {-# LINE 435 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOaroundMap = + ({-# LINE 99 "./src-ag/KWOrder.ag" #-} + _lhsIaroundMap + {-# LINE 441 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 447 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 124 "./src-ag/KWOrder.ag" #-} + _lhsImergeMap + {-# LINE 453 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOmergedChildren = + ({-# LINE 124 "./src-ag/KWOrder.ag" #-} + _lhsImergedChildren + {-# LINE 459 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 34 "./src-ag/KWOrder.ag" #-} + _lhsIoptions + {-# LINE 465 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 471 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOaroundMap = + ({-# LINE 99 "./src-ag/KWOrder.ag" #-} + _lhsIaroundMap + {-# LINE 477 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 483 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 124 "./src-ag/KWOrder.ag" #-} + _lhsImergeMap + {-# LINE 489 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOmergedChildren = + ({-# LINE 124 "./src-ag/KWOrder.ag" #-} + _lhsImergedChildren + {-# LINE 495 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 34 "./src-ag/KWOrder.ag" #-} + _lhsIoptions + {-# LINE 501 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 507 "dist/build/KWOrder.hs" #-} + ) + ( _hdIechilds,_hdIedges,_hdInontnames,_hdIrefHoNts,_hdIrefNts,_hdIvertices) = + hd_ _hdOaroundMap _hdOinhMap _hdOmergeMap _hdOmergedChildren _hdOoptions _hdOsynMap + ( _tlIechilds,_tlIedges,_tlInontnames,_tlIrefHoNts,_tlIrefNts,_tlIvertices) = + tl_ _tlOaroundMap _tlOinhMap _tlOmergeMap _tlOmergedChildren _tlOoptions _tlOsynMap + in ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOrefHoNts,_lhsOrefNts,_lhsOvertices)))) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (\ _lhsIaroundMap + _lhsIinhMap + _lhsImergeMap + _lhsImergedChildren + _lhsIoptions + _lhsIsynMap -> + (let _lhsOechilds :: EChildren + _lhsOedges :: (Set.Set Edge) + _lhsOnontnames :: ([(Identifier, Identifier)]) + _lhsOrefHoNts :: (Set NontermIdent) + _lhsOrefNts :: (Set NontermIdent) + _lhsOvertices :: (Set.Set Vertex) + -- use rule "./src-ag/KWOrder.ag"(line 175, column 29) + _lhsOechilds = + ({-# LINE 175 "./src-ag/KWOrder.ag" #-} + [] + {-# LINE 532 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 233, column 33) + _lhsOedges = + ({-# LINE 233 "./src-ag/KWOrder.ag" #-} + Set.empty + {-# LINE 538 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 298, column 37) + _lhsOnontnames = + ({-# LINE 298 "./src-ag/KWOrder.ag" #-} + [] + {-# LINE 544 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 56, column 67) + _lhsOrefHoNts = + ({-# LINE 56 "./src-ag/KWOrder.ag" #-} + mempty + {-# LINE 550 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 56, column 67) + _lhsOrefNts = + ({-# LINE 56 "./src-ag/KWOrder.ag" #-} + mempty + {-# LINE 556 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 189, column 36) + _lhsOvertices = + ({-# LINE 189 "./src-ag/KWOrder.ag" #-} + Set.empty + {-# LINE 562 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOrefHoNts,_lhsOrefNts,_lhsOvertices)))) +-- Expression -------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : Expression + vertices : Set.Set Vertex + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} + visit 0: + local copy : _ +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression _pos _tks) = + (sem_Expression_Expression _pos _tks) +-- semantic domain +newtype T_Expression = T_Expression (( Expression,(Set.Set Vertex))) +data Inh_Expression = Inh_Expression {} +data Syn_Expression = Syn_Expression {copy_Syn_Expression :: Expression,vertices_Syn_Expression :: (Set.Set Vertex)} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem) (Inh_Expression) = + (let ( _lhsOcopy,_lhsOvertices) = sem + in (Syn_Expression _lhsOcopy _lhsOvertices)) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Expression + -- "./src-ag/KWOrder.ag"(line 200, column 17) + _lhsOvertices = + ({-# LINE 200 "./src-ag/KWOrder.ag" #-} + Set.unions $ map (\tok -> vertices_Syn_HsToken + (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_ + {-# LINE 604 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 154 "./src-ag/KWOrder.ag" #-} + Expression pos_ tks_ + {-# LINE 610 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 154 "./src-ag/KWOrder.ag" #-} + _copy + {-# LINE 616 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOcopy,_lhsOvertices))) +-- Grammar ----------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + depgraphs : PP_Doc + errors : Seq Error + inhmap : Map.Map NontermIdent Attributes + localSigMap : Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type)) + output : ExecutionPlan + synmap : Map.Map NontermIdent Attributes + visitgraph : PP_Doc + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} + visit 0: + local closedNtDeps : _ + local closedHoNtDeps : _ + local closedHoNtRevDeps : _ +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) +-- semantic domain +newtype T_Grammar = T_Grammar (Options -> + ( PP_Doc,(Seq Error),(Map.Map NontermIdent Attributes),(Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))),ExecutionPlan,(Map.Map NontermIdent Attributes),PP_Doc)) +data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: Options} +data Syn_Grammar = Syn_Grammar {depgraphs_Syn_Grammar :: PP_Doc,errors_Syn_Grammar :: (Seq Error),inhmap_Syn_Grammar :: (Map.Map NontermIdent Attributes),localSigMap_Syn_Grammar :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))),output_Syn_Grammar :: ExecutionPlan,synmap_Syn_Grammar :: (Map.Map NontermIdent Attributes),visitgraph_Syn_Grammar :: PP_Doc} +wrap_Grammar :: T_Grammar -> + Inh_Grammar -> + Syn_Grammar +wrap_Grammar (T_Grammar sem) (Inh_Grammar _lhsIoptions) = + (let ( _lhsOdepgraphs,_lhsOerrors,_lhsOinhmap,_lhsOlocalSigMap,_lhsOoutput,_lhsOsynmap,_lhsOvisitgraph) = sem _lhsIoptions + in (Syn_Grammar _lhsOdepgraphs _lhsOerrors _lhsOinhmap _lhsOlocalSigMap _lhsOoutput _lhsOsynmap _lhsOvisitgraph)) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ = + (T_Grammar (\ _lhsIoptions -> + (let _nontsOrulenumber :: Int + _nontsOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) + _nontsOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) + _nontsOclassContexts :: ContextMap + _nontsOmanualDeps :: AttrOrderMap + _lhsOoutput :: ExecutionPlan + _lhsOdepgraphs :: PP_Doc + _lhsOvisitgraph :: PP_Doc + _lhsOerrors :: (Seq Error) + _nontsOinhMap :: (Map Identifier Attributes) + _nontsOsynMap :: (Map Identifier Attributes) + _lhsOinhmap :: (Map.Map NontermIdent Attributes) + _lhsOlocalSigMap :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) + _lhsOsynmap :: (Map.Map NontermIdent Attributes) + _nontsOclosedHoNtDeps :: (Map NontermIdent (Set NontermIdent)) + _nontsOclosedHoNtRevDeps :: (Map NontermIdent (Set NontermIdent)) + _nontsOclosedNtDeps :: (Map NontermIdent (Set NontermIdent)) + _nontsOoptions :: Options + _nontsIdepinfo :: ([NontDependencyInformation]) + _nontsIinhMap' :: (Map Identifier Attributes) + _nontsIinhmap :: (Map.Map NontermIdent Attributes) + _nontsIlocalSigMap :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) + _nontsIntDeps :: (Map NontermIdent (Set NontermIdent)) + _nontsIntHoDeps :: (Map NontermIdent (Set NontermIdent)) + _nontsIrulenumber :: Int + _nontsIsynMap' :: (Map Identifier Attributes) + _nontsIsynmap :: (Map.Map NontermIdent Attributes) + -- "./src-ag/KWOrder.ag"(line 44, column 14) + _nontsOrulenumber = + ({-# LINE 44 "./src-ag/KWOrder.ag" #-} + 0 + {-# LINE 717 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 83, column 3) + _closedNtDeps = + ({-# LINE 83 "./src-ag/KWOrder.ag" #-} + closeMap _nontsIntDeps + {-# LINE 723 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 84, column 3) + _closedHoNtDeps = + ({-# LINE 84 "./src-ag/KWOrder.ag" #-} + closeMap _nontsIntHoDeps + {-# LINE 729 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 85, column 3) + _closedHoNtRevDeps = + ({-# LINE 85 "./src-ag/KWOrder.ag" #-} + revDeps _closedHoNtDeps + {-# LINE 735 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 105, column 3) + _nontsOaroundMap = + ({-# LINE 105 "./src-ag/KWOrder.ag" #-} + aroundsMap_ + {-# LINE 741 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 130, column 3) + _nontsOmergeMap = + ({-# LINE 130 "./src-ag/KWOrder.ag" #-} + mergeMap_ + {-# LINE 747 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 146, column 3) + _nontsOclassContexts = + ({-# LINE 146 "./src-ag/KWOrder.ag" #-} + contextMap_ + {-# LINE 753 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 269, column 31) + _nontsOmanualDeps = + ({-# LINE 269 "./src-ag/KWOrder.ag" #-} + manualAttrOrderMap_ + {-# LINE 759 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 359, column 15) + (_lhsOoutput,_lhsOdepgraphs,_lhsOvisitgraph,_lhsOerrors) = + ({-# LINE 359 "./src-ag/KWOrder.ag" #-} + let lazyPlan = kennedyWarrenLazy _lhsIoptions wrappers_ _nontsIdepinfo typeSyns_ derivings_ + in if visit _lhsIoptions && withCycle _lhsIoptions + then case kennedyWarrenOrder _lhsIoptions wrappers_ _nontsIdepinfo typeSyns_ derivings_ of + Left e -> (lazyPlan,empty,empty,Seq.singleton e) + Right (o,d,v) -> (o,d,v,Seq.empty) + else (lazyPlan,empty,empty,Seq.empty) + {-# LINE 770 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 15, column 13) + _nontsOinhMap = + ({-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + _nontsIinhMap' + {-# LINE 776 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 16, column 13) + _nontsOsynMap = + ({-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + _nontsIsynMap' + {-# LINE 782 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 371, column 33) + _lhsOinhmap = + ({-# LINE 371 "./src-ag/KWOrder.ag" #-} + _nontsIinhmap + {-# LINE 788 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 383, column 57) + _lhsOlocalSigMap = + ({-# LINE 383 "./src-ag/KWOrder.ag" #-} + _nontsIlocalSigMap + {-# LINE 794 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 372, column 33) + _lhsOsynmap = + ({-# LINE 372 "./src-ag/KWOrder.ag" #-} + _nontsIsynmap + {-# LINE 800 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (from local) + _nontsOclosedHoNtDeps = + ({-# LINE 55 "./src-ag/KWOrder.ag" #-} + _closedHoNtDeps + {-# LINE 806 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (from local) + _nontsOclosedHoNtRevDeps = + ({-# LINE 55 "./src-ag/KWOrder.ag" #-} + _closedHoNtRevDeps + {-# LINE 812 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (from local) + _nontsOclosedNtDeps = + ({-# LINE 55 "./src-ag/KWOrder.ag" #-} + _closedNtDeps + {-# LINE 818 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _nontsOoptions = + ({-# LINE 34 "./src-ag/KWOrder.ag" #-} + _lhsIoptions + {-# LINE 824 "dist/build/KWOrder.hs" #-} + ) + ( _nontsIdepinfo,_nontsIinhMap',_nontsIinhmap,_nontsIlocalSigMap,_nontsIntDeps,_nontsIntHoDeps,_nontsIrulenumber,_nontsIsynMap',_nontsIsynmap) = + nonts_ _nontsOaroundMap _nontsOclassContexts _nontsOclosedHoNtDeps _nontsOclosedHoNtRevDeps _nontsOclosedNtDeps _nontsOinhMap _nontsOmanualDeps _nontsOmergeMap _nontsOoptions _nontsOrulenumber _nontsOsynMap + in ( _lhsOdepgraphs,_lhsOerrors,_lhsOinhmap,_lhsOlocalSigMap,_lhsOoutput,_lhsOsynmap,_lhsOvisitgraph)))) +-- HsToken ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + vertices : Set.Set Vertex + alternatives: + alternative AGLocal: + child var : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + alternative AGField: + child field : {Identifier} + child attr : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + alternative HsToken: + child value : {String} + child pos : {Pos} + alternative CharToken: + child value : {String} + child pos : {Pos} + alternative StrToken: + child value : {String} + child pos : {Pos} + alternative Err: + child mesg : {String} + child pos : {Pos} +-} +-- cata +sem_HsToken :: HsToken -> + T_HsToken +sem_HsToken (AGLocal _var _pos _rdesc) = + (sem_HsToken_AGLocal _var _pos _rdesc) +sem_HsToken (AGField _field _attr _pos _rdesc) = + (sem_HsToken_AGField _field _attr _pos _rdesc) +sem_HsToken (HsToken _value _pos) = + (sem_HsToken_HsToken _value _pos) +sem_HsToken (CharToken _value _pos) = + (sem_HsToken_CharToken _value _pos) +sem_HsToken (StrToken _value _pos) = + (sem_HsToken_StrToken _value _pos) +sem_HsToken (Err _mesg _pos) = + (sem_HsToken_Err _mesg _pos) +-- semantic domain +newtype T_HsToken = T_HsToken (( (Set.Set Vertex))) +data Inh_HsToken = Inh_HsToken {} +data Syn_HsToken = Syn_HsToken {vertices_Syn_HsToken :: (Set.Set Vertex)} +wrap_HsToken :: T_HsToken -> + Inh_HsToken -> + Syn_HsToken +wrap_HsToken (T_HsToken sem) (Inh_HsToken) = + (let ( _lhsOvertices) = sem + in (Syn_HsToken _lhsOvertices)) +sem_HsToken_AGLocal :: Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGLocal var_ pos_ rdesc_ = + (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) + -- "./src-ag/KWOrder.ag"(line 193, column 14) + _lhsOvertices = + ({-# LINE 193 "./src-ag/KWOrder.ag" #-} + Set.singleton $ VChild var_ + {-# LINE 892 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOvertices))) +sem_HsToken_AGField :: Identifier -> + Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGField field_ attr_ pos_ rdesc_ = + (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) + -- "./src-ag/KWOrder.ag"(line 194, column 14) + _lhsOvertices = + ({-# LINE 194 "./src-ag/KWOrder.ag" #-} + Set.singleton $ VAttr (if field_ == _LHS then Inh + else if field_ == _LOC then Loc + else Syn) field_ attr_ + {-# LINE 908 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOvertices))) +sem_HsToken_HsToken :: String -> + Pos -> + T_HsToken +sem_HsToken_HsToken value_ pos_ = + (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) + -- use rule "./src-ag/KWOrder.ag"(line 189, column 36) + _lhsOvertices = + ({-# LINE 189 "./src-ag/KWOrder.ag" #-} + Set.empty + {-# LINE 920 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOvertices))) +sem_HsToken_CharToken :: String -> + Pos -> + T_HsToken +sem_HsToken_CharToken value_ pos_ = + (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) + -- use rule "./src-ag/KWOrder.ag"(line 189, column 36) + _lhsOvertices = + ({-# LINE 189 "./src-ag/KWOrder.ag" #-} + Set.empty + {-# LINE 932 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOvertices))) +sem_HsToken_StrToken :: String -> + Pos -> + T_HsToken +sem_HsToken_StrToken value_ pos_ = + (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) + -- use rule "./src-ag/KWOrder.ag"(line 189, column 36) + _lhsOvertices = + ({-# LINE 189 "./src-ag/KWOrder.ag" #-} + Set.empty + {-# LINE 944 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOvertices))) +sem_HsToken_Err :: String -> + Pos -> + T_HsToken +sem_HsToken_Err mesg_ pos_ = + (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) + -- use rule "./src-ag/KWOrder.ag"(line 189, column 36) + _lhsOvertices = + ({-# LINE 189 "./src-ag/KWOrder.ag" #-} + Set.empty + {-# LINE 956 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOvertices))) +-- HsTokens ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : HsToken + child tl : HsTokens + alternative Nil: +-} +-- cata +sem_HsTokens :: HsTokens -> + T_HsTokens +sem_HsTokens list = + (Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list)) +-- semantic domain +newtype T_HsTokens = T_HsTokens (( )) +data Inh_HsTokens = Inh_HsTokens {} +data Syn_HsTokens = Syn_HsTokens {} +wrap_HsTokens :: T_HsTokens -> + Inh_HsTokens -> + Syn_HsTokens +wrap_HsTokens (T_HsTokens sem) (Inh_HsTokens) = + (let ( ) = sem + in (Syn_HsTokens)) +sem_HsTokens_Cons :: T_HsToken -> + T_HsTokens -> + T_HsTokens +sem_HsTokens_Cons (T_HsToken hd_) (T_HsTokens tl_) = + (T_HsTokens (let _hdIvertices :: (Set.Set Vertex) + ( _hdIvertices) = + hd_ + in ( ))) +sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil = + (T_HsTokens (let + in ( ))) +-- HsTokensRoot ------------------------------------------------ +{- + 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 (( )) +data Inh_HsTokensRoot = Inh_HsTokensRoot {} +data Syn_HsTokensRoot = Syn_HsTokensRoot {} +wrap_HsTokensRoot :: T_HsTokensRoot -> + Inh_HsTokensRoot -> + Syn_HsTokensRoot +wrap_HsTokensRoot (T_HsTokensRoot sem) (Inh_HsTokensRoot) = + (let ( ) = sem + in (Syn_HsTokensRoot)) +sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> + T_HsTokensRoot +sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_) = + (T_HsTokensRoot (let + in ( ))) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + inherited attributes: + aroundMap : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + classContexts : ContextMap + closedHoNtDeps : Map NontermIdent (Set NontermIdent) + closedHoNtRevDeps : Map NontermIdent (Set NontermIdent) + closedNtDeps : Map NontermIdent (Set NontermIdent) + inhMap : Map Identifier Attributes + manualDeps : AttrOrderMap + mergeMap : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) + options : Options + synMap : Map Identifier Attributes + chained attribute: + rulenumber : Int + synthesized attributes: + depinfo : NontDependencyInformation + inhMap' : Map Identifier Attributes + inhmap : Map.Map NontermIdent Attributes + localSigMap : Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type)) + ntDeps : Map NontermIdent (Set NontermIdent) + ntHoDeps : Map NontermIdent (Set NontermIdent) + synMap' : Map Identifier Attributes + synmap : Map.Map NontermIdent Attributes + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions + visit 0: + local closedNtDeps : _ + local closedHoNtDeps : _ + local closedHoNtRevDeps : _ + local recursive : _ + local nontrivAcyc : _ + local hoInfo : _ + local aroundMap : _ + local mergeMap : _ + local classContexts : _ + local synvertices : _ + local inhvertices : _ + local vertices : _ + local nontgraph : _ +-} +-- 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 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + ContextMap -> + (Map NontermIdent (Set NontermIdent)) -> + (Map NontermIdent (Set NontermIdent)) -> + (Map NontermIdent (Set NontermIdent)) -> + (Map Identifier Attributes) -> + AttrOrderMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + Options -> + Int -> + (Map Identifier Attributes) -> + ( NontDependencyInformation,(Map Identifier Attributes),(Map.Map NontermIdent Attributes),(Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))),(Map NontermIdent (Set NontermIdent)),(Map NontermIdent (Set NontermIdent)),Int,(Map Identifier Attributes),(Map.Map NontermIdent Attributes))) +data Inh_Nonterminal = Inh_Nonterminal {aroundMap_Inh_Nonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))),classContexts_Inh_Nonterminal :: ContextMap,closedHoNtDeps_Inh_Nonterminal :: (Map NontermIdent (Set NontermIdent)),closedHoNtRevDeps_Inh_Nonterminal :: (Map NontermIdent (Set NontermIdent)),closedNtDeps_Inh_Nonterminal :: (Map NontermIdent (Set NontermIdent)),inhMap_Inh_Nonterminal :: (Map Identifier Attributes),manualDeps_Inh_Nonterminal :: AttrOrderMap,mergeMap_Inh_Nonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))),options_Inh_Nonterminal :: Options,rulenumber_Inh_Nonterminal :: Int,synMap_Inh_Nonterminal :: (Map Identifier Attributes)} +data Syn_Nonterminal = Syn_Nonterminal {depinfo_Syn_Nonterminal :: NontDependencyInformation,inhMap'_Syn_Nonterminal :: (Map Identifier Attributes),inhmap_Syn_Nonterminal :: (Map.Map NontermIdent Attributes),localSigMap_Syn_Nonterminal :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))),ntDeps_Syn_Nonterminal :: (Map NontermIdent (Set NontermIdent)),ntHoDeps_Syn_Nonterminal :: (Map NontermIdent (Set NontermIdent)),rulenumber_Syn_Nonterminal :: Int,synMap'_Syn_Nonterminal :: (Map Identifier Attributes),synmap_Syn_Nonterminal :: (Map.Map NontermIdent Attributes)} +wrap_Nonterminal :: T_Nonterminal -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal _lhsIaroundMap _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) = + (let ( _lhsOdepinfo,_lhsOinhMap',_lhsOinhmap,_lhsOlocalSigMap,_lhsOntDeps,_lhsOntHoDeps,_lhsOrulenumber,_lhsOsynMap',_lhsOsynmap) = sem _lhsIaroundMap _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap + in (Syn_Nonterminal _lhsOdepinfo _lhsOinhMap' _lhsOinhmap _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOrulenumber _lhsOsynMap' _lhsOsynmap)) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) = + (T_Nonterminal (\ _lhsIaroundMap + _lhsIclassContexts + _lhsIclosedHoNtDeps + _lhsIclosedHoNtRevDeps + _lhsIclosedNtDeps + _lhsIinhMap + _lhsImanualDeps + _lhsImergeMap + _lhsIoptions + _lhsIrulenumber + _lhsIsynMap -> + (let _lhsOntDeps :: (Map NontermIdent (Set NontermIdent)) + _lhsOntHoDeps :: (Map NontermIdent (Set NontermIdent)) + _prodsOmanualDeps :: (Map ConstructorIdent (Set Dependency)) + _lhsOdepinfo :: NontDependencyInformation + _lhsOinhmap :: (Map.Map NontermIdent Attributes) + _lhsOsynmap :: (Map.Map NontermIdent Attributes) + _lhsOlocalSigMap :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) + _lhsOinhMap' :: (Map Identifier Attributes) + _lhsOsynMap' :: (Map Identifier Attributes) + _lhsOrulenumber :: Int + _prodsOaroundMap :: (Map ConstructorIdent (Map Identifier [Expression])) + _prodsOinhMap :: (Map Identifier Attributes) + _prodsOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) + _prodsOoptions :: Options + _prodsOrulenumber :: Int + _prodsOsynMap :: (Map Identifier Attributes) + _prodsIdepgraph :: ([ProdDependencyGraph]) + _prodsIlocalSigMap :: (Map.Map ConstructorIdent (Map.Map Identifier Type)) + _prodsIrefHoNts :: (Set NontermIdent) + _prodsIrefNts :: (Set NontermIdent) + _prodsIrulenumber :: Int + -- "./src-ag/KWOrder.ag"(line 59, column 3) + _lhsOntDeps = + ({-# LINE 59 "./src-ag/KWOrder.ag" #-} + Map.singleton nt_ _prodsIrefNts + {-# LINE 1136 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 60, column 3) + _lhsOntHoDeps = + ({-# LINE 60 "./src-ag/KWOrder.ag" #-} + Map.singleton nt_ _prodsIrefHoNts + {-# LINE 1142 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 62, column 3) + _closedNtDeps = + ({-# LINE 62 "./src-ag/KWOrder.ag" #-} + Map.findWithDefault Set.empty nt_ _lhsIclosedNtDeps + {-# LINE 1148 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 63, column 3) + _closedHoNtDeps = + ({-# LINE 63 "./src-ag/KWOrder.ag" #-} + Map.findWithDefault Set.empty nt_ _lhsIclosedHoNtDeps + {-# LINE 1154 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 64, column 3) + _closedHoNtRevDeps = + ({-# LINE 64 "./src-ag/KWOrder.ag" #-} + Map.findWithDefault Set.empty nt_ _lhsIclosedHoNtRevDeps + {-# LINE 1160 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 66, column 3) + _recursive = + ({-# LINE 66 "./src-ag/KWOrder.ag" #-} + nt_ `Set.member` _closedNtDeps + {-# LINE 1166 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 67, column 3) + _nontrivAcyc = + ({-# LINE 67 "./src-ag/KWOrder.ag" #-} + nt_ `Set.member` _closedHoNtDeps + {-# LINE 1172 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 68, column 3) + _hoInfo = + ({-# LINE 68 "./src-ag/KWOrder.ag" #-} + HigherOrderInfo { hoNtDeps = _closedHoNtDeps + , hoNtRevDeps = _closedHoNtRevDeps + , hoAcyclic = _nontrivAcyc + } + {-# LINE 1181 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 101, column 32) + _aroundMap = + ({-# LINE 101 "./src-ag/KWOrder.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaroundMap + {-# LINE 1187 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 126, column 32) + _mergeMap = + ({-# LINE 126 "./src-ag/KWOrder.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsImergeMap + {-# LINE 1193 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 149, column 3) + _classContexts = + ({-# LINE 149 "./src-ag/KWOrder.ag" #-} + Map.findWithDefault [] nt_ _lhsIclassContexts + {-# LINE 1199 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 270, column 31) + _prodsOmanualDeps = + ({-# LINE 270 "./src-ag/KWOrder.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsImanualDeps + {-# LINE 1205 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 325, column 18) + _synvertices = + ({-# LINE 325 "./src-ag/KWOrder.ag" #-} + map (VAttr Syn nt_) . Map.keys $ syn_ + {-# LINE 1211 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 326, column 18) + _inhvertices = + ({-# LINE 326 "./src-ag/KWOrder.ag" #-} + map (VAttr Inh nt_) . Map.keys $ inh_ + {-# LINE 1217 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 327, column 18) + _vertices = + ({-# LINE 327 "./src-ag/KWOrder.ag" #-} + _synvertices ++ _inhvertices + {-# LINE 1223 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 331, column 18) + _nontgraph = + ({-# LINE 331 "./src-ag/KWOrder.ag" #-} + NontDependencyGraph { ndgVertices = _vertices + , ndgEdges = [] } + {-# LINE 1230 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 339, column 18) + _lhsOdepinfo = + ({-# LINE 339 "./src-ag/KWOrder.ag" #-} + NontDependencyInformation { ndiNonterminal = nt_ + , ndiParams = params_ + , ndiInh = Map.keys inh_ + , ndiSyn = Map.keys syn_ + , ndiDepGraph = _nontgraph + , ndiProds = _prodsIdepgraph + , ndiRecursive = _recursive + , ndiHoInfo = _hoInfo + , ndiClassCtxs = _classContexts + } + {-# LINE 1245 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 377, column 17) + _lhsOinhmap = + ({-# LINE 377 "./src-ag/KWOrder.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 1251 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 378, column 17) + _lhsOsynmap = + ({-# LINE 378 "./src-ag/KWOrder.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 1257 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 387, column 32) + _lhsOlocalSigMap = + ({-# LINE 387 "./src-ag/KWOrder.ag" #-} + Map.singleton nt_ _prodsIlocalSigMap + {-# LINE 1263 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 7, column 18) + _lhsOinhMap' = + ({-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 1269 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 8, column 18) + _lhsOsynMap' = + ({-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 1275 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (up) + _lhsOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _prodsIrulenumber + {-# LINE 1281 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (from local) + _prodsOaroundMap = + ({-# LINE 96 "./src-ag/KWOrder.ag" #-} + _aroundMap + {-# LINE 1287 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _prodsOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1293 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (from local) + _prodsOmergeMap = + ({-# LINE 121 "./src-ag/KWOrder.ag" #-} + _mergeMap + {-# LINE 1299 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _prodsOoptions = + ({-# LINE 34 "./src-ag/KWOrder.ag" #-} + _lhsIoptions + {-# LINE 1305 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _prodsOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 1311 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _prodsOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1317 "dist/build/KWOrder.hs" #-} + ) + ( _prodsIdepgraph,_prodsIlocalSigMap,_prodsIrefHoNts,_prodsIrefNts,_prodsIrulenumber) = + prods_ _prodsOaroundMap _prodsOinhMap _prodsOmanualDeps _prodsOmergeMap _prodsOoptions _prodsOrulenumber _prodsOsynMap + in ( _lhsOdepinfo,_lhsOinhMap',_lhsOinhmap,_lhsOlocalSigMap,_lhsOntDeps,_lhsOntHoDeps,_lhsOrulenumber,_lhsOsynMap',_lhsOsynmap)))) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + inherited attributes: + aroundMap : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + classContexts : ContextMap + closedHoNtDeps : Map NontermIdent (Set NontermIdent) + closedHoNtRevDeps : Map NontermIdent (Set NontermIdent) + closedNtDeps : Map NontermIdent (Set NontermIdent) + inhMap : Map Identifier Attributes + manualDeps : AttrOrderMap + mergeMap : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) + options : Options + synMap : Map Identifier Attributes + chained attribute: + rulenumber : Int + synthesized attributes: + depinfo : [NontDependencyInformation] + inhMap' : Map Identifier Attributes + inhmap : Map.Map NontermIdent Attributes + localSigMap : Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type)) + ntDeps : Map NontermIdent (Set NontermIdent) + ntHoDeps : Map NontermIdent (Set NontermIdent) + synMap' : Map Identifier Attributes + synmap : Map.Map NontermIdent Attributes + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + alternative Nil: +-} +-- 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 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + ContextMap -> + (Map NontermIdent (Set NontermIdent)) -> + (Map NontermIdent (Set NontermIdent)) -> + (Map NontermIdent (Set NontermIdent)) -> + (Map Identifier Attributes) -> + AttrOrderMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + Options -> + Int -> + (Map Identifier Attributes) -> + ( ([NontDependencyInformation]),(Map Identifier Attributes),(Map.Map NontermIdent Attributes),(Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))),(Map NontermIdent (Set NontermIdent)),(Map NontermIdent (Set NontermIdent)),Int,(Map Identifier Attributes),(Map.Map NontermIdent Attributes))) +data Inh_Nonterminals = Inh_Nonterminals {aroundMap_Inh_Nonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))),classContexts_Inh_Nonterminals :: ContextMap,closedHoNtDeps_Inh_Nonterminals :: (Map NontermIdent (Set NontermIdent)),closedHoNtRevDeps_Inh_Nonterminals :: (Map NontermIdent (Set NontermIdent)),closedNtDeps_Inh_Nonterminals :: (Map NontermIdent (Set NontermIdent)),inhMap_Inh_Nonterminals :: (Map Identifier Attributes),manualDeps_Inh_Nonterminals :: AttrOrderMap,mergeMap_Inh_Nonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))),options_Inh_Nonterminals :: Options,rulenumber_Inh_Nonterminals :: Int,synMap_Inh_Nonterminals :: (Map Identifier Attributes)} +data Syn_Nonterminals = Syn_Nonterminals {depinfo_Syn_Nonterminals :: ([NontDependencyInformation]),inhMap'_Syn_Nonterminals :: (Map Identifier Attributes),inhmap_Syn_Nonterminals :: (Map.Map NontermIdent Attributes),localSigMap_Syn_Nonterminals :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))),ntDeps_Syn_Nonterminals :: (Map NontermIdent (Set NontermIdent)),ntHoDeps_Syn_Nonterminals :: (Map NontermIdent (Set NontermIdent)),rulenumber_Syn_Nonterminals :: Int,synMap'_Syn_Nonterminals :: (Map Identifier Attributes),synmap_Syn_Nonterminals :: (Map.Map NontermIdent Attributes)} +wrap_Nonterminals :: T_Nonterminals -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals _lhsIaroundMap _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) = + (let ( _lhsOdepinfo,_lhsOinhMap',_lhsOinhmap,_lhsOlocalSigMap,_lhsOntDeps,_lhsOntHoDeps,_lhsOrulenumber,_lhsOsynMap',_lhsOsynmap) = sem _lhsIaroundMap _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap + in (Syn_Nonterminals _lhsOdepinfo _lhsOinhMap' _lhsOinhmap _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOrulenumber _lhsOsynMap' _lhsOsynmap)) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) = + (T_Nonterminals (\ _lhsIaroundMap + _lhsIclassContexts + _lhsIclosedHoNtDeps + _lhsIclosedHoNtRevDeps + _lhsIclosedNtDeps + _lhsIinhMap + _lhsImanualDeps + _lhsImergeMap + _lhsIoptions + _lhsIrulenumber + _lhsIsynMap -> + (let _lhsOdepinfo :: ([NontDependencyInformation]) + _lhsOinhMap' :: (Map Identifier Attributes) + _lhsOinhmap :: (Map.Map NontermIdent Attributes) + _lhsOlocalSigMap :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) + _lhsOntDeps :: (Map NontermIdent (Set NontermIdent)) + _lhsOntHoDeps :: (Map NontermIdent (Set NontermIdent)) + _lhsOsynMap' :: (Map Identifier Attributes) + _lhsOsynmap :: (Map.Map NontermIdent Attributes) + _lhsOrulenumber :: Int + _hdOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) + _hdOclassContexts :: ContextMap + _hdOclosedHoNtDeps :: (Map NontermIdent (Set NontermIdent)) + _hdOclosedHoNtRevDeps :: (Map NontermIdent (Set NontermIdent)) + _hdOclosedNtDeps :: (Map NontermIdent (Set NontermIdent)) + _hdOinhMap :: (Map Identifier Attributes) + _hdOmanualDeps :: AttrOrderMap + _hdOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) + _hdOoptions :: Options + _hdOrulenumber :: Int + _hdOsynMap :: (Map Identifier Attributes) + _tlOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) + _tlOclassContexts :: ContextMap + _tlOclosedHoNtDeps :: (Map NontermIdent (Set NontermIdent)) + _tlOclosedHoNtRevDeps :: (Map NontermIdent (Set NontermIdent)) + _tlOclosedNtDeps :: (Map NontermIdent (Set NontermIdent)) + _tlOinhMap :: (Map Identifier Attributes) + _tlOmanualDeps :: AttrOrderMap + _tlOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) + _tlOoptions :: Options + _tlOrulenumber :: Int + _tlOsynMap :: (Map Identifier Attributes) + _hdIdepinfo :: NontDependencyInformation + _hdIinhMap' :: (Map Identifier Attributes) + _hdIinhmap :: (Map.Map NontermIdent Attributes) + _hdIlocalSigMap :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) + _hdIntDeps :: (Map NontermIdent (Set NontermIdent)) + _hdIntHoDeps :: (Map NontermIdent (Set NontermIdent)) + _hdIrulenumber :: Int + _hdIsynMap' :: (Map Identifier Attributes) + _hdIsynmap :: (Map.Map NontermIdent Attributes) + _tlIdepinfo :: ([NontDependencyInformation]) + _tlIinhMap' :: (Map Identifier Attributes) + _tlIinhmap :: (Map.Map NontermIdent Attributes) + _tlIlocalSigMap :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) + _tlIntDeps :: (Map NontermIdent (Set NontermIdent)) + _tlIntHoDeps :: (Map NontermIdent (Set NontermIdent)) + _tlIrulenumber :: Int + _tlIsynMap' :: (Map Identifier Attributes) + _tlIsynmap :: (Map.Map NontermIdent Attributes) + -- use rule "./src-ag/KWOrder.ag"(line 336, column 33) + _lhsOdepinfo = + ({-# LINE 336 "./src-ag/KWOrder.ag" #-} + _hdIdepinfo : _tlIdepinfo + {-# LINE 1447 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOinhMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + _hdIinhMap' `Map.union` _tlIinhMap' + {-# LINE 1453 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 371, column 33) + _lhsOinhmap = + ({-# LINE 371 "./src-ag/KWOrder.ag" #-} + _hdIinhmap `Map.union` _tlIinhmap + {-# LINE 1459 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 383, column 57) + _lhsOlocalSigMap = + ({-# LINE 383 "./src-ag/KWOrder.ag" #-} + _hdIlocalSigMap `Map.union` _tlIlocalSigMap + {-# LINE 1465 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 54, column 54) + _lhsOntDeps = + ({-# LINE 54 "./src-ag/KWOrder.ag" #-} + _hdIntDeps `mappend` _tlIntDeps + {-# LINE 1471 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 54, column 54) + _lhsOntHoDeps = + ({-# LINE 54 "./src-ag/KWOrder.ag" #-} + _hdIntHoDeps `mappend` _tlIntHoDeps + {-# LINE 1477 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOsynMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + _hdIsynMap' `Map.union` _tlIsynMap' + {-# LINE 1483 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 372, column 33) + _lhsOsynmap = + ({-# LINE 372 "./src-ag/KWOrder.ag" #-} + _hdIsynmap `Map.union` _tlIsynmap + {-# LINE 1489 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (up) + _lhsOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _tlIrulenumber + {-# LINE 1495 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOaroundMap = + ({-# LINE 93 "./src-ag/KWOrder.ag" #-} + _lhsIaroundMap + {-# LINE 1501 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOclassContexts = + ({-# LINE 143 "./src-ag/KWOrder.ag" #-} + _lhsIclassContexts + {-# LINE 1507 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOclosedHoNtDeps = + ({-# LINE 55 "./src-ag/KWOrder.ag" #-} + _lhsIclosedHoNtDeps + {-# LINE 1513 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOclosedHoNtRevDeps = + ({-# LINE 55 "./src-ag/KWOrder.ag" #-} + _lhsIclosedHoNtRevDeps + {-# LINE 1519 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOclosedNtDeps = + ({-# LINE 55 "./src-ag/KWOrder.ag" #-} + _lhsIclosedNtDeps + {-# LINE 1525 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1531 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOmanualDeps = + ({-# LINE 266 "./src-ag/KWOrder.ag" #-} + _lhsImanualDeps + {-# LINE 1537 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 118 "./src-ag/KWOrder.ag" #-} + _lhsImergeMap + {-# LINE 1543 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 34 "./src-ag/KWOrder.ag" #-} + _lhsIoptions + {-# LINE 1549 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 1555 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1561 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOaroundMap = + ({-# LINE 93 "./src-ag/KWOrder.ag" #-} + _lhsIaroundMap + {-# LINE 1567 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOclassContexts = + ({-# LINE 143 "./src-ag/KWOrder.ag" #-} + _lhsIclassContexts + {-# LINE 1573 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOclosedHoNtDeps = + ({-# LINE 55 "./src-ag/KWOrder.ag" #-} + _lhsIclosedHoNtDeps + {-# LINE 1579 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOclosedHoNtRevDeps = + ({-# LINE 55 "./src-ag/KWOrder.ag" #-} + _lhsIclosedHoNtRevDeps + {-# LINE 1585 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOclosedNtDeps = + ({-# LINE 55 "./src-ag/KWOrder.ag" #-} + _lhsIclosedNtDeps + {-# LINE 1591 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1597 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOmanualDeps = + ({-# LINE 266 "./src-ag/KWOrder.ag" #-} + _lhsImanualDeps + {-# LINE 1603 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 118 "./src-ag/KWOrder.ag" #-} + _lhsImergeMap + {-# LINE 1609 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 34 "./src-ag/KWOrder.ag" #-} + _lhsIoptions + {-# LINE 1615 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (chain) + _tlOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _hdIrulenumber + {-# LINE 1621 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1627 "dist/build/KWOrder.hs" #-} + ) + ( _hdIdepinfo,_hdIinhMap',_hdIinhmap,_hdIlocalSigMap,_hdIntDeps,_hdIntHoDeps,_hdIrulenumber,_hdIsynMap',_hdIsynmap) = + hd_ _hdOaroundMap _hdOclassContexts _hdOclosedHoNtDeps _hdOclosedHoNtRevDeps _hdOclosedNtDeps _hdOinhMap _hdOmanualDeps _hdOmergeMap _hdOoptions _hdOrulenumber _hdOsynMap + ( _tlIdepinfo,_tlIinhMap',_tlIinhmap,_tlIlocalSigMap,_tlIntDeps,_tlIntHoDeps,_tlIrulenumber,_tlIsynMap',_tlIsynmap) = + tl_ _tlOaroundMap _tlOclassContexts _tlOclosedHoNtDeps _tlOclosedHoNtRevDeps _tlOclosedNtDeps _tlOinhMap _tlOmanualDeps _tlOmergeMap _tlOoptions _tlOrulenumber _tlOsynMap + in ( _lhsOdepinfo,_lhsOinhMap',_lhsOinhmap,_lhsOlocalSigMap,_lhsOntDeps,_lhsOntHoDeps,_lhsOrulenumber,_lhsOsynMap',_lhsOsynmap)))) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (\ _lhsIaroundMap + _lhsIclassContexts + _lhsIclosedHoNtDeps + _lhsIclosedHoNtRevDeps + _lhsIclosedNtDeps + _lhsIinhMap + _lhsImanualDeps + _lhsImergeMap + _lhsIoptions + _lhsIrulenumber + _lhsIsynMap -> + (let _lhsOdepinfo :: ([NontDependencyInformation]) + _lhsOinhMap' :: (Map Identifier Attributes) + _lhsOinhmap :: (Map.Map NontermIdent Attributes) + _lhsOlocalSigMap :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) + _lhsOntDeps :: (Map NontermIdent (Set NontermIdent)) + _lhsOntHoDeps :: (Map NontermIdent (Set NontermIdent)) + _lhsOsynMap' :: (Map Identifier Attributes) + _lhsOsynmap :: (Map.Map NontermIdent Attributes) + _lhsOrulenumber :: Int + -- use rule "./src-ag/KWOrder.ag"(line 336, column 33) + _lhsOdepinfo = + ({-# LINE 336 "./src-ag/KWOrder.ag" #-} + [] + {-# LINE 1660 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOinhMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + Map.empty + {-# LINE 1666 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 371, column 33) + _lhsOinhmap = + ({-# LINE 371 "./src-ag/KWOrder.ag" #-} + Map.empty + {-# LINE 1672 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 383, column 57) + _lhsOlocalSigMap = + ({-# LINE 383 "./src-ag/KWOrder.ag" #-} + Map.empty + {-# LINE 1678 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 54, column 54) + _lhsOntDeps = + ({-# LINE 54 "./src-ag/KWOrder.ag" #-} + mempty + {-# LINE 1684 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 54, column 54) + _lhsOntHoDeps = + ({-# LINE 54 "./src-ag/KWOrder.ag" #-} + mempty + {-# LINE 1690 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOsynMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + Map.empty + {-# LINE 1696 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 372, column 33) + _lhsOsynmap = + ({-# LINE 372 "./src-ag/KWOrder.ag" #-} + Map.empty + {-# LINE 1702 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (chain) + _lhsOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 1708 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOdepinfo,_lhsOinhMap',_lhsOinhmap,_lhsOlocalSigMap,_lhsOntDeps,_lhsOntHoDeps,_lhsOrulenumber,_lhsOsynMap',_lhsOsynmap)))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : Pattern + vertices : Set.Set Vertex + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local vertex : _ + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern (Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern (Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern (Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +sem_Pattern (Underscore _pos) = + (sem_Pattern_Underscore _pos) +-- semantic domain +newtype T_Pattern = T_Pattern (( Pattern,(Set.Set Vertex))) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,vertices_Syn_Pattern :: (Set.Set Vertex)} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem) (Inh_Pattern) = + (let ( _lhsOcopy,_lhsOvertices) = sem + in (Syn_Pattern _lhsOcopy _lhsOvertices)) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_) = + (T_Pattern (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIvertices :: (Set.Set Vertex) + -- use rule "./src-ag/KWOrder.ag"(line 189, column 36) + _lhsOvertices = + ({-# LINE 189 "./src-ag/KWOrder.ag" #-} + _patsIvertices + {-# LINE 1779 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 1785 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1791 "dist/build/KWOrder.hs" #-} + ) + ( _patsIcopy,_patsIvertices) = + pats_ + in ( _lhsOcopy,_lhsOvertices))) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_) = + (T_Pattern (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Pattern + _patsIcopy :: Patterns + _patsIvertices :: (Set.Set Vertex) + -- use rule "./src-ag/KWOrder.ag"(line 189, column 36) + _lhsOvertices = + ({-# LINE 189 "./src-ag/KWOrder.ag" #-} + _patsIvertices + {-# LINE 1808 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 1814 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1820 "dist/build/KWOrder.hs" #-} + ) + ( _patsIcopy,_patsIvertices) = + pats_ + in ( _lhsOcopy,_lhsOvertices))) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_) = + (T_Pattern (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIvertices :: (Set.Set Vertex) + -- "./src-ag/KWOrder.ag"(line 205, column 12) + _vertex = + ({-# LINE 205 "./src-ag/KWOrder.ag" #-} + if field_ == _INST then VChild attr_ + else VAttr (if field_ == _LHS then Syn + else if field_ == _LOC then Loc + else Inh) field_ attr_ + {-# LINE 1841 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 209, column 12) + _lhsOvertices = + ({-# LINE 209 "./src-ag/KWOrder.ag" #-} + Set.insert _vertex _patIvertices + {-# LINE 1847 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 1853 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1859 "dist/build/KWOrder.hs" #-} + ) + ( _patIcopy,_patIvertices) = + pat_ + in ( _lhsOcopy,_lhsOvertices))) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_) = + (T_Pattern (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Pattern + _patIcopy :: Pattern + _patIvertices :: (Set.Set Vertex) + -- use rule "./src-ag/KWOrder.ag"(line 189, column 36) + _lhsOvertices = + ({-# LINE 189 "./src-ag/KWOrder.ag" #-} + _patIvertices + {-# LINE 1875 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 1881 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1887 "dist/build/KWOrder.hs" #-} + ) + ( _patIcopy,_patIvertices) = + pat_ + in ( _lhsOcopy,_lhsOvertices))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Pattern + -- use rule "./src-ag/KWOrder.ag"(line 189, column 36) + _lhsOvertices = + ({-# LINE 189 "./src-ag/KWOrder.ag" #-} + Set.empty + {-# LINE 1901 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 1907 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1913 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOcopy,_lhsOvertices))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : Patterns + vertices : Set.Set Vertex + 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,(Set.Set Vertex))) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,vertices_Syn_Patterns :: (Set.Set Vertex)} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem) (Inh_Patterns) = + (let ( _lhsOcopy,_lhsOvertices) = sem + in (Syn_Patterns _lhsOcopy _lhsOvertices)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = + (T_Patterns (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Patterns + _hdIcopy :: Pattern + _hdIvertices :: (Set.Set Vertex) + _tlIcopy :: Patterns + _tlIvertices :: (Set.Set Vertex) + -- use rule "./src-ag/KWOrder.ag"(line 189, column 36) + _lhsOvertices = + ({-# LINE 189 "./src-ag/KWOrder.ag" #-} + _hdIvertices `Set.union` _tlIvertices + {-# LINE 1961 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 1967 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1973 "dist/build/KWOrder.hs" #-} + ) + ( _hdIcopy,_hdIvertices) = + hd_ + ( _tlIcopy,_tlIvertices) = + tl_ + in ( _lhsOcopy,_lhsOvertices))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOvertices :: (Set.Set Vertex) + _lhsOcopy :: Patterns + -- use rule "./src-ag/KWOrder.ag"(line 189, column 36) + _lhsOvertices = + ({-# LINE 189 "./src-ag/KWOrder.ag" #-} + Set.empty + {-# LINE 1988 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 1994 "dist/build/KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 2000 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOcopy,_lhsOvertices))) +-- Production -------------------------------------------------- +{- + visit 0: + inherited attributes: + aroundMap : Map ConstructorIdent (Map Identifier [Expression]) + inhMap : Map Identifier Attributes + manualDeps : Map ConstructorIdent (Set Dependency) + mergeMap : Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)) + options : Options + synMap : Map Identifier Attributes + chained attribute: + rulenumber : Int + synthesized attributes: + depgraph : ProdDependencyGraph + localSigMap : Map.Map ConstructorIdent (Map.Map Identifier Type) + refHoNts : Set NontermIdent + refNts : Set NontermIdent + alternatives: + alternative Production: + child con : {ConstructorIdent} + child params : {[Identifier]} + child constraints : {[Type]} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + child macro : {MaybeMacro} + visit 0: + local aroundMap : _ + local mergeMap : _ + local mergedChildren : _ + local vertices : _ + local manualDeps : _ + local manualEdges : _ + local edges : _ +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production (Production _con _params _constraints _children _rules _typeSigs _macro) = + (sem_Production_Production _con _params _constraints (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs) _macro) +-- semantic domain +newtype T_Production = T_Production ((Map ConstructorIdent (Map Identifier [Expression])) -> + (Map Identifier Attributes) -> + (Map ConstructorIdent (Set Dependency)) -> + (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) -> + Options -> + Int -> + (Map Identifier Attributes) -> + ( ProdDependencyGraph,(Map.Map ConstructorIdent (Map.Map Identifier Type)),(Set NontermIdent),(Set NontermIdent),Int)) +data Inh_Production = Inh_Production {aroundMap_Inh_Production :: (Map ConstructorIdent (Map Identifier [Expression])),inhMap_Inh_Production :: (Map Identifier Attributes),manualDeps_Inh_Production :: (Map ConstructorIdent (Set Dependency)),mergeMap_Inh_Production :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))),options_Inh_Production :: Options,rulenumber_Inh_Production :: Int,synMap_Inh_Production :: (Map Identifier Attributes)} +data Syn_Production = Syn_Production {depgraph_Syn_Production :: ProdDependencyGraph,localSigMap_Syn_Production :: (Map.Map ConstructorIdent (Map.Map Identifier Type)),refHoNts_Syn_Production :: (Set NontermIdent),refNts_Syn_Production :: (Set NontermIdent),rulenumber_Syn_Production :: Int} +wrap_Production :: T_Production -> + Inh_Production -> + Syn_Production +wrap_Production (T_Production sem) (Inh_Production _lhsIaroundMap _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) = + (let ( _lhsOdepgraph,_lhsOlocalSigMap,_lhsOrefHoNts,_lhsOrefNts,_lhsOrulenumber) = sem _lhsIaroundMap _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap + in (Syn_Production _lhsOdepgraph _lhsOlocalSigMap _lhsOrefHoNts _lhsOrefNts _lhsOrulenumber)) +sem_Production_Production :: ConstructorIdent -> + ([Identifier]) -> + ([Type]) -> + T_Children -> + T_Rules -> + T_TypeSigs -> + MaybeMacro -> + T_Production +sem_Production_Production con_ params_ constraints_ (T_Children children_) (T_Rules rules_) (T_TypeSigs typeSigs_) macro_ = + (T_Production (\ _lhsIaroundMap + _lhsIinhMap + _lhsImanualDeps + _lhsImergeMap + _lhsIoptions + _lhsIrulenumber + _lhsIsynMap -> + (let _lhsOdepgraph :: ProdDependencyGraph + _lhsOlocalSigMap :: (Map.Map ConstructorIdent (Map.Map Identifier Type)) + _lhsOrefHoNts :: (Set NontermIdent) + _lhsOrefNts :: (Set NontermIdent) + _lhsOrulenumber :: Int + _childrenOaroundMap :: (Map Identifier [Expression]) + _childrenOinhMap :: (Map Identifier Attributes) + _childrenOmergeMap :: (Map Identifier (Identifier, [Identifier], Expression)) + _childrenOmergedChildren :: (Set Identifier) + _childrenOoptions :: Options + _childrenOsynMap :: (Map Identifier Attributes) + _rulesOrulenumber :: Int + _childrenIechilds :: EChildren + _childrenIedges :: (Set.Set Edge) + _childrenInontnames :: ([(Identifier, Identifier)]) + _childrenIrefHoNts :: (Set NontermIdent) + _childrenIrefNts :: (Set NontermIdent) + _childrenIvertices :: (Set.Set Vertex) + _rulesIedges :: (Set.Set Edge) + _rulesIerules :: ERules + _rulesIrulenumber :: Int + _rulesIvertices :: (Set.Set Vertex) + _typeSigsIlocalSigMap :: (Map Identifier Type) + -- "./src-ag/KWOrder.ag"(line 102, column 32) + _aroundMap = + ({-# LINE 102 "./src-ag/KWOrder.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIaroundMap + {-# LINE 2103 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 127, column 32) + _mergeMap = + ({-# LINE 127 "./src-ag/KWOrder.ag" #-} + Map.findWithDefault Map.empty con_ _lhsImergeMap + {-# LINE 2109 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 133, column 3) + _mergedChildren = + ({-# LINE 133 "./src-ag/KWOrder.ag" #-} + Set.unions [ Set.fromList ms | (_,ms,_) <- Map.elems _mergeMap ] + {-# LINE 2115 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 229, column 17) + _vertices = + ({-# LINE 229 "./src-ag/KWOrder.ag" #-} + _rulesIvertices `Set.union` _childrenIvertices + {-# LINE 2121 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 272, column 3) + _manualDeps = + ({-# LINE 272 "./src-ag/KWOrder.ag" #-} + Map.findWithDefault Set.empty con_ _lhsImanualDeps + {-# LINE 2127 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 273, column 3) + _manualEdges = + ({-# LINE 273 "./src-ag/KWOrder.ag" #-} + Set.map depToEdge _manualDeps + {-# LINE 2133 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 295, column 17) + _edges = + ({-# LINE 295 "./src-ag/KWOrder.ag" #-} + _rulesIedges `Set.union` _childrenIedges + {-# LINE 2139 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 310, column 17) + _lhsOdepgraph = + ({-# LINE 310 "./src-ag/KWOrder.ag" #-} + ProdDependencyGraph { pdgVertices = Set.toList _vertices + , pdgEdges = Set.toList _edges + , pdgRules = _rulesIerules + , pdgChilds = _childrenIechilds + , pdgProduction = con_ + , pdgChildMap = _childrenInontnames + , pdgConstraints = constraints_ + , pdgParams = params_ } + {-# LINE 2152 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 388, column 32) + _lhsOlocalSigMap = + ({-# LINE 388 "./src-ag/KWOrder.ag" #-} + Map.singleton con_ _typeSigsIlocalSigMap + {-# LINE 2158 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 56, column 67) + _lhsOrefHoNts = + ({-# LINE 56 "./src-ag/KWOrder.ag" #-} + _childrenIrefHoNts + {-# LINE 2164 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 56, column 67) + _lhsOrefNts = + ({-# LINE 56 "./src-ag/KWOrder.ag" #-} + _childrenIrefNts + {-# LINE 2170 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (up) + _lhsOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _rulesIrulenumber + {-# LINE 2176 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (from local) + _childrenOaroundMap = + ({-# LINE 99 "./src-ag/KWOrder.ag" #-} + _aroundMap + {-# LINE 2182 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _childrenOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 2188 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (from local) + _childrenOmergeMap = + ({-# LINE 124 "./src-ag/KWOrder.ag" #-} + _mergeMap + {-# LINE 2194 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (from local) + _childrenOmergedChildren = + ({-# LINE 124 "./src-ag/KWOrder.ag" #-} + _mergedChildren + {-# LINE 2200 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _childrenOoptions = + ({-# LINE 34 "./src-ag/KWOrder.ag" #-} + _lhsIoptions + {-# LINE 2206 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _childrenOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2212 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _rulesOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 2218 "dist/build/KWOrder.hs" #-} + ) + ( _childrenIechilds,_childrenIedges,_childrenInontnames,_childrenIrefHoNts,_childrenIrefNts,_childrenIvertices) = + children_ _childrenOaroundMap _childrenOinhMap _childrenOmergeMap _childrenOmergedChildren _childrenOoptions _childrenOsynMap + ( _rulesIedges,_rulesIerules,_rulesIrulenumber,_rulesIvertices) = + rules_ _rulesOrulenumber + ( _typeSigsIlocalSigMap) = + typeSigs_ + in ( _lhsOdepgraph,_lhsOlocalSigMap,_lhsOrefHoNts,_lhsOrefNts,_lhsOrulenumber)))) +-- Productions ------------------------------------------------- +{- + visit 0: + inherited attributes: + aroundMap : Map ConstructorIdent (Map Identifier [Expression]) + inhMap : Map Identifier Attributes + manualDeps : Map ConstructorIdent (Set Dependency) + mergeMap : Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)) + options : Options + synMap : Map Identifier Attributes + chained attribute: + rulenumber : Int + synthesized attributes: + depgraph : [ProdDependencyGraph] + localSigMap : Map.Map ConstructorIdent (Map.Map Identifier Type) + refHoNts : Set NontermIdent + refNts : Set NontermIdent + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + alternative Nil: +-} +-- cata +sem_Productions :: Productions -> + T_Productions +sem_Productions list = + (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list)) +-- semantic domain +newtype T_Productions = T_Productions ((Map ConstructorIdent (Map Identifier [Expression])) -> + (Map Identifier Attributes) -> + (Map ConstructorIdent (Set Dependency)) -> + (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) -> + Options -> + Int -> + (Map Identifier Attributes) -> + ( ([ProdDependencyGraph]),(Map.Map ConstructorIdent (Map.Map Identifier Type)),(Set NontermIdent),(Set NontermIdent),Int)) +data Inh_Productions = Inh_Productions {aroundMap_Inh_Productions :: (Map ConstructorIdent (Map Identifier [Expression])),inhMap_Inh_Productions :: (Map Identifier Attributes),manualDeps_Inh_Productions :: (Map ConstructorIdent (Set Dependency)),mergeMap_Inh_Productions :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))),options_Inh_Productions :: Options,rulenumber_Inh_Productions :: Int,synMap_Inh_Productions :: (Map Identifier Attributes)} +data Syn_Productions = Syn_Productions {depgraph_Syn_Productions :: ([ProdDependencyGraph]),localSigMap_Syn_Productions :: (Map.Map ConstructorIdent (Map.Map Identifier Type)),refHoNts_Syn_Productions :: (Set NontermIdent),refNts_Syn_Productions :: (Set NontermIdent),rulenumber_Syn_Productions :: Int} +wrap_Productions :: T_Productions -> + Inh_Productions -> + Syn_Productions +wrap_Productions (T_Productions sem) (Inh_Productions _lhsIaroundMap _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) = + (let ( _lhsOdepgraph,_lhsOlocalSigMap,_lhsOrefHoNts,_lhsOrefNts,_lhsOrulenumber) = sem _lhsIaroundMap _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap + in (Syn_Productions _lhsOdepgraph _lhsOlocalSigMap _lhsOrefHoNts _lhsOrefNts _lhsOrulenumber)) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons (T_Production hd_) (T_Productions tl_) = + (T_Productions (\ _lhsIaroundMap + _lhsIinhMap + _lhsImanualDeps + _lhsImergeMap + _lhsIoptions + _lhsIrulenumber + _lhsIsynMap -> + (let _lhsOdepgraph :: ([ProdDependencyGraph]) + _lhsOlocalSigMap :: (Map.Map ConstructorIdent (Map.Map Identifier Type)) + _lhsOrefHoNts :: (Set NontermIdent) + _lhsOrefNts :: (Set NontermIdent) + _lhsOrulenumber :: Int + _hdOaroundMap :: (Map ConstructorIdent (Map Identifier [Expression])) + _hdOinhMap :: (Map Identifier Attributes) + _hdOmanualDeps :: (Map ConstructorIdent (Set Dependency)) + _hdOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) + _hdOoptions :: Options + _hdOrulenumber :: Int + _hdOsynMap :: (Map Identifier Attributes) + _tlOaroundMap :: (Map ConstructorIdent (Map Identifier [Expression])) + _tlOinhMap :: (Map Identifier Attributes) + _tlOmanualDeps :: (Map ConstructorIdent (Set Dependency)) + _tlOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) + _tlOoptions :: Options + _tlOrulenumber :: Int + _tlOsynMap :: (Map Identifier Attributes) + _hdIdepgraph :: ProdDependencyGraph + _hdIlocalSigMap :: (Map.Map ConstructorIdent (Map.Map Identifier Type)) + _hdIrefHoNts :: (Set NontermIdent) + _hdIrefNts :: (Set NontermIdent) + _hdIrulenumber :: Int + _tlIdepgraph :: ([ProdDependencyGraph]) + _tlIlocalSigMap :: (Map.Map ConstructorIdent (Map.Map Identifier Type)) + _tlIrefHoNts :: (Set NontermIdent) + _tlIrefNts :: (Set NontermIdent) + _tlIrulenumber :: Int + -- use rule "./src-ag/KWOrder.ag"(line 307, column 33) + _lhsOdepgraph = + ({-# LINE 307 "./src-ag/KWOrder.ag" #-} + _hdIdepgraph : _tlIdepgraph + {-# LINE 2316 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 384, column 57) + _lhsOlocalSigMap = + ({-# LINE 384 "./src-ag/KWOrder.ag" #-} + _hdIlocalSigMap `Map.union` _tlIlocalSigMap + {-# LINE 2322 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 56, column 67) + _lhsOrefHoNts = + ({-# LINE 56 "./src-ag/KWOrder.ag" #-} + _hdIrefHoNts `mappend` _tlIrefHoNts + {-# LINE 2328 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 56, column 67) + _lhsOrefNts = + ({-# LINE 56 "./src-ag/KWOrder.ag" #-} + _hdIrefNts `mappend` _tlIrefNts + {-# LINE 2334 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (up) + _lhsOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _tlIrulenumber + {-# LINE 2340 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOaroundMap = + ({-# LINE 96 "./src-ag/KWOrder.ag" #-} + _lhsIaroundMap + {-# LINE 2346 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 2352 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOmanualDeps = + ({-# LINE 267 "./src-ag/KWOrder.ag" #-} + _lhsImanualDeps + {-# LINE 2358 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 121 "./src-ag/KWOrder.ag" #-} + _lhsImergeMap + {-# LINE 2364 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 34 "./src-ag/KWOrder.ag" #-} + _lhsIoptions + {-# LINE 2370 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 2376 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2382 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOaroundMap = + ({-# LINE 96 "./src-ag/KWOrder.ag" #-} + _lhsIaroundMap + {-# LINE 2388 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 2394 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOmanualDeps = + ({-# LINE 267 "./src-ag/KWOrder.ag" #-} + _lhsImanualDeps + {-# LINE 2400 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 121 "./src-ag/KWOrder.ag" #-} + _lhsImergeMap + {-# LINE 2406 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 34 "./src-ag/KWOrder.ag" #-} + _lhsIoptions + {-# LINE 2412 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (chain) + _tlOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _hdIrulenumber + {-# LINE 2418 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _tlOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2424 "dist/build/KWOrder.hs" #-} + ) + ( _hdIdepgraph,_hdIlocalSigMap,_hdIrefHoNts,_hdIrefNts,_hdIrulenumber) = + hd_ _hdOaroundMap _hdOinhMap _hdOmanualDeps _hdOmergeMap _hdOoptions _hdOrulenumber _hdOsynMap + ( _tlIdepgraph,_tlIlocalSigMap,_tlIrefHoNts,_tlIrefNts,_tlIrulenumber) = + tl_ _tlOaroundMap _tlOinhMap _tlOmanualDeps _tlOmergeMap _tlOoptions _tlOrulenumber _tlOsynMap + in ( _lhsOdepgraph,_lhsOlocalSigMap,_lhsOrefHoNts,_lhsOrefNts,_lhsOrulenumber)))) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (\ _lhsIaroundMap + _lhsIinhMap + _lhsImanualDeps + _lhsImergeMap + _lhsIoptions + _lhsIrulenumber + _lhsIsynMap -> + (let _lhsOdepgraph :: ([ProdDependencyGraph]) + _lhsOlocalSigMap :: (Map.Map ConstructorIdent (Map.Map Identifier Type)) + _lhsOrefHoNts :: (Set NontermIdent) + _lhsOrefNts :: (Set NontermIdent) + _lhsOrulenumber :: Int + -- use rule "./src-ag/KWOrder.ag"(line 307, column 33) + _lhsOdepgraph = + ({-# LINE 307 "./src-ag/KWOrder.ag" #-} + [] + {-# LINE 2449 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 384, column 57) + _lhsOlocalSigMap = + ({-# LINE 384 "./src-ag/KWOrder.ag" #-} + Map.empty + {-# LINE 2455 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 56, column 67) + _lhsOrefHoNts = + ({-# LINE 56 "./src-ag/KWOrder.ag" #-} + mempty + {-# LINE 2461 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 56, column 67) + _lhsOrefNts = + ({-# LINE 56 "./src-ag/KWOrder.ag" #-} + mempty + {-# LINE 2467 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (chain) + _lhsOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 2473 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOdepgraph,_lhsOlocalSigMap,_lhsOrefHoNts,_lhsOrefNts,_lhsOrulenumber)))) +-- Rule -------------------------------------------------------- +{- + visit 0: + chained attribute: + rulenumber : Int + synthesized attributes: + edges : Set.Set Edge + erules : ERule + vertices : Set.Set Vertex + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + child pure : {Bool} + child identity : {Bool} + child mbError : {Maybe Error} + child eager : {Bool} + visit 0: + local rulename : _ + local vertex : _ + local edgesout : _ + local edgesin : _ +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit _pure _identity _mbError _eager) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin _explicit _pure _identity _mbError _eager) +-- semantic domain +newtype T_Rule = T_Rule (Int -> + ( (Set.Set Edge),ERule,Int,(Set.Set Vertex))) +data Inh_Rule = Inh_Rule {rulenumber_Inh_Rule :: Int} +data Syn_Rule = Syn_Rule {edges_Syn_Rule :: (Set.Set Edge),erules_Syn_Rule :: ERule,rulenumber_Syn_Rule :: Int,vertices_Syn_Rule :: (Set.Set Vertex)} +wrap_Rule :: T_Rule -> + Inh_Rule -> + Syn_Rule +wrap_Rule (T_Rule sem) (Inh_Rule _lhsIrulenumber) = + (let ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices) = sem _lhsIrulenumber + in (Syn_Rule _lhsOedges _lhsOerules _lhsOrulenumber _lhsOvertices)) +sem_Rule_Rule :: (Maybe Identifier) -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + Bool -> + Bool -> + (Maybe Error) -> + Bool -> + T_Rule +sem_Rule_Rule mbName_ (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ = + (T_Rule (\ _lhsIrulenumber -> + (let _lhsOrulenumber :: Int + _lhsOerules :: ERule + _lhsOvertices :: (Set.Set Vertex) + _lhsOedges :: (Set.Set Edge) + _patternIcopy :: Pattern + _patternIvertices :: (Set.Set Vertex) + _rhsIcopy :: Expression + _rhsIvertices :: (Set.Set Vertex) + -- "./src-ag/KWOrder.ag"(line 47, column 11) + _lhsOrulenumber = + ({-# LINE 47 "./src-ag/KWOrder.ag" #-} + _lhsIrulenumber + 1 + {-# LINE 2544 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 48, column 11) + _rulename = + ({-# LINE 48 "./src-ag/KWOrder.ag" #-} + maybe (identifier $ "rule" ++ show _lhsIrulenumber) id mbName_ + {-# LINE 2550 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 160, column 10) + _lhsOerules = + ({-# LINE 160 "./src-ag/KWOrder.ag" #-} + ERule _rulename + _patternIcopy + _rhsIcopy + owrt_ + origin_ + explicit_ + pure_ + mbError_ + {-# LINE 2563 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 224, column 11) + _vertex = + ({-# LINE 224 "./src-ag/KWOrder.ag" #-} + VRule _rulename + {-# LINE 2569 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 225, column 11) + _lhsOvertices = + ({-# LINE 225 "./src-ag/KWOrder.ag" #-} + Set.insert _vertex $ _patternIvertices `Set.union` _rhsIvertices + {-# LINE 2575 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 237, column 11) + _edgesout = + ({-# LINE 237 "./src-ag/KWOrder.ag" #-} + map ((,) _vertex ) (Set.toList _rhsIvertices) + {-# LINE 2581 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 238, column 11) + _edgesin = + ({-# LINE 238 "./src-ag/KWOrder.ag" #-} + map (flip (,) _vertex ) (Set.toList _patternIvertices) + {-# LINE 2587 "dist/build/KWOrder.hs" #-} + ) + -- "./src-ag/KWOrder.ag"(line 239, column 11) + _lhsOedges = + ({-# LINE 239 "./src-ag/KWOrder.ag" #-} + Set.fromList $ _edgesout ++ _edgesin + {-# LINE 2593 "dist/build/KWOrder.hs" #-} + ) + ( _patternIcopy,_patternIvertices) = + pattern_ + ( _rhsIcopy,_rhsIvertices) = + rhs_ + in ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices)))) +-- Rules ------------------------------------------------------- +{- + visit 0: + chained attribute: + rulenumber : Int + synthesized attributes: + edges : Set.Set Edge + erules : ERules + vertices : Set.Set Vertex + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + alternative Nil: +-} +-- 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 (Int -> + ( (Set.Set Edge),ERules,Int,(Set.Set Vertex))) +data Inh_Rules = Inh_Rules {rulenumber_Inh_Rules :: Int} +data Syn_Rules = Syn_Rules {edges_Syn_Rules :: (Set.Set Edge),erules_Syn_Rules :: ERules,rulenumber_Syn_Rules :: Int,vertices_Syn_Rules :: (Set.Set Vertex)} +wrap_Rules :: T_Rules -> + Inh_Rules -> + Syn_Rules +wrap_Rules (T_Rules sem) (Inh_Rules _lhsIrulenumber) = + (let ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices) = sem _lhsIrulenumber + in (Syn_Rules _lhsOedges _lhsOerules _lhsOrulenumber _lhsOvertices)) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) = + (T_Rules (\ _lhsIrulenumber -> + (let _lhsOedges :: (Set.Set Edge) + _lhsOerules :: ERules + _lhsOvertices :: (Set.Set Vertex) + _lhsOrulenumber :: Int + _hdOrulenumber :: Int + _tlOrulenumber :: Int + _hdIedges :: (Set.Set Edge) + _hdIerules :: ERule + _hdIrulenumber :: Int + _hdIvertices :: (Set.Set Vertex) + _tlIedges :: (Set.Set Edge) + _tlIerules :: ERules + _tlIrulenumber :: Int + _tlIvertices :: (Set.Set Vertex) + -- use rule "./src-ag/KWOrder.ag"(line 233, column 33) + _lhsOedges = + ({-# LINE 233 "./src-ag/KWOrder.ag" #-} + _hdIedges `Set.union` _tlIedges + {-# LINE 2654 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 157, column 25) + _lhsOerules = + ({-# LINE 157 "./src-ag/KWOrder.ag" #-} + _hdIerules : _tlIerules + {-# LINE 2660 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 189, column 36) + _lhsOvertices = + ({-# LINE 189 "./src-ag/KWOrder.ag" #-} + _hdIvertices `Set.union` _tlIvertices + {-# LINE 2666 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (up) + _lhsOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _tlIrulenumber + {-# LINE 2672 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (down) + _hdOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 2678 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (chain) + _tlOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _hdIrulenumber + {-# LINE 2684 "dist/build/KWOrder.hs" #-} + ) + ( _hdIedges,_hdIerules,_hdIrulenumber,_hdIvertices) = + hd_ _hdOrulenumber + ( _tlIedges,_tlIerules,_tlIrulenumber,_tlIvertices) = + tl_ _tlOrulenumber + in ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices)))) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (\ _lhsIrulenumber -> + (let _lhsOedges :: (Set.Set Edge) + _lhsOerules :: ERules + _lhsOvertices :: (Set.Set Vertex) + _lhsOrulenumber :: Int + -- use rule "./src-ag/KWOrder.ag"(line 233, column 33) + _lhsOedges = + ({-# LINE 233 "./src-ag/KWOrder.ag" #-} + Set.empty + {-# LINE 2702 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 157, column 25) + _lhsOerules = + ({-# LINE 157 "./src-ag/KWOrder.ag" #-} + [] + {-# LINE 2708 "dist/build/KWOrder.hs" #-} + ) + -- use rule "./src-ag/KWOrder.ag"(line 189, column 36) + _lhsOvertices = + ({-# LINE 189 "./src-ag/KWOrder.ag" #-} + Set.empty + {-# LINE 2714 "dist/build/KWOrder.hs" #-} + ) + -- copy rule (chain) + _lhsOrulenumber = + ({-# LINE 41 "./src-ag/KWOrder.ag" #-} + _lhsIrulenumber + {-# LINE 2720 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices)))) +-- TypeSig ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + localSigMap : Map Identifier Type + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig (TypeSig _name _tp) = + (sem_TypeSig_TypeSig _name _tp) +-- semantic domain +newtype T_TypeSig = T_TypeSig (( (Map Identifier Type))) +data Inh_TypeSig = Inh_TypeSig {} +data Syn_TypeSig = Syn_TypeSig {localSigMap_Syn_TypeSig :: (Map Identifier Type)} +wrap_TypeSig :: T_TypeSig -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig) = + (let ( _lhsOlocalSigMap) = sem + in (Syn_TypeSig _lhsOlocalSigMap)) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig name_ tp_ = + (T_TypeSig (let _lhsOlocalSigMap :: (Map Identifier Type) + -- "./src-ag/KWOrder.ag"(line 389, column 32) + _lhsOlocalSigMap = + ({-# LINE 389 "./src-ag/KWOrder.ag" #-} + Map.singleton name_ tp_ + {-# LINE 2757 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOlocalSigMap))) +-- TypeSigs ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + localSigMap : Map Identifier Type + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + alternative Nil: +-} +-- 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 (( (Map Identifier Type))) +data Inh_TypeSigs = Inh_TypeSigs {} +data Syn_TypeSigs = Syn_TypeSigs {localSigMap_Syn_TypeSigs :: (Map Identifier Type)} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs) = + (let ( _lhsOlocalSigMap) = sem + in (Syn_TypeSigs _lhsOlocalSigMap)) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons (T_TypeSig hd_) (T_TypeSigs tl_) = + (T_TypeSigs (let _lhsOlocalSigMap :: (Map Identifier Type) + _hdIlocalSigMap :: (Map Identifier Type) + _tlIlocalSigMap :: (Map Identifier Type) + -- use rule "./src-ag/KWOrder.ag"(line 385, column 57) + _lhsOlocalSigMap = + ({-# LINE 385 "./src-ag/KWOrder.ag" #-} + _hdIlocalSigMap `Map.union` _tlIlocalSigMap + {-# LINE 2797 "dist/build/KWOrder.hs" #-} + ) + ( _hdIlocalSigMap) = + hd_ + ( _tlIlocalSigMap) = + tl_ + in ( _lhsOlocalSigMap))) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (let _lhsOlocalSigMap :: (Map Identifier Type) + -- use rule "./src-ag/KWOrder.ag"(line 385, column 57) + _lhsOlocalSigMap = + ({-# LINE 385 "./src-ag/KWOrder.ag" #-} + Map.empty + {-# LINE 2811 "dist/build/KWOrder.hs" #-} + ) + in ( _lhsOlocalSigMap))) diff --git a/dist/build/Macro.hs b/dist/build/Macro.hs new file mode 100644 --- /dev/null +++ b/dist/build/Macro.hs @@ -0,0 +1,53 @@ + + +-- UUAGC 0.9.42.0 (src-ag/Macro.ag) +module Macro where +{-# LINE 4 "./src-ag/Macro.ag" #-} + +import CommonTypes +{-# LINE 9 "dist/build/Macro.hs" #-} +-- Macro ------------------------------------------------------- +{- + alternatives: + alternative Macro: + child con : {ConstructorIdent} + child children : MacroChildren + alternative None: +-} +data Macro = Macro (ConstructorIdent) (MacroChildren) + | None + deriving ( Show) +-- MacroChild -------------------------------------------------- +{- + alternatives: + alternative RuleChild: + child name : {Identifier} + child macro : Macro + alternative ChildChild: + child name : {Identifier} + child child : {Identifier} + alternative ValueChild: + child name : {Identifier} + child value : {String} +-} +data MacroChild = RuleChild (Identifier) (Macro) + | ChildChild (Identifier) (Identifier) + | ValueChild (Identifier) (String) + deriving ( Show) +-- MacroChildren ----------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : MacroChild + child tl : MacroChildren + alternative Nil: +-} +type MacroChildren = [MacroChild] +-- MaybeMacro -------------------------------------------------- +{- + alternatives: + alternative Just: + child just : Macro + alternative Nothing: +-} +type MaybeMacro = Maybe Macro diff --git a/dist/build/Order.hs b/dist/build/Order.hs new file mode 100644 --- /dev/null +++ b/dist/build/Order.hs @@ -0,0 +1,5684 @@ + + +-- UUAGC 0.9.42.0 (src-ag/Order.ag) +module Order where +{-# LINE 10 "./src-ag/Order.ag" #-} + +-- From uuagc +import CommonTypes +import Patterns +import ErrorMessages +import AbstractSyntax +import Code hiding (Type) +import qualified Code +import Expression +import Options +import SequentialComputation +import SequentialTypes +import CodeSyntax +import GrammarInfo +import HsToken(HsTokensRoot(HsTokensRoot)) +import HsTokenScanner(lexTokens) +import SemHsTokens(sem_HsTokensRoot,wrap_HsTokensRoot, Syn_HsTokensRoot(..),Inh_HsTokensRoot(..)) +-- From uulib +import qualified Data.Map as Map +import qualified Data.Set as Set +import qualified Data.Sequence as Seq +import Data.Map(Map) +import Data.Set(Set) +import Data.Sequence(Seq, (><)) +import UU.Util.Utils +import UU.Scanner.Position(Pos(..),initPos) +import Data.Foldable(toList) + +-- From haskell libraries +import Control.Monad(liftM) +import qualified Data.Array as Array +import Data.Array((!),bounds,inRange) +import Data.List(elemIndex,partition,sort,mapAccumL,find,nubBy,intersperse,groupBy,transpose) +import qualified Data.Tree as Tree +import Data.Maybe +{-# LINE 42 "dist/build/Order.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 49 "dist/build/Order.hs" #-} + +{-# LINE 2 "./src-ag/Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 55 "dist/build/Order.hs" #-} + +{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import Macro --marcos +import CommonTypes +import ErrorMessages +{-# LINE 67 "dist/build/Order.hs" #-} +{-# LINE 47 "./src-ag/Order.ag" #-} + +-- Terminates with an error if the key is not in the map +findWithErr1 :: (Ord k, Show k) => String -> k -> Map k a -> a +findWithErr1 s k + = Map.findWithDefault (error ("findWithErr1 " ++ s ++ ": key " ++ show k ++ " not in map.")) k + +findWithErr2 :: (Ord k, Show k, Show a) => k -> Map k a -> a +findWithErr2 k m + = Map.findWithDefault (error ("findWithErr2: key " ++ show k ++ " not in map: " ++ show m)) k m +{-# LINE 78 "dist/build/Order.hs" #-} + +{-# LINE 72 "./src-ag/Order.ag" #-} + +startsWith :: String -> String -> Bool +startsWith k h = k == take (length k) h +{-# LINE 84 "dist/build/Order.hs" #-} + +{-# LINE 139 "./src-ag/Order.ag" #-} + +getNtName :: Type -> NontermIdent +getNtName (NT nt _ _) = nt +getNtName _ = nullIdent +{-# LINE 91 "dist/build/Order.hs" #-} + +{-# LINE 167 "./src-ag/Order.ag" #-} + +data AltAttr = AltAttr Identifier Identifier Bool + deriving (Eq, Ord, Show) +{-# LINE 97 "dist/build/Order.hs" #-} + +{-# LINE 237 "./src-ag/Order.ag" #-} + +substSelf nt tp + = case tp of + NT n tps defor | n == _SELF -> NT nt tps defor + _ -> tp + +haskellTupel :: [Type] -> Maybe Type +haskellTupel ts = Just ( Haskell ( '(' : (concat (intersperse "," (map show ts))) ++ ")" )) +{-# LINE 108 "dist/build/Order.hs" #-} + +{-# LINE 688 "./src-ag/Order.ag" #-} + +swap (a,b) = (b,a) + +showPath :: Table CRule -> [Vertex] -> [String] +showPath ruleTable path + = let look a | inRange (bounds ruleTable) a = [showOrigin (ruleTable ! a)] + | otherwise = ["Vertex " ++ show a] + showOrigin cr | getHasCode cr && getName (getAttr cr) /= "self" = prettyCRule cr ++ " (" ++ show (getPos (getAttr cr)) ++ ")" + | otherwise = prettyCRule cr + in concatMap look path + + +showPathLocal :: Table CRule -> [Vertex] -> [String] +showPathLocal _ [] = [] +showPathLocal ruleTable xs = showP (xs++[-1]) + where showP [] = [] + showP (v1:v2:vs) = let line = step v1 v2 + lines = showP vs + in line:lines + step v1 v2 = " - " ++ a1 + where r1 = ruleTable ! v1 + a1 = show (getAttr r1) + + +limitTo :: Int -> [String] -> [String] +limitTo _ [] = [] +limitTo 0 _ = ["....etcetera, etcetera...."] +limitTo n (x:xs) = x : limitTo (n-1) xs + +showPathNice :: Table CRule -> [Vertex] -> [String] +showPathNice _ [] = [] +showPathNice ruleTable xs = limitTo 100 (showP ((-1):xs++[-1])) + where [maxf, maxa, maxn, maxc] = maxWidths ruleTable (take 100 xs) + showP [] = [] + showP (v1:v2:vs) = let line = step v1 v2 + lines = showP vs + in if null line then lines else line:lines + step v1 v2 | last && first = induced + | last && isSyn r1 = "pass up " ++ alignR maxf "" ++ " " ++ alignL maxa a1 ++ " in " ++ alignR maxn n1 ++ "|" ++ c1 ++ induced + | first&& not(isSyn r2) = "get from above " ++ alignR maxf "" ++ " " ++ alignL maxa a2 ++ " in " ++ alignR maxn n2 ++ "|" ++ c2 + | last = "pass down " ++ alignR maxf f1 ++ "." ++ a1 ++ induced + | isSyn r2 = "get from below " ++ alignR maxf f2 ++ "." ++ alignL maxa a2 ++ " in " ++ alignR maxn n2 ++ "|" ++ c2 + | isLocal r1 = if head a1 == '_' + then "" + else "calculate " ++ alignR maxf "loc" ++ "." ++ a1 + | otherwise = "pass down " ++ alignR maxf f1 ++ "." ++ alignL maxa a1 ++ " to " ++ alignR maxn n2 ++ "|" ++ c2 + where + first = v1<0 + last = v2<0 + r1 = ruleTable ! v1 + r2 = ruleTable ! v2 + a1 = show (getAttr r1) + a2 = show (getAttr r2) + f1 = show (getField r1) + f2 = show (getField r2) + n1 = show (getLhsNt r1) + n2 = show (getLhsNt r2) + c1 = show (getCon r1) + c2 = show (getCon r2) + induced | v2== -2 = " INDUCED dependency to " + | otherwise = "" + + +maxWidths ruleTable vs + = map maximum (transpose (map getWidth vs)) + where getWidth v | v<0 = [0,0,0,0] + | otherwise = map (length . show . ($ (ruleTable!v))) [getField, getAttr, getLhsNt, getCon] + +alignL n xs | k Bool -> Route -> Error +localCycleErr ruleTable o_visit (s:path) + = let cr = ruleTable ! s + attr = getAttr cr + nt = getLhsNt cr + con = getCon cr + in LocalCirc nt con attr o_visit (showPathLocal ruleTable path) + +instCycleErr :: Table CRule -> Bool -> Route -> Error +instCycleErr ruleTable o_visit (s:path) + = let cr = ruleTable ! s + attr = getAttr cr + nt = getLhsNt cr + con = getCon cr + in InstCirc nt con attr o_visit (showPathLocal ruleTable path) + +directCycleErrs :: Table NTAttr -> Table CRule -> Bool -> [EdgeRoutes] -> [Error] +directCycleErrs attrTable ruleTable o_visit xs + = let getNont v = case attrTable ! v of + NTASyn nt _ _ -> nt + NTAInh nt _ _ -> nt + getAttr v = case attrTable ! v of + NTASyn _ a _ -> a + NTAInh _ a _ -> a + sameNont ((v1,_),_,_) ((v2,_),_,_) = getNont v1 == getNont v2 + procCycle ((v1,v2),p1,p2) = ((getAttr v1, getAttr v2), showPathNice ruleTable p1, showPathNice ruleTable p2) + wrapGroup gr@(((v1,_),_,_):_) = DirectCirc (getNont v1) o_visit (map procCycle gr) + in map wrapGroup (groupBy sameNont xs) + +inducedCycleErrs :: Table NTAttr -> Table CRule -> CInterfaceMap -> [EdgeRoutes] -> [Error] +inducedCycleErrs attrTable ruleTable cim xs + = let getNont v = case attrTable ! v of + NTASyn nt _ _ -> nt + NTAInh nt _ _ -> nt + getAttr v = case attrTable ! v of + NTASyn _ a _ -> a + NTAInh _ a _ -> a + sameNont ((v1,_),_,_) ((v2,_),_,_) = getNont v1 == getNont v2 + procCycle ((v1,v2),p1,p2) = ((getAttr v1, getAttr v2), showPathNice ruleTable p1, showPathNice ruleTable p2) + wrapGroup gr@(((v1,_),_,_):_) = InducedCirc (getNont v1) (findWithErr1 "inducedCycleErr.cinter" (getNont v1) cim) (map procCycle gr) + in map wrapGroup (groupBy sameNont xs) +{-# LINE 228 "dist/build/Order.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,ChildKind)] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + inh : Attributes + inhMap : Map Identifier Attributes + mergeMap : Map Identifier (Identifier,[Identifier]) + nt : Identifier + o_unbox : Bool + syn : Attributes + synMap : Map Identifier Attributes + synthesized attributes: + attributes : [(Identifier,Attributes,Attributes)] + collectChildrenInhs : Map Identifier Attributes + collectChildrenSyns : Map Identifier Attributes + errors : Seq Error + field : (Identifier,Type,ChildKind) + gathAltAttrs : [AltAttr] + gathRules : Seq CRule + inhs : Seq (Identifier,Attributes) + nts : Seq (Identifier,NontermIdent) + singlevisits : [CRule] + terminals : [Identifier] + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child kind : {ChildKind} + visit 0: + local maptolocal : _ + local gathRules : _ + local chnt : _ + local inh : _ + local syn : _ +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child (Child _name _tp _kind) = + (sem_Child_Child _name _tp _kind) +-- semantic domain +newtype T_Child = T_Child (([(Identifier,Type,ChildKind)]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + Attributes -> + (Map Identifier Attributes) -> + (Map Identifier (Identifier,[Identifier])) -> + Identifier -> + Bool -> + Attributes -> + (Map Identifier Attributes) -> + ( ([(Identifier,Attributes,Attributes)]),(Map Identifier Attributes ),(Map Identifier Attributes ),(Seq Error),((Identifier,Type,ChildKind)),([AltAttr]),(Seq CRule),(Seq (Identifier,Attributes)),(Seq (Identifier,NontermIdent)),([CRule]),([Identifier]))) +data Inh_Child = Inh_Child {allfields_Inh_Child :: !(([(Identifier,Type,ChildKind)])),allnts_Inh_Child :: !(([Identifier])),attrs_Inh_Child :: !(([(Identifier,Identifier)])),con_Inh_Child :: !(Identifier),inh_Inh_Child :: !(Attributes),inhMap_Inh_Child :: !((Map Identifier Attributes)),mergeMap_Inh_Child :: !((Map Identifier (Identifier,[Identifier]))),nt_Inh_Child :: !(Identifier),o_unbox_Inh_Child :: !(Bool),syn_Inh_Child :: !(Attributes),synMap_Inh_Child :: !((Map Identifier Attributes))} +data Syn_Child = Syn_Child {attributes_Syn_Child :: !(([(Identifier,Attributes,Attributes)])),collectChildrenInhs_Syn_Child :: !((Map Identifier Attributes )),collectChildrenSyns_Syn_Child :: !((Map Identifier Attributes )),errors_Syn_Child :: !((Seq Error)),field_Syn_Child :: !(((Identifier,Type,ChildKind))),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 -> + Inh_Child -> + Syn_Child +wrap_Child (T_Child sem) (Inh_Child _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn _lhsIsynMap) = + (let ( _lhsOattributes,_lhsOcollectChildrenInhs,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfield,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn _lhsIsynMap + in (Syn_Child _lhsOattributes _lhsOcollectChildrenInhs _lhsOcollectChildrenSyns _lhsOerrors _lhsOfield _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals)) +sem_Child_Child :: Identifier -> + Type -> + ChildKind -> + T_Child +sem_Child_Child name_ tp_ kind_ = + (T_Child (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIinh + _lhsIinhMap + _lhsImergeMap + _lhsInt + _lhsIo_unbox + _lhsIsyn + _lhsIsynMap -> + (let _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOnts :: (Seq (Identifier,NontermIdent)) + _lhsOinhs :: (Seq (Identifier,Attributes)) + _lhsOcollectChildrenSyns :: (Map Identifier Attributes ) + _lhsOcollectChildrenInhs :: (Map Identifier Attributes ) + _lhsOsinglevisits :: ([CRule]) + _lhsOterminals :: ([Identifier]) + _lhsOattributes :: ([(Identifier,Attributes,Attributes)]) + _lhsOfield :: ((Identifier,Type,ChildKind)) + _lhsOerrors :: (Seq Error) + _lhsOgathRules :: (Seq CRule) + -- "./src-ag/Order.ag"(line 178, column 13) + _maptolocal = + ({-# LINE 178 "./src-ag/Order.ag" #-} + case tp_ of + NT nt _ _ -> Map.null _syn + _ -> True + {-# LINE 327 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 181, column 13) + _lhsOgathAltAttrs = + ({-# LINE 181 "./src-ag/Order.ag" #-} + if _maptolocal + then [ AltAttr _LOC name_ True ] + else [ AltAttr name_ syn True | syn <- Map.keys _syn ] + {-# LINE 335 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 196, column 13) + _lhsOnts = + ({-# LINE 196 "./src-ag/Order.ag" #-} + Seq.singleton (name_,getNtName tp_) + {-# LINE 341 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 197, column 13) + _lhsOinhs = + ({-# LINE 197 "./src-ag/Order.ag" #-} + Seq.singleton (name_,_inh ) + {-# LINE 347 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 213, column 13) + _gathRules = + ({-# LINE 213 "./src-ag/Order.ag" #-} + if _maptolocal + then Seq.singleton (cRuleTerminal name_ _lhsInt _lhsIcon tp_) + else Seq.fromList [ cRuleRhsSyn syn _lhsInt _lhsIcon tp name_ (getNtName tp_) | (syn,tp) <- Map.assocs _syn ] + {-# LINE 355 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 345, column 12) + _lhsOcollectChildrenSyns = + ({-# LINE 345 "./src-ag/Order.ag" #-} + Map.singleton name_ _syn + {-# LINE 361 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 346, column 12) + _lhsOcollectChildrenInhs = + ({-# LINE 346 "./src-ag/Order.ag" #-} + Map.singleton name_ _inh + {-# LINE 367 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 614, column 11) + _lhsOsinglevisits = + ({-# LINE 614 "./src-ag/Order.ag" #-} + if _maptolocal + then [] + else [CChildVisit name_ (getNtName tp_) 0 _inh _syn True] + {-# LINE 375 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 639, column 11) + _lhsOterminals = + ({-# LINE 639 "./src-ag/Order.ag" #-} + if _maptolocal + then [name_] + else [] + {-# LINE 383 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 668, column 11) + _lhsOattributes = + ({-# LINE 668 "./src-ag/Order.ag" #-} + [(name_, _inh , _syn )] + {-# LINE 389 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 672, column 11) + _lhsOfield = + ({-# LINE 672 "./src-ag/Order.ag" #-} + (name_, tp_, kind_) + {-# LINE 395 "dist/build/Order.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 19, column 11) + _chnt = + ({-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + case tp_ of + NT nt _ _ -> nt + Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") + Haskell t -> identifier "" + {-# LINE 404 "dist/build/Order.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 23, column 11) + _inh = + ({-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIinhMap + {-# LINE 410 "dist/build/Order.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 24, column 11) + _syn = + ({-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIsynMap + {-# LINE 416 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 422 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 207, column 23) + _lhsOgathRules = + ({-# LINE 207 "./src-ag/Order.ag" #-} + _gathRules + {-# LINE 428 "dist/build/Order.hs" #-} + ) + in ( _lhsOattributes,_lhsOcollectChildrenInhs,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfield,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals)))) +-- Children ---------------------------------------------------- +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,ChildKind)] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + inh : Attributes + inhMap : Map Identifier Attributes + mergeMap : Map Identifier (Identifier,[Identifier]) + nt : Identifier + o_unbox : Bool + syn : Attributes + synMap : Map Identifier Attributes + synthesized attributes: + attributes : [(Identifier,Attributes,Attributes)] + collectChildrenInhs : Map Identifier Attributes + collectChildrenSyns : Map Identifier Attributes + errors : Seq Error + fields : [(Identifier,Type,ChildKind)] + gathAltAttrs : [AltAttr] + gathRules : Seq CRule + inhs : Seq (Identifier,Attributes) + nts : Seq (Identifier,NontermIdent) + singlevisits : [CRule] + terminals : [Identifier] + alternatives: + alternative Cons: + child hd : Child + child tl : Children + alternative Nil: +-} +-- 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,Type,ChildKind)]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + Attributes -> + (Map Identifier Attributes) -> + (Map Identifier (Identifier,[Identifier])) -> + Identifier -> + Bool -> + Attributes -> + (Map Identifier Attributes) -> + ( ([(Identifier,Attributes,Attributes)]),(Map Identifier Attributes ),(Map Identifier Attributes ),(Seq Error),([(Identifier,Type,ChildKind)]),([AltAttr]),(Seq CRule),(Seq (Identifier,Attributes)),(Seq (Identifier,NontermIdent)),([CRule]),([Identifier]))) +data Inh_Children = Inh_Children {allfields_Inh_Children :: !(([(Identifier,Type,ChildKind)])),allnts_Inh_Children :: !(([Identifier])),attrs_Inh_Children :: !(([(Identifier,Identifier)])),con_Inh_Children :: !(Identifier),inh_Inh_Children :: !(Attributes),inhMap_Inh_Children :: !((Map Identifier Attributes)),mergeMap_Inh_Children :: !((Map Identifier (Identifier,[Identifier]))),nt_Inh_Children :: !(Identifier),o_unbox_Inh_Children :: !(Bool),syn_Inh_Children :: !(Attributes),synMap_Inh_Children :: !((Map Identifier Attributes))} +data Syn_Children = Syn_Children {attributes_Syn_Children :: !(([(Identifier,Attributes,Attributes)])),collectChildrenInhs_Syn_Children :: !((Map Identifier Attributes )),collectChildrenSyns_Syn_Children :: !((Map Identifier Attributes )),errors_Syn_Children :: !((Seq Error)),fields_Syn_Children :: !(([(Identifier,Type,ChildKind)])),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 -> + Inh_Children -> + Syn_Children +wrap_Children (T_Children sem) (Inh_Children _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn _lhsIsynMap) = + (let ( _lhsOattributes,_lhsOcollectChildrenInhs,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn _lhsIsynMap + in (Syn_Children _lhsOattributes _lhsOcollectChildrenInhs _lhsOcollectChildrenSyns _lhsOerrors _lhsOfields _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals)) +sem_Children_Cons :: T_Child -> + T_Children -> + T_Children +sem_Children_Cons (T_Child hd_) (T_Children tl_) = + (T_Children (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIinh + _lhsIinhMap + _lhsImergeMap + _lhsInt + _lhsIo_unbox + _lhsIsyn + _lhsIsynMap -> + (let _lhsOfields :: ([(Identifier,Type,ChildKind)]) + _lhsOattributes :: ([(Identifier,Attributes,Attributes)]) + _lhsOcollectChildrenInhs :: (Map Identifier Attributes ) + _lhsOcollectChildrenSyns :: (Map Identifier Attributes ) + _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOgathRules :: (Seq CRule) + _lhsOinhs :: (Seq (Identifier,Attributes)) + _lhsOnts :: (Seq (Identifier,NontermIdent)) + _lhsOsinglevisits :: ([CRule]) + _lhsOterminals :: ([Identifier]) + _hdOallfields :: ([(Identifier,Type,ChildKind)]) + _hdOallnts :: ([Identifier]) + _hdOattrs :: ([(Identifier,Identifier)]) + _hdOcon :: Identifier + _hdOinh :: Attributes + _hdOinhMap :: (Map Identifier Attributes) + _hdOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _hdOnt :: Identifier + _hdOo_unbox :: Bool + _hdOsyn :: Attributes + _hdOsynMap :: (Map Identifier Attributes) + _tlOallfields :: ([(Identifier,Type,ChildKind)]) + _tlOallnts :: ([Identifier]) + _tlOattrs :: ([(Identifier,Identifier)]) + _tlOcon :: Identifier + _tlOinh :: Attributes + _tlOinhMap :: (Map Identifier Attributes) + _tlOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _tlOnt :: Identifier + _tlOo_unbox :: Bool + _tlOsyn :: Attributes + _tlOsynMap :: (Map Identifier Attributes) + _hdIattributes :: ([(Identifier,Attributes,Attributes)]) + _hdIcollectChildrenInhs :: (Map Identifier Attributes ) + _hdIcollectChildrenSyns :: (Map Identifier Attributes ) + _hdIerrors :: (Seq Error) + _hdIfield :: ((Identifier,Type,ChildKind)) + _hdIgathAltAttrs :: ([AltAttr]) + _hdIgathRules :: (Seq CRule) + _hdIinhs :: (Seq (Identifier,Attributes)) + _hdInts :: (Seq (Identifier,NontermIdent)) + _hdIsinglevisits :: ([CRule]) + _hdIterminals :: ([Identifier]) + _tlIattributes :: ([(Identifier,Attributes,Attributes)]) + _tlIcollectChildrenInhs :: (Map Identifier Attributes ) + _tlIcollectChildrenSyns :: (Map Identifier Attributes ) + _tlIerrors :: (Seq Error) + _tlIfields :: ([(Identifier,Type,ChildKind)]) + _tlIgathAltAttrs :: ([AltAttr]) + _tlIgathRules :: (Seq CRule) + _tlIinhs :: (Seq (Identifier,Attributes)) + _tlInts :: (Seq (Identifier,NontermIdent)) + _tlIsinglevisits :: ([CRule]) + _tlIterminals :: ([Identifier]) + -- "./src-ag/Order.ag"(line 675, column 11) + _lhsOfields = + ({-# LINE 675 "./src-ag/Order.ag" #-} + _hdIfield : _tlIfields + {-# LINE 564 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 666, column 32) + _lhsOattributes = + ({-# LINE 666 "./src-ag/Order.ag" #-} + _hdIattributes ++ _tlIattributes + {-# LINE 570 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 343, column 68) + _lhsOcollectChildrenInhs = + ({-# LINE 343 "./src-ag/Order.ag" #-} + _hdIcollectChildrenInhs `Map.union` _tlIcollectChildrenInhs + {-# LINE 576 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 343, column 68) + _lhsOcollectChildrenSyns = + ({-# LINE 343 "./src-ag/Order.ag" #-} + _hdIcollectChildrenSyns `Map.union` _tlIcollectChildrenSyns + {-# LINE 582 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 588 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 171, column 68) + _lhsOgathAltAttrs = + ({-# LINE 171 "./src-ag/Order.ag" #-} + _hdIgathAltAttrs ++ _tlIgathAltAttrs + {-# LINE 594 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 207, column 23) + _lhsOgathRules = + ({-# LINE 207 "./src-ag/Order.ag" #-} + _hdIgathRules Seq.>< _tlIgathRules + {-# LINE 600 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 194, column 20) + _lhsOinhs = + ({-# LINE 194 "./src-ag/Order.ag" #-} + _hdIinhs Seq.>< _tlIinhs + {-# LINE 606 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 193, column 19) + _lhsOnts = + ({-# LINE 193 "./src-ag/Order.ag" #-} + _hdInts Seq.>< _tlInts + {-# LINE 612 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 612, column 40) + _lhsOsinglevisits = + ({-# LINE 612 "./src-ag/Order.ag" #-} + _hdIsinglevisits ++ _tlIsinglevisits + {-# LINE 618 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 637, column 38) + _lhsOterminals = + ({-# LINE 637 "./src-ag/Order.ag" #-} + _hdIterminals ++ _tlIterminals + {-# LINE 624 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOallfields = + ({-# LINE 655 "./src-ag/Order.ag" #-} + _lhsIallfields + {-# LINE 630 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOallnts = + ({-# LINE 648 "./src-ag/Order.ag" #-} + _lhsIallnts + {-# LINE 636 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOattrs = + ({-# LINE 655 "./src-ag/Order.ag" #-} + _lhsIattrs + {-# LINE 642 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 91 "./src-ag/Order.ag" #-} + _lhsIcon + {-# LINE 648 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIinh + {-# LINE 654 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 660 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 361 "./src-ag/Order.ag" #-} + _lhsImergeMap + {-# LINE 666 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 672 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 120 "./src-ag/Order.ag" #-} + _lhsIo_unbox + {-# LINE 678 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIsyn + {-# LINE 684 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 690 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOallfields = + ({-# LINE 655 "./src-ag/Order.ag" #-} + _lhsIallfields + {-# LINE 696 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOallnts = + ({-# LINE 648 "./src-ag/Order.ag" #-} + _lhsIallnts + {-# LINE 702 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOattrs = + ({-# LINE 655 "./src-ag/Order.ag" #-} + _lhsIattrs + {-# LINE 708 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 91 "./src-ag/Order.ag" #-} + _lhsIcon + {-# LINE 714 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIinh + {-# LINE 720 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 726 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 361 "./src-ag/Order.ag" #-} + _lhsImergeMap + {-# LINE 732 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 738 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 120 "./src-ag/Order.ag" #-} + _lhsIo_unbox + {-# LINE 744 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIsyn + {-# LINE 750 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 756 "dist/build/Order.hs" #-} + ) + ( _hdIattributes,_hdIcollectChildrenInhs,_hdIcollectChildrenSyns,_hdIerrors,_hdIfield,_hdIgathAltAttrs,_hdIgathRules,_hdIinhs,_hdInts,_hdIsinglevisits,_hdIterminals) = + hd_ _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOinh _hdOinhMap _hdOmergeMap _hdOnt _hdOo_unbox _hdOsyn _hdOsynMap + ( _tlIattributes,_tlIcollectChildrenInhs,_tlIcollectChildrenSyns,_tlIerrors,_tlIfields,_tlIgathAltAttrs,_tlIgathRules,_tlIinhs,_tlInts,_tlIsinglevisits,_tlIterminals) = + tl_ _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOinh _tlOinhMap _tlOmergeMap _tlOnt _tlOo_unbox _tlOsyn _tlOsynMap + in ( _lhsOattributes,_lhsOcollectChildrenInhs,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals)))) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIinh + _lhsIinhMap + _lhsImergeMap + _lhsInt + _lhsIo_unbox + _lhsIsyn + _lhsIsynMap -> + (let _lhsOfields :: ([(Identifier,Type,ChildKind)]) + _lhsOattributes :: ([(Identifier,Attributes,Attributes)]) + _lhsOcollectChildrenInhs :: (Map Identifier Attributes ) + _lhsOcollectChildrenSyns :: (Map Identifier Attributes ) + _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOgathRules :: (Seq CRule) + _lhsOinhs :: (Seq (Identifier,Attributes)) + _lhsOnts :: (Seq (Identifier,NontermIdent)) + _lhsOsinglevisits :: ([CRule]) + _lhsOterminals :: ([Identifier]) + -- "./src-ag/Order.ag"(line 676, column 11) + _lhsOfields = + ({-# LINE 676 "./src-ag/Order.ag" #-} + [] + {-# LINE 791 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 666, column 32) + _lhsOattributes = + ({-# LINE 666 "./src-ag/Order.ag" #-} + [] + {-# LINE 797 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 343, column 68) + _lhsOcollectChildrenInhs = + ({-# LINE 343 "./src-ag/Order.ag" #-} + Map.empty + {-# LINE 803 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 343, column 68) + _lhsOcollectChildrenSyns = + ({-# LINE 343 "./src-ag/Order.ag" #-} + Map.empty + {-# LINE 809 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 815 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 171, column 68) + _lhsOgathAltAttrs = + ({-# LINE 171 "./src-ag/Order.ag" #-} + [] + {-# LINE 821 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 207, column 23) + _lhsOgathRules = + ({-# LINE 207 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 827 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 194, column 20) + _lhsOinhs = + ({-# LINE 194 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 833 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 193, column 19) + _lhsOnts = + ({-# LINE 193 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 839 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 612, column 40) + _lhsOsinglevisits = + ({-# LINE 612 "./src-ag/Order.ag" #-} + [] + {-# LINE 845 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 637, column 38) + _lhsOterminals = + ({-# LINE 637 "./src-ag/Order.ag" #-} + [] + {-# LINE 851 "dist/build/Order.hs" #-} + ) + in ( _lhsOattributes,_lhsOcollectChildrenInhs,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals)))) +-- Expression -------------------------------------------------- +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,ChildKind)] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + mergeMap : Map Identifier (Identifier,[Identifier]) + nt : Identifier + synthesized attributes: + allRhsVars : Set (Identifier,Identifier) + copy : Expression + errors : Seq Error + textLines : [String] + usedAttrs : [(Identifier,Identifier)] + usedFields : [Identifier] + usedLocals : [Identifier] + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} + visit 0: + local textLines : _ + local usedAttrs : _ + local usedLocals : _ + local usedFields : _ + local copy : _ +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression _pos _tks) = + (sem_Expression_Expression _pos _tks) +-- semantic domain +newtype T_Expression = T_Expression (([(Identifier,Type,ChildKind)]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + (Map Identifier (Identifier,[Identifier])) -> + Identifier -> + ( (Set (Identifier,Identifier)),Expression,(Seq Error),([String]),([(Identifier,Identifier)]),([Identifier]),([Identifier]))) +data Inh_Expression = Inh_Expression {allfields_Inh_Expression :: !(([(Identifier,Type,ChildKind)])),allnts_Inh_Expression :: !(([Identifier])),attrs_Inh_Expression :: !(([(Identifier,Identifier)])),con_Inh_Expression :: !(Identifier),mergeMap_Inh_Expression :: !((Map Identifier (Identifier,[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 -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem) (Inh_Expression _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt) = + (let ( _lhsOallRhsVars,_lhsOcopy,_lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt + in (Syn_Expression _lhsOallRhsVars _lhsOcopy _lhsOerrors _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals)) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsImergeMap + _lhsInt -> + (let _lhsOerrors :: (Seq Error) + _lhsOallRhsVars :: (Set (Identifier,Identifier)) + _lhsOcopy :: Expression + _lhsOtextLines :: ([String]) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedFields :: ([Identifier]) + _lhsOusedLocals :: ([Identifier]) + -- "./src-ag/Order.ag"(line 465, column 21) + (_textLines,_usedAttrs,_usedLocals,_usedFields) = + ({-# LINE 465 "./src-ag/Order.ag" #-} + let mergedChildren = [ x | (_,xs) <- Map.elems _lhsImergeMap, x <- xs ] + attrsIn = filter (\(fld,_) -> not (fld `elem` mergedChildren)) _lhsIattrs + inherited = Inh_HsTokensRoot + { attrs_Inh_HsTokensRoot = attrsIn + , con_Inh_HsTokensRoot = _lhsIcon + , allfields_Inh_HsTokensRoot = _lhsIallfields + , allnts_Inh_HsTokensRoot = _lhsIallnts + , nt_Inh_HsTokensRoot = _lhsInt + } + synthesized = wrap_HsTokensRoot (sem_HsTokensRoot (HsTokensRoot tks_)) inherited + in case synthesized of + Syn_HsTokensRoot + { textLines_Syn_HsTokensRoot = textLines + , usedAttrs_Syn_HsTokensRoot = usedAttrs + , usedLocals_Syn_HsTokensRoot = usedLocals + , usedFields_Syn_HsTokensRoot = usedFields + } -> let extraAttrs = [ (src,attr) + | (fld,attr) <- usedAttrs, let mbMerged = Map.lookup fld _lhsImergeMap, isJust mbMerged + , let (Just (_, srcs)) = mbMerged, src <- srcs ] + usedAttrs' = usedAttrs ++ extraAttrs + in (textLines,usedAttrs',usedLocals,usedFields) + {-# LINE 945 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 488, column 17) + _lhsOerrors = + ({-# LINE 488 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 951 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 489, column 17) + _lhsOallRhsVars = + ({-# LINE 489 "./src-ag/Order.ag" #-} + Set.fromList _usedAttrs + `Set.union` + Set.fromList [ (_LOC, l) | l <- _usedLocals ] + `Set.union` + Set.fromList [ (_FIELD, fld) | fld <- _usedFields ] + {-# LINE 961 "dist/build/Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 456 "./src-ag/Order.ag" #-} + Expression pos_ tks_ + {-# LINE 967 "dist/build/Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 456 "./src-ag/Order.ag" #-} + _copy + {-# LINE 973 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _lhsOtextLines = + ({-# LINE 455 "./src-ag/Order.ag" #-} + _textLines + {-# LINE 979 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _lhsOusedAttrs = + ({-# LINE 453 "./src-ag/Order.ag" #-} + _usedAttrs + {-# LINE 985 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _lhsOusedFields = + ({-# LINE 454 "./src-ag/Order.ag" #-} + _usedFields + {-# LINE 991 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _lhsOusedLocals = + ({-# LINE 452 "./src-ag/Order.ag" #-} + _usedLocals + {-# LINE 997 "dist/build/Order.hs" #-} + ) + in ( _lhsOallRhsVars,_lhsOcopy,_lhsOerrors,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals)))) +-- Grammar ----------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + errors : Seq Error + nAutoRules : Int + nExplicitRules : Int + output : CGrammar + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} + visit 0: + local o_dovisit : _ + local ruleTable : _ + local attrTable : _ + local attrVertex : _ + local tdpToTds : _ + local tdsToTdp : _ + local directDep : _ + local instDep : _ + local aroundDep : _ + local mergeDep : _ + local info : _ + local cInterfaceMap : _ + local cVisitsMap : _ + local cyclesErrors : _ + local aroundMap : _ + local mergeMap : _ +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) +-- semantic domain +newtype T_Grammar = T_Grammar (Options -> + ( (Seq Error),Int,Int,CGrammar)) +data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: !(Options)} +data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: !((Seq Error)),nAutoRules_Syn_Grammar :: !(Int),nExplicitRules_Syn_Grammar :: !(Int),output_Syn_Grammar :: !(CGrammar)} +wrap_Grammar :: T_Grammar -> + Inh_Grammar -> + Syn_Grammar +wrap_Grammar (T_Grammar sem) (Inh_Grammar _lhsIoptions) = + (let ( _lhsOerrors,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOoutput) = sem _lhsIoptions + in (Syn_Grammar _lhsOerrors _lhsOnAutoRules _lhsOnExplicitRules _lhsOoutput)) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ = + (T_Grammar (\ _lhsIoptions -> + (let _nontsOo_cata :: Bool + _nontsOo_data :: Bool + _nontsOo_sig :: Bool + _nontsOo_sem :: Bool + _nontsOo_rename :: Bool + _nontsOo_newtypes :: Bool + _nontsOo_wantvisit :: Bool + _nontsOo_unbox :: Bool + _nontsOo_case :: Bool + _nontsOprefix :: String + _nontsOvcount :: Int + _nontsOmanualAttrDepMap :: AttrOrderMap + _nontsOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) + _nontsOacount :: Int + _lhsOerrors :: (Seq Error) + _lhsOoutput :: CGrammar + _nontsOallnts :: ([Identifier]) + _nontsOinhMap :: (Map Identifier Attributes) + _nontsOsynMap :: (Map Identifier Attributes) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _nontsOcInterfaceMap :: CInterfaceMap + _nontsOcVisitsMap :: CVisitsMap + _nontsOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) + _nontsOo_dovisit :: Bool + _nontsIacount :: Int + _nontsIadditionalDep :: (Seq Edge) + _nontsIaranges :: (Seq (Int,Int,Int)) + _nontsIaroundDep :: (Seq Edge) + _nontsIcNonterminals :: CNonterminals + _nontsIdirectDep :: (Seq Edge) + _nontsIerrors :: (Seq Error) + _nontsIinhMap' :: (Map Identifier Attributes) + _nontsIinstDep :: (Seq Edge) + _nontsImergeDep :: (Seq Edge) + _nontsInAutoRules :: Int + _nontsInExplicitRules :: Int + _nontsInonts :: ([(NontermIdent,[ConstructorIdent])]) + _nontsIntattrs :: (Seq (Vertex,NTAttr)) + _nontsIrules :: (Seq (Vertex,CRule)) + _nontsIsynMap' :: (Map Identifier Attributes) + _nontsIvcount :: Int + -- "./src-ag/Order.ag"(line 124, column 17) + _o_dovisit = + ({-# LINE 124 "./src-ag/Order.ag" #-} + visit _lhsIoptions && null _cyclesErrors + {-# LINE 1123 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 125, column 17) + _nontsOo_cata = + ({-# LINE 125 "./src-ag/Order.ag" #-} + folds _lhsIoptions + {-# LINE 1129 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 125, column 17) + _nontsOo_data = + ({-# LINE 126 "./src-ag/Order.ag" #-} + dataTypes _lhsIoptions + {-# LINE 1135 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 125, column 17) + _nontsOo_sig = + ({-# LINE 127 "./src-ag/Order.ag" #-} + typeSigs _lhsIoptions + {-# LINE 1141 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 125, column 17) + _nontsOo_sem = + ({-# LINE 128 "./src-ag/Order.ag" #-} + semfuns _lhsIoptions + {-# LINE 1147 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 125, column 17) + _nontsOo_rename = + ({-# LINE 129 "./src-ag/Order.ag" #-} + rename _lhsIoptions + {-# LINE 1153 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 125, column 17) + _nontsOo_newtypes = + ({-# LINE 130 "./src-ag/Order.ag" #-} + newtypes _lhsIoptions + {-# LINE 1159 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 125, column 17) + _nontsOo_wantvisit = + ({-# LINE 131 "./src-ag/Order.ag" #-} + visit _lhsIoptions + {-# LINE 1165 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 125, column 17) + _nontsOo_unbox = + ({-# LINE 132 "./src-ag/Order.ag" #-} + unbox _lhsIoptions + {-# LINE 1171 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 125, column 17) + _nontsOo_case = + ({-# LINE 133 "./src-ag/Order.ag" #-} + cases _lhsIoptions + {-# LINE 1177 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 125, column 17) + _nontsOprefix = + ({-# LINE 134 "./src-ag/Order.ag" #-} + prefix _lhsIoptions + {-# LINE 1183 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 260, column 15) + _nontsOvcount = + ({-# LINE 260 "./src-ag/Order.ag" #-} + 0 + {-# LINE 1189 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 286, column 7) + _nontsOmanualAttrDepMap = + ({-# LINE 286 "./src-ag/Order.ag" #-} + manualAttrOrderMap_ + {-# LINE 1195 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 415, column 14) + _nontsOaroundMap = + ({-# LINE 415 "./src-ag/Order.ag" #-} + aroundsMap_ + {-# LINE 1201 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 504, column 13) + _nontsOacount = + ({-# LINE 504 "./src-ag/Order.ag" #-} + 0 + {-# LINE 1207 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 542, column 13) + _ruleTable = + ({-# LINE 542 "./src-ag/Order.ag" #-} + Array.array (0,_nontsIvcount-1) (toList _nontsIrules) + {-# LINE 1213 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 543, column 13) + _attrTable = + ({-# LINE 543 "./src-ag/Order.ag" #-} + Array.array (0,_nontsIacount-1) (toList _nontsIntattrs) + {-# LINE 1219 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 544, column 13) + _attrVertex = + ({-# LINE 544 "./src-ag/Order.ag" #-} + Map.fromList (map swap (toList _nontsIntattrs)) + {-# LINE 1225 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 545, column 13) + _tdpToTds = + ({-# LINE 545 "./src-ag/Order.ag" #-} + [ (s, maybe (-1) (\v -> findWithErr1 "Grammar.tdpToTds" v _attrVertex) (ntattr cr)) + | (s,cr) <- toList _nontsIrules] + {-# LINE 1232 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 547, column 13) + _tdsToTdp = + ({-# LINE 547 "./src-ag/Order.ag" #-} + 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) + {-# LINE 1241 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 551, column 13) + _directDep = + ({-# LINE 551 "./src-ag/Order.ag" #-} + toList (_nontsIdirectDep Seq.>< _nontsIadditionalDep) + {-# LINE 1247 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 552, column 13) + _instDep = + ({-# LINE 552 "./src-ag/Order.ag" #-} + toList _nontsIinstDep + {-# LINE 1253 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 553, column 13) + _aroundDep = + ({-# LINE 553 "./src-ag/Order.ag" #-} + toList _nontsIaroundDep + {-# LINE 1259 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 554, column 13) + _mergeDep = + ({-# LINE 554 "./src-ag/Order.ag" #-} + toList _nontsImergeDep + {-# LINE 1265 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 555, column 13) + _info = + ({-# LINE 555 "./src-ag/Order.ag" #-} + let def [] = -1 + def (v:vs) = v + in Info { tdsToTdp = Array.array (0,_nontsIacount-1) _tdsToTdp + , tdpToTds = Array.array (0,_nontsIvcount-1) _tdpToTds + , attrTable = _attrTable + , ruleTable = _ruleTable + , lmh = toList _nontsIaranges + , nonts = _nontsInonts + , wraps = wrappers_ + } + {-# LINE 1280 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 566, column 17) + (_cInterfaceMap,_cVisitsMap,_cyclesErrors) = + ({-# LINE 566 "./src-ag/Order.ag" #-} + case computeSequential _info _directDep (_instDep ++ _aroundDep ++ _mergeDep ) of + CycleFree cim cvm -> ( cim + , cvm + , [] + ) + LocalCycle errs -> ( error "No interfaces for AG with local cycles" + , error "No visit sub-sequences for AG with local cycles" + , map (localCycleErr _ruleTable (visit _lhsIoptions)) errs + ) + InstCycle errs -> ( error "No interfaces for AG with cycles through insts" + , error "No visit sub-sequences for AG with cycles through insts" + , map (instCycleErr _ruleTable (visit _lhsIoptions)) errs + ) + DirectCycle errs -> ( error "No interfaces for AG with direct cycles" + , error "No visit sub-sequences for AG with direct cycles" + , directCycleErrs _attrTable _ruleTable (visit _lhsIoptions) errs + ) + InducedCycle cim errs -> ( cim + , error "No visit sub-sequences for AG with induced cycles" + , inducedCycleErrs _attrTable _ruleTable cim errs + ) + {-# LINE 1306 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 588, column 13) + _lhsOerrors = + ({-# LINE 588 "./src-ag/Order.ag" #-} + (if withCycle _lhsIoptions then Seq.fromList _cyclesErrors else Seq.empty) + Seq.>< _nontsIerrors + {-# LINE 1313 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 620, column 15) + _lhsOoutput = + ({-# LINE 620 "./src-ag/Order.ag" #-} + CGrammar typeSyns_ derivings_ wrappers_ _nontsIcNonterminals pragmas_ paramMap_ contextMap_ quantMap_ _aroundMap _mergeMap _o_dovisit + {-# LINE 1319 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 633, column 14) + _aroundMap = + ({-# LINE 633 "./src-ag/Order.ag" #-} + Map.map (Map.map Map.keysSet) aroundsMap_ + {-# LINE 1325 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 634, column 14) + _mergeMap = + ({-# LINE 634 "./src-ag/Order.ag" #-} + Map.map (Map.map (Map.map (\(nt,srcs,_) -> (nt,srcs)))) mergeMap_ + {-# LINE 1331 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 651, column 13) + _nontsOallnts = + ({-# LINE 651 "./src-ag/Order.ag" #-} + map fst (_nontsInonts) + {-# LINE 1337 "dist/build/Order.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 15, column 13) + _nontsOinhMap = + ({-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + _nontsIinhMap' + {-# LINE 1343 "dist/build/Order.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 16, column 13) + _nontsOsynMap = + ({-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + _nontsIsynMap' + {-# LINE 1349 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnAutoRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + _nontsInAutoRules + {-# LINE 1355 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnExplicitRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + _nontsInExplicitRules + {-# LINE 1361 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _nontsOcInterfaceMap = + ({-# LINE 595 "./src-ag/Order.ag" #-} + _cInterfaceMap + {-# LINE 1367 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _nontsOcVisitsMap = + ({-# LINE 602 "./src-ag/Order.ag" #-} + _cVisitsMap + {-# LINE 1373 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _nontsOmergeMap = + ({-# LINE 353 "./src-ag/Order.ag" #-} + _mergeMap + {-# LINE 1379 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _nontsOo_dovisit = + ({-# LINE 117 "./src-ag/Order.ag" #-} + _o_dovisit + {-# LINE 1385 "dist/build/Order.hs" #-} + ) + ( _nontsIacount,_nontsIadditionalDep,_nontsIaranges,_nontsIaroundDep,_nontsIcNonterminals,_nontsIdirectDep,_nontsIerrors,_nontsIinhMap',_nontsIinstDep,_nontsImergeDep,_nontsInAutoRules,_nontsInExplicitRules,_nontsInonts,_nontsIntattrs,_nontsIrules,_nontsIsynMap',_nontsIvcount) = + nonts_ _nontsOacount _nontsOallnts _nontsOaroundMap _nontsOcInterfaceMap _nontsOcVisitsMap _nontsOinhMap _nontsOmanualAttrDepMap _nontsOmergeMap _nontsOo_case _nontsOo_cata _nontsOo_data _nontsOo_dovisit _nontsOo_newtypes _nontsOo_rename _nontsOo_sem _nontsOo_sig _nontsOo_unbox _nontsOo_wantvisit _nontsOprefix _nontsOsynMap _nontsOvcount + in ( _lhsOerrors,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOoutput)))) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + inherited attributes: + allnts : [Identifier] + aroundMap : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + cInterfaceMap : CInterfaceMap + cVisitsMap : CVisitsMap + inhMap : Map Identifier Attributes + manualAttrDepMap : AttrOrderMap + mergeMap : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) + o_case : Bool + o_cata : Bool + o_data : Bool + o_dovisit : Bool + o_newtypes : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_unbox : Bool + o_wantvisit : Bool + prefix : String + synMap : Map Identifier Attributes + chained attributes: + acount : Int + vcount : Int + synthesized attributes: + additionalDep : Seq Edge + aranges : Seq (Int,Int,Int) + aroundDep : Seq Edge + cNonterminal : CNonterminal + directDep : Seq Edge + errors : Seq Error + inhMap' : Map Identifier Attributes + instDep : Seq Edge + mergeDep : Seq Edge + nAutoRules : Int + nExplicitRules : Int + nonts : [(NontermIdent,[ConstructorIdent])] + ntattrs : Seq (Vertex,NTAttr) + rules : Seq (Vertex,CRule) + synMap' : Map Identifier Attributes + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions + visit 0: + local mergeMap : _ + local aroundMap : _ + local ntattrs : _ + local cInter : _ +-} +-- 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 (Int -> + ([Identifier]) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + CInterfaceMap -> + CVisitsMap -> + (Map Identifier Attributes) -> + AttrOrderMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + String -> + (Map Identifier Attributes) -> + Int -> + ( Int,(Seq Edge),(Seq (Int,Int,Int)),(Seq Edge),CNonterminal,(Seq Edge),(Seq Error),(Map Identifier Attributes),(Seq Edge),(Seq Edge),Int,Int,([(NontermIdent,[ConstructorIdent])]),(Seq (Vertex,NTAttr)),(Seq (Vertex,CRule)),(Map Identifier Attributes),Int)) +data Inh_Nonterminal = Inh_Nonterminal {acount_Inh_Nonterminal :: !(Int),allnts_Inh_Nonterminal :: !(([Identifier])),aroundMap_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cInterfaceMap_Inh_Nonterminal :: !(CInterfaceMap),cVisitsMap_Inh_Nonterminal :: !(CVisitsMap),inhMap_Inh_Nonterminal :: !((Map Identifier Attributes)),manualAttrDepMap_Inh_Nonterminal :: !(AttrOrderMap),mergeMap_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))))),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),synMap_Inh_Nonterminal :: !((Map Identifier Attributes)),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))),aroundDep_Syn_Nonterminal :: !((Seq Edge)),cNonterminal_Syn_Nonterminal :: !(CNonterminal),directDep_Syn_Nonterminal :: !((Seq Edge)),errors_Syn_Nonterminal :: !((Seq Error)),inhMap'_Syn_Nonterminal :: !((Map Identifier Attributes)),instDep_Syn_Nonterminal :: !((Seq Edge)),mergeDep_Syn_Nonterminal :: !((Seq Edge)),nAutoRules_Syn_Nonterminal :: !(Int),nExplicitRules_Syn_Nonterminal :: !(Int),nonts_Syn_Nonterminal :: !(([(NontermIdent,[ConstructorIdent])])),ntattrs_Syn_Nonterminal :: !((Seq (Vertex,NTAttr))),rules_Syn_Nonterminal :: !((Seq (Vertex,CRule))),synMap'_Syn_Nonterminal :: !((Map Identifier Attributes)),vcount_Syn_Nonterminal :: !(Int)} +wrap_Nonterminal :: T_Nonterminal -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsynMap _lhsIvcount) = + (let ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOaroundDep,_lhsOcNonterminal,_lhsOdirectDep,_lhsOerrors,_lhsOinhMap',_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOsynMap',_lhsOvcount) = sem _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsynMap _lhsIvcount + in (Syn_Nonterminal _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOaroundDep _lhsOcNonterminal _lhsOdirectDep _lhsOerrors _lhsOinhMap' _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOnonts _lhsOntattrs _lhsOrules _lhsOsynMap' _lhsOvcount)) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) = + (T_Nonterminal (\ _lhsIacount + _lhsIallnts + _lhsIaroundMap + _lhsIcInterfaceMap + _lhsIcVisitsMap + _lhsIinhMap + _lhsImanualAttrDepMap + _lhsImergeMap + _lhsIo_case + _lhsIo_cata + _lhsIo_data + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_unbox + _lhsIo_wantvisit + _lhsIprefix + _lhsIsynMap + _lhsIvcount -> + (let _prodsOnt :: Identifier + _prodsOinh :: Attributes + _prodsOsyn :: Attributes + _lhsOntattrs :: (Seq (Vertex,NTAttr)) + _lhsOacount :: Int + _lhsOaranges :: (Seq (Int,Int,Int)) + _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])]) + _lhsOcNonterminal :: CNonterminal + _lhsOinhMap' :: (Map Identifier Attributes) + _lhsOsynMap' :: (Map Identifier Attributes) + _lhsOadditionalDep :: (Seq Edge) + _lhsOaroundDep :: (Seq Edge) + _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOinstDep :: (Seq Edge) + _lhsOmergeDep :: (Seq Edge) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _lhsOrules :: (Seq (Vertex,CRule)) + _lhsOvcount :: Int + _prodsOallnts :: ([Identifier]) + _prodsOaroundMap :: (Map ConstructorIdent (Map Identifier [Expression])) + _prodsOcVisitsMap :: CVisitsMap + _prodsOinhMap :: (Map Identifier Attributes) + _prodsOmanualAttrDepMap :: AttrOrderMap + _prodsOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) + _prodsOo_case :: Bool + _prodsOo_cata :: Bool + _prodsOo_dovisit :: Bool + _prodsOo_newtypes :: Bool + _prodsOo_rename :: Bool + _prodsOo_sem :: Bool + _prodsOo_sig :: Bool + _prodsOo_unbox :: Bool + _prodsOo_wantvisit :: Bool + _prodsOprefix :: String + _prodsOsynMap :: (Map Identifier Attributes) + _prodsOvcount :: Int + _prodsIadditionalDep :: (Seq Edge) + _prodsIaroundDep :: (Seq Edge) + _prodsIcProductions :: CProductions + _prodsIcons :: ([ConstructorIdent]) + _prodsIdirectDep :: (Seq Edge) + _prodsIerrors :: (Seq Error) + _prodsIinstDep :: (Seq Edge) + _prodsImergeDep :: (Seq Edge) + _prodsInAutoRules :: Int + _prodsInExplicitRules :: Int + _prodsIrules :: (Seq (Vertex,CRule)) + _prodsIvcount :: Int + -- "./src-ag/Order.ag"(line 98, column 17) + _prodsOnt = + ({-# LINE 98 "./src-ag/Order.ag" #-} + nt_ + {-# LINE 1563 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 101, column 17) + _prodsOinh = + ({-# LINE 101 "./src-ag/Order.ag" #-} + inh_ + {-# LINE 1569 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 102, column 17) + _prodsOsyn = + ({-# LINE 102 "./src-ag/Order.ag" #-} + syn_ + {-# LINE 1575 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 358, column 32) + _mergeMap = + ({-# LINE 358 "./src-ag/Order.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsImergeMap + {-# LINE 1581 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 411, column 32) + _aroundMap = + ({-# LINE 411 "./src-ag/Order.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaroundMap + {-# LINE 1587 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 507, column 17) + _ntattrs = + ({-# LINE 507 "./src-ag/Order.ag" #-} + [ NTAInh nt_ inh tp | (inh,tp) <- Map.assocs inh_ ] + ++ [NTASyn nt_ syn tp | (syn,tp) <- Map.assocs syn_ ] + {-# LINE 1594 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 509, column 17) + _lhsOntattrs = + ({-# LINE 509 "./src-ag/Order.ag" #-} + Seq.fromList (zip [_lhsIacount ..] _ntattrs) + {-# LINE 1600 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 510, column 17) + _lhsOacount = + ({-# LINE 510 "./src-ag/Order.ag" #-} + _lhsIacount + Map.size inh_ + Map.size syn_ + {-# LINE 1606 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 511, column 17) + _lhsOaranges = + ({-# LINE 511 "./src-ag/Order.ag" #-} + Seq.singleton + (_lhsIacount + ,_lhsIacount + Map.size inh_ + ,_lhsIacount + Map.size syn_ + Map.size inh_ - 1) + {-# LINE 1615 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 520, column 19) + _lhsOnonts = + ({-# LINE 520 "./src-ag/Order.ag" #-} + [(nt_,_prodsIcons)] + {-# LINE 1621 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 597, column 19) + _cInter = + ({-# LINE 597 "./src-ag/Order.ag" #-} + if _lhsIo_dovisit + then findWithErr1 "Nonterminal.cInter" nt_ _lhsIcInterfaceMap + else CInterface [CSegment inh_ syn_] + {-# LINE 1629 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 625, column 19) + _lhsOcNonterminal = + ({-# LINE 625 "./src-ag/Order.ag" #-} + CNonterminal nt_ params_ inh_ syn_ _prodsIcProductions _cInter + {-# LINE 1635 "dist/build/Order.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 7, column 18) + _lhsOinhMap' = + ({-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 1641 "dist/build/Order.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 8, column 18) + _lhsOsynMap' = + ({-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 1647 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 282, column 60) + _lhsOadditionalDep = + ({-# LINE 282 "./src-ag/Order.ag" #-} + _prodsIadditionalDep + {-# LINE 1653 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 403, column 24) + _lhsOaroundDep = + ({-# LINE 403 "./src-ag/Order.ag" #-} + _prodsIaroundDep + {-# LINE 1659 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 268, column 33) + _lhsOdirectDep = + ({-# LINE 268 "./src-ag/Order.ag" #-} + _prodsIdirectDep + {-# LINE 1665 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + _prodsIerrors + {-# LINE 1671 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 311, column 31) + _lhsOinstDep = + ({-# LINE 311 "./src-ag/Order.ag" #-} + _prodsIinstDep + {-# LINE 1677 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 366, column 18) + _lhsOmergeDep = + ({-# LINE 366 "./src-ag/Order.ag" #-} + _prodsImergeDep + {-# LINE 1683 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnAutoRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + _prodsInAutoRules + {-# LINE 1689 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnExplicitRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + _prodsInExplicitRules + {-# LINE 1695 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 258, column 18) + _lhsOrules = + ({-# LINE 258 "./src-ag/Order.ag" #-} + _prodsIrules + {-# LINE 1701 "dist/build/Order.hs" #-} + ) + -- copy rule (up) + _lhsOvcount = + ({-# LINE 257 "./src-ag/Order.ag" #-} + _prodsIvcount + {-# LINE 1707 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOallnts = + ({-# LINE 648 "./src-ag/Order.ag" #-} + _lhsIallnts + {-# LINE 1713 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _prodsOaroundMap = + ({-# LINE 409 "./src-ag/Order.ag" #-} + _aroundMap + {-# LINE 1719 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOcVisitsMap = + ({-# LINE 602 "./src-ag/Order.ag" #-} + _lhsIcVisitsMap + {-# LINE 1725 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1731 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOmanualAttrDepMap = + ({-# LINE 282 "./src-ag/Order.ag" #-} + _lhsImanualAttrDepMap + {-# LINE 1737 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _prodsOmergeMap = + ({-# LINE 356 "./src-ag/Order.ag" #-} + _mergeMap + {-# LINE 1743 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_case = + ({-# LINE 118 "./src-ag/Order.ag" #-} + _lhsIo_case + {-# LINE 1749 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_cata = + ({-# LINE 112 "./src-ag/Order.ag" #-} + _lhsIo_cata + {-# LINE 1755 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_dovisit = + ({-# LINE 117 "./src-ag/Order.ag" #-} + _lhsIo_dovisit + {-# LINE 1761 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_newtypes = + ({-# LINE 111 "./src-ag/Order.ag" #-} + _lhsIo_newtypes + {-# LINE 1767 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_rename = + ({-# LINE 115 "./src-ag/Order.ag" #-} + _lhsIo_rename + {-# LINE 1773 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_sem = + ({-# LINE 114 "./src-ag/Order.ag" #-} + _lhsIo_sem + {-# LINE 1779 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_sig = + ({-# LINE 113 "./src-ag/Order.ag" #-} + _lhsIo_sig + {-# LINE 1785 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_unbox = + ({-# LINE 120 "./src-ag/Order.ag" #-} + _lhsIo_unbox + {-# LINE 1791 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOo_wantvisit = + ({-# LINE 116 "./src-ag/Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 1797 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOprefix = + ({-# LINE 119 "./src-ag/Order.ag" #-} + _lhsIprefix + {-# LINE 1803 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1809 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _prodsOvcount = + ({-# LINE 257 "./src-ag/Order.ag" #-} + _lhsIvcount + {-# LINE 1815 "dist/build/Order.hs" #-} + ) + ( _prodsIadditionalDep,_prodsIaroundDep,_prodsIcProductions,_prodsIcons,_prodsIdirectDep,_prodsIerrors,_prodsIinstDep,_prodsImergeDep,_prodsInAutoRules,_prodsInExplicitRules,_prodsIrules,_prodsIvcount) = + prods_ _prodsOallnts _prodsOaroundMap _prodsOcVisitsMap _prodsOinh _prodsOinhMap _prodsOmanualAttrDepMap _prodsOmergeMap _prodsOnt _prodsOo_case _prodsOo_cata _prodsOo_dovisit _prodsOo_newtypes _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_unbox _prodsOo_wantvisit _prodsOprefix _prodsOsyn _prodsOsynMap _prodsOvcount + in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOaroundDep,_lhsOcNonterminal,_lhsOdirectDep,_lhsOerrors,_lhsOinhMap',_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOsynMap',_lhsOvcount)))) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + inherited attributes: + allnts : [Identifier] + aroundMap : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + cInterfaceMap : CInterfaceMap + cVisitsMap : CVisitsMap + inhMap : Map Identifier Attributes + manualAttrDepMap : AttrOrderMap + mergeMap : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) + o_case : Bool + o_cata : Bool + o_data : Bool + o_dovisit : Bool + o_newtypes : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_unbox : Bool + o_wantvisit : Bool + prefix : String + synMap : Map Identifier Attributes + chained attributes: + acount : Int + vcount : Int + synthesized attributes: + additionalDep : Seq Edge + aranges : Seq (Int,Int,Int) + aroundDep : Seq Edge + cNonterminals : CNonterminals + directDep : Seq Edge + errors : Seq Error + inhMap' : Map Identifier Attributes + instDep : Seq Edge + mergeDep : Seq Edge + nAutoRules : Int + nExplicitRules : Int + nonts : [(NontermIdent,[ConstructorIdent])] + ntattrs : Seq (Vertex,NTAttr) + rules : Seq (Vertex,CRule) + synMap' : Map Identifier Attributes + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + alternative Nil: +-} +-- 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 (Int -> + ([Identifier]) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + CInterfaceMap -> + CVisitsMap -> + (Map Identifier Attributes) -> + AttrOrderMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + String -> + (Map Identifier Attributes) -> + Int -> + ( Int,(Seq Edge),(Seq (Int,Int,Int)),(Seq Edge),CNonterminals,(Seq Edge),(Seq Error),(Map Identifier Attributes),(Seq Edge),(Seq Edge),Int,Int,([(NontermIdent,[ConstructorIdent])]),(Seq (Vertex,NTAttr)),(Seq (Vertex,CRule)),(Map Identifier Attributes),Int)) +data Inh_Nonterminals = Inh_Nonterminals {acount_Inh_Nonterminals :: !(Int),allnts_Inh_Nonterminals :: !(([Identifier])),aroundMap_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cInterfaceMap_Inh_Nonterminals :: !(CInterfaceMap),cVisitsMap_Inh_Nonterminals :: !(CVisitsMap),inhMap_Inh_Nonterminals :: !((Map Identifier Attributes)),manualAttrDepMap_Inh_Nonterminals :: !(AttrOrderMap),mergeMap_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))))),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),synMap_Inh_Nonterminals :: !((Map Identifier Attributes)),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))),aroundDep_Syn_Nonterminals :: !((Seq Edge)),cNonterminals_Syn_Nonterminals :: !(CNonterminals),directDep_Syn_Nonterminals :: !((Seq Edge)),errors_Syn_Nonterminals :: !((Seq Error)),inhMap'_Syn_Nonterminals :: !((Map Identifier Attributes)),instDep_Syn_Nonterminals :: !((Seq Edge)),mergeDep_Syn_Nonterminals :: !((Seq Edge)),nAutoRules_Syn_Nonterminals :: !(Int),nExplicitRules_Syn_Nonterminals :: !(Int),nonts_Syn_Nonterminals :: !(([(NontermIdent,[ConstructorIdent])])),ntattrs_Syn_Nonterminals :: !((Seq (Vertex,NTAttr))),rules_Syn_Nonterminals :: !((Seq (Vertex,CRule))),synMap'_Syn_Nonterminals :: !((Map Identifier Attributes)),vcount_Syn_Nonterminals :: !(Int)} +wrap_Nonterminals :: T_Nonterminals -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsynMap _lhsIvcount) = + (let ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOaroundDep,_lhsOcNonterminals,_lhsOdirectDep,_lhsOerrors,_lhsOinhMap',_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOsynMap',_lhsOvcount) = sem _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsynMap _lhsIvcount + in (Syn_Nonterminals _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOaroundDep _lhsOcNonterminals _lhsOdirectDep _lhsOerrors _lhsOinhMap' _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOnonts _lhsOntattrs _lhsOrules _lhsOsynMap' _lhsOvcount)) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) = + (T_Nonterminals (\ _lhsIacount + _lhsIallnts + _lhsIaroundMap + _lhsIcInterfaceMap + _lhsIcVisitsMap + _lhsIinhMap + _lhsImanualAttrDepMap + _lhsImergeMap + _lhsIo_case + _lhsIo_cata + _lhsIo_data + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_unbox + _lhsIo_wantvisit + _lhsIprefix + _lhsIsynMap + _lhsIvcount -> + (let _lhsOcNonterminals :: CNonterminals + _lhsOadditionalDep :: (Seq Edge) + _lhsOaranges :: (Seq (Int,Int,Int)) + _lhsOaroundDep :: (Seq Edge) + _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOinhMap' :: (Map Identifier Attributes) + _lhsOinstDep :: (Seq Edge) + _lhsOmergeDep :: (Seq Edge) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])]) + _lhsOntattrs :: (Seq (Vertex,NTAttr)) + _lhsOrules :: (Seq (Vertex,CRule)) + _lhsOsynMap' :: (Map Identifier Attributes) + _lhsOacount :: Int + _lhsOvcount :: Int + _hdOacount :: Int + _hdOallnts :: ([Identifier]) + _hdOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) + _hdOcInterfaceMap :: CInterfaceMap + _hdOcVisitsMap :: CVisitsMap + _hdOinhMap :: (Map Identifier Attributes) + _hdOmanualAttrDepMap :: AttrOrderMap + _hdOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_data :: Bool + _hdOo_dovisit :: Bool + _hdOo_newtypes :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_unbox :: Bool + _hdOo_wantvisit :: Bool + _hdOprefix :: String + _hdOsynMap :: (Map Identifier Attributes) + _hdOvcount :: Int + _tlOacount :: Int + _tlOallnts :: ([Identifier]) + _tlOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) + _tlOcInterfaceMap :: CInterfaceMap + _tlOcVisitsMap :: CVisitsMap + _tlOinhMap :: (Map Identifier Attributes) + _tlOmanualAttrDepMap :: AttrOrderMap + _tlOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_data :: Bool + _tlOo_dovisit :: Bool + _tlOo_newtypes :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_unbox :: Bool + _tlOo_wantvisit :: Bool + _tlOprefix :: String + _tlOsynMap :: (Map Identifier Attributes) + _tlOvcount :: Int + _hdIacount :: Int + _hdIadditionalDep :: (Seq Edge) + _hdIaranges :: (Seq (Int,Int,Int)) + _hdIaroundDep :: (Seq Edge) + _hdIcNonterminal :: CNonterminal + _hdIdirectDep :: (Seq Edge) + _hdIerrors :: (Seq Error) + _hdIinhMap' :: (Map Identifier Attributes) + _hdIinstDep :: (Seq Edge) + _hdImergeDep :: (Seq Edge) + _hdInAutoRules :: Int + _hdInExplicitRules :: Int + _hdInonts :: ([(NontermIdent,[ConstructorIdent])]) + _hdIntattrs :: (Seq (Vertex,NTAttr)) + _hdIrules :: (Seq (Vertex,CRule)) + _hdIsynMap' :: (Map Identifier Attributes) + _hdIvcount :: Int + _tlIacount :: Int + _tlIadditionalDep :: (Seq Edge) + _tlIaranges :: (Seq (Int,Int,Int)) + _tlIaroundDep :: (Seq Edge) + _tlIcNonterminals :: CNonterminals + _tlIdirectDep :: (Seq Edge) + _tlIerrors :: (Seq Error) + _tlIinhMap' :: (Map Identifier Attributes) + _tlIinstDep :: (Seq Edge) + _tlImergeDep :: (Seq Edge) + _tlInAutoRules :: Int + _tlInExplicitRules :: Int + _tlInonts :: ([(NontermIdent,[ConstructorIdent])]) + _tlIntattrs :: (Seq (Vertex,NTAttr)) + _tlIrules :: (Seq (Vertex,CRule)) + _tlIsynMap' :: (Map Identifier Attributes) + _tlIvcount :: Int + -- "./src-ag/Order.ag"(line 622, column 12) + _lhsOcNonterminals = + ({-# LINE 622 "./src-ag/Order.ag" #-} + _hdIcNonterminal : _tlIcNonterminals + {-# LINE 2026 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 282, column 60) + _lhsOadditionalDep = + ({-# LINE 282 "./src-ag/Order.ag" #-} + _hdIadditionalDep Seq.>< _tlIadditionalDep + {-# LINE 2032 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 501, column 36) + _lhsOaranges = + ({-# LINE 501 "./src-ag/Order.ag" #-} + _hdIaranges Seq.>< _tlIaranges + {-# LINE 2038 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 403, column 24) + _lhsOaroundDep = + ({-# LINE 403 "./src-ag/Order.ag" #-} + _hdIaroundDep Seq.>< _tlIaroundDep + {-# LINE 2044 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 268, column 33) + _lhsOdirectDep = + ({-# LINE 268 "./src-ag/Order.ag" #-} + _hdIdirectDep Seq.>< _tlIdirectDep + {-# LINE 2050 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 2056 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOinhMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + _hdIinhMap' `Map.union` _tlIinhMap' + {-# LINE 2062 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 311, column 31) + _lhsOinstDep = + ({-# LINE 311 "./src-ag/Order.ag" #-} + _hdIinstDep Seq.>< _tlIinstDep + {-# LINE 2068 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 366, column 18) + _lhsOmergeDep = + ({-# LINE 366 "./src-ag/Order.ag" #-} + _hdImergeDep Seq.>< _tlImergeDep + {-# LINE 2074 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnAutoRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + _hdInAutoRules + _tlInAutoRules + {-# LINE 2080 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnExplicitRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + _hdInExplicitRules + _tlInExplicitRules + {-# LINE 2086 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 518, column 43) + _lhsOnonts = + ({-# LINE 518 "./src-ag/Order.ag" #-} + _hdInonts ++ _tlInonts + {-# LINE 2092 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 500, column 35) + _lhsOntattrs = + ({-# LINE 500 "./src-ag/Order.ag" #-} + _hdIntattrs Seq.>< _tlIntattrs + {-# LINE 2098 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 258, column 18) + _lhsOrules = + ({-# LINE 258 "./src-ag/Order.ag" #-} + _hdIrules Seq.>< _tlIrules + {-# LINE 2104 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOsynMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + _hdIsynMap' `Map.union` _tlIsynMap' + {-# LINE 2110 "dist/build/Order.hs" #-} + ) + -- copy rule (up) + _lhsOacount = + ({-# LINE 500 "./src-ag/Order.ag" #-} + _tlIacount + {-# LINE 2116 "dist/build/Order.hs" #-} + ) + -- copy rule (up) + _lhsOvcount = + ({-# LINE 257 "./src-ag/Order.ag" #-} + _tlIvcount + {-# LINE 2122 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOacount = + ({-# LINE 500 "./src-ag/Order.ag" #-} + _lhsIacount + {-# LINE 2128 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOallnts = + ({-# LINE 648 "./src-ag/Order.ag" #-} + _lhsIallnts + {-# LINE 2134 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOaroundMap = + ({-# LINE 406 "./src-ag/Order.ag" #-} + _lhsIaroundMap + {-# LINE 2140 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOcInterfaceMap = + ({-# LINE 595 "./src-ag/Order.ag" #-} + _lhsIcInterfaceMap + {-# LINE 2146 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOcVisitsMap = + ({-# LINE 602 "./src-ag/Order.ag" #-} + _lhsIcVisitsMap + {-# LINE 2152 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 2158 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOmanualAttrDepMap = + ({-# LINE 282 "./src-ag/Order.ag" #-} + _lhsImanualAttrDepMap + {-# LINE 2164 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 353 "./src-ag/Order.ag" #-} + _lhsImergeMap + {-# LINE 2170 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 118 "./src-ag/Order.ag" #-} + _lhsIo_case + {-# LINE 2176 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 112 "./src-ag/Order.ag" #-} + _lhsIo_cata + {-# LINE 2182 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_data = + ({-# LINE 121 "./src-ag/Order.ag" #-} + _lhsIo_data + {-# LINE 2188 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_dovisit = + ({-# LINE 117 "./src-ag/Order.ag" #-} + _lhsIo_dovisit + {-# LINE 2194 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 111 "./src-ag/Order.ag" #-} + _lhsIo_newtypes + {-# LINE 2200 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 115 "./src-ag/Order.ag" #-} + _lhsIo_rename + {-# LINE 2206 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 114 "./src-ag/Order.ag" #-} + _lhsIo_sem + {-# LINE 2212 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 113 "./src-ag/Order.ag" #-} + _lhsIo_sig + {-# LINE 2218 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 120 "./src-ag/Order.ag" #-} + _lhsIo_unbox + {-# LINE 2224 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_wantvisit = + ({-# LINE 116 "./src-ag/Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 2230 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 119 "./src-ag/Order.ag" #-} + _lhsIprefix + {-# LINE 2236 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2242 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOvcount = + ({-# LINE 257 "./src-ag/Order.ag" #-} + _lhsIvcount + {-# LINE 2248 "dist/build/Order.hs" #-} + ) + -- copy rule (chain) + _tlOacount = + ({-# LINE 500 "./src-ag/Order.ag" #-} + _hdIacount + {-# LINE 2254 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOallnts = + ({-# LINE 648 "./src-ag/Order.ag" #-} + _lhsIallnts + {-# LINE 2260 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOaroundMap = + ({-# LINE 406 "./src-ag/Order.ag" #-} + _lhsIaroundMap + {-# LINE 2266 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOcInterfaceMap = + ({-# LINE 595 "./src-ag/Order.ag" #-} + _lhsIcInterfaceMap + {-# LINE 2272 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOcVisitsMap = + ({-# LINE 602 "./src-ag/Order.ag" #-} + _lhsIcVisitsMap + {-# LINE 2278 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 2284 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOmanualAttrDepMap = + ({-# LINE 282 "./src-ag/Order.ag" #-} + _lhsImanualAttrDepMap + {-# LINE 2290 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 353 "./src-ag/Order.ag" #-} + _lhsImergeMap + {-# LINE 2296 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 118 "./src-ag/Order.ag" #-} + _lhsIo_case + {-# LINE 2302 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 112 "./src-ag/Order.ag" #-} + _lhsIo_cata + {-# LINE 2308 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_data = + ({-# LINE 121 "./src-ag/Order.ag" #-} + _lhsIo_data + {-# LINE 2314 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_dovisit = + ({-# LINE 117 "./src-ag/Order.ag" #-} + _lhsIo_dovisit + {-# LINE 2320 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 111 "./src-ag/Order.ag" #-} + _lhsIo_newtypes + {-# LINE 2326 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 115 "./src-ag/Order.ag" #-} + _lhsIo_rename + {-# LINE 2332 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 114 "./src-ag/Order.ag" #-} + _lhsIo_sem + {-# LINE 2338 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 113 "./src-ag/Order.ag" #-} + _lhsIo_sig + {-# LINE 2344 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 120 "./src-ag/Order.ag" #-} + _lhsIo_unbox + {-# LINE 2350 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_wantvisit = + ({-# LINE 116 "./src-ag/Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 2356 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 119 "./src-ag/Order.ag" #-} + _lhsIprefix + {-# LINE 2362 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2368 "dist/build/Order.hs" #-} + ) + -- copy rule (chain) + _tlOvcount = + ({-# LINE 257 "./src-ag/Order.ag" #-} + _hdIvcount + {-# LINE 2374 "dist/build/Order.hs" #-} + ) + ( _hdIacount,_hdIadditionalDep,_hdIaranges,_hdIaroundDep,_hdIcNonterminal,_hdIdirectDep,_hdIerrors,_hdIinhMap',_hdIinstDep,_hdImergeDep,_hdInAutoRules,_hdInExplicitRules,_hdInonts,_hdIntattrs,_hdIrules,_hdIsynMap',_hdIvcount) = + hd_ _hdOacount _hdOallnts _hdOaroundMap _hdOcInterfaceMap _hdOcVisitsMap _hdOinhMap _hdOmanualAttrDepMap _hdOmergeMap _hdOo_case _hdOo_cata _hdOo_data _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_unbox _hdOo_wantvisit _hdOprefix _hdOsynMap _hdOvcount + ( _tlIacount,_tlIadditionalDep,_tlIaranges,_tlIaroundDep,_tlIcNonterminals,_tlIdirectDep,_tlIerrors,_tlIinhMap',_tlIinstDep,_tlImergeDep,_tlInAutoRules,_tlInExplicitRules,_tlInonts,_tlIntattrs,_tlIrules,_tlIsynMap',_tlIvcount) = + tl_ _tlOacount _tlOallnts _tlOaroundMap _tlOcInterfaceMap _tlOcVisitsMap _tlOinhMap _tlOmanualAttrDepMap _tlOmergeMap _tlOo_case _tlOo_cata _tlOo_data _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_unbox _tlOo_wantvisit _tlOprefix _tlOsynMap _tlOvcount + in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOaroundDep,_lhsOcNonterminals,_lhsOdirectDep,_lhsOerrors,_lhsOinhMap',_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOsynMap',_lhsOvcount)))) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (\ _lhsIacount + _lhsIallnts + _lhsIaroundMap + _lhsIcInterfaceMap + _lhsIcVisitsMap + _lhsIinhMap + _lhsImanualAttrDepMap + _lhsImergeMap + _lhsIo_case + _lhsIo_cata + _lhsIo_data + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_unbox + _lhsIo_wantvisit + _lhsIprefix + _lhsIsynMap + _lhsIvcount -> + (let _lhsOcNonterminals :: CNonterminals + _lhsOadditionalDep :: (Seq Edge) + _lhsOaranges :: (Seq (Int,Int,Int)) + _lhsOaroundDep :: (Seq Edge) + _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOinhMap' :: (Map Identifier Attributes) + _lhsOinstDep :: (Seq Edge) + _lhsOmergeDep :: (Seq Edge) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])]) + _lhsOntattrs :: (Seq (Vertex,NTAttr)) + _lhsOrules :: (Seq (Vertex,CRule)) + _lhsOsynMap' :: (Map Identifier Attributes) + _lhsOacount :: Int + _lhsOvcount :: Int + -- "./src-ag/Order.ag"(line 623, column 12) + _lhsOcNonterminals = + ({-# LINE 623 "./src-ag/Order.ag" #-} + [] + {-# LINE 2425 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 282, column 60) + _lhsOadditionalDep = + ({-# LINE 282 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 2431 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 501, column 36) + _lhsOaranges = + ({-# LINE 501 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 2437 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 403, column 24) + _lhsOaroundDep = + ({-# LINE 403 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 2443 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 268, column 33) + _lhsOdirectDep = + ({-# LINE 268 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 2449 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 2455 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOinhMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + Map.empty + {-# LINE 2461 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 311, column 31) + _lhsOinstDep = + ({-# LINE 311 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 2467 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 366, column 18) + _lhsOmergeDep = + ({-# LINE 366 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 2473 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnAutoRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + 0 + {-# LINE 2479 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnExplicitRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + 0 + {-# LINE 2485 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 518, column 43) + _lhsOnonts = + ({-# LINE 518 "./src-ag/Order.ag" #-} + [] + {-# LINE 2491 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 500, column 35) + _lhsOntattrs = + ({-# LINE 500 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 2497 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 258, column 18) + _lhsOrules = + ({-# LINE 258 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 2503 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOsynMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + Map.empty + {-# LINE 2509 "dist/build/Order.hs" #-} + ) + -- copy rule (chain) + _lhsOacount = + ({-# LINE 500 "./src-ag/Order.ag" #-} + _lhsIacount + {-# LINE 2515 "dist/build/Order.hs" #-} + ) + -- copy rule (chain) + _lhsOvcount = + ({-# LINE 257 "./src-ag/Order.ag" #-} + _lhsIvcount + {-# LINE 2521 "dist/build/Order.hs" #-} + ) + in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOaroundDep,_lhsOcNonterminals,_lhsOdirectDep,_lhsOerrors,_lhsOinhMap',_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOsynMap',_lhsOvcount)))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allTypeSigs : Map Identifier Type + altAttrs : Map AltAttr Vertex + con : Identifier + inh : Attributes + nt : Identifier + syn : Attributes + synthesized attributes: + copy : Pattern + errors : Seq Error + gathAltAttrs : [AltAttr] + instVars : [Identifier] + locVars : [Identifier] + patternAttrs : [(Identifier,Identifier,Bool)] + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern (Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern (Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern (Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +sem_Pattern (Underscore _pos) = + (sem_Pattern_Underscore _pos) +-- semantic domain +newtype T_Pattern = T_Pattern ((Map Identifier Type) -> + (Map AltAttr Vertex) -> + Identifier -> + Attributes -> + Identifier -> + Attributes -> + ( Pattern,(Seq Error),([AltAttr]),([Identifier]),([Identifier]),([(Identifier,Identifier,Bool)]))) +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)]))} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +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 + in (Syn_Pattern _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs)) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_) = + (T_Pattern (\ _lhsIallTypeSigs + _lhsIaltAttrs + _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool)]) + _lhsOcopy :: Pattern + _patsOallTypeSigs :: (Map Identifier Type) + _patsOaltAttrs :: (Map AltAttr Vertex) + _patsOcon :: Identifier + _patsOinh :: Attributes + _patsOnt :: Identifier + _patsOsyn :: Attributes + _patsIcopy :: Patterns + _patsIerrors :: (Seq Error) + _patsIgathAltAttrs :: ([AltAttr]) + _patsIinstVars :: ([Identifier]) + _patsIlocVars :: ([Identifier]) + _patsIpatternAttrs :: ([(Identifier,Identifier,Bool)]) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + _patsIerrors + {-# LINE 2628 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 171, column 68) + _lhsOgathAltAttrs = + ({-# LINE 171 "./src-ag/Order.ag" #-} + _patsIgathAltAttrs + {-# LINE 2634 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 86) + _lhsOinstVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + _patsIinstVars + {-# LINE 2640 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 48) + _lhsOlocVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + _patsIlocVars + {-# LINE 2646 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 248, column 42) + _lhsOpatternAttrs = + ({-# LINE 248 "./src-ag/Order.ag" #-} + _patsIpatternAttrs + {-# LINE 2652 "dist/build/Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 2658 "dist/build/Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 2664 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patsOallTypeSigs = + ({-# LINE 534 "./src-ag/Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 2670 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patsOaltAttrs = + ({-# LINE 187 "./src-ag/Order.ag" #-} + _lhsIaltAttrs + {-# LINE 2676 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patsOcon = + ({-# LINE 91 "./src-ag/Order.ag" #-} + _lhsIcon + {-# LINE 2682 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patsOinh = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIinh + {-# LINE 2688 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patsOnt = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 2694 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patsOsyn = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIsyn + {-# LINE 2700 "dist/build/Order.hs" #-} + ) + ( _patsIcopy,_patsIerrors,_patsIgathAltAttrs,_patsIinstVars,_patsIlocVars,_patsIpatternAttrs) = + pats_ _patsOallTypeSigs _patsOaltAttrs _patsOcon _patsOinh _patsOnt _patsOsyn + in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs)))) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_) = + (T_Pattern (\ _lhsIallTypeSigs + _lhsIaltAttrs + _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool)]) + _lhsOcopy :: Pattern + _patsOallTypeSigs :: (Map Identifier Type) + _patsOaltAttrs :: (Map AltAttr Vertex) + _patsOcon :: Identifier + _patsOinh :: Attributes + _patsOnt :: Identifier + _patsOsyn :: Attributes + _patsIcopy :: Patterns + _patsIerrors :: (Seq Error) + _patsIgathAltAttrs :: ([AltAttr]) + _patsIinstVars :: ([Identifier]) + _patsIlocVars :: ([Identifier]) + _patsIpatternAttrs :: ([(Identifier,Identifier,Bool)]) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + _patsIerrors + {-# LINE 2737 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 171, column 68) + _lhsOgathAltAttrs = + ({-# LINE 171 "./src-ag/Order.ag" #-} + _patsIgathAltAttrs + {-# LINE 2743 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 86) + _lhsOinstVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + _patsIinstVars + {-# LINE 2749 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 48) + _lhsOlocVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + _patsIlocVars + {-# LINE 2755 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 248, column 42) + _lhsOpatternAttrs = + ({-# LINE 248 "./src-ag/Order.ag" #-} + _patsIpatternAttrs + {-# LINE 2761 "dist/build/Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 2767 "dist/build/Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 2773 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patsOallTypeSigs = + ({-# LINE 534 "./src-ag/Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 2779 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patsOaltAttrs = + ({-# LINE 187 "./src-ag/Order.ag" #-} + _lhsIaltAttrs + {-# LINE 2785 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patsOcon = + ({-# LINE 91 "./src-ag/Order.ag" #-} + _lhsIcon + {-# LINE 2791 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patsOinh = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIinh + {-# LINE 2797 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patsOnt = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 2803 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patsOsyn = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIsyn + {-# LINE 2809 "dist/build/Order.hs" #-} + ) + ( _patsIcopy,_patsIerrors,_patsIgathAltAttrs,_patsIinstVars,_patsIlocVars,_patsIpatternAttrs) = + pats_ _patsOallTypeSigs _patsOaltAttrs _patsOcon _patsOinh _patsOnt _patsOsyn + in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs)))) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_) = + (T_Pattern (\ _lhsIallTypeSigs + _lhsIaltAttrs + _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool)]) + _lhsOlocVars :: ([Identifier]) + _lhsOinstVars :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOcopy :: Pattern + _patOallTypeSigs :: (Map Identifier Type) + _patOaltAttrs :: (Map AltAttr Vertex) + _patOcon :: Identifier + _patOinh :: Attributes + _patOnt :: Identifier + _patOsyn :: Attributes + _patIcopy :: Pattern + _patIerrors :: (Seq Error) + _patIgathAltAttrs :: ([AltAttr]) + _patIinstVars :: ([Identifier]) + _patIlocVars :: ([Identifier]) + _patIpatternAttrs :: ([(Identifier,Identifier,Bool)]) + -- "./src-ag/Order.ag"(line 185, column 12) + _lhsOgathAltAttrs = + ({-# LINE 185 "./src-ag/Order.ag" #-} + [AltAttr field_ attr_ (field_ == _LOC || field_ == _INST)] + {-# LINE 2847 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 251, column 12) + _lhsOpatternAttrs = + ({-# LINE 251 "./src-ag/Order.ag" #-} + [(field_,attr_,(field_ == _LOC || field_ == _INST))] + {-# LINE 2853 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 681, column 14) + _lhsOlocVars = + ({-# LINE 681 "./src-ag/Order.ag" #-} + if field_ == _LOC + then [attr_] + else [] + {-# LINE 2861 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 684, column 14) + _lhsOinstVars = + ({-# LINE 684 "./src-ag/Order.ag" #-} + if field_ == _INST + then [attr_] + else [] + {-# LINE 2869 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + _patIerrors + {-# LINE 2875 "dist/build/Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 2881 "dist/build/Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 2887 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patOallTypeSigs = + ({-# LINE 534 "./src-ag/Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 2893 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patOaltAttrs = + ({-# LINE 187 "./src-ag/Order.ag" #-} + _lhsIaltAttrs + {-# LINE 2899 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patOcon = + ({-# LINE 91 "./src-ag/Order.ag" #-} + _lhsIcon + {-# LINE 2905 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patOinh = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIinh + {-# LINE 2911 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patOnt = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 2917 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patOsyn = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIsyn + {-# LINE 2923 "dist/build/Order.hs" #-} + ) + ( _patIcopy,_patIerrors,_patIgathAltAttrs,_patIinstVars,_patIlocVars,_patIpatternAttrs) = + pat_ _patOallTypeSigs _patOaltAttrs _patOcon _patOinh _patOnt _patOsyn + in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs)))) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_) = + (T_Pattern (\ _lhsIallTypeSigs + _lhsIaltAttrs + _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool)]) + _lhsOcopy :: Pattern + _patOallTypeSigs :: (Map Identifier Type) + _patOaltAttrs :: (Map AltAttr Vertex) + _patOcon :: Identifier + _patOinh :: Attributes + _patOnt :: Identifier + _patOsyn :: Attributes + _patIcopy :: Pattern + _patIerrors :: (Seq Error) + _patIgathAltAttrs :: ([AltAttr]) + _patIinstVars :: ([Identifier]) + _patIlocVars :: ([Identifier]) + _patIpatternAttrs :: ([(Identifier,Identifier,Bool)]) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + _patIerrors + {-# LINE 2959 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 171, column 68) + _lhsOgathAltAttrs = + ({-# LINE 171 "./src-ag/Order.ag" #-} + _patIgathAltAttrs + {-# LINE 2965 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 86) + _lhsOinstVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + _patIinstVars + {-# LINE 2971 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 48) + _lhsOlocVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + _patIlocVars + {-# LINE 2977 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 248, column 42) + _lhsOpatternAttrs = + ({-# LINE 248 "./src-ag/Order.ag" #-} + _patIpatternAttrs + {-# LINE 2983 "dist/build/Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 2989 "dist/build/Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 2995 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patOallTypeSigs = + ({-# LINE 534 "./src-ag/Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 3001 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patOaltAttrs = + ({-# LINE 187 "./src-ag/Order.ag" #-} + _lhsIaltAttrs + {-# LINE 3007 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patOcon = + ({-# LINE 91 "./src-ag/Order.ag" #-} + _lhsIcon + {-# LINE 3013 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patOinh = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIinh + {-# LINE 3019 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patOnt = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 3025 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patOsyn = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIsyn + {-# LINE 3031 "dist/build/Order.hs" #-} + ) + ( _patIcopy,_patIerrors,_patIgathAltAttrs,_patIinstVars,_patIlocVars,_patIpatternAttrs) = + pat_ _patOallTypeSigs _patOaltAttrs _patOcon _patOinh _patOnt _patOsyn + in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs)))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (\ _lhsIallTypeSigs + _lhsIaltAttrs + _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool)]) + _lhsOcopy :: Pattern + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 3055 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 171, column 68) + _lhsOgathAltAttrs = + ({-# LINE 171 "./src-ag/Order.ag" #-} + [] + {-# LINE 3061 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 86) + _lhsOinstVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + [] + {-# LINE 3067 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 48) + _lhsOlocVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + [] + {-# LINE 3073 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 248, column 42) + _lhsOpatternAttrs = + ({-# LINE 248 "./src-ag/Order.ag" #-} + [] + {-# LINE 3079 "dist/build/Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 3085 "dist/build/Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 3091 "dist/build/Order.hs" #-} + ) + in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs)))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + inherited attributes: + allTypeSigs : Map Identifier Type + altAttrs : Map AltAttr Vertex + con : Identifier + inh : Attributes + nt : Identifier + syn : Attributes + synthesized attributes: + copy : Patterns + errors : Seq Error + gathAltAttrs : [AltAttr] + instVars : [Identifier] + locVars : [Identifier] + patternAttrs : [(Identifier,Identifier,Bool)] + 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 ((Map Identifier Type) -> + (Map AltAttr Vertex) -> + Identifier -> + Attributes -> + Identifier -> + Attributes -> + ( Patterns,(Seq Error),([AltAttr]),([Identifier]),([Identifier]),([(Identifier,Identifier,Bool)]))) +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)]))} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_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 + in (Syn_Patterns _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = + (T_Patterns (\ _lhsIallTypeSigs + _lhsIaltAttrs + _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool)]) + _lhsOcopy :: Patterns + _hdOallTypeSigs :: (Map Identifier Type) + _hdOaltAttrs :: (Map AltAttr Vertex) + _hdOcon :: Identifier + _hdOinh :: Attributes + _hdOnt :: Identifier + _hdOsyn :: Attributes + _tlOallTypeSigs :: (Map Identifier Type) + _tlOaltAttrs :: (Map AltAttr Vertex) + _tlOcon :: Identifier + _tlOinh :: Attributes + _tlOnt :: Identifier + _tlOsyn :: Attributes + _hdIcopy :: Pattern + _hdIerrors :: (Seq Error) + _hdIgathAltAttrs :: ([AltAttr]) + _hdIinstVars :: ([Identifier]) + _hdIlocVars :: ([Identifier]) + _hdIpatternAttrs :: ([(Identifier,Identifier,Bool)]) + _tlIcopy :: Patterns + _tlIerrors :: (Seq Error) + _tlIgathAltAttrs :: ([AltAttr]) + _tlIinstVars :: ([Identifier]) + _tlIlocVars :: ([Identifier]) + _tlIpatternAttrs :: ([(Identifier,Identifier,Bool)]) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 3186 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 171, column 68) + _lhsOgathAltAttrs = + ({-# LINE 171 "./src-ag/Order.ag" #-} + _hdIgathAltAttrs ++ _tlIgathAltAttrs + {-# LINE 3192 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 86) + _lhsOinstVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + _hdIinstVars ++ _tlIinstVars + {-# LINE 3198 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 48) + _lhsOlocVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + _hdIlocVars ++ _tlIlocVars + {-# LINE 3204 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 248, column 42) + _lhsOpatternAttrs = + ({-# LINE 248 "./src-ag/Order.ag" #-} + _hdIpatternAttrs ++ _tlIpatternAttrs + {-# LINE 3210 "dist/build/Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 3216 "dist/build/Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 3222 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOallTypeSigs = + ({-# LINE 534 "./src-ag/Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 3228 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOaltAttrs = + ({-# LINE 187 "./src-ag/Order.ag" #-} + _lhsIaltAttrs + {-# LINE 3234 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 91 "./src-ag/Order.ag" #-} + _lhsIcon + {-# LINE 3240 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIinh + {-# LINE 3246 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 3252 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIsyn + {-# LINE 3258 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOallTypeSigs = + ({-# LINE 534 "./src-ag/Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 3264 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOaltAttrs = + ({-# LINE 187 "./src-ag/Order.ag" #-} + _lhsIaltAttrs + {-# LINE 3270 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 91 "./src-ag/Order.ag" #-} + _lhsIcon + {-# LINE 3276 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIinh + {-# LINE 3282 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 3288 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIsyn + {-# LINE 3294 "dist/build/Order.hs" #-} + ) + ( _hdIcopy,_hdIerrors,_hdIgathAltAttrs,_hdIinstVars,_hdIlocVars,_hdIpatternAttrs) = + hd_ _hdOallTypeSigs _hdOaltAttrs _hdOcon _hdOinh _hdOnt _hdOsyn + ( _tlIcopy,_tlIerrors,_tlIgathAltAttrs,_tlIinstVars,_tlIlocVars,_tlIpatternAttrs) = + tl_ _tlOallTypeSigs _tlOaltAttrs _tlOcon _tlOinh _tlOnt _tlOsyn + in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs)))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (\ _lhsIallTypeSigs + _lhsIaltAttrs + _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool)]) + _lhsOcopy :: Patterns + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 3319 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 171, column 68) + _lhsOgathAltAttrs = + ({-# LINE 171 "./src-ag/Order.ag" #-} + [] + {-# LINE 3325 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 86) + _lhsOinstVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + [] + {-# LINE 3331 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 48) + _lhsOlocVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + [] + {-# LINE 3337 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 248, column 42) + _lhsOpatternAttrs = + ({-# LINE 248 "./src-ag/Order.ag" #-} + [] + {-# LINE 3343 "dist/build/Order.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 3349 "dist/build/Order.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 3355 "dist/build/Order.hs" #-} + ) + in ( _lhsOcopy,_lhsOerrors,_lhsOgathAltAttrs,_lhsOinstVars,_lhsOlocVars,_lhsOpatternAttrs)))) +-- Production -------------------------------------------------- +{- + visit 0: + inherited attributes: + allnts : [Identifier] + aroundMap : Map ConstructorIdent (Map Identifier [Expression]) + cVisitsMap : CVisitsMap + inh : Attributes + inhMap : Map Identifier Attributes + manualAttrDepMap : AttrOrderMap + mergeMap : Map ConstructorIdent (Map Identifier (Identifier,[Identifier])) + nt : Identifier + o_case : Bool + o_cata : Bool + o_dovisit : Bool + o_newtypes : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_unbox : Bool + o_wantvisit : Bool + prefix : String + syn : Attributes + synMap : Map Identifier Attributes + chained attribute: + vcount : Int + synthesized attributes: + additionalDep : Seq Edge + aroundDep : Seq Edge + cProduction : CProduction + cons : [ConstructorIdent] + directDep : Seq Edge + errors : Seq Error + instDep : Seq Edge + mergeDep : Seq Edge + nAutoRules : Int + nExplicitRules : Int + rules : Seq (Vertex,CRule) + alternatives: + alternative Production: + child con : {ConstructorIdent} + child params : {[Identifier]} + child constraints : {[Type]} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + child macro : {MaybeMacro} + visit 0: + local gathAltAttrs : _ + local altAttrs : _ + local inhRules : _ + local gathRules : _ + local manualDeps : _ + local mergeMap : _ + local mergeDep1 : _ + local mergeDep2 : _ + local aroundMap : _ + local aroundDep1 : _ + local aroundDep2 : _ + local cVisits : _ + local allfields : _ + local attrs : _ + local inhnames : _ + local synnames : _ +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production (Production _con _params _constraints _children _rules _typeSigs _macro) = + (sem_Production_Production _con _params _constraints (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs) _macro) +-- semantic domain +newtype T_Production = T_Production (([Identifier]) -> + (Map ConstructorIdent (Map Identifier [Expression])) -> + CVisitsMap -> + Attributes -> + (Map Identifier Attributes) -> + AttrOrderMap -> + (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) -> + Identifier -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + String -> + Attributes -> + (Map Identifier Attributes) -> + Int -> + ( (Seq Edge),(Seq Edge),CProduction,([ConstructorIdent]),(Seq Edge),(Seq Error),(Seq Edge),(Seq Edge),Int,Int,(Seq (Vertex,CRule)),Int)) +data Inh_Production = Inh_Production {allnts_Inh_Production :: !(([Identifier])),aroundMap_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),cVisitsMap_Inh_Production :: !(CVisitsMap),inh_Inh_Production :: !(Attributes),inhMap_Inh_Production :: !((Map Identifier Attributes)),manualAttrDepMap_Inh_Production :: !(AttrOrderMap),mergeMap_Inh_Production :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))),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),synMap_Inh_Production :: !((Map Identifier Attributes)),vcount_Inh_Production :: !(Int)} +data Syn_Production = Syn_Production {additionalDep_Syn_Production :: !((Seq Edge)),aroundDep_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)),mergeDep_Syn_Production :: !((Seq Edge)),nAutoRules_Syn_Production :: !(Int),nExplicitRules_Syn_Production :: !(Int),rules_Syn_Production :: !((Seq (Vertex,CRule))),vcount_Syn_Production :: !(Int)} +wrap_Production :: T_Production -> + Inh_Production -> + Syn_Production +wrap_Production (T_Production sem) (Inh_Production _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynMap _lhsIvcount) = + (let ( _lhsOadditionalDep,_lhsOaroundDep,_lhsOcProduction,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOrules,_lhsOvcount) = sem _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynMap _lhsIvcount + in (Syn_Production _lhsOadditionalDep _lhsOaroundDep _lhsOcProduction _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOrules _lhsOvcount)) +sem_Production_Production :: ConstructorIdent -> + ([Identifier]) -> + ([Type]) -> + T_Children -> + T_Rules -> + T_TypeSigs -> + MaybeMacro -> + T_Production +sem_Production_Production con_ params_ constraints_ (T_Children children_) (T_Rules rules_) (T_TypeSigs typeSigs_) macro_ = + (T_Production (\ _lhsIallnts + _lhsIaroundMap + _lhsIcVisitsMap + _lhsIinh + _lhsIinhMap + _lhsImanualAttrDepMap + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_unbox + _lhsIo_wantvisit + _lhsIprefix + _lhsIsyn + _lhsIsynMap + _lhsIvcount -> + (let _childrenOcon :: Identifier + _rulesOcon :: Identifier + _rulesOchildNts :: (Map Identifier NontermIdent) + _rulesOchildInhs :: (Map Identifier Attributes) + _lhsOrules :: (Seq (Vertex,CRule)) + _lhsOvcount :: Int + _lhsOadditionalDep :: (Seq Edge) + _rulesOsynsOfChildren :: (Map Identifier Attributes) + _rulesOinhsOfChildren :: (Map Identifier Attributes) + _lhsOmergeDep :: (Seq Edge) + _lhsOaroundDep :: (Seq Edge) + _lhsOcons :: ([ConstructorIdent]) + _typeSigsOtypeSigs :: (Map Identifier Type) + _rulesOallTypeSigs :: (Map Identifier Type) + _lhsOcProduction :: CProduction + _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOinstDep :: (Seq Edge) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _childrenOallfields :: ([(Identifier,Type,ChildKind)]) + _childrenOallnts :: ([Identifier]) + _childrenOattrs :: ([(Identifier,Identifier)]) + _childrenOinh :: Attributes + _childrenOinhMap :: (Map Identifier Attributes) + _childrenOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _childrenOnt :: Identifier + _childrenOo_unbox :: Bool + _childrenOsyn :: Attributes + _childrenOsynMap :: (Map Identifier Attributes) + _rulesOallfields :: ([(Identifier,Type,ChildKind)]) + _rulesOallnts :: ([Identifier]) + _rulesOaltAttrs :: (Map AltAttr Vertex) + _rulesOattrs :: ([(Identifier,Identifier)]) + _rulesOinh :: Attributes + _rulesOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _rulesOnt :: Identifier + _rulesOo_case :: Bool + _rulesOo_cata :: Bool + _rulesOo_dovisit :: Bool + _rulesOo_newtypes :: Bool + _rulesOo_rename :: Bool + _rulesOo_sem :: Bool + _rulesOo_sig :: Bool + _rulesOo_wantvisit :: Bool + _rulesOprefix :: String + _rulesOsyn :: Attributes + _childrenIattributes :: ([(Identifier,Attributes,Attributes)]) + _childrenIcollectChildrenInhs :: (Map Identifier Attributes ) + _childrenIcollectChildrenSyns :: (Map Identifier Attributes ) + _childrenIerrors :: (Seq Error) + _childrenIfields :: ([(Identifier,Type,ChildKind)]) + _childrenIgathAltAttrs :: ([AltAttr]) + _childrenIgathRules :: (Seq CRule) + _childrenIinhs :: (Seq (Identifier,Attributes)) + _childrenInts :: (Seq (Identifier,NontermIdent)) + _childrenIsinglevisits :: ([CRule]) + _childrenIterminals :: ([Identifier]) + _rulesIdirectDep :: (Seq Edge) + _rulesIerrors :: (Seq Error) + _rulesIgathAltAttrs :: ([AltAttr]) + _rulesIgathRules :: (Seq CRule) + _rulesIinstDep :: (Seq Edge) + _rulesIinstVars :: ([Identifier]) + _rulesIlocVars :: ([Identifier]) + _rulesInAutoRules :: Int + _rulesInExplicitRules :: Int + _typeSigsItypeSigs :: (Map Identifier Type) + -- "./src-ag/Order.ag"(line 94, column 16) + _childrenOcon = + ({-# LINE 94 "./src-ag/Order.ag" #-} + con_ + {-# LINE 3561 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 96, column 16) + _rulesOcon = + ({-# LINE 96 "./src-ag/Order.ag" #-} + con_ + {-# LINE 3567 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 173, column 18) + _gathAltAttrs = + ({-# LINE 173 "./src-ag/Order.ag" #-} + [ AltAttr _LHS inh True | inh <- Map.keys _lhsIinh ] + ++ _childrenIgathAltAttrs + ++ _rulesIgathAltAttrs + {-# LINE 3575 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 189, column 17) + _altAttrs = + ({-# LINE 189 "./src-ag/Order.ag" #-} + Map.fromList (zip _gathAltAttrs [_lhsIvcount..]) + {-# LINE 3581 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 202, column 18) + _rulesOchildNts = + ({-# LINE 202 "./src-ag/Order.ag" #-} + Map.fromList (toList _childrenInts) + {-# LINE 3587 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 203, column 19) + _rulesOchildInhs = + ({-# LINE 203 "./src-ag/Order.ag" #-} + Map.fromList (toList _childrenIinhs) + {-# LINE 3593 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 209, column 18) + _inhRules = + ({-# LINE 209 "./src-ag/Order.ag" #-} + [ cRuleLhsInh inh _lhsInt con_ tp | (inh,tp) <- Map.assocs _lhsIinh ] + {-# LINE 3599 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 210, column 19) + _gathRules = + ({-# LINE 210 "./src-ag/Order.ag" #-} + _inhRules ++ toList (_childrenIgathRules Seq.>< _rulesIgathRules) + {-# LINE 3605 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 262, column 18) + _lhsOrules = + ({-# LINE 262 "./src-ag/Order.ag" #-} + Seq.fromList (zip [_lhsIvcount..] _gathRules) + {-# LINE 3611 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 263, column 19) + _lhsOvcount = + ({-# LINE 263 "./src-ag/Order.ag" #-} + _lhsIvcount + length _gathRules + {-# LINE 3617 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 290, column 7) + _manualDeps = + ({-# LINE 290 "./src-ag/Order.ag" #-} + Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrDepMap + {-# LINE 3623 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 293, column 7) + _lhsOadditionalDep = + ({-# LINE 293 "./src-ag/Order.ag" #-} + Seq.fromList [ (vertex True occA, vertex False occB) + | Dependency occA occB <- _manualDeps + , let vertex inout (OccAttr child nm) + | child == _LOC = findWithErr2 (AltAttr _LOC nm True) _altAttrs + | otherwise = findWithErr2 (AltAttr child nm inout) _altAttrs + vertex _ (OccRule nm) + = findWithErr2 (AltAttr _LOC (Ident ("_rule_" ++ show nm) (getPos nm)) True) _altAttrs + ] + {-# LINE 3636 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 340, column 17) + _rulesOsynsOfChildren = + ({-# LINE 340 "./src-ag/Order.ag" #-} + _childrenIcollectChildrenSyns + {-# LINE 3642 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 341, column 17) + _rulesOinhsOfChildren = + ({-# LINE 341 "./src-ag/Order.ag" #-} + _childrenIcollectChildrenInhs + {-# LINE 3648 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 359, column 32) + _mergeMap = + ({-# LINE 359 "./src-ag/Order.ag" #-} + Map.findWithDefault Map.empty con_ _lhsImergeMap + {-# LINE 3654 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 370, column 7) + _lhsOmergeDep = + ({-# LINE 370 "./src-ag/Order.ag" #-} + _mergeDep1 Seq.>< _mergeDep2 + {-# LINE 3660 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 371, column 7) + _mergeDep1 = + ({-# LINE 371 "./src-ag/Order.ag" #-} + Seq.fromList $ + [ (childVert, synVert) + | childNm <- Map.keys _mergeMap + , synNm <- Map.keys (findWithErr2 childNm _childrenIcollectChildrenSyns) + , let childNm' = Ident (show childNm ++ "_merge") (getPos childNm) + childAttr = AltAttr _LOC childNm' True + synAttr = AltAttr childNm synNm True + childVert = findWithErr2 childAttr _altAttrs + synVert = findWithErr2 synAttr _altAttrs + ] + {-# LINE 3675 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 382, column 7) + _mergeDep2 = + ({-# LINE 382 "./src-ag/Order.ag" #-} + Seq.fromList $ + [ (mergedVert, sourceVert) + | (childNm, (_,cs)) <- Map.assocs _mergeMap + , c <- cs + , synNm <- Map.keys (findWithErr2 childNm _childrenIcollectChildrenSyns) + , let sourceAttr = AltAttr childNm synNm True + mergedAttr = AltAttr c synNm True + sourceVert = findWithErr2 sourceAttr _altAttrs + mergedVert = findWithErr2 mergedAttr _altAttrs + ] + {-# LINE 3690 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 412, column 32) + _aroundMap = + ({-# LINE 412 "./src-ag/Order.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIaroundMap + {-# LINE 3696 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 419, column 6) + _aroundDep1 = + ({-# LINE 419 "./src-ag/Order.ag" #-} + Seq.fromList $ + [ (childVert, synVert) + | childNm <- Map.keys _aroundMap + , synNm <- Map.keys (findWithErr2 childNm _childrenIcollectChildrenSyns) + , let childNm' = Ident (show childNm ++ "_around") (getPos childNm) + childAttr = AltAttr _LOC childNm' True + synAttr = AltAttr childNm synNm True + childVert = findWithErr2 childAttr _altAttrs + synVert = findWithErr2 synAttr _altAttrs + ] + {-# LINE 3711 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 430, column 6) + _aroundDep2 = + ({-# LINE 430 "./src-ag/Order.ag" #-} + Seq.fromList $ + [ (childVert, inhVert) + | childNm <- Map.keys _aroundMap + , inhNm <- Map.keys (findWithErr2 childNm _childrenIcollectChildrenInhs) + , let childNm' = Ident (show childNm ++ "_around") (getPos childNm) + childAttr = AltAttr _LOC childNm' True + inhAttr = AltAttr childNm inhNm False + childVert = findWithErr2 childAttr _altAttrs + inhVert = findWithErr2 inhAttr _altAttrs + ] + {-# LINE 3726 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 441, column 6) + _lhsOaroundDep = + ({-# LINE 441 "./src-ag/Order.ag" #-} + _aroundDep1 Seq.>< _aroundDep2 + {-# LINE 3732 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 523, column 18) + _lhsOcons = + ({-# LINE 523 "./src-ag/Order.ag" #-} + [con_] + {-# LINE 3738 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 530, column 16) + _typeSigsOtypeSigs = + ({-# LINE 530 "./src-ag/Order.ag" #-} + Map.empty + {-# LINE 3744 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 536, column 17) + _rulesOallTypeSigs = + ({-# LINE 536 "./src-ag/Order.ag" #-} + _typeSigsItypeSigs + {-# LINE 3750 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 604, column 17) + _cVisits = + ({-# LINE 604 "./src-ag/Order.ag" #-} + if _lhsIo_dovisit + then let prodsVisitsMap = findWithErr1 "Production.cVisits.nt" _lhsInt _lhsIcVisitsMap + visits = findWithErr1 "Production.cVisits.con" con_ prodsVisitsMap + in visits + else let vss = nubBy eqCRuleDefines _gathRules ++ _childrenIsinglevisits + in [CVisit _lhsIinh _lhsIsyn vss [] False] + {-# LINE 3761 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 630, column 18) + _lhsOcProduction = + ({-# LINE 630 "./src-ag/Order.ag" #-} + CProduction con_ _cVisits _childrenIfields _childrenIterminals + {-# LINE 3767 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 658, column 16) + _allfields = + ({-# LINE 658 "./src-ag/Order.ag" #-} + _childrenIfields + {-# LINE 3773 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 658, column 16) + _attrs = + ({-# LINE 659 "./src-ag/Order.ag" #-} + map ((,) _LOC) _rulesIlocVars ++ + map ((,) _INST) _rulesIinstVars ++ + map ((,) _LHS) _inhnames ++ + concat [map ((,) nm) (Map.keys as) | (nm,_,as) <- _childrenIattributes] + {-# LINE 3782 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 658, column 16) + _inhnames = + ({-# LINE 663 "./src-ag/Order.ag" #-} + Map.keys _lhsIinh + {-# LINE 3788 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 658, column 16) + _synnames = + ({-# LINE 664 "./src-ag/Order.ag" #-} + Map.keys _lhsIsyn + {-# LINE 3794 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 268, column 33) + _lhsOdirectDep = + ({-# LINE 268 "./src-ag/Order.ag" #-} + _rulesIdirectDep + {-# LINE 3800 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + _childrenIerrors Seq.>< _rulesIerrors + {-# LINE 3806 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 311, column 31) + _lhsOinstDep = + ({-# LINE 311 "./src-ag/Order.ag" #-} + _rulesIinstDep + {-# LINE 3812 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnAutoRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + _rulesInAutoRules + {-# LINE 3818 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnExplicitRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + _rulesInExplicitRules + {-# LINE 3824 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _childrenOallfields = + ({-# LINE 655 "./src-ag/Order.ag" #-} + _allfields + {-# LINE 3830 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _childrenOallnts = + ({-# LINE 648 "./src-ag/Order.ag" #-} + _lhsIallnts + {-# LINE 3836 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _childrenOattrs = + ({-# LINE 655 "./src-ag/Order.ag" #-} + _attrs + {-# LINE 3842 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _childrenOinh = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIinh + {-# LINE 3848 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _childrenOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 3854 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _childrenOmergeMap = + ({-# LINE 361 "./src-ag/Order.ag" #-} + _mergeMap + {-# LINE 3860 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _childrenOnt = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 3866 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _childrenOo_unbox = + ({-# LINE 120 "./src-ag/Order.ag" #-} + _lhsIo_unbox + {-# LINE 3872 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _childrenOsyn = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIsyn + {-# LINE 3878 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _childrenOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 3884 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _rulesOallfields = + ({-# LINE 655 "./src-ag/Order.ag" #-} + _allfields + {-# LINE 3890 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rulesOallnts = + ({-# LINE 648 "./src-ag/Order.ag" #-} + _lhsIallnts + {-# LINE 3896 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _rulesOaltAttrs = + ({-# LINE 187 "./src-ag/Order.ag" #-} + _altAttrs + {-# LINE 3902 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _rulesOattrs = + ({-# LINE 655 "./src-ag/Order.ag" #-} + _attrs + {-# LINE 3908 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rulesOinh = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIinh + {-# LINE 3914 "dist/build/Order.hs" #-} + ) + -- copy rule (from local) + _rulesOmergeMap = + ({-# LINE 361 "./src-ag/Order.ag" #-} + _mergeMap + {-# LINE 3920 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rulesOnt = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 3926 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_case = + ({-# LINE 118 "./src-ag/Order.ag" #-} + _lhsIo_case + {-# LINE 3932 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_cata = + ({-# LINE 112 "./src-ag/Order.ag" #-} + _lhsIo_cata + {-# LINE 3938 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_dovisit = + ({-# LINE 117 "./src-ag/Order.ag" #-} + _lhsIo_dovisit + {-# LINE 3944 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_newtypes = + ({-# LINE 111 "./src-ag/Order.ag" #-} + _lhsIo_newtypes + {-# LINE 3950 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_rename = + ({-# LINE 115 "./src-ag/Order.ag" #-} + _lhsIo_rename + {-# LINE 3956 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_sem = + ({-# LINE 114 "./src-ag/Order.ag" #-} + _lhsIo_sem + {-# LINE 3962 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_sig = + ({-# LINE 113 "./src-ag/Order.ag" #-} + _lhsIo_sig + {-# LINE 3968 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rulesOo_wantvisit = + ({-# LINE 116 "./src-ag/Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 3974 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rulesOprefix = + ({-# LINE 119 "./src-ag/Order.ag" #-} + _lhsIprefix + {-# LINE 3980 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rulesOsyn = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIsyn + {-# LINE 3986 "dist/build/Order.hs" #-} + ) + ( _childrenIattributes,_childrenIcollectChildrenInhs,_childrenIcollectChildrenSyns,_childrenIerrors,_childrenIfields,_childrenIgathAltAttrs,_childrenIgathRules,_childrenIinhs,_childrenInts,_childrenIsinglevisits,_childrenIterminals) = + children_ _childrenOallfields _childrenOallnts _childrenOattrs _childrenOcon _childrenOinh _childrenOinhMap _childrenOmergeMap _childrenOnt _childrenOo_unbox _childrenOsyn _childrenOsynMap + ( _rulesIdirectDep,_rulesIerrors,_rulesIgathAltAttrs,_rulesIgathRules,_rulesIinstDep,_rulesIinstVars,_rulesIlocVars,_rulesInAutoRules,_rulesInExplicitRules) = + rules_ _rulesOallTypeSigs _rulesOallfields _rulesOallnts _rulesOaltAttrs _rulesOattrs _rulesOchildInhs _rulesOchildNts _rulesOcon _rulesOinh _rulesOinhsOfChildren _rulesOmergeMap _rulesOnt _rulesOo_case _rulesOo_cata _rulesOo_dovisit _rulesOo_newtypes _rulesOo_rename _rulesOo_sem _rulesOo_sig _rulesOo_wantvisit _rulesOprefix _rulesOsyn _rulesOsynsOfChildren + ( _typeSigsItypeSigs) = + typeSigs_ _typeSigsOtypeSigs + in ( _lhsOadditionalDep,_lhsOaroundDep,_lhsOcProduction,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOrules,_lhsOvcount)))) +-- Productions ------------------------------------------------- +{- + visit 0: + inherited attributes: + allnts : [Identifier] + aroundMap : Map ConstructorIdent (Map Identifier [Expression]) + cVisitsMap : CVisitsMap + inh : Attributes + inhMap : Map Identifier Attributes + manualAttrDepMap : AttrOrderMap + mergeMap : Map ConstructorIdent (Map Identifier (Identifier,[Identifier])) + nt : Identifier + o_case : Bool + o_cata : Bool + o_dovisit : Bool + o_newtypes : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_unbox : Bool + o_wantvisit : Bool + prefix : String + syn : Attributes + synMap : Map Identifier Attributes + chained attribute: + vcount : Int + synthesized attributes: + additionalDep : Seq Edge + aroundDep : Seq Edge + cProductions : CProductions + cons : [ConstructorIdent] + directDep : Seq Edge + errors : Seq Error + instDep : Seq Edge + mergeDep : Seq Edge + nAutoRules : Int + nExplicitRules : Int + rules : Seq (Vertex,CRule) + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + alternative Nil: +-} +-- 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 (([Identifier]) -> + (Map ConstructorIdent (Map Identifier [Expression])) -> + CVisitsMap -> + Attributes -> + (Map Identifier Attributes) -> + AttrOrderMap -> + (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) -> + Identifier -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + String -> + Attributes -> + (Map Identifier Attributes) -> + Int -> + ( (Seq Edge),(Seq Edge),CProductions,([ConstructorIdent]),(Seq Edge),(Seq Error),(Seq Edge),(Seq Edge),Int,Int,(Seq (Vertex,CRule)),Int)) +data Inh_Productions = Inh_Productions {allnts_Inh_Productions :: !(([Identifier])),aroundMap_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),cVisitsMap_Inh_Productions :: !(CVisitsMap),inh_Inh_Productions :: !(Attributes),inhMap_Inh_Productions :: !((Map Identifier Attributes)),manualAttrDepMap_Inh_Productions :: !(AttrOrderMap),mergeMap_Inh_Productions :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))),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),synMap_Inh_Productions :: !((Map Identifier Attributes)),vcount_Inh_Productions :: !(Int)} +data Syn_Productions = Syn_Productions {additionalDep_Syn_Productions :: !((Seq Edge)),aroundDep_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)),mergeDep_Syn_Productions :: !((Seq Edge)),nAutoRules_Syn_Productions :: !(Int),nExplicitRules_Syn_Productions :: !(Int),rules_Syn_Productions :: !((Seq (Vertex,CRule))),vcount_Syn_Productions :: !(Int)} +wrap_Productions :: T_Productions -> + Inh_Productions -> + Syn_Productions +wrap_Productions (T_Productions sem) (Inh_Productions _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynMap _lhsIvcount) = + (let ( _lhsOadditionalDep,_lhsOaroundDep,_lhsOcProductions,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOrules,_lhsOvcount) = sem _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynMap _lhsIvcount + in (Syn_Productions _lhsOadditionalDep _lhsOaroundDep _lhsOcProductions _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOrules _lhsOvcount)) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons (T_Production hd_) (T_Productions tl_) = + (T_Productions (\ _lhsIallnts + _lhsIaroundMap + _lhsIcVisitsMap + _lhsIinh + _lhsIinhMap + _lhsImanualAttrDepMap + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_unbox + _lhsIo_wantvisit + _lhsIprefix + _lhsIsyn + _lhsIsynMap + _lhsIvcount -> + (let _lhsOcProductions :: CProductions + _lhsOadditionalDep :: (Seq Edge) + _lhsOaroundDep :: (Seq Edge) + _lhsOcons :: ([ConstructorIdent]) + _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOinstDep :: (Seq Edge) + _lhsOmergeDep :: (Seq Edge) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _lhsOrules :: (Seq (Vertex,CRule)) + _lhsOvcount :: Int + _hdOallnts :: ([Identifier]) + _hdOaroundMap :: (Map ConstructorIdent (Map Identifier [Expression])) + _hdOcVisitsMap :: CVisitsMap + _hdOinh :: Attributes + _hdOinhMap :: (Map Identifier Attributes) + _hdOmanualAttrDepMap :: AttrOrderMap + _hdOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) + _hdOnt :: Identifier + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_dovisit :: Bool + _hdOo_newtypes :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_unbox :: Bool + _hdOo_wantvisit :: Bool + _hdOprefix :: String + _hdOsyn :: Attributes + _hdOsynMap :: (Map Identifier Attributes) + _hdOvcount :: Int + _tlOallnts :: ([Identifier]) + _tlOaroundMap :: (Map ConstructorIdent (Map Identifier [Expression])) + _tlOcVisitsMap :: CVisitsMap + _tlOinh :: Attributes + _tlOinhMap :: (Map Identifier Attributes) + _tlOmanualAttrDepMap :: AttrOrderMap + _tlOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) + _tlOnt :: Identifier + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_dovisit :: Bool + _tlOo_newtypes :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_unbox :: Bool + _tlOo_wantvisit :: Bool + _tlOprefix :: String + _tlOsyn :: Attributes + _tlOsynMap :: (Map Identifier Attributes) + _tlOvcount :: Int + _hdIadditionalDep :: (Seq Edge) + _hdIaroundDep :: (Seq Edge) + _hdIcProduction :: CProduction + _hdIcons :: ([ConstructorIdent]) + _hdIdirectDep :: (Seq Edge) + _hdIerrors :: (Seq Error) + _hdIinstDep :: (Seq Edge) + _hdImergeDep :: (Seq Edge) + _hdInAutoRules :: Int + _hdInExplicitRules :: Int + _hdIrules :: (Seq (Vertex,CRule)) + _hdIvcount :: Int + _tlIadditionalDep :: (Seq Edge) + _tlIaroundDep :: (Seq Edge) + _tlIcProductions :: CProductions + _tlIcons :: ([ConstructorIdent]) + _tlIdirectDep :: (Seq Edge) + _tlIerrors :: (Seq Error) + _tlIinstDep :: (Seq Edge) + _tlImergeDep :: (Seq Edge) + _tlInAutoRules :: Int + _tlInExplicitRules :: Int + _tlIrules :: (Seq (Vertex,CRule)) + _tlIvcount :: Int + -- "./src-ag/Order.ag"(line 627, column 12) + _lhsOcProductions = + ({-# LINE 627 "./src-ag/Order.ag" #-} + _hdIcProduction : _tlIcProductions + {-# LINE 4182 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 282, column 60) + _lhsOadditionalDep = + ({-# LINE 282 "./src-ag/Order.ag" #-} + _hdIadditionalDep Seq.>< _tlIadditionalDep + {-# LINE 4188 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 403, column 24) + _lhsOaroundDep = + ({-# LINE 403 "./src-ag/Order.ag" #-} + _hdIaroundDep Seq.>< _tlIaroundDep + {-# LINE 4194 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 521, column 40) + _lhsOcons = + ({-# LINE 521 "./src-ag/Order.ag" #-} + _hdIcons ++ _tlIcons + {-# LINE 4200 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 268, column 33) + _lhsOdirectDep = + ({-# LINE 268 "./src-ag/Order.ag" #-} + _hdIdirectDep Seq.>< _tlIdirectDep + {-# LINE 4206 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 4212 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 311, column 31) + _lhsOinstDep = + ({-# LINE 311 "./src-ag/Order.ag" #-} + _hdIinstDep Seq.>< _tlIinstDep + {-# LINE 4218 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 366, column 18) + _lhsOmergeDep = + ({-# LINE 366 "./src-ag/Order.ag" #-} + _hdImergeDep Seq.>< _tlImergeDep + {-# LINE 4224 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnAutoRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + _hdInAutoRules + _tlInAutoRules + {-# LINE 4230 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnExplicitRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + _hdInExplicitRules + _tlInExplicitRules + {-# LINE 4236 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 258, column 18) + _lhsOrules = + ({-# LINE 258 "./src-ag/Order.ag" #-} + _hdIrules Seq.>< _tlIrules + {-# LINE 4242 "dist/build/Order.hs" #-} + ) + -- copy rule (up) + _lhsOvcount = + ({-# LINE 257 "./src-ag/Order.ag" #-} + _tlIvcount + {-# LINE 4248 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOallnts = + ({-# LINE 648 "./src-ag/Order.ag" #-} + _lhsIallnts + {-# LINE 4254 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOaroundMap = + ({-# LINE 409 "./src-ag/Order.ag" #-} + _lhsIaroundMap + {-# LINE 4260 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOcVisitsMap = + ({-# LINE 602 "./src-ag/Order.ag" #-} + _lhsIcVisitsMap + {-# LINE 4266 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIinh + {-# LINE 4272 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 4278 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOmanualAttrDepMap = + ({-# LINE 282 "./src-ag/Order.ag" #-} + _lhsImanualAttrDepMap + {-# LINE 4284 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 356 "./src-ag/Order.ag" #-} + _lhsImergeMap + {-# LINE 4290 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 4296 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 118 "./src-ag/Order.ag" #-} + _lhsIo_case + {-# LINE 4302 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 112 "./src-ag/Order.ag" #-} + _lhsIo_cata + {-# LINE 4308 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_dovisit = + ({-# LINE 117 "./src-ag/Order.ag" #-} + _lhsIo_dovisit + {-# LINE 4314 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 111 "./src-ag/Order.ag" #-} + _lhsIo_newtypes + {-# LINE 4320 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 115 "./src-ag/Order.ag" #-} + _lhsIo_rename + {-# LINE 4326 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 114 "./src-ag/Order.ag" #-} + _lhsIo_sem + {-# LINE 4332 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 113 "./src-ag/Order.ag" #-} + _lhsIo_sig + {-# LINE 4338 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_unbox = + ({-# LINE 120 "./src-ag/Order.ag" #-} + _lhsIo_unbox + {-# LINE 4344 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_wantvisit = + ({-# LINE 116 "./src-ag/Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 4350 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 119 "./src-ag/Order.ag" #-} + _lhsIprefix + {-# LINE 4356 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIsyn + {-# LINE 4362 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 4368 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOvcount = + ({-# LINE 257 "./src-ag/Order.ag" #-} + _lhsIvcount + {-# LINE 4374 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOallnts = + ({-# LINE 648 "./src-ag/Order.ag" #-} + _lhsIallnts + {-# LINE 4380 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOaroundMap = + ({-# LINE 409 "./src-ag/Order.ag" #-} + _lhsIaroundMap + {-# LINE 4386 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOcVisitsMap = + ({-# LINE 602 "./src-ag/Order.ag" #-} + _lhsIcVisitsMap + {-# LINE 4392 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIinh + {-# LINE 4398 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 4404 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOmanualAttrDepMap = + ({-# LINE 282 "./src-ag/Order.ag" #-} + _lhsImanualAttrDepMap + {-# LINE 4410 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 356 "./src-ag/Order.ag" #-} + _lhsImergeMap + {-# LINE 4416 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 4422 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 118 "./src-ag/Order.ag" #-} + _lhsIo_case + {-# LINE 4428 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 112 "./src-ag/Order.ag" #-} + _lhsIo_cata + {-# LINE 4434 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_dovisit = + ({-# LINE 117 "./src-ag/Order.ag" #-} + _lhsIo_dovisit + {-# LINE 4440 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 111 "./src-ag/Order.ag" #-} + _lhsIo_newtypes + {-# LINE 4446 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 115 "./src-ag/Order.ag" #-} + _lhsIo_rename + {-# LINE 4452 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 114 "./src-ag/Order.ag" #-} + _lhsIo_sem + {-# LINE 4458 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 113 "./src-ag/Order.ag" #-} + _lhsIo_sig + {-# LINE 4464 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_unbox = + ({-# LINE 120 "./src-ag/Order.ag" #-} + _lhsIo_unbox + {-# LINE 4470 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_wantvisit = + ({-# LINE 116 "./src-ag/Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 4476 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 119 "./src-ag/Order.ag" #-} + _lhsIprefix + {-# LINE 4482 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIsyn + {-# LINE 4488 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 4494 "dist/build/Order.hs" #-} + ) + -- copy rule (chain) + _tlOvcount = + ({-# LINE 257 "./src-ag/Order.ag" #-} + _hdIvcount + {-# LINE 4500 "dist/build/Order.hs" #-} + ) + ( _hdIadditionalDep,_hdIaroundDep,_hdIcProduction,_hdIcons,_hdIdirectDep,_hdIerrors,_hdIinstDep,_hdImergeDep,_hdInAutoRules,_hdInExplicitRules,_hdIrules,_hdIvcount) = + hd_ _hdOallnts _hdOaroundMap _hdOcVisitsMap _hdOinh _hdOinhMap _hdOmanualAttrDepMap _hdOmergeMap _hdOnt _hdOo_case _hdOo_cata _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_unbox _hdOo_wantvisit _hdOprefix _hdOsyn _hdOsynMap _hdOvcount + ( _tlIadditionalDep,_tlIaroundDep,_tlIcProductions,_tlIcons,_tlIdirectDep,_tlIerrors,_tlIinstDep,_tlImergeDep,_tlInAutoRules,_tlInExplicitRules,_tlIrules,_tlIvcount) = + tl_ _tlOallnts _tlOaroundMap _tlOcVisitsMap _tlOinh _tlOinhMap _tlOmanualAttrDepMap _tlOmergeMap _tlOnt _tlOo_case _tlOo_cata _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_unbox _tlOo_wantvisit _tlOprefix _tlOsyn _tlOsynMap _tlOvcount + in ( _lhsOadditionalDep,_lhsOaroundDep,_lhsOcProductions,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOrules,_lhsOvcount)))) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (\ _lhsIallnts + _lhsIaroundMap + _lhsIcVisitsMap + _lhsIinh + _lhsIinhMap + _lhsImanualAttrDepMap + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_unbox + _lhsIo_wantvisit + _lhsIprefix + _lhsIsyn + _lhsIsynMap + _lhsIvcount -> + (let _lhsOcProductions :: CProductions + _lhsOadditionalDep :: (Seq Edge) + _lhsOaroundDep :: (Seq Edge) + _lhsOcons :: ([ConstructorIdent]) + _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOinstDep :: (Seq Edge) + _lhsOmergeDep :: (Seq Edge) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _lhsOrules :: (Seq (Vertex,CRule)) + _lhsOvcount :: Int + -- "./src-ag/Order.ag"(line 628, column 12) + _lhsOcProductions = + ({-# LINE 628 "./src-ag/Order.ag" #-} + [] + {-# LINE 4546 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 282, column 60) + _lhsOadditionalDep = + ({-# LINE 282 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 4552 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 403, column 24) + _lhsOaroundDep = + ({-# LINE 403 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 4558 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 521, column 40) + _lhsOcons = + ({-# LINE 521 "./src-ag/Order.ag" #-} + [] + {-# LINE 4564 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 268, column 33) + _lhsOdirectDep = + ({-# LINE 268 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 4570 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 4576 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 311, column 31) + _lhsOinstDep = + ({-# LINE 311 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 4582 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 366, column 18) + _lhsOmergeDep = + ({-# LINE 366 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 4588 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnAutoRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + 0 + {-# LINE 4594 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnExplicitRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + 0 + {-# LINE 4600 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 258, column 18) + _lhsOrules = + ({-# LINE 258 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 4606 "dist/build/Order.hs" #-} + ) + -- copy rule (chain) + _lhsOvcount = + ({-# LINE 257 "./src-ag/Order.ag" #-} + _lhsIvcount + {-# LINE 4612 "dist/build/Order.hs" #-} + ) + in ( _lhsOadditionalDep,_lhsOaroundDep,_lhsOcProductions,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOrules,_lhsOvcount)))) +-- Rule -------------------------------------------------------- +{- + visit 0: + inherited attributes: + allTypeSigs : Map Identifier Type + allfields : [(Identifier,Type,ChildKind)] + allnts : [Identifier] + altAttrs : Map AltAttr Vertex + attrs : [(Identifier,Identifier)] + childInhs : Map Identifier Attributes + childNts : Map Identifier NontermIdent + con : Identifier + inh : Attributes + inhsOfChildren : Map Identifier Attributes + mergeMap : Map Identifier (Identifier,[Identifier]) + nt : Identifier + o_case : Bool + o_cata : Bool + o_dovisit : Bool + o_newtypes : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_wantvisit : Bool + prefix : String + syn : Attributes + synsOfChildren : Map Identifier Attributes + synthesized attributes: + directDep : Seq Edge + errors : Seq Error + gathAltAttrs : [AltAttr] + gathRules : Seq CRule + instDep : Seq Edge + instVars : [Identifier] + locVars : [Identifier] + nAutoRules : Int + nExplicitRules : Int + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + child pure : {Bool} + child identity : {Bool} + child mbError : {Maybe Error} + child eager : {Bool} + visit 0: + local defines : _ + local gathRules : _ + local instDep1 : _ + local instDep2 : _ +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit _pure _identity _mbError _eager) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin _explicit _pure _identity _mbError _eager) +-- semantic domain +newtype T_Rule = T_Rule ((Map Identifier Type) -> + ([(Identifier,Type,ChildKind)]) -> + ([Identifier]) -> + (Map AltAttr Vertex) -> + ([(Identifier,Identifier)]) -> + (Map Identifier Attributes) -> + (Map Identifier NontermIdent) -> + Identifier -> + Attributes -> + (Map Identifier Attributes) -> + (Map Identifier (Identifier,[Identifier])) -> + Identifier -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + String -> + Attributes -> + (Map Identifier Attributes) -> + ( (Seq Edge),(Seq Error),([AltAttr]),(Seq CRule),(Seq Edge),([Identifier]),([Identifier]),Int,Int)) +data Inh_Rule = Inh_Rule {allTypeSigs_Inh_Rule :: !((Map Identifier Type)),allfields_Inh_Rule :: !(([(Identifier,Type,ChildKind)])),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),inhsOfChildren_Inh_Rule :: !((Map Identifier Attributes)),mergeMap_Inh_Rule :: !((Map Identifier (Identifier,[Identifier]))),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 {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])),nAutoRules_Syn_Rule :: !(Int),nExplicitRules_Syn_Rule :: !(Int)} +wrap_Rule :: T_Rule -> + Inh_Rule -> + Syn_Rule +wrap_Rule (T_Rule sem) (Inh_Rule _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsIinhsOfChildren _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren) = + (let ( _lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars,_lhsOnAutoRules,_lhsOnExplicitRules) = sem _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsIinhsOfChildren _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren + in (Syn_Rule _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars _lhsOnAutoRules _lhsOnExplicitRules)) +sem_Rule_Rule :: (Maybe Identifier) -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + Bool -> + Bool -> + (Maybe Error) -> + Bool -> + T_Rule +sem_Rule_Rule mbName_ (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ = + (T_Rule (\ _lhsIallTypeSigs + _lhsIallfields + _lhsIallnts + _lhsIaltAttrs + _lhsIattrs + _lhsIchildInhs + _lhsIchildNts + _lhsIcon + _lhsIinh + _lhsIinhsOfChildren + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_wantvisit + _lhsIprefix + _lhsIsyn + _lhsIsynsOfChildren -> + (let _lhsOnExplicitRules :: Int + _lhsOnAutoRules :: Int + _lhsOdirectDep :: (Seq Edge) + _lhsOinstDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOgathRules :: (Seq CRule) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _patternOallTypeSigs :: (Map Identifier Type) + _patternOaltAttrs :: (Map AltAttr Vertex) + _patternOcon :: Identifier + _patternOinh :: Attributes + _patternOnt :: Identifier + _patternOsyn :: Attributes + _rhsOallfields :: ([(Identifier,Type,ChildKind)]) + _rhsOallnts :: ([Identifier]) + _rhsOattrs :: ([(Identifier,Identifier)]) + _rhsOcon :: Identifier + _rhsOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _rhsOnt :: Identifier + _patternIcopy :: Pattern + _patternIerrors :: (Seq Error) + _patternIgathAltAttrs :: ([AltAttr]) + _patternIinstVars :: ([Identifier]) + _patternIlocVars :: ([Identifier]) + _patternIpatternAttrs :: ([(Identifier,Identifier,Bool)]) + _rhsIallRhsVars :: (Set (Identifier,Identifier)) + _rhsIcopy :: Expression + _rhsIerrors :: (Seq Error) + _rhsItextLines :: ([String]) + _rhsIusedAttrs :: ([(Identifier,Identifier)]) + _rhsIusedFields :: ([Identifier]) + _rhsIusedLocals :: ([Identifier]) + -- "./src-ag/Order.ag"(line 65, column 11) + _lhsOnExplicitRules = + ({-# LINE 65 "./src-ag/Order.ag" #-} + if explicit_ + then 1 + else 0 + {-# LINE 4783 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 68, column 11) + _lhsOnAutoRules = + ({-# LINE 68 "./src-ag/Order.ag" #-} + if startsWith "use rule" origin_ || startsWith "copy rule" origin_ + then 1 + else 0 + {-# LINE 4791 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 218, column 12) + _defines = + ({-# LINE 218 "./src-ag/Order.ag" #-} + let tp field attr | field == _LOC || field == _INST + = Map.lookup attr _lhsIallTypeSigs + | field == _LHS = Map.lookup attr _lhsIsyn + | otherwise = Map.lookup attr (findWithErr1 "Rule.defines.tp" field _lhsIchildInhs) + typ :: Pattern -> Maybe Type + typ (Alias field attr _) = tp field attr + typ (Underscore _) = Nothing + typ _ = Nothing + in Map.fromList [ (findWithErr1 "Rule.defines" aa _lhsIaltAttrs, (field,attr,(tp field attr))) + | (field,attr,isLocalOrInst) <- _patternIpatternAttrs + , let aa = AltAttr field attr isLocalOrInst + ] + {-# LINE 4808 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 232, column 12) + _gathRules = + ({-# LINE 232 "./src-ag/Order.ag" #-} + 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 explicit_ mbName_ + | (field,attr,tp) <- Map.elems _defines + ] + {-# LINE 4817 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 270, column 12) + _lhsOdirectDep = + ({-# LINE 270 "./src-ag/Order.ag" #-} + 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 ] + {-# LINE 4826 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 314, column 6) + _instDep1 = + ({-# LINE 314 "./src-ag/Order.ag" #-} + Seq.fromList $ + [ (instVert, synVert) + | (field,instNm,_) <- Map.elems _defines + , field == _INST + , synNm <- Map.keys (findWithErr2 instNm _lhsIsynsOfChildren) + , let instAttr = AltAttr _INST instNm True + synAttr = AltAttr instNm synNm True + instVert = findWithErr2 instAttr _lhsIaltAttrs + synVert = findWithErr2 synAttr _lhsIaltAttrs + ] + {-# LINE 4841 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 325, column 6) + _instDep2 = + ({-# LINE 325 "./src-ag/Order.ag" #-} + Seq.fromList $ + [ (instVert, inhVert) + | (field,instNm,_) <- Map.elems _defines + , field == _INST + , inhNm <- Map.keys (findWithErr2 instNm _lhsIinhsOfChildren) + , let instAttr = AltAttr _INST instNm True + inhAttr = AltAttr instNm inhNm False + instVert = findWithErr2 instAttr _lhsIaltAttrs + inhVert = findWithErr2 inhAttr _lhsIaltAttrs + ] + {-# LINE 4856 "dist/build/Order.hs" #-} + ) + -- "./src-ag/Order.ag"(line 336, column 6) + _lhsOinstDep = + ({-# LINE 336 "./src-ag/Order.ag" #-} + _instDep1 Seq.>< _instDep2 + {-# LINE 4862 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + _patternIerrors Seq.>< _rhsIerrors + {-# LINE 4868 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 171, column 68) + _lhsOgathAltAttrs = + ({-# LINE 171 "./src-ag/Order.ag" #-} + _patternIgathAltAttrs + {-# LINE 4874 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 207, column 23) + _lhsOgathRules = + ({-# LINE 207 "./src-ag/Order.ag" #-} + _gathRules + {-# LINE 4880 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 86) + _lhsOinstVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + _patternIinstVars + {-# LINE 4886 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 48) + _lhsOlocVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + _patternIlocVars + {-# LINE 4892 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patternOallTypeSigs = + ({-# LINE 534 "./src-ag/Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 4898 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patternOaltAttrs = + ({-# LINE 187 "./src-ag/Order.ag" #-} + _lhsIaltAttrs + {-# LINE 4904 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patternOcon = + ({-# LINE 91 "./src-ag/Order.ag" #-} + _lhsIcon + {-# LINE 4910 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patternOinh = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIinh + {-# LINE 4916 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patternOnt = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 4922 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _patternOsyn = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIsyn + {-# LINE 4928 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rhsOallfields = + ({-# LINE 447 "./src-ag/Order.ag" #-} + _lhsIallfields + {-# LINE 4934 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rhsOallnts = + ({-# LINE 448 "./src-ag/Order.ag" #-} + _lhsIallnts + {-# LINE 4940 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rhsOattrs = + ({-# LINE 449 "./src-ag/Order.ag" #-} + _lhsIattrs + {-# LINE 4946 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rhsOcon = + ({-# LINE 446 "./src-ag/Order.ag" #-} + _lhsIcon + {-# LINE 4952 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rhsOmergeMap = + ({-# LINE 361 "./src-ag/Order.ag" #-} + _lhsImergeMap + {-# LINE 4958 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _rhsOnt = + ({-# LINE 446 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 4964 "dist/build/Order.hs" #-} + ) + ( _patternIcopy,_patternIerrors,_patternIgathAltAttrs,_patternIinstVars,_patternIlocVars,_patternIpatternAttrs) = + pattern_ _patternOallTypeSigs _patternOaltAttrs _patternOcon _patternOinh _patternOnt _patternOsyn + ( _rhsIallRhsVars,_rhsIcopy,_rhsIerrors,_rhsItextLines,_rhsIusedAttrs,_rhsIusedFields,_rhsIusedLocals) = + rhs_ _rhsOallfields _rhsOallnts _rhsOattrs _rhsOcon _rhsOmergeMap _rhsOnt + in ( _lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars,_lhsOnAutoRules,_lhsOnExplicitRules)))) +-- Rules ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allTypeSigs : Map Identifier Type + allfields : [(Identifier,Type,ChildKind)] + allnts : [Identifier] + altAttrs : Map AltAttr Vertex + attrs : [(Identifier,Identifier)] + childInhs : Map Identifier Attributes + childNts : Map Identifier NontermIdent + con : Identifier + inh : Attributes + inhsOfChildren : Map Identifier Attributes + mergeMap : Map Identifier (Identifier,[Identifier]) + nt : Identifier + o_case : Bool + o_cata : Bool + o_dovisit : Bool + o_newtypes : Bool + o_rename : Bool + o_sem : Bool + o_sig : Bool + o_wantvisit : Bool + prefix : String + syn : Attributes + synsOfChildren : Map Identifier Attributes + synthesized attributes: + directDep : Seq Edge + errors : Seq Error + gathAltAttrs : [AltAttr] + gathRules : Seq CRule + instDep : Seq Edge + instVars : [Identifier] + locVars : [Identifier] + nAutoRules : Int + nExplicitRules : Int + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + alternative Nil: +-} +-- 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 ((Map Identifier Type) -> + ([(Identifier,Type,ChildKind)]) -> + ([Identifier]) -> + (Map AltAttr Vertex) -> + ([(Identifier,Identifier)]) -> + (Map Identifier Attributes) -> + (Map Identifier NontermIdent) -> + Identifier -> + Attributes -> + (Map Identifier Attributes) -> + (Map Identifier (Identifier,[Identifier])) -> + Identifier -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + Bool -> + String -> + Attributes -> + (Map Identifier Attributes) -> + ( (Seq Edge),(Seq Error),([AltAttr]),(Seq CRule),(Seq Edge),([Identifier]),([Identifier]),Int,Int)) +data Inh_Rules = Inh_Rules {allTypeSigs_Inh_Rules :: !((Map Identifier Type)),allfields_Inh_Rules :: !(([(Identifier,Type,ChildKind)])),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),inhsOfChildren_Inh_Rules :: !((Map Identifier Attributes)),mergeMap_Inh_Rules :: !((Map Identifier (Identifier,[Identifier]))),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 {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])),nAutoRules_Syn_Rules :: !(Int),nExplicitRules_Syn_Rules :: !(Int)} +wrap_Rules :: T_Rules -> + Inh_Rules -> + Syn_Rules +wrap_Rules (T_Rules sem) (Inh_Rules _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsIinhsOfChildren _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren) = + (let ( _lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars,_lhsOnAutoRules,_lhsOnExplicitRules) = sem _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsIinhsOfChildren _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIsynsOfChildren + in (Syn_Rules _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars _lhsOnAutoRules _lhsOnExplicitRules)) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) = + (T_Rules (\ _lhsIallTypeSigs + _lhsIallfields + _lhsIallnts + _lhsIaltAttrs + _lhsIattrs + _lhsIchildInhs + _lhsIchildNts + _lhsIcon + _lhsIinh + _lhsIinhsOfChildren + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_wantvisit + _lhsIprefix + _lhsIsyn + _lhsIsynsOfChildren -> + (let _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOgathRules :: (Seq CRule) + _lhsOinstDep :: (Seq Edge) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + _hdOallTypeSigs :: (Map Identifier Type) + _hdOallfields :: ([(Identifier,Type,ChildKind)]) + _hdOallnts :: ([Identifier]) + _hdOaltAttrs :: (Map AltAttr Vertex) + _hdOattrs :: ([(Identifier,Identifier)]) + _hdOchildInhs :: (Map Identifier Attributes) + _hdOchildNts :: (Map Identifier NontermIdent) + _hdOcon :: Identifier + _hdOinh :: Attributes + _hdOinhsOfChildren :: (Map Identifier Attributes) + _hdOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _hdOnt :: Identifier + _hdOo_case :: Bool + _hdOo_cata :: Bool + _hdOo_dovisit :: Bool + _hdOo_newtypes :: Bool + _hdOo_rename :: Bool + _hdOo_sem :: Bool + _hdOo_sig :: Bool + _hdOo_wantvisit :: Bool + _hdOprefix :: String + _hdOsyn :: Attributes + _hdOsynsOfChildren :: (Map Identifier Attributes) + _tlOallTypeSigs :: (Map Identifier Type) + _tlOallfields :: ([(Identifier,Type,ChildKind)]) + _tlOallnts :: ([Identifier]) + _tlOaltAttrs :: (Map AltAttr Vertex) + _tlOattrs :: ([(Identifier,Identifier)]) + _tlOchildInhs :: (Map Identifier Attributes) + _tlOchildNts :: (Map Identifier NontermIdent) + _tlOcon :: Identifier + _tlOinh :: Attributes + _tlOinhsOfChildren :: (Map Identifier Attributes) + _tlOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _tlOnt :: Identifier + _tlOo_case :: Bool + _tlOo_cata :: Bool + _tlOo_dovisit :: Bool + _tlOo_newtypes :: Bool + _tlOo_rename :: Bool + _tlOo_sem :: Bool + _tlOo_sig :: Bool + _tlOo_wantvisit :: Bool + _tlOprefix :: String + _tlOsyn :: Attributes + _tlOsynsOfChildren :: (Map Identifier Attributes) + _hdIdirectDep :: (Seq Edge) + _hdIerrors :: (Seq Error) + _hdIgathAltAttrs :: ([AltAttr]) + _hdIgathRules :: (Seq CRule) + _hdIinstDep :: (Seq Edge) + _hdIinstVars :: ([Identifier]) + _hdIlocVars :: ([Identifier]) + _hdInAutoRules :: Int + _hdInExplicitRules :: Int + _tlIdirectDep :: (Seq Edge) + _tlIerrors :: (Seq Error) + _tlIgathAltAttrs :: ([AltAttr]) + _tlIgathRules :: (Seq CRule) + _tlIinstDep :: (Seq Edge) + _tlIinstVars :: ([Identifier]) + _tlIlocVars :: ([Identifier]) + _tlInAutoRules :: Int + _tlInExplicitRules :: Int + -- use rule "./src-ag/Order.ag"(line 268, column 33) + _lhsOdirectDep = + ({-# LINE 268 "./src-ag/Order.ag" #-} + _hdIdirectDep Seq.>< _tlIdirectDep + {-# LINE 5156 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 5162 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 171, column 68) + _lhsOgathAltAttrs = + ({-# LINE 171 "./src-ag/Order.ag" #-} + _hdIgathAltAttrs ++ _tlIgathAltAttrs + {-# LINE 5168 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 207, column 23) + _lhsOgathRules = + ({-# LINE 207 "./src-ag/Order.ag" #-} + _hdIgathRules Seq.>< _tlIgathRules + {-# LINE 5174 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 311, column 31) + _lhsOinstDep = + ({-# LINE 311 "./src-ag/Order.ag" #-} + _hdIinstDep Seq.>< _tlIinstDep + {-# LINE 5180 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 86) + _lhsOinstVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + _hdIinstVars ++ _tlIinstVars + {-# LINE 5186 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 48) + _lhsOlocVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + _hdIlocVars ++ _tlIlocVars + {-# LINE 5192 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnAutoRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + _hdInAutoRules + _tlInAutoRules + {-# LINE 5198 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnExplicitRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + _hdInExplicitRules + _tlInExplicitRules + {-# LINE 5204 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOallTypeSigs = + ({-# LINE 534 "./src-ag/Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 5210 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOallfields = + ({-# LINE 655 "./src-ag/Order.ag" #-} + _lhsIallfields + {-# LINE 5216 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOallnts = + ({-# LINE 648 "./src-ag/Order.ag" #-} + _lhsIallnts + {-# LINE 5222 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOaltAttrs = + ({-# LINE 187 "./src-ag/Order.ag" #-} + _lhsIaltAttrs + {-# LINE 5228 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOattrs = + ({-# LINE 655 "./src-ag/Order.ag" #-} + _lhsIattrs + {-# LINE 5234 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOchildInhs = + ({-# LINE 200 "./src-ag/Order.ag" #-} + _lhsIchildInhs + {-# LINE 5240 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOchildNts = + ({-# LINE 199 "./src-ag/Order.ag" #-} + _lhsIchildNts + {-# LINE 5246 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 91 "./src-ag/Order.ag" #-} + _lhsIcon + {-# LINE 5252 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIinh + {-# LINE 5258 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOinhsOfChildren = + ({-# LINE 338 "./src-ag/Order.ag" #-} + _lhsIinhsOfChildren + {-# LINE 5264 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 361 "./src-ag/Order.ag" #-} + _lhsImergeMap + {-# LINE 5270 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 5276 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_case = + ({-# LINE 118 "./src-ag/Order.ag" #-} + _lhsIo_case + {-# LINE 5282 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_cata = + ({-# LINE 112 "./src-ag/Order.ag" #-} + _lhsIo_cata + {-# LINE 5288 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_dovisit = + ({-# LINE 117 "./src-ag/Order.ag" #-} + _lhsIo_dovisit + {-# LINE 5294 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_newtypes = + ({-# LINE 111 "./src-ag/Order.ag" #-} + _lhsIo_newtypes + {-# LINE 5300 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_rename = + ({-# LINE 115 "./src-ag/Order.ag" #-} + _lhsIo_rename + {-# LINE 5306 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_sem = + ({-# LINE 114 "./src-ag/Order.ag" #-} + _lhsIo_sem + {-# LINE 5312 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_sig = + ({-# LINE 113 "./src-ag/Order.ag" #-} + _lhsIo_sig + {-# LINE 5318 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOo_wantvisit = + ({-# LINE 116 "./src-ag/Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 5324 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOprefix = + ({-# LINE 119 "./src-ag/Order.ag" #-} + _lhsIprefix + {-# LINE 5330 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIsyn + {-# LINE 5336 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOsynsOfChildren = + ({-# LINE 338 "./src-ag/Order.ag" #-} + _lhsIsynsOfChildren + {-# LINE 5342 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOallTypeSigs = + ({-# LINE 534 "./src-ag/Order.ag" #-} + _lhsIallTypeSigs + {-# LINE 5348 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOallfields = + ({-# LINE 655 "./src-ag/Order.ag" #-} + _lhsIallfields + {-# LINE 5354 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOallnts = + ({-# LINE 648 "./src-ag/Order.ag" #-} + _lhsIallnts + {-# LINE 5360 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOaltAttrs = + ({-# LINE 187 "./src-ag/Order.ag" #-} + _lhsIaltAttrs + {-# LINE 5366 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOattrs = + ({-# LINE 655 "./src-ag/Order.ag" #-} + _lhsIattrs + {-# LINE 5372 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOchildInhs = + ({-# LINE 200 "./src-ag/Order.ag" #-} + _lhsIchildInhs + {-# LINE 5378 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOchildNts = + ({-# LINE 199 "./src-ag/Order.ag" #-} + _lhsIchildNts + {-# LINE 5384 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 91 "./src-ag/Order.ag" #-} + _lhsIcon + {-# LINE 5390 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIinh + {-# LINE 5396 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOinhsOfChildren = + ({-# LINE 338 "./src-ag/Order.ag" #-} + _lhsIinhsOfChildren + {-# LINE 5402 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 361 "./src-ag/Order.ag" #-} + _lhsImergeMap + {-# LINE 5408 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsInt + {-# LINE 5414 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_case = + ({-# LINE 118 "./src-ag/Order.ag" #-} + _lhsIo_case + {-# LINE 5420 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_cata = + ({-# LINE 112 "./src-ag/Order.ag" #-} + _lhsIo_cata + {-# LINE 5426 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_dovisit = + ({-# LINE 117 "./src-ag/Order.ag" #-} + _lhsIo_dovisit + {-# LINE 5432 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_newtypes = + ({-# LINE 111 "./src-ag/Order.ag" #-} + _lhsIo_newtypes + {-# LINE 5438 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_rename = + ({-# LINE 115 "./src-ag/Order.ag" #-} + _lhsIo_rename + {-# LINE 5444 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_sem = + ({-# LINE 114 "./src-ag/Order.ag" #-} + _lhsIo_sem + {-# LINE 5450 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_sig = + ({-# LINE 113 "./src-ag/Order.ag" #-} + _lhsIo_sig + {-# LINE 5456 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOo_wantvisit = + ({-# LINE 116 "./src-ag/Order.ag" #-} + _lhsIo_wantvisit + {-# LINE 5462 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOprefix = + ({-# LINE 119 "./src-ag/Order.ag" #-} + _lhsIprefix + {-# LINE 5468 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 90 "./src-ag/Order.ag" #-} + _lhsIsyn + {-# LINE 5474 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _tlOsynsOfChildren = + ({-# LINE 338 "./src-ag/Order.ag" #-} + _lhsIsynsOfChildren + {-# LINE 5480 "dist/build/Order.hs" #-} + ) + ( _hdIdirectDep,_hdIerrors,_hdIgathAltAttrs,_hdIgathRules,_hdIinstDep,_hdIinstVars,_hdIlocVars,_hdInAutoRules,_hdInExplicitRules) = + hd_ _hdOallTypeSigs _hdOallfields _hdOallnts _hdOaltAttrs _hdOattrs _hdOchildInhs _hdOchildNts _hdOcon _hdOinh _hdOinhsOfChildren _hdOmergeMap _hdOnt _hdOo_case _hdOo_cata _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_wantvisit _hdOprefix _hdOsyn _hdOsynsOfChildren + ( _tlIdirectDep,_tlIerrors,_tlIgathAltAttrs,_tlIgathRules,_tlIinstDep,_tlIinstVars,_tlIlocVars,_tlInAutoRules,_tlInExplicitRules) = + tl_ _tlOallTypeSigs _tlOallfields _tlOallnts _tlOaltAttrs _tlOattrs _tlOchildInhs _tlOchildNts _tlOcon _tlOinh _tlOinhsOfChildren _tlOmergeMap _tlOnt _tlOo_case _tlOo_cata _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_wantvisit _tlOprefix _tlOsyn _tlOsynsOfChildren + in ( _lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars,_lhsOnAutoRules,_lhsOnExplicitRules)))) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (\ _lhsIallTypeSigs + _lhsIallfields + _lhsIallnts + _lhsIaltAttrs + _lhsIattrs + _lhsIchildInhs + _lhsIchildNts + _lhsIcon + _lhsIinh + _lhsIinhsOfChildren + _lhsImergeMap + _lhsInt + _lhsIo_case + _lhsIo_cata + _lhsIo_dovisit + _lhsIo_newtypes + _lhsIo_rename + _lhsIo_sem + _lhsIo_sig + _lhsIo_wantvisit + _lhsIprefix + _lhsIsyn + _lhsIsynsOfChildren -> + (let _lhsOdirectDep :: (Seq Edge) + _lhsOerrors :: (Seq Error) + _lhsOgathAltAttrs :: ([AltAttr]) + _lhsOgathRules :: (Seq CRule) + _lhsOinstDep :: (Seq Edge) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOnAutoRules :: Int + _lhsOnExplicitRules :: Int + -- use rule "./src-ag/Order.ag"(line 268, column 33) + _lhsOdirectDep = + ({-# LINE 268 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 5525 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 85, column 70) + _lhsOerrors = + ({-# LINE 85 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 5531 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 171, column 68) + _lhsOgathAltAttrs = + ({-# LINE 171 "./src-ag/Order.ag" #-} + [] + {-# LINE 5537 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 207, column 23) + _lhsOgathRules = + ({-# LINE 207 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 5543 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 311, column 31) + _lhsOinstDep = + ({-# LINE 311 "./src-ag/Order.ag" #-} + Seq.empty + {-# LINE 5549 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 86) + _lhsOinstVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + [] + {-# LINE 5555 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 678, column 48) + _lhsOlocVars = + ({-# LINE 678 "./src-ag/Order.ag" #-} + [] + {-# LINE 5561 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnAutoRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + 0 + {-# LINE 5567 "dist/build/Order.hs" #-} + ) + -- use rule "./src-ag/Order.ag"(line 62, column 105) + _lhsOnExplicitRules = + ({-# LINE 62 "./src-ag/Order.ag" #-} + 0 + {-# LINE 5573 "dist/build/Order.hs" #-} + ) + in ( _lhsOdirectDep,_lhsOerrors,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinstDep,_lhsOinstVars,_lhsOlocVars,_lhsOnAutoRules,_lhsOnExplicitRules)))) +-- TypeSig ----------------------------------------------------- +{- + visit 0: + chained attribute: + typeSigs : Map Identifier Type + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig (TypeSig _name _tp) = + (sem_TypeSig_TypeSig _name _tp) +-- 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))} +wrap_TypeSig :: T_TypeSig -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig _lhsItypeSigs) = + (let ( _lhsOtypeSigs) = sem _lhsItypeSigs + in (Syn_TypeSig _lhsOtypeSigs)) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig name_ tp_ = + (T_TypeSig (\ _lhsItypeSigs -> + (let _lhsOtypeSigs :: (Map Identifier Type) + -- "./src-ag/Order.ag"(line 532, column 13) + _lhsOtypeSigs = + ({-# LINE 532 "./src-ag/Order.ag" #-} + Map.insert name_ tp_ _lhsItypeSigs + {-# LINE 5612 "dist/build/Order.hs" #-} + ) + in ( _lhsOtypeSigs)))) +-- TypeSigs ---------------------------------------------------- +{- + visit 0: + chained attribute: + typeSigs : Map Identifier Type + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + alternative Nil: +-} +-- 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 ((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))} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs _lhsItypeSigs) = + (let ( _lhsOtypeSigs) = sem _lhsItypeSigs + in (Syn_TypeSigs _lhsOtypeSigs)) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons (T_TypeSig hd_) (T_TypeSigs tl_) = + (T_TypeSigs (\ _lhsItypeSigs -> + (let _lhsOtypeSigs :: (Map Identifier Type) + _hdOtypeSigs :: (Map Identifier Type) + _tlOtypeSigs :: (Map Identifier Type) + _hdItypeSigs :: (Map Identifier Type) + _tlItypeSigs :: (Map Identifier Type) + -- copy rule (up) + _lhsOtypeSigs = + ({-# LINE 528 "./src-ag/Order.ag" #-} + _tlItypeSigs + {-# LINE 5656 "dist/build/Order.hs" #-} + ) + -- copy rule (down) + _hdOtypeSigs = + ({-# LINE 528 "./src-ag/Order.ag" #-} + _lhsItypeSigs + {-# LINE 5662 "dist/build/Order.hs" #-} + ) + -- copy rule (chain) + _tlOtypeSigs = + ({-# LINE 528 "./src-ag/Order.ag" #-} + _hdItypeSigs + {-# LINE 5668 "dist/build/Order.hs" #-} + ) + ( _hdItypeSigs) = + hd_ _hdOtypeSigs + ( _tlItypeSigs) = + tl_ _tlOtypeSigs + in ( _lhsOtypeSigs)))) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (\ _lhsItypeSigs -> + (let _lhsOtypeSigs :: (Map Identifier Type) + -- copy rule (chain) + _lhsOtypeSigs = + ({-# LINE 528 "./src-ag/Order.ag" #-} + _lhsItypeSigs + {-# LINE 5683 "dist/build/Order.hs" #-} + ) + in ( _lhsOtypeSigs)))) diff --git a/dist/build/Patterns.hs b/dist/build/Patterns.hs new file mode 100644 --- /dev/null +++ b/dist/build/Patterns.hs @@ -0,0 +1,63 @@ + + +-- UUAGC 0.9.42.0 (src-ag/Patterns.ag) +module Patterns where +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 11 "dist/build/Patterns.hs" #-} +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : Pattern + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +data Pattern = Constr (ConstructorIdent) (Patterns) + | Product (Pos) (Patterns) + | Alias (Identifier) (Identifier) (Pattern) + | Irrefutable (Pattern) + | Underscore (Pos) + deriving ( Show) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : Patterns + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +type Patterns = [Pattern] diff --git a/dist/build/PrintCode.hs b/dist/build/PrintCode.hs new file mode 100644 --- /dev/null +++ b/dist/build/PrintCode.hs @@ -0,0 +1,4119 @@ +{-# OPTIONS_GHC -XBangPatterns #-} + +-- UUAGC 0.9.42.0 (src-ag/PrintCode.ag) +module PrintCode where +{-# LINE 10 "./src-ag/PrintCode.ag" #-} + +import Data.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 System.FilePath +import CommonTypes(BlockInfo, BlockKind(..), identifier) +{-# LINE 19 "dist/build/PrintCode.hs" #-} + +{-# LINE 2 "./src-ag/Code.ag" #-} + +import Pretty +import Patterns +import Data.List(partition) +import Data.Set(Set) +import qualified Data.Set as Set +import Data.Map(Map) +import qualified Data.Map as Map +{-# LINE 30 "dist/build/PrintCode.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 37 "dist/build/PrintCode.hs" #-} +{-# LINE 24 "./src-ag/PrintCode.ag" #-} + +type PP_Docs = [PP_Doc] +{-# LINE 41 "dist/build/PrintCode.hs" #-} + +{-# LINE 28 "./src-ag/PrintCode.ag" #-} + +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 +{-# LINE 54 "dist/build/PrintCode.hs" #-} + +{-# LINE 300 "./src-ag/PrintCode.ag" #-} + + +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 + +{-# LINE 67 "dist/build/PrintCode.hs" #-} + +{-# LINE 399 "./src-ag/PrintCode.ag" #-} + +locname' n = "_loc_" ++ getName n +{-# LINE 72 "dist/build/PrintCode.hs" #-} + +{-# LINE 473 "./src-ag/PrintCode.ag" #-} + +renderDocs :: [PP_Doc] -> String +renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) "" +{-# LINE 78 "dist/build/PrintCode.hs" #-} + +{-# LINE 521 "./src-ag/PrintCode.ag" #-} + +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 +{-# LINE 95 "dist/build/PrintCode.hs" #-} + +{-# LINE 146 "./src-ag/Code.ag" #-} + +-- 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 +{-# LINE 114 "dist/build/PrintCode.hs" #-} +-- 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 -> + Inh_CaseAlt -> + Syn_CaseAlt +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 (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 156 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 161 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 166 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 171 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 176 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 181 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (({-# LINE 422 "./src-ag/PrintCode.ag" #-} + False + {-# LINE 186 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOisDeclOfLet -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile) of + { ( !_exprIpp) -> + (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) of + { ( !_leftIpp) -> + (case (({-# LINE 219 "./src-ag/PrintCode.ag" #-} + ["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"] + {-# LINE 195 "dist/build/PrintCode.hs" #-} + )) 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 -> + Inh_CaseAlts -> + Syn_CaseAlts +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 (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 241 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 246 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 56 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 251 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 256 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 261 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 56 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 266 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOnested -> + (case (tl_ _tlOnested _tlOoptions _tlOoutputfile) of + { ( !_tlIpps) -> + (case (hd_ _hdOnested _hdOoptions _hdOoutputfile) of + { ( !_hdIpps) -> + (case (({-# LINE 69 "./src-ag/PrintCode.ag" #-} + _hdIpps ++ _tlIpps + {-# LINE 275 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }) }) }))) +sem_CaseAlts_Nil :: T_CaseAlts +sem_CaseAlts_Nil = + (T_CaseAlts (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 70 "./src-ag/PrintCode.ag" #-} + [] + {-# LINE 286 "dist/build/PrintCode.hs" #-} + )) 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 -> + Inh_Chunk -> + Syn_Chunk +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 (({-# LINE 44 "./src-ag/PrintCode.ag" #-} + if sepSemMods _lhsIoptions + then replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ "_" ++ name_) + else _lhsImainFile + {-# LINE 378 "dist/build/PrintCode.hs" #-} + )) of + { !_outputfile -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _outputfile + {-# LINE 383 "dist/build/PrintCode.hs" #-} + )) of + { !_semWrapperOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 388 "dist/build/PrintCode.hs" #-} + )) of + { !_semWrapperOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 393 "dist/build/PrintCode.hs" #-} + )) of + { !_semWrapperOnested -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 398 "dist/build/PrintCode.hs" #-} + )) of + { !_semWrapperOisDeclOfLet -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _outputfile + {-# LINE 403 "dist/build/PrintCode.hs" #-} + )) of + { !_semDomOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 408 "dist/build/PrintCode.hs" #-} + )) of + { !_semDomOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 413 "dist/build/PrintCode.hs" #-} + )) of + { !_semDomOnested -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 418 "dist/build/PrintCode.hs" #-} + )) of + { !_semDomOisDeclOfLet -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _outputfile + {-# LINE 423 "dist/build/PrintCode.hs" #-} + )) of + { !_dataDefOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 428 "dist/build/PrintCode.hs" #-} + )) of + { !_dataDefOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 433 "dist/build/PrintCode.hs" #-} + )) of + { !_dataDefOnested -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 438 "dist/build/PrintCode.hs" #-} + )) of + { !_dataDefOisDeclOfLet -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _outputfile + {-# LINE 443 "dist/build/PrintCode.hs" #-} + )) of + { !_commentOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 448 "dist/build/PrintCode.hs" #-} + )) of + { !_commentOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 453 "dist/build/PrintCode.hs" #-} + )) of + { !_commentOnested -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 458 "dist/build/PrintCode.hs" #-} + )) of + { !_commentOisDeclOfLet -> + (case (semWrapper_ _semWrapperOisDeclOfLet _semWrapperOnested _semWrapperOoptions _semWrapperOoutputfile) of + { ( !_semWrapperIpps) -> + (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 (({-# LINE 487 "./src-ag/PrintCode.ag" #-} + [ [_commentIpp] + , _dataDefIpps + , _semDomIpps + , if reference _lhsIoptions then _semWrapperIpps else [] + ] + {-# LINE 475 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOappendCommon -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _outputfile + {-# LINE 480 "dist/build/PrintCode.hs" #-} + )) of + { !_cataFunOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 485 "dist/build/PrintCode.hs" #-} + )) of + { !_cataFunOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 490 "dist/build/PrintCode.hs" #-} + )) of + { !_cataFunOnested -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 495 "dist/build/PrintCode.hs" #-} + )) of + { !_cataFunOisDeclOfLet -> + (case (cataFun_ _cataFunOisDeclOfLet _cataFunOnested _cataFunOoptions _cataFunOoutputfile) of + { ( !_cataFunIpps) -> + (case (({-# LINE 493 "./src-ag/PrintCode.ag" #-} + [ [_commentIpp] + , _cataFunIpps + , if reference _lhsIoptions then [] else _semWrapperIpps + ] + {-# LINE 505 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOappendMain -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _outputfile + {-# LINE 510 "dist/build/PrintCode.hs" #-} + )) of + { !_semFunctionsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 515 "dist/build/PrintCode.hs" #-} + )) of + { !_semFunctionsOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 520 "dist/build/PrintCode.hs" #-} + )) of + { !_semFunctionsOnested -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 525 "dist/build/PrintCode.hs" #-} + )) of + { !_semFunctionsOisDeclOfLet -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _outputfile + {-# LINE 530 "dist/build/PrintCode.hs" #-} + )) of + { !_infoOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 535 "dist/build/PrintCode.hs" #-} + )) of + { !_infoOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 540 "dist/build/PrintCode.hs" #-} + )) of + { !_infoOnested -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 545 "dist/build/PrintCode.hs" #-} + )) of + { !_infoOisDeclOfLet -> + (case (({-# LINE 519 "./src-ag/PrintCode.ag" #-} + concat $ intersperse "," semNames_ + {-# LINE 550 "dist/build/PrintCode.hs" #-} + )) of + { !_exports -> + (case (semFunctions_ _semFunctionsOisDeclOfLet _semFunctionsOnested _semFunctionsOoptions _semFunctionsOoutputfile) of + { ( !_semFunctionsIpps) -> + (case (info_ _infoOisDeclOfLet _infoOnested _infoOoptions _infoOoutputfile) of + { ( !_infoIpps) -> + (case (({-# LINE 503 "./src-ag/PrintCode.ag" #-} + 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 + ] + {-# LINE 570 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOgenSems -> + (case (({-# LINE 481 "./src-ag/PrintCode.ag" #-} + ["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"] + {-# LINE 575 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOimports -> + (case (({-# LINE 97 "./src-ag/PrintCode.ag" #-} + _commentIpp + : _infoIpps + ++ _dataDefIpps + ++ _cataFunIpps + ++ _semDomIpps + ++ _semWrapperIpps + ++ _semFunctionsIpps + ++ [Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap] + {-# LINE 587 "dist/build/PrintCode.hs" #-} + )) 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 -> + Inh_Chunks -> + Syn_Chunks +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 (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 661 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 666 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOnested -> + (case (({-# LINE 437 "./src-ag/PrintCode.ag" #-} + _lhsImainFile + {-# LINE 671 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOmainFile -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 676 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOisDeclOfLet -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 681 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 686 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOnested -> + (case (({-# LINE 437 "./src-ag/PrintCode.ag" #-} + _lhsImainFile + {-# LINE 691 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOmainFile -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 696 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOisDeclOfLet -> + (case (({-# LINE 434 "./src-ag/PrintCode.ag" #-} + _lhsItextBlocks + {-# LINE 701 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOtextBlocks -> + (case (({-# LINE 435 "./src-ag/PrintCode.ag" #-} + _lhsItextBlockMap + {-# LINE 706 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOtextBlockMap -> + (case (({-# LINE 433 "./src-ag/PrintCode.ag" #-} + _lhsIpragmaBlocks + {-# LINE 711 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOpragmaBlocks -> + (case (({-# LINE 436 "./src-ag/PrintCode.ag" #-} + _lhsIoptionsLine + {-# LINE 716 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOoptionsLine -> + (case (({-# LINE 439 "./src-ag/PrintCode.ag" #-} + _lhsImoduleHeader + {-# LINE 721 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOmoduleHeader -> + (case (({-# LINE 438 "./src-ag/PrintCode.ag" #-} + _lhsImainName + {-# LINE 726 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOmainName -> + (case (({-# LINE 432 "./src-ag/PrintCode.ag" #-} + _lhsIimportBlocks + {-# LINE 731 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOimportBlocks -> + (case (tl_ _tlOimportBlocks _tlOisDeclOfLet _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnested _tlOoptions _tlOoptionsLine _tlOpragmaBlocks _tlOtextBlockMap _tlOtextBlocks) of + { ( !_tlIappendCommon,!_tlIappendMain,!_tlIgenSems,!_tlIimports,!_tlIpps) -> + (case (({-# LINE 434 "./src-ag/PrintCode.ag" #-} + _lhsItextBlocks + {-# LINE 738 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOtextBlocks -> + (case (({-# LINE 435 "./src-ag/PrintCode.ag" #-} + _lhsItextBlockMap + {-# LINE 743 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOtextBlockMap -> + (case (({-# LINE 433 "./src-ag/PrintCode.ag" #-} + _lhsIpragmaBlocks + {-# LINE 748 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOpragmaBlocks -> + (case (({-# LINE 436 "./src-ag/PrintCode.ag" #-} + _lhsIoptionsLine + {-# LINE 753 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOoptionsLine -> + (case (({-# LINE 439 "./src-ag/PrintCode.ag" #-} + _lhsImoduleHeader + {-# LINE 758 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOmoduleHeader -> + (case (({-# LINE 438 "./src-ag/PrintCode.ag" #-} + _lhsImainName + {-# LINE 763 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOmainName -> + (case (({-# LINE 432 "./src-ag/PrintCode.ag" #-} + _lhsIimportBlocks + {-# LINE 768 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOimportBlocks -> + (case (hd_ _hdOimportBlocks _hdOisDeclOfLet _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnested _hdOoptions _hdOoptionsLine _hdOpragmaBlocks _hdOtextBlockMap _hdOtextBlocks) of + { ( !_hdIappendCommon,!_hdIappendMain,!_hdIgenSems,!_hdIimports,!_hdIpps) -> + (case (({-# LINE 483 "./src-ag/PrintCode.ag" #-} + _hdIappendCommon ++ _tlIappendCommon + {-# LINE 775 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOappendCommon -> + (case (({-# LINE 483 "./src-ag/PrintCode.ag" #-} + _hdIappendMain ++ _tlIappendMain + {-# LINE 780 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOappendMain -> + (case (({-# LINE 499 "./src-ag/PrintCode.ag" #-} + _hdIgenSems >> _tlIgenSems + {-# LINE 785 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOgenSems -> + (case (({-# LINE 478 "./src-ag/PrintCode.ag" #-} + _hdIimports ++ _tlIimports + {-# LINE 790 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOimports -> + (case (({-# LINE 89 "./src-ag/PrintCode.ag" #-} + _hdIpps ++ _tlIpps + {-# LINE 795 "dist/build/PrintCode.hs" #-} + )) 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 (({-# LINE 483 "./src-ag/PrintCode.ag" #-} + [] + {-# LINE 814 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOappendCommon -> + (case (({-# LINE 483 "./src-ag/PrintCode.ag" #-} + [] + {-# LINE 819 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOappendMain -> + (case (({-# LINE 499 "./src-ag/PrintCode.ag" #-} + return () + {-# LINE 824 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOgenSems -> + (case (({-# LINE 478 "./src-ag/PrintCode.ag" #-} + [] + {-# LINE 829 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOimports -> + (case (({-# LINE 90 "./src-ag/PrintCode.ag" #-} + [] + {-# LINE 834 "dist/build/PrintCode.hs" #-} + )) 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 : Types + alternative Record: + child name : {String} + child args : NamedTypes +-} +-- cata +sem_DataAlt :: DataAlt -> + T_DataAlt +sem_DataAlt !(DataAlt _name _args) = + (sem_DataAlt_DataAlt _name (sem_Types _args)) +sem_DataAlt !(Record _name _args) = + (sem_DataAlt_Record _name (sem_NamedTypes _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 -> + Inh_DataAlt -> + Syn_DataAlt +wrap_DataAlt !(T_DataAlt sem) !(Inh_DataAlt _lhsInested _lhsIstrictPre) = + (let ( !_lhsOpp) = sem _lhsInested _lhsIstrictPre + in (Syn_DataAlt _lhsOpp)) +sem_DataAlt_DataAlt :: String -> + T_Types -> + T_DataAlt +sem_DataAlt_DataAlt !name_ !(T_Types args_) = + (T_DataAlt (\ (!_lhsInested) + (!_lhsIstrictPre) -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 881 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (args_ _argsOnested) of + { ( !_argsIpps) -> + (case (({-# LINE 222 "./src-ag/PrintCode.ag" #-} + name_ >#< hv_sp (map ((_lhsIstrictPre >|<) . pp_parens) _argsIpps) + {-# LINE 888 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_DataAlt_Record :: String -> + T_NamedTypes -> + T_DataAlt +sem_DataAlt_Record !name_ !(T_NamedTypes args_) = + (T_DataAlt (\ (!_lhsInested) + (!_lhsIstrictPre) -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 900 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (args_ _argsOnested) of + { ( !_argsIpps) -> + (case (({-# LINE 223 "./src-ag/PrintCode.ag" #-} + name_ >#< pp_block "{" "}" "," _argsIpps + {-# LINE 907 "dist/build/PrintCode.hs" #-} + )) 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 -> + Inh_DataAlts -> + Syn_DataAlts +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 (({-# LINE 317 "./src-ag/PrintCode.ag" #-} + _lhsIstrictPre + {-# LINE 950 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOstrictPre -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 955 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOnested -> + (case (({-# LINE 317 "./src-ag/PrintCode.ag" #-} + _lhsIstrictPre + {-# LINE 960 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOstrictPre -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 965 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOnested -> + (case (tl_ _tlOnested _tlOstrictPre) of + { ( !_tlIpps) -> + (case (hd_ _hdOnested _hdOstrictPre) of + { ( !_hdIpp) -> + (case (({-# LINE 73 "./src-ag/PrintCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 974 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }))) +sem_DataAlts_Nil :: T_DataAlts +sem_DataAlts_Nil = + (T_DataAlts (\ (!_lhsInested) + (!_lhsIstrictPre) -> + (case (({-# LINE 74 "./src-ag/PrintCode.ag" #-} + [] + {-# LINE 984 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }))) +-- Decl -------------------------------------------------------- +{- + visit 0: + inherited attributes: + isDeclOfLet : Bool + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Decl: + child left : Lhs + child rhs : Expr + child binds : {Set String} + child uses : {Set String} + alternative Bind: + child left : Lhs + child rhs : Expr + alternative BindLet: + child left : Lhs + child rhs : Expr + alternative Data: + child name : {String} + child params : {[String]} + child alts : DataAlts + child strict : {Bool} + child derivings : {[String]} + alternative NewType: + child name : {String} + child params : {[String]} + child con : {String} + child tp : Type + alternative Type: + child name : {String} + child params : {[String]} + child tp : Type + alternative TSig: + child name : {String} + child tp : Type + alternative Comment: + child txt : {String} + alternative PragmaDecl: + child txt : {String} + alternative Resume: + child monadic : {Bool} + child nt : {String} + child left : Lhs + child rhs : Expr + alternative EvalDecl: + child nt : {String} + child left : Lhs + child rhs : Expr + visit 0: + local strat : _ +-} +-- cata +sem_Decl :: Decl -> + T_Decl +sem_Decl !(Decl _left _rhs _binds _uses) = + (sem_Decl_Decl (sem_Lhs _left) (sem_Expr _rhs) _binds _uses) +sem_Decl !(Bind _left _rhs) = + (sem_Decl_Bind (sem_Lhs _left) (sem_Expr _rhs)) +sem_Decl !(BindLet _left _rhs) = + (sem_Decl_BindLet (sem_Lhs _left) (sem_Expr _rhs)) +sem_Decl !(Data _name _params _alts _strict _derivings) = + (sem_Decl_Data _name _params (sem_DataAlts _alts) _strict _derivings) +sem_Decl !(NewType _name _params _con _tp) = + (sem_Decl_NewType _name _params _con (sem_Type _tp)) +sem_Decl !(Type _name _params _tp) = + (sem_Decl_Type _name _params (sem_Type _tp)) +sem_Decl !(TSig _name _tp) = + (sem_Decl_TSig _name (sem_Type _tp)) +sem_Decl !(Comment _txt) = + (sem_Decl_Comment _txt) +sem_Decl !(PragmaDecl _txt) = + (sem_Decl_PragmaDecl _txt) +sem_Decl !(Resume _monadic _nt _left _rhs) = + (sem_Decl_Resume _monadic _nt (sem_Lhs _left) (sem_Expr _rhs)) +sem_Decl !(EvalDecl _nt _left _rhs) = + (sem_Decl_EvalDecl _nt (sem_Lhs _left) (sem_Expr _rhs)) +-- 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 -> + Inh_Decl -> + Syn_Decl +wrap_Decl !(T_Decl sem) !(Inh_Decl _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = + (let ( !_lhsOpp) = sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile + in (Syn_Decl _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 (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1095 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1100 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1105 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1110 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1115 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1120 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 1125 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOisDeclOfLet -> + (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile) of + { ( !_rhsIpp) -> + (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) of + { ( !_leftIpp) -> + (case (({-# LINE 107 "./src-ag/PrintCode.ag" #-} + _leftIpp >#< "=" + >-< indent 4 _rhsIpp + {-# LINE 1135 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) }))) +sem_Decl_Bind :: T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_Bind !(T_Lhs left_) !(T_Expr rhs_) = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1149 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1154 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1159 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1164 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1169 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1174 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 1179 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOisDeclOfLet -> + (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile) of + { ( !_rhsIpp) -> + (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) of + { ( !_leftIpp) -> + (case (({-# LINE 109 "./src-ag/PrintCode.ag" #-} + _leftIpp >#< "<-" >#< _rhsIpp + {-# LINE 1188 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) }))) +sem_Decl_BindLet :: T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_BindLet !(T_Lhs left_) !(T_Expr rhs_) = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1202 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1207 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1212 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1217 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1222 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1227 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 1232 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOisDeclOfLet -> + (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile) of + { ( !_rhsIpp) -> + (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) of + { ( !_leftIpp) -> + (case (({-# LINE 110 "./src-ag/PrintCode.ag" #-} + "let" >#< _leftIpp >#< "=" >#< _rhsIpp + {-# LINE 1241 "dist/build/PrintCode.hs" #-} + )) 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 (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1258 "dist/build/PrintCode.hs" #-} + )) of + { !_altsOnested -> + (case (({-# LINE 320 "./src-ag/PrintCode.ag" #-} + if strict_ then pp "!" else empty + {-# LINE 1263 "dist/build/PrintCode.hs" #-} + )) of + { !_altsOstrictPre -> + (case (alts_ _altsOnested _altsOstrictPre) of + { ( !_altsIpps) -> + (case (({-# LINE 111 "./src-ag/PrintCode.ag" #-} + "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_) + ) + {-# LINE 1278 "dist/build/PrintCode.hs" #-} + )) 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 (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1294 "dist/build/PrintCode.hs" #-} + )) of + { !_tpOnested -> + (case (tp_ _tpOnested) of + { ( !_tpIpp,!_tpIprec) -> + (case (({-# LINE 120 "./src-ag/PrintCode.ag" #-} + "newtype" >#< hv_sp (name_ : params_) >#< "=" >#< con_ >#< pp_parens _tpIpp + {-# LINE 1301 "dist/build/PrintCode.hs" #-} + )) 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 (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1316 "dist/build/PrintCode.hs" #-} + )) of + { !_tpOnested -> + (case (tp_ _tpOnested) of + { ( !_tpIpp,!_tpIprec) -> + (case (({-# LINE 121 "./src-ag/PrintCode.ag" #-} + "type" >#< hv_sp (name_ : params_) >#< "=" >#< _tpIpp + {-# LINE 1323 "dist/build/PrintCode.hs" #-} + )) 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 (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1337 "dist/build/PrintCode.hs" #-} + )) of + { !_tpOnested -> + (case (tp_ _tpOnested) of + { ( !_tpIpp,!_tpIprec) -> + (case (({-# LINE 122 "./src-ag/PrintCode.ag" #-} + name_ >#< "::" >#< _tpIpp + {-# LINE 1344 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_Decl_Comment :: String -> + T_Decl +sem_Decl_Comment !txt_ = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 123 "./src-ag/PrintCode.ag" #-} + if '\n' `elem` txt_ + then "{-" >-< vlist (lines txt_) >-< "-}" + else "--" >#< txt_ + {-# LINE 1359 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Decl_PragmaDecl :: String -> + T_Decl +sem_Decl_PragmaDecl !txt_ = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 126 "./src-ag/PrintCode.ag" #-} + "{-#" >#< text txt_ >#< "#-}" + {-# LINE 1372 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Decl_Resume :: Bool -> + String -> + T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_Resume !monadic_ !nt_ !(T_Lhs left_) !(T_Expr rhs_) = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1388 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1393 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1398 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1403 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1408 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1413 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 1418 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOisDeclOfLet -> + (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile) of + { ( !_rhsIpp) -> + (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) of + { ( !_leftIpp) -> + (case (({-# LINE 127 "./src-ag/PrintCode.ag" #-} + if monadic_ + then _leftIpp >#< "<-" >#< _rhsIpp + else _leftIpp >#< "=" >-< indent 4 _rhsIpp + {-# LINE 1429 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) }))) +sem_Decl_EvalDecl :: String -> + T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_EvalDecl !nt_ !(T_Lhs left_) !(T_Expr rhs_) = + (T_Decl (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1444 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1449 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1454 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1459 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1464 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1469 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 1474 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOisDeclOfLet -> + (case (({-# LINE 130 "./src-ag/PrintCode.ag" #-} + if breadthFirstStrict _lhsIoptions + then "stepwiseEval" + else "lazyEval" + {-# LINE 1481 "dist/build/PrintCode.hs" #-} + )) of + { !_strat -> + (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile) of + { ( !_rhsIpp) -> + (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) of + { ( !_leftIpp) -> + (case (({-# LINE 133 "./src-ag/PrintCode.ag" #-} + if breadthFirst _lhsIoptions + then _leftIpp >#< "=" >#< "case" >#< _strat >#< pp_parens _rhsIpp >#< "of" + >-< indent 4 ( + pp_parens (nt_ >|< "_Syn" >#< "_val") >#< "-> _val" + ) + else _leftIpp >#< "=" >#< _rhsIpp + {-# LINE 1495 "dist/build/PrintCode.hs" #-} + )) 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 -> + Inh_Decls -> + Syn_Decls +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 (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1544 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1549 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1554 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOnested -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 1559 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOisDeclOfLet -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1564 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1569 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1574 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOnested -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 1579 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOisDeclOfLet -> + (case (tl_ _tlOisDeclOfLet _tlOnested _tlOoptions _tlOoutputfile) of + { ( !_tlIpps) -> + (case (hd_ _hdOisDeclOfLet _hdOnested _hdOoptions _hdOoutputfile) of + { ( !_hdIpp) -> + (case (({-# LINE 85 "./src-ag/PrintCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 1588 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }) }) }) }) }))) +sem_Decls_Nil :: T_Decls +sem_Decls_Nil = + (T_Decls (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 86 "./src-ag/PrintCode.ag" #-} + [] + {-# LINE 1600 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }))) +-- Expr -------------------------------------------------------- +{- + visit 0: + inherited attributes: + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Let: + child decls : Decls + child body : Expr + alternative Case: + child expr : Expr + child alts : CaseAlts + alternative Do: + child stmts : Decls + child body : Expr + alternative Lambda: + child args : Exprs + child body : Expr + visit 0: + local addBang : _ + local strictParams : _ + alternative TupleExpr: + child exprs : Exprs + alternative UnboxedTupleExpr: + child exprs : Exprs + alternative App: + child name : {String} + child args : Exprs + alternative SimpleExpr: + child txt : {String} + alternative TextExpr: + child lns : {[String]} + alternative Trace: + child txt : {String} + child expr : Expr + alternative PragmaExpr: + child onLeftSide : {Bool} + child onNewLine : {Bool} + child txt : {String} + child expr : Expr + alternative LineExpr: + child expr : Expr + alternative TypedExpr: + child expr : Expr + child tp : Type + alternative ResultExpr: + child nt : {String} + child expr : Expr + alternative InvokeExpr: + child nt : {String} + child expr : Expr + child args : Exprs + alternative ResumeExpr: + child nt : {String} + child expr : Expr + child left : Lhs + child rhs : Expr + alternative SemFun: + child nt : {String} + child args : Exprs + child body : Expr + visit 0: + local addBang : _ + local strictParams : _ +-} +-- cata +sem_Expr :: Expr -> + T_Expr +sem_Expr !(Let _decls _body) = + (sem_Expr_Let (sem_Decls _decls) (sem_Expr _body)) +sem_Expr !(Case _expr _alts) = + (sem_Expr_Case (sem_Expr _expr) (sem_CaseAlts _alts)) +sem_Expr !(Do _stmts _body) = + (sem_Expr_Do (sem_Decls _stmts) (sem_Expr _body)) +sem_Expr !(Lambda _args _body) = + (sem_Expr_Lambda (sem_Exprs _args) (sem_Expr _body)) +sem_Expr !(TupleExpr _exprs) = + (sem_Expr_TupleExpr (sem_Exprs _exprs)) +sem_Expr !(UnboxedTupleExpr _exprs) = + (sem_Expr_UnboxedTupleExpr (sem_Exprs _exprs)) +sem_Expr !(App _name _args) = + (sem_Expr_App _name (sem_Exprs _args)) +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 !(PragmaExpr _onLeftSide _onNewLine _txt _expr) = + (sem_Expr_PragmaExpr _onLeftSide _onNewLine _txt (sem_Expr _expr)) +sem_Expr !(LineExpr _expr) = + (sem_Expr_LineExpr (sem_Expr _expr)) +sem_Expr !(TypedExpr _expr _tp) = + (sem_Expr_TypedExpr (sem_Expr _expr) (sem_Type _tp)) +sem_Expr !(ResultExpr _nt _expr) = + (sem_Expr_ResultExpr _nt (sem_Expr _expr)) +sem_Expr !(InvokeExpr _nt _expr _args) = + (sem_Expr_InvokeExpr _nt (sem_Expr _expr) (sem_Exprs _args)) +sem_Expr !(ResumeExpr _nt _expr _left _rhs) = + (sem_Expr_ResumeExpr _nt (sem_Expr _expr) (sem_Lhs _left) (sem_Expr _rhs)) +sem_Expr !(SemFun _nt _args _body) = + (sem_Expr_SemFun _nt (sem_Exprs _args) (sem_Expr _body)) +-- 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 -> + Inh_Expr -> + Syn_Expr +wrap_Expr !(T_Expr sem) !(Inh_Expr _lhsInested _lhsIoptions _lhsIoutputfile) = + (let ( !_lhsOpp) = sem _lhsInested _lhsIoptions _lhsIoutputfile + in (Syn_Expr _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 (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1732 "dist/build/PrintCode.hs" #-} + )) of + { !_bodyOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1737 "dist/build/PrintCode.hs" #-} + )) of + { !_bodyOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1742 "dist/build/PrintCode.hs" #-} + )) of + { !_bodyOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1747 "dist/build/PrintCode.hs" #-} + )) of + { !_declsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1752 "dist/build/PrintCode.hs" #-} + )) of + { !_declsOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1757 "dist/build/PrintCode.hs" #-} + )) of + { !_declsOnested -> + (case (({-# LINE 414 "./src-ag/PrintCode.ag" #-} + True + {-# LINE 1762 "dist/build/PrintCode.hs" #-} + )) of + { !_declsOisDeclOfLet -> + (case (body_ _bodyOnested _bodyOoptions _bodyOoutputfile) of + { ( !_bodyIpp) -> + (case (decls_ _declsOisDeclOfLet _declsOnested _declsOoptions _declsOoutputfile) of + { ( !_declsIpps) -> + (case (({-# LINE 141 "./src-ag/PrintCode.ag" #-} + pp_parens ( "let" >#< (vlist _declsIpps) + >-< "in " >#< _bodyIpp + ) + {-# LINE 1773 "dist/build/PrintCode.hs" #-} + )) 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 (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1786 "dist/build/PrintCode.hs" #-} + )) of + { !_altsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1791 "dist/build/PrintCode.hs" #-} + )) of + { !_altsOoptions -> + (case (({-# LINE 56 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1796 "dist/build/PrintCode.hs" #-} + )) of + { !_altsOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1801 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1806 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1811 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (alts_ _altsOnested _altsOoptions _altsOoutputfile) of + { ( !_altsIpps) -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile) of + { ( !_exprIpp) -> + (case (({-# LINE 144 "./src-ag/PrintCode.ag" #-} + pp_parens ( "case" >#< pp_parens _exprIpp >#< "of" + >-< (vlist _altsIpps) + ) + {-# LINE 1822 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }))) +sem_Expr_Do :: T_Decls -> + T_Expr -> + T_Expr +sem_Expr_Do !(T_Decls stmts_) !(T_Expr body_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1835 "dist/build/PrintCode.hs" #-} + )) of + { !_bodyOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1840 "dist/build/PrintCode.hs" #-} + )) of + { !_bodyOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1845 "dist/build/PrintCode.hs" #-} + )) of + { !_bodyOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1850 "dist/build/PrintCode.hs" #-} + )) of + { !_stmtsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1855 "dist/build/PrintCode.hs" #-} + )) of + { !_stmtsOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1860 "dist/build/PrintCode.hs" #-} + )) of + { !_stmtsOnested -> + (case (({-# LINE 416 "./src-ag/PrintCode.ag" #-} + False + {-# LINE 1865 "dist/build/PrintCode.hs" #-} + )) of + { !_stmtsOisDeclOfLet -> + (case (body_ _bodyOnested _bodyOoptions _bodyOoutputfile) of + { ( !_bodyIpp) -> + (case (stmts_ _stmtsOisDeclOfLet _stmtsOnested _stmtsOoptions _stmtsOoutputfile) of + { ( !_stmtsIpps) -> + (case (({-# LINE 147 "./src-ag/PrintCode.ag" #-} + pp_parens ( "do" >#< ( vlist _stmtsIpps + >-< ("return" >#< _bodyIpp)) + ) + {-# LINE 1876 "dist/build/PrintCode.hs" #-} + )) 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 (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1889 "dist/build/PrintCode.hs" #-} + )) of + { !_bodyOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1894 "dist/build/PrintCode.hs" #-} + )) of + { !_bodyOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1899 "dist/build/PrintCode.hs" #-} + )) of + { !_bodyOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1904 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1909 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1914 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (({-# LINE 153 "./src-ag/PrintCode.ag" #-} + if bangpats _lhsIoptions + then \p -> pp_parens ("!" >|< p) + else id + {-# LINE 1921 "dist/build/PrintCode.hs" #-} + )) of + { !_addBang -> + (case (args_ _argsOnested _argsOoptions _argsOoutputfile) of + { ( !_argsIpps) -> + (case (({-# LINE 150 "./src-ag/PrintCode.ag" #-} + if strictSems _lhsIoptions + then _argsIpps + else [] + {-# LINE 1930 "dist/build/PrintCode.hs" #-} + )) of + { !_strictParams -> + (case (body_ _bodyOnested _bodyOoptions _bodyOoutputfile) of + { ( !_bodyIpp) -> + (case (({-# LINE 156 "./src-ag/PrintCode.ag" #-} + pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->" + >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp) + ) + {-# LINE 1939 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) }) }))) +sem_Expr_TupleExpr :: T_Exprs -> + T_Expr +sem_Expr_TupleExpr !(T_Exprs exprs_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1951 "dist/build/PrintCode.hs" #-} + )) of + { !_exprsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1956 "dist/build/PrintCode.hs" #-} + )) of + { !_exprsOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1961 "dist/build/PrintCode.hs" #-} + )) of + { !_exprsOnested -> + (case (exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile) of + { ( !_exprsIpps) -> + (case (({-# LINE 159 "./src-ag/PrintCode.ag" #-} + ppTuple _lhsInested _exprsIpps + {-# LINE 1968 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Expr_UnboxedTupleExpr :: T_Exprs -> + T_Expr +sem_Expr_UnboxedTupleExpr !(T_Exprs exprs_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 1980 "dist/build/PrintCode.hs" #-} + )) of + { !_exprsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 1985 "dist/build/PrintCode.hs" #-} + )) of + { !_exprsOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 1990 "dist/build/PrintCode.hs" #-} + )) of + { !_exprsOnested -> + (case (exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile) of + { ( !_exprsIpps) -> + (case (({-# LINE 160 "./src-ag/PrintCode.ag" #-} + ppUnboxedTuple _lhsInested _exprsIpps + {-# LINE 1997 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Expr_App :: String -> + T_Exprs -> + T_Expr +sem_Expr_App !name_ !(T_Exprs args_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2010 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2015 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2020 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (args_ _argsOnested _argsOoptions _argsOoutputfile) of + { ( !_argsIpps) -> + (case (({-# LINE 161 "./src-ag/PrintCode.ag" #-} + pp_parens $ name_ >#< hv_sp _argsIpps + {-# LINE 2027 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Expr_SimpleExpr :: String -> + T_Expr +sem_Expr_SimpleExpr !txt_ = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 162 "./src-ag/PrintCode.ag" #-} + text txt_ + {-# LINE 2039 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Expr_TextExpr :: ([String]) -> + T_Expr +sem_Expr_TextExpr !lns_ = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 163 "./src-ag/PrintCode.ag" #-} + vlist (map text lns_) + {-# LINE 2051 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Expr_Trace :: String -> + T_Expr -> + T_Expr +sem_Expr_Trace !txt_ !(T_Expr expr_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2064 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2069 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2074 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile) of + { ( !_exprIpp) -> + (case (({-# LINE 164 "./src-ag/PrintCode.ag" #-} + "trace" >#< ( pp_parens ("\"" >|< text txt_ >|< "\"") + >-< pp_parens _exprIpp + ) + {-# LINE 2083 "dist/build/PrintCode.hs" #-} + )) 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 (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2098 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2103 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2108 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile) of + { ( !_exprIpp) -> + (case (({-# LINE 167 "./src-ag/PrintCode.ag" #-} + 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 pp_parens (pragmaDoc `leftOp` _exprIpp `rightOp` pragmaDoc) + {-# LINE 2125 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Expr_LineExpr :: T_Expr -> + T_Expr +sem_Expr_LineExpr !(T_Expr expr_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2137 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2142 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2147 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile) of + { ( !_exprIpp) -> + (case (({-# LINE 178 "./src-ag/PrintCode.ag" #-} + _exprIpp >-< "{-# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show _lhsIoutputfile >#< "#-}" + >-< "" + {-# LINE 2155 "dist/build/PrintCode.hs" #-} + )) 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 (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2168 "dist/build/PrintCode.hs" #-} + )) of + { !_tpOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2173 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2178 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2183 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (tp_ _tpOnested) of + { ( !_tpIpp,!_tpIprec) -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile) of + { ( !_exprIpp) -> + (case (({-# LINE 180 "./src-ag/PrintCode.ag" #-} + pp_parens (_exprIpp >#< "::" >#< _tpIpp) + {-# LINE 2192 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }))) +sem_Expr_ResultExpr :: String -> + T_Expr -> + T_Expr +sem_Expr_ResultExpr !nt_ !(T_Expr expr_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2205 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2210 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2215 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile) of + { ( !_exprIpp) -> + (case (({-# LINE 181 "./src-ag/PrintCode.ag" #-} + if breadthFirst _lhsIoptions + then "final" >#< + pp_parens (nt_ >|< "_Syn" >#< pp_parens _exprIpp) + else _exprIpp + {-# LINE 2225 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Expr_InvokeExpr :: String -> + T_Expr -> + T_Exprs -> + T_Expr +sem_Expr_InvokeExpr !nt_ !(T_Expr expr_) !(T_Exprs args_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2239 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2244 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2249 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2254 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2259 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2264 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (args_ _argsOnested _argsOoptions _argsOoutputfile) of + { ( !_argsIpps) -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile) of + { ( !_exprIpp) -> + (case (({-# LINE 185 "./src-ag/PrintCode.ag" #-} + if breadthFirst _lhsIoptions + then "invoke" >#< pp_parens _exprIpp >#< pp_parens ( + nt_ >|< "_Inh" >#< pp_parens (ppTuple False _argsIpps)) + else _exprIpp >#< hv_sp _argsIpps + {-# LINE 2276 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }))) +sem_Expr_ResumeExpr :: String -> + T_Expr -> + T_Lhs -> + T_Expr -> + T_Expr +sem_Expr_ResumeExpr !nt_ !(T_Expr expr_) !(T_Lhs left_) !(T_Expr rhs_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2291 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2296 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2301 "dist/build/PrintCode.hs" #-} + )) of + { !_rhsOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2306 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2311 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2316 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2321 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2326 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2331 "dist/build/PrintCode.hs" #-} + )) of + { !_exprOnested -> + (case (({-# LINE 418 "./src-ag/PrintCode.ag" #-} + False + {-# LINE 2336 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOisDeclOfLet -> + (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile) of + { ( !_rhsIpp) -> + (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) of + { ( !_leftIpp) -> + (case (expr_ _exprOnested _exprOoptions _exprOoutputfile) of + { ( !_exprIpp) -> + (case (({-# LINE 189 "./src-ag/PrintCode.ag" #-} + if breadthFirst _lhsIoptions + then pp_parens ("resume" >#< pp_parens _exprIpp + >-< indent 2 (pp_parens ( "\\" >|< + pp_parens ("~" >|< pp_parens (nt_ >|< "_Syn" >#< "_inh_arg")) + >#< "->" + >-< indent 2 ( "let" >#< _leftIpp >#< "= _inh_arg" + >-< indent 2 ("in" >#< _rhsIpp) + )))) + else pp_parens ( "case" >#< pp_parens _exprIpp >#< "of" + >-< ("{" >#< _leftIpp >#< "->") + >-< indent 4 (_rhsIpp >#< "}") + ) + {-# LINE 2358 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Expr_SemFun :: String -> + T_Exprs -> + T_Expr -> + T_Expr +sem_Expr_SemFun !nt_ !(T_Exprs args_) !(T_Expr body_) = + (T_Expr (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2372 "dist/build/PrintCode.hs" #-} + )) of + { !_bodyOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2377 "dist/build/PrintCode.hs" #-} + )) of + { !_bodyOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2382 "dist/build/PrintCode.hs" #-} + )) of + { !_bodyOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2387 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2392 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2397 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (({-# LINE 204 "./src-ag/PrintCode.ag" #-} + if bangpats _lhsIoptions + then \p -> pp_parens ("!" >|< p) + else id + {-# LINE 2404 "dist/build/PrintCode.hs" #-} + )) of + { !_addBang -> + (case (args_ _argsOnested _argsOoptions _argsOoutputfile) of + { ( !_argsIpps) -> + (case (({-# LINE 201 "./src-ag/PrintCode.ag" #-} + if strictSems _lhsIoptions + then _argsIpps + else [] + {-# LINE 2413 "dist/build/PrintCode.hs" #-} + )) of + { !_strictParams -> + (case (body_ _bodyOnested _bodyOoptions _bodyOoutputfile) of + { ( !_bodyIpp) -> + (case (({-# LINE 207 "./src-ag/PrintCode.ag" #-} + if breadthFirst _lhsIoptions + then "Child" >#< pp_parens ( "\\" >|< + pp_parens (nt_ >|< "_Inh" >#< + ppTuple False (map _addBang _argsIpps)) >#< "->" + >-< indent 2 (_strictParams `ppMultiSeqV` _bodyIpp)) + else if null _argsIpps + then _bodyIpp + else pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->" + >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp) + ) + {-# LINE 2429 "dist/build/PrintCode.hs" #-} + )) 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 -> + Inh_Exprs -> + Syn_Exprs +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 (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2475 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2480 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2485 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOnested -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2490 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2495 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2500 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOnested -> + (case (tl_ _tlOnested _tlOoptions _tlOoutputfile) of + { ( !_tlIpps) -> + (case (hd_ _hdOnested _hdOoptions _hdOoutputfile) of + { ( !_hdIpp) -> + (case (({-# LINE 65 "./src-ag/PrintCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 2509 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }) }) }))) +sem_Exprs_Nil :: T_Exprs +sem_Exprs_Nil = + (T_Exprs (\ (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 66 "./src-ag/PrintCode.ag" #-} + [] + {-# LINE 2520 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }))) +-- Lhs --------------------------------------------------------- +{- + visit 0: + inherited attributes: + isDeclOfLet : Bool + nested : Bool + options : Options + outputfile : String + synthesized attribute: + pp : PP_Doc + alternatives: + 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 : _ + alternative Fun: + child name : {String} + child args : Exprs + visit 0: + local addBang : _ + local strictGuard : _ + local hasStrictVars : _ + local addStrictGuard : _ + alternative Unwrap: + child name : {String} + child sub : Lhs +-} +-- cata +sem_Lhs :: Lhs -> + T_Lhs +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) +sem_Lhs !(Fun _name _args) = + (sem_Lhs_Fun _name (sem_Exprs _args)) +sem_Lhs !(Unwrap _name _sub) = + (sem_Lhs_Unwrap _name (sem_Lhs _sub)) +-- 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 -> + Inh_Lhs -> + Syn_Lhs +wrap_Lhs !(T_Lhs sem) !(Inh_Lhs _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = + (let ( !_lhsOpp) = sem _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile + in (Syn_Lhs _lhsOpp)) +sem_Lhs_Pattern3 :: T_Pattern -> + T_Lhs +sem_Lhs_Pattern3 !(T_Pattern pat3_) = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2607 "dist/build/PrintCode.hs" #-} + )) of + { !_pat3Ooptions -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 2612 "dist/build/PrintCode.hs" #-} + )) of + { !_pat3OisDeclOfLet -> + (case (({-# LINE 380 "./src-ag/PrintCode.ag" #-} + False + {-# LINE 2617 "dist/build/PrintCode.hs" #-} + )) of + { !_pat3ObelowIrrefutable -> + (case (pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions) of + { ( !_pat3Icopy,!_pat3IisUnderscore,!_pat3Ipp,!_pat3Ipp',!_pat3IstrictVars) -> + (case (({-# LINE 235 "./src-ag/PrintCode.ag" #-} + not (null _pat3IstrictVars) + {-# LINE 2624 "dist/build/PrintCode.hs" #-} + )) of + { !_hasStrictVars -> + (case (({-# LINE 234 "./src-ag/PrintCode.ag" #-} + _pat3IstrictVars `ppMultiSeqH` (pp "True") + {-# LINE 2629 "dist/build/PrintCode.hs" #-} + )) of + { !_strictGuard -> + (case (({-# LINE 232 "./src-ag/PrintCode.ag" #-} + if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id + {-# LINE 2634 "dist/build/PrintCode.hs" #-} + )) of + { !_addStrictGuard -> + (case (({-# LINE 252 "./src-ag/PrintCode.ag" #-} + _addStrictGuard _pat3Ipp + {-# LINE 2639 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }))) +sem_Lhs_Pattern3SM :: T_Pattern -> + T_Lhs +sem_Lhs_Pattern3SM !(T_Pattern pat3_) = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2652 "dist/build/PrintCode.hs" #-} + )) of + { !_pat3Ooptions -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 2657 "dist/build/PrintCode.hs" #-} + )) of + { !_pat3OisDeclOfLet -> + (case (({-# LINE 380 "./src-ag/PrintCode.ag" #-} + False + {-# LINE 2662 "dist/build/PrintCode.hs" #-} + )) of + { !_pat3ObelowIrrefutable -> + (case (pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions) of + { ( !_pat3Icopy,!_pat3IisUnderscore,!_pat3Ipp,!_pat3Ipp',!_pat3IstrictVars) -> + (case (({-# LINE 253 "./src-ag/PrintCode.ag" #-} + _pat3Ipp' + {-# LINE 2669 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Lhs_TupleLhs :: ([String]) -> + T_Lhs +sem_Lhs_TupleLhs !comps_ = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 248 "./src-ag/PrintCode.ag" #-} + if bangpats _lhsIoptions + then \p -> "!" >|< p + else id + {-# LINE 2684 "dist/build/PrintCode.hs" #-} + )) of + { !_addBang -> + (case (({-# LINE 240 "./src-ag/PrintCode.ag" #-} + not (null comps_) + {-# LINE 2689 "dist/build/PrintCode.hs" #-} + )) of + { !_hasStrictVars -> + (case (({-# LINE 237 "./src-ag/PrintCode.ag" #-} + if stricterCases _lhsIoptions && not _lhsIisDeclOfLet + then map text comps_ `ppMultiSeqH` (pp "True") + else pp "True" + {-# LINE 2696 "dist/build/PrintCode.hs" #-} + )) of + { !_strictGuard -> + (case (({-# LINE 232 "./src-ag/PrintCode.ag" #-} + if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id + {-# LINE 2701 "dist/build/PrintCode.hs" #-} + )) of + { !_addStrictGuard -> + (case (({-# LINE 254 "./src-ag/PrintCode.ag" #-} + _addStrictGuard $ ppTuple _lhsInested (map (_addBang . text) comps_) + {-# LINE 2706 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Lhs_UnboxedTupleLhs :: ([String]) -> + T_Lhs +sem_Lhs_UnboxedTupleLhs !comps_ = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 248 "./src-ag/PrintCode.ag" #-} + if bangpats _lhsIoptions + then \p -> "!" >|< p + else id + {-# LINE 2721 "dist/build/PrintCode.hs" #-} + )) of + { !_addBang -> + (case (({-# LINE 240 "./src-ag/PrintCode.ag" #-} + not (null comps_) + {-# LINE 2726 "dist/build/PrintCode.hs" #-} + )) of + { !_hasStrictVars -> + (case (({-# LINE 237 "./src-ag/PrintCode.ag" #-} + if stricterCases _lhsIoptions && not _lhsIisDeclOfLet + then map text comps_ `ppMultiSeqH` (pp "True") + else pp "True" + {-# LINE 2733 "dist/build/PrintCode.hs" #-} + )) of + { !_strictGuard -> + (case (({-# LINE 232 "./src-ag/PrintCode.ag" #-} + if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id + {-# LINE 2738 "dist/build/PrintCode.hs" #-} + )) of + { !_addStrictGuard -> + (case (({-# LINE 255 "./src-ag/PrintCode.ag" #-} + _addStrictGuard $ ppUnboxedTuple _lhsInested (map (_addBang . text) comps_) + {-# LINE 2743 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Lhs_Fun :: String -> + T_Exprs -> + T_Lhs +sem_Lhs_Fun !name_ !(T_Exprs args_) = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2757 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2762 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOoptions -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2767 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (({-# LINE 248 "./src-ag/PrintCode.ag" #-} + if bangpats _lhsIoptions + then \p -> "!" >|< p + else id + {-# LINE 2774 "dist/build/PrintCode.hs" #-} + )) of + { !_addBang -> + (case (args_ _argsOnested _argsOoptions _argsOoutputfile) of + { ( !_argsIpps) -> + (case (({-# LINE 245 "./src-ag/PrintCode.ag" #-} + _argsIpps `ppMultiSeqH` (pp "True") + {-# LINE 2781 "dist/build/PrintCode.hs" #-} + )) of + { !_strictGuard -> + (case (({-# LINE 244 "./src-ag/PrintCode.ag" #-} + not (null _argsIpps) + {-# LINE 2786 "dist/build/PrintCode.hs" #-} + )) of + { !_hasStrictVars -> + (case (({-# LINE 243 "./src-ag/PrintCode.ag" #-} + if strictSems _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id + {-# LINE 2791 "dist/build/PrintCode.hs" #-} + )) of + { !_addStrictGuard -> + (case (({-# LINE 256 "./src-ag/PrintCode.ag" #-} + _addStrictGuard (name_ >#< hv_sp (map _addBang _argsIpps)) + {-# LINE 2796 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }))) +sem_Lhs_Unwrap :: String -> + T_Lhs -> + T_Lhs +sem_Lhs_Unwrap !name_ !(T_Lhs sub_) = + (T_Lhs (\ (!_lhsIisDeclOfLet) + (!_lhsInested) + (!_lhsIoptions) + (!_lhsIoutputfile) -> + (case (({-# LINE 40 "./src-ag/PrintCode.ag" #-} + _lhsIoutputfile + {-# LINE 2810 "dist/build/PrintCode.hs" #-} + )) of + { !_subOoutputfile -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 2815 "dist/build/PrintCode.hs" #-} + )) of + { !_subOoptions -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2820 "dist/build/PrintCode.hs" #-} + )) of + { !_subOnested -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 2825 "dist/build/PrintCode.hs" #-} + )) of + { !_subOisDeclOfLet -> + (case (sub_ _subOisDeclOfLet _subOnested _subOoptions _subOoutputfile) of + { ( !_subIpp) -> + (case (({-# LINE 257 "./src-ag/PrintCode.ag" #-} + pp_parens (name_ >#< _subIpp) + {-# LINE 2832 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }))) +-- NamedType --------------------------------------------------- +{- + visit 0: + inherited attribute: + nested : Bool + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Named: + child strict : {Bool} + child name : {String} + child tp : Type +-} +-- cata +sem_NamedType :: NamedType -> + T_NamedType +sem_NamedType !(Named _strict _name _tp) = + (sem_NamedType_Named _strict _name (sem_Type _tp)) +-- semantic domain +newtype T_NamedType = T_NamedType (Bool -> + ( PP_Doc)) +data Inh_NamedType = Inh_NamedType {nested_Inh_NamedType :: !(Bool)} +data Syn_NamedType = Syn_NamedType {pp_Syn_NamedType :: !(PP_Doc)} +wrap_NamedType :: T_NamedType -> + Inh_NamedType -> + Syn_NamedType +wrap_NamedType !(T_NamedType sem) !(Inh_NamedType _lhsInested) = + (let ( !_lhsOpp) = sem _lhsInested + in (Syn_NamedType _lhsOpp)) +sem_NamedType_Named :: Bool -> + String -> + T_Type -> + T_NamedType +sem_NamedType_Named !strict_ !name_ !(T_Type tp_) = + (T_NamedType (\ (!_lhsInested) -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2873 "dist/build/PrintCode.hs" #-} + )) of + { !_tpOnested -> + (case (tp_ _tpOnested) of + { ( !_tpIpp,!_tpIprec) -> + (case (({-# LINE 226 "./src-ag/PrintCode.ag" #-} + if strict_ + then name_ >#< "::" >#< "!" >|< pp_parens _tpIpp + else name_ >#< "::" >#< _tpIpp + {-# LINE 2882 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +-- NamedTypes -------------------------------------------------- +{- + visit 0: + inherited attribute: + nested : Bool + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : NamedType + child tl : NamedTypes + alternative Nil: +-} +-- cata +sem_NamedTypes :: NamedTypes -> + T_NamedTypes +sem_NamedTypes !list = + (Prelude.foldr sem_NamedTypes_Cons sem_NamedTypes_Nil (Prelude.map sem_NamedType list)) +-- semantic domain +newtype T_NamedTypes = T_NamedTypes (Bool -> + ( PP_Docs)) +data Inh_NamedTypes = Inh_NamedTypes {nested_Inh_NamedTypes :: !(Bool)} +data Syn_NamedTypes = Syn_NamedTypes {pps_Syn_NamedTypes :: !(PP_Docs)} +wrap_NamedTypes :: T_NamedTypes -> + Inh_NamedTypes -> + Syn_NamedTypes +wrap_NamedTypes !(T_NamedTypes sem) !(Inh_NamedTypes _lhsInested) = + (let ( !_lhsOpps) = sem _lhsInested + in (Syn_NamedTypes _lhsOpps)) +sem_NamedTypes_Cons :: T_NamedType -> + T_NamedTypes -> + T_NamedTypes +sem_NamedTypes_Cons !(T_NamedType hd_) !(T_NamedTypes tl_) = + (T_NamedTypes (\ (!_lhsInested) -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2922 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOnested -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 2927 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOnested -> + (case (tl_ _tlOnested) of + { ( !_tlIpps) -> + (case (hd_ _hdOnested) of + { ( !_hdIpp) -> + (case (({-# LINE 81 "./src-ag/PrintCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 2936 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }))) +sem_NamedTypes_Nil :: T_NamedTypes +sem_NamedTypes_Nil = + (T_NamedTypes (\ (!_lhsInested) -> + (case (({-# LINE 82 "./src-ag/PrintCode.ag" #-} + [] + {-# LINE 2945 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + inherited attributes: + belowIrrefutable : Bool + isDeclOfLet : Bool + options : Options + synthesized attributes: + copy : Pattern + isUnderscore : Bool + pp : PP_Doc + pp' : PP_Doc + strictVars : [PP_Doc] + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + local addBang : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + local addBang : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local copy : _ + local ppVar : _ + local addBang : _ + local ppVarBang : _ + local strictPatVars : _ + local strictVar : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern !(Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern !(Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern !(Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern !(Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +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 -> + Inh_Pattern -> + Syn_Pattern +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_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr !name_ !(T_Patterns pats_) = + (T_Pattern (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 3030 "dist/build/PrintCode.hs" #-} + )) of + { !_patsOoptions -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 3035 "dist/build/PrintCode.hs" #-} + )) of + { !_patsOisDeclOfLet -> + (case (({-# LINE 373 "./src-ag/PrintCode.ag" #-} + _lhsIbelowIrrefutable + {-# LINE 3040 "dist/build/PrintCode.hs" #-} + )) of + { !_patsObelowIrrefutable -> + (case (pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions) of + { ( !_patsIcopy,!_patsIpps,!_patsIpps',!_patsIstrictVars) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 3047 "dist/build/PrintCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 3052 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 368 "./src-ag/PrintCode.ag" #-} + False + {-# LINE 3057 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 352 "./src-ag/PrintCode.ag" #-} + if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable + then \p -> "!" >|< p + else id + {-# LINE 3064 "dist/build/PrintCode.hs" #-} + )) of + { !_addBang -> + (case (({-# LINE 357 "./src-ag/PrintCode.ag" #-} + _addBang $ pp_parens $ name_ >#< hv_sp _patsIpps + {-# LINE 3069 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 391 "./src-ag/PrintCode.ag" #-} + pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps') + {-# LINE 3074 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp' -> + (case (({-# LINE 326 "./src-ag/PrintCode.ag" #-} + _patsIstrictVars + {-# LINE 3079 "dist/build/PrintCode.hs" #-} + )) 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 (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 3092 "dist/build/PrintCode.hs" #-} + )) of + { !_patsOoptions -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 3097 "dist/build/PrintCode.hs" #-} + )) of + { !_patsOisDeclOfLet -> + (case (({-# LINE 373 "./src-ag/PrintCode.ag" #-} + _lhsIbelowIrrefutable + {-# LINE 3102 "dist/build/PrintCode.hs" #-} + )) of + { !_patsObelowIrrefutable -> + (case (pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions) of + { ( !_patsIcopy,!_patsIpps,!_patsIpps',!_patsIstrictVars) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 3109 "dist/build/PrintCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 3114 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 369 "./src-ag/PrintCode.ag" #-} + False + {-# LINE 3119 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 352 "./src-ag/PrintCode.ag" #-} + if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable + then \p -> "!" >|< p + else id + {-# LINE 3126 "dist/build/PrintCode.hs" #-} + )) of + { !_addBang -> + (case (({-# LINE 358 "./src-ag/PrintCode.ag" #-} + _addBang $ pp_block "(" ")" "," _patsIpps + {-# LINE 3131 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 392 "./src-ag/PrintCode.ag" #-} + pp_block "(" ")" "," _patsIpps' + {-# LINE 3136 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp' -> + (case (({-# LINE 326 "./src-ag/PrintCode.ag" #-} + _patsIstrictVars + {-# LINE 3141 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) }))) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_) = + (T_Pattern (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 3155 "dist/build/PrintCode.hs" #-} + )) of + { !_patOoptions -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 3160 "dist/build/PrintCode.hs" #-} + )) of + { !_patOisDeclOfLet -> + (case (({-# LINE 373 "./src-ag/PrintCode.ag" #-} + _lhsIbelowIrrefutable + {-# LINE 3165 "dist/build/PrintCode.hs" #-} + )) of + { !_patObelowIrrefutable -> + (case (pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions) of + { ( !_patIcopy,!_patIisUnderscore,!_patIpp,!_patIpp',!_patIstrictVars) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 3172 "dist/build/PrintCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 3177 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 370 "./src-ag/PrintCode.ag" #-} + False + {-# LINE 3182 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 359 "./src-ag/PrintCode.ag" #-} + pp (attrname False field_ attr_) + {-# LINE 3187 "dist/build/PrintCode.hs" #-} + )) of + { !_ppVar -> + (case (({-# LINE 352 "./src-ag/PrintCode.ag" #-} + if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable + then \p -> "!" >|< p + else id + {-# LINE 3194 "dist/build/PrintCode.hs" #-} + )) of + { !_addBang -> + (case (({-# LINE 360 "./src-ag/PrintCode.ag" #-} + _addBang $ _ppVar + {-# LINE 3199 "dist/build/PrintCode.hs" #-} + )) of + { !_ppVarBang -> + (case (({-# LINE 361 "./src-ag/PrintCode.ag" #-} + if _patIisUnderscore + then _ppVarBang + else _ppVarBang >|< "@" >|< _patIpp + {-# LINE 3206 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 393 "./src-ag/PrintCode.ag" #-} + let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_ + | otherwise = attrname False field_ attr_ + in attribute >|< "@" >|< _patIpp' + {-# LINE 3213 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp' -> + (case (({-# LINE 333 "./src-ag/PrintCode.ag" #-} + if stricterCases _lhsIoptions && not _lhsIisDeclOfLet + then _patIstrictVars + else [] + {-# LINE 3220 "dist/build/PrintCode.hs" #-} + )) of + { !_strictPatVars -> + (case (({-# LINE 329 "./src-ag/PrintCode.ag" #-} + if strictCases _lhsIoptions && not _lhsIisDeclOfLet + then [_ppVar ] + else [] + {-# LINE 3227 "dist/build/PrintCode.hs" #-} + )) of + { !_strictVar -> + (case (({-# LINE 337 "./src-ag/PrintCode.ag" #-} + _strictVar ++ _strictPatVars + {-# LINE 3232 "dist/build/PrintCode.hs" #-} + )) 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 (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 3244 "dist/build/PrintCode.hs" #-} + )) of + { !_patOoptions -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 3249 "dist/build/PrintCode.hs" #-} + )) of + { !_patOisDeclOfLet -> + (case (({-# LINE 376 "./src-ag/PrintCode.ag" #-} + True + {-# LINE 3254 "dist/build/PrintCode.hs" #-} + )) of + { !_patObelowIrrefutable -> + (case (pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions) of + { ( !_patIcopy,!_patIisUnderscore,!_patIpp,!_patIpp',!_patIstrictVars) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 3261 "dist/build/PrintCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 3266 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 367 "./src-ag/PrintCode.ag" #-} + _patIisUnderscore + {-# LINE 3271 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 364 "./src-ag/PrintCode.ag" #-} + text "~" >|< pp_parens _patIpp + {-# LINE 3276 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 396 "./src-ag/PrintCode.ag" #-} + text "~" >|< pp_parens _patIpp + {-# LINE 3281 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp' -> + (case (({-# LINE 340 "./src-ag/PrintCode.ag" #-} + [] + {-# LINE 3286 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore !pos_ = + (T_Pattern (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 3298 "dist/build/PrintCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 3303 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 371 "./src-ag/PrintCode.ag" #-} + True + {-# LINE 3308 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 365 "./src-ag/PrintCode.ag" #-} + text "_" + {-# LINE 3313 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 397 "./src-ag/PrintCode.ag" #-} + text "_" + {-# LINE 3318 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp' -> + (case (({-# LINE 326 "./src-ag/PrintCode.ag" #-} + [] + {-# LINE 3323 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + inherited attributes: + belowIrrefutable : Bool + isDeclOfLet : Bool + options : Options + synthesized attributes: + copy : Patterns + 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 -> + Inh_Patterns -> + Syn_Patterns +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 (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 3376 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOoptions -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 3381 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOisDeclOfLet -> + (case (({-# LINE 373 "./src-ag/PrintCode.ag" #-} + _lhsIbelowIrrefutable + {-# LINE 3386 "dist/build/PrintCode.hs" #-} + )) of + { !_tlObelowIrrefutable -> + (case (tl_ _tlObelowIrrefutable _tlOisDeclOfLet _tlOoptions) of + { ( !_tlIcopy,!_tlIpps,!_tlIpps',!_tlIstrictVars) -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _lhsIoptions + {-# LINE 3393 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOoptions -> + (case (({-# LINE 407 "./src-ag/PrintCode.ag" #-} + _lhsIisDeclOfLet + {-# LINE 3398 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOisDeclOfLet -> + (case (({-# LINE 373 "./src-ag/PrintCode.ag" #-} + _lhsIbelowIrrefutable + {-# LINE 3403 "dist/build/PrintCode.hs" #-} + )) of + { !_hdObelowIrrefutable -> + (case (hd_ _hdObelowIrrefutable _hdOisDeclOfLet _hdOoptions) of + { ( !_hdIcopy,!_hdIisUnderscore,!_hdIpp,!_hdIpp',!_hdIstrictVars) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 3410 "dist/build/PrintCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 3415 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 347 "./src-ag/PrintCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 3420 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpps -> + (case (({-# LINE 387 "./src-ag/PrintCode.ag" #-} + _hdIpp' : _tlIpps' + {-# LINE 3425 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpps' -> + (case (({-# LINE 326 "./src-ag/PrintCode.ag" #-} + _hdIstrictVars ++ _tlIstrictVars + {-# LINE 3430 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) }) }) }))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (\ (!_lhsIbelowIrrefutable) + (!_lhsIisDeclOfLet) + (!_lhsIoptions) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 3441 "dist/build/PrintCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 3446 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 348 "./src-ag/PrintCode.ag" #-} + [] + {-# LINE 3451 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpps -> + (case (({-# LINE 388 "./src-ag/PrintCode.ag" #-} + [] + {-# LINE 3456 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpps' -> + (case (({-# LINE 326 "./src-ag/PrintCode.ag" #-} + [] + {-# LINE 3461 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOstrictVars -> + ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars) }) }) }) }) }))) +-- Program ----------------------------------------------------- +{- + visit 0: + inherited attributes: + importBlocks : PP_Doc + mainBlocksDoc : 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 + child ordered : {Bool} + visit 0: + local options : _ + local commonFile : _ + local genCommonModule : _ + local mainModuleFile : _ + local genMainModule : _ +-} +-- cata +sem_Program :: Program -> + T_Program +sem_Program !(Program _chunks _ordered) = + (sem_Program_Program (sem_Chunks _chunks) _ordered) +-- semantic domain +newtype T_Program = T_Program (PP_Doc -> + 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),mainBlocksDoc_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 -> + Inh_Program -> + Syn_Program +wrap_Program !(T_Program sem) !(Inh_Program _lhsIimportBlocks _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) = + (let ( !_lhsOgenIO,!_lhsOoutput) = sem _lhsIimportBlocks _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks + in (Syn_Program _lhsOgenIO _lhsOoutput)) +sem_Program_Program :: T_Chunks -> + Bool -> + T_Program +sem_Program_Program !(T_Chunks chunks_) !ordered_ = + (T_Program (\ (!_lhsIimportBlocks) + (!_lhsImainBlocksDoc) + (!_lhsImainFile) + (!_lhsImainName) + (!_lhsImoduleHeader) + (!_lhsIoptions) + (!_lhsIoptionsLine) + (!_lhsIpragmaBlocks) + (!_lhsItextBlockMap) + (!_lhsItextBlocks) -> + (case (({-# LINE 435 "./src-ag/PrintCode.ag" #-} + _lhsItextBlockMap + {-# LINE 3534 "dist/build/PrintCode.hs" #-} + )) of + { !_chunksOtextBlockMap -> + (case (({-# LINE 433 "./src-ag/PrintCode.ag" #-} + _lhsIpragmaBlocks + {-# LINE 3539 "dist/build/PrintCode.hs" #-} + )) of + { !_chunksOpragmaBlocks -> + (case (({-# LINE 436 "./src-ag/PrintCode.ag" #-} + _lhsIoptionsLine + {-# LINE 3544 "dist/build/PrintCode.hs" #-} + )) of + { !_chunksOoptionsLine -> + (case (({-# LINE 59 "./src-ag/PrintCode.ag" #-} + _lhsIoptions { breadthFirst = breadthFirst _lhsIoptions && visit _lhsIoptions && cases _lhsIoptions && ordered_ } + {-# LINE 3549 "dist/build/PrintCode.hs" #-} + )) of + { !_options -> + (case (({-# LINE 50 "./src-ag/PrintCode.ag" #-} + _options + {-# LINE 3554 "dist/build/PrintCode.hs" #-} + )) of + { !_chunksOoptions -> + (case (({-# LINE 439 "./src-ag/PrintCode.ag" #-} + _lhsImoduleHeader + {-# LINE 3559 "dist/build/PrintCode.hs" #-} + )) of + { !_chunksOmoduleHeader -> + (case (({-# LINE 438 "./src-ag/PrintCode.ag" #-} + _lhsImainName + {-# LINE 3564 "dist/build/PrintCode.hs" #-} + )) of + { !_chunksOmainName -> + (case (({-# LINE 437 "./src-ag/PrintCode.ag" #-} + _lhsImainFile + {-# LINE 3569 "dist/build/PrintCode.hs" #-} + )) of + { !_chunksOmainFile -> + (case (({-# LINE 457 "./src-ag/PrintCode.ag" #-} + replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ "_common") + {-# LINE 3574 "dist/build/PrintCode.hs" #-} + )) of + { !_commonFile -> + (case (({-# LINE 410 "./src-ag/PrintCode.ag" #-} + False + {-# LINE 3579 "dist/build/PrintCode.hs" #-} + )) of + { !_chunksOisDeclOfLet -> + (case (({-# LINE 62 "./src-ag/PrintCode.ag" #-} + nest _lhsIoptions + {-# LINE 3584 "dist/build/PrintCode.hs" #-} + )) of + { !_chunksOnested -> + (case (({-# LINE 434 "./src-ag/PrintCode.ag" #-} + _lhsItextBlocks + {-# LINE 3589 "dist/build/PrintCode.hs" #-} + )) of + { !_chunksOtextBlocks -> + (case (({-# LINE 432 "./src-ag/PrintCode.ag" #-} + _lhsIimportBlocks + {-# LINE 3594 "dist/build/PrintCode.hs" #-} + )) of + { !_chunksOimportBlocks -> + (case (chunks_ _chunksOimportBlocks _chunksOisDeclOfLet _chunksOmainFile _chunksOmainName _chunksOmoduleHeader _chunksOnested _chunksOoptions _chunksOoptionsLine _chunksOpragmaBlocks _chunksOtextBlockMap _chunksOtextBlocks) of + { ( !_chunksIappendCommon,!_chunksIappendMain,!_chunksIgenSems,!_chunksIimports,!_chunksIpps) -> + (case (({-# LINE 458 "./src-ag/PrintCode.ag" #-} + writeModule _commonFile + ( [ pp $ _lhsIpragmaBlocks + , pp $ _lhsIoptionsLine + , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True + , _lhsIimportBlocks + , _lhsItextBlocks + ] + ++ map vlist _chunksIappendCommon + ) + {-# LINE 3609 "dist/build/PrintCode.hs" #-} + )) of + { !_genCommonModule -> + (case (({-# LINE 444 "./src-ag/PrintCode.ag" #-} + _lhsImainFile + {-# LINE 3614 "dist/build/PrintCode.hs" #-} + )) of + { !_mainModuleFile -> + (case (({-# LINE 445 "./src-ag/PrintCode.ag" #-} + writeModule _mainModuleFile + ( [ pp $ _lhsIpragmaBlocks + , pp $ _lhsIoptionsLine + , pp $ _lhsImoduleHeader _lhsImainName "" "" False + , pp $ ("import " ++ _lhsImainName ++ "_common\n") + ] + ++ map pp _chunksIimports + ++ map vlist _chunksIappendMain + ++ [_lhsImainBlocksDoc] + ) + {-# LINE 3628 "dist/build/PrintCode.hs" #-} + )) of + { !_genMainModule -> + (case (({-# LINE 469 "./src-ag/PrintCode.ag" #-} + do _genMainModule + _genCommonModule + _chunksIgenSems + {-# LINE 3635 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOgenIO -> + (case (({-# LINE 94 "./src-ag/PrintCode.ag" #-} + _chunksIpps + {-# LINE 3640 "dist/build/PrintCode.hs" #-} + )) 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 QuantApp: + child left : {String} + child right : Type + alternative TypeApp: + child func : Type + child args : Types + alternative TupleType: + child tps : Types + alternative UnboxedTupleType: + child tps : Types + alternative List: + child tp : Type + alternative SimpleType: + child txt : {String} + alternative NontermType: + child name : {String} + child params : {[String]} + child deforested : {Bool} + visit 0: + local prefix : _ + alternative TMaybe: + child tp : Type + alternative TEither: + child left : Type + child right : Type + alternative TMap: + child key : Type + child value : Type + alternative TIntMap: + child value : Type +-} +-- 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 !(QuantApp _left _right) = + (sem_Type_QuantApp _left (sem_Type _right)) +sem_Type !(TypeApp _func _args) = + (sem_Type_TypeApp (sem_Type _func) (sem_Types _args)) +sem_Type !(TupleType _tps) = + (sem_Type_TupleType (sem_Types _tps)) +sem_Type !(UnboxedTupleType _tps) = + (sem_Type_UnboxedTupleType (sem_Types _tps)) +sem_Type !(List _tp) = + (sem_Type_List (sem_Type _tp)) +sem_Type !(SimpleType _txt) = + (sem_Type_SimpleType _txt) +sem_Type !(NontermType _name _params _deforested) = + (sem_Type_NontermType _name _params _deforested) +sem_Type !(TMaybe _tp) = + (sem_Type_TMaybe (sem_Type _tp)) +sem_Type !(TEither _left _right) = + (sem_Type_TEither (sem_Type _left) (sem_Type _right)) +sem_Type !(TMap _key _value) = + (sem_Type_TMap (sem_Type _key) (sem_Type _value)) +sem_Type !(TIntMap _value) = + (sem_Type_TIntMap (sem_Type _value)) +-- 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 -> + Inh_Type -> + Syn_Type +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 (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 3740 "dist/build/PrintCode.hs" #-} + )) of + { !_rightOnested -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 3745 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (right_ _rightOnested) of + { ( !_rightIpp,!_rightIprec) -> + (case (({-# LINE 263 "./src-ag/PrintCode.ag" #-} + if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp + {-# LINE 3752 "dist/build/PrintCode.hs" #-} + )) of + { !_r -> + (case (left_ _leftOnested) of + { ( !_leftIpp,!_leftIprec) -> + (case (({-# LINE 262 "./src-ag/PrintCode.ag" #-} + if _leftIprec <= 2 then pp_parens _leftIpp else _leftIpp + {-# LINE 3759 "dist/build/PrintCode.hs" #-} + )) of + { !_l -> + (case (({-# LINE 261 "./src-ag/PrintCode.ag" #-} + _l >#< "->" >-< _r + {-# LINE 3764 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 260 "./src-ag/PrintCode.ag" #-} + 2 + {-# LINE 3769 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }) }) }) }) }))) +sem_Type_CtxApp :: ([(String, [String])]) -> + T_Type -> + T_Type +sem_Type_CtxApp !left_ !(T_Type right_) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 3780 "dist/build/PrintCode.hs" #-} + )) of + { !_rightOnested -> + (case (right_ _rightOnested) of + { ( !_rightIpp,!_rightIprec) -> + (case (({-# LINE 269 "./src-ag/PrintCode.ag" #-} + (pp_block "(" ")" "," $ map (\(n,ns) -> hv_sp $ map pp (n:ns)) left_) >#< "=>" >#< _rightIpp + {-# LINE 3787 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 259 "./src-ag/PrintCode.ag" #-} + _rightIprec + {-# LINE 3792 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }))) +sem_Type_QuantApp :: String -> + T_Type -> + T_Type +sem_Type_QuantApp !left_ !(T_Type right_) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 3803 "dist/build/PrintCode.hs" #-} + )) of + { !_rightOnested -> + (case (right_ _rightOnested) of + { ( !_rightIpp,!_rightIprec) -> + (case (({-# LINE 271 "./src-ag/PrintCode.ag" #-} + left_ >#< _rightIpp + {-# LINE 3810 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 259 "./src-ag/PrintCode.ag" #-} + _rightIprec + {-# LINE 3815 "dist/build/PrintCode.hs" #-} + )) 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 (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 3826 "dist/build/PrintCode.hs" #-} + )) of + { !_argsOnested -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 3831 "dist/build/PrintCode.hs" #-} + )) of + { !_funcOnested -> + (case (args_ _argsOnested) of + { ( !_argsIpps) -> + (case (func_ _funcOnested) of + { ( !_funcIpp,!_funcIprec) -> + (case (({-# LINE 266 "./src-ag/PrintCode.ag" #-} + hv_sp (_funcIpp : _argsIpps) + {-# LINE 3840 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 259 "./src-ag/PrintCode.ag" #-} + _funcIprec + {-# LINE 3845 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }) }) }))) +sem_Type_TupleType :: T_Types -> + T_Type +sem_Type_TupleType !(T_Types tps_) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 3855 "dist/build/PrintCode.hs" #-} + )) of + { !_tpsOnested -> + (case (tps_ _tpsOnested) of + { ( !_tpsIpps) -> + (case (({-# LINE 274 "./src-ag/PrintCode.ag" #-} + ppTuple _lhsInested _tpsIpps + {-# LINE 3862 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 273 "./src-ag/PrintCode.ag" #-} + 5 + {-# LINE 3867 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }))) +sem_Type_UnboxedTupleType :: T_Types -> + T_Type +sem_Type_UnboxedTupleType !(T_Types tps_) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 3877 "dist/build/PrintCode.hs" #-} + )) of + { !_tpsOnested -> + (case (tps_ _tpsOnested) of + { ( !_tpsIpps) -> + (case (({-# LINE 277 "./src-ag/PrintCode.ag" #-} + ppUnboxedTuple _lhsInested _tpsIpps + {-# LINE 3884 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 276 "./src-ag/PrintCode.ag" #-} + 5 + {-# LINE 3889 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }))) +sem_Type_List :: T_Type -> + T_Type +sem_Type_List !(T_Type tp_) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 3899 "dist/build/PrintCode.hs" #-} + )) of + { !_tpOnested -> + (case (tp_ _tpOnested) of + { ( !_tpIpp,!_tpIprec) -> + (case (({-# LINE 280 "./src-ag/PrintCode.ag" #-} + "[" >|< _tpIpp >|< "]" + {-# LINE 3906 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 279 "./src-ag/PrintCode.ag" #-} + 5 + {-# LINE 3911 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }))) +sem_Type_SimpleType :: String -> + T_Type +sem_Type_SimpleType !txt_ = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 283 "./src-ag/PrintCode.ag" #-} + if reallySimple txt_ then text txt_ else pp_parens (text txt_) + {-# LINE 3921 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 282 "./src-ag/PrintCode.ag" #-} + 5 + {-# LINE 3926 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }))) +sem_Type_NontermType :: String -> + ([String]) -> + Bool -> + T_Type +sem_Type_NontermType !name_ !params_ !deforested_ = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 287 "./src-ag/PrintCode.ag" #-} + if deforested_ + then text "T_" + else empty + {-# LINE 3940 "dist/build/PrintCode.hs" #-} + )) of + { !_prefix -> + (case (({-# LINE 286 "./src-ag/PrintCode.ag" #-} + _prefix >|< text name_ >#< hv_sp params_ + {-# LINE 3945 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 285 "./src-ag/PrintCode.ag" #-} + 5 + {-# LINE 3950 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }))) +sem_Type_TMaybe :: T_Type -> + T_Type +sem_Type_TMaybe !(T_Type tp_) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 3960 "dist/build/PrintCode.hs" #-} + )) of + { !_tpOnested -> + (case (tp_ _tpOnested) of + { ( !_tpIpp,!_tpIprec) -> + (case (({-# LINE 291 "./src-ag/PrintCode.ag" #-} + text "Maybe" >#< _tpIpp + {-# LINE 3967 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 290 "./src-ag/PrintCode.ag" #-} + 5 + {-# LINE 3972 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }))) +sem_Type_TEither :: T_Type -> + T_Type -> + T_Type +sem_Type_TEither !(T_Type left_) !(T_Type right_) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 3983 "dist/build/PrintCode.hs" #-} + )) of + { !_rightOnested -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 3988 "dist/build/PrintCode.hs" #-} + )) of + { !_leftOnested -> + (case (right_ _rightOnested) of + { ( !_rightIpp,!_rightIprec) -> + (case (left_ _leftOnested) of + { ( !_leftIpp,!_leftIprec) -> + (case (({-# LINE 293 "./src-ag/PrintCode.ag" #-} + text "Either" >#< pp_parens _leftIpp >#< pp_parens _rightIpp + {-# LINE 3997 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 292 "./src-ag/PrintCode.ag" #-} + 5 + {-# LINE 4002 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }) }) }))) +sem_Type_TMap :: T_Type -> + T_Type -> + T_Type +sem_Type_TMap !(T_Type key_) !(T_Type value_) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 4013 "dist/build/PrintCode.hs" #-} + )) of + { !_valueOnested -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 4018 "dist/build/PrintCode.hs" #-} + )) of + { !_keyOnested -> + (case (value_ _valueOnested) of + { ( !_valueIpp,!_valueIprec) -> + (case (key_ _keyOnested) of + { ( !_keyIpp,!_keyIprec) -> + (case (({-# LINE 295 "./src-ag/PrintCode.ag" #-} + text "Data.Map.Map" >#< pp_parens _keyIpp >#< pp_parens _valueIpp + {-# LINE 4027 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 294 "./src-ag/PrintCode.ag" #-} + 5 + {-# LINE 4032 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOprec -> + ( _lhsOpp,_lhsOprec) }) }) }) }) }) }))) +sem_Type_TIntMap :: T_Type -> + T_Type +sem_Type_TIntMap !(T_Type value_) = + (T_Type (\ (!_lhsInested) -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 4042 "dist/build/PrintCode.hs" #-} + )) of + { !_valueOnested -> + (case (value_ _valueOnested) of + { ( !_valueIpp,!_valueIprec) -> + (case (({-# LINE 297 "./src-ag/PrintCode.ag" #-} + text "Data.IntMap.IntMap" >#< pp_parens _valueIpp + {-# LINE 4049 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpp -> + (case (({-# LINE 296 "./src-ag/PrintCode.ag" #-} + 5 + {-# LINE 4054 "dist/build/PrintCode.hs" #-} + )) 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 -> + Inh_Types -> + Syn_Types +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 (({-# LINE 54 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 4094 "dist/build/PrintCode.hs" #-} + )) of + { !_tlOnested -> + (case (({-# LINE 52 "./src-ag/PrintCode.ag" #-} + _lhsInested + {-# LINE 4099 "dist/build/PrintCode.hs" #-} + )) of + { !_hdOnested -> + (case (tl_ _tlOnested) of + { ( !_tlIpps) -> + (case (hd_ _hdOnested) of + { ( !_hdIpp,!_hdIprec) -> + (case (({-# LINE 77 "./src-ag/PrintCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 4108 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }))) +sem_Types_Nil :: T_Types +sem_Types_Nil = + (T_Types (\ (!_lhsInested) -> + (case (({-# LINE 78 "./src-ag/PrintCode.ag" #-} + [] + {-# LINE 4117 "dist/build/PrintCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }))) diff --git a/dist/build/PrintErrorMessages.hs b/dist/build/PrintErrorMessages.hs new file mode 100644 --- /dev/null +++ b/dist/build/PrintErrorMessages.hs @@ -0,0 +1,1935 @@ + + +-- UUAGC 0.9.42.0 (src-ag/PrintErrorMessages.ag) +module PrintErrorMessages where +{-# LINE 4 "./src-ag/PrintErrorMessages.ag" #-} + +import Pretty +import UU.Scanner.Position(Pos(..), noPos) +import ErrorMessages +import Options +import Data.List(mapAccumL,intersect,(\\)) +import GrammarInfo +import qualified Control.Monad.Error.Class as Err +{-# LINE 15 "dist/build/PrintErrorMessages.hs" #-} + +{-# LINE 2 "./src-ag/ErrorMessages.ag" #-} + +import UU.Scanner.Position(Pos) +import Pretty +import CodeSyntax +import CommonTypes +{-# LINE 23 "dist/build/PrintErrorMessages.hs" #-} +{-# LINE 15 "./src-ag/PrintErrorMessages.ag" #-} + +instance Err.Error Error where + noMsg = Err.strMsg "error" + strMsg = CustomError False noPos . pp +{-# LINE 29 "dist/build/PrintErrorMessages.hs" #-} + +{-# LINE 22 "./src-ag/PrintErrorMessages.ag" #-} + +isError :: Options -> Error -> Bool +isError opts (ParserError _ _ _ ) = True +isError opts (DupAlt _ _ _ ) = False +isError opts (DupSynonym _ _ ) = False +isError opts (DupSet _ _ ) = False +isError opts (DupInhAttr _ _ _ ) = True +isError opts (DupSynAttr _ _ _ ) = True +isError opts (DupChild _ _ _ _ ) = False +isError opts (DupRule _ _ _ _ _) = True +isError opts (DupSig _ _ _ ) = False +isError opts (UndefNont _ ) = True +isError opts (UndefAlt _ _ ) = True +isError opts (UndefChild _ _ _ ) = True +isError opts (MissingRule _ _ _ _ ) = False +isError opts (SuperfluousRule _ _ _ _ ) = False +isError opts (UndefLocal _ _ _ ) = True +isError opts (ChildAsLocal _ _ _ ) = False +isError opts (UndefAttr _ _ _ _ _) = True +isError opts (CyclicSet _ ) = True +isError opts (CustomError w _ _ ) = not w +isError opts (LocalCirc _ _ _ _ _) = cycleIsDangerous opts +isError opts (InstCirc _ _ _ _ _) = cycleIsDangerous opts +isError opts (DirectCirc _ _ _ ) = cycleIsDangerous opts +isError opts (InducedCirc _ _ _ ) = cycleIsDangerous opts +isError opts (MissingTypeSig _ _ _ ) = False +isError opts (MissingInstSig _ _ _ ) = True +isError opts (DupUnique _ _ _ ) = False +isError opts (MissingUnique _ _ ) = True +isError opts (MissingSyn _ _ ) = True +isError opts (MissingNamedRule _ _ _) = True +isError opts (DupRuleName _ _ _) = True +isError opts (HsParseError _ _) = True +isError opts (Cyclic _ _ _) = True +isError opts (IncompatibleVisitKind _ _ _ _) = True +isError opts (IncompatibleRuleKind _ _) = True +isError opts (IncompatibleAttachKind _ _) = True + +cycleIsDangerous :: Options -> Bool +cycleIsDangerous opts + = any ($ opts) [ wignore, bangpats, cases, strictCases, stricterCases, strictSems, withCycle ] +{-# LINE 73 "dist/build/PrintErrorMessages.hs" #-} + +{-# LINE 550 "./src-ag/PrintErrorMessages.ag" #-} + +toWidth n xs | k-< indent 4 (vlist (map text path2)) + >-< text "and back: " + >-< indent 4 (vlist (map text path1)) + +attrText inh syn + = if inh == syn + then "threaded attribute " ++ getName inh + else "inherited attribute " ++ getName inh ++ " and synthesized attribute " ++getName syn + +showLineNr :: Int -> String +showLineNr i | i==(-1) = "CR" + | otherwise = show i + +showAttrDef f a | f == _LHS = "synthesized attribute " ++ getName a + | f == _LOC = "local attribute " ++ getName a + | f == _INST = "inst attribute " ++ getName a + | otherwise = "inherited attribute " ++ getName a ++ " of field " ++ getName f + +showAttrUse f a | f == _LHS = "inherited attribute " ++ getName a + | f == _LOC = "local attribute " ++ getName a + | f == _INST = "inst attribute " ++ getName a + | otherwise = "synthesized attribute " ++ getName a ++ " of field " ++ getName f + +ppAttr f a = text (getName f++"."++getName a) +ppAttrUse f a = "@" >|< ppAttr f a +{-# LINE 111 "dist/build/PrintErrorMessages.hs" #-} + +{-# LINE 588 "./src-ag/PrintErrorMessages.ag" #-} + +infixr 5 +#+ +(+#+) :: String -> String -> String +(+#+) s t = s ++ " " ++ t + +infixr 5 +.+ +(+.+) :: Identifier -> Identifier -> String +(+.+) s t = getName s ++ "." ++ getName t + +wfill = fill . addSpaces. concat . map words + where addSpaces (x:xs) = x:map addSpace xs + addSpaces [] = [] + addSpace [x] | x `elem` ".,;:!?" = [x] + addSpace xs = ' ':xs + +ppError :: Bool -- class of the error, True:error False:warning + -> Pos -- source position + -> PP_Doc -- error message + -> PP_Doc -- pattern + -> PP_Doc -- help, more info + -> PP_Doc -- action taken by AG + -> Bool -- verbose? show help and action? + -> PP_Doc +ppError isError pos mesg pat hlp act verbose + = let position = case pos of + Pos l c f | l >= 0 -> f >|< ":" >|< show l >|< ":" >|< show c + | otherwise -> pp "uuagc" + tp = if isError then "error" else "warning" + header = position >|< ":" >#< tp >|< ":" >#< mesg + pattern = "pattern :" >#< pat + help = "help :" >#< hlp + action = "action :" >#< act + in if verbose + then vlist [text "",header,pattern,help,action] + else header + +{- +-- old error reporting code + = let + cl = if isError then "ERROR" else "Warning" + position = case pos of + (Pos l c f) | l >= 0 -> f >|< ": line " >|< show l >|< ", column " >|< show c + | otherwise -> empty + header = "*** UU.AG" >#< cl >#< position >#< "***" + message = "problem :" >#< mesg + pattern = "pattern :" >#< pat + help = "help :" >#< hlp + action = "action :" >#< act + in + if verbose + then vlist [text "",header,message,pattern,help,action] + else vlist [text "",header,message] +-} + +showPos = show . getPos + +ppInterface inter = wfill ["interface:", show inter] + +{-# LINE 172 "dist/build/PrintErrorMessages.hs" #-} +-- Error ------------------------------------------------------- +{- + visit 0: + inherited attributes: + options : Options + verbose : Bool + synthesized attributes: + me : Error + pp : PP_Doc + alternatives: + alternative ParserError: + child pos : {Pos} + child problem : {String} + child action : {String} + visit 0: + local me : _ + alternative HsParseError: + child pos : {Pos} + child msg : {String} + visit 0: + local me : _ + alternative DupAlt: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child occ1 : {ConstructorIdent} + visit 0: + local me : _ + alternative DupSynonym: + child nt : {NontermIdent} + child occ1 : {NontermIdent} + visit 0: + local me : _ + alternative DupSet: + child name : {NontermIdent} + child occ1 : {NontermIdent} + visit 0: + local me : _ + alternative DupInhAttr: + child nt : {NontermIdent} + child attr : {Identifier} + child occ1 : {Identifier} + visit 0: + local me : _ + alternative DupSynAttr: + child nt : {NontermIdent} + child attr : {Identifier} + child occ1 : {Identifier} + visit 0: + local me : _ + alternative DupChild: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child name : {Identifier} + child occ1 : {Identifier} + visit 0: + local me : _ + alternative DupRule: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + child occ1 : {Identifier} + visit 0: + local me : _ + alternative DupRuleName: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child nm : {Identifier} + visit 0: + local me : _ + alternative DupSig: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + visit 0: + local me : _ + alternative UndefNont: + child nt : {NontermIdent} + visit 0: + local me : _ + alternative UndefAlt: + child nt : {NontermIdent} + child con : {ConstructorIdent} + visit 0: + local me : _ + alternative UndefChild: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child name : {Identifier} + visit 0: + local me : _ + alternative MissingRule: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + visit 0: + local me : _ + alternative MissingNamedRule: + child nt : {NontermIdent} + child con : {Identifier} + child name : {Identifier} + visit 0: + local me : _ + alternative SuperfluousRule: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + visit 0: + local me : _ + alternative UndefLocal: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child var : {Identifier} + visit 0: + local me : _ + alternative ChildAsLocal: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child var : {Identifier} + visit 0: + local me : _ + alternative UndefAttr: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child attr : {Identifier} + child isOut : {Bool} + visit 0: + local me : _ + alternative Cyclic: + child nt : {NontermIdent} + child mbCon : {Maybe ConstructorIdent} + child verts : {[String]} + visit 0: + local me : _ + alternative CyclicSet: + child name : {Identifier} + visit 0: + local me : _ + alternative CustomError: + child isWarning : {Bool} + child pos : {Pos} + child mesg : {PP_Doc} + visit 0: + local me : _ + alternative LocalCirc: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + child o_visit : {Bool} + child path : {[String]} + visit 0: + local me : _ + alternative InstCirc: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + child o_visit : {Bool} + child path : {[String]} + visit 0: + local me : _ + alternative DirectCirc: + child nt : {NontermIdent} + child o_visit : {Bool} + child cyclic : {[((Identifier,Identifier),[String],[String])]} + visit 0: + local me : _ + alternative InducedCirc: + child nt : {NontermIdent} + child cinter : {CInterface} + child cyclic : {[((Identifier,Identifier),[String],[String])]} + visit 0: + local me : _ + alternative MissingTypeSig: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + visit 0: + local me : _ + alternative MissingInstSig: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + visit 0: + local me : _ + alternative DupUnique: + child nt : {NontermIdent} + child con : {ConstructorIdent} + child attr : {Identifier} + visit 0: + local me : _ + alternative MissingUnique: + child nt : {NontermIdent} + child attr : {Identifier} + visit 0: + local me : _ + alternative MissingSyn: + child nt : {NontermIdent} + child attr : {Identifier} + visit 0: + local me : _ + alternative IncompatibleVisitKind: + child child : {Identifier} + child vis : {VisitIdentifier} + child from : {VisitKind} + child to : {VisitKind} + visit 0: + local me : _ + alternative IncompatibleRuleKind: + child rule : {Identifier} + child kind : {VisitKind} + visit 0: + local me : _ + alternative IncompatibleAttachKind: + child child : {Identifier} + child kind : {VisitKind} + visit 0: + local me : _ +-} +-- cata +sem_Error :: Error -> + T_Error +sem_Error (ParserError _pos _problem _action) = + (sem_Error_ParserError _pos _problem _action) +sem_Error (HsParseError _pos _msg) = + (sem_Error_HsParseError _pos _msg) +sem_Error (DupAlt _nt _con _occ1) = + (sem_Error_DupAlt _nt _con _occ1) +sem_Error (DupSynonym _nt _occ1) = + (sem_Error_DupSynonym _nt _occ1) +sem_Error (DupSet _name _occ1) = + (sem_Error_DupSet _name _occ1) +sem_Error (DupInhAttr _nt _attr _occ1) = + (sem_Error_DupInhAttr _nt _attr _occ1) +sem_Error (DupSynAttr _nt _attr _occ1) = + (sem_Error_DupSynAttr _nt _attr _occ1) +sem_Error (DupChild _nt _con _name _occ1) = + (sem_Error_DupChild _nt _con _name _occ1) +sem_Error (DupRule _nt _con _field _attr _occ1) = + (sem_Error_DupRule _nt _con _field _attr _occ1) +sem_Error (DupRuleName _nt _con _nm) = + (sem_Error_DupRuleName _nt _con _nm) +sem_Error (DupSig _nt _con _attr) = + (sem_Error_DupSig _nt _con _attr) +sem_Error (UndefNont _nt) = + (sem_Error_UndefNont _nt) +sem_Error (UndefAlt _nt _con) = + (sem_Error_UndefAlt _nt _con) +sem_Error (UndefChild _nt _con _name) = + (sem_Error_UndefChild _nt _con _name) +sem_Error (MissingRule _nt _con _field _attr) = + (sem_Error_MissingRule _nt _con _field _attr) +sem_Error (MissingNamedRule _nt _con _name) = + (sem_Error_MissingNamedRule _nt _con _name) +sem_Error (SuperfluousRule _nt _con _field _attr) = + (sem_Error_SuperfluousRule _nt _con _field _attr) +sem_Error (UndefLocal _nt _con _var) = + (sem_Error_UndefLocal _nt _con _var) +sem_Error (ChildAsLocal _nt _con _var) = + (sem_Error_ChildAsLocal _nt _con _var) +sem_Error (UndefAttr _nt _con _field _attr _isOut) = + (sem_Error_UndefAttr _nt _con _field _attr _isOut) +sem_Error (Cyclic _nt _mbCon _verts) = + (sem_Error_Cyclic _nt _mbCon _verts) +sem_Error (CyclicSet _name) = + (sem_Error_CyclicSet _name) +sem_Error (CustomError _isWarning _pos _mesg) = + (sem_Error_CustomError _isWarning _pos _mesg) +sem_Error (LocalCirc _nt _con _attr _o_visit _path) = + (sem_Error_LocalCirc _nt _con _attr _o_visit _path) +sem_Error (InstCirc _nt _con _attr _o_visit _path) = + (sem_Error_InstCirc _nt _con _attr _o_visit _path) +sem_Error (DirectCirc _nt _o_visit _cyclic) = + (sem_Error_DirectCirc _nt _o_visit _cyclic) +sem_Error (InducedCirc _nt _cinter _cyclic) = + (sem_Error_InducedCirc _nt _cinter _cyclic) +sem_Error (MissingTypeSig _nt _con _attr) = + (sem_Error_MissingTypeSig _nt _con _attr) +sem_Error (MissingInstSig _nt _con _attr) = + (sem_Error_MissingInstSig _nt _con _attr) +sem_Error (DupUnique _nt _con _attr) = + (sem_Error_DupUnique _nt _con _attr) +sem_Error (MissingUnique _nt _attr) = + (sem_Error_MissingUnique _nt _attr) +sem_Error (MissingSyn _nt _attr) = + (sem_Error_MissingSyn _nt _attr) +sem_Error (IncompatibleVisitKind _child _vis _from _to) = + (sem_Error_IncompatibleVisitKind _child _vis _from _to) +sem_Error (IncompatibleRuleKind _rule _kind) = + (sem_Error_IncompatibleRuleKind _rule _kind) +sem_Error (IncompatibleAttachKind _child _kind) = + (sem_Error_IncompatibleAttachKind _child _kind) +-- semantic domain +newtype T_Error = T_Error (Options -> + Bool -> + ( Error,PP_Doc)) +data Inh_Error = Inh_Error {options_Inh_Error :: Options,verbose_Inh_Error :: Bool} +data Syn_Error = Syn_Error {me_Syn_Error :: Error,pp_Syn_Error :: PP_Doc} +wrap_Error :: T_Error -> + Inh_Error -> + Syn_Error +wrap_Error (T_Error sem) (Inh_Error _lhsIoptions _lhsIverbose) = + (let ( _lhsOme,_lhsOpp) = sem _lhsIoptions _lhsIverbose + in (Syn_Error _lhsOme _lhsOpp)) +sem_Error_ParserError :: Pos -> + String -> + String -> + T_Error +sem_Error_ParserError pos_ problem_ action_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 89, column 21) + _lhsOpp = + ({-# LINE 89 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = text ("parser expecting " ++ problem_) + pat = text "" + help = text "" + act = text action_ + in ppError (isError _lhsIoptions _me) pos_ mesg pat help act _lhsIverbose + {-# LINE 496 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + ParserError pos_ problem_ action_ + {-# LINE 502 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 508 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_HsParseError :: Pos -> + String -> + T_Error +sem_Error_HsParseError pos_ msg_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 95, column 21) + _lhsOpp = + ({-# LINE 95 "./src-ag/PrintErrorMessages.ag" #-} + ppError True pos_ (text msg_) (text "") (text "") (text "Correct the syntax of the Haskell code.") _lhsIverbose + {-# LINE 523 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + HsParseError pos_ msg_ + {-# LINE 529 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 535 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_DupAlt :: NontermIdent -> + ConstructorIdent -> + ConstructorIdent -> + T_Error +sem_Error_DupAlt nt_ con_ occ1_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 97, column 21) + _lhsOpp = + ({-# LINE 97 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Repeated definition for alternative", getName con_ + ,"of nonterminal", getName nt_, "." + ] >-< + wfill ["First definition:", (showPos occ1_),"."] >-< + wfill ["Other definition:", (showPos con_),"."] + pat = "DATA" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< "...") + >-< indent 2 ("|" >#< getName con_ >#< "...") + help = wfill ["The nonterminal",getName nt_,"has more than one alternative that" + ,"is labelled with the constructor name",getName con_,"." + ,"You should either rename or remove enough of them to make all" + ,"constructors of",getName nt_,"uniquely named." + ] + act = wfill [ "The first alternative of name",getName con_ + ,"you have given for nonterminal",getName nt_ + ,"is considered valid. All other alternatives have been discarded." + ] + in ppError (isError _lhsIoptions _me) (getPos con_) mesg pat help act _lhsIverbose + {-# LINE 568 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + DupAlt nt_ con_ occ1_ + {-# LINE 574 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 580 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_DupSynonym :: NontermIdent -> + NontermIdent -> + T_Error +sem_Error_DupSynonym nt_ occ1_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 119, column 21) + _lhsOpp = + ({-# LINE 119 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Definition of type synonym", getName nt_, "clashes with another" + ,"type synonym." + ] >-< + wfill ["First definition:", (showPos occ1_),"."] >-< + wfill ["Type synonym :" , (showPos nt_),"."] + pat = "DATA" >#< getName nt_ + >-< indent 2 ("|" >#< "...") + >-< "TYPE" >#< getName nt_ >#< "=" >#< "..." + help = wfill ["A type synonym with name", getName nt_ + ,"has been given while there already is TYPE" + ,"definition with the same name." + ,"You should either rename or remove the type synonym." + ] + act = wfill [ "The clashing type synonym will be ignored." + ] + in ppError (isError _lhsIoptions _me) (getPos nt_) mesg pat help act _lhsIverbose + {-# LINE 610 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + DupSynonym nt_ occ1_ + {-# LINE 616 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 622 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_DupSet :: NontermIdent -> + NontermIdent -> + T_Error +sem_Error_DupSet name_ occ1_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 136, column 21) + _lhsOpp = + ({-# LINE 136 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Definition of nonterminal set", getName name_, "clashes with another" + ,"set, a type synonym or a data definition." + ] >-< + wfill ["First definition:", (showPos occ1_),"."] >-< + wfill ["Set definition:" , (showPos name_),"."] + pat = "SET" >#< getName name_ >#< "=" >#< "..." + >-< "SET" >#< getName name_ >#< "=" >#< "..." + help = wfill ["A nonterminal set with name", getName name_ + ,"has been given while there already is a SET, DATA, or TYPE" + ,"definition with the same name." + ,"You should either rename or remove the nonterminal set." + ] + act = wfill [ "The clashing nonterminal set will be ignored." + ] + in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose + {-# LINE 651 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + DupSet name_ occ1_ + {-# LINE 657 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 663 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_DupInhAttr :: NontermIdent -> + Identifier -> + Identifier -> + T_Error +sem_Error_DupInhAttr nt_ attr_ occ1_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 152, column 21) + _lhsOpp = + ({-# LINE 152 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Repeated declaration of inherited attribute", getName attr_ + , "of nonterminal", getName nt_, "." + ] >-< + wfill ["First definition:", (showPos occ1_),"."] >-< + wfill ["Other definition:", (showPos attr_),"."] + pat = "ATTR" >#< getName nt_ >#< "[" >#< getName attr_ >|< ":...," + >#< getName attr_ >|< ":... | | ]" + help = wfill ["The identifier" , getName attr_ ,"has been declared" + ,"as an inherited (or chained) attribute for nonterminal" + ,getName nt_ , "more than once, with possibly different types." + ,"Delete all but one or rename them to make them unique." + ] + act = wfill ["One declaration with its corresponding type is considered valid." + ,"All others have been discarded. The generated program will probably not run." + ] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 694 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + DupInhAttr nt_ attr_ occ1_ + {-# LINE 700 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 706 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_DupSynAttr :: NontermIdent -> + Identifier -> + Identifier -> + T_Error +sem_Error_DupSynAttr nt_ attr_ occ1_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 171, column 21) + _lhsOpp = + ({-# LINE 171 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Repeated declaration of synthesized attribute", getName attr_ + , "of nonterminal", getName nt_, "." + ] >-< + wfill ["First definition:", (showPos occ1_),"."] >-< + wfill ["Other definition:", (showPos attr_),"."] + pat = "ATTR" >#< getName nt_ >#< "[ | |" >#< getName attr_ >|< ":...," + >#< getName attr_ >|< ":... ]" + help = wfill ["The identifier" , getName attr_ ,"has been declared" + ,"as a synthesized (or chained) attribute for nonterminal" + ,getName nt_ , "more than once, with possibly different types." + ,"Delete all but one or rename them to make them unique." + ] + act = wfill ["One declaration with its corresponding type is considered valid." + ,"All others have been discarded. The generated program will probably not run." + ] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 737 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + DupSynAttr nt_ attr_ occ1_ + {-# LINE 743 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 749 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_DupChild :: NontermIdent -> + ConstructorIdent -> + Identifier -> + Identifier -> + T_Error +sem_Error_DupChild nt_ con_ name_ occ1_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 190, column 21) + _lhsOpp = + ({-# LINE 190 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Repeated declaration for field", getName name_, "of alternative" + ,getName con_, "of nonterminal", getName nt_, "." + ] >-< + wfill ["First definition:", (showPos occ1_),"."] >-< + wfill ["Other definition:", (showPos name_),"."] + pat = "DATA" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< (getName name_ >|< ":..." >-< getName name_ >|< ":...")) + help = wfill ["The alternative" ,getName con_ , "of nonterminal" ,getName nt_ + ,"has more than one field that is named" + , getName name_ ++ ". Possibly they have different types." + ,"You should either rename or remove enough of them to make all fields of" + ,getName con_ , "for nonterminal " , getName nt_ , "uniquely named." + ] + act = wfill ["The last declaration with its corresponding type is considered valid." + ,"All others have been discarded." + ] + in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose + {-# LINE 782 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + DupChild nt_ con_ name_ occ1_ + {-# LINE 788 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 794 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_DupRule :: NontermIdent -> + ConstructorIdent -> + Identifier -> + Identifier -> + Identifier -> + T_Error +sem_Error_DupRule nt_ con_ field_ attr_ occ1_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 210, column 21) + _lhsOpp = + ({-# LINE 210 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more rules for" + ,showAttrDef field_ attr_,"." + ] >-< + wfill ["First rule:", (showPos occ1_),"."] >-< + wfill ["Other rule:", (showPos attr_),"."] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") + >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") + help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_ + ,", there is more than one rule for the" , showAttrDef field_ attr_ + ,". You should either rename or remove enough of them to make all rules for alternative" + ,getName con_ , "of nonterminal " ,getName nt_ , "uniquely named." + ] + act = wfill ["The last rule given is considered valid. All others have been discarded."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 826 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + DupRule nt_ con_ field_ attr_ occ1_ + {-# LINE 832 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 838 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_DupRuleName :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_DupRuleName nt_ con_ nm_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 228, column 21) + _lhsOpp = + ({-# LINE 228 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more rule names for" + ,show nm_,"." + ] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< show nm_ >#< ": ... = ...") + >-< indent 2 ("|" >#< getName con_ >#< show nm_ >#< ": ... = ...") + help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_ + ,", there is more than one rule name " , show nm_ + ,". You should either rename or remove enough of them." + ] + act = wfill ["Compilation cannot continue."] + in ppError (isError _lhsIoptions _me) (getPos nm_) mesg pat help act _lhsIverbose + {-# LINE 865 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + DupRuleName nt_ con_ nm_ + {-# LINE 871 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 877 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_DupSig :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_DupSig nt_ con_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 243, column 21) + _lhsOpp = + ({-# LINE 243 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more typesignatures for" + ,showAttrDef _LOC attr_,"." + ] >-< + wfill ["First signature:", (showPos attr_),"."] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< "= ...") + >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< "= ...") + help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_ + ,", there is more than one rule for the" , showAttrDef _LOC attr_ + ,". You should remove enough of them to make all typesignatures for alternative" + ,getName con_ , "of nonterminal " ,getName nt_ , "unique." + ] + act = wfill ["The last typesignature given is considered valid. All others have been discarded."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 906 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + DupSig nt_ con_ attr_ + {-# LINE 912 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 918 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_UndefNont :: NontermIdent -> + T_Error +sem_Error_UndefNont nt_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 260, column 21) + _lhsOpp = + ({-# LINE 260 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Nonterminal", getName nt_, "is not defined." + ] + pat = "DATA" >#< getName nt_ >#< "..." + help = wfill ["There are attributes and/or rules for nonterminal" , getName nt_ ,", but there is no definition" + , "for" ,getName nt_, ". Maybe you misspelled it? Otherwise insert a definition." + ] + act = wfill ["Everything regarding the unknown nonterminal has been ignored."] + in ppError (isError _lhsIoptions _me) (getPos nt_) mesg pat help act _lhsIverbose + {-# LINE 939 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + UndefNont nt_ + {-# LINE 945 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 951 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_UndefAlt :: NontermIdent -> + ConstructorIdent -> + T_Error +sem_Error_UndefAlt nt_ con_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 270, column 21) + _lhsOpp = + ({-# LINE 270 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_, "is not defined." + ] + pat = "DATA" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< "...") + help = wfill ["There are rules for alternative", getName con_ , "of nonterminal" ,getName nt_ + ,", but there is no definition for this alternative in the definitions of the" + ,"nonterminal" , getName nt_, ". Maybe you misspelled it? Otherwise insert a definition." + ] + act = wfill ["All rules for the unknown alternative have been ignored."] + in ppError (isError _lhsIoptions _me) (getPos con_) mesg pat help act _lhsIverbose + {-# LINE 975 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + UndefAlt nt_ con_ + {-# LINE 981 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 987 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_UndefChild :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_UndefChild nt_ con_ name_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 282, column 21) + _lhsOpp = + ({-# LINE 282 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_ + , "does not have a nontrivial field named", getName name_ , "." + ] + pat = "SEM" >#< nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr name_ (identifier "") >#< "= ...") + help = wfill ["There are rules that define or use attributes of field" , getName name_ + ,"in alternative" , getName con_ , "of nonterminal" , getName nt_ + ,", but there is no field with AG-type in the definition of the alternative." + ,"Maybe you misspelled it? Otherwise insert the field into the definition," + ,"or change its type from an HS-type to an AG-type." + ] + act = wfill ["All rules for the unknown field have been ignored."] + in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose + {-# LINE 1015 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + UndefChild nt_ con_ name_ + {-# LINE 1021 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1027 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_MissingRule :: NontermIdent -> + ConstructorIdent -> + Identifier -> + Identifier -> + T_Error +sem_Error_MissingRule nt_ con_ field_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 297, column 21) + _lhsOpp = + ({-# LINE 297 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Missing rule for", showAttrDef field_ attr_ , "in alternative" + , getName con_ , "of nonterminal",getName nt_ ,"." + ] + pat = "SEM" >#< nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") + help = wfill ["The", showAttrDef field_ attr_, "in alternative", getName con_ + , "of nonterminal", getName nt_, "is missing and cannot be inferred" + ,"by a copy rule, so you should add an appropriate rule." + ] + act = wfill ["The value of the attribute has been set to undefined."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 1054 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + MissingRule nt_ con_ field_ attr_ + {-# LINE 1060 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1066 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_MissingNamedRule :: NontermIdent -> + Identifier -> + Identifier -> + T_Error +sem_Error_MissingNamedRule nt_ con_ name_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 310, column 23) + _lhsOpp = + ({-# LINE 310 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Missing rule name ", show name_ , "in alternative" + , getName con_ , "of nonterminal",getName nt_ ,"." + ] + pat = "SEM" >#< nt_ + >-< indent 2 ("|" >#< getName con_ >#< show name_ >#< ": ... = ...") + help = wfill ["There is a dependency on a rule with name ", show name_ , "in alternative" + , getName con_ , "of nonterminal",getName nt_ ,", but no rule has been defined with this name. Maybe you misspelled it?" + ] + act = wfill ["Compilation cannot continue."] + in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose + {-# LINE 1091 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + MissingNamedRule nt_ con_ name_ + {-# LINE 1097 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1103 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_SuperfluousRule :: NontermIdent -> + ConstructorIdent -> + Identifier -> + Identifier -> + T_Error +sem_Error_SuperfluousRule nt_ con_ field_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 322, column 21) + _lhsOpp = + ({-# LINE 322 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Rule for non-existing", showAttrDef field_ attr_ , "at alternative" + , getName con_ , "of nonterminal",getName nt_, "." + ] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") + help = wfill ["There is a rule for" , showAttrDef field_ attr_ , "in the definitions for alternative" , getName con_ + ,"of nonterminal" , getName nt_, ", but this attribute does not exist. Maybe you misspelled it?" + ,"Otherwise either remove the rule or add an appropriate attribute definition." + ] + act = wfill ["The rule has been ignored."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 1130 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + SuperfluousRule nt_ con_ field_ attr_ + {-# LINE 1136 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1142 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_UndefLocal :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_UndefLocal nt_ con_ var_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 336, column 21) + _lhsOpp = + ({-# LINE 336 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Undefined local variable or field",getName var_, "at constructor" + , getName con_ , "of nonterminal",getName nt_, "." + ] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< ". = " + >#< "..." >#< "@" >|< getName var_ >#< "..." ) + help = wfill ["A rule in the definitions for alternative" , getName con_ ,"of nonterminal" + , getName nt_ , "contains a local variable or field name that is not defined. " + ,"Maybe you misspelled it?" + ,"Otherwise either remove the rule or add an appropriate definition." + ] + act = wfill ["The generated program will not run."] + in ppError (isError _lhsIoptions _me) (getPos var_) mesg pat help act _lhsIverbose + {-# LINE 1170 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + UndefLocal nt_ con_ var_ + {-# LINE 1176 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1182 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_ChildAsLocal :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_ChildAsLocal nt_ con_ var_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 351, column 21) + _lhsOpp = + ({-# LINE 351 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Nontrivial field ",getName var_, "is used as local at constructor" + , getName con_ , "of nonterminal",getName nt_, "." + ] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< "... = " + >#< "..." >#< "@" >|< getName var_ >#< "..." ) + help = wfill ["A rule in the definitions for alternative" , getName con_ ,"of nonterminal" + , getName nt_ , "contains a nontrivial field name", getName var_, "." + ,"You should use @", getName var_, ".self instead, where self is a SELF-attribute." + ] + act = wfill ["The generated program probably contains a type error or has undefined variables."] + in ppError (isError _lhsIoptions _me) (getPos var_) mesg pat help act _lhsIverbose + {-# LINE 1209 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + ChildAsLocal nt_ con_ var_ + {-# LINE 1215 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1221 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_UndefAttr :: NontermIdent -> + ConstructorIdent -> + Identifier -> + Identifier -> + Bool -> + T_Error +sem_Error_UndefAttr nt_ con_ field_ attr_ isOut_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 365, column 21) + _lhsOpp = + ({-# LINE 365 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Undefined" + , if isOut_ + then showAttrDef field_ attr_ + else showAttrUse field_ attr_ + , "at constructor" + , getName con_ , "of nonterminal",getName nt_, "." + ] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< ". = " + >#< "..." >#< ppAttrUse field_ attr_ >#< "...") + help = wfill ["A rule in the definitions for alternative" , getName con_ ,"of nonterminal" + ,getName nt_ , "contains an attribute that is not defined" + ,"Maybe you misspelled it?" + ,"Otherwise either remove the rule or add an appropriate attribute definition." + ] + act = wfill ["The generated program will not run."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 1255 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + UndefAttr nt_ con_ field_ attr_ isOut_ + {-# LINE 1261 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1267 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_Cyclic :: NontermIdent -> + (Maybe ConstructorIdent) -> + ([String]) -> + T_Error +sem_Error_Cyclic nt_ mbCon_ verts_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 393, column 21) + _lhsOpp = + ({-# LINE 393 "./src-ag/PrintErrorMessages.ag" #-} + let pos = getPos nt_ + mesg = text "Circular dependency for nonterminal" >#< getName nt_ + >#< ( case mbCon_ of + Nothing -> empty + Just con -> text "and constructor" >#< con + ) + >#< ( case verts_ of + v : _ -> text "including vertex" >#< text v + _ -> empty + ) + pat = text "cyclic rule definition" + help = hlist (text "The following attributes are all cyclic: " : map text verts_) + act = wfill ["code cannot be generated until the cycle is removed."] + in ppError (isError _lhsIoptions _me) pos mesg pat help act False + {-# LINE 1296 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + Cyclic nt_ mbCon_ verts_ + {-# LINE 1302 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1308 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_CyclicSet :: Identifier -> + T_Error +sem_Error_CyclicSet name_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 384, column 21) + _lhsOpp = + ({-# LINE 384 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Cyclic definition for nonterminal set", getName name_] + pat = "SET" >#< getName name_ >#< "=" >#< "..." >#< getName name_ >#< "..." + help = wfill ["The defintion for a nonterminal set named" , getName name_ + ,"directly or indirectly refers to itself." + ,"Adapt the definition of the nonterminal set, to remove the cyclic dependency." + ] + act = wfill ["The nonterminal set", getName name_, "is considered to be empty."] + in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose + {-# LINE 1329 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + CyclicSet name_ + {-# LINE 1335 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1341 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_CustomError :: Bool -> + Pos -> + PP_Doc -> + T_Error +sem_Error_CustomError isWarning_ pos_ mesg_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 408, column 21) + _lhsOpp = + ({-# LINE 408 "./src-ag/PrintErrorMessages.ag" #-} + let pat = text "unknown" + help = wfill ["not available."] + act = wfill ["unknown"] + in ppError (isError _lhsIoptions _me) pos_ mesg_ pat help act False + {-# LINE 1360 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + CustomError isWarning_ pos_ mesg_ + {-# LINE 1366 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1372 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_LocalCirc :: NontermIdent -> + ConstructorIdent -> + Identifier -> + Bool -> + ([String]) -> + T_Error +sem_Error_LocalCirc nt_ con_ attr_ o_visit_ path_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 413, column 21) + _lhsOpp = + ({-# LINE 413 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Circular dependency for local attribute", getName attr_ + , "of alternative", getName con_, "of nonterminal", getName nt_] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< "loc." >|< getName attr_ >#< "=" + >#< "..." >#< "@loc." >|< getName attr_ >#< "...") + help = if null path_ + then text "the definition is directly circular" + else hlist ("The following attributes are involved in the cycle:": path_) + act | o_visit_ = text "An unoptimized version was generated. It might hang when run." + | otherwise = text "The generated program might hang when run." + in ppError (isError _lhsIoptions _me) (getPos (attr_)) mesg pat help act _lhsIverbose + {-# LINE 1400 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + LocalCirc nt_ con_ attr_ o_visit_ path_ + {-# LINE 1406 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1412 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_InstCirc :: NontermIdent -> + ConstructorIdent -> + Identifier -> + Bool -> + ([String]) -> + T_Error +sem_Error_InstCirc nt_ con_ attr_ o_visit_ path_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 425, column 21) + _lhsOpp = + ({-# LINE 425 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Circular dependency for inst attribute", getName attr_ + , "of alternative", getName con_, "of nonterminal", getName nt_] + pat = "SEM" >#< getName nt_ + >-< indent 2 ("|" >#< getName con_ >#< "inst." >|< getName attr_ >#< "=" + >#< "..." >#< "@s." >#< "...") + help = if null path_ + then text "the definition is directly circular" + else hlist ("The following attributes are involved in the cycle:": path_) + act | o_visit_ = text "An unoptimized version was generated. It might hang when run." + | otherwise = text "The generated program might hang when run." + in ppError (isError _lhsIoptions _me) (getPos (attr_)) mesg pat help act _lhsIverbose + {-# LINE 1440 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + InstCirc nt_ con_ attr_ o_visit_ path_ + {-# LINE 1446 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1452 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_DirectCirc :: NontermIdent -> + Bool -> + ([((Identifier,Identifier),[String],[String])]) -> + T_Error +sem_Error_DirectCirc nt_ o_visit_ cyclic_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 437, column 21) + _lhsOpp = + ({-# LINE 437 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["In nonterminal", getName nt_, "synthesized and inherited attributes are mutually dependent" ] + >-< vlist (map showEdge cyclic_) + pat = text "" + help = vlist (map showEdgeLong cyclic_) + act | o_visit_ = text "An unoptimized version was generated. It might hang when run." + | otherwise = text "The generated program might hang when run." + in ppError (isError _lhsIoptions _me) noPos mesg pat help act _lhsIverbose + {-# LINE 1474 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + DirectCirc nt_ o_visit_ cyclic_ + {-# LINE 1480 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1486 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_InducedCirc :: NontermIdent -> + CInterface -> + ([((Identifier,Identifier),[String],[String])]) -> + T_Error +sem_Error_InducedCirc nt_ cinter_ cyclic_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 445, column 21) + _lhsOpp = + ({-# LINE 445 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["After scheduling, in nonterminal", getName nt_, "synthesized and inherited attributes have an INDUCED mutual dependency" ] + >-< vlist (map showEdge cyclic_) + pat = text "" + showInter (CInterface segs) = concat (snd (mapAccumL (\i c -> (i+1,("visit " ++ show i) : map ind (showsSegment c))) 0 segs)) + help = vlist (("Interface for nonterminal " ++ getName nt_ ++ ":") : map ind (showInter cinter_)) + >-< vlist (map showEdgeLong cyclic_) + act = text "An unoptimized version was generated. It might hang when run." + in ppError (isError _lhsIoptions _me) noPos mesg pat help act _lhsIverbose + {-# LINE 1509 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + InducedCirc nt_ cinter_ cyclic_ + {-# LINE 1515 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1521 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_MissingTypeSig :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_MissingTypeSig nt_ con_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 454, column 21) + _lhsOpp = + ({-# LINE 454 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Type signature needed, but not found for", showAttrDef _LOC attr_ , "in alternative" + , getName con_ , "of nonterminal",getName nt_ ,"." + ]>-< + wfill ["Location:", (showPos attr_),"."] + pat = "SEM" >#< nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< ": ...") + help = wfill ["The", showAttrDef _LOC attr_, "in alternative", getName con_ + ,"of nonterminal", getName nt_, "is needed in two separate visits to", getName nt_ + ,"so its type is needed to generate type signatures." + ,"Please supply its type." + ] + act = wfill ["The type signatures of semantic functions are not generated."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 1549 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + MissingTypeSig nt_ con_ attr_ + {-# LINE 1555 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1561 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_MissingInstSig :: NontermIdent -> + ConstructorIdent -> + Identifier -> + T_Error +sem_Error_MissingInstSig nt_ con_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 468, column 21) + _lhsOpp = + ({-# LINE 468 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Type signature needed, but not found for", showAttrDef _INST attr_ , "in alternative" + , getName con_ , "of nonterminal",getName nt_ ,"." + ]>-< + wfill ["Location:", (showPos attr_),"."] + pat = "SEM" >#< nt_ + >-< indent 2 ("|" >#< getName con_ >#< ppAttr _INST attr_ >#< ": ...") + help = wfill ["The", showAttrDef _INST attr_, "in alternative", getName con_ + ,"of nonterminal", getName nt_, "is a non-terminal attribute, so " + ,"its type is needed to attribute its value." + ,"Please supply its type." + ] + act = wfill ["It is not possible to proceed without this signature."] + in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose + {-# LINE 1589 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + MissingInstSig nt_ con_ attr_ + {-# LINE 1595 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1601 "dist/build/PrintErrorMessages.hs" #-} + ) + 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 + -- "./src-ag/PrintErrorMessages.ag"(line 498, column 21) + _lhsOpp = + ({-# LINE 498 "./src-ag/PrintErrorMessages.ag" #-} + 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 + {-# LINE 1630 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + DupUnique nt_ con_ attr_ + {-# LINE 1636 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1642 "dist/build/PrintErrorMessages.hs" #-} + ) + 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 + -- "./src-ag/PrintErrorMessages.ag"(line 482, column 21) + _lhsOpp = + ({-# LINE 482 "./src-ag/PrintErrorMessages.ag" #-} + 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 + {-# LINE 1670 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + MissingUnique nt_ attr_ + {-# LINE 1676 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1682 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_MissingSyn :: NontermIdent -> + Identifier -> + T_Error +sem_Error_MissingSyn nt_ attr_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 515, column 20) + _lhsOpp = + ({-# LINE 515 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = wfill ["Missing synthesized attribute" + , getName attr_ + , "at nonterminal" + , getName nt_, "." + ] + pat = "ATTR" >#< getName nt_ >#< "[ | | " >#< getName attr_ >#< " : ... ]" + help = wfill ["An augment rule for a constructor for nonterminal" , getName nt_ + , "refers to a synthesized attribute named " + , getName attr_ + ,"Maybe you misspelled it?" + ,"Otherwise 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 + {-# LINE 1710 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + MissingSyn nt_ attr_ + {-# LINE 1716 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1722 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_IncompatibleVisitKind :: Identifier -> + VisitIdentifier -> + VisitKind -> + VisitKind -> + T_Error +sem_Error_IncompatibleVisitKind child_ vis_ from_ to_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 531, column 20) + _lhsOpp = + ({-# LINE 531 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = "visit" >#< vis_ >#< "of child" >#< child_ >#< " with kind" >#< show to_ >#< " cannot be called from a visit with kind " >#< show from_ + pat = empty + help = empty + act = text "It is not possible to proceed without fixing this kind error." + in ppError (isError _lhsIoptions _me) (getPos child_) mesg pat help act _lhsIverbose + {-# LINE 1743 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + IncompatibleVisitKind child_ vis_ from_ to_ + {-# LINE 1749 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1755 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_IncompatibleRuleKind :: Identifier -> + VisitKind -> + T_Error +sem_Error_IncompatibleRuleKind rule_ kind_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 537, column 20) + _lhsOpp = + ({-# LINE 537 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = "rule" >#< rule_ >#< "cannot be called from a visit with kind " >#< show kind_ + pat = empty + help = empty + act = text "It is not possible to proceed without fixing this kind error." + in ppError (isError _lhsIoptions _me) (getPos rule_) mesg pat help act _lhsIverbose + {-# LINE 1774 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + IncompatibleRuleKind rule_ kind_ + {-# LINE 1780 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1786 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +sem_Error_IncompatibleAttachKind :: Identifier -> + VisitKind -> + T_Error +sem_Error_IncompatibleAttachKind child_ kind_ = + (T_Error (\ _lhsIoptions + _lhsIverbose -> + (let _lhsOpp :: PP_Doc + _lhsOme :: Error + -- "./src-ag/PrintErrorMessages.ag"(line 544, column 20) + _lhsOpp = + ({-# LINE 544 "./src-ag/PrintErrorMessages.ag" #-} + let mesg = "child" >#< child_ >#< "cannot be called from a visit with kind " >#< show kind_ + pat = empty + help = empty + act = text "It is not possible to proceed without fixing this kind error." + in ppError (isError _lhsIoptions _me) (getPos child_) mesg pat help act _lhsIverbose + {-# LINE 1805 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _me = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + IncompatibleAttachKind child_ kind_ + {-# LINE 1811 "dist/build/PrintErrorMessages.hs" #-} + ) + -- self rule + _lhsOme = + ({-# LINE 71 "./src-ag/PrintErrorMessages.ag" #-} + _me + {-# LINE 1817 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOme,_lhsOpp)))) +-- Errors ------------------------------------------------------ +{- + visit 0: + inherited attributes: + dups : [String] + options : Options + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Cons: + child hd : Error + child tl : Errors + visit 0: + local verbose : _ + local str : _ + alternative Nil: + visit 0: + local verbose : _ +-} +-- cata +sem_Errors :: Errors -> + T_Errors +sem_Errors list = + (Prelude.foldr sem_Errors_Cons sem_Errors_Nil (Prelude.map sem_Error list)) +-- semantic domain +newtype T_Errors = T_Errors (([String]) -> + Options -> + ( PP_Doc)) +data Inh_Errors = Inh_Errors {dups_Inh_Errors :: ([String]),options_Inh_Errors :: Options} +data Syn_Errors = Syn_Errors {pp_Syn_Errors :: PP_Doc} +wrap_Errors :: T_Errors -> + Inh_Errors -> + Syn_Errors +wrap_Errors (T_Errors sem) (Inh_Errors _lhsIdups _lhsIoptions) = + (let ( _lhsOpp) = sem _lhsIdups _lhsIoptions + in (Syn_Errors _lhsOpp)) +sem_Errors_Cons :: T_Error -> + T_Errors -> + T_Errors +sem_Errors_Cons (T_Error hd_) (T_Errors tl_) = + (T_Errors (\ _lhsIdups + _lhsIoptions -> + (let _lhsOpp :: PP_Doc + _tlOdups :: ([String]) + _hdOoptions :: Options + _hdOverbose :: Bool + _tlOoptions :: Options + _hdIme :: Error + _hdIpp :: PP_Doc + _tlIpp :: PP_Doc + -- "./src-ag/PrintErrorMessages.ag"(line 78, column 8) + _verbose = + ({-# LINE 78 "./src-ag/PrintErrorMessages.ag" #-} + verbose _lhsIoptions + {-# LINE 1874 "dist/build/PrintErrorMessages.hs" #-} + ) + -- "./src-ag/PrintErrorMessages.ag"(line 79, column 11) + _str = + ({-# LINE 79 "./src-ag/PrintErrorMessages.ag" #-} + disp _hdIpp 5000 "" + {-# LINE 1880 "dist/build/PrintErrorMessages.hs" #-} + ) + -- "./src-ag/PrintErrorMessages.ag"(line 81, column 11) + _lhsOpp = + ({-# LINE 81 "./src-ag/PrintErrorMessages.ag" #-} + if _str `elem` _lhsIdups + then _tlIpp + else _hdIpp >-< _tlIpp + {-# LINE 1888 "dist/build/PrintErrorMessages.hs" #-} + ) + -- "./src-ag/PrintErrorMessages.ag"(line 84, column 11) + _tlOdups = + ({-# LINE 84 "./src-ag/PrintErrorMessages.ag" #-} + _str : _lhsIdups + {-# LINE 1894 "dist/build/PrintErrorMessages.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 70 "./src-ag/PrintErrorMessages.ag" #-} + _lhsIoptions + {-# LINE 1900 "dist/build/PrintErrorMessages.hs" #-} + ) + -- copy rule (from local) + _hdOverbose = + ({-# LINE 70 "./src-ag/PrintErrorMessages.ag" #-} + _verbose + {-# LINE 1906 "dist/build/PrintErrorMessages.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 74 "./src-ag/PrintErrorMessages.ag" #-} + _lhsIoptions + {-# LINE 1912 "dist/build/PrintErrorMessages.hs" #-} + ) + ( _hdIme,_hdIpp) = + hd_ _hdOoptions _hdOverbose + ( _tlIpp) = + tl_ _tlOdups _tlOoptions + in ( _lhsOpp)))) +sem_Errors_Nil :: T_Errors +sem_Errors_Nil = + (T_Errors (\ _lhsIdups + _lhsIoptions -> + (let _lhsOpp :: PP_Doc + -- "./src-ag/PrintErrorMessages.ag"(line 78, column 8) + _verbose = + ({-# LINE 78 "./src-ag/PrintErrorMessages.ag" #-} + verbose _lhsIoptions + {-# LINE 1928 "dist/build/PrintErrorMessages.hs" #-} + ) + -- "./src-ag/PrintErrorMessages.ag"(line 85, column 11) + _lhsOpp = + ({-# LINE 85 "./src-ag/PrintErrorMessages.ag" #-} + text "" + {-# LINE 1934 "dist/build/PrintErrorMessages.hs" #-} + ) + in ( _lhsOpp)))) diff --git a/dist/build/PrintOcamlCode.hs b/dist/build/PrintOcamlCode.hs new file mode 100644 --- /dev/null +++ b/dist/build/PrintOcamlCode.hs @@ -0,0 +1,2223 @@ +{-# OPTIONS_GHC -XBangPatterns #-} + +-- UUAGC 0.9.42.0 (src-ag/PrintOcamlCode.ag) +module PrintOcamlCode where +{-# LINE 10 "./src-ag/PrintOcamlCode.ag" #-} + +import Pretty +import Code +import Patterns +import Options +import CommonTypes hiding (List,Type,Map,Maybe,IntMap,Either) +import Data.List(intersperse,intercalate) +import Data.Char(toLower) +{-# LINE 15 "dist/build/PrintOcamlCode.hs" #-} + +{-# LINE 2 "./src-ag/Code.ag" #-} + +import Pretty +import Patterns +import Data.List(partition) +import Data.Set(Set) +import qualified Data.Set as Set +import Data.Map(Map) +import qualified Data.Map as Map +{-# LINE 26 "dist/build/PrintOcamlCode.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 33 "dist/build/PrintOcamlCode.hs" #-} +{-# LINE 21 "./src-ag/PrintOcamlCode.ag" #-} + +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 + +ppTuple True pps = "(" >|< pp_block " " (replicate (length pps `max` 1) ')') ",(" pps +ppTuple False pps = "(" >|< pp_block " " ")" "," pps +{-# LINE 50 "dist/build/PrintOcamlCode.hs" #-} + +{-# LINE 174 "./src-ag/PrintOcamlCode.ag" #-} + +toOcamlTC (c:cs) = toLower c : cs +toOcamlTC xs = xs +{-# LINE 56 "dist/build/PrintOcamlCode.hs" #-} + +{-# LINE 146 "./src-ag/Code.ag" #-} + +-- 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 +{-# LINE 75 "dist/build/PrintOcamlCode.hs" #-} +-- CaseAlt ----------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attribute: + pp : PP_Doc + 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 (Options -> + ( PP_Doc)) +data Inh_CaseAlt = Inh_CaseAlt {options_Inh_CaseAlt :: !(Options)} +data Syn_CaseAlt = Syn_CaseAlt {pp_Syn_CaseAlt :: !(PP_Doc)} +wrap_CaseAlt :: T_CaseAlt -> + Inh_CaseAlt -> + Syn_CaseAlt +wrap_CaseAlt !(T_CaseAlt sem) !(Inh_CaseAlt _lhsIoptions) = + (let ( !_lhsOpp) = sem _lhsIoptions + in (Syn_CaseAlt _lhsOpp)) +sem_CaseAlt_CaseAlt :: T_Lhs -> + T_Expr -> + T_CaseAlt +sem_CaseAlt_CaseAlt !(T_Lhs left_) !(T_Expr expr_) = + (T_CaseAlt (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 111 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions) of + { ( !_exprIpp) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 118 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_leftOoptions -> + (case (left_ _leftOoptions) of + { ( !_leftIpp) -> + (case (({-# LINE 180 "./src-ag/PrintOcamlCode.ag" #-} + _leftIpp >#< "->" >#< _exprIpp + {-# LINE 125 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +-- CaseAlts ---------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + 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 (Options -> + ( PP_Docs)) +data Inh_CaseAlts = Inh_CaseAlts {options_Inh_CaseAlts :: !(Options)} +data Syn_CaseAlts = Syn_CaseAlts {pps_Syn_CaseAlts :: !(PP_Docs)} +wrap_CaseAlts :: T_CaseAlts -> + Inh_CaseAlts -> + Syn_CaseAlts +wrap_CaseAlts !(T_CaseAlts sem) !(Inh_CaseAlts _lhsIoptions) = + (let ( !_lhsOpps) = sem _lhsIoptions + in (Syn_CaseAlts _lhsOpps)) +sem_CaseAlts_Cons :: T_CaseAlt -> + T_CaseAlts -> + T_CaseAlts +sem_CaseAlts_Cons !(T_CaseAlt hd_) !(T_CaseAlts tl_) = + (T_CaseAlts (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 165 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_tlOoptions -> + (case (tl_ _tlOoptions) of + { ( !_tlIpps) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 172 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_hdOoptions -> + (case (hd_ _hdOoptions) of + { ( !_hdIpp) -> + (case (({-# LINE 64 "./src-ag/PrintOcamlCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 179 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }))) +sem_CaseAlts_Nil :: T_CaseAlts +sem_CaseAlts_Nil = + (T_CaseAlts (\ (!_lhsIoptions) -> + (case (({-# LINE 65 "./src-ag/PrintOcamlCode.ag" #-} + [] + {-# LINE 188 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }))) +-- Chunk ------------------------------------------------------- +{- + visit 0: + inherited attributes: + isToplevel : Bool + options : Options + textBlockMap : Map BlockInfo PP_Doc + synthesized attribute: + 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]} +-} +-- 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 (Bool -> + Options -> + (Map BlockInfo PP_Doc) -> + ( PP_Docs)) +data Inh_Chunk = Inh_Chunk {isToplevel_Inh_Chunk :: !(Bool),options_Inh_Chunk :: !(Options),textBlockMap_Inh_Chunk :: !((Map BlockInfo PP_Doc))} +data Syn_Chunk = Syn_Chunk {pps_Syn_Chunk :: !(PP_Docs)} +wrap_Chunk :: T_Chunk -> + Inh_Chunk -> + Syn_Chunk +wrap_Chunk !(T_Chunk sem) !(Inh_Chunk _lhsIisToplevel _lhsIoptions _lhsItextBlockMap) = + (let ( !_lhsOpps) = sem _lhsIisToplevel _lhsIoptions _lhsItextBlockMap + in (Syn_Chunk _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 (\ (!_lhsIisToplevel) + (!_lhsIoptions) + (!_lhsItextBlockMap) -> + (case (({-# LINE 209 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 247 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_semFunctionsOisToplevel -> + (case (({-# LINE 209 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 252 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_semWrapperOisToplevel -> + (case (({-# LINE 209 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 257 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_semDomOisToplevel -> + (case (({-# LINE 209 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 262 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_cataFunOisToplevel -> + (case (({-# LINE 209 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 267 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_dataDefOisToplevel -> + (case (({-# LINE 209 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 272 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_infoOisToplevel -> + (case (({-# LINE 209 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 277 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_commentOisToplevel -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 282 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_semFunctionsOoptions -> + (case (semFunctions_ _semFunctionsOisToplevel _semFunctionsOoptions) of + { ( !_semFunctionsIpps) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 289 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_semWrapperOoptions -> + (case (semWrapper_ _semWrapperOisToplevel _semWrapperOoptions) of + { ( !_semWrapperIpps) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 296 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_semDomOoptions -> + (case (semDom_ _semDomOisToplevel _semDomOoptions) of + { ( !_semDomIpps) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 303 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_cataFunOoptions -> + (case (cataFun_ _cataFunOisToplevel _cataFunOoptions) of + { ( !_cataFunIpps) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 310 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_dataDefOoptions -> + (case (dataDef_ _dataDefOisToplevel _dataDefOoptions) of + { ( !_dataDefIpps) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 317 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_infoOoptions -> + (case (info_ _infoOisToplevel _infoOoptions) of + { ( !_infoIpps) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 324 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_commentOoptions -> + (case (comment_ _commentOisToplevel _commentOoptions) of + { ( !_commentIpp) -> + (case (({-# LINE 96 "./src-ag/PrintOcamlCode.ag" #-} + _commentIpp + : _infoIpps + ++ _dataDefIpps + ++ _semDomIpps + ++ _semFunctionsIpps + ++ _semWrapperIpps + ++ _cataFunIpps + ++ [Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap] + {-# LINE 338 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) +-- Chunks ------------------------------------------------------ +{- + visit 0: + inherited attributes: + isToplevel : Bool + options : Options + textBlockMap : Map BlockInfo PP_Doc + synthesized attribute: + 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 (Bool -> + Options -> + (Map BlockInfo PP_Doc) -> + ( PP_Docs)) +data Inh_Chunks = Inh_Chunks {isToplevel_Inh_Chunks :: !(Bool),options_Inh_Chunks :: !(Options),textBlockMap_Inh_Chunks :: !((Map BlockInfo PP_Doc))} +data Syn_Chunks = Syn_Chunks {pps_Syn_Chunks :: !(PP_Docs)} +wrap_Chunks :: T_Chunks -> + Inh_Chunks -> + Syn_Chunks +wrap_Chunks !(T_Chunks sem) !(Inh_Chunks _lhsIisToplevel _lhsIoptions _lhsItextBlockMap) = + (let ( !_lhsOpps) = sem _lhsIisToplevel _lhsIoptions _lhsItextBlockMap + in (Syn_Chunks _lhsOpps)) +sem_Chunks_Cons :: T_Chunk -> + T_Chunks -> + T_Chunks +sem_Chunks_Cons !(T_Chunk hd_) !(T_Chunks tl_) = + (T_Chunks (\ (!_lhsIisToplevel) + (!_lhsIoptions) + (!_lhsItextBlockMap) -> + (case (({-# LINE 45 "./src-ag/PrintOcamlCode.ag" #-} + _lhsItextBlockMap + {-# LINE 384 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_tlOtextBlockMap -> + (case (({-# LINE 209 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 389 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_tlOisToplevel -> + (case (({-# LINE 45 "./src-ag/PrintOcamlCode.ag" #-} + _lhsItextBlockMap + {-# LINE 394 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_hdOtextBlockMap -> + (case (({-# LINE 209 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 399 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_hdOisToplevel -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 404 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_tlOoptions -> + (case (tl_ _tlOisToplevel _tlOoptions _tlOtextBlockMap) of + { ( !_tlIpps) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 411 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_hdOoptions -> + (case (hd_ _hdOisToplevel _hdOoptions _hdOtextBlockMap) of + { ( !_hdIpps) -> + (case (({-# LINE 84 "./src-ag/PrintOcamlCode.ag" #-} + _hdIpps ++ _tlIpps + {-# LINE 418 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }) }) }))) +sem_Chunks_Nil :: T_Chunks +sem_Chunks_Nil = + (T_Chunks (\ (!_lhsIisToplevel) + (!_lhsIoptions) + (!_lhsItextBlockMap) -> + (case (({-# LINE 85 "./src-ag/PrintOcamlCode.ag" #-} + [] + {-# LINE 429 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }))) +-- DataAlt ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative DataAlt: + child name : {String} + child args : Types + alternative Record: + child name : {String} + child args : NamedTypes +-} +-- cata +sem_DataAlt :: DataAlt -> + T_DataAlt +sem_DataAlt !(DataAlt _name _args) = + (sem_DataAlt_DataAlt _name (sem_Types _args)) +sem_DataAlt !(Record _name _args) = + (sem_DataAlt_Record _name (sem_NamedTypes _args)) +-- semantic domain +newtype T_DataAlt = T_DataAlt (( PP_Doc)) +data Inh_DataAlt = Inh_DataAlt {} +data Syn_DataAlt = Syn_DataAlt {pp_Syn_DataAlt :: !(PP_Doc)} +wrap_DataAlt :: T_DataAlt -> + Inh_DataAlt -> + Syn_DataAlt +wrap_DataAlt !(T_DataAlt sem) !(Inh_DataAlt) = + (let ( !_lhsOpp) = sem + in (Syn_DataAlt _lhsOpp)) +sem_DataAlt_DataAlt :: String -> + T_Types -> + T_DataAlt +sem_DataAlt_DataAlt !name_ !(T_Types args_) = + (T_DataAlt (case (args_) of + { ( !_argsIpps) -> + (case (({-# LINE 183 "./src-ag/PrintOcamlCode.ag" #-} + name_ >#< "of" >#< pp_block "" "" " * " (map pp_parens _argsIpps) + {-# LINE 471 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) })) +sem_DataAlt_Record :: String -> + T_NamedTypes -> + T_DataAlt +sem_DataAlt_Record !name_ !(T_NamedTypes args_) = + (T_DataAlt (case (args_) of + { ( !_argsIpps) -> + (case (({-# LINE 184 "./src-ag/PrintOcamlCode.ag" #-} + pp_block "{" "}" ";" _argsIpps + {-# LINE 483 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) })) +-- DataAlts ---------------------------------------------------- +{- + visit 0: + 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 (( PP_Docs)) +data Inh_DataAlts = Inh_DataAlts {} +data Syn_DataAlts = Syn_DataAlts {pps_Syn_DataAlts :: !(PP_Docs)} +wrap_DataAlts :: T_DataAlts -> + Inh_DataAlts -> + Syn_DataAlts +wrap_DataAlts !(T_DataAlts sem) !(Inh_DataAlts) = + (let ( !_lhsOpps) = sem + in (Syn_DataAlts _lhsOpps)) +sem_DataAlts_Cons :: T_DataAlt -> + T_DataAlts -> + T_DataAlts +sem_DataAlts_Cons !(T_DataAlt hd_) !(T_DataAlts tl_) = + (T_DataAlts (case (tl_) of + { ( !_tlIpps) -> + (case (hd_) of + { ( !_hdIpp) -> + (case (({-# LINE 68 "./src-ag/PrintOcamlCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 523 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) })) +sem_DataAlts_Nil :: T_DataAlts +sem_DataAlts_Nil = + (T_DataAlts (case (({-# LINE 69 "./src-ag/PrintOcamlCode.ag" #-} + [] + {-# LINE 531 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) })) +-- Decl -------------------------------------------------------- +{- + visit 0: + inherited attributes: + isToplevel : Bool + options : Options + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Decl: + child left : Lhs + child rhs : Expr + child binds : {Set String} + child uses : {Set String} + alternative Bind: + child left : Lhs + child rhs : Expr + alternative BindLet: + child left : Lhs + child rhs : Expr + alternative Data: + child name : {String} + child params : {[String]} + child alts : DataAlts + child strict : {Bool} + child derivings : {[String]} + alternative NewType: + child name : {String} + child params : {[String]} + child con : {String} + child tp : Type + alternative Type: + child name : {String} + child params : {[String]} + child tp : Type + alternative TSig: + child name : {String} + child tp : Type + alternative Comment: + child txt : {String} + alternative PragmaDecl: + child txt : {String} + alternative Resume: + child monadic : {Bool} + child nt : {String} + child left : Lhs + child rhs : Expr + alternative EvalDecl: + child nt : {String} + child left : Lhs + child rhs : Expr +-} +-- cata +sem_Decl :: Decl -> + T_Decl +sem_Decl !(Decl _left _rhs _binds _uses) = + (sem_Decl_Decl (sem_Lhs _left) (sem_Expr _rhs) _binds _uses) +sem_Decl !(Bind _left _rhs) = + (sem_Decl_Bind (sem_Lhs _left) (sem_Expr _rhs)) +sem_Decl !(BindLet _left _rhs) = + (sem_Decl_BindLet (sem_Lhs _left) (sem_Expr _rhs)) +sem_Decl !(Data _name _params _alts _strict _derivings) = + (sem_Decl_Data _name _params (sem_DataAlts _alts) _strict _derivings) +sem_Decl !(NewType _name _params _con _tp) = + (sem_Decl_NewType _name _params _con (sem_Type _tp)) +sem_Decl !(Type _name _params _tp) = + (sem_Decl_Type _name _params (sem_Type _tp)) +sem_Decl !(TSig _name _tp) = + (sem_Decl_TSig _name (sem_Type _tp)) +sem_Decl !(Comment _txt) = + (sem_Decl_Comment _txt) +sem_Decl !(PragmaDecl _txt) = + (sem_Decl_PragmaDecl _txt) +sem_Decl !(Resume _monadic _nt _left _rhs) = + (sem_Decl_Resume _monadic _nt (sem_Lhs _left) (sem_Expr _rhs)) +sem_Decl !(EvalDecl _nt _left _rhs) = + (sem_Decl_EvalDecl _nt (sem_Lhs _left) (sem_Expr _rhs)) +-- semantic domain +newtype T_Decl = T_Decl (Bool -> + Options -> + ( PP_Doc)) +data Inh_Decl = Inh_Decl {isToplevel_Inh_Decl :: !(Bool),options_Inh_Decl :: !(Options)} +data Syn_Decl = Syn_Decl {pp_Syn_Decl :: !(PP_Doc)} +wrap_Decl :: T_Decl -> + Inh_Decl -> + Syn_Decl +wrap_Decl !(T_Decl sem) !(Inh_Decl _lhsIisToplevel _lhsIoptions) = + (let ( !_lhsOpp) = sem _lhsIisToplevel _lhsIoptions + in (Syn_Decl _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 (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 634 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (rhs_ _rhsOoptions) of + { ( !_rhsIpp) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 641 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_leftOoptions -> + (case (left_ _leftOoptions) of + { ( !_leftIpp) -> + (case (({-# LINE 106 "./src-ag/PrintOcamlCode.ag" #-} + if _lhsIisToplevel + then "let" >#< _leftIpp >#< "=" + >-< indent 4 _rhsIpp >#< ";;" + else "let" >#< _leftIpp >#< "=" + >-< indent 4 _rhsIpp >#< "in" + {-# LINE 652 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Decl_Bind :: T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_Bind !(T_Lhs left_) !(T_Expr rhs_) = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 111 "./src-ag/PrintOcamlCode.ag" #-} + error "pp of Decl.Bind not supported" + {-# LINE 664 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Decl_BindLet :: T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_BindLet !(T_Lhs left_) !(T_Expr rhs_) = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 112 "./src-ag/PrintOcamlCode.ag" #-} + error "pp of Decl.BindLet not supported" + {-# LINE 676 "dist/build/PrintOcamlCode.hs" #-} + )) 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 (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (alts_) of + { ( !_altsIpps) -> + (case (({-# LINE 113 "./src-ag/PrintOcamlCode.ag" #-} + "type" >#< hv_sp (map (\p -> "'" >|< p) params_ ++ [text $ toOcamlTC name_]) + >#< ( case _altsIpps of + [] -> empty + (x:xs) -> "=" >#< x + >-< vlist (map ("|" >#<) xs) + ) + >#< ";;" + {-# LINE 699 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }))) +sem_Decl_NewType :: String -> + ([String]) -> + String -> + T_Type -> + T_Decl +sem_Decl_NewType !name_ !params_ !con_ !(T_Type tp_) = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 120 "./src-ag/PrintOcamlCode.ag" #-} + error "pp of Decl.NewType not supported" + {-# LINE 713 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Decl_Type :: String -> + ([String]) -> + T_Type -> + T_Decl +sem_Decl_Type !name_ !params_ !(T_Type tp_) = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (tp_) of + { ( !_tpIpp) -> + (case (({-# LINE 121 "./src-ag/PrintOcamlCode.ag" #-} + "type" >#< hv_sp (map (\p -> "'" >|< p) params_ ++ [text $ toOcamlTC name_]) >#< "=" >#< _tpIpp >#< ";;" + {-# LINE 728 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }))) +sem_Decl_TSig :: String -> + T_Type -> + T_Decl +sem_Decl_TSig !name_ !(T_Type tp_) = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (tp_) of + { ( !_tpIpp) -> + (case (({-# LINE 122 "./src-ag/PrintOcamlCode.ag" #-} + "(*" >#< name_ >#< ":" >#< _tpIpp >#< "*)" + {-# LINE 742 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }))) +sem_Decl_Comment :: String -> + T_Decl +sem_Decl_Comment !txt_ = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 123 "./src-ag/PrintOcamlCode.ag" #-} + if '\n' `elem` txt_ + then "(* " >-< vlist (lines txt_) >-< "*)" + else "(*" >#< txt_ >#< "*)" + {-# LINE 755 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Decl_PragmaDecl :: String -> + T_Decl +sem_Decl_PragmaDecl !txt_ = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 126 "./src-ag/PrintOcamlCode.ag" #-} + error "pp of Decl.PragmaDecl not supported" + {-# LINE 766 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Decl_Resume :: Bool -> + String -> + T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_Resume !monadic_ !nt_ !(T_Lhs left_) !(T_Expr rhs_) = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 780 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (rhs_ _rhsOoptions) of + { ( !_rhsIpp) -> + (case (({-# LINE 53 "./src-ag/PrintOcamlCode.ag" #-} + _rhsIpp + {-# LINE 787 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_Decl_EvalDecl :: String -> + T_Lhs -> + T_Expr -> + T_Decl +sem_Decl_EvalDecl !nt_ !(T_Lhs left_) !(T_Expr rhs_) = + (T_Decl (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 800 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (rhs_ _rhsOoptions) of + { ( !_rhsIpp) -> + (case (({-# LINE 53 "./src-ag/PrintOcamlCode.ag" #-} + _rhsIpp + {-# LINE 807 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +-- Decls ------------------------------------------------------- +{- + visit 0: + inherited attributes: + isToplevel : Bool + options : Options + 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 -> + Options -> + ( PP_Docs)) +data Inh_Decls = Inh_Decls {isToplevel_Inh_Decls :: !(Bool),options_Inh_Decls :: !(Options)} +data Syn_Decls = Syn_Decls {pps_Syn_Decls :: !(PP_Docs)} +wrap_Decls :: T_Decls -> + Inh_Decls -> + Syn_Decls +wrap_Decls !(T_Decls sem) !(Inh_Decls _lhsIisToplevel _lhsIoptions) = + (let ( !_lhsOpps) = sem _lhsIisToplevel _lhsIoptions + in (Syn_Decls _lhsOpps)) +sem_Decls_Cons :: T_Decl -> + T_Decls -> + T_Decls +sem_Decls_Cons !(T_Decl hd_) !(T_Decls tl_) = + (T_Decls (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 209 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 850 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_tlOisToplevel -> + (case (({-# LINE 209 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIisToplevel + {-# LINE 855 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_hdOisToplevel -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 860 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_tlOoptions -> + (case (tl_ _tlOisToplevel _tlOoptions) of + { ( !_tlIpps) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 867 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_hdOoptions -> + (case (hd_ _hdOisToplevel _hdOoptions) of + { ( !_hdIpp) -> + (case (({-# LINE 80 "./src-ag/PrintOcamlCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 874 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }) }) }))) +sem_Decls_Nil :: T_Decls +sem_Decls_Nil = + (T_Decls (\ (!_lhsIisToplevel) + (!_lhsIoptions) -> + (case (({-# LINE 81 "./src-ag/PrintOcamlCode.ag" #-} + [] + {-# LINE 884 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }))) +-- Expr -------------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Let: + child decls : Decls + child body : Expr + alternative Case: + child expr : Expr + child alts : CaseAlts + alternative Do: + child stmts : Decls + child body : Expr + alternative Lambda: + child args : Exprs + child body : Expr + alternative TupleExpr: + child exprs : Exprs + alternative UnboxedTupleExpr: + child exprs : Exprs + alternative App: + child name : {String} + child args : Exprs + alternative SimpleExpr: + child txt : {String} + alternative TextExpr: + child lns : {[String]} + alternative Trace: + child txt : {String} + child expr : Expr + alternative PragmaExpr: + child onLeftSide : {Bool} + child onNewLine : {Bool} + child txt : {String} + child expr : Expr + alternative LineExpr: + child expr : Expr + alternative TypedExpr: + child expr : Expr + child tp : Type + alternative ResultExpr: + child nt : {String} + child expr : Expr + alternative InvokeExpr: + child nt : {String} + child expr : Expr + child args : Exprs + alternative ResumeExpr: + child nt : {String} + child expr : Expr + child left : Lhs + child rhs : Expr + alternative SemFun: + child nt : {String} + child args : Exprs + child body : Expr +-} +-- cata +sem_Expr :: Expr -> + T_Expr +sem_Expr !(Let _decls _body) = + (sem_Expr_Let (sem_Decls _decls) (sem_Expr _body)) +sem_Expr !(Case _expr _alts) = + (sem_Expr_Case (sem_Expr _expr) (sem_CaseAlts _alts)) +sem_Expr !(Do _stmts _body) = + (sem_Expr_Do (sem_Decls _stmts) (sem_Expr _body)) +sem_Expr !(Lambda _args _body) = + (sem_Expr_Lambda (sem_Exprs _args) (sem_Expr _body)) +sem_Expr !(TupleExpr _exprs) = + (sem_Expr_TupleExpr (sem_Exprs _exprs)) +sem_Expr !(UnboxedTupleExpr _exprs) = + (sem_Expr_UnboxedTupleExpr (sem_Exprs _exprs)) +sem_Expr !(App _name _args) = + (sem_Expr_App _name (sem_Exprs _args)) +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 !(PragmaExpr _onLeftSide _onNewLine _txt _expr) = + (sem_Expr_PragmaExpr _onLeftSide _onNewLine _txt (sem_Expr _expr)) +sem_Expr !(LineExpr _expr) = + (sem_Expr_LineExpr (sem_Expr _expr)) +sem_Expr !(TypedExpr _expr _tp) = + (sem_Expr_TypedExpr (sem_Expr _expr) (sem_Type _tp)) +sem_Expr !(ResultExpr _nt _expr) = + (sem_Expr_ResultExpr _nt (sem_Expr _expr)) +sem_Expr !(InvokeExpr _nt _expr _args) = + (sem_Expr_InvokeExpr _nt (sem_Expr _expr) (sem_Exprs _args)) +sem_Expr !(ResumeExpr _nt _expr _left _rhs) = + (sem_Expr_ResumeExpr _nt (sem_Expr _expr) (sem_Lhs _left) (sem_Expr _rhs)) +sem_Expr !(SemFun _nt _args _body) = + (sem_Expr_SemFun _nt (sem_Exprs _args) (sem_Expr _body)) +-- semantic domain +newtype T_Expr = T_Expr (Options -> + ( PP_Doc)) +data Inh_Expr = Inh_Expr {options_Inh_Expr :: !(Options)} +data Syn_Expr = Syn_Expr {pp_Syn_Expr :: !(PP_Doc)} +wrap_Expr :: T_Expr -> + Inh_Expr -> + Syn_Expr +wrap_Expr !(T_Expr sem) !(Inh_Expr _lhsIoptions) = + (let ( !_lhsOpp) = sem _lhsIoptions + in (Syn_Expr _lhsOpp)) +sem_Expr_Let :: T_Decls -> + T_Expr -> + T_Expr +sem_Expr_Let !(T_Decls decls_) !(T_Expr body_) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 216 "./src-ag/PrintOcamlCode.ag" #-} + False + {-# LINE 1004 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_declsOisToplevel -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1009 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_bodyOoptions -> + (case (body_ _bodyOoptions) of + { ( !_bodyIpp) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1016 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_declsOoptions -> + (case (decls_ _declsOisToplevel _declsOoptions) of + { ( !_declsIpps) -> + (case (({-# LINE 130 "./src-ag/PrintOcamlCode.ag" #-} + pp_parens $ vlist (_declsIpps ++ [_bodyIpp]) + {-# LINE 1023 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }))) +sem_Expr_Case :: T_Expr -> + T_CaseAlts -> + T_Expr +sem_Expr_Case !(T_Expr expr_) !(T_CaseAlts alts_) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1034 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_altsOoptions -> + (case (alts_ _altsOoptions) of + { ( !_altsIpps) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1041 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions) of + { ( !_exprIpp) -> + (case (({-# LINE 131 "./src-ag/PrintOcamlCode.ag" #-} + pp_parens ( "match" >#< _exprIpp >#< "with" + >-< indent 2 ( case _altsIpps of + [] -> empty + (x:xs) -> " " >#< x + >-< vlist (map ("|" >#<) xs) + ) + ) + {-# LINE 1054 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Expr_Do :: T_Decls -> + T_Expr -> + T_Expr +sem_Expr_Do !(T_Decls stmts_) !(T_Expr body_) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 138 "./src-ag/PrintOcamlCode.ag" #-} + error "pp of Expr.Do not supported" + {-# LINE 1065 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Expr_Lambda :: T_Exprs -> + T_Expr -> + T_Expr +sem_Expr_Lambda !(T_Exprs args_) !(T_Expr body_) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1076 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_bodyOoptions -> + (case (body_ _bodyOoptions) of + { ( !_bodyIpp) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1083 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_argsOoptions -> + (case (args_ _argsOoptions) of + { ( !_argsIpps) -> + (case (({-# LINE 139 "./src-ag/PrintOcamlCode.ag" #-} + pp_parens ( pp "fun" >#< hv_sp _argsIpps >#< "->" + >-< indent 2 _bodyIpp ) + {-# LINE 1091 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }) }) }))) +sem_Expr_TupleExpr :: T_Exprs -> + T_Expr +sem_Expr_TupleExpr !(T_Exprs exprs_) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1101 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_exprsOoptions -> + (case (exprs_ _exprsOoptions) of + { ( !_exprsIpps) -> + (case (({-# LINE 141 "./src-ag/PrintOcamlCode.ag" #-} + ppTuple False _exprsIpps + {-# LINE 1108 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_Expr_UnboxedTupleExpr :: T_Exprs -> + T_Expr +sem_Expr_UnboxedTupleExpr !(T_Exprs exprs_) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 142 "./src-ag/PrintOcamlCode.ag" #-} + error "pp of Expr.UnboxedTupleExpr not supported" + {-# LINE 1118 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Expr_App :: String -> + T_Exprs -> + T_Expr +sem_Expr_App !name_ !(T_Exprs args_) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1129 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_argsOoptions -> + (case (args_ _argsOoptions) of + { ( !_argsIpps) -> + (case (({-# LINE 143 "./src-ag/PrintOcamlCode.ag" #-} + pp_parens $ name_ >#< hv_sp _argsIpps + {-# LINE 1136 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_Expr_SimpleExpr :: String -> + T_Expr +sem_Expr_SimpleExpr !txt_ = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 144 "./src-ag/PrintOcamlCode.ag" #-} + text txt_ + {-# LINE 1146 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Expr_TextExpr :: ([String]) -> + T_Expr +sem_Expr_TextExpr !lns_ = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 145 "./src-ag/PrintOcamlCode.ag" #-} + vlist (map text lns_) + {-# LINE 1156 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Expr_Trace :: String -> + T_Expr -> + T_Expr +sem_Expr_Trace !txt_ !(T_Expr expr_) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1167 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions) of + { ( !_exprIpp) -> + (case (({-# LINE 146 "./src-ag/PrintOcamlCode.ag" #-} + _exprIpp + {-# LINE 1174 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_Expr_PragmaExpr :: Bool -> + Bool -> + String -> + T_Expr -> + T_Expr +sem_Expr_PragmaExpr !onLeftSide_ !onNewLine_ !txt_ !(T_Expr expr_) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1187 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions) of + { ( !_exprIpp) -> + (case (({-# LINE 147 "./src-ag/PrintOcamlCode.ag" #-} + _exprIpp + {-# LINE 1194 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_Expr_LineExpr :: T_Expr -> + T_Expr +sem_Expr_LineExpr !(T_Expr expr_) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1204 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions) of + { ( !_exprIpp) -> + (case (({-# LINE 148 "./src-ag/PrintOcamlCode.ag" #-} + _exprIpp + {-# LINE 1211 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_Expr_TypedExpr :: T_Expr -> + T_Type -> + T_Expr +sem_Expr_TypedExpr !(T_Expr expr_) !(T_Type tp_) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1222 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions) of + { ( !_exprIpp) -> + (case (({-# LINE 149 "./src-ag/PrintOcamlCode.ag" #-} + _exprIpp + {-# LINE 1229 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_Expr_ResultExpr :: String -> + T_Expr -> + T_Expr +sem_Expr_ResultExpr !nt_ !(T_Expr expr_) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1240 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions) of + { ( !_exprIpp) -> + (case (({-# LINE 53 "./src-ag/PrintOcamlCode.ag" #-} + _exprIpp + {-# LINE 1247 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_Expr_InvokeExpr :: String -> + T_Expr -> + T_Exprs -> + T_Expr +sem_Expr_InvokeExpr !nt_ !(T_Expr expr_) !(T_Exprs args_) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1259 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_exprOoptions -> + (case (expr_ _exprOoptions) of + { ( !_exprIpp) -> + (case (({-# LINE 53 "./src-ag/PrintOcamlCode.ag" #-} + _exprIpp + {-# LINE 1266 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_Expr_ResumeExpr :: String -> + T_Expr -> + T_Lhs -> + T_Expr -> + T_Expr +sem_Expr_ResumeExpr !nt_ !(T_Expr expr_) !(T_Lhs left_) !(T_Expr rhs_) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1279 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_rhsOoptions -> + (case (rhs_ _rhsOoptions) of + { ( !_rhsIpp) -> + (case (({-# LINE 53 "./src-ag/PrintOcamlCode.ag" #-} + _rhsIpp + {-# LINE 1286 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_Expr_SemFun :: String -> + T_Exprs -> + T_Expr -> + T_Expr +sem_Expr_SemFun !nt_ !(T_Exprs args_) !(T_Expr body_) = + (T_Expr (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1298 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_bodyOoptions -> + (case (body_ _bodyOoptions) of + { ( !_bodyIpp) -> + (case (({-# LINE 53 "./src-ag/PrintOcamlCode.ag" #-} + _bodyIpp + {-# LINE 1305 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +-- Exprs ------------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + 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 (Options -> + ( PP_Docs)) +data Inh_Exprs = Inh_Exprs {options_Inh_Exprs :: !(Options)} +data Syn_Exprs = Syn_Exprs {pps_Syn_Exprs :: !(PP_Docs)} +wrap_Exprs :: T_Exprs -> + Inh_Exprs -> + Syn_Exprs +wrap_Exprs !(T_Exprs sem) !(Inh_Exprs _lhsIoptions) = + (let ( !_lhsOpps) = sem _lhsIoptions + in (Syn_Exprs _lhsOpps)) +sem_Exprs_Cons :: T_Expr -> + T_Exprs -> + T_Exprs +sem_Exprs_Cons !(T_Expr hd_) !(T_Exprs tl_) = + (T_Exprs (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1345 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_tlOoptions -> + (case (tl_ _tlOoptions) of + { ( !_tlIpps) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1352 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_hdOoptions -> + (case (hd_ _hdOoptions) of + { ( !_hdIpp) -> + (case (({-# LINE 60 "./src-ag/PrintOcamlCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 1359 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) }) }) }))) +sem_Exprs_Nil :: T_Exprs +sem_Exprs_Nil = + (T_Exprs (\ (!_lhsIoptions) -> + (case (({-# LINE 61 "./src-ag/PrintOcamlCode.ag" #-} + [] + {-# LINE 1368 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }))) +-- Lhs --------------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Pattern3: + child pat3 : Pattern + alternative Pattern3SM: + child pat3 : Pattern + alternative TupleLhs: + child comps : {[String]} + alternative UnboxedTupleLhs: + child comps : {[String]} + alternative Fun: + child name : {String} + child args : Exprs + alternative Unwrap: + child name : {String} + child sub : Lhs +-} +-- cata +sem_Lhs :: Lhs -> + T_Lhs +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) +sem_Lhs !(Fun _name _args) = + (sem_Lhs_Fun _name (sem_Exprs _args)) +sem_Lhs !(Unwrap _name _sub) = + (sem_Lhs_Unwrap _name (sem_Lhs _sub)) +-- semantic domain +newtype T_Lhs = T_Lhs (Options -> + ( PP_Doc)) +data Inh_Lhs = Inh_Lhs {options_Inh_Lhs :: !(Options)} +data Syn_Lhs = Syn_Lhs {pp_Syn_Lhs :: !(PP_Doc)} +wrap_Lhs :: T_Lhs -> + Inh_Lhs -> + Syn_Lhs +wrap_Lhs !(T_Lhs sem) !(Inh_Lhs _lhsIoptions) = + (let ( !_lhsOpp) = sem _lhsIoptions + in (Syn_Lhs _lhsOpp)) +sem_Lhs_Pattern3 :: T_Pattern -> + T_Lhs +sem_Lhs_Pattern3 !(T_Pattern pat3_) = + (T_Lhs (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1427 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_pat3Ooptions -> + (case (pat3_ _pat3Ooptions) of + { ( !_pat3Icopy,!_pat3IisUnderscore,!_pat3Ipp) -> + (case (({-# LINE 152 "./src-ag/PrintOcamlCode.ag" #-} + _pat3Ipp + {-# LINE 1434 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_Lhs_Pattern3SM :: T_Pattern -> + T_Lhs +sem_Lhs_Pattern3SM !(T_Pattern pat3_) = + (T_Lhs (\ (!_lhsIoptions) -> + (case (({-# LINE 153 "./src-ag/PrintOcamlCode.ag" #-} + error "pp of Lhs.Pattern3SM not supported" + {-# LINE 1444 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Lhs_TupleLhs :: ([String]) -> + T_Lhs +sem_Lhs_TupleLhs !comps_ = + (T_Lhs (\ (!_lhsIoptions) -> + (case (({-# LINE 154 "./src-ag/PrintOcamlCode.ag" #-} + ppTuple False (map text comps_) + {-# LINE 1454 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Lhs_UnboxedTupleLhs :: ([String]) -> + T_Lhs +sem_Lhs_UnboxedTupleLhs !comps_ = + (T_Lhs (\ (!_lhsIoptions) -> + (case (({-# LINE 155 "./src-ag/PrintOcamlCode.ag" #-} + error "pp of Lhs.UnboxedTupleLhs not supported" + {-# LINE 1464 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }))) +sem_Lhs_Fun :: String -> + T_Exprs -> + T_Lhs +sem_Lhs_Fun !name_ !(T_Exprs args_) = + (T_Lhs (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1475 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_argsOoptions -> + (case (args_ _argsOoptions) of + { ( !_argsIpps) -> + (case (({-# LINE 156 "./src-ag/PrintOcamlCode.ag" #-} + name_ >#< hv_sp _argsIpps + {-# LINE 1482 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +sem_Lhs_Unwrap :: String -> + T_Lhs -> + T_Lhs +sem_Lhs_Unwrap !name_ !(T_Lhs sub_) = + (T_Lhs (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1493 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_subOoptions -> + (case (sub_ _subOoptions) of + { ( !_subIpp) -> + (case (({-# LINE 157 "./src-ag/PrintOcamlCode.ag" #-} + pp_parens (name_ >#< _subIpp) + {-# LINE 1500 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) }))) +-- NamedType --------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Named: + child strict : {Bool} + child name : {String} + child tp : Type +-} +-- cata +sem_NamedType :: NamedType -> + T_NamedType +sem_NamedType !(Named _strict _name _tp) = + (sem_NamedType_Named _strict _name (sem_Type _tp)) +-- semantic domain +newtype T_NamedType = T_NamedType (( PP_Doc)) +data Inh_NamedType = Inh_NamedType {} +data Syn_NamedType = Syn_NamedType {pp_Syn_NamedType :: !(PP_Doc)} +wrap_NamedType :: T_NamedType -> + Inh_NamedType -> + Syn_NamedType +wrap_NamedType !(T_NamedType sem) !(Inh_NamedType) = + (let ( !_lhsOpp) = sem + in (Syn_NamedType _lhsOpp)) +sem_NamedType_Named :: Bool -> + String -> + T_Type -> + T_NamedType +sem_NamedType_Named !strict_ !name_ !(T_Type tp_) = + (T_NamedType (case (tp_) of + { ( !_tpIpp) -> + (case (({-# LINE 187 "./src-ag/PrintOcamlCode.ag" #-} + name_ >#< ":" >#< _tpIpp + {-# LINE 1539 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) })) +-- NamedTypes -------------------------------------------------- +{- + visit 0: + synthesized attribute: + pps : PP_Docs + alternatives: + alternative Cons: + child hd : NamedType + child tl : NamedTypes + alternative Nil: +-} +-- cata +sem_NamedTypes :: NamedTypes -> + T_NamedTypes +sem_NamedTypes !list = + (Prelude.foldr sem_NamedTypes_Cons sem_NamedTypes_Nil (Prelude.map sem_NamedType list)) +-- semantic domain +newtype T_NamedTypes = T_NamedTypes (( PP_Docs)) +data Inh_NamedTypes = Inh_NamedTypes {} +data Syn_NamedTypes = Syn_NamedTypes {pps_Syn_NamedTypes :: !(PP_Docs)} +wrap_NamedTypes :: T_NamedTypes -> + Inh_NamedTypes -> + Syn_NamedTypes +wrap_NamedTypes !(T_NamedTypes sem) !(Inh_NamedTypes) = + (let ( !_lhsOpps) = sem + in (Syn_NamedTypes _lhsOpps)) +sem_NamedTypes_Cons :: T_NamedType -> + T_NamedTypes -> + T_NamedTypes +sem_NamedTypes_Cons !(T_NamedType hd_) !(T_NamedTypes tl_) = + (T_NamedTypes (case (tl_) of + { ( !_tlIpps) -> + (case (hd_) of + { ( !_hdIpp) -> + (case (({-# LINE 76 "./src-ag/PrintOcamlCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 1579 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) })) +sem_NamedTypes_Nil :: T_NamedTypes +sem_NamedTypes_Nil = + (T_NamedTypes (case (({-# LINE 77 "./src-ag/PrintOcamlCode.ag" #-} + [] + {-# LINE 1587 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) })) +-- Pattern ----------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + copy : Pattern + isUnderscore : Bool + pp : PP_Doc + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern !(Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern !(Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern !(Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern !(Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +sem_Pattern !(Underscore _pos) = + (sem_Pattern_Underscore _pos) +-- semantic domain +newtype T_Pattern = T_Pattern (Options -> + ( Pattern,Bool,PP_Doc)) +data Inh_Pattern = Inh_Pattern {options_Inh_Pattern :: !(Options)} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern),isUnderscore_Syn_Pattern :: !(Bool),pp_Syn_Pattern :: !(PP_Doc)} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern !(T_Pattern sem) !(Inh_Pattern _lhsIoptions) = + (let ( !_lhsOcopy,!_lhsOisUnderscore,!_lhsOpp) = sem _lhsIoptions + in (Syn_Pattern _lhsOcopy _lhsOisUnderscore _lhsOpp)) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr !name_ !(T_Patterns pats_) = + (T_Pattern (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1657 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_patsOoptions -> + (case (pats_ _patsOoptions) of + { ( !_patsIcopy,!_patsIpps) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 1664 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1669 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 200 "./src-ag/PrintOcamlCode.ag" #-} + False + {-# LINE 1674 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 190 "./src-ag/PrintOcamlCode.ag" #-} + pp_parens $ name_ >#< hv_sp _patsIpps + {-# LINE 1679 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp) }) }) }) }) }) }))) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product !pos_ !(T_Patterns pats_) = + (T_Pattern (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1690 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_patsOoptions -> + (case (pats_ _patsOoptions) of + { ( !_patsIcopy,!_patsIpps) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 1697 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1702 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 201 "./src-ag/PrintOcamlCode.ag" #-} + False + {-# LINE 1707 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 191 "./src-ag/PrintOcamlCode.ag" #-} + pp_block "(" ")" "," _patsIpps + {-# LINE 1712 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp) }) }) }) }) }) }))) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_) = + (T_Pattern (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1724 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_patOoptions -> + (case (pat_ _patOoptions) of + { ( !_patIcopy,!_patIisUnderscore,!_patIpp) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 1731 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1736 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 202 "./src-ag/PrintOcamlCode.ag" #-} + False + {-# LINE 1741 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 193 "./src-ag/PrintOcamlCode.ag" #-} + if _patIisUnderscore + then pp (attrname False field_ attr_) + else error "pp of Pattern.Alias is only supported in the form (x@_)" + {-# LINE 1748 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp) }) }) }) }) }) }))) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable !(T_Pattern pat_) = + (T_Pattern (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1758 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_patOoptions -> + (case (pat_ _patOoptions) of + { ( !_patIcopy,!_patIisUnderscore,!_patIpp) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 1765 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1770 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 199 "./src-ag/PrintOcamlCode.ag" #-} + _patIisUnderscore + {-# LINE 1775 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 196 "./src-ag/PrintOcamlCode.ag" #-} + error "pp of Pattern.Irrefutable not supported" + {-# LINE 1780 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp) }) }) }) }) }) }))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore !pos_ = + (T_Pattern (\ (!_lhsIoptions) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 1790 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1795 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 203 "./src-ag/PrintOcamlCode.ag" #-} + True + {-# LINE 1800 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOisUnderscore -> + (case (({-# LINE 197 "./src-ag/PrintOcamlCode.ag" #-} + text "_" + {-# LINE 1805 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp) }) }) }) }))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + copy : Patterns + pps : PP_Docs + 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 (Options -> + ( Patterns,PP_Docs)) +data Inh_Patterns = Inh_Patterns {options_Inh_Patterns :: !(Options)} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns),pps_Syn_Patterns :: !(PP_Docs)} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns !(T_Patterns sem) !(Inh_Patterns _lhsIoptions) = + (let ( !_lhsOcopy,!_lhsOpps) = sem _lhsIoptions + in (Syn_Patterns _lhsOcopy _lhsOpps)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons !(T_Pattern hd_) !(T_Patterns tl_) = + (T_Patterns (\ (!_lhsIoptions) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1850 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_tlOoptions -> + (case (tl_ _tlOoptions) of + { ( !_tlIcopy,!_tlIpps) -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1857 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_hdOoptions -> + (case (hd_ _hdOoptions) of + { ( !_hdIcopy,!_hdIisUnderscore,!_hdIpp) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 1864 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1869 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 88 "./src-ag/PrintOcamlCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 1874 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOcopy,_lhsOpps) }) }) }) }) }) }) }))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (\ (!_lhsIoptions) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 1883 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1888 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOcopy -> + (case (({-# LINE 89 "./src-ag/PrintOcamlCode.ag" #-} + [] + {-# LINE 1893 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOcopy,_lhsOpps) }) }) }))) +-- Program ----------------------------------------------------- +{- + visit 0: + inherited attributes: + options : Options + textBlockMap : Map BlockInfo PP_Doc + synthesized attribute: + output : PP_Docs + alternatives: + alternative Program: + child chunks : Chunks + child ordered : {Bool} +-} +-- cata +sem_Program :: Program -> + T_Program +sem_Program !(Program _chunks _ordered) = + (sem_Program_Program (sem_Chunks _chunks) _ordered) +-- semantic domain +newtype T_Program = T_Program (Options -> + (Map BlockInfo PP_Doc) -> + ( PP_Docs)) +data Inh_Program = Inh_Program {options_Inh_Program :: !(Options),textBlockMap_Inh_Program :: !((Map BlockInfo PP_Doc))} +data Syn_Program = Syn_Program {output_Syn_Program :: !(PP_Docs)} +wrap_Program :: T_Program -> + Inh_Program -> + Syn_Program +wrap_Program !(T_Program sem) !(Inh_Program _lhsIoptions _lhsItextBlockMap) = + (let ( !_lhsOoutput) = sem _lhsIoptions _lhsItextBlockMap + in (Syn_Program _lhsOoutput)) +sem_Program_Program :: T_Chunks -> + Bool -> + T_Program +sem_Program_Program !(T_Chunks chunks_) !ordered_ = + (T_Program (\ (!_lhsIoptions) + (!_lhsItextBlockMap) -> + (case (({-# LINE 45 "./src-ag/PrintOcamlCode.ag" #-} + _lhsItextBlockMap + {-# LINE 1935 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_chunksOtextBlockMap -> + (case (({-# LINE 212 "./src-ag/PrintOcamlCode.ag" #-} + True + {-# LINE 1940 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_chunksOisToplevel -> + (case (({-# LINE 43 "./src-ag/PrintOcamlCode.ag" #-} + _lhsIoptions + {-# LINE 1945 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_chunksOoptions -> + (case (chunks_ _chunksOisToplevel _chunksOoptions _chunksOtextBlockMap) of + { ( !_chunksIpps) -> + (case (({-# LINE 57 "./src-ag/PrintOcamlCode.ag" #-} + _chunksIpps + {-# LINE 1952 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOoutput -> + ( _lhsOoutput) }) }) }) }) }))) +-- Type -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Arr: + child left : Type + child right : Type + alternative CtxApp: + child left : {[(String, [String])]} + child right : Type + alternative QuantApp: + child left : {String} + child right : Type + alternative TypeApp: + child func : Type + child args : Types + alternative TupleType: + child tps : Types + alternative UnboxedTupleType: + child tps : Types + alternative List: + child tp : Type + alternative SimpleType: + child txt : {String} + alternative NontermType: + child name : {String} + child params : {[String]} + child deforested : {Bool} + alternative TMaybe: + child tp : Type + alternative TEither: + child left : Type + child right : Type + alternative TMap: + child key : Type + child value : Type + alternative TIntMap: + child value : Type +-} +-- 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 !(QuantApp _left _right) = + (sem_Type_QuantApp _left (sem_Type _right)) +sem_Type !(TypeApp _func _args) = + (sem_Type_TypeApp (sem_Type _func) (sem_Types _args)) +sem_Type !(TupleType _tps) = + (sem_Type_TupleType (sem_Types _tps)) +sem_Type !(UnboxedTupleType _tps) = + (sem_Type_UnboxedTupleType (sem_Types _tps)) +sem_Type !(List _tp) = + (sem_Type_List (sem_Type _tp)) +sem_Type !(SimpleType _txt) = + (sem_Type_SimpleType _txt) +sem_Type !(NontermType _name _params _deforested) = + (sem_Type_NontermType _name _params _deforested) +sem_Type !(TMaybe _tp) = + (sem_Type_TMaybe (sem_Type _tp)) +sem_Type !(TEither _left _right) = + (sem_Type_TEither (sem_Type _left) (sem_Type _right)) +sem_Type !(TMap _key _value) = + (sem_Type_TMap (sem_Type _key) (sem_Type _value)) +sem_Type !(TIntMap _value) = + (sem_Type_TIntMap (sem_Type _value)) +-- semantic domain +newtype T_Type = T_Type (( PP_Doc)) +data Inh_Type = Inh_Type {} +data Syn_Type = Syn_Type {pp_Syn_Type :: !(PP_Doc)} +wrap_Type :: T_Type -> + Inh_Type -> + Syn_Type +wrap_Type !(T_Type sem) !(Inh_Type) = + (let ( !_lhsOpp) = sem + in (Syn_Type _lhsOpp)) +sem_Type_Arr :: T_Type -> + T_Type -> + T_Type +sem_Type_Arr !(T_Type left_) !(T_Type right_) = + (T_Type (case (right_) of + { ( !_rightIpp) -> + (case (left_) of + { ( !_leftIpp) -> + (case (({-# LINE 160 "./src-ag/PrintOcamlCode.ag" #-} + pp_parens (_leftIpp >#< "->" >#< _rightIpp) + {-# LINE 2046 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) +sem_Type_CtxApp :: ([(String, [String])]) -> + T_Type -> + T_Type +sem_Type_CtxApp !left_ !(T_Type right_) = + (T_Type (case (({-# LINE 161 "./src-ag/PrintOcamlCode.ag" #-} + error "pp of Type.CtxApp not supported" + {-# LINE 2056 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) +sem_Type_QuantApp :: String -> + T_Type -> + T_Type +sem_Type_QuantApp !left_ !(T_Type right_) = + (T_Type (case (right_) of + { ( !_rightIpp) -> + (case (({-# LINE 53 "./src-ag/PrintOcamlCode.ag" #-} + _rightIpp + {-# LINE 2068 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) })) +sem_Type_TypeApp :: T_Type -> + T_Types -> + T_Type +sem_Type_TypeApp !(T_Type func_) !(T_Types args_) = + (T_Type (case (args_) of + { ( !_argsIpps) -> + (case (func_) of + { ( !_funcIpp) -> + (case (({-# LINE 162 "./src-ag/PrintOcamlCode.ag" #-} + pp_parens (hv_sp (_argsIpps ++ [_funcIpp])) + {-# LINE 2082 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) }) })) +sem_Type_TupleType :: T_Types -> + T_Type +sem_Type_TupleType !(T_Types tps_) = + (T_Type (case (tps_) of + { ( !_tpsIpps) -> + (case (({-# LINE 163 "./src-ag/PrintOcamlCode.ag" #-} + pp_block "(" ")" "," _tpsIpps + {-# LINE 2093 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) })) +sem_Type_UnboxedTupleType :: T_Types -> + T_Type +sem_Type_UnboxedTupleType !(T_Types tps_) = + (T_Type (case (({-# LINE 165 "./src-ag/PrintOcamlCode.ag" #-} + error "pp of Type.UnboxedTupleType is not supported" + {-# LINE 2102 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) +sem_Type_List :: T_Type -> + T_Type +sem_Type_List !(T_Type tp_) = + (T_Type (case (tp_) of + { ( !_tpIpp) -> + (case (({-# LINE 166 "./src-ag/PrintOcamlCode.ag" #-} + _tpIpp >#< "list" + {-# LINE 2113 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) })) +sem_Type_SimpleType :: String -> + T_Type +sem_Type_SimpleType !txt_ = + (T_Type (case (({-# LINE 167 "./src-ag/PrintOcamlCode.ag" #-} + text txt_ + {-# LINE 2122 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) +sem_Type_NontermType :: String -> + ([String]) -> + Bool -> + T_Type +sem_Type_NontermType !name_ !params_ !deforested_ = + (T_Type (case (({-# LINE 168 "./src-ag/PrintOcamlCode.ag" #-} + pp_block "(" ")" " " (map text params_ ++ [text $ toOcamlTC name_]) + {-# LINE 2133 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) +sem_Type_TMaybe :: T_Type -> + T_Type +sem_Type_TMaybe !(T_Type tp_) = + (T_Type (case (tp_) of + { ( !_tpIpp) -> + (case (({-# LINE 169 "./src-ag/PrintOcamlCode.ag" #-} + _tpIpp >#< "opt" + {-# LINE 2144 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) }) })) +sem_Type_TEither :: T_Type -> + T_Type -> + T_Type +sem_Type_TEither !(T_Type left_) !(T_Type right_) = + (T_Type (case (({-# LINE 170 "./src-ag/PrintOcamlCode.ag" #-} + error "pp of Type.TEither is not supported" + {-# LINE 2154 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) +sem_Type_TMap :: T_Type -> + T_Type -> + T_Type +sem_Type_TMap !(T_Type key_) !(T_Type value_) = + (T_Type (case (({-# LINE 171 "./src-ag/PrintOcamlCode.ag" #-} + error "pp of Type.TMap is not supported" + {-# LINE 2164 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) +sem_Type_TIntMap :: T_Type -> + T_Type +sem_Type_TIntMap !(T_Type value_) = + (T_Type (case (({-# LINE 172 "./src-ag/PrintOcamlCode.ag" #-} + error "pp of Type.TIntMap is not supported" + {-# LINE 2173 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpp -> + ( _lhsOpp) })) +-- Types ------------------------------------------------------- +{- + visit 0: + 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 (( PP_Docs)) +data Inh_Types = Inh_Types {} +data Syn_Types = Syn_Types {pps_Syn_Types :: !(PP_Docs)} +wrap_Types :: T_Types -> + Inh_Types -> + Syn_Types +wrap_Types !(T_Types sem) !(Inh_Types) = + (let ( !_lhsOpps) = sem + in (Syn_Types _lhsOpps)) +sem_Types_Cons :: T_Type -> + T_Types -> + T_Types +sem_Types_Cons !(T_Type hd_) !(T_Types tl_) = + (T_Types (case (tl_) of + { ( !_tlIpps) -> + (case (hd_) of + { ( !_hdIpp) -> + (case (({-# LINE 72 "./src-ag/PrintOcamlCode.ag" #-} + _hdIpp : _tlIpps + {-# LINE 2213 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) }) }) })) +sem_Types_Nil :: T_Types +sem_Types_Nil = + (T_Types (case (({-# LINE 73 "./src-ag/PrintOcamlCode.ag" #-} + [] + {-# LINE 2221 "dist/build/PrintOcamlCode.hs" #-} + )) of + { !_lhsOpps -> + ( _lhsOpps) })) diff --git a/dist/build/PrintVisitCode.hs b/dist/build/PrintVisitCode.hs new file mode 100644 --- /dev/null +++ b/dist/build/PrintVisitCode.hs @@ -0,0 +1,758 @@ + + +-- UUAGC 0.9.42.0 (src-ag/PrintVisitCode.ag) +module PrintVisitCode where +{-# LINE 10 "./src-ag/PrintVisitCode.ag" #-} + +import CommonTypes +import SequentialTypes +import Options +import CodeSyntax +import ErrorMessages +import GrammarInfo +import DeclBlocks +import Pretty + +import qualified Data.Map as Map +import Data.Map(Map) +import qualified Data.Set as Set +import Data.Set(Set) +import qualified Data.Sequence as Seq +import Data.Sequence(Seq) +import UU.Scanner.Position + +import Data.List(partition,intersperse,intersect,(\\)) +import Data.Maybe(fromJust,isJust) +{-# LINE 27 "dist/build/PrintVisitCode.hs" #-} + +{-# LINE 2 "./src-ag/CodeSyntax.ag" #-} + +import Patterns +import CommonTypes +import Data.Map(Map) +import Data.Set(Set) +{-# LINE 35 "dist/build/PrintVisitCode.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 42 "dist/build/PrintVisitCode.hs" #-} + +{-# LINE 2 "./src-ag/DeclBlocks.ag" #-} + +import Code (Decl,Expr) +{-# LINE 47 "dist/build/PrintVisitCode.hs" #-} +{-# LINE 32 "./src-ag/PrintVisitCode.ag" #-} + +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 +{-# LINE 61 "dist/build/PrintVisitCode.hs" #-} +-- CGrammar ---------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attribute: + output : PP_Docs + alternatives: + alternative CGrammar: + child typeSyns : {TypeSyns} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : CNonterminals + child pragmas : {PragmaMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Set Identifier))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))} + child multivisit : {Bool} +-} +-- cata +sem_CGrammar :: CGrammar -> + T_CGrammar +sem_CGrammar (CGrammar _typeSyns _derivings _wrappers _nonts _pragmas _paramMap _contextMap _quantMap _aroundsMap _mergeMap _multivisit) = + (sem_CGrammar_CGrammar _typeSyns _derivings _wrappers (sem_CNonterminals _nonts) _pragmas _paramMap _contextMap _quantMap _aroundsMap _mergeMap _multivisit) +-- semantic domain +newtype T_CGrammar = T_CGrammar (Options -> + ( PP_Docs)) +data Inh_CGrammar = Inh_CGrammar {options_Inh_CGrammar :: !(Options)} +data Syn_CGrammar = Syn_CGrammar {output_Syn_CGrammar :: !(PP_Docs)} +wrap_CGrammar :: T_CGrammar -> + Inh_CGrammar -> + Syn_CGrammar +wrap_CGrammar (T_CGrammar sem) (Inh_CGrammar _lhsIoptions) = + (let ( _lhsOoutput) = sem _lhsIoptions + in (Syn_CGrammar _lhsOoutput)) +sem_CGrammar_CGrammar :: TypeSyns -> + Derivings -> + (Set NontermIdent) -> + T_CNonterminals -> + PragmaMap -> + ParamMap -> + ContextMap -> + QuantMap -> + (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> + Bool -> + T_CGrammar +sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ (T_CNonterminals nonts_) pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ = + (T_CGrammar (\ _lhsIoptions -> + (case (({-# LINE 53 "./src-ag/PrintVisitCode.ag" #-} + [] + {-# LINE 115 "dist/build/PrintVisitCode.hs" #-} + )) of + { _lhsOoutput -> + ( _lhsOoutput) }))) +-- CInterface -------------------------------------------------- +{- + alternatives: + alternative CInterface: + child seg : CSegments +-} +-- cata +sem_CInterface :: CInterface -> + T_CInterface +sem_CInterface (CInterface _seg) = + (sem_CInterface_CInterface (sem_CSegments _seg)) +-- semantic domain +newtype T_CInterface = T_CInterface (( )) +data Inh_CInterface = Inh_CInterface {} +data Syn_CInterface = Syn_CInterface {} +wrap_CInterface :: T_CInterface -> + Inh_CInterface -> + Syn_CInterface +wrap_CInterface (T_CInterface sem) (Inh_CInterface) = + (let ( ) = sem + in (Syn_CInterface)) +sem_CInterface_CInterface :: T_CSegments -> + T_CInterface +sem_CInterface_CInterface (T_CSegments seg_) = + (T_CInterface ( )) +-- CNonterminal ------------------------------------------------ +{- + alternatives: + alternative CNonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : CProductions + child inter : CInterface +-} +-- cata +sem_CNonterminal :: CNonterminal -> + T_CNonterminal +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 (( )) +data Inh_CNonterminal = Inh_CNonterminal {} +data Syn_CNonterminal = Syn_CNonterminal {} +wrap_CNonterminal :: T_CNonterminal -> + Inh_CNonterminal -> + Syn_CNonterminal +wrap_CNonterminal (T_CNonterminal sem) (Inh_CNonterminal) = + (let ( ) = sem + in (Syn_CNonterminal)) +sem_CNonterminal_CNonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_CProductions -> + T_CInterface -> + T_CNonterminal +sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ (T_CProductions prods_) (T_CInterface inter_) = + (T_CNonterminal ( )) +-- CNonterminals ----------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CNonterminal + child tl : CNonterminals + alternative Nil: +-} +-- cata +sem_CNonterminals :: CNonterminals -> + T_CNonterminals +sem_CNonterminals list = + (Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list)) +-- semantic domain +newtype T_CNonterminals = T_CNonterminals (( )) +data Inh_CNonterminals = Inh_CNonterminals {} +data Syn_CNonterminals = Syn_CNonterminals {} +wrap_CNonterminals :: T_CNonterminals -> + Inh_CNonterminals -> + Syn_CNonterminals +wrap_CNonterminals (T_CNonterminals sem) (Inh_CNonterminals) = + (let ( ) = sem + in (Syn_CNonterminals)) +sem_CNonterminals_Cons :: T_CNonterminal -> + T_CNonterminals -> + T_CNonterminals +sem_CNonterminals_Cons (T_CNonterminal hd_) (T_CNonterminals tl_) = + (T_CNonterminals ( )) +sem_CNonterminals_Nil :: T_CNonterminals +sem_CNonterminals_Nil = + (T_CNonterminals ( )) +-- CProduction ------------------------------------------------- +{- + alternatives: + alternative CProduction: + child con : {ConstructorIdent} + child visits : CVisits + child children : {[(Identifier,Type,ChildKind)]} + child terminals : {[Identifier]} +-} +-- cata +sem_CProduction :: CProduction -> + T_CProduction +sem_CProduction (CProduction _con _visits _children _terminals) = + (sem_CProduction_CProduction _con (sem_CVisits _visits) _children _terminals) +-- semantic domain +newtype T_CProduction = T_CProduction (( )) +data Inh_CProduction = Inh_CProduction {} +data Syn_CProduction = Syn_CProduction {} +wrap_CProduction :: T_CProduction -> + Inh_CProduction -> + Syn_CProduction +wrap_CProduction (T_CProduction sem) (Inh_CProduction) = + (let ( ) = sem + in (Syn_CProduction)) +sem_CProduction_CProduction :: ConstructorIdent -> + T_CVisits -> + ([(Identifier,Type,ChildKind)]) -> + ([Identifier]) -> + T_CProduction +sem_CProduction_CProduction con_ (T_CVisits visits_) children_ terminals_ = + (T_CProduction ( )) +-- CProductions ------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : CProduction + child tl : CProductions + alternative Nil: +-} +-- cata +sem_CProductions :: CProductions -> + T_CProductions +sem_CProductions list = + (Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list)) +-- semantic domain +newtype T_CProductions = T_CProductions (( )) +data Inh_CProductions = Inh_CProductions {} +data Syn_CProductions = Syn_CProductions {} +wrap_CProductions :: T_CProductions -> + Inh_CProductions -> + Syn_CProductions +wrap_CProductions (T_CProductions sem) (Inh_CProductions) = + (let ( ) = sem + in (Syn_CProductions)) +sem_CProductions_Cons :: T_CProduction -> + T_CProductions -> + T_CProductions +sem_CProductions_Cons (T_CProduction hd_) (T_CProductions tl_) = + (T_CProductions ( )) +sem_CProductions_Nil :: T_CProductions +sem_CProductions_Nil = + (T_CProductions ( )) +-- CRule ------------------------------------------------------- +{- + alternatives: + alternative CRule: + child name : {Identifier} + child isIn : {Bool} + child hasCode : {Bool} + child nt : {NontermIdent} + child con : {ConstructorIdent} + child field : {Identifier} + child childnt : {Maybe NontermIdent} + child tp : {Maybe Type} + child pattern : Pattern + child rhs : {[String]} + child defines : {Map Int (Identifier,Identifier,Maybe Type)} + child owrt : {Bool} + child origin : {String} + child uses : {Set (Identifier, Identifier)} + child explicit : {Bool} + child mbNamed : {Maybe Identifier} + alternative CChildVisit: + child name : {Identifier} + child nt : {NontermIdent} + child nr : {Int} + child inh : {Attributes} + child syn : {Attributes} + child isLast : {Bool} +-} +-- cata +sem_CRule :: CRule -> + T_CRule +sem_CRule (CRule _name _isIn _hasCode _nt _con _field _childnt _tp _pattern _rhs _defines _owrt _origin _uses _explicit _mbNamed) = + (sem_CRule_CRule _name _isIn _hasCode _nt _con _field _childnt _tp (sem_Pattern _pattern) _rhs _defines _owrt _origin _uses _explicit _mbNamed) +sem_CRule (CChildVisit _name _nt _nr _inh _syn _isLast) = + (sem_CRule_CChildVisit _name _nt _nr _inh _syn _isLast) +-- semantic domain +newtype T_CRule = T_CRule (( )) +data Inh_CRule = Inh_CRule {} +data Syn_CRule = Syn_CRule {} +wrap_CRule :: T_CRule -> + Inh_CRule -> + Syn_CRule +wrap_CRule (T_CRule sem) (Inh_CRule) = + (let ( ) = sem + in (Syn_CRule)) +sem_CRule_CRule :: Identifier -> + Bool -> + Bool -> + NontermIdent -> + ConstructorIdent -> + Identifier -> + (Maybe NontermIdent) -> + (Maybe Type) -> + T_Pattern -> + ([String]) -> + (Map Int (Identifier,Identifier,Maybe Type)) -> + Bool -> + String -> + (Set (Identifier, Identifier)) -> + Bool -> + (Maybe Identifier) -> + T_CRule +sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ (T_Pattern pattern_) rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ = + (T_CRule ( )) +sem_CRule_CChildVisit :: Identifier -> + NontermIdent -> + Int -> + Attributes -> + Attributes -> + Bool -> + T_CRule +sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ = + (T_CRule ( )) +-- CSegment ---------------------------------------------------- +{- + alternatives: + alternative CSegment: + child inh : {Attributes} + child syn : {Attributes} +-} +-- cata +sem_CSegment :: CSegment -> + T_CSegment +sem_CSegment (CSegment _inh _syn) = + (sem_CSegment_CSegment _inh _syn) +-- semantic domain +newtype T_CSegment = T_CSegment (( )) +data Inh_CSegment = Inh_CSegment {} +data Syn_CSegment = Syn_CSegment {} +wrap_CSegment :: T_CSegment -> + Inh_CSegment -> + Syn_CSegment +wrap_CSegment (T_CSegment sem) (Inh_CSegment) = + (let ( ) = sem + in (Syn_CSegment)) +sem_CSegment_CSegment :: Attributes -> + Attributes -> + T_CSegment +sem_CSegment_CSegment inh_ syn_ = + (T_CSegment ( )) +-- CSegments --------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CSegment + child tl : CSegments + alternative Nil: +-} +-- cata +sem_CSegments :: CSegments -> + T_CSegments +sem_CSegments list = + (Prelude.foldr sem_CSegments_Cons sem_CSegments_Nil (Prelude.map sem_CSegment list)) +-- semantic domain +newtype T_CSegments = T_CSegments (( )) +data Inh_CSegments = Inh_CSegments {} +data Syn_CSegments = Syn_CSegments {} +wrap_CSegments :: T_CSegments -> + Inh_CSegments -> + Syn_CSegments +wrap_CSegments (T_CSegments sem) (Inh_CSegments) = + (let ( ) = sem + in (Syn_CSegments)) +sem_CSegments_Cons :: T_CSegment -> + T_CSegments -> + T_CSegments +sem_CSegments_Cons (T_CSegment hd_) (T_CSegments tl_) = + (T_CSegments ( )) +sem_CSegments_Nil :: T_CSegments +sem_CSegments_Nil = + (T_CSegments ( )) +-- CVisit ------------------------------------------------------ +{- + alternatives: + alternative CVisit: + child inh : {Attributes} + child syn : {Attributes} + child vss : Sequence + child intra : Sequence + child ordered : {Bool} +-} +-- cata +sem_CVisit :: CVisit -> + T_CVisit +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 (( )) +data Inh_CVisit = Inh_CVisit {} +data Syn_CVisit = Syn_CVisit {} +wrap_CVisit :: T_CVisit -> + Inh_CVisit -> + Syn_CVisit +wrap_CVisit (T_CVisit sem) (Inh_CVisit) = + (let ( ) = sem + in (Syn_CVisit)) +sem_CVisit_CVisit :: Attributes -> + Attributes -> + T_Sequence -> + T_Sequence -> + Bool -> + T_CVisit +sem_CVisit_CVisit inh_ syn_ (T_Sequence vss_) (T_Sequence intra_) ordered_ = + (T_CVisit ( )) +-- CVisits ----------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CVisit + child tl : CVisits + alternative Nil: +-} +-- cata +sem_CVisits :: CVisits -> + T_CVisits +sem_CVisits list = + (Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list)) +-- semantic domain +newtype T_CVisits = T_CVisits (( )) +data Inh_CVisits = Inh_CVisits {} +data Syn_CVisits = Syn_CVisits {} +wrap_CVisits :: T_CVisits -> + Inh_CVisits -> + Syn_CVisits +wrap_CVisits (T_CVisits sem) (Inh_CVisits) = + (let ( ) = sem + in (Syn_CVisits)) +sem_CVisits_Cons :: T_CVisit -> + T_CVisits -> + T_CVisits +sem_CVisits_Cons (T_CVisit hd_) (T_CVisits tl_) = + (T_CVisits ( )) +sem_CVisits_Nil :: T_CVisits +sem_CVisits_Nil = + (T_CVisits ( )) +-- DeclBlocks -------------------------------------------------- +{- + alternatives: + alternative DeclBlock: + child defs : {[Decl]} + child visit : {Decl} + child next : DeclBlocks + alternative DeclTerminator: + child defs : {[Decl]} + child result : {Expr} +-} +-- cata +sem_DeclBlocks :: DeclBlocks -> + T_DeclBlocks +sem_DeclBlocks (DeclBlock _defs _visit _next) = + (sem_DeclBlocks_DeclBlock _defs _visit (sem_DeclBlocks _next)) +sem_DeclBlocks (DeclTerminator _defs _result) = + (sem_DeclBlocks_DeclTerminator _defs _result) +-- semantic domain +newtype T_DeclBlocks = T_DeclBlocks (( )) +data Inh_DeclBlocks = Inh_DeclBlocks {} +data Syn_DeclBlocks = Syn_DeclBlocks {} +wrap_DeclBlocks :: T_DeclBlocks -> + Inh_DeclBlocks -> + Syn_DeclBlocks +wrap_DeclBlocks (T_DeclBlocks sem) (Inh_DeclBlocks) = + (let ( ) = sem + in (Syn_DeclBlocks)) +sem_DeclBlocks_DeclBlock :: ([Decl]) -> + Decl -> + T_DeclBlocks -> + T_DeclBlocks +sem_DeclBlocks_DeclBlock defs_ visit_ (T_DeclBlocks next_) = + (T_DeclBlocks ( )) +sem_DeclBlocks_DeclTerminator :: ([Decl]) -> + Expr -> + T_DeclBlocks +sem_DeclBlocks_DeclTerminator defs_ result_ = + (T_DeclBlocks ( )) +-- DeclBlocksRoot ---------------------------------------------- +{- + alternatives: + alternative DeclBlocksRoot: + child blocks : DeclBlocks +-} +-- cata +sem_DeclBlocksRoot :: DeclBlocksRoot -> + T_DeclBlocksRoot +sem_DeclBlocksRoot (DeclBlocksRoot _blocks) = + (sem_DeclBlocksRoot_DeclBlocksRoot (sem_DeclBlocks _blocks)) +-- semantic domain +newtype T_DeclBlocksRoot = T_DeclBlocksRoot (( )) +data Inh_DeclBlocksRoot = Inh_DeclBlocksRoot {} +data Syn_DeclBlocksRoot = Syn_DeclBlocksRoot {} +wrap_DeclBlocksRoot :: T_DeclBlocksRoot -> + Inh_DeclBlocksRoot -> + Syn_DeclBlocksRoot +wrap_DeclBlocksRoot (T_DeclBlocksRoot sem) (Inh_DeclBlocksRoot) = + (let ( ) = sem + in (Syn_DeclBlocksRoot)) +sem_DeclBlocksRoot_DeclBlocksRoot :: T_DeclBlocks -> + T_DeclBlocksRoot +sem_DeclBlocksRoot_DeclBlocksRoot (T_DeclBlocks blocks_) = + (T_DeclBlocksRoot ( )) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : Pattern + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern (Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern (Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern (Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +sem_Pattern (Underscore _pos) = + (sem_Pattern_Underscore _pos) +-- semantic domain +newtype T_Pattern = T_Pattern (( Pattern)) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern)} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem) (Inh_Pattern) = + (let ( _lhsOcopy) = sem + in (Syn_Pattern _lhsOcopy)) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_) = + (T_Pattern (case (pats_) of + { ( _patsIcopy) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 593 "dist/build/PrintVisitCode.hs" #-} + )) of + { _copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 598 "dist/build/PrintVisitCode.hs" #-} + )) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) })) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_) = + (T_Pattern (case (pats_) of + { ( _patsIcopy) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 610 "dist/build/PrintVisitCode.hs" #-} + )) of + { _copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 615 "dist/build/PrintVisitCode.hs" #-} + )) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) })) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_) = + (T_Pattern (case (pat_) of + { ( _patIcopy) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 628 "dist/build/PrintVisitCode.hs" #-} + )) of + { _copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 633 "dist/build/PrintVisitCode.hs" #-} + )) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) })) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_) = + (T_Pattern (case (pat_) of + { ( _patIcopy) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 644 "dist/build/PrintVisitCode.hs" #-} + )) of + { _copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 649 "dist/build/PrintVisitCode.hs" #-} + )) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) })) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 658 "dist/build/PrintVisitCode.hs" #-} + )) of + { _copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 663 "dist/build/PrintVisitCode.hs" #-} + )) of + { _lhsOcopy -> + ( _lhsOcopy) }) })) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : 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)) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns)} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem) (Inh_Patterns) = + (let ( _lhsOcopy) = sem + in (Syn_Patterns _lhsOcopy)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = + (T_Patterns (case (tl_) of + { ( _tlIcopy) -> + (case (hd_) of + { ( _hdIcopy) -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 707 "dist/build/PrintVisitCode.hs" #-} + )) of + { _copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 712 "dist/build/PrintVisitCode.hs" #-} + )) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) })) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 720 "dist/build/PrintVisitCode.hs" #-} + )) of + { _copy -> + (case (({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 725 "dist/build/PrintVisitCode.hs" #-} + )) of + { _lhsOcopy -> + ( _lhsOcopy) }) })) +-- Sequence ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CRule + child tl : Sequence + alternative Nil: +-} +-- cata +sem_Sequence :: Sequence -> + T_Sequence +sem_Sequence list = + (Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list)) +-- semantic domain +newtype T_Sequence = T_Sequence (( )) +data Inh_Sequence = Inh_Sequence {} +data Syn_Sequence = Syn_Sequence {} +wrap_Sequence :: T_Sequence -> + Inh_Sequence -> + Syn_Sequence +wrap_Sequence (T_Sequence sem) (Inh_Sequence) = + (let ( ) = sem + in (Syn_Sequence)) +sem_Sequence_Cons :: T_CRule -> + T_Sequence -> + T_Sequence +sem_Sequence_Cons (T_CRule hd_) (T_Sequence tl_) = + (T_Sequence ( )) +sem_Sequence_Nil :: T_Sequence +sem_Sequence_Nil = + (T_Sequence ( )) diff --git a/dist/build/ResolveLocals.hs b/dist/build/ResolveLocals.hs new file mode 100644 --- /dev/null +++ b/dist/build/ResolveLocals.hs @@ -0,0 +1,2912 @@ + + +-- UUAGC 0.9.42.0 (src-ag/ResolveLocals.ag) +module ResolveLocals where +{-# LINE 15 "./src-ag/ResolveLocals.ag" #-} + +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Map(Map) +import qualified Data.Sequence as Seq +import Data.Sequence(Seq,(><)) +import CommonTypes +import Patterns +import ErrorMessages +import AbstractSyntax +import Expression +import Options +import HsToken(HsTokensRoot(HsTokensRoot)) +import HsTokenScanner(lexTokens) +import SemHsTokens(sem_HsTokensRoot,wrap_HsTokensRoot, Syn_HsTokensRoot(..),Inh_HsTokensRoot(..)) +import Data.Maybe +{-# LINE 23 "dist/build/ResolveLocals.hs" #-} + +{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import Macro --marcos +import CommonTypes +import ErrorMessages +{-# LINE 35 "dist/build/ResolveLocals.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 42 "dist/build/ResolveLocals.hs" #-} + +{-# LINE 2 "./src-ag/Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 48 "dist/build/ResolveLocals.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,ChildKind)] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + inh : Attributes + inhMap : Map Identifier Attributes + mergeMap : Map Identifier (Identifier,[Identifier]) + nt : Identifier + syn : Attributes + synMap : Map Identifier Attributes + synthesized attributes: + attributes : [(Identifier,Attributes,Attributes)] + field : (Identifier,Type,ChildKind) + output : Child + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child kind : {ChildKind} + visit 0: + local chnt : _ + local inh : _ + local syn : _ + local output : _ +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child (Child _name _tp _kind) = + (sem_Child_Child _name _tp _kind) +-- semantic domain +newtype T_Child = T_Child (([(Identifier,Type,ChildKind)]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + Attributes -> + (Map Identifier Attributes) -> + (Map Identifier (Identifier,[Identifier])) -> + Identifier -> + Attributes -> + (Map Identifier Attributes) -> + ( ([(Identifier,Attributes,Attributes)]),((Identifier,Type,ChildKind)),Child)) +data Inh_Child = Inh_Child {allfields_Inh_Child :: ([(Identifier,Type,ChildKind)]),allnts_Inh_Child :: ([Identifier]),attrs_Inh_Child :: ([(Identifier,Identifier)]),con_Inh_Child :: Identifier,inh_Inh_Child :: Attributes,inhMap_Inh_Child :: (Map Identifier Attributes),mergeMap_Inh_Child :: (Map Identifier (Identifier,[Identifier])),nt_Inh_Child :: Identifier,syn_Inh_Child :: Attributes,synMap_Inh_Child :: (Map Identifier Attributes)} +data Syn_Child = Syn_Child {attributes_Syn_Child :: ([(Identifier,Attributes,Attributes)]),field_Syn_Child :: ((Identifier,Type,ChildKind)),output_Syn_Child :: Child} +wrap_Child :: T_Child -> + Inh_Child -> + Syn_Child +wrap_Child (T_Child sem) (Inh_Child _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIsyn _lhsIsynMap) = + (let ( _lhsOattributes,_lhsOfield,_lhsOoutput) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIsyn _lhsIsynMap + in (Syn_Child _lhsOattributes _lhsOfield _lhsOoutput)) +sem_Child_Child :: Identifier -> + Type -> + ChildKind -> + T_Child +sem_Child_Child name_ tp_ kind_ = + (T_Child (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIinh + _lhsIinhMap + _lhsImergeMap + _lhsInt + _lhsIsyn + _lhsIsynMap -> + (let _lhsOattributes :: ([(Identifier,Attributes,Attributes)]) + _lhsOfield :: ((Identifier,Type,ChildKind)) + _lhsOoutput :: Child + -- "./src-ag/ResolveLocals.ag"(line 84, column 11) + _lhsOattributes = + ({-# LINE 84 "./src-ag/ResolveLocals.ag" #-} + [(name_, _inh , _syn )] + {-# LINE 125 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/ResolveLocals.ag"(line 87, column 11) + _lhsOfield = + ({-# LINE 87 "./src-ag/ResolveLocals.ag" #-} + (name_, tp_, kind_) + {-# LINE 131 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 19, column 11) + _chnt = + ({-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + case tp_ of + NT nt _ _ -> nt + Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") + Haskell t -> identifier "" + {-# LINE 140 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 23, column 11) + _inh = + ({-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIinhMap + {-# LINE 146 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 24, column 11) + _syn = + ({-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIsynMap + {-# LINE 152 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + Child name_ tp_ kind_ + {-# LINE 158 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 164 "dist/build/ResolveLocals.hs" #-} + ) + in ( _lhsOattributes,_lhsOfield,_lhsOoutput)))) +-- Children ---------------------------------------------------- +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,ChildKind)] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + inh : Attributes + inhMap : Map Identifier Attributes + mergeMap : Map Identifier (Identifier,[Identifier]) + nt : Identifier + syn : Attributes + synMap : Map Identifier Attributes + synthesized attributes: + attributes : [(Identifier,Attributes,Attributes)] + fields : [(Identifier,Type,ChildKind)] + output : Children + 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,Type,ChildKind)]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + Attributes -> + (Map Identifier Attributes) -> + (Map Identifier (Identifier,[Identifier])) -> + Identifier -> + Attributes -> + (Map Identifier Attributes) -> + ( ([(Identifier,Attributes,Attributes)]),([(Identifier,Type,ChildKind)]),Children)) +data Inh_Children = Inh_Children {allfields_Inh_Children :: ([(Identifier,Type,ChildKind)]),allnts_Inh_Children :: ([Identifier]),attrs_Inh_Children :: ([(Identifier,Identifier)]),con_Inh_Children :: Identifier,inh_Inh_Children :: Attributes,inhMap_Inh_Children :: (Map Identifier Attributes),mergeMap_Inh_Children :: (Map Identifier (Identifier,[Identifier])),nt_Inh_Children :: Identifier,syn_Inh_Children :: Attributes,synMap_Inh_Children :: (Map Identifier Attributes)} +data Syn_Children = Syn_Children {attributes_Syn_Children :: ([(Identifier,Attributes,Attributes)]),fields_Syn_Children :: ([(Identifier,Type,ChildKind)]),output_Syn_Children :: Children} +wrap_Children :: T_Children -> + Inh_Children -> + Syn_Children +wrap_Children (T_Children sem) (Inh_Children _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIsyn _lhsIsynMap) = + (let ( _lhsOattributes,_lhsOfields,_lhsOoutput) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIsyn _lhsIsynMap + in (Syn_Children _lhsOattributes _lhsOfields _lhsOoutput)) +sem_Children_Cons :: T_Child -> + T_Children -> + T_Children +sem_Children_Cons (T_Child hd_) (T_Children tl_) = + (T_Children (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIinh + _lhsIinhMap + _lhsImergeMap + _lhsInt + _lhsIsyn + _lhsIsynMap -> + (let _lhsOfields :: ([(Identifier,Type,ChildKind)]) + _lhsOattributes :: ([(Identifier,Attributes,Attributes)]) + _lhsOoutput :: Children + _hdOallfields :: ([(Identifier,Type,ChildKind)]) + _hdOallnts :: ([Identifier]) + _hdOattrs :: ([(Identifier,Identifier)]) + _hdOcon :: Identifier + _hdOinh :: Attributes + _hdOinhMap :: (Map Identifier Attributes) + _hdOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _hdOnt :: Identifier + _hdOsyn :: Attributes + _hdOsynMap :: (Map Identifier Attributes) + _tlOallfields :: ([(Identifier,Type,ChildKind)]) + _tlOallnts :: ([Identifier]) + _tlOattrs :: ([(Identifier,Identifier)]) + _tlOcon :: Identifier + _tlOinh :: Attributes + _tlOinhMap :: (Map Identifier Attributes) + _tlOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _tlOnt :: Identifier + _tlOsyn :: Attributes + _tlOsynMap :: (Map Identifier Attributes) + _hdIattributes :: ([(Identifier,Attributes,Attributes)]) + _hdIfield :: ((Identifier,Type,ChildKind)) + _hdIoutput :: Child + _tlIattributes :: ([(Identifier,Attributes,Attributes)]) + _tlIfields :: ([(Identifier,Type,ChildKind)]) + _tlIoutput :: Children + -- "./src-ag/ResolveLocals.ag"(line 90, column 11) + _lhsOfields = + ({-# LINE 90 "./src-ag/ResolveLocals.ag" #-} + _hdIfield : _tlIfields + {-# LINE 267 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 82, column 32) + _lhsOattributes = + ({-# LINE 82 "./src-ag/ResolveLocals.ag" #-} + _hdIattributes ++ _tlIattributes + {-# LINE 273 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 279 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 285 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOallfields = + ({-# LINE 71 "./src-ag/ResolveLocals.ag" #-} + _lhsIallfields + {-# LINE 291 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOallnts = + ({-# LINE 57 "./src-ag/ResolveLocals.ag" #-} + _lhsIallnts + {-# LINE 297 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOattrs = + ({-# LINE 71 "./src-ag/ResolveLocals.ag" #-} + _lhsIattrs + {-# LINE 303 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 105 "./src-ag/ResolveLocals.ag" #-} + _lhsIcon + {-# LINE 309 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIinh + {-# LINE 315 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 321 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 131 "./src-ag/ResolveLocals.ag" #-} + _lhsImergeMap + {-# LINE 327 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 333 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIsyn + {-# LINE 339 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 345 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOallfields = + ({-# LINE 71 "./src-ag/ResolveLocals.ag" #-} + _lhsIallfields + {-# LINE 351 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOallnts = + ({-# LINE 57 "./src-ag/ResolveLocals.ag" #-} + _lhsIallnts + {-# LINE 357 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOattrs = + ({-# LINE 71 "./src-ag/ResolveLocals.ag" #-} + _lhsIattrs + {-# LINE 363 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 105 "./src-ag/ResolveLocals.ag" #-} + _lhsIcon + {-# LINE 369 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIinh + {-# LINE 375 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 381 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 131 "./src-ag/ResolveLocals.ag" #-} + _lhsImergeMap + {-# LINE 387 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 393 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIsyn + {-# LINE 399 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 405 "dist/build/ResolveLocals.hs" #-} + ) + ( _hdIattributes,_hdIfield,_hdIoutput) = + hd_ _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOinh _hdOinhMap _hdOmergeMap _hdOnt _hdOsyn _hdOsynMap + ( _tlIattributes,_tlIfields,_tlIoutput) = + tl_ _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOinh _tlOinhMap _tlOmergeMap _tlOnt _tlOsyn _tlOsynMap + in ( _lhsOattributes,_lhsOfields,_lhsOoutput)))) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIinh + _lhsIinhMap + _lhsImergeMap + _lhsInt + _lhsIsyn + _lhsIsynMap -> + (let _lhsOfields :: ([(Identifier,Type,ChildKind)]) + _lhsOattributes :: ([(Identifier,Attributes,Attributes)]) + _lhsOoutput :: Children + -- "./src-ag/ResolveLocals.ag"(line 91, column 11) + _lhsOfields = + ({-# LINE 91 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 431 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 82, column 32) + _lhsOattributes = + ({-# LINE 82 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 437 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 443 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 449 "dist/build/ResolveLocals.hs" #-} + ) + in ( _lhsOattributes,_lhsOfields,_lhsOoutput)))) +-- Expression -------------------------------------------------- +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,ChildKind)] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + mergeMap : Map Identifier (Identifier,[Identifier]) + nt : Identifier + options : Options + synthesized attributes: + errors : Seq Error + output : Expression + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} + visit 0: + local errors : _ + local newTks : _ + 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,Type,ChildKind)]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + (Map Identifier (Identifier,[Identifier])) -> + Identifier -> + Options -> + ( (Seq Error),Expression)) +data Inh_Expression = Inh_Expression {allfields_Inh_Expression :: ([(Identifier,Type,ChildKind)]),allnts_Inh_Expression :: ([Identifier]),attrs_Inh_Expression :: ([(Identifier,Identifier)]),con_Inh_Expression :: Identifier,mergeMap_Inh_Expression :: (Map Identifier (Identifier,[Identifier])),nt_Inh_Expression :: Identifier,options_Inh_Expression :: Options} +data Syn_Expression = Syn_Expression {errors_Syn_Expression :: (Seq Error),output_Syn_Expression :: Expression} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem) (Inh_Expression _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt _lhsIoptions) = + (let ( _lhsOerrors,_lhsOoutput) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt _lhsIoptions + in (Syn_Expression _lhsOerrors _lhsOoutput)) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsImergeMap + _lhsInt + _lhsIoptions -> + (let _lhsOoutput :: Expression + _lhsOerrors :: (Seq Error) + -- "./src-ag/ResolveLocals.ag"(line 145, column 21) + (_errors,_newTks) = + ({-# LINE 145 "./src-ag/ResolveLocals.ag" #-} + let mergedChildren = [ x | (_,xs) <- Map.elems _lhsImergeMap, x <- xs ] + attrsIn = filter (\(fld,_) -> not (fld `elem` mergedChildren)) _lhsIattrs + inherited = Inh_HsTokensRoot + { attrs_Inh_HsTokensRoot = attrsIn + , con_Inh_HsTokensRoot = _lhsIcon + , allfields_Inh_HsTokensRoot = _lhsIallfields + , allnts_Inh_HsTokensRoot = _lhsIallnts + , nt_Inh_HsTokensRoot = _lhsInt + } + synthesized = wrap_HsTokensRoot (sem_HsTokensRoot (HsTokensRoot tks_)) inherited + in (errors_Syn_HsTokensRoot synthesized, output_Syn_HsTokensRoot synthesized) + {-# LINE 524 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/ResolveLocals.ag"(line 157, column 17) + _lhsOoutput = + ({-# LINE 157 "./src-ag/ResolveLocals.ag" #-} + Expression pos_ _newTks + {-# LINE 530 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + _errors + {-# LINE 536 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + Expression pos_ tks_ + {-# LINE 542 "dist/build/ResolveLocals.hs" #-} + ) + in ( _lhsOerrors,_lhsOoutput)))) +-- Grammar ----------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + errors : Seq Error + output : Grammar + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} + visit 0: + local output : _ +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) +-- semantic domain +newtype T_Grammar = T_Grammar (Options -> + ( (Seq Error),Grammar)) +data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: Options} +data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: (Seq Error),output_Syn_Grammar :: Grammar} +wrap_Grammar :: T_Grammar -> + Inh_Grammar -> + Syn_Grammar +wrap_Grammar (T_Grammar sem) (Inh_Grammar _lhsIoptions) = + (let ( _lhsOerrors,_lhsOoutput) = sem _lhsIoptions + in (Syn_Grammar _lhsOerrors _lhsOoutput)) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ = + (T_Grammar (\ _lhsIoptions -> + (let _nontsOallnts :: ([Identifier]) + _nontsOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) + _nontsOinhMap :: (Map Identifier Attributes) + _nontsOsynMap :: (Map Identifier Attributes) + _lhsOerrors :: (Seq Error) + _lhsOoutput :: Grammar + _nontsOoptions :: Options + _nontsIerrors :: (Seq Error) + _nontsIinhMap' :: (Map Identifier Attributes) + _nontsInonts :: ([(NontermIdent,[ConstructorIdent])]) + _nontsIoutput :: Nonterminals + _nontsIsynMap' :: (Map Identifier Attributes) + -- "./src-ag/ResolveLocals.ag"(line 60, column 13) + _nontsOallnts = + ({-# LINE 60 "./src-ag/ResolveLocals.ag" #-} + map fst (_nontsInonts) + {-# LINE 621 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/ResolveLocals.ag"(line 120, column 14) + _nontsOmergeMap = + ({-# LINE 120 "./src-ag/ResolveLocals.ag" #-} + Map.map (Map.map (Map.map (\(nt,srcs,_) -> (nt,srcs)))) mergeMap_ + {-# LINE 627 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 15, column 13) + _nontsOinhMap = + ({-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + _nontsIinhMap' + {-# LINE 633 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 16, column 13) + _nontsOsynMap = + ({-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + _nontsIsynMap' + {-# LINE 639 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + _nontsIerrors + {-# LINE 645 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ + {-# LINE 651 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 657 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _nontsOoptions = + ({-# LINE 41 "./src-ag/ResolveLocals.ag" #-} + _lhsIoptions + {-# LINE 663 "dist/build/ResolveLocals.hs" #-} + ) + ( _nontsIerrors,_nontsIinhMap',_nontsInonts,_nontsIoutput,_nontsIsynMap') = + nonts_ _nontsOallnts _nontsOinhMap _nontsOmergeMap _nontsOoptions _nontsOsynMap + in ( _lhsOerrors,_lhsOoutput)))) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + inherited attributes: + allnts : [Identifier] + inhMap : Map Identifier Attributes + mergeMap : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) + options : Options + synMap : Map Identifier Attributes + synthesized attributes: + errors : Seq Error + inhMap' : Map Identifier Attributes + nonts : [(NontermIdent,[ConstructorIdent])] + output : Nonterminal + synMap' : Map Identifier Attributes + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions + visit 0: + local mergeMap : _ + 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 (([Identifier]) -> + (Map Identifier Attributes) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> + Options -> + (Map Identifier Attributes) -> + ( (Seq Error),(Map Identifier Attributes),([(NontermIdent,[ConstructorIdent])]),Nonterminal,(Map Identifier Attributes))) +data Inh_Nonterminal = Inh_Nonterminal {allnts_Inh_Nonterminal :: ([Identifier]),inhMap_Inh_Nonterminal :: (Map Identifier Attributes),mergeMap_Inh_Nonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))),options_Inh_Nonterminal :: Options,synMap_Inh_Nonterminal :: (Map Identifier Attributes)} +data Syn_Nonterminal = Syn_Nonterminal {errors_Syn_Nonterminal :: (Seq Error),inhMap'_Syn_Nonterminal :: (Map Identifier Attributes),nonts_Syn_Nonterminal :: ([(NontermIdent,[ConstructorIdent])]),output_Syn_Nonterminal :: Nonterminal,synMap'_Syn_Nonterminal :: (Map Identifier Attributes)} +wrap_Nonterminal :: T_Nonterminal -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap) = + (let ( _lhsOerrors,_lhsOinhMap',_lhsOnonts,_lhsOoutput,_lhsOsynMap') = sem _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap + in (Syn_Nonterminal _lhsOerrors _lhsOinhMap' _lhsOnonts _lhsOoutput _lhsOsynMap')) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) = + (T_Nonterminal (\ _lhsIallnts + _lhsIinhMap + _lhsImergeMap + _lhsIoptions + _lhsIsynMap -> + (let _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])]) + _prodsOnt :: Identifier + _prodsOinh :: Attributes + _prodsOsyn :: Attributes + _lhsOinhMap' :: (Map Identifier Attributes) + _lhsOsynMap' :: (Map Identifier Attributes) + _lhsOerrors :: (Seq Error) + _lhsOoutput :: Nonterminal + _prodsOallnts :: ([Identifier]) + _prodsOinhMap :: (Map Identifier Attributes) + _prodsOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) + _prodsOoptions :: Options + _prodsOsynMap :: (Map Identifier Attributes) + _prodsIcons :: ([ConstructorIdent]) + _prodsIerrors :: (Seq Error) + _prodsIoutput :: Productions + -- "./src-ag/ResolveLocals.ag"(line 64, column 19) + _lhsOnonts = + ({-# LINE 64 "./src-ag/ResolveLocals.ag" #-} + [(nt_,_prodsIcons)] + {-# LINE 746 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/ResolveLocals.ag"(line 112, column 17) + _prodsOnt = + ({-# LINE 112 "./src-ag/ResolveLocals.ag" #-} + nt_ + {-# LINE 752 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/ResolveLocals.ag"(line 115, column 17) + _prodsOinh = + ({-# LINE 115 "./src-ag/ResolveLocals.ag" #-} + inh_ + {-# LINE 758 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/ResolveLocals.ag"(line 116, column 17) + _prodsOsyn = + ({-# LINE 116 "./src-ag/ResolveLocals.ag" #-} + syn_ + {-# LINE 764 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/ResolveLocals.ag"(line 128, column 32) + _mergeMap = + ({-# LINE 128 "./src-ag/ResolveLocals.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsImergeMap + {-# LINE 770 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 7, column 18) + _lhsOinhMap' = + ({-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 776 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 8, column 18) + _lhsOsynMap' = + ({-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 782 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + _prodsIerrors + {-# LINE 788 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + Nonterminal nt_ params_ inh_ syn_ _prodsIoutput + {-# LINE 794 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 800 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _prodsOallnts = + ({-# LINE 57 "./src-ag/ResolveLocals.ag" #-} + _lhsIallnts + {-# LINE 806 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _prodsOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 812 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (from local) + _prodsOmergeMap = + ({-# LINE 126 "./src-ag/ResolveLocals.ag" #-} + _mergeMap + {-# LINE 818 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _prodsOoptions = + ({-# LINE 41 "./src-ag/ResolveLocals.ag" #-} + _lhsIoptions + {-# LINE 824 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _prodsOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 830 "dist/build/ResolveLocals.hs" #-} + ) + ( _prodsIcons,_prodsIerrors,_prodsIoutput) = + prods_ _prodsOallnts _prodsOinh _prodsOinhMap _prodsOmergeMap _prodsOnt _prodsOoptions _prodsOsyn _prodsOsynMap + in ( _lhsOerrors,_lhsOinhMap',_lhsOnonts,_lhsOoutput,_lhsOsynMap')))) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + inherited attributes: + allnts : [Identifier] + inhMap : Map Identifier Attributes + mergeMap : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) + options : Options + synMap : Map Identifier Attributes + synthesized attributes: + errors : Seq Error + inhMap' : Map Identifier Attributes + nonts : [(NontermIdent,[ConstructorIdent])] + output : Nonterminals + synMap' : Map Identifier Attributes + 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 (([Identifier]) -> + (Map Identifier Attributes) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> + Options -> + (Map Identifier Attributes) -> + ( (Seq Error),(Map Identifier Attributes),([(NontermIdent,[ConstructorIdent])]),Nonterminals,(Map Identifier Attributes))) +data Inh_Nonterminals = Inh_Nonterminals {allnts_Inh_Nonterminals :: ([Identifier]),inhMap_Inh_Nonterminals :: (Map Identifier Attributes),mergeMap_Inh_Nonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))),options_Inh_Nonterminals :: Options,synMap_Inh_Nonterminals :: (Map Identifier Attributes)} +data Syn_Nonterminals = Syn_Nonterminals {errors_Syn_Nonterminals :: (Seq Error),inhMap'_Syn_Nonterminals :: (Map Identifier Attributes),nonts_Syn_Nonterminals :: ([(NontermIdent,[ConstructorIdent])]),output_Syn_Nonterminals :: Nonterminals,synMap'_Syn_Nonterminals :: (Map Identifier Attributes)} +wrap_Nonterminals :: T_Nonterminals -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap) = + (let ( _lhsOerrors,_lhsOinhMap',_lhsOnonts,_lhsOoutput,_lhsOsynMap') = sem _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap + in (Syn_Nonterminals _lhsOerrors _lhsOinhMap' _lhsOnonts _lhsOoutput _lhsOsynMap')) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) = + (T_Nonterminals (\ _lhsIallnts + _lhsIinhMap + _lhsImergeMap + _lhsIoptions + _lhsIsynMap -> + (let _lhsOerrors :: (Seq Error) + _lhsOinhMap' :: (Map Identifier Attributes) + _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])]) + _lhsOsynMap' :: (Map Identifier Attributes) + _lhsOoutput :: Nonterminals + _hdOallnts :: ([Identifier]) + _hdOinhMap :: (Map Identifier Attributes) + _hdOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) + _hdOoptions :: Options + _hdOsynMap :: (Map Identifier Attributes) + _tlOallnts :: ([Identifier]) + _tlOinhMap :: (Map Identifier Attributes) + _tlOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) + _tlOoptions :: Options + _tlOsynMap :: (Map Identifier Attributes) + _hdIerrors :: (Seq Error) + _hdIinhMap' :: (Map Identifier Attributes) + _hdInonts :: ([(NontermIdent,[ConstructorIdent])]) + _hdIoutput :: Nonterminal + _hdIsynMap' :: (Map Identifier Attributes) + _tlIerrors :: (Seq Error) + _tlIinhMap' :: (Map Identifier Attributes) + _tlInonts :: ([(NontermIdent,[ConstructorIdent])]) + _tlIoutput :: Nonterminals + _tlIsynMap' :: (Map Identifier Attributes) + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 918 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOinhMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + _hdIinhMap' `Map.union` _tlIinhMap' + {-# LINE 924 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 62, column 43) + _lhsOnonts = + ({-# LINE 62 "./src-ag/ResolveLocals.ag" #-} + _hdInonts ++ _tlInonts + {-# LINE 930 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOsynMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + _hdIsynMap' `Map.union` _tlIsynMap' + {-# LINE 936 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 942 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 948 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOallnts = + ({-# LINE 57 "./src-ag/ResolveLocals.ag" #-} + _lhsIallnts + {-# LINE 954 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 960 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 123 "./src-ag/ResolveLocals.ag" #-} + _lhsImergeMap + {-# LINE 966 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 41 "./src-ag/ResolveLocals.ag" #-} + _lhsIoptions + {-# LINE 972 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 978 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOallnts = + ({-# LINE 57 "./src-ag/ResolveLocals.ag" #-} + _lhsIallnts + {-# LINE 984 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 990 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 123 "./src-ag/ResolveLocals.ag" #-} + _lhsImergeMap + {-# LINE 996 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 41 "./src-ag/ResolveLocals.ag" #-} + _lhsIoptions + {-# LINE 1002 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1008 "dist/build/ResolveLocals.hs" #-} + ) + ( _hdIerrors,_hdIinhMap',_hdInonts,_hdIoutput,_hdIsynMap') = + hd_ _hdOallnts _hdOinhMap _hdOmergeMap _hdOoptions _hdOsynMap + ( _tlIerrors,_tlIinhMap',_tlInonts,_tlIoutput,_tlIsynMap') = + tl_ _tlOallnts _tlOinhMap _tlOmergeMap _tlOoptions _tlOsynMap + in ( _lhsOerrors,_lhsOinhMap',_lhsOnonts,_lhsOoutput,_lhsOsynMap')))) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (\ _lhsIallnts + _lhsIinhMap + _lhsImergeMap + _lhsIoptions + _lhsIsynMap -> + (let _lhsOerrors :: (Seq Error) + _lhsOinhMap' :: (Map Identifier Attributes) + _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])]) + _lhsOsynMap' :: (Map Identifier Attributes) + _lhsOoutput :: Nonterminals + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + Seq.empty + {-# LINE 1031 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOinhMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + Map.empty + {-# LINE 1037 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 62, column 43) + _lhsOnonts = + ({-# LINE 62 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 1043 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOsynMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + Map.empty + {-# LINE 1049 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 1055 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 1061 "dist/build/ResolveLocals.hs" #-} + ) + in ( _lhsOerrors,_lhsOinhMap',_lhsOnonts,_lhsOoutput,_lhsOsynMap')))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + inherited attributes: + con : Identifier + inh : Attributes + nt : Identifier + syn : Attributes + synthesized attributes: + copy : Pattern + errors : Seq Error + instVars : [Identifier] + locVars : [Identifier] + output : Pattern + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + local output : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + local output : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local copy : _ + local output : _ + alternative Irrefutable: + child pat : Pattern + 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 (Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern (Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern (Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern (Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +sem_Pattern (Underscore _pos) = + (sem_Pattern_Underscore _pos) +-- semantic domain +newtype T_Pattern = T_Pattern (Identifier -> + Attributes -> + Identifier -> + Attributes -> + ( Pattern,(Seq Error),([Identifier]),([Identifier]),Pattern)) +data Inh_Pattern = Inh_Pattern {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),instVars_Syn_Pattern :: ([Identifier]),locVars_Syn_Pattern :: ([Identifier]),output_Syn_Pattern :: Pattern} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem) (Inh_Pattern _lhsIcon _lhsIinh _lhsInt _lhsIsyn) = + (let ( _lhsOcopy,_lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput) = sem _lhsIcon _lhsIinh _lhsInt _lhsIsyn + in (Syn_Pattern _lhsOcopy _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput)) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_) = + (T_Pattern (\ _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOcopy :: Pattern + _lhsOoutput :: Pattern + _patsOcon :: Identifier + _patsOinh :: Attributes + _patsOnt :: Identifier + _patsOsyn :: Attributes + _patsIcopy :: Patterns + _patsIerrors :: (Seq Error) + _patsIinstVars :: ([Identifier]) + _patsIlocVars :: ([Identifier]) + _patsIoutput :: Patterns + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + _patsIerrors + {-# LINE 1162 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 86) + _lhsOinstVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + _patsIinstVars + {-# LINE 1168 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 48) + _lhsOlocVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + _patsIlocVars + {-# LINE 1174 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 1180 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + Constr name_ _patsIoutput + {-# LINE 1186 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1192 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 1198 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patsOcon = + ({-# LINE 105 "./src-ag/ResolveLocals.ag" #-} + _lhsIcon + {-# LINE 1204 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patsOinh = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIinh + {-# LINE 1210 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patsOnt = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 1216 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patsOsyn = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIsyn + {-# LINE 1222 "dist/build/ResolveLocals.hs" #-} + ) + ( _patsIcopy,_patsIerrors,_patsIinstVars,_patsIlocVars,_patsIoutput) = + pats_ _patsOcon _patsOinh _patsOnt _patsOsyn + in ( _lhsOcopy,_lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput)))) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_) = + (T_Pattern (\ _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOcopy :: Pattern + _lhsOoutput :: Pattern + _patsOcon :: Identifier + _patsOinh :: Attributes + _patsOnt :: Identifier + _patsOsyn :: Attributes + _patsIcopy :: Patterns + _patsIerrors :: (Seq Error) + _patsIinstVars :: ([Identifier]) + _patsIlocVars :: ([Identifier]) + _patsIoutput :: Patterns + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + _patsIerrors + {-# LINE 1253 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 86) + _lhsOinstVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + _patsIinstVars + {-# LINE 1259 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 48) + _lhsOlocVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + _patsIlocVars + {-# LINE 1265 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 1271 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + Product pos_ _patsIoutput + {-# LINE 1277 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1283 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 1289 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patsOcon = + ({-# LINE 105 "./src-ag/ResolveLocals.ag" #-} + _lhsIcon + {-# LINE 1295 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patsOinh = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIinh + {-# LINE 1301 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patsOnt = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 1307 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patsOsyn = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIsyn + {-# LINE 1313 "dist/build/ResolveLocals.hs" #-} + ) + ( _patsIcopy,_patsIerrors,_patsIinstVars,_patsIlocVars,_patsIoutput) = + pats_ _patsOcon _patsOinh _patsOnt _patsOsyn + in ( _lhsOcopy,_lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput)))) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_) = + (T_Pattern (\ _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOlocVars :: ([Identifier]) + _lhsOinstVars :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOcopy :: Pattern + _lhsOoutput :: Pattern + _patOcon :: Identifier + _patOinh :: Attributes + _patOnt :: Identifier + _patOsyn :: Attributes + _patIcopy :: Pattern + _patIerrors :: (Seq Error) + _patIinstVars :: ([Identifier]) + _patIlocVars :: ([Identifier]) + _patIoutput :: Pattern + -- "./src-ag/ResolveLocals.ag"(line 96, column 14) + _lhsOlocVars = + ({-# LINE 96 "./src-ag/ResolveLocals.ag" #-} + if field_ == _LOC + then [attr_] + else [] + {-# LINE 1347 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/ResolveLocals.ag"(line 99, column 14) + _lhsOinstVars = + ({-# LINE 99 "./src-ag/ResolveLocals.ag" #-} + if field_ == _INST + then [attr_] + else [] + {-# LINE 1355 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + _patIerrors + {-# LINE 1361 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 1367 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + Alias field_ attr_ _patIoutput + {-# LINE 1373 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1379 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 1385 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patOcon = + ({-# LINE 105 "./src-ag/ResolveLocals.ag" #-} + _lhsIcon + {-# LINE 1391 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patOinh = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIinh + {-# LINE 1397 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patOnt = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 1403 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patOsyn = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIsyn + {-# LINE 1409 "dist/build/ResolveLocals.hs" #-} + ) + ( _patIcopy,_patIerrors,_patIinstVars,_patIlocVars,_patIoutput) = + pat_ _patOcon _patOinh _patOnt _patOsyn + in ( _lhsOcopy,_lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput)))) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_) = + (T_Pattern (\ _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOcopy :: Pattern + _lhsOoutput :: Pattern + _patOcon :: Identifier + _patOinh :: Attributes + _patOnt :: Identifier + _patOsyn :: Attributes + _patIcopy :: Pattern + _patIerrors :: (Seq Error) + _patIinstVars :: ([Identifier]) + _patIlocVars :: ([Identifier]) + _patIoutput :: Pattern + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + _patIerrors + {-# LINE 1439 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 86) + _lhsOinstVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + _patIinstVars + {-# LINE 1445 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 48) + _lhsOlocVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + _patIlocVars + {-# LINE 1451 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 1457 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + Irrefutable _patIoutput + {-# LINE 1463 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1469 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 1475 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patOcon = + ({-# LINE 105 "./src-ag/ResolveLocals.ag" #-} + _lhsIcon + {-# LINE 1481 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patOinh = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIinh + {-# LINE 1487 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patOnt = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 1493 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patOsyn = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIsyn + {-# LINE 1499 "dist/build/ResolveLocals.hs" #-} + ) + ( _patIcopy,_patIerrors,_patIinstVars,_patIlocVars,_patIoutput) = + pat_ _patOcon _patOinh _patOnt _patOsyn + in ( _lhsOcopy,_lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput)))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (\ _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOcopy :: Pattern + _lhsOoutput :: Pattern + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + Seq.empty + {-# LINE 1520 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 86) + _lhsOinstVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 1526 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 48) + _lhsOlocVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 1532 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 1538 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + Underscore pos_ + {-# LINE 1544 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1550 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 1556 "dist/build/ResolveLocals.hs" #-} + ) + in ( _lhsOcopy,_lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput)))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + inherited attributes: + con : Identifier + inh : Attributes + nt : Identifier + syn : Attributes + synthesized attributes: + copy : Patterns + errors : Seq Error + instVars : [Identifier] + locVars : [Identifier] + output : Patterns + 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 -> + Attributes -> + Identifier -> + Attributes -> + ( Patterns,(Seq Error),([Identifier]),([Identifier]),Patterns)) +data Inh_Patterns = Inh_Patterns {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),instVars_Syn_Patterns :: ([Identifier]),locVars_Syn_Patterns :: ([Identifier]),output_Syn_Patterns :: Patterns} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem) (Inh_Patterns _lhsIcon _lhsIinh _lhsInt _lhsIsyn) = + (let ( _lhsOcopy,_lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput) = sem _lhsIcon _lhsIinh _lhsInt _lhsIsyn + in (Syn_Patterns _lhsOcopy _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = + (T_Patterns (\ _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOcopy :: Patterns + _lhsOoutput :: Patterns + _hdOcon :: Identifier + _hdOinh :: Attributes + _hdOnt :: Identifier + _hdOsyn :: Attributes + _tlOcon :: Identifier + _tlOinh :: Attributes + _tlOnt :: Identifier + _tlOsyn :: Attributes + _hdIcopy :: Pattern + _hdIerrors :: (Seq Error) + _hdIinstVars :: ([Identifier]) + _hdIlocVars :: ([Identifier]) + _hdIoutput :: Pattern + _tlIcopy :: Patterns + _tlIerrors :: (Seq Error) + _tlIinstVars :: ([Identifier]) + _tlIlocVars :: ([Identifier]) + _tlIoutput :: Patterns + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 1639 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 86) + _lhsOinstVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + _hdIinstVars ++ _tlIinstVars + {-# LINE 1645 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 48) + _lhsOlocVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + _hdIlocVars ++ _tlIlocVars + {-# LINE 1651 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 1657 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 1663 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1669 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 1675 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 105 "./src-ag/ResolveLocals.ag" #-} + _lhsIcon + {-# LINE 1681 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIinh + {-# LINE 1687 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 1693 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIsyn + {-# LINE 1699 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 105 "./src-ag/ResolveLocals.ag" #-} + _lhsIcon + {-# LINE 1705 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIinh + {-# LINE 1711 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 1717 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIsyn + {-# LINE 1723 "dist/build/ResolveLocals.hs" #-} + ) + ( _hdIcopy,_hdIerrors,_hdIinstVars,_hdIlocVars,_hdIoutput) = + hd_ _hdOcon _hdOinh _hdOnt _hdOsyn + ( _tlIcopy,_tlIerrors,_tlIinstVars,_tlIlocVars,_tlIoutput) = + tl_ _tlOcon _tlOinh _tlOnt _tlOsyn + in ( _lhsOcopy,_lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput)))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (\ _lhsIcon + _lhsIinh + _lhsInt + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOcopy :: Patterns + _lhsOoutput :: Patterns + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + Seq.empty + {-# LINE 1745 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 86) + _lhsOinstVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 1751 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 48) + _lhsOlocVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 1757 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 1763 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 1769 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1775 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 1781 "dist/build/ResolveLocals.hs" #-} + ) + in ( _lhsOcopy,_lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput)))) +-- Production -------------------------------------------------- +{- + visit 0: + inherited attributes: + allnts : [Identifier] + inh : Attributes + inhMap : Map Identifier Attributes + mergeMap : Map ConstructorIdent (Map Identifier (Identifier,[Identifier])) + nt : Identifier + options : Options + syn : Attributes + synMap : Map Identifier Attributes + synthesized attributes: + cons : [ConstructorIdent] + errors : Seq Error + output : Production + alternatives: + alternative Production: + child con : {ConstructorIdent} + child params : {[Identifier]} + child constraints : {[Type]} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + child macro : {MaybeMacro} + visit 0: + local allfields : _ + local attrs : _ + local inhnames : _ + local synnames : _ + local mergeMap : _ + local output : _ +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production (Production _con _params _constraints _children _rules _typeSigs _macro) = + (sem_Production_Production _con _params _constraints (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs) _macro) +-- semantic domain +newtype T_Production = T_Production (([Identifier]) -> + Attributes -> + (Map Identifier Attributes) -> + (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) -> + Identifier -> + Options -> + Attributes -> + (Map Identifier Attributes) -> + ( ([ConstructorIdent]),(Seq Error),Production)) +data Inh_Production = Inh_Production {allnts_Inh_Production :: ([Identifier]),inh_Inh_Production :: Attributes,inhMap_Inh_Production :: (Map Identifier Attributes),mergeMap_Inh_Production :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))),nt_Inh_Production :: Identifier,options_Inh_Production :: Options,syn_Inh_Production :: Attributes,synMap_Inh_Production :: (Map Identifier Attributes)} +data Syn_Production = Syn_Production {cons_Syn_Production :: ([ConstructorIdent]),errors_Syn_Production :: (Seq Error),output_Syn_Production :: Production} +wrap_Production :: T_Production -> + Inh_Production -> + Syn_Production +wrap_Production (T_Production sem) (Inh_Production _lhsIallnts _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn _lhsIsynMap) = + (let ( _lhsOcons,_lhsOerrors,_lhsOoutput) = sem _lhsIallnts _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn _lhsIsynMap + in (Syn_Production _lhsOcons _lhsOerrors _lhsOoutput)) +sem_Production_Production :: ConstructorIdent -> + ([Identifier]) -> + ([Type]) -> + T_Children -> + T_Rules -> + T_TypeSigs -> + MaybeMacro -> + T_Production +sem_Production_Production con_ params_ constraints_ (T_Children children_) (T_Rules rules_) (T_TypeSigs typeSigs_) macro_ = + (T_Production (\ _lhsIallnts + _lhsIinh + _lhsIinhMap + _lhsImergeMap + _lhsInt + _lhsIoptions + _lhsIsyn + _lhsIsynMap -> + (let _lhsOcons :: ([ConstructorIdent]) + _childrenOcon :: Identifier + _rulesOcon :: Identifier + _lhsOerrors :: (Seq Error) + _lhsOoutput :: Production + _childrenOallfields :: ([(Identifier,Type,ChildKind)]) + _childrenOallnts :: ([Identifier]) + _childrenOattrs :: ([(Identifier,Identifier)]) + _childrenOinh :: Attributes + _childrenOinhMap :: (Map Identifier Attributes) + _childrenOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _childrenOnt :: Identifier + _childrenOsyn :: Attributes + _childrenOsynMap :: (Map Identifier Attributes) + _rulesOallfields :: ([(Identifier,Type,ChildKind)]) + _rulesOallnts :: ([Identifier]) + _rulesOattrs :: ([(Identifier,Identifier)]) + _rulesOinh :: Attributes + _rulesOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _rulesOnt :: Identifier + _rulesOoptions :: Options + _rulesOsyn :: Attributes + _childrenIattributes :: ([(Identifier,Attributes,Attributes)]) + _childrenIfields :: ([(Identifier,Type,ChildKind)]) + _childrenIoutput :: Children + _rulesIerrors :: (Seq Error) + _rulesIinstVars :: ([Identifier]) + _rulesIlocVars :: ([Identifier]) + _rulesIoutput :: Rules + _typeSigsIoutput :: TypeSigs + -- "./src-ag/ResolveLocals.ag"(line 67, column 18) + _lhsOcons = + ({-# LINE 67 "./src-ag/ResolveLocals.ag" #-} + [con_] + {-# LINE 1891 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/ResolveLocals.ag"(line 74, column 16) + _allfields = + ({-# LINE 74 "./src-ag/ResolveLocals.ag" #-} + _childrenIfields + {-# LINE 1897 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/ResolveLocals.ag"(line 74, column 16) + _attrs = + ({-# LINE 75 "./src-ag/ResolveLocals.ag" #-} + map ((,) _LOC) _rulesIlocVars ++ + map ((,) _INST) _rulesIinstVars ++ + map ((,) _LHS) _inhnames ++ + concat [map ((,) nm) (Map.keys as) | (nm,_,as) <- _childrenIattributes] + {-# LINE 1906 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/ResolveLocals.ag"(line 74, column 16) + _inhnames = + ({-# LINE 79 "./src-ag/ResolveLocals.ag" #-} + Map.keys _lhsIinh + {-# LINE 1912 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/ResolveLocals.ag"(line 74, column 16) + _synnames = + ({-# LINE 80 "./src-ag/ResolveLocals.ag" #-} + Map.keys _lhsIsyn + {-# LINE 1918 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/ResolveLocals.ag"(line 108, column 16) + _childrenOcon = + ({-# LINE 108 "./src-ag/ResolveLocals.ag" #-} + con_ + {-# LINE 1924 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/ResolveLocals.ag"(line 110, column 16) + _rulesOcon = + ({-# LINE 110 "./src-ag/ResolveLocals.ag" #-} + con_ + {-# LINE 1930 "dist/build/ResolveLocals.hs" #-} + ) + -- "./src-ag/ResolveLocals.ag"(line 129, column 32) + _mergeMap = + ({-# LINE 129 "./src-ag/ResolveLocals.ag" #-} + Map.findWithDefault Map.empty con_ _lhsImergeMap + {-# LINE 1936 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + _rulesIerrors + {-# LINE 1942 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + Production con_ params_ constraints_ _childrenIoutput _rulesIoutput _typeSigsIoutput macro_ + {-# LINE 1948 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 1954 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (from local) + _childrenOallfields = + ({-# LINE 71 "./src-ag/ResolveLocals.ag" #-} + _allfields + {-# LINE 1960 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _childrenOallnts = + ({-# LINE 57 "./src-ag/ResolveLocals.ag" #-} + _lhsIallnts + {-# LINE 1966 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (from local) + _childrenOattrs = + ({-# LINE 71 "./src-ag/ResolveLocals.ag" #-} + _attrs + {-# LINE 1972 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _childrenOinh = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIinh + {-# LINE 1978 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _childrenOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1984 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (from local) + _childrenOmergeMap = + ({-# LINE 131 "./src-ag/ResolveLocals.ag" #-} + _mergeMap + {-# LINE 1990 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _childrenOnt = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 1996 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _childrenOsyn = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIsyn + {-# LINE 2002 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _childrenOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2008 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (from local) + _rulesOallfields = + ({-# LINE 71 "./src-ag/ResolveLocals.ag" #-} + _allfields + {-# LINE 2014 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _rulesOallnts = + ({-# LINE 57 "./src-ag/ResolveLocals.ag" #-} + _lhsIallnts + {-# LINE 2020 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (from local) + _rulesOattrs = + ({-# LINE 71 "./src-ag/ResolveLocals.ag" #-} + _attrs + {-# LINE 2026 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _rulesOinh = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIinh + {-# LINE 2032 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (from local) + _rulesOmergeMap = + ({-# LINE 131 "./src-ag/ResolveLocals.ag" #-} + _mergeMap + {-# LINE 2038 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _rulesOnt = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 2044 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _rulesOoptions = + ({-# LINE 41 "./src-ag/ResolveLocals.ag" #-} + _lhsIoptions + {-# LINE 2050 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _rulesOsyn = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIsyn + {-# LINE 2056 "dist/build/ResolveLocals.hs" #-} + ) + ( _childrenIattributes,_childrenIfields,_childrenIoutput) = + children_ _childrenOallfields _childrenOallnts _childrenOattrs _childrenOcon _childrenOinh _childrenOinhMap _childrenOmergeMap _childrenOnt _childrenOsyn _childrenOsynMap + ( _rulesIerrors,_rulesIinstVars,_rulesIlocVars,_rulesIoutput) = + rules_ _rulesOallfields _rulesOallnts _rulesOattrs _rulesOcon _rulesOinh _rulesOmergeMap _rulesOnt _rulesOoptions _rulesOsyn + ( _typeSigsIoutput) = + typeSigs_ + in ( _lhsOcons,_lhsOerrors,_lhsOoutput)))) +-- Productions ------------------------------------------------- +{- + visit 0: + inherited attributes: + allnts : [Identifier] + inh : Attributes + inhMap : Map Identifier Attributes + mergeMap : Map ConstructorIdent (Map Identifier (Identifier,[Identifier])) + nt : Identifier + options : Options + syn : Attributes + synMap : Map Identifier Attributes + synthesized attributes: + cons : [ConstructorIdent] + errors : Seq Error + output : Productions + 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 (([Identifier]) -> + Attributes -> + (Map Identifier Attributes) -> + (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) -> + Identifier -> + Options -> + Attributes -> + (Map Identifier Attributes) -> + ( ([ConstructorIdent]),(Seq Error),Productions)) +data Inh_Productions = Inh_Productions {allnts_Inh_Productions :: ([Identifier]),inh_Inh_Productions :: Attributes,inhMap_Inh_Productions :: (Map Identifier Attributes),mergeMap_Inh_Productions :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))),nt_Inh_Productions :: Identifier,options_Inh_Productions :: Options,syn_Inh_Productions :: Attributes,synMap_Inh_Productions :: (Map Identifier Attributes)} +data Syn_Productions = Syn_Productions {cons_Syn_Productions :: ([ConstructorIdent]),errors_Syn_Productions :: (Seq Error),output_Syn_Productions :: Productions} +wrap_Productions :: T_Productions -> + Inh_Productions -> + Syn_Productions +wrap_Productions (T_Productions sem) (Inh_Productions _lhsIallnts _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn _lhsIsynMap) = + (let ( _lhsOcons,_lhsOerrors,_lhsOoutput) = sem _lhsIallnts _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn _lhsIsynMap + in (Syn_Productions _lhsOcons _lhsOerrors _lhsOoutput)) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons (T_Production hd_) (T_Productions tl_) = + (T_Productions (\ _lhsIallnts + _lhsIinh + _lhsIinhMap + _lhsImergeMap + _lhsInt + _lhsIoptions + _lhsIsyn + _lhsIsynMap -> + (let _lhsOcons :: ([ConstructorIdent]) + _lhsOerrors :: (Seq Error) + _lhsOoutput :: Productions + _hdOallnts :: ([Identifier]) + _hdOinh :: Attributes + _hdOinhMap :: (Map Identifier Attributes) + _hdOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) + _hdOnt :: Identifier + _hdOoptions :: Options + _hdOsyn :: Attributes + _hdOsynMap :: (Map Identifier Attributes) + _tlOallnts :: ([Identifier]) + _tlOinh :: Attributes + _tlOinhMap :: (Map Identifier Attributes) + _tlOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) + _tlOnt :: Identifier + _tlOoptions :: Options + _tlOsyn :: Attributes + _tlOsynMap :: (Map Identifier Attributes) + _hdIcons :: ([ConstructorIdent]) + _hdIerrors :: (Seq Error) + _hdIoutput :: Production + _tlIcons :: ([ConstructorIdent]) + _tlIerrors :: (Seq Error) + _tlIoutput :: Productions + -- use rule "./src-ag/ResolveLocals.ag"(line 65, column 40) + _lhsOcons = + ({-# LINE 65 "./src-ag/ResolveLocals.ag" #-} + _hdIcons ++ _tlIcons + {-# LINE 2155 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 2161 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 2167 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 2173 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOallnts = + ({-# LINE 57 "./src-ag/ResolveLocals.ag" #-} + _lhsIallnts + {-# LINE 2179 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIinh + {-# LINE 2185 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 2191 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 126 "./src-ag/ResolveLocals.ag" #-} + _lhsImergeMap + {-# LINE 2197 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 2203 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 41 "./src-ag/ResolveLocals.ag" #-} + _lhsIoptions + {-# LINE 2209 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIsyn + {-# LINE 2215 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2221 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOallnts = + ({-# LINE 57 "./src-ag/ResolveLocals.ag" #-} + _lhsIallnts + {-# LINE 2227 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIinh + {-# LINE 2233 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 2239 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 126 "./src-ag/ResolveLocals.ag" #-} + _lhsImergeMap + {-# LINE 2245 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 2251 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 41 "./src-ag/ResolveLocals.ag" #-} + _lhsIoptions + {-# LINE 2257 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIsyn + {-# LINE 2263 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 2269 "dist/build/ResolveLocals.hs" #-} + ) + ( _hdIcons,_hdIerrors,_hdIoutput) = + hd_ _hdOallnts _hdOinh _hdOinhMap _hdOmergeMap _hdOnt _hdOoptions _hdOsyn _hdOsynMap + ( _tlIcons,_tlIerrors,_tlIoutput) = + tl_ _tlOallnts _tlOinh _tlOinhMap _tlOmergeMap _tlOnt _tlOoptions _tlOsyn _tlOsynMap + in ( _lhsOcons,_lhsOerrors,_lhsOoutput)))) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (\ _lhsIallnts + _lhsIinh + _lhsIinhMap + _lhsImergeMap + _lhsInt + _lhsIoptions + _lhsIsyn + _lhsIsynMap -> + (let _lhsOcons :: ([ConstructorIdent]) + _lhsOerrors :: (Seq Error) + _lhsOoutput :: Productions + -- use rule "./src-ag/ResolveLocals.ag"(line 65, column 40) + _lhsOcons = + ({-# LINE 65 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 2293 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + Seq.empty + {-# LINE 2299 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 2305 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 2311 "dist/build/ResolveLocals.hs" #-} + ) + in ( _lhsOcons,_lhsOerrors,_lhsOoutput)))) +-- Rule -------------------------------------------------------- +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,ChildKind)] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + inh : Attributes + mergeMap : Map Identifier (Identifier,[Identifier]) + nt : Identifier + options : Options + syn : Attributes + synthesized attributes: + errors : Seq Error + instVars : [Identifier] + locVars : [Identifier] + output : Rule + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + child pure : {Bool} + child identity : {Bool} + child mbError : {Maybe Error} + child eager : {Bool} + visit 0: + local output : _ +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit _pure _identity _mbError _eager) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin _explicit _pure _identity _mbError _eager) +-- semantic domain +newtype T_Rule = T_Rule (([(Identifier,Type,ChildKind)]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + Attributes -> + (Map Identifier (Identifier,[Identifier])) -> + Identifier -> + Options -> + Attributes -> + ( (Seq Error),([Identifier]),([Identifier]),Rule)) +data Inh_Rule = Inh_Rule {allfields_Inh_Rule :: ([(Identifier,Type,ChildKind)]),allnts_Inh_Rule :: ([Identifier]),attrs_Inh_Rule :: ([(Identifier,Identifier)]),con_Inh_Rule :: Identifier,inh_Inh_Rule :: Attributes,mergeMap_Inh_Rule :: (Map Identifier (Identifier,[Identifier])),nt_Inh_Rule :: Identifier,options_Inh_Rule :: Options,syn_Inh_Rule :: Attributes} +data Syn_Rule = Syn_Rule {errors_Syn_Rule :: (Seq Error),instVars_Syn_Rule :: ([Identifier]),locVars_Syn_Rule :: ([Identifier]),output_Syn_Rule :: Rule} +wrap_Rule :: T_Rule -> + Inh_Rule -> + Syn_Rule +wrap_Rule (T_Rule sem) (Inh_Rule _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn) = + (let ( _lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn + in (Syn_Rule _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput)) +sem_Rule_Rule :: (Maybe Identifier) -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + Bool -> + Bool -> + (Maybe Error) -> + Bool -> + T_Rule +sem_Rule_Rule mbName_ (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ = + (T_Rule (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIinh + _lhsImergeMap + _lhsInt + _lhsIoptions + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOoutput :: Rule + _patternOcon :: Identifier + _patternOinh :: Attributes + _patternOnt :: Identifier + _patternOsyn :: Attributes + _rhsOallfields :: ([(Identifier,Type,ChildKind)]) + _rhsOallnts :: ([Identifier]) + _rhsOattrs :: ([(Identifier,Identifier)]) + _rhsOcon :: Identifier + _rhsOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _rhsOnt :: Identifier + _rhsOoptions :: Options + _patternIcopy :: Pattern + _patternIerrors :: (Seq Error) + _patternIinstVars :: ([Identifier]) + _patternIlocVars :: ([Identifier]) + _patternIoutput :: Pattern + _rhsIerrors :: (Seq Error) + _rhsIoutput :: Expression + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + _patternIerrors Seq.>< _rhsIerrors + {-# LINE 2418 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 86) + _lhsOinstVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + _patternIinstVars + {-# LINE 2424 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 48) + _lhsOlocVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + _patternIlocVars + {-# LINE 2430 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + Rule mbName_ _patternIoutput _rhsIoutput owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ + {-# LINE 2436 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 2442 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patternOcon = + ({-# LINE 105 "./src-ag/ResolveLocals.ag" #-} + _lhsIcon + {-# LINE 2448 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patternOinh = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIinh + {-# LINE 2454 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patternOnt = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 2460 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _patternOsyn = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIsyn + {-# LINE 2466 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _rhsOallfields = + ({-# LINE 139 "./src-ag/ResolveLocals.ag" #-} + _lhsIallfields + {-# LINE 2472 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _rhsOallnts = + ({-# LINE 140 "./src-ag/ResolveLocals.ag" #-} + _lhsIallnts + {-# LINE 2478 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _rhsOattrs = + ({-# LINE 141 "./src-ag/ResolveLocals.ag" #-} + _lhsIattrs + {-# LINE 2484 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _rhsOcon = + ({-# LINE 138 "./src-ag/ResolveLocals.ag" #-} + _lhsIcon + {-# LINE 2490 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _rhsOmergeMap = + ({-# LINE 131 "./src-ag/ResolveLocals.ag" #-} + _lhsImergeMap + {-# LINE 2496 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _rhsOnt = + ({-# LINE 138 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 2502 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _rhsOoptions = + ({-# LINE 41 "./src-ag/ResolveLocals.ag" #-} + _lhsIoptions + {-# LINE 2508 "dist/build/ResolveLocals.hs" #-} + ) + ( _patternIcopy,_patternIerrors,_patternIinstVars,_patternIlocVars,_patternIoutput) = + pattern_ _patternOcon _patternOinh _patternOnt _patternOsyn + ( _rhsIerrors,_rhsIoutput) = + rhs_ _rhsOallfields _rhsOallnts _rhsOattrs _rhsOcon _rhsOmergeMap _rhsOnt _rhsOoptions + in ( _lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput)))) +-- Rules ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,ChildKind)] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + inh : Attributes + mergeMap : Map Identifier (Identifier,[Identifier]) + nt : Identifier + options : Options + syn : Attributes + synthesized attributes: + errors : Seq Error + instVars : [Identifier] + locVars : [Identifier] + output : Rules + 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,Type,ChildKind)]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + Attributes -> + (Map Identifier (Identifier,[Identifier])) -> + Identifier -> + Options -> + Attributes -> + ( (Seq Error),([Identifier]),([Identifier]),Rules)) +data Inh_Rules = Inh_Rules {allfields_Inh_Rules :: ([(Identifier,Type,ChildKind)]),allnts_Inh_Rules :: ([Identifier]),attrs_Inh_Rules :: ([(Identifier,Identifier)]),con_Inh_Rules :: Identifier,inh_Inh_Rules :: Attributes,mergeMap_Inh_Rules :: (Map Identifier (Identifier,[Identifier])),nt_Inh_Rules :: Identifier,options_Inh_Rules :: Options,syn_Inh_Rules :: Attributes} +data Syn_Rules = Syn_Rules {errors_Syn_Rules :: (Seq Error),instVars_Syn_Rules :: ([Identifier]),locVars_Syn_Rules :: ([Identifier]),output_Syn_Rules :: Rules} +wrap_Rules :: T_Rules -> + Inh_Rules -> + Syn_Rules +wrap_Rules (T_Rules sem) (Inh_Rules _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn) = + (let ( _lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn + in (Syn_Rules _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput)) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) = + (T_Rules (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIinh + _lhsImergeMap + _lhsInt + _lhsIoptions + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOoutput :: Rules + _hdOallfields :: ([(Identifier,Type,ChildKind)]) + _hdOallnts :: ([Identifier]) + _hdOattrs :: ([(Identifier,Identifier)]) + _hdOcon :: Identifier + _hdOinh :: Attributes + _hdOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _hdOnt :: Identifier + _hdOoptions :: Options + _hdOsyn :: Attributes + _tlOallfields :: ([(Identifier,Type,ChildKind)]) + _tlOallnts :: ([Identifier]) + _tlOattrs :: ([(Identifier,Identifier)]) + _tlOcon :: Identifier + _tlOinh :: Attributes + _tlOmergeMap :: (Map Identifier (Identifier,[Identifier])) + _tlOnt :: Identifier + _tlOoptions :: Options + _tlOsyn :: Attributes + _hdIerrors :: (Seq Error) + _hdIinstVars :: ([Identifier]) + _hdIlocVars :: ([Identifier]) + _hdIoutput :: Rule + _tlIerrors :: (Seq Error) + _tlIinstVars :: ([Identifier]) + _tlIlocVars :: ([Identifier]) + _tlIoutput :: Rules + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 2614 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 86) + _lhsOinstVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + _hdIinstVars ++ _tlIinstVars + {-# LINE 2620 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 48) + _lhsOlocVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + _hdIlocVars ++ _tlIlocVars + {-# LINE 2626 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 2632 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 2638 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOallfields = + ({-# LINE 71 "./src-ag/ResolveLocals.ag" #-} + _lhsIallfields + {-# LINE 2644 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOallnts = + ({-# LINE 57 "./src-ag/ResolveLocals.ag" #-} + _lhsIallnts + {-# LINE 2650 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOattrs = + ({-# LINE 71 "./src-ag/ResolveLocals.ag" #-} + _lhsIattrs + {-# LINE 2656 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 105 "./src-ag/ResolveLocals.ag" #-} + _lhsIcon + {-# LINE 2662 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOinh = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIinh + {-# LINE 2668 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOmergeMap = + ({-# LINE 131 "./src-ag/ResolveLocals.ag" #-} + _lhsImergeMap + {-# LINE 2674 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 2680 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 41 "./src-ag/ResolveLocals.ag" #-} + _lhsIoptions + {-# LINE 2686 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _hdOsyn = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIsyn + {-# LINE 2692 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOallfields = + ({-# LINE 71 "./src-ag/ResolveLocals.ag" #-} + _lhsIallfields + {-# LINE 2698 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOallnts = + ({-# LINE 57 "./src-ag/ResolveLocals.ag" #-} + _lhsIallnts + {-# LINE 2704 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOattrs = + ({-# LINE 71 "./src-ag/ResolveLocals.ag" #-} + _lhsIattrs + {-# LINE 2710 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 105 "./src-ag/ResolveLocals.ag" #-} + _lhsIcon + {-# LINE 2716 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOinh = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIinh + {-# LINE 2722 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOmergeMap = + ({-# LINE 131 "./src-ag/ResolveLocals.ag" #-} + _lhsImergeMap + {-# LINE 2728 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsInt + {-# LINE 2734 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 41 "./src-ag/ResolveLocals.ag" #-} + _lhsIoptions + {-# LINE 2740 "dist/build/ResolveLocals.hs" #-} + ) + -- copy rule (down) + _tlOsyn = + ({-# LINE 104 "./src-ag/ResolveLocals.ag" #-} + _lhsIsyn + {-# LINE 2746 "dist/build/ResolveLocals.hs" #-} + ) + ( _hdIerrors,_hdIinstVars,_hdIlocVars,_hdIoutput) = + hd_ _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOinh _hdOmergeMap _hdOnt _hdOoptions _hdOsyn + ( _tlIerrors,_tlIinstVars,_tlIlocVars,_tlIoutput) = + tl_ _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOinh _tlOmergeMap _tlOnt _tlOoptions _tlOsyn + in ( _lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput)))) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIinh + _lhsImergeMap + _lhsInt + _lhsIoptions + _lhsIsyn -> + (let _lhsOerrors :: (Seq Error) + _lhsOinstVars :: ([Identifier]) + _lhsOlocVars :: ([Identifier]) + _lhsOoutput :: Rules + -- use rule "./src-ag/ResolveLocals.ag"(line 44, column 16) + _lhsOerrors = + ({-# LINE 44 "./src-ag/ResolveLocals.ag" #-} + Seq.empty + {-# LINE 2772 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 86) + _lhsOinstVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 2778 "dist/build/ResolveLocals.hs" #-} + ) + -- use rule "./src-ag/ResolveLocals.ag"(line 93, column 48) + _lhsOlocVars = + ({-# LINE 93 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 2784 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 2790 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 2796 "dist/build/ResolveLocals.hs" #-} + ) + in ( _lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput)))) +-- TypeSig ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + output : TypeSig + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} + visit 0: + local output : _ +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig (TypeSig _name _tp) = + (sem_TypeSig_TypeSig _name _tp) +-- semantic domain +newtype T_TypeSig = T_TypeSig (( TypeSig)) +data Inh_TypeSig = Inh_TypeSig {} +data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: TypeSig} +wrap_TypeSig :: T_TypeSig -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig) = + (let ( _lhsOoutput) = sem + in (Syn_TypeSig _lhsOoutput)) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig name_ tp_ = + (T_TypeSig (let _lhsOoutput :: TypeSig + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + TypeSig name_ tp_ + {-# LINE 2835 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 2841 "dist/build/ResolveLocals.hs" #-} + ) + in ( _lhsOoutput))) +-- TypeSigs ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + output : TypeSigs + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- cata +sem_TypeSigs :: TypeSigs -> + T_TypeSigs +sem_TypeSigs list = + (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list)) +-- semantic domain +newtype T_TypeSigs = T_TypeSigs (( TypeSigs)) +data Inh_TypeSigs = Inh_TypeSigs {} +data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: TypeSigs} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs) = + (let ( _lhsOoutput) = sem + in (Syn_TypeSigs _lhsOoutput)) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons (T_TypeSig hd_) (T_TypeSigs tl_) = + (T_TypeSigs (let _lhsOoutput :: TypeSigs + _hdIoutput :: TypeSig + _tlIoutput :: TypeSigs + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 2885 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 2891 "dist/build/ResolveLocals.hs" #-} + ) + ( _hdIoutput) = + hd_ + ( _tlIoutput) = + tl_ + in ( _lhsOoutput))) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (let _lhsOoutput :: TypeSigs + -- self rule + _output = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + [] + {-# LINE 2905 "dist/build/ResolveLocals.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 47 "./src-ag/ResolveLocals.ag" #-} + _output + {-# LINE 2911 "dist/build/ResolveLocals.hs" #-} + ) + in ( _lhsOoutput))) diff --git a/dist/build/SemHsTokens.hs b/dist/build/SemHsTokens.hs new file mode 100644 --- /dev/null +++ b/dist/build/SemHsTokens.hs @@ -0,0 +1,909 @@ + + +-- UUAGC 0.9.42.0 (src-ag/SemHsTokens.ag) +module SemHsTokens where +{-# LINE 4 "./src-ag/SemHsTokens.ag" #-} + +import qualified Data.Sequence as Seq +import Data.Sequence(Seq,empty,singleton,(><)) +import Data.Foldable(toList) +import Pretty + +import TokenDef +import HsToken +import ErrorMessages +{-# LINE 16 "dist/build/SemHsTokens.hs" #-} + +{-# LINE 2 "./src-ag/HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 22 "dist/build/SemHsTokens.hs" #-} +{-# LINE 57 "./src-ag/SemHsTokens.ag" #-} + +isNTname allnts (Just (NT nt _ _)) = nt `elem` allnts +isNTname allnts _ = False +{-# LINE 27 "dist/build/SemHsTokens.hs" #-} +-- HsToken ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,ChildKind)] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + fieldnames : [Identifier] + nt : Identifier + synthesized attributes: + errors : Seq Error + output : HsToken + tok : (Pos,String) + usedAttrs : [(Identifier,Identifier)] + usedFields : Seq Identifier + usedLocals : [Identifier] + alternatives: + alternative AGLocal: + child var : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local tkAsLocal : _ + local tkAsField : _ + local errors : _ + local output : _ + local tok : _ + local usedLocals : _ + alternative AGField: + child field : {Identifier} + child attr : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local addTrace : _ + local output : _ + alternative HsToken: + child value : {String} + child pos : {Pos} + visit 0: + local output : _ + alternative CharToken: + child value : {String} + child pos : {Pos} + visit 0: + local output : _ + alternative StrToken: + child value : {String} + child pos : {Pos} + visit 0: + local output : _ + alternative Err: + child mesg : {String} + child pos : {Pos} + visit 0: + local output : _ +-} +-- cata +sem_HsToken :: HsToken -> + T_HsToken +sem_HsToken (AGLocal _var _pos _rdesc) = + (sem_HsToken_AGLocal _var _pos _rdesc) +sem_HsToken (AGField _field _attr _pos _rdesc) = + (sem_HsToken_AGField _field _attr _pos _rdesc) +sem_HsToken (HsToken _value _pos) = + (sem_HsToken_HsToken _value _pos) +sem_HsToken (CharToken _value _pos) = + (sem_HsToken_CharToken _value _pos) +sem_HsToken (StrToken _value _pos) = + (sem_HsToken_StrToken _value _pos) +sem_HsToken (Err _mesg _pos) = + (sem_HsToken_Err _mesg _pos) +-- semantic domain +newtype T_HsToken = T_HsToken (([(Identifier,Type,ChildKind)]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + ([Identifier]) -> + Identifier -> + ( (Seq Error),HsToken,((Pos,String)),([(Identifier,Identifier)]),(Seq Identifier),([Identifier]))) +data Inh_HsToken = Inh_HsToken {allfields_Inh_HsToken :: ([(Identifier,Type,ChildKind)]),allnts_Inh_HsToken :: ([Identifier]),attrs_Inh_HsToken :: ([(Identifier,Identifier)]),con_Inh_HsToken :: Identifier,fieldnames_Inh_HsToken :: ([Identifier]),nt_Inh_HsToken :: Identifier} +data Syn_HsToken = Syn_HsToken {errors_Syn_HsToken :: (Seq Error),output_Syn_HsToken :: HsToken,tok_Syn_HsToken :: ((Pos,String)),usedAttrs_Syn_HsToken :: ([(Identifier,Identifier)]),usedFields_Syn_HsToken :: (Seq Identifier),usedLocals_Syn_HsToken :: ([Identifier])} +wrap_HsToken :: T_HsToken -> + Inh_HsToken -> + Syn_HsToken +wrap_HsToken (T_HsToken sem) (Inh_HsToken _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt) = + (let ( _lhsOerrors,_lhsOoutput,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt + in (Syn_HsToken _lhsOerrors _lhsOoutput _lhsOtok _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals)) +sem_HsToken_AGLocal :: Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGLocal var_ pos_ rdesc_ = + (T_HsToken (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOusedFields :: (Seq Identifier) + _lhsOerrors :: (Seq Error) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedLocals :: ([Identifier]) + _lhsOoutput :: HsToken + _lhsOtok :: ((Pos,String)) + -- "./src-ag/SemHsTokens.ag"(line 65, column 15) + _tkAsLocal = + ({-# LINE 65 "./src-ag/SemHsTokens.ag" #-} + AGLocal var_ pos_ rdesc_ + {-# LINE 138 "dist/build/SemHsTokens.hs" #-} + ) + -- "./src-ag/SemHsTokens.ag"(line 66, column 15) + _tkAsField = + ({-# LINE 66 "./src-ag/SemHsTokens.ag" #-} + AGField _LOC var_ pos_ rdesc_ + {-# LINE 144 "dist/build/SemHsTokens.hs" #-} + ) + -- "./src-ag/SemHsTokens.ag"(line 67, column 19) + (_errors,_output,_tok,_usedLocals) = + ({-# LINE 67 "./src-ag/SemHsTokens.ag" #-} + if var_ `elem` _lhsIfieldnames + then if isNTname _lhsIallnts (lookup var_ (map (\(n,t,_) -> (n,t)) _lhsIallfields)) + then (Seq.singleton(ChildAsLocal _lhsInt _lhsIcon var_), _tkAsLocal ,(pos_,fieldname var_), [] ) + else (Seq.empty, _tkAsLocal , (pos_,fieldname var_), [] ) + else if (_LOC,var_) `elem` _lhsIattrs + then (Seq.empty , _tkAsField , (pos_,locname var_), [var_]) + else (Seq.singleton(UndefLocal _lhsInt _lhsIcon var_), _tkAsField , (pos_,locname var_), [] ) + {-# LINE 156 "dist/build/SemHsTokens.hs" #-} + ) + -- "./src-ag/SemHsTokens.ag"(line 103, column 13) + _lhsOusedFields = + ({-# LINE 103 "./src-ag/SemHsTokens.ag" #-} + if var_ `elem` _lhsIfieldnames + then Seq.singleton var_ + else Seq.empty + {-# LINE 164 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 43, column 37) + _lhsOerrors = + ({-# LINE 43 "./src-ag/SemHsTokens.ag" #-} + _errors + {-# LINE 170 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 88, column 40) + _lhsOusedAttrs = + ({-# LINE 88 "./src-ag/SemHsTokens.ag" #-} + [] + {-# LINE 176 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 87, column 40) + _lhsOusedLocals = + ({-# LINE 87 "./src-ag/SemHsTokens.ag" #-} + _usedLocals + {-# LINE 182 "dist/build/SemHsTokens.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 142 "./src-ag/SemHsTokens.ag" #-} + _output + {-# LINE 188 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (from local) + _lhsOtok = + ({-# LINE 120 "./src-ag/SemHsTokens.ag" #-} + _tok + {-# LINE 194 "dist/build/SemHsTokens.hs" #-} + ) + in ( _lhsOerrors,_lhsOoutput,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals)))) +sem_HsToken_AGField :: Identifier -> + Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGField field_ attr_ pos_ rdesc_ = + (T_HsToken (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOerrors :: (Seq Error) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedLocals :: ([Identifier]) + _lhsOtok :: ((Pos,String)) + _lhsOusedFields :: (Seq Identifier) + _lhsOoutput :: HsToken + -- "./src-ag/SemHsTokens.ag"(line 77, column 15) + _lhsOerrors = + ({-# LINE 77 "./src-ag/SemHsTokens.ag" #-} + if (field_,attr_) `elem` _lhsIattrs + then Seq.empty + else if not(field_ `elem` (_LHS : _LOC: _lhsIfieldnames)) + then Seq.singleton (UndefChild _lhsInt _lhsIcon field_) + else Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ attr_ False) + {-# LINE 223 "dist/build/SemHsTokens.hs" #-} + ) + -- "./src-ag/SemHsTokens.ag"(line 91, column 13) + (_lhsOusedAttrs,_lhsOusedLocals) = + ({-# LINE 91 "./src-ag/SemHsTokens.ag" #-} + if field_ == _LOC + then ([], [attr_]) + else ([(field_,attr_)], []) + {-# LINE 231 "dist/build/SemHsTokens.hs" #-} + ) + -- "./src-ag/SemHsTokens.ag"(line 122, column 8) + _addTrace = + ({-# LINE 122 "./src-ag/SemHsTokens.ag" #-} + case rdesc_ of + Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))" + Nothing -> id + {-# LINE 239 "dist/build/SemHsTokens.hs" #-} + ) + -- "./src-ag/SemHsTokens.ag"(line 125, column 8) + _lhsOtok = + ({-# LINE 125 "./src-ag/SemHsTokens.ag" #-} + (pos_, _addTrace $ attrname True field_ attr_) + {-# LINE 245 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 100, column 40) + _lhsOusedFields = + ({-# LINE 100 "./src-ag/SemHsTokens.ag" #-} + Seq.empty + {-# LINE 251 "dist/build/SemHsTokens.hs" #-} + ) + -- self rule + _output = + ({-# LINE 142 "./src-ag/SemHsTokens.ag" #-} + AGField field_ attr_ pos_ rdesc_ + {-# LINE 257 "dist/build/SemHsTokens.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 142 "./src-ag/SemHsTokens.ag" #-} + _output + {-# LINE 263 "dist/build/SemHsTokens.hs" #-} + ) + in ( _lhsOerrors,_lhsOoutput,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals)))) +sem_HsToken_HsToken :: String -> + Pos -> + T_HsToken +sem_HsToken_HsToken value_ pos_ = + (T_HsToken (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOtok :: ((Pos,String)) + _lhsOerrors :: (Seq Error) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedFields :: (Seq Identifier) + _lhsOusedLocals :: ([Identifier]) + _lhsOoutput :: HsToken + -- "./src-ag/SemHsTokens.ag"(line 127, column 14) + _lhsOtok = + ({-# LINE 127 "./src-ag/SemHsTokens.ag" #-} + (pos_, value_) + {-# LINE 286 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 43, column 37) + _lhsOerrors = + ({-# LINE 43 "./src-ag/SemHsTokens.ag" #-} + Seq.empty + {-# LINE 292 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 88, column 40) + _lhsOusedAttrs = + ({-# LINE 88 "./src-ag/SemHsTokens.ag" #-} + [] + {-# LINE 298 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 100, column 40) + _lhsOusedFields = + ({-# LINE 100 "./src-ag/SemHsTokens.ag" #-} + Seq.empty + {-# LINE 304 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 87, column 40) + _lhsOusedLocals = + ({-# LINE 87 "./src-ag/SemHsTokens.ag" #-} + [] + {-# LINE 310 "dist/build/SemHsTokens.hs" #-} + ) + -- self rule + _output = + ({-# LINE 142 "./src-ag/SemHsTokens.ag" #-} + HsToken value_ pos_ + {-# LINE 316 "dist/build/SemHsTokens.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 142 "./src-ag/SemHsTokens.ag" #-} + _output + {-# LINE 322 "dist/build/SemHsTokens.hs" #-} + ) + in ( _lhsOerrors,_lhsOoutput,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals)))) +sem_HsToken_CharToken :: String -> + Pos -> + T_HsToken +sem_HsToken_CharToken value_ pos_ = + (T_HsToken (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOtok :: ((Pos,String)) + _lhsOerrors :: (Seq Error) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedFields :: (Seq Identifier) + _lhsOusedLocals :: ([Identifier]) + _lhsOoutput :: HsToken + -- "./src-ag/SemHsTokens.ag"(line 129, column 16) + _lhsOtok = + ({-# LINE 129 "./src-ag/SemHsTokens.ag" #-} + (pos_, if null value_ + then "" + else showCharShort (head value_) + ) + {-# LINE 348 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 43, column 37) + _lhsOerrors = + ({-# LINE 43 "./src-ag/SemHsTokens.ag" #-} + Seq.empty + {-# LINE 354 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 88, column 40) + _lhsOusedAttrs = + ({-# LINE 88 "./src-ag/SemHsTokens.ag" #-} + [] + {-# LINE 360 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 100, column 40) + _lhsOusedFields = + ({-# LINE 100 "./src-ag/SemHsTokens.ag" #-} + Seq.empty + {-# LINE 366 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 87, column 40) + _lhsOusedLocals = + ({-# LINE 87 "./src-ag/SemHsTokens.ag" #-} + [] + {-# LINE 372 "dist/build/SemHsTokens.hs" #-} + ) + -- self rule + _output = + ({-# LINE 142 "./src-ag/SemHsTokens.ag" #-} + CharToken value_ pos_ + {-# LINE 378 "dist/build/SemHsTokens.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 142 "./src-ag/SemHsTokens.ag" #-} + _output + {-# LINE 384 "dist/build/SemHsTokens.hs" #-} + ) + in ( _lhsOerrors,_lhsOoutput,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals)))) +sem_HsToken_StrToken :: String -> + Pos -> + T_HsToken +sem_HsToken_StrToken value_ pos_ = + (T_HsToken (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOtok :: ((Pos,String)) + _lhsOerrors :: (Seq Error) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedFields :: (Seq Identifier) + _lhsOusedLocals :: ([Identifier]) + _lhsOoutput :: HsToken + -- "./src-ag/SemHsTokens.ag"(line 134, column 16) + _lhsOtok = + ({-# LINE 134 "./src-ag/SemHsTokens.ag" #-} + (pos_, showStrShort value_) + {-# LINE 407 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 43, column 37) + _lhsOerrors = + ({-# LINE 43 "./src-ag/SemHsTokens.ag" #-} + Seq.empty + {-# LINE 413 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 88, column 40) + _lhsOusedAttrs = + ({-# LINE 88 "./src-ag/SemHsTokens.ag" #-} + [] + {-# LINE 419 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 100, column 40) + _lhsOusedFields = + ({-# LINE 100 "./src-ag/SemHsTokens.ag" #-} + Seq.empty + {-# LINE 425 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 87, column 40) + _lhsOusedLocals = + ({-# LINE 87 "./src-ag/SemHsTokens.ag" #-} + [] + {-# LINE 431 "dist/build/SemHsTokens.hs" #-} + ) + -- self rule + _output = + ({-# LINE 142 "./src-ag/SemHsTokens.ag" #-} + StrToken value_ pos_ + {-# LINE 437 "dist/build/SemHsTokens.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 142 "./src-ag/SemHsTokens.ag" #-} + _output + {-# LINE 443 "dist/build/SemHsTokens.hs" #-} + ) + in ( _lhsOerrors,_lhsOoutput,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals)))) +sem_HsToken_Err :: String -> + Pos -> + T_HsToken +sem_HsToken_Err mesg_ pos_ = + (T_HsToken (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOerrors :: (Seq Error) + _lhsOtok :: ((Pos,String)) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedFields :: (Seq Identifier) + _lhsOusedLocals :: ([Identifier]) + _lhsOoutput :: HsToken + -- "./src-ag/SemHsTokens.ag"(line 50, column 9) + _lhsOerrors = + ({-# LINE 50 "./src-ag/SemHsTokens.ag" #-} + let m = text mesg_ + in Seq.singleton (CustomError False pos_ m) + {-# LINE 467 "dist/build/SemHsTokens.hs" #-} + ) + -- "./src-ag/SemHsTokens.ag"(line 135, column 16) + _lhsOtok = + ({-# LINE 135 "./src-ag/SemHsTokens.ag" #-} + (pos_, "") + {-# LINE 473 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 88, column 40) + _lhsOusedAttrs = + ({-# LINE 88 "./src-ag/SemHsTokens.ag" #-} + [] + {-# LINE 479 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 100, column 40) + _lhsOusedFields = + ({-# LINE 100 "./src-ag/SemHsTokens.ag" #-} + Seq.empty + {-# LINE 485 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 87, column 40) + _lhsOusedLocals = + ({-# LINE 87 "./src-ag/SemHsTokens.ag" #-} + [] + {-# LINE 491 "dist/build/SemHsTokens.hs" #-} + ) + -- self rule + _output = + ({-# LINE 142 "./src-ag/SemHsTokens.ag" #-} + Err mesg_ pos_ + {-# LINE 497 "dist/build/SemHsTokens.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 142 "./src-ag/SemHsTokens.ag" #-} + _output + {-# LINE 503 "dist/build/SemHsTokens.hs" #-} + ) + in ( _lhsOerrors,_lhsOoutput,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals)))) +-- HsTokens ---------------------------------------------------- +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,ChildKind)] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + fieldnames : [Identifier] + nt : Identifier + synthesized attributes: + errors : Seq Error + output : HsTokens + tks : [(Pos,String)] + usedAttrs : [(Identifier,Identifier)] + usedFields : Seq Identifier + usedLocals : [Identifier] + alternatives: + alternative Cons: + child hd : HsToken + child tl : HsTokens + visit 0: + local output : _ + alternative Nil: + visit 0: + local output : _ +-} +-- 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 (([(Identifier,Type,ChildKind)]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + ([Identifier]) -> + Identifier -> + ( (Seq Error),HsTokens,([(Pos,String)]),([(Identifier,Identifier)]),(Seq Identifier),([Identifier]))) +data Inh_HsTokens = Inh_HsTokens {allfields_Inh_HsTokens :: ([(Identifier,Type,ChildKind)]),allnts_Inh_HsTokens :: ([Identifier]),attrs_Inh_HsTokens :: ([(Identifier,Identifier)]),con_Inh_HsTokens :: Identifier,fieldnames_Inh_HsTokens :: ([Identifier]),nt_Inh_HsTokens :: Identifier} +data Syn_HsTokens = Syn_HsTokens {errors_Syn_HsTokens :: (Seq Error),output_Syn_HsTokens :: HsTokens,tks_Syn_HsTokens :: ([(Pos,String)]),usedAttrs_Syn_HsTokens :: ([(Identifier,Identifier)]),usedFields_Syn_HsTokens :: (Seq Identifier),usedLocals_Syn_HsTokens :: ([Identifier])} +wrap_HsTokens :: T_HsTokens -> + Inh_HsTokens -> + Syn_HsTokens +wrap_HsTokens (T_HsTokens sem) (Inh_HsTokens _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt) = + (let ( _lhsOerrors,_lhsOoutput,_lhsOtks,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt + in (Syn_HsTokens _lhsOerrors _lhsOoutput _lhsOtks _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals)) +sem_HsTokens_Cons :: T_HsToken -> + T_HsTokens -> + T_HsTokens +sem_HsTokens_Cons (T_HsToken hd_) (T_HsTokens tl_) = + (T_HsTokens (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOtks :: ([(Pos,String)]) + _lhsOerrors :: (Seq Error) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedFields :: (Seq Identifier) + _lhsOusedLocals :: ([Identifier]) + _lhsOoutput :: HsTokens + _hdOallfields :: ([(Identifier,Type,ChildKind)]) + _hdOallnts :: ([Identifier]) + _hdOattrs :: ([(Identifier,Identifier)]) + _hdOcon :: Identifier + _hdOfieldnames :: ([Identifier]) + _hdOnt :: Identifier + _tlOallfields :: ([(Identifier,Type,ChildKind)]) + _tlOallnts :: ([Identifier]) + _tlOattrs :: ([(Identifier,Identifier)]) + _tlOcon :: Identifier + _tlOfieldnames :: ([Identifier]) + _tlOnt :: Identifier + _hdIerrors :: (Seq Error) + _hdIoutput :: HsToken + _hdItok :: ((Pos,String)) + _hdIusedAttrs :: ([(Identifier,Identifier)]) + _hdIusedFields :: (Seq Identifier) + _hdIusedLocals :: ([Identifier]) + _tlIerrors :: (Seq Error) + _tlIoutput :: HsTokens + _tlItks :: ([(Pos,String)]) + _tlIusedAttrs :: ([(Identifier,Identifier)]) + _tlIusedFields :: (Seq Identifier) + _tlIusedLocals :: ([Identifier]) + -- "./src-ag/SemHsTokens.ag"(line 117, column 10) + _lhsOtks = + ({-# LINE 117 "./src-ag/SemHsTokens.ag" #-} + _hdItok : _tlItks + {-# LINE 598 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 43, column 37) + _lhsOerrors = + ({-# LINE 43 "./src-ag/SemHsTokens.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 604 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 88, column 40) + _lhsOusedAttrs = + ({-# LINE 88 "./src-ag/SemHsTokens.ag" #-} + _hdIusedAttrs ++ _tlIusedAttrs + {-# LINE 610 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 100, column 40) + _lhsOusedFields = + ({-# LINE 100 "./src-ag/SemHsTokens.ag" #-} + _hdIusedFields Seq.>< _tlIusedFields + {-# LINE 616 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 87, column 40) + _lhsOusedLocals = + ({-# LINE 87 "./src-ag/SemHsTokens.ag" #-} + _hdIusedLocals ++ _tlIusedLocals + {-# LINE 622 "dist/build/SemHsTokens.hs" #-} + ) + -- self rule + _output = + ({-# LINE 142 "./src-ag/SemHsTokens.ag" #-} + (:) _hdIoutput _tlIoutput + {-# LINE 628 "dist/build/SemHsTokens.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 142 "./src-ag/SemHsTokens.ag" #-} + _output + {-# LINE 634 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _hdOallfields = + ({-# LINE 30 "./src-ag/SemHsTokens.ag" #-} + _lhsIallfields + {-# LINE 640 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _hdOallnts = + ({-# LINE 31 "./src-ag/SemHsTokens.ag" #-} + _lhsIallnts + {-# LINE 646 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _hdOattrs = + ({-# LINE 32 "./src-ag/SemHsTokens.ag" #-} + _lhsIattrs + {-# LINE 652 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _hdOcon = + ({-# LINE 29 "./src-ag/SemHsTokens.ag" #-} + _lhsIcon + {-# LINE 658 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _hdOfieldnames = + ({-# LINE 36 "./src-ag/SemHsTokens.ag" #-} + _lhsIfieldnames + {-# LINE 664 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 29 "./src-ag/SemHsTokens.ag" #-} + _lhsInt + {-# LINE 670 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tlOallfields = + ({-# LINE 30 "./src-ag/SemHsTokens.ag" #-} + _lhsIallfields + {-# LINE 676 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tlOallnts = + ({-# LINE 31 "./src-ag/SemHsTokens.ag" #-} + _lhsIallnts + {-# LINE 682 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tlOattrs = + ({-# LINE 32 "./src-ag/SemHsTokens.ag" #-} + _lhsIattrs + {-# LINE 688 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tlOcon = + ({-# LINE 29 "./src-ag/SemHsTokens.ag" #-} + _lhsIcon + {-# LINE 694 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tlOfieldnames = + ({-# LINE 36 "./src-ag/SemHsTokens.ag" #-} + _lhsIfieldnames + {-# LINE 700 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 29 "./src-ag/SemHsTokens.ag" #-} + _lhsInt + {-# LINE 706 "dist/build/SemHsTokens.hs" #-} + ) + ( _hdIerrors,_hdIoutput,_hdItok,_hdIusedAttrs,_hdIusedFields,_hdIusedLocals) = + hd_ _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOfieldnames _hdOnt + ( _tlIerrors,_tlIoutput,_tlItks,_tlIusedAttrs,_tlIusedFields,_tlIusedLocals) = + tl_ _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOfieldnames _tlOnt + in ( _lhsOerrors,_lhsOoutput,_lhsOtks,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals)))) +sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil = + (T_HsTokens (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsIfieldnames + _lhsInt -> + (let _lhsOtks :: ([(Pos,String)]) + _lhsOerrors :: (Seq Error) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedFields :: (Seq Identifier) + _lhsOusedLocals :: ([Identifier]) + _lhsOoutput :: HsTokens + -- "./src-ag/SemHsTokens.ag"(line 118, column 10) + _lhsOtks = + ({-# LINE 118 "./src-ag/SemHsTokens.ag" #-} + [] + {-# LINE 731 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 43, column 37) + _lhsOerrors = + ({-# LINE 43 "./src-ag/SemHsTokens.ag" #-} + Seq.empty + {-# LINE 737 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 88, column 40) + _lhsOusedAttrs = + ({-# LINE 88 "./src-ag/SemHsTokens.ag" #-} + [] + {-# LINE 743 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 100, column 40) + _lhsOusedFields = + ({-# LINE 100 "./src-ag/SemHsTokens.ag" #-} + Seq.empty + {-# LINE 749 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 87, column 40) + _lhsOusedLocals = + ({-# LINE 87 "./src-ag/SemHsTokens.ag" #-} + [] + {-# LINE 755 "dist/build/SemHsTokens.hs" #-} + ) + -- self rule + _output = + ({-# LINE 142 "./src-ag/SemHsTokens.ag" #-} + [] + {-# LINE 761 "dist/build/SemHsTokens.hs" #-} + ) + -- self rule + _lhsOoutput = + ({-# LINE 142 "./src-ag/SemHsTokens.ag" #-} + _output + {-# LINE 767 "dist/build/SemHsTokens.hs" #-} + ) + in ( _lhsOerrors,_lhsOoutput,_lhsOtks,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals)))) +-- HsTokensRoot ------------------------------------------------ +{- + visit 0: + inherited attributes: + allfields : [(Identifier,Type,ChildKind)] + allnts : [Identifier] + attrs : [(Identifier,Identifier)] + con : Identifier + nt : Identifier + synthesized attributes: + errors : Seq Error + output : [HsToken] + textLines : [String] + usedAttrs : [(Identifier,Identifier)] + usedFields : [Identifier] + usedLocals : [Identifier] + 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,Type,ChildKind)]) -> + ([Identifier]) -> + ([(Identifier,Identifier)]) -> + Identifier -> + Identifier -> + ( (Seq Error),([HsToken]),([String]),([(Identifier,Identifier)]),([Identifier]),([Identifier]))) +data Inh_HsTokensRoot = Inh_HsTokensRoot {allfields_Inh_HsTokensRoot :: ([(Identifier,Type,ChildKind)]),allnts_Inh_HsTokensRoot :: ([Identifier]),attrs_Inh_HsTokensRoot :: ([(Identifier,Identifier)]),con_Inh_HsTokensRoot :: Identifier,nt_Inh_HsTokensRoot :: Identifier} +data Syn_HsTokensRoot = Syn_HsTokensRoot {errors_Syn_HsTokensRoot :: (Seq Error),output_Syn_HsTokensRoot :: ([HsToken]),textLines_Syn_HsTokensRoot :: ([String]),usedAttrs_Syn_HsTokensRoot :: ([(Identifier,Identifier)]),usedFields_Syn_HsTokensRoot :: ([Identifier]),usedLocals_Syn_HsTokensRoot :: ([Identifier])} +wrap_HsTokensRoot :: T_HsTokensRoot -> + Inh_HsTokensRoot -> + Syn_HsTokensRoot +wrap_HsTokensRoot (T_HsTokensRoot sem) (Inh_HsTokensRoot _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt) = + (let ( _lhsOerrors,_lhsOoutput,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt + in (Syn_HsTokensRoot _lhsOerrors _lhsOoutput _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals)) +sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> + T_HsTokensRoot +sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_) = + (T_HsTokensRoot (\ _lhsIallfields + _lhsIallnts + _lhsIattrs + _lhsIcon + _lhsInt -> + (let _tokensOfieldnames :: ([Identifier]) + _lhsOusedFields :: ([Identifier]) + _lhsOtextLines :: ([String]) + _lhsOerrors :: (Seq Error) + _lhsOoutput :: ([HsToken]) + _lhsOusedAttrs :: ([(Identifier,Identifier)]) + _lhsOusedLocals :: ([Identifier]) + _tokensOallfields :: ([(Identifier,Type,ChildKind)]) + _tokensOallnts :: ([Identifier]) + _tokensOattrs :: ([(Identifier,Identifier)]) + _tokensOcon :: Identifier + _tokensOnt :: Identifier + _tokensIerrors :: (Seq Error) + _tokensIoutput :: HsTokens + _tokensItks :: ([(Pos,String)]) + _tokensIusedAttrs :: ([(Identifier,Identifier)]) + _tokensIusedFields :: (Seq Identifier) + _tokensIusedLocals :: ([Identifier]) + -- "./src-ag/SemHsTokens.ag"(line 38, column 18) + _tokensOfieldnames = + ({-# LINE 38 "./src-ag/SemHsTokens.ag" #-} + map (\(n,_,_) -> n) _lhsIallfields + {-# LINE 840 "dist/build/SemHsTokens.hs" #-} + ) + -- "./src-ag/SemHsTokens.ag"(line 107, column 18) + _lhsOusedFields = + ({-# LINE 107 "./src-ag/SemHsTokens.ag" #-} + toList _tokensIusedFields + {-# LINE 846 "dist/build/SemHsTokens.hs" #-} + ) + -- "./src-ag/SemHsTokens.ag"(line 114, column 18) + _lhsOtextLines = + ({-# LINE 114 "./src-ag/SemHsTokens.ag" #-} + showTokens _tokensItks + {-# LINE 852 "dist/build/SemHsTokens.hs" #-} + ) + -- use rule "./src-ag/SemHsTokens.ag"(line 18, column 18) + _lhsOerrors = + ({-# LINE 18 "./src-ag/SemHsTokens.ag" #-} + _tokensIerrors + {-# LINE 858 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (up) + _lhsOoutput = + ({-# LINE 141 "./src-ag/SemHsTokens.ag" #-} + _tokensIoutput + {-# LINE 864 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (up) + _lhsOusedAttrs = + ({-# LINE 20 "./src-ag/SemHsTokens.ag" #-} + _tokensIusedAttrs + {-# LINE 870 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (up) + _lhsOusedLocals = + ({-# LINE 19 "./src-ag/SemHsTokens.ag" #-} + _tokensIusedLocals + {-# LINE 876 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tokensOallfields = + ({-# LINE 30 "./src-ag/SemHsTokens.ag" #-} + _lhsIallfields + {-# LINE 882 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tokensOallnts = + ({-# LINE 31 "./src-ag/SemHsTokens.ag" #-} + _lhsIallnts + {-# LINE 888 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tokensOattrs = + ({-# LINE 32 "./src-ag/SemHsTokens.ag" #-} + _lhsIattrs + {-# LINE 894 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tokensOcon = + ({-# LINE 29 "./src-ag/SemHsTokens.ag" #-} + _lhsIcon + {-# LINE 900 "dist/build/SemHsTokens.hs" #-} + ) + -- copy rule (down) + _tokensOnt = + ({-# LINE 29 "./src-ag/SemHsTokens.ag" #-} + _lhsInt + {-# LINE 906 "dist/build/SemHsTokens.hs" #-} + ) + ( _tokensIerrors,_tokensIoutput,_tokensItks,_tokensIusedAttrs,_tokensIusedFields,_tokensIusedLocals) = + tokens_ _tokensOallfields _tokensOallnts _tokensOattrs _tokensOcon _tokensOfieldnames _tokensOnt + in ( _lhsOerrors,_lhsOoutput,_lhsOtextLines,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals)))) diff --git a/dist/build/TfmToVisage.hs b/dist/build/TfmToVisage.hs new file mode 100644 --- /dev/null +++ b/dist/build/TfmToVisage.hs @@ -0,0 +1,1427 @@ + + +-- UUAGC 0.9.42.0 (src-ag/TfmToVisage.ag) +module TfmToVisage where +{-# LINE 9 "./src-ag/TfmToVisage.ag" #-} + +import AbstractSyntax +import VisagePatterns +import VisageSyntax +import qualified Data.Map as Map +import Data.Map (Map) +{-# LINE 13 "dist/build/TfmToVisage.hs" #-} + +{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import Macro --marcos +import CommonTypes +import ErrorMessages +{-# LINE 25 "dist/build/TfmToVisage.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 32 "dist/build/TfmToVisage.hs" #-} + +{-# LINE 2 "./src-ag/Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 38 "dist/build/TfmToVisage.hs" #-} +{-# LINE 17 "./src-ag/TfmToVisage.ag" #-} + +-- Maps a rule to a pair +-- Later, I expect to map to a list of rules, because we might need to unfold. + + +-- Checks that a certain alias is in fact a Var in the old representation of the AG system +isVar (Alias _ _ (Underscore _)) = True +isVar _ = False + +type VisageRuleMap = [(String, VisageRule)] + +splitVRules :: [VisageRule] -> VisageRuleMap +splitVRules vrs = concat (map unfoldvrs vrs) + +unfoldvrs :: VisageRule -> VisageRuleMap +unfoldvrs vr@(VRule attrfields _ _ _ _) = zip (map (getName . fst) attrfields) (map (copyRule vr) attrfields) + +copyRule :: VisageRule -> (Identifier,Identifier) -> VisageRule +copyRule (VRule attrfields _ pat expr owrt) (field,attr) = VRule attrfields attr pat expr owrt + +getForField :: String -> VisageRuleMap -> [VisageRule] +getForField field xs = map snd (filter ((field ==) . fst) xs) + +{- + Delivers a map from fieldname to VisageRule with all references to others underscored. + So, (lhs.x, rt.y, loc.z) = (0,1,2) becomes something like + [("lhs", (lhs.x,_,_) = (0,1,2) + + At this point, we do not use this anymore. + +allways :: VisageRule -> VisageRuleMap +allways vr@(VRule vrfields _ _ _ _) = zip vrfields (map (underScoreRule vr) (nub vrfields)) + +splitVRules :: [VisageRule] -> VisageRuleMap +splitVRules vrs = concat (map allways vrs) + +underScoreRule :: VisageRule -> String -> VisageRule +underScoreRule (VRule fields pat expr owrt rule) s = VRule fields (underScore s pat) expr owrt rule + +underScore :: String -> VisagePattern -> VisagePattern +underScore field (VConstr name pats) = VConstr name (map (underScore field) pats) +underScore field (VProduct pos pats) = VProduct pos (map (underScore field) pats) +underScore field vp@(VVar vfield attr) = + if (field == getName vfield) + then vp + else (VUnderscore (getPos vfield)) +-- Should I recurse into the pat of VAlias? +underScore field vp@(VAlias afield attr pat) = + if (field == getName afield) + then vp + else (VUnderscore (getPos afield)) +underScore field vp@(VUnderscore pos) = vp + +-} +{-# LINE 94 "dist/build/TfmToVisage.hs" #-} +-- Child ------------------------------------------------------- +{- + visit 0: + inherited attributes: + inhMap : Map Identifier Attributes + rulemap : VisageRuleMap + synMap : Map Identifier Attributes + synthesized attribute: + vchild : VisageChild + alternatives: + alternative Child: + child name : {Identifier} + child tp : {Type} + child kind : {ChildKind} + visit 0: + local chnt : _ + local inh : _ + local syn : _ +-} +-- cata +sem_Child :: Child -> + T_Child +sem_Child (Child _name _tp _kind) = + (sem_Child_Child _name _tp _kind) +-- semantic domain +newtype T_Child = T_Child ((Map Identifier Attributes) -> + VisageRuleMap -> + (Map Identifier Attributes) -> + ( VisageChild)) +data Inh_Child = Inh_Child {inhMap_Inh_Child :: (Map Identifier Attributes),rulemap_Inh_Child :: VisageRuleMap,synMap_Inh_Child :: (Map Identifier Attributes)} +data Syn_Child = Syn_Child {vchild_Syn_Child :: VisageChild} +wrap_Child :: T_Child -> + Inh_Child -> + Syn_Child +wrap_Child (T_Child sem) (Inh_Child _lhsIinhMap _lhsIrulemap _lhsIsynMap) = + (let ( _lhsOvchild) = sem _lhsIinhMap _lhsIrulemap _lhsIsynMap + in (Syn_Child _lhsOvchild)) +sem_Child_Child :: Identifier -> + Type -> + ChildKind -> + T_Child +sem_Child_Child name_ tp_ kind_ = + (T_Child (\ _lhsIinhMap + _lhsIrulemap + _lhsIsynMap -> + (let _lhsOvchild :: VisageChild + -- "./src-ag/TfmToVisage.ag"(line 121, column 11) + _lhsOvchild = + ({-# LINE 121 "./src-ag/TfmToVisage.ag" #-} + VChild name_ tp_ _inh _syn (getForField (getName name_) _lhsIrulemap) + {-# LINE 145 "dist/build/TfmToVisage.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 19, column 11) + _chnt = + ({-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + case tp_ of + NT nt _ _ -> nt + Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") + Haskell t -> identifier "" + {-# LINE 154 "dist/build/TfmToVisage.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 23, column 11) + _inh = + ({-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIinhMap + {-# LINE 160 "dist/build/TfmToVisage.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 24, column 11) + _syn = + ({-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIsynMap + {-# LINE 166 "dist/build/TfmToVisage.hs" #-} + ) + in ( _lhsOvchild)))) +-- Children ---------------------------------------------------- +{- + visit 0: + inherited attributes: + inhMap : Map Identifier Attributes + rulemap : VisageRuleMap + synMap : Map Identifier Attributes + synthesized attribute: + vchildren : [VisageChild] + alternatives: + alternative Cons: + child hd : Child + child tl : Children + alternative Nil: +-} +-- 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 ((Map Identifier Attributes) -> + VisageRuleMap -> + (Map Identifier Attributes) -> + ( ([VisageChild]))) +data Inh_Children = Inh_Children {inhMap_Inh_Children :: (Map Identifier Attributes),rulemap_Inh_Children :: VisageRuleMap,synMap_Inh_Children :: (Map Identifier Attributes)} +data Syn_Children = Syn_Children {vchildren_Syn_Children :: ([VisageChild])} +wrap_Children :: T_Children -> + Inh_Children -> + Syn_Children +wrap_Children (T_Children sem) (Inh_Children _lhsIinhMap _lhsIrulemap _lhsIsynMap) = + (let ( _lhsOvchildren) = sem _lhsIinhMap _lhsIrulemap _lhsIsynMap + in (Syn_Children _lhsOvchildren)) +sem_Children_Cons :: T_Child -> + T_Children -> + T_Children +sem_Children_Cons (T_Child hd_) (T_Children tl_) = + (T_Children (\ _lhsIinhMap + _lhsIrulemap + _lhsIsynMap -> + (let _lhsOvchildren :: ([VisageChild]) + _hdOinhMap :: (Map Identifier Attributes) + _hdOrulemap :: VisageRuleMap + _hdOsynMap :: (Map Identifier Attributes) + _tlOinhMap :: (Map Identifier Attributes) + _tlOrulemap :: VisageRuleMap + _tlOsynMap :: (Map Identifier Attributes) + _hdIvchild :: VisageChild + _tlIvchildren :: ([VisageChild]) + -- "./src-ag/TfmToVisage.ag"(line 117, column 17) + _lhsOvchildren = + ({-# LINE 117 "./src-ag/TfmToVisage.ag" #-} + _hdIvchild : _tlIvchildren + {-# LINE 222 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _hdOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 228 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _hdOrulemap = + ({-# LINE 83 "./src-ag/TfmToVisage.ag" #-} + _lhsIrulemap + {-# LINE 234 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _hdOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 240 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _tlOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 246 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _tlOrulemap = + ({-# LINE 84 "./src-ag/TfmToVisage.ag" #-} + _lhsIrulemap + {-# LINE 252 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _tlOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 258 "dist/build/TfmToVisage.hs" #-} + ) + ( _hdIvchild) = + hd_ _hdOinhMap _hdOrulemap _hdOsynMap + ( _tlIvchildren) = + tl_ _tlOinhMap _tlOrulemap _tlOsynMap + in ( _lhsOvchildren)))) +sem_Children_Nil :: T_Children +sem_Children_Nil = + (T_Children (\ _lhsIinhMap + _lhsIrulemap + _lhsIsynMap -> + (let _lhsOvchildren :: ([VisageChild]) + -- "./src-ag/TfmToVisage.ag"(line 118, column 17) + _lhsOvchildren = + ({-# LINE 118 "./src-ag/TfmToVisage.ag" #-} + [] + {-# LINE 275 "dist/build/TfmToVisage.hs" #-} + ) + in ( _lhsOvchildren)))) +-- Expression -------------------------------------------------- +{- + visit 0: + synthesized attribute: + self : Expression + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} + visit 0: + local self : _ +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression _pos _tks) = + (sem_Expression_Expression _pos _tks) +-- semantic domain +newtype T_Expression = T_Expression (( Expression)) +data Inh_Expression = Inh_Expression {} +data Syn_Expression = Syn_Expression {self_Syn_Expression :: Expression} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem) (Inh_Expression) = + (let ( _lhsOself) = sem + in (Syn_Expression _lhsOself)) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (let _lhsOself :: Expression + -- self rule + _self = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + Expression pos_ tks_ + {-# LINE 314 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + _self + {-# LINE 320 "dist/build/TfmToVisage.hs" #-} + ) + in ( _lhsOself))) +-- Grammar ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + visage : VisageGrammar + alternatives: + alternative Grammar: + child typeSyns : {TypeSyns} + child useMap : {UseMap} + child derivings : {Derivings} + child wrappers : {Set NontermIdent} + child nonts : Nonterminals + child pragmas : {PragmaMap} + child manualAttrOrderMap : {AttrOrderMap} + child paramMap : {ParamMap} + child contextMap : {ContextMap} + child quantMap : {QuantMap} + child uniqueMap : {UniqueMap} + child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} +-} +-- cata +sem_Grammar :: Grammar -> + T_Grammar +sem_Grammar (Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) = + (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) +-- semantic domain +newtype T_Grammar = T_Grammar (( VisageGrammar)) +data Inh_Grammar = Inh_Grammar {} +data Syn_Grammar = Syn_Grammar {visage_Syn_Grammar :: VisageGrammar} +wrap_Grammar :: T_Grammar -> + Inh_Grammar -> + Syn_Grammar +wrap_Grammar (T_Grammar sem) (Inh_Grammar) = + (let ( _lhsOvisage) = sem + in (Syn_Grammar _lhsOvisage)) +sem_Grammar_Grammar :: TypeSyns -> + UseMap -> + Derivings -> + (Set NontermIdent) -> + T_Nonterminals -> + PragmaMap -> + AttrOrderMap -> + ParamMap -> + ContextMap -> + QuantMap -> + UniqueMap -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> + T_Grammar +sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ = + (T_Grammar (let _lhsOvisage :: VisageGrammar + _nontsOinhMap :: (Map Identifier Attributes) + _nontsOsynMap :: (Map Identifier Attributes) + _nontsIinhMap' :: (Map Identifier Attributes) + _nontsIsynMap' :: (Map Identifier Attributes) + _nontsIvnonts :: ([VisageNonterminal]) + -- "./src-ag/TfmToVisage.ag"(line 90, column 7) + _lhsOvisage = + ({-# LINE 90 "./src-ag/TfmToVisage.ag" #-} + VGrammar _nontsIvnonts + {-# LINE 386 "dist/build/TfmToVisage.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 15, column 13) + _nontsOinhMap = + ({-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + _nontsIinhMap' + {-# LINE 392 "dist/build/TfmToVisage.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 16, column 13) + _nontsOsynMap = + ({-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + _nontsIsynMap' + {-# LINE 398 "dist/build/TfmToVisage.hs" #-} + ) + ( _nontsIinhMap',_nontsIsynMap',_nontsIvnonts) = + nonts_ _nontsOinhMap _nontsOsynMap + in ( _lhsOvisage))) +-- Nonterminal ------------------------------------------------- +{- + visit 0: + inherited attributes: + inhMap : Map Identifier Attributes + synMap : Map Identifier Attributes + synthesized attributes: + inhMap' : Map Identifier Attributes + synMap' : Map Identifier Attributes + vnont : VisageNonterminal + alternatives: + alternative Nonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child inh : {Attributes} + child syn : {Attributes} + child prods : Productions +-} +-- 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 ((Map Identifier Attributes) -> + (Map Identifier Attributes) -> + ( (Map Identifier Attributes),(Map Identifier Attributes),VisageNonterminal)) +data Inh_Nonterminal = Inh_Nonterminal {inhMap_Inh_Nonterminal :: (Map Identifier Attributes),synMap_Inh_Nonterminal :: (Map Identifier Attributes)} +data Syn_Nonterminal = Syn_Nonterminal {inhMap'_Syn_Nonterminal :: (Map Identifier Attributes),synMap'_Syn_Nonterminal :: (Map Identifier Attributes),vnont_Syn_Nonterminal :: VisageNonterminal} +wrap_Nonterminal :: T_Nonterminal -> + Inh_Nonterminal -> + Syn_Nonterminal +wrap_Nonterminal (T_Nonterminal sem) (Inh_Nonterminal _lhsIinhMap _lhsIsynMap) = + (let ( _lhsOinhMap',_lhsOsynMap',_lhsOvnont) = sem _lhsIinhMap _lhsIsynMap + in (Syn_Nonterminal _lhsOinhMap' _lhsOsynMap' _lhsOvnont)) +sem_Nonterminal_Nonterminal :: NontermIdent -> + ([Identifier]) -> + Attributes -> + Attributes -> + T_Productions -> + T_Nonterminal +sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_) = + (T_Nonterminal (\ _lhsIinhMap + _lhsIsynMap -> + (let _lhsOvnont :: VisageNonterminal + _lhsOinhMap' :: (Map Identifier Attributes) + _lhsOsynMap' :: (Map Identifier Attributes) + _prodsOinhMap :: (Map Identifier Attributes) + _prodsOsynMap :: (Map Identifier Attributes) + _prodsIvprods :: ([VisageProduction]) + -- "./src-ag/TfmToVisage.ag"(line 100, column 7) + _lhsOvnont = + ({-# LINE 100 "./src-ag/TfmToVisage.ag" #-} + VNonterminal nt_ inh_ syn_ _prodsIvprods + {-# LINE 457 "dist/build/TfmToVisage.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 7, column 18) + _lhsOinhMap' = + ({-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 463 "dist/build/TfmToVisage.hs" #-} + ) + -- "./src-ag/DistChildAttr.ag"(line 8, column 18) + _lhsOsynMap' = + ({-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 469 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _prodsOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 475 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _prodsOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 481 "dist/build/TfmToVisage.hs" #-} + ) + ( _prodsIvprods) = + prods_ _prodsOinhMap _prodsOsynMap + in ( _lhsOinhMap',_lhsOsynMap',_lhsOvnont)))) +-- Nonterminals ------------------------------------------------ +{- + visit 0: + inherited attributes: + inhMap : Map Identifier Attributes + synMap : Map Identifier Attributes + synthesized attributes: + inhMap' : Map Identifier Attributes + synMap' : Map Identifier Attributes + vnonts : [VisageNonterminal] + alternatives: + alternative Cons: + child hd : Nonterminal + child tl : Nonterminals + alternative Nil: +-} +-- 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 ((Map Identifier Attributes) -> + (Map Identifier Attributes) -> + ( (Map Identifier Attributes),(Map Identifier Attributes),([VisageNonterminal]))) +data Inh_Nonterminals = Inh_Nonterminals {inhMap_Inh_Nonterminals :: (Map Identifier Attributes),synMap_Inh_Nonterminals :: (Map Identifier Attributes)} +data Syn_Nonterminals = Syn_Nonterminals {inhMap'_Syn_Nonterminals :: (Map Identifier Attributes),synMap'_Syn_Nonterminals :: (Map Identifier Attributes),vnonts_Syn_Nonterminals :: ([VisageNonterminal])} +wrap_Nonterminals :: T_Nonterminals -> + Inh_Nonterminals -> + Syn_Nonterminals +wrap_Nonterminals (T_Nonterminals sem) (Inh_Nonterminals _lhsIinhMap _lhsIsynMap) = + (let ( _lhsOinhMap',_lhsOsynMap',_lhsOvnonts) = sem _lhsIinhMap _lhsIsynMap + in (Syn_Nonterminals _lhsOinhMap' _lhsOsynMap' _lhsOvnonts)) +sem_Nonterminals_Cons :: T_Nonterminal -> + T_Nonterminals -> + T_Nonterminals +sem_Nonterminals_Cons (T_Nonterminal hd_) (T_Nonterminals tl_) = + (T_Nonterminals (\ _lhsIinhMap + _lhsIsynMap -> + (let _lhsOvnonts :: ([VisageNonterminal]) + _lhsOinhMap' :: (Map Identifier Attributes) + _lhsOsynMap' :: (Map Identifier Attributes) + _hdOinhMap :: (Map Identifier Attributes) + _hdOsynMap :: (Map Identifier Attributes) + _tlOinhMap :: (Map Identifier Attributes) + _tlOsynMap :: (Map Identifier Attributes) + _hdIinhMap' :: (Map Identifier Attributes) + _hdIsynMap' :: (Map Identifier Attributes) + _hdIvnont :: VisageNonterminal + _tlIinhMap' :: (Map Identifier Attributes) + _tlIsynMap' :: (Map Identifier Attributes) + _tlIvnonts :: ([VisageNonterminal]) + -- "./src-ag/TfmToVisage.ag"(line 94, column 7) + _lhsOvnonts = + ({-# LINE 94 "./src-ag/TfmToVisage.ag" #-} + _hdIvnont : _tlIvnonts + {-# LINE 542 "dist/build/TfmToVisage.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOinhMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + _hdIinhMap' `Map.union` _tlIinhMap' + {-# LINE 548 "dist/build/TfmToVisage.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOsynMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + _hdIsynMap' `Map.union` _tlIsynMap' + {-# LINE 554 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _hdOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 560 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _hdOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 566 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _tlOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 572 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _tlOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 578 "dist/build/TfmToVisage.hs" #-} + ) + ( _hdIinhMap',_hdIsynMap',_hdIvnont) = + hd_ _hdOinhMap _hdOsynMap + ( _tlIinhMap',_tlIsynMap',_tlIvnonts) = + tl_ _tlOinhMap _tlOsynMap + in ( _lhsOinhMap',_lhsOsynMap',_lhsOvnonts)))) +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = + (T_Nonterminals (\ _lhsIinhMap + _lhsIsynMap -> + (let _lhsOvnonts :: ([VisageNonterminal]) + _lhsOinhMap' :: (Map Identifier Attributes) + _lhsOsynMap' :: (Map Identifier Attributes) + -- "./src-ag/TfmToVisage.ag"(line 96, column 7) + _lhsOvnonts = + ({-# LINE 96 "./src-ag/TfmToVisage.ag" #-} + [] + {-# LINE 596 "dist/build/TfmToVisage.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOinhMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + Map.empty + {-# LINE 602 "dist/build/TfmToVisage.hs" #-} + ) + -- use rule "./src-ag/DistChildAttr.ag"(line 4, column 53) + _lhsOsynMap' = + ({-# LINE 4 "./src-ag/DistChildAttr.ag" #-} + Map.empty + {-# LINE 608 "dist/build/TfmToVisage.hs" #-} + ) + in ( _lhsOinhMap',_lhsOsynMap',_lhsOvnonts)))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : Pattern + fieldattrs : [(Identifier,Identifier)] + self : Pattern + vpat : VisagePattern + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + local self : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + local self : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local copy : _ + local self : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + local self : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ + local self : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern (Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern (Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern (Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +sem_Pattern (Underscore _pos) = + (sem_Pattern_Underscore _pos) +-- semantic domain +newtype T_Pattern = T_Pattern (( Pattern,( [(Identifier,Identifier)] ),Pattern,VisagePattern)) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: Pattern,fieldattrs_Syn_Pattern :: ( [(Identifier,Identifier)] ),self_Syn_Pattern :: Pattern,vpat_Syn_Pattern :: VisagePattern} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem) (Inh_Pattern) = + (let ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat) = sem + in (Syn_Pattern _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat)) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_) = + (T_Pattern (let _lhsOvpat :: VisagePattern + _lhsOfieldattrs :: ( [(Identifier,Identifier)] ) + _lhsOcopy :: Pattern + _lhsOself :: Pattern + _patsIcopy :: Patterns + _patsIfieldattrs :: ( [(Identifier,Identifier)] ) + _patsIself :: Patterns + _patsIvpats :: ([VisagePattern]) + -- "./src-ag/TfmToVisage.ag"(line 136, column 17) + _lhsOvpat = + ({-# LINE 136 "./src-ag/TfmToVisage.ag" #-} + VConstr name_ _patsIvpats + {-# LINE 689 "dist/build/TfmToVisage.hs" #-} + ) + -- use rule "./src-ag/TfmToVisage.ag"(line 144, column 43) + _lhsOfieldattrs = + ({-# LINE 144 "./src-ag/TfmToVisage.ag" #-} + _patsIfieldattrs + {-# LINE 695 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 701 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _self = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + Constr name_ _patsIself + {-# LINE 707 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 713 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + _self + {-# LINE 719 "dist/build/TfmToVisage.hs" #-} + ) + ( _patsIcopy,_patsIfieldattrs,_patsIself,_patsIvpats) = + pats_ + in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat))) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_) = + (T_Pattern (let _lhsOvpat :: VisagePattern + _lhsOfieldattrs :: ( [(Identifier,Identifier)] ) + _lhsOcopy :: Pattern + _lhsOself :: Pattern + _patsIcopy :: Patterns + _patsIfieldattrs :: ( [(Identifier,Identifier)] ) + _patsIself :: Patterns + _patsIvpats :: ([VisagePattern]) + -- "./src-ag/TfmToVisage.ag"(line 137, column 17) + _lhsOvpat = + ({-# LINE 137 "./src-ag/TfmToVisage.ag" #-} + VProduct pos_ _patsIvpats + {-# LINE 740 "dist/build/TfmToVisage.hs" #-} + ) + -- use rule "./src-ag/TfmToVisage.ag"(line 144, column 43) + _lhsOfieldattrs = + ({-# LINE 144 "./src-ag/TfmToVisage.ag" #-} + _patsIfieldattrs + {-# LINE 746 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 752 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _self = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + Product pos_ _patsIself + {-# LINE 758 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 764 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + _self + {-# LINE 770 "dist/build/TfmToVisage.hs" #-} + ) + ( _patsIcopy,_patsIfieldattrs,_patsIself,_patsIvpats) = + pats_ + in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat))) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_) = + (T_Pattern (let _lhsOvpat :: VisagePattern + _lhsOfieldattrs :: ( [(Identifier,Identifier)] ) + _lhsOcopy :: Pattern + _lhsOself :: Pattern + _patIcopy :: Pattern + _patIfieldattrs :: ( [(Identifier,Identifier)] ) + _patIself :: Pattern + _patIvpat :: VisagePattern + -- "./src-ag/TfmToVisage.ag"(line 138, column 17) + _lhsOvpat = + ({-# LINE 138 "./src-ag/TfmToVisage.ag" #-} + if (isVar _self) + then VVar field_ attr_ + else VAlias field_ attr_ _patIvpat + {-# LINE 794 "dist/build/TfmToVisage.hs" #-} + ) + -- "./src-ag/TfmToVisage.ag"(line 147, column 17) + _lhsOfieldattrs = + ({-# LINE 147 "./src-ag/TfmToVisage.ag" #-} + [(field_, attr_)] + {-# LINE 800 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 806 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _self = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + Alias field_ attr_ _patIself + {-# LINE 812 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 818 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + _self + {-# LINE 824 "dist/build/TfmToVisage.hs" #-} + ) + ( _patIcopy,_patIfieldattrs,_patIself,_patIvpat) = + pat_ + in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat))) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_) = + (T_Pattern (let _lhsOfieldattrs :: ( [(Identifier,Identifier)] ) + _lhsOcopy :: Pattern + _lhsOself :: Pattern + _lhsOvpat :: VisagePattern + _patIcopy :: Pattern + _patIfieldattrs :: ( [(Identifier,Identifier)] ) + _patIself :: Pattern + _patIvpat :: VisagePattern + -- use rule "./src-ag/TfmToVisage.ag"(line 144, column 43) + _lhsOfieldattrs = + ({-# LINE 144 "./src-ag/TfmToVisage.ag" #-} + _patIfieldattrs + {-# LINE 844 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 850 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _self = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + Irrefutable _patIself + {-# LINE 856 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 862 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + _self + {-# LINE 868 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (up) + _lhsOvpat = + ({-# LINE 85 "./src-ag/TfmToVisage.ag" #-} + _patIvpat + {-# LINE 874 "dist/build/TfmToVisage.hs" #-} + ) + ( _patIcopy,_patIfieldattrs,_patIself,_patIvpat) = + pat_ + in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat))) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOvpat :: VisagePattern + _lhsOfieldattrs :: ( [(Identifier,Identifier)] ) + _lhsOcopy :: Pattern + _lhsOself :: Pattern + -- "./src-ag/TfmToVisage.ag"(line 141, column 17) + _lhsOvpat = + ({-# LINE 141 "./src-ag/TfmToVisage.ag" #-} + VUnderscore pos_ + {-# LINE 890 "dist/build/TfmToVisage.hs" #-} + ) + -- use rule "./src-ag/TfmToVisage.ag"(line 144, column 43) + _lhsOfieldattrs = + ({-# LINE 144 "./src-ag/TfmToVisage.ag" #-} + [] + {-# LINE 896 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 902 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _self = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + Underscore pos_ + {-# LINE 908 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 914 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + _self + {-# LINE 920 "dist/build/TfmToVisage.hs" #-} + ) + in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : Patterns + fieldattrs : [(Identifier,Identifier)] + self : Patterns + vpats : [VisagePattern] + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + local self : _ + alternative Nil: + visit 0: + local copy : _ + local self : _ +-} +-- 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,( [(Identifier,Identifier)] ),Patterns,([VisagePattern]))) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: Patterns,fieldattrs_Syn_Patterns :: ( [(Identifier,Identifier)] ),self_Syn_Patterns :: Patterns,vpats_Syn_Patterns :: ([VisagePattern])} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem) (Inh_Patterns) = + (let ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpats) = sem + in (Syn_Patterns _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpats)) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) = + (T_Patterns (let _lhsOvpats :: ([VisagePattern]) + _lhsOfieldattrs :: ( [(Identifier,Identifier)] ) + _lhsOcopy :: Patterns + _lhsOself :: Patterns + _hdIcopy :: Pattern + _hdIfieldattrs :: ( [(Identifier,Identifier)] ) + _hdIself :: Pattern + _hdIvpat :: VisagePattern + _tlIcopy :: Patterns + _tlIfieldattrs :: ( [(Identifier,Identifier)] ) + _tlIself :: Patterns + _tlIvpats :: ([VisagePattern]) + -- "./src-ag/TfmToVisage.ag"(line 132, column 17) + _lhsOvpats = + ({-# LINE 132 "./src-ag/TfmToVisage.ag" #-} + _hdIvpat : _tlIvpats + {-# LINE 978 "dist/build/TfmToVisage.hs" #-} + ) + -- use rule "./src-ag/TfmToVisage.ag"(line 144, column 43) + _lhsOfieldattrs = + ({-# LINE 144 "./src-ag/TfmToVisage.ag" #-} + _hdIfieldattrs ++ _tlIfieldattrs + {-# LINE 984 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 990 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _self = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + (:) _hdIself _tlIself + {-# LINE 996 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1002 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + _self + {-# LINE 1008 "dist/build/TfmToVisage.hs" #-} + ) + ( _hdIcopy,_hdIfieldattrs,_hdIself,_hdIvpat) = + hd_ + ( _tlIcopy,_tlIfieldattrs,_tlIself,_tlIvpats) = + tl_ + in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpats))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOvpats :: ([VisagePattern]) + _lhsOfieldattrs :: ( [(Identifier,Identifier)] ) + _lhsOcopy :: Patterns + _lhsOself :: Patterns + -- "./src-ag/TfmToVisage.ag"(line 133, column 17) + _lhsOvpats = + ({-# LINE 133 "./src-ag/TfmToVisage.ag" #-} + [] + {-# LINE 1025 "dist/build/TfmToVisage.hs" #-} + ) + -- use rule "./src-ag/TfmToVisage.ag"(line 144, column 43) + _lhsOfieldattrs = + ({-# LINE 144 "./src-ag/TfmToVisage.ag" #-} + [] + {-# LINE 1031 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 1037 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _self = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + [] + {-# LINE 1043 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 1049 "dist/build/TfmToVisage.hs" #-} + ) + -- self rule + _lhsOself = + ({-# LINE 74 "./src-ag/TfmToVisage.ag" #-} + _self + {-# LINE 1055 "dist/build/TfmToVisage.hs" #-} + ) + in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpats))) +-- Production -------------------------------------------------- +{- + visit 0: + inherited attributes: + inhMap : Map Identifier Attributes + synMap : Map Identifier Attributes + synthesized attribute: + vprod : VisageProduction + alternatives: + alternative Production: + child con : {ConstructorIdent} + child params : {[Identifier]} + child constraints : {[Type]} + child children : Children + child rules : Rules + child typeSigs : TypeSigs + child macro : {MaybeMacro} + visit 0: + local splitVRules : _ + local locrules : _ + local lhsrules : _ +-} +-- cata +sem_Production :: Production -> + T_Production +sem_Production (Production _con _params _constraints _children _rules _typeSigs _macro) = + (sem_Production_Production _con _params _constraints (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs) _macro) +-- semantic domain +newtype T_Production = T_Production ((Map Identifier Attributes) -> + (Map Identifier Attributes) -> + ( VisageProduction)) +data Inh_Production = Inh_Production {inhMap_Inh_Production :: (Map Identifier Attributes),synMap_Inh_Production :: (Map Identifier Attributes)} +data Syn_Production = Syn_Production {vprod_Syn_Production :: VisageProduction} +wrap_Production :: T_Production -> + Inh_Production -> + Syn_Production +wrap_Production (T_Production sem) (Inh_Production _lhsIinhMap _lhsIsynMap) = + (let ( _lhsOvprod) = sem _lhsIinhMap _lhsIsynMap + in (Syn_Production _lhsOvprod)) +sem_Production_Production :: ConstructorIdent -> + ([Identifier]) -> + ([Type]) -> + T_Children -> + T_Rules -> + T_TypeSigs -> + MaybeMacro -> + T_Production +sem_Production_Production con_ params_ constraints_ (T_Children children_) (T_Rules rules_) (T_TypeSigs typeSigs_) macro_ = + (T_Production (\ _lhsIinhMap + _lhsIsynMap -> + (let _lhsOvprod :: VisageProduction + _childrenOrulemap :: VisageRuleMap + _childrenOinhMap :: (Map Identifier Attributes) + _childrenOsynMap :: (Map Identifier Attributes) + _childrenIvchildren :: ([VisageChild]) + _rulesIvrules :: ([VisageRule]) + -- "./src-ag/TfmToVisage.ag"(line 110, column 7) + _lhsOvprod = + ({-# LINE 110 "./src-ag/TfmToVisage.ag" #-} + VProduction con_ _childrenIvchildren _lhsrules _locrules + {-# LINE 1118 "dist/build/TfmToVisage.hs" #-} + ) + -- "./src-ag/TfmToVisage.ag"(line 111, column 7) + _splitVRules = + ({-# LINE 111 "./src-ag/TfmToVisage.ag" #-} + splitVRules _rulesIvrules + {-# LINE 1124 "dist/build/TfmToVisage.hs" #-} + ) + -- "./src-ag/TfmToVisage.ag"(line 112, column 7) + _locrules = + ({-# LINE 112 "./src-ag/TfmToVisage.ag" #-} + getForField "loc" _splitVRules + {-# LINE 1130 "dist/build/TfmToVisage.hs" #-} + ) + -- "./src-ag/TfmToVisage.ag"(line 113, column 7) + _lhsrules = + ({-# LINE 113 "./src-ag/TfmToVisage.ag" #-} + getForField "lhs" _splitVRules + {-# LINE 1136 "dist/build/TfmToVisage.hs" #-} + ) + -- "./src-ag/TfmToVisage.ag"(line 114, column 7) + _childrenOrulemap = + ({-# LINE 114 "./src-ag/TfmToVisage.ag" #-} + _splitVRules + {-# LINE 1142 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _childrenOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1148 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _childrenOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1154 "dist/build/TfmToVisage.hs" #-} + ) + ( _childrenIvchildren) = + children_ _childrenOinhMap _childrenOrulemap _childrenOsynMap + ( _rulesIvrules) = + rules_ + in ( _lhsOvprod)))) +-- Productions ------------------------------------------------- +{- + visit 0: + inherited attributes: + inhMap : Map Identifier Attributes + synMap : Map Identifier Attributes + synthesized attribute: + vprods : [VisageProduction] + alternatives: + alternative Cons: + child hd : Production + child tl : Productions + alternative Nil: +-} +-- cata +sem_Productions :: Productions -> + T_Productions +sem_Productions list = + (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list)) +-- semantic domain +newtype T_Productions = T_Productions ((Map Identifier Attributes) -> + (Map Identifier Attributes) -> + ( ([VisageProduction]))) +data Inh_Productions = Inh_Productions {inhMap_Inh_Productions :: (Map Identifier Attributes),synMap_Inh_Productions :: (Map Identifier Attributes)} +data Syn_Productions = Syn_Productions {vprods_Syn_Productions :: ([VisageProduction])} +wrap_Productions :: T_Productions -> + Inh_Productions -> + Syn_Productions +wrap_Productions (T_Productions sem) (Inh_Productions _lhsIinhMap _lhsIsynMap) = + (let ( _lhsOvprods) = sem _lhsIinhMap _lhsIsynMap + in (Syn_Productions _lhsOvprods)) +sem_Productions_Cons :: T_Production -> + T_Productions -> + T_Productions +sem_Productions_Cons (T_Production hd_) (T_Productions tl_) = + (T_Productions (\ _lhsIinhMap + _lhsIsynMap -> + (let _lhsOvprods :: ([VisageProduction]) + _hdOinhMap :: (Map Identifier Attributes) + _hdOsynMap :: (Map Identifier Attributes) + _tlOinhMap :: (Map Identifier Attributes) + _tlOsynMap :: (Map Identifier Attributes) + _hdIvprod :: VisageProduction + _tlIvprods :: ([VisageProduction]) + -- "./src-ag/TfmToVisage.ag"(line 104, column 7) + _lhsOvprods = + ({-# LINE 104 "./src-ag/TfmToVisage.ag" #-} + _hdIvprod : _tlIvprods + {-# LINE 1209 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _hdOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1215 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _hdOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1221 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _tlOinhMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIinhMap + {-# LINE 1227 "dist/build/TfmToVisage.hs" #-} + ) + -- copy rule (down) + _tlOsynMap = + ({-# LINE 12 "./src-ag/DistChildAttr.ag" #-} + _lhsIsynMap + {-# LINE 1233 "dist/build/TfmToVisage.hs" #-} + ) + ( _hdIvprod) = + hd_ _hdOinhMap _hdOsynMap + ( _tlIvprods) = + tl_ _tlOinhMap _tlOsynMap + in ( _lhsOvprods)))) +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = + (T_Productions (\ _lhsIinhMap + _lhsIsynMap -> + (let _lhsOvprods :: ([VisageProduction]) + -- "./src-ag/TfmToVisage.ag"(line 106, column 7) + _lhsOvprods = + ({-# LINE 106 "./src-ag/TfmToVisage.ag" #-} + [] + {-# LINE 1249 "dist/build/TfmToVisage.hs" #-} + ) + in ( _lhsOvprods)))) +-- Rule -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + vrule : VisageRule + alternatives: + alternative Rule: + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + child pure : {Bool} + child identity : {Bool} + child mbError : {Maybe Error} + child eager : {Bool} +-} +-- cata +sem_Rule :: Rule -> + T_Rule +sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit _pure _identity _mbError _eager) = + (sem_Rule_Rule _mbName (sem_Pattern _pattern) (sem_Expression _rhs) _owrt _origin _explicit _pure _identity _mbError _eager) +-- semantic domain +newtype T_Rule = T_Rule (( VisageRule)) +data Inh_Rule = Inh_Rule {} +data Syn_Rule = Syn_Rule {vrule_Syn_Rule :: VisageRule} +wrap_Rule :: T_Rule -> + Inh_Rule -> + Syn_Rule +wrap_Rule (T_Rule sem) (Inh_Rule) = + (let ( _lhsOvrule) = sem + in (Syn_Rule _lhsOvrule)) +sem_Rule_Rule :: (Maybe Identifier) -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + Bool -> + Bool -> + (Maybe Error) -> + Bool -> + T_Rule +sem_Rule_Rule mbName_ (T_Pattern pattern_) (T_Expression rhs_) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ = + (T_Rule (let _lhsOvrule :: VisageRule + _patternIcopy :: Pattern + _patternIfieldattrs :: ( [(Identifier,Identifier)] ) + _patternIself :: Pattern + _patternIvpat :: VisagePattern + _rhsIself :: Expression + -- "./src-ag/TfmToVisage.ag"(line 129, column 11) + _lhsOvrule = + ({-# LINE 129 "./src-ag/TfmToVisage.ag" #-} + VRule _patternIfieldattrs undefined _patternIvpat _rhsIself owrt_ + {-# LINE 1307 "dist/build/TfmToVisage.hs" #-} + ) + ( _patternIcopy,_patternIfieldattrs,_patternIself,_patternIvpat) = + pattern_ + ( _rhsIself) = + rhs_ + in ( _lhsOvrule))) +-- Rules ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + vrules : [VisageRule] + alternatives: + alternative Cons: + child hd : Rule + child tl : Rules + alternative Nil: +-} +-- 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 (( ([VisageRule]))) +data Inh_Rules = Inh_Rules {} +data Syn_Rules = Syn_Rules {vrules_Syn_Rules :: ([VisageRule])} +wrap_Rules :: T_Rules -> + Inh_Rules -> + Syn_Rules +wrap_Rules (T_Rules sem) (Inh_Rules) = + (let ( _lhsOvrules) = sem + in (Syn_Rules _lhsOvrules)) +sem_Rules_Cons :: T_Rule -> + T_Rules -> + T_Rules +sem_Rules_Cons (T_Rule hd_) (T_Rules tl_) = + (T_Rules (let _lhsOvrules :: ([VisageRule]) + _hdIvrule :: VisageRule + _tlIvrules :: ([VisageRule]) + -- "./src-ag/TfmToVisage.ag"(line 124, column 17) + _lhsOvrules = + ({-# LINE 124 "./src-ag/TfmToVisage.ag" #-} + _hdIvrule : _tlIvrules + {-# LINE 1351 "dist/build/TfmToVisage.hs" #-} + ) + ( _hdIvrule) = + hd_ + ( _tlIvrules) = + tl_ + in ( _lhsOvrules))) +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = + (T_Rules (let _lhsOvrules :: ([VisageRule]) + -- "./src-ag/TfmToVisage.ag"(line 125, column 17) + _lhsOvrules = + ({-# LINE 125 "./src-ag/TfmToVisage.ag" #-} + [] + {-# LINE 1365 "dist/build/TfmToVisage.hs" #-} + ) + in ( _lhsOvrules))) +-- TypeSig ----------------------------------------------------- +{- + alternatives: + alternative TypeSig: + child name : {Identifier} + child tp : {Type} +-} +-- cata +sem_TypeSig :: TypeSig -> + T_TypeSig +sem_TypeSig (TypeSig _name _tp) = + (sem_TypeSig_TypeSig _name _tp) +-- semantic domain +newtype T_TypeSig = T_TypeSig (( )) +data Inh_TypeSig = Inh_TypeSig {} +data Syn_TypeSig = Syn_TypeSig {} +wrap_TypeSig :: T_TypeSig -> + Inh_TypeSig -> + Syn_TypeSig +wrap_TypeSig (T_TypeSig sem) (Inh_TypeSig) = + (let ( ) = sem + in (Syn_TypeSig)) +sem_TypeSig_TypeSig :: Identifier -> + Type -> + T_TypeSig +sem_TypeSig_TypeSig name_ tp_ = + (T_TypeSig (let + in ( ))) +-- TypeSigs ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : TypeSig + child tl : TypeSigs + alternative Nil: +-} +-- 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 (( )) +data Inh_TypeSigs = Inh_TypeSigs {} +data Syn_TypeSigs = Syn_TypeSigs {} +wrap_TypeSigs :: T_TypeSigs -> + Inh_TypeSigs -> + Syn_TypeSigs +wrap_TypeSigs (T_TypeSigs sem) (Inh_TypeSigs) = + (let ( ) = sem + in (Syn_TypeSigs)) +sem_TypeSigs_Cons :: T_TypeSig -> + T_TypeSigs -> + T_TypeSigs +sem_TypeSigs_Cons (T_TypeSig hd_) (T_TypeSigs tl_) = + (T_TypeSigs (let + in ( ))) +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = + (T_TypeSigs (let + in ( ))) diff --git a/dist/build/Transform.hs b/dist/build/Transform.hs new file mode 100644 --- /dev/null +++ b/dist/build/Transform.hs @@ -0,0 +1,8028 @@ + + +-- UUAGC 0.9.42.0 (src-ag/Transform.ag) +module Transform where +{-# LINE 8 "./src-ag/Transform.ag" #-} + +import Control.Monad(mplus,mzero) +import Data.List (partition, elem, nub,intersperse, union) +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, elems) +import qualified Data.Sequence as Seq +import Data.Sequence(Seq, empty, (><),fromList) +import Data.Foldable(toList) +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 RhsCheck +import Debug.Trace +{-# LINE 30 "dist/build/Transform.hs" #-} + +{-# LINE 2 "./src-ag/ConcreteSyntax.ag" #-} + +import UU.Scanner.Position (Pos) +import Patterns (Pattern) +import Expression (Expression) +import CommonTypes +import Macro --marcos +{-# LINE 39 "dist/build/Transform.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 46 "dist/build/Transform.hs" #-} +{-# LINE 107 "./src-ag/Transform.ag" #-} +type DefinedSets = Map Identifier (Set NontermIdent) +{-# LINE 49 "dist/build/Transform.hs" #-} + +{-# LINE 127 "./src-ag/Transform.ag" #-} +type FieldMap = [(Identifier, Type)] +{-# LINE 53 "dist/build/Transform.hs" #-} + +{-# LINE 128 "./src-ag/Transform.ag" #-} +type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap) +{-# LINE 57 "dist/build/Transform.hs" #-} + +{-# LINE 151 "./src-ag/Transform.ag" #-} +type AttrName = (Identifier,Identifier) +{-# LINE 61 "dist/build/Transform.hs" #-} + +{-# LINE 152 "./src-ag/Transform.ag" #-} +type RuleInfo = (Maybe Identifier, [AttrName]->Pattern, Expression, [AttrName], Bool, String, Bool, Bool) +{-# LINE 65 "dist/build/Transform.hs" #-} + +{-# LINE 153 "./src-ag/Transform.ag" #-} +type SigInfo = (Identifier,Type) +{-# LINE 69 "dist/build/Transform.hs" #-} + +{-# LINE 154 "./src-ag/Transform.ag" #-} +type UniqueInfo = (Identifier,Identifier) +{-# LINE 73 "dist/build/Transform.hs" #-} + +{-# LINE 155 "./src-ag/Transform.ag" #-} +type AugmentInfo = (Identifier,Expression) +{-# LINE 77 "dist/build/Transform.hs" #-} + +{-# LINE 156 "./src-ag/Transform.ag" #-} +type AroundInfo = (Identifier,Expression) +{-# LINE 81 "dist/build/Transform.hs" #-} + +{-# LINE 157 "./src-ag/Transform.ag" #-} +type MergeInfo = (Identifier, Identifier, [Identifier], Expression) +{-# LINE 85 "dist/build/Transform.hs" #-} + +{-# LINE 206 "./src-ag/Transform.ag" #-} + + +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.singleton (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) = partition (equalId x) xs + in map (err x) same ++ checkForDuplicates err other + +equalId :: Identifier -> Identifier -> Bool +equalId x y = getName x == getName y + +{-# LINE 116 "dist/build/Transform.hs" #-} + +{-# LINE 355 "./src-ag/Transform.ag" #-} + +type RulesAndErrors = ([Rule], Seq Error) +type SigsAndErrors = ([TypeSig], Seq Error) +type InstsAndErrors = ([(Identifier, Type)], Seq Error) +type UniquesAndErrors = (Map Identifier Identifier, Seq Error) +type AugmentsAndErrors = (Map Identifier [Expression], Seq Error) +type AroundsAndErrors = (Map Identifier [Expression], Seq Error) +type MergesAndErrors = (Map Identifier (Identifier, [Identifier], Expression), Seq Error) +type AttrOverwrite = Map AttrName Bool +type AccumRuleCheck = (RulesAndErrors, AttrOverwrite) +type AccumDefiCheck = (Seq Error, AttrOverwrite, [AttrName], [AttrName]) + +checkRules :: Map NontermIdent (Attributes, Attributes) -> DataTypes -> + Map NontermIdent (Map ConstructorIdent [Identifier]) -> Map NontermIdent (Map ConstructorIdent [SigInfo]) -> + Map NontermIdent (Map ConstructorIdent [MergeInfo]) -> + NontermIdent -> ConstructorIdent -> [RuleInfo] -> RulesAndErrors +checkRules attributes fields allinsts allsigs allmerges nt con rs + = let fieldmap :: FieldMap + fieldmap = (_LHS, NT nt [] False) : (_LOC, NT nullIdent [] False) : (_INST, NT nullIdent [] False) : (_FIRST, NT nullIdent [] False) : (_LAST, NT nullIdent [] False) + : 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)) + -- merged children are not allowed to have any inherited attrs defined: do not include + + 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 (mbNm, pat,exp,as,owrt,str, pur, eager) ((r1,e1),m1) + = let (e2,m2,u2,b2) = foldr (checkDefi owrt) (e1,m1,[],[]) as + in ( (Rule mbNm (pat u2) exp owrt str True pur False Nothing eager : 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 _ _) -> + let tp' = maybe tp id (deforestedNt tp) + in 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.<|)) (DupRule nt con field attr2 attr) e, m, fa:u, bs) + Nothing -> ( e, Map.insert fa owrt m, u, fa:bs) + else (((Seq.<|)) (SuperfluousRule nt con field attr) e, m, fa:u, bs) + _ -> (((Seq.<|)) (UndefChild nt con field) e, m, fa:u, bs ) + + in fst (foldr checkRule (([],Seq.empty),Map.empty) rs) + +checkRuleNames :: NontermIdent -> ConstructorIdent -> [RuleInfo] -> Seq Error +checkRuleNames nt con + = fst . foldr checkRule (Seq.empty, Set.empty) + where + checkRule (Just nm,_,_,_,_,_,_,_) (errs, nms) + | nm `Set.member` nms = (DupRuleName nt con nm Seq.<| errs, nms) + | otherwise = (errs, Set.insert nm nms) + checkRule (Nothing,_,_,_,_,_,_,_) inp = inp + +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.<|)) (DupSig nt con ide) errs) + -- else if not (ide `elem` locattrdefs) + -- then (sigs, ((Seq.<|)) (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]) -> DataTypes -> NontermIdent -> ConstructorIdent -> [Identifier] -> InstsAndErrors +checkInsts allNts sigMap fieldMap nt con + = foldr (\inst (insts, errs) -> + maybe (insts, Seq.singleton (MissingInstSig nt con inst) >< errs) + (\info@(k, NT nm args _) -> + case findInst k insts of + Just k' -> (insts, Seq.singleton (DupChild nt con k k') >< errs) + Nothing -> 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) + info' = (k, NT nm' args True) -- this should be the only place at which 'for' with value True can be generated + in case nm' `Set.member` allNts of + True -> (info' : insts, errs) + False -> (insts, Seq.singleton (UndefNont nm') >< errs) + | otherwise -> (insts, Seq.singleton (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) + + findInst _ [] = Nothing + findInst k ((k', _): r) + | k == k' = Just k' + | otherwise = findInst k r + +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.<|)) (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.<|)) (MissingUnique nt ref) errs) + + (inhs,syns) = Map.findWithDefault (Map.empty,Map.empty) nt allAttrs + in foldr checkUnique (Map.empty, Seq.empty) uniques + +checkAugments :: Map NontermIdent (Attributes, Attributes) -> NontermIdent -> ConstructorIdent -> [AugmentInfo] -> AugmentsAndErrors +checkAugments allAttrs nt con augments + = let checkAugment (ident,expr) (as,errs) + = if ident `Map.member` as + then (Map.update (\vs -> Just (vs ++ [expr])) ident as, errs) + else if Map.member ident syns + then (Map.insert ident [expr] as, errs) + else (as, ((Seq.<|)) (MissingSyn nt ident) errs) + + (inhs,syns) = Map.findWithDefault (Map.empty,Map.empty) nt allAttrs + in foldr checkAugment (Map.empty, Seq.empty) augments + +checkArounds :: DataTypes -> NontermIdent -> ConstructorIdent -> [AroundInfo] -> AroundsAndErrors +checkArounds fieldMap nt con arounds + = let checkAround (ident,expr) (as,errs) + = if ident `Map.member` as + then (Map.update (\vs -> Just (vs ++ [expr])) ident as, errs) + else case lookup ident fields of + Just (NT _ _ _) -> (Map.insert ident [expr] as, errs) + _ -> (as, ((Seq.<|)) (UndefChild nt con ident) errs) + fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fieldMap) + in foldr checkAround (Map.empty, Seq.empty) arounds + +checkMerges :: Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [Identifier]) -> DataTypes -> NontermIdent -> ConstructorIdent -> [MergeInfo] -> MergesAndErrors +checkMerges allNts allInsts fieldMap nt con merges + = let checkMerge (target,nt,sources,expr) (m,errs) + = let fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fieldMap) + insts = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allInsts) + allFields = insts ++ map fst fields -- note: sources of merge may not contain a target (for simplicity) + in if target `Map.member` m -- check for duplicate with self + then (m, DupChild nt con target (fst $ Map.elemAt (Map.findIndex target m) m) Seq.<| errs) + else if target `elem` allFields + then (m, DupChild nt con target (head $ filter (== target) allFields) Seq.<| errs) + else let missing = filter (\s -> not (s `elem` allFields)) sources + in if null missing + then if nt `Set.member` allNts -- check if the nonterm is defined + then (Map.insert target (nt, sources, expr) m, errs) -- all ok.. + else (m, UndefNont nt Seq.<| errs) + else (m, (Seq.fromList $ map (UndefChild nt con) missing) Seq.>< errs) + in foldr checkMerge (Map.empty, Seq.empty) merges + +unionunionplusplus = Map.unionWith (Map.unionWith (++)) +{-# LINE 272 "dist/build/Transform.hs" #-} + +{-# LINE 511 "./src-ag/Transform.ag" #-} + +mkUniqueRules :: Options -> Map NontermIdent (Map ConstructorIdent [RuleInfo]) -> DataTypes -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> Map NontermIdent (Attributes,Attributes) -> NontermIdent -> ConstructorIdent -> Map Identifier Identifier -> [Rule] +mkUniqueRules opts allRules allFields allInsts allAttrDecls nt con usMap + = map apply groups + where + fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allFields) + ++ Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allInsts) + -- may have duplicates + + attrDefs = let projectDefs (_,_,_,defs,_,_,_,_) = defs + in concatMap projectDefs $ Map.findWithDefault [] con $ Map.findWithDefault Map.empty nt allRules + + groups = Map.assocs $ Map.foldrWithKey (\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 locs = filter (not . existsLoc) locAttrs + outAttr = attr outFld ref + defs = (if hasOut then [] else [outAttr]) ++ [attr _LOC u | u <- locs ] + pat = Product noPos defs + rhs = Expression noPos $ wrap ref $ foldr gencase (finalout hasOut locs) locs + -- [HsToken ("mkUniques" ++ show (length locAttrs) ++ " ") noPos, AGField _LHS ref noPos Nothing] + rul = Rule Nothing pat rhs False "-- generated by the unique rule mechanism." False True False Nothing False + hasOut = exists outAttr + exists (Alias fld a _) = (fld,a) `elem` attrDefs + existsLoc nm = exists (attr _LOC nm) + in rul + 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 noGenCont us = h ("(" ++ concat (intersperse "," ( (if noGenCont then [] else ["__cont"]) ++ map getName us)) ++ ")") + wrap ref inp = h "let __cont = " ++ [AGField _LHS ref noPos Nothing] ++ h " in seq __cont ( " ++ inp ++ h " )" +{-# LINE 311 "dist/build/Transform.hs" #-} + +{-# LINE 746 "./src-ag/Transform.ag" #-} + +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 +{-# LINE 336 "dist/build/Transform.hs" #-} + +{-# LINE 872 "./src-ag/Transform.ag" #-} + +extract s = case dropWhile isSeparator s of + "" -> [] + s' -> w : extract s'' + where (w, s'') = break isSeparator s' +isSeparator x = x == '_' +{-# LINE 345 "dist/build/Transform.hs" #-} + +{-# LINE 896 "./src-ag/Transform.ag" #-} + +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) +{-# LINE 354 "dist/build/Transform.hs" #-} + +{-# LINE 928 "./src-ag/Transform.ag" #-} + +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) +{-# LINE 363 "dist/build/Transform.hs" #-} + +{-# LINE 954 "./src-ag/Transform.ag" #-} + +mergeParams :: ParamMap -> ParamMap -> ParamMap +mergeParams = Map.unionWith (++) +{-# LINE 369 "dist/build/Transform.hs" #-} + +{-# LINE 977 "./src-ag/Transform.ag" #-} + +mergeCtx :: ContextMap -> ContextMap -> ContextMap +mergeCtx + = Map.unionWith nubconcat + where nubconcat a b = nub (a ++ b) +{-# LINE 377 "dist/build/Transform.hs" #-} + +{-# LINE 996 "./src-ag/Transform.ag" #-} + +mergeQuant :: QuantMap -> QuantMap -> QuantMap +mergeQuant = Map.unionWith (++) +{-# LINE 383 "dist/build/Transform.hs" #-} + +{-# LINE 1007 "./src-ag/Transform.ag" #-} + +mergeDerivings m1 m2 = foldr (\(n,cs) m -> Map.insertWith Set.union n cs m) m2 (Map.toList m1) +{-# LINE 388 "dist/build/Transform.hs" #-} + +{-# LINE 1018 "./src-ag/Transform.ag" #-} + +merge x y = foldr f y (Map.toList x) + where f ~(k,v) m = Map.insertWith (Map.union) k v m +{-# LINE 394 "dist/build/Transform.hs" #-} + +{-# LINE 1060 "./src-ag/Transform.ag" #-} + +checkAttrs allFields nts inherited synthesized decls = foldErrors check decls nts where + check nt decls | not (nt `Map.member` allFields) = (decls,Seq.singleton(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) +{-# LINE 404 "dist/build/Transform.hs" #-} + +{-# LINE 1071 "./src-ag/Transform.ag" #-} + +addSelf name atMap = let (eInh,eSyn) = Map.findWithDefault(Map.empty,Map.empty) name atMap + in Map.insert name (eInh, Map.insert (Ident "self" noPos) Self eSyn)atMap +{-# LINE 410 "dist/build/Transform.hs" #-} + +{-# LINE 1212 "./src-ag/Transform.ag" #-} + +makeType :: Set NontermIdent -> Type -> Type +makeType nts tp@(NT x _ _) | Set.member x nts = tp + | otherwise = Haskell (typeToHaskellString Nothing [] tp) +makeType _ tp = tp +{-# LINE 418 "dist/build/Transform.hs" #-} + +{-# LINE 1218 "./src-ag/Transform.ag" #-} + +constructGrammar :: Set NontermIdent + -> ParamMap + -> Map NontermIdent (Map ConstructorIdent (Set Identifier)) + -> DataTypes + -> Map NontermIdent [ConstructorIdent] + -> Map NontermIdent (Map ConstructorIdent [Type]) + -> 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 + -> QuantMap + -> UniqueMap + -> Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + -> Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + -> Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) + -> Map NontermIdent (Map ConstructorIdent MaybeMacro) + -> Grammar + +constructGrammar nts ntParams prodParams gram prodOrder constraints attrs uses derivings wrappers allrules tsigs allinsts tsyns pragmaMap orderMap contextMap quantMap uniqueMap augmentsMap aroundsMap mergeMap macros = + let gr = [ (nt,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 + mergemap = Map.findWithDefault Map.empty nt mergeMap + macromap = Map.findWithDefault Map.empty nt macros + csmap = Map.findWithDefault Map.empty nt constraints + psmap = Map.findWithDefault Map.empty nt prodParams + prs = Map.findWithDefault [] nt prodOrder + alt con = + let flds = Map.findWithDefault [] con alts + rules = Map.findWithDefault [] con rmap + tsigs = Map.findWithDefault [] con tsmap + insts = Map.findWithDefault [] con instsmap + merges = [ (n, NT t [] False) | (n, (t, _, _)) <- Map.assocs $ maybe Map.empty id (Map.lookup con mergemap) ] + cs = Map.findWithDefault [] con csmap + ps = Set.elems $ Map.findWithDefault Set.empty con psmap + mbMacro = Map.findWithDefault Nothing con macromap + + -- important: keep order of children + cldrn = map child (flds ++ filter (not . existsAsField) insts ++ merges) + child (nm, tp) = + let tpI = if existsAsInst nm + then fromJust $ lookup nm insts + else tp + virt = if existsAsInst nm + then case lookup nm flds of + Just tp' -> ChildReplace tp' + Nothing -> ChildAttr + else if existsAsMerge nm + then ChildAttr + else ChildSyntax + in Child nm tpI virt + existsAsInst nm = maybe False (const True) (lookup nm insts) + existsAsField (nm,_) = maybe False (const True) (lookup nm flds) + existsAsMerge nm = maybe False (const True) (lookup nm merges) + in Production con ps cs cldrn rules tsigs mbMacro + in Nonterminal nt params inh syn (map alt prs) + in Grammar tsyns uses derivings wrappers nonts pragmaMap orderMap ntParams contextMap quantMap uniqueMap augmentsMap aroundsMap mergeMap +{-# LINE 490 "dist/build/Transform.hs" #-} + +{-# LINE 1289 "./src-ag/Transform.ag" #-} + +mapUnionWithSetUnion = Map.unionWith Set.union +mapUnionWithPlusPlus = Map.unionWith (++) +{-# LINE 496 "dist/build/Transform.hs" #-} +-- AG ---------------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + agi : (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, 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 prodOrder : _ + local allFields : _ + local allConstraints : _ + local allConParams : _ + local allConstrs : _ + local allRules : _ + local allSigs : _ + local allInsts : _ + local allUniques : _ + local allAugments : _ + local allArounds : _ + local allMerges : _ + local augmentSigs : _ + local allRulesErrs : _ + local allNamesErrs : _ + local allSigsErrs : _ + local allInstsErrs : _ + local allUniquesErrs : _ + local allAugmentErrs : _ + local allAroundsErrs : _ + local allMergesErrs : _ + local checkedRulesPre : _ + local checkedSigs : _ + local checkedInsts : _ + local checkedUniques : _ + local checkedAugments : _ + local checkedArounds : _ + local checkedRules : _ + local checkedMerges : _ + local errs1 : _ + local errs2 : _ + local errs3 : _ + local errs4 : _ + local errs5 : _ + local errs6 : _ + local errs7 : _ + local errs8 : _ + local errs9 : _ + local errs10 : _ + local errs11 : _ + local allNonterminals : _ + local allAttrDecls : _ + local allMacros : _ + local allAttrs : _ +-} +-- cata +sem_AG :: AG -> + T_AG +sem_AG (AG _elems) = + (sem_AG_AG (sem_Elems _elems)) +-- semantic domain +newtype T_AG = T_AG (Options -> + ( ((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))),Blocks,(Seq Error),(Maybe (String,String,String)),Grammar,(Options -> Options))) +data Inh_AG = Inh_AG {options_Inh_AG :: !(Options)} +data Syn_AG = Syn_AG {agi_Syn_AG :: !(((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes)))),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 -> + Inh_AG -> + Syn_AG +wrap_AG (T_AG sem) (Inh_AG _lhsIoptions) = + (let ( _lhsOagi,_lhsOblocks,_lhsOerrors,_lhsOmoduleDecl,_lhsOoutput,_lhsOpragmas) = sem _lhsIoptions + in (Syn_AG _lhsOagi _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)) + _lhsOagi :: ((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) + _elemsOattrs :: (Map NontermIdent (Attributes, Attributes)) + _lhsOblocks :: Blocks + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOpragmas :: (Options -> Options) + _elemsOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _elemsOallAttrs :: (Map NontermIdent (Attributes, Attributes)) + _elemsOallFields :: DataTypes + _elemsOallNonterminals :: (Set NontermIdent) + _elemsOoptions :: Options + _elemsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _elemsIattrOrderCollect :: AttrOrderMap + _elemsIattrs :: (Map NontermIdent (Attributes, Attributes)) + _elemsIblocks :: Blocks + _elemsIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _elemsIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _elemsIcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _elemsIcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _elemsIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _elemsIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _elemsIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _elemsIcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _elemsIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _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) + _elemsIquantCollect :: QuantMap + _elemsIsemPragmasCollect :: PragmaMap + _elemsItypeSyns :: TypeSyns + _elemsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _elemsIwrappers :: (Set NontermIdent) + -- "./src-ag/Transform.ag"(line 53, column 8) + _lhsOoutput = + ({-# LINE 53 "./src-ag/Transform.ag" #-} + constructGrammar _allNonterminals + _elemsIparamsCollect + _allConParams + _allFields + _prodOrder + _allConstraints + _allAttrDecls + _elemsIuseMap + _elemsIderivings + (if wrappers _lhsIoptions then _allNonterminals else _elemsIwrappers) + _checkedRules + _checkedSigs + _checkedInsts + _elemsItypeSyns + _elemsIsemPragmasCollect + _elemsIattrOrderCollect + _elemsIctxCollect + _elemsIquantCollect + _checkedUniques + _checkedAugments + _checkedArounds + _checkedMerges + _allMacros + {-# LINE 650 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 260, column 10) + _prodOrder = + ({-# LINE 260 "./src-ag/Transform.ag" #-} + let f (nt,con,fm) = Map.insertWith g nt [con] + g [con] lst | con `elem` lst = lst + | otherwise = con : lst + in foldr f Map.empty _elemsIcollectedFields + {-# LINE 659 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 264, column 10) + _allFields = + ({-# LINE 264 "./src-ag/Transform.ag" #-} + let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm) + in foldr f (Map.empty) _elemsIcollectedFields + {-# LINE 666 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 267, column 10) + _allConstraints = + ({-# LINE 267 "./src-ag/Transform.ag" #-} + let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm) + in foldr f (Map.empty) _elemsIcollectedConstraints + {-# LINE 673 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 270, column 10) + _allConParams = + ({-# LINE 270 "./src-ag/Transform.ag" #-} + let f (nt,con,fm) = Map.insertWith (Map.unionWith Set.union) nt (Map.singleton con fm) + in foldr f (Map.empty) _elemsIcollectedConParams + {-# LINE 680 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 273, column 10) + _allConstrs = + ({-# LINE 273 "./src-ag/Transform.ag" #-} + let f (nt,con,_) = Map.insertWith (++) nt [con] + in foldr f (Map.empty) _elemsIcollectedFields + {-# LINE 687 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 276, column 10) + _allRules = + ({-# LINE 276 "./src-ag/Transform.ag" #-} + let f (nt,con,r) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [r]) + in foldr f (Map.empty) _elemsIcollectedRules + {-# LINE 694 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 279, column 10) + _allSigs = + ({-# LINE 279 "./src-ag/Transform.ag" #-} + 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 ] + ) + {-# LINE 704 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 285, column 10) + _allInsts = + ({-# LINE 285 "./src-ag/Transform.ag" #-} + let f (nt,con,is) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con is) + in foldr f (Map.empty) _elemsIcollectedInsts + {-# LINE 711 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 288, column 10) + _allUniques = + ({-# LINE 288 "./src-ag/Transform.ag" #-} + let f (nt,con,us) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con us) + in foldr f (Map.empty) _elemsIcollectedUniques + {-# LINE 718 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 290, column 10) + _allAugments = + ({-# LINE 290 "./src-ag/Transform.ag" #-} + let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as) + in foldr f Map.empty _elemsIcollectedAugments + {-# LINE 725 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 292, column 10) + _allArounds = + ({-# LINE 292 "./src-ag/Transform.ag" #-} + let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as) + in foldr f Map.empty _elemsIcollectedArounds + {-# LINE 732 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 294, column 10) + _allMerges = + ({-# LINE 294 "./src-ag/Transform.ag" #-} + let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as) + in foldr f Map.empty _elemsIcollectedMerges + {-# LINE 739 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 297, column 10) + _augmentSigs = + ({-# LINE 297 "./src-ag/Transform.ag" #-} + let gen mp = [] + in Map.map (Map.map gen) _allAugments + {-# LINE 746 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 300, column 10) + _allRulesErrs = + ({-# LINE 300 "./src-ag/Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . (checkRules _allAttrDecls _allFields _allInsts _allSigs _allMerges )) _allRules + {-# LINE 752 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 301, column 10) + _allNamesErrs = + ({-# LINE 301 "./src-ag/Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . checkRuleNames) _allRules + {-# LINE 758 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 302, column 10) + _allSigsErrs = + ({-# LINE 302 "./src-ag/Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . (checkSigs )) _allSigs + {-# LINE 764 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 303, column 10) + _allInstsErrs = + ({-# LINE 303 "./src-ag/Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . (checkInsts _allNonterminals _allSigs _allFields )) _allInsts + {-# LINE 770 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 304, column 10) + _allUniquesErrs = + ({-# LINE 304 "./src-ag/Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . (checkUniques _allAttrDecls )) _allUniques + {-# LINE 776 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 305, column 10) + _allAugmentErrs = + ({-# LINE 305 "./src-ag/Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . (checkAugments _allAttrDecls )) _allAugments + {-# LINE 782 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 306, column 10) + _allAroundsErrs = + ({-# LINE 306 "./src-ag/Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . (checkArounds _allFields )) _allArounds + {-# LINE 788 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 307, column 10) + _allMergesErrs = + ({-# LINE 307 "./src-ag/Transform.ag" #-} + Map.mapWithKey (Map.mapWithKey . (checkMerges _allNonterminals _allInsts _allFields )) _allMerges + {-# LINE 794 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 309, column 10) + _checkedRulesPre = + ({-# LINE 309 "./src-ag/Transform.ag" #-} + Map.map (Map.map fst) _allRulesErrs + {-# LINE 800 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 310, column 10) + _checkedSigs = + ({-# LINE 310 "./src-ag/Transform.ag" #-} + Map.map (Map.map fst) _allSigsErrs `unionunionplusplus` _augmentSigs + {-# LINE 806 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 311, column 10) + _checkedInsts = + ({-# LINE 311 "./src-ag/Transform.ag" #-} + Map.map (Map.map fst) _allInstsErrs + {-# LINE 812 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 312, column 10) + _checkedUniques = + ({-# LINE 312 "./src-ag/Transform.ag" #-} + Map.map (Map.map fst) _allUniquesErrs + {-# LINE 818 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 313, column 10) + _checkedAugments = + ({-# LINE 313 "./src-ag/Transform.ag" #-} + Map.map (Map.map fst) _allAugmentErrs + {-# LINE 824 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 314, column 10) + _checkedArounds = + ({-# LINE 314 "./src-ag/Transform.ag" #-} + Map.map (Map.map fst) _allAroundsErrs + {-# LINE 830 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 315, column 10) + _checkedRules = + ({-# LINE 315 "./src-ag/Transform.ag" #-} + Map.unionWith (Map.unionWith (++)) _checkedRulesPre (Map.mapWithKey (Map.mapWithKey . (mkUniqueRules _lhsIoptions _allRules _allFields _checkedInsts _allAttrDecls )) _checkedUniques ) + {-# LINE 836 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 316, column 10) + _checkedMerges = + ({-# LINE 316 "./src-ag/Transform.ag" #-} + Map.map (Map.map fst) _allMergesErrs + {-# LINE 842 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 318, column 10) + _errs1 = + ({-# LINE 318 "./src-ag/Transform.ag" #-} + let f = checkForDuplicates (DupSynonym) + in Seq.fromList . f . map fst $ _elemsItypeSyns + {-# LINE 849 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 321, column 10) + _errs2 = + ({-# LINE 321 "./src-ag/Transform.ag" #-} + 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 + {-# LINE 857 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 325, column 10) + _errs3 = + ({-# LINE 325 "./src-ag/Transform.ag" #-} + let f (nt,cons) = checkForDuplicates (DupAlt nt) cons + in Seq.empty + {-# LINE 864 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 329, column 10) + _errs4 = + ({-# LINE 329 "./src-ag/Transform.ag" #-} + let f m s = Map.fold ((><) . snd) s m + in Map.fold f Seq.empty _allRulesErrs + {-# LINE 871 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 332, column 10) + _errs5 = + ({-# LINE 332 "./src-ag/Transform.ag" #-} + let f m s = Map.fold ((><) . snd) s m + in Map.fold f Seq.empty _allSigsErrs + {-# LINE 878 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 335, column 10) + _errs6 = + ({-# LINE 335 "./src-ag/Transform.ag" #-} + let f m s = Map.fold ((><) . snd) s m + in Map.fold f Seq.empty _allInstsErrs + {-# LINE 885 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 338, column 10) + _errs7 = + ({-# LINE 338 "./src-ag/Transform.ag" #-} + let f m s = Map.fold ((><) . snd) s m + in Map.fold f Seq.empty _allUniquesErrs + {-# LINE 892 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 341, column 10) + _errs8 = + ({-# LINE 341 "./src-ag/Transform.ag" #-} + let f m s = Map.fold ((><) . snd) s m + in Map.fold f Seq.empty _allAugmentErrs + {-# LINE 899 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 344, column 10) + _errs9 = + ({-# LINE 344 "./src-ag/Transform.ag" #-} + let f m s = Map.fold ((><) . snd) s m + in Map.fold f Seq.empty _allAroundsErrs + {-# LINE 906 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 347, column 10) + _errs10 = + ({-# LINE 347 "./src-ag/Transform.ag" #-} + let f m s = Map.fold ((><)) s m + in Map.fold f Seq.empty _allNamesErrs + {-# LINE 913 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 350, column 10) + _errs11 = + ({-# LINE 350 "./src-ag/Transform.ag" #-} + let f m s = Map.fold ((><) . snd) s m + in Map.fold f Seq.empty _allMergesErrs + {-# LINE 920 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 353, column 10) + _lhsOerrors = + ({-# LINE 353 "./src-ag/Transform.ag" #-} + _elemsIerrors >< _errs1 >< _errs2 >< _errs3 >< _errs4 >< _errs5 >< _errs6 >< _errs7 >< _errs8 >< _errs9 >< _errs10 >< _errs11 + {-# LINE 926 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 605, column 10) + _allNonterminals = + ({-# LINE 605 "./src-ag/Transform.ag" #-} + _elemsIcollectedNames `Set.difference` _elemsIcollectedSetNames + {-# LINE 932 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 625, column 8) + _elemsOallConstructors = + ({-# LINE 625 "./src-ag/Transform.ag" #-} + _elemsIcollectedConstructorsMap + {-# LINE 938 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 708, column 8) + _elemsOdefSets = + ({-# LINE 708 "./src-ag/Transform.ag" #-} + Map.fromList (map (\x->(x,(Set.singleton x, Set.empty))) (Set.toList _allNonterminals )) + {-# LINE 944 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 709, column 8) + _elemsOdefinedSets = + ({-# LINE 709 "./src-ag/Transform.ag" #-} + Map.map fst _elemsIdefSets + {-# LINE 950 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1024, column 8) + _elemsOattrDecls = + ({-# LINE 1024 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 956 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1078, column 9) + _allAttrDecls = + ({-# LINE 1078 "./src-ag/Transform.ag" #-} + if withSelf _lhsIoptions + then foldr addSelf _elemsIattrDecls (Set.toList _allNonterminals ) + else _elemsIattrDecls + {-# LINE 964 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1314, column 10) + _allMacros = + ({-# LINE 1314 "./src-ag/Transform.ag" #-} + let f (nt,con,m) = Map.insertWith (Map.union) nt (Map.singleton con m) + in foldr f (Map.empty) _elemsIcollectedMacros + {-# LINE 971 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1327, column 8) + _lhsOagi = + ({-# LINE 1327 "./src-ag/Transform.ag" #-} + (_allNonterminals ,_allFields ,_allAttrs ) + {-# LINE 977 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1329, column 8) + _allAttrs = + ({-# LINE 1329 "./src-ag/Transform.ag" #-} + if withSelf _lhsIoptions + then foldr addSelf _elemsIattrs (Set.toList _allNonterminals ) + else _elemsIattrs + {-# LINE 985 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1337, column 9) + _elemsOattrs = + ({-# LINE 1337 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 991 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 46, column 19) + _lhsOblocks = + ({-# LINE 46 "./src-ag/Transform.ag" #-} + _elemsIblocks + {-# LINE 997 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1202, column 37) + _lhsOmoduleDecl = + ({-# LINE 1202 "./src-ag/Transform.ag" #-} + _elemsImoduleDecl + {-# LINE 1003 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 801, column 34) + _lhsOpragmas = + ({-# LINE 801 "./src-ag/Transform.ag" #-} + _elemsIpragmas + {-# LINE 1009 "dist/build/Transform.hs" #-} + ) + -- copy rule (from local) + _elemsOallAttrDecls = + ({-# LINE 909 "./src-ag/Transform.ag" #-} + _allAttrDecls + {-# LINE 1015 "dist/build/Transform.hs" #-} + ) + -- copy rule (from local) + _elemsOallAttrs = + ({-# LINE 1324 "./src-ag/Transform.ag" #-} + _allAttrs + {-# LINE 1021 "dist/build/Transform.hs" #-} + ) + -- copy rule (from local) + _elemsOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _allFields + {-# LINE 1027 "dist/build/Transform.hs" #-} + ) + -- copy rule (from local) + _elemsOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _allNonterminals + {-# LINE 1033 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _elemsOoptions = + ({-# LINE 40 "./src-ag/Transform.ag" #-} + _lhsIoptions + {-# LINE 1039 "dist/build/Transform.hs" #-} + ) + ( _elemsIattrDecls,_elemsIattrOrderCollect,_elemsIattrs,_elemsIblocks,_elemsIcollectedArounds,_elemsIcollectedAugments,_elemsIcollectedConParams,_elemsIcollectedConstraints,_elemsIcollectedConstructorsMap,_elemsIcollectedFields,_elemsIcollectedInsts,_elemsIcollectedMacros,_elemsIcollectedMerges,_elemsIcollectedNames,_elemsIcollectedRules,_elemsIcollectedSetNames,_elemsIcollectedSigs,_elemsIcollectedUniques,_elemsIctxCollect,_elemsIdefSets,_elemsIderivings,_elemsIerrors,_elemsImoduleDecl,_elemsIparamsCollect,_elemsIpragmas,_elemsIquantCollect,_elemsIsemPragmasCollect,_elemsItypeSyns,_elemsIuseMap,_elemsIwrappers) = + elems_ _elemsOallAttrDecls _elemsOallAttrs _elemsOallConstructors _elemsOallFields _elemsOallNonterminals _elemsOattrDecls _elemsOattrs _elemsOdefSets _elemsOdefinedSets _elemsOoptions + in ( _lhsOagi,_lhsOblocks,_lhsOerrors,_lhsOmoduleDecl,_lhsOoutput,_lhsOpragmas)))) +-- Alt --------------------------------------------------------- +{- + visit 0: + inherited attributes: + allConstructors : Map NontermIdent (Set ConstructorIdent) + allNonterminals : Set NontermIdent + nts : Set NontermIdent + synthesized attributes: + collectedConParams : [(NontermIdent, ConstructorIdent, Set Identifier)] + collectedConstraints : [(NontermIdent, ConstructorIdent, [Type])] + collectedConstructorNames : Set ConstructorIdent + collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] + collectedMacros : [(NontermIdent, ConstructorIdent, MaybeMacro)] + alternatives: + alternative Alt: + child pos : {Pos} + child names : ConstructorSet + child tyvars : {[Identifier]} + child fields : Fields + child macro : {MaybeMacro} +-} +-- cata +sem_Alt :: Alt -> + T_Alt +sem_Alt (Alt _pos _names _tyvars _fields _macro) = + (sem_Alt_Alt _pos (sem_ConstructorSet _names) _tyvars (sem_Fields _fields) _macro) +-- semantic domain +newtype T_Alt = T_Alt ((Map NontermIdent (Set ConstructorIdent)) -> + (Set NontermIdent) -> + (Set NontermIdent) -> + ( ([(NontermIdent, ConstructorIdent, Set Identifier)]),([(NontermIdent, ConstructorIdent, [Type])]),(Set ConstructorIdent),([(NontermIdent, ConstructorIdent, FieldMap)]),([(NontermIdent, ConstructorIdent, MaybeMacro)]))) +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 {collectedConParams_Syn_Alt :: !(([(NontermIdent, ConstructorIdent, Set Identifier)])),collectedConstraints_Syn_Alt :: !(([(NontermIdent, ConstructorIdent, [Type])])),collectedConstructorNames_Syn_Alt :: !((Set ConstructorIdent)),collectedFields_Syn_Alt :: !(([(NontermIdent, ConstructorIdent, FieldMap)])),collectedMacros_Syn_Alt :: !(([(NontermIdent, ConstructorIdent, MaybeMacro)]))} +wrap_Alt :: T_Alt -> + Inh_Alt -> + Syn_Alt +wrap_Alt (T_Alt sem) (Inh_Alt _lhsIallConstructors _lhsIallNonterminals _lhsInts) = + (let ( _lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorNames,_lhsOcollectedFields,_lhsOcollectedMacros) = sem _lhsIallConstructors _lhsIallNonterminals _lhsInts + in (Syn_Alt _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorNames _lhsOcollectedFields _lhsOcollectedMacros)) +sem_Alt_Alt :: Pos -> + T_ConstructorSet -> + ([Identifier]) -> + T_Fields -> + MaybeMacro -> + T_Alt +sem_Alt_Alt pos_ (T_ConstructorSet names_) tyvars_ (T_Fields fields_) macro_ = + (T_Alt (\ _lhsIallConstructors + _lhsIallNonterminals + _lhsInts -> + (let _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _fieldsOallNonterminals :: (Set NontermIdent) + _namesIcollectedConstructorNames :: (Set ConstructorIdent) + _namesIconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _namesIerrors :: (Seq Error) + _fieldsIcollectedConstraints :: ([Type]) + _fieldsIcollectedFields :: ([(Identifier, Type)]) + -- "./src-ag/Transform.ag"(line 242, column 10) + _lhsOcollectedFields = + ({-# LINE 242 "./src-ag/Transform.ag" #-} + [ (nt, con, _fieldsIcollectedFields) + | nt <- Set.toList _lhsInts + , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) + ] + {-# LINE 1111 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 246, column 10) + _lhsOcollectedConstraints = + ({-# LINE 246 "./src-ag/Transform.ag" #-} + [ (nt, con, _fieldsIcollectedConstraints) + | nt <- Set.toList _lhsInts + , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) + ] + {-# LINE 1120 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 250, column 10) + _lhsOcollectedConParams = + ({-# LINE 250 "./src-ag/Transform.ag" #-} + [ (nt, con, Set.fromList tyvars_) + | nt <- Set.toList _lhsInts + , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) + ] + {-# LINE 1129 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1305, column 10) + _lhsOcollectedMacros = + ({-# LINE 1305 "./src-ag/Transform.ag" #-} + [ (nt, con, macro_) + | nt <- Set.toList _lhsInts + , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) + ] + {-# LINE 1138 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 99, column 62) + _lhsOcollectedConstructorNames = + ({-# LINE 99 "./src-ag/Transform.ag" #-} + _namesIcollectedConstructorNames + {-# LINE 1144 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _fieldsOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 1150 "dist/build/Transform.hs" #-} + ) + ( _namesIcollectedConstructorNames,_namesIconstructors,_namesIerrors) = + names_ + ( _fieldsIcollectedConstraints,_fieldsIcollectedFields) = + fields_ _fieldsOallNonterminals + in ( _lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorNames,_lhsOcollectedFields,_lhsOcollectedMacros)))) +-- Alts -------------------------------------------------------- +{- + visit 0: + inherited attributes: + allConstructors : Map NontermIdent (Set ConstructorIdent) + allNonterminals : Set NontermIdent + nts : Set NontermIdent + synthesized attributes: + collectedConParams : [(NontermIdent, ConstructorIdent, Set Identifier)] + collectedConstraints : [(NontermIdent, ConstructorIdent, [Type])] + collectedConstructorNames : Set ConstructorIdent + collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] + collectedMacros : [(NontermIdent, ConstructorIdent, MaybeMacro)] + 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) -> + ( ([(NontermIdent, ConstructorIdent, Set Identifier)]),([(NontermIdent, ConstructorIdent, [Type])]),(Set ConstructorIdent),([(NontermIdent, ConstructorIdent, FieldMap)]),([(NontermIdent, ConstructorIdent, MaybeMacro)]))) +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 {collectedConParams_Syn_Alts :: !(([(NontermIdent, ConstructorIdent, Set Identifier)])),collectedConstraints_Syn_Alts :: !(([(NontermIdent, ConstructorIdent, [Type])])),collectedConstructorNames_Syn_Alts :: !((Set ConstructorIdent)),collectedFields_Syn_Alts :: !(([(NontermIdent, ConstructorIdent, FieldMap)])),collectedMacros_Syn_Alts :: !(([(NontermIdent, ConstructorIdent, MaybeMacro)]))} +wrap_Alts :: T_Alts -> + Inh_Alts -> + Syn_Alts +wrap_Alts (T_Alts sem) (Inh_Alts _lhsIallConstructors _lhsIallNonterminals _lhsInts) = + (let ( _lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorNames,_lhsOcollectedFields,_lhsOcollectedMacros) = sem _lhsIallConstructors _lhsIallNonterminals _lhsInts + in (Syn_Alts _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorNames _lhsOcollectedFields _lhsOcollectedMacros)) +sem_Alts_Cons :: T_Alt -> + T_Alts -> + T_Alts +sem_Alts_Cons (T_Alt hd_) (T_Alts tl_) = + (T_Alts (\ _lhsIallConstructors + _lhsIallNonterminals + _lhsInts -> + (let _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _hdOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _hdOallNonterminals :: (Set NontermIdent) + _hdOnts :: (Set NontermIdent) + _tlOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _tlOallNonterminals :: (Set NontermIdent) + _tlOnts :: (Set NontermIdent) + _hdIcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _hdIcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _hdIcollectedConstructorNames :: (Set ConstructorIdent) + _hdIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _hdIcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _tlIcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _tlIcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _tlIcollectedConstructorNames :: (Set ConstructorIdent) + _tlIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _tlIcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + -- use rule "./src-ag/Transform.ag"(line 133, column 31) + _lhsOcollectedConParams = + ({-# LINE 133 "./src-ag/Transform.ag" #-} + _hdIcollectedConParams ++ _tlIcollectedConParams + {-# LINE 1226 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 132, column 33) + _lhsOcollectedConstraints = + ({-# LINE 132 "./src-ag/Transform.ag" #-} + _hdIcollectedConstraints ++ _tlIcollectedConstraints + {-# LINE 1232 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 99, column 62) + _lhsOcollectedConstructorNames = + ({-# LINE 99 "./src-ag/Transform.ag" #-} + _hdIcollectedConstructorNames `Set.union` _tlIcollectedConstructorNames + {-# LINE 1238 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 131, column 28) + _lhsOcollectedFields = + ({-# LINE 131 "./src-ag/Transform.ag" #-} + _hdIcollectedFields ++ _tlIcollectedFields + {-# LINE 1244 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1301, column 28) + _lhsOcollectedMacros = + ({-# LINE 1301 "./src-ag/Transform.ag" #-} + _hdIcollectedMacros ++ _tlIcollectedMacros + {-# LINE 1250 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOallConstructors = + ({-# LINE 102 "./src-ag/Transform.ag" #-} + _lhsIallConstructors + {-# LINE 1256 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 1262 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOnts = + ({-# LINE 176 "./src-ag/Transform.ag" #-} + _lhsInts + {-# LINE 1268 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOallConstructors = + ({-# LINE 102 "./src-ag/Transform.ag" #-} + _lhsIallConstructors + {-# LINE 1274 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 1280 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOnts = + ({-# LINE 176 "./src-ag/Transform.ag" #-} + _lhsInts + {-# LINE 1286 "dist/build/Transform.hs" #-} + ) + ( _hdIcollectedConParams,_hdIcollectedConstraints,_hdIcollectedConstructorNames,_hdIcollectedFields,_hdIcollectedMacros) = + hd_ _hdOallConstructors _hdOallNonterminals _hdOnts + ( _tlIcollectedConParams,_tlIcollectedConstraints,_tlIcollectedConstructorNames,_tlIcollectedFields,_tlIcollectedMacros) = + tl_ _tlOallConstructors _tlOallNonterminals _tlOnts + in ( _lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorNames,_lhsOcollectedFields,_lhsOcollectedMacros)))) +sem_Alts_Nil :: T_Alts +sem_Alts_Nil = + (T_Alts (\ _lhsIallConstructors + _lhsIallNonterminals + _lhsInts -> + (let _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedConstructorNames :: (Set ConstructorIdent) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + -- use rule "./src-ag/Transform.ag"(line 133, column 31) + _lhsOcollectedConParams = + ({-# LINE 133 "./src-ag/Transform.ag" #-} + [] + {-# LINE 1307 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 132, column 33) + _lhsOcollectedConstraints = + ({-# LINE 132 "./src-ag/Transform.ag" #-} + [] + {-# LINE 1313 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 99, column 62) + _lhsOcollectedConstructorNames = + ({-# LINE 99 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 1319 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 131, column 28) + _lhsOcollectedFields = + ({-# LINE 131 "./src-ag/Transform.ag" #-} + [] + {-# LINE 1325 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1301, column 28) + _lhsOcollectedMacros = + ({-# LINE 1301 "./src-ag/Transform.ag" #-} + [] + {-# LINE 1331 "dist/build/Transform.hs" #-} + ) + in ( _lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorNames,_lhsOcollectedFields,_lhsOcollectedMacros)))) +-- Attrs ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allFields : DataTypes + allNonterminals : Set NontermIdent + nts : Set NontermIdent + options : Options + chained attributes: + attrDecls : Map NontermIdent (Attributes, Attributes) + attrs : 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 attrDecls : _ + local errors : _ + local inherited : _ + local synthesized : _ + local useMap : _ + local errors1 : _ +-} +-- 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)) -> + (Map NontermIdent (Attributes, Attributes)) -> + (Set NontermIdent) -> + Options -> + ( (Map NontermIdent (Attributes, Attributes)),(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))),attrs_Inh_Attrs :: !((Map NontermIdent (Attributes, Attributes))),nts_Inh_Attrs :: !((Set NontermIdent)),options_Inh_Attrs :: !(Options)} +data Syn_Attrs = Syn_Attrs {attrDecls_Syn_Attrs :: !((Map NontermIdent (Attributes, Attributes))),attrs_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 -> + Inh_Attrs -> + Syn_Attrs +wrap_Attrs (T_Attrs sem) (Inh_Attrs _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsInts _lhsIoptions) = + (let ( _lhsOattrDecls,_lhsOattrs,_lhsOerrors,_lhsOuseMap) = sem _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsInts _lhsIoptions + in (Syn_Attrs _lhsOattrDecls _lhsOattrs _lhsOerrors _lhsOuseMap)) +sem_Attrs_Attrs :: Pos -> + AttrNames -> + AttrNames -> + AttrNames -> + T_Attrs +sem_Attrs_Attrs pos_ inh_ chn_ syn_ = + (T_Attrs (\ _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIattrs + _lhsInts + _lhsIoptions -> + (let _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOerrors :: (Seq Error) + _lhsOattrs :: (Map NontermIdent (Attributes, Attributes)) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + -- "./src-ag/Transform.ag"(line 1033, column 15) + (_attrDecls,_errors) = + ({-# LINE 1033 "./src-ag/Transform.ag" #-} + checkAttrs _lhsIallFields (Set.toList _lhsInts) _inherited _synthesized _lhsIattrDecls + {-# LINE 1403 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1035, column 15) + (_inherited,_synthesized,_useMap) = + ({-# LINE 1035 "./src-ag/Transform.ag" #-} + 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))) + {-# LINE 1416 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1043, column 11) + _lhsOuseMap = + ({-# LINE 1043 "./src-ag/Transform.ag" #-} + Map.fromList (zip (Set.toList _lhsInts) (repeat _useMap)) + {-# LINE 1422 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1045, column 11) + _errors1 = + ({-# LINE 1045 "./src-ag/Transform.ag" #-} + if checkParseTy _lhsIoptions + then let attrs = inh_ ++ syn_ ++ chn_ + items = map (\(ident,tp,_) -> (getPos ident, tp)) attrs + errs = map check items + check (pos,Haskell s) = + let exp = Expression pos tks + tks = [tk] + tk = HsToken s pos + in Seq.fromList $ checkTy exp + check _ = Seq.empty + in foldr (Seq.><) Seq.empty errs + else Seq.empty + {-# LINE 1439 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1057, column 11) + _lhsOerrors = + ({-# LINE 1057 "./src-ag/Transform.ag" #-} + _errors Seq.>< _errors1 + {-# LINE 1445 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1341, column 11) + _lhsOattrs = + ({-# LINE 1341 "./src-ag/Transform.ag" #-} + let insert decls nt = if Map.member nt decls + then Map.update (\(inh,syn) -> Just ( Map.union inh $ Map.fromList _inherited + , Map.union syn $ Map.fromList _synthesized)) nt decls + else Map.insert nt (Map.fromList _inherited, Map.fromList _synthesized) decls + in foldl insert _lhsIattrs (Set.toList _lhsInts) + {-# LINE 1455 "dist/build/Transform.hs" #-} + ) + -- copy rule (from local) + _lhsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _attrDecls + {-# LINE 1461 "dist/build/Transform.hs" #-} + ) + in ( _lhsOattrDecls,_lhsOattrs,_lhsOerrors,_lhsOuseMap)))) +-- ConstructorSet ---------------------------------------------- +{- + visit 0: + synthesized attributes: + collectedConstructorNames : Set ConstructorIdent + constructors : (Set ConstructorIdent->Set ConstructorIdent) + errors : Seq Error + alternatives: + alternative CName: + child name : {ConstructorIdent} + alternative CUnion: + child set1 : ConstructorSet + child set2 : ConstructorSet + alternative CDifference: + child set1 : ConstructorSet + child set2 : ConstructorSet + alternative CAll: +-} +-- cata +sem_ConstructorSet :: ConstructorSet -> + T_ConstructorSet +sem_ConstructorSet (CName _name) = + (sem_ConstructorSet_CName _name) +sem_ConstructorSet (CUnion _set1 _set2) = + (sem_ConstructorSet_CUnion (sem_ConstructorSet _set1) (sem_ConstructorSet _set2)) +sem_ConstructorSet (CDifference _set1 _set2) = + (sem_ConstructorSet_CDifference (sem_ConstructorSet _set1) (sem_ConstructorSet _set2)) +sem_ConstructorSet (CAll) = + (sem_ConstructorSet_CAll) +-- 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 -> + Inh_ConstructorSet -> + Syn_ConstructorSet +wrap_ConstructorSet (T_ConstructorSet sem) (Inh_ConstructorSet) = + (let ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors) = sem + in (Syn_ConstructorSet _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) + -- "./src-ag/Transform.ag"(line 613, column 11) + _lhsOcollectedConstructorNames = + ({-# LINE 613 "./src-ag/Transform.ag" #-} + Set.singleton name_ + {-# LINE 1513 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 776, column 17) + _lhsOconstructors = + ({-# LINE 776 "./src-ag/Transform.ag" #-} + \ds -> Set.singleton name_ + {-# LINE 1519 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + Seq.empty + {-# LINE 1525 "dist/build/Transform.hs" #-} + ) + 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) + -- "./src-ag/Transform.ag"(line 777, column 17) + _lhsOconstructors = + ({-# LINE 777 "./src-ag/Transform.ag" #-} + \ds -> _set1Iconstructors ds `Set.union` _set2Iconstructors ds + {-# LINE 1545 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 99, column 62) + _lhsOcollectedConstructorNames = + ({-# LINE 99 "./src-ag/Transform.ag" #-} + _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames + {-# LINE 1551 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + _set1Ierrors Seq.>< _set2Ierrors + {-# LINE 1557 "dist/build/Transform.hs" #-} + ) + ( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) = + set1_ + ( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) = + set2_ + 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) + -- "./src-ag/Transform.ag"(line 778, column 17) + _lhsOconstructors = + ({-# LINE 778 "./src-ag/Transform.ag" #-} + \ds -> _set1Iconstructors ds `Set.difference` _set2Iconstructors ds + {-# LINE 1581 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 99, column 62) + _lhsOcollectedConstructorNames = + ({-# LINE 99 "./src-ag/Transform.ag" #-} + _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames + {-# LINE 1587 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + _set1Ierrors Seq.>< _set2Ierrors + {-# LINE 1593 "dist/build/Transform.hs" #-} + ) + ( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) = + set1_ + ( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) = + set2_ + in ( _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) + -- "./src-ag/Transform.ag"(line 779, column 17) + _lhsOconstructors = + ({-# LINE 779 "./src-ag/Transform.ag" #-} + \ds -> ds + {-# LINE 1609 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 99, column 62) + _lhsOcollectedConstructorNames = + ({-# LINE 99 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 1615 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + Seq.empty + {-# LINE 1621 "dist/build/Transform.hs" #-} + ) + in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors))) +-- Elem -------------------------------------------------------- +{- + visit 0: + inherited attributes: + allAttrDecls : Map NontermIdent (Attributes, Attributes) + allAttrs : Map NontermIdent (Attributes, Attributes) + allConstructors : Map NontermIdent (Set ConstructorIdent) + allFields : DataTypes + allNonterminals : Set NontermIdent + definedSets : DefinedSets + options : Options + chained attributes: + attrDecls : Map NontermIdent (Attributes, Attributes) + attrs : Map NontermIdent (Attributes, Attributes) + defSets : Map Identifier (Set NontermIdent,Set Identifier) + synthesized attributes: + attrOrderCollect : AttrOrderMap + blocks : Blocks + collectedArounds : [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] + collectedAugments : [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] + collectedConParams : [(NontermIdent, ConstructorIdent, Set Identifier)] + collectedConstraints : [(NontermIdent, ConstructorIdent, [Type])] + collectedConstructorsMap : Map NontermIdent (Set ConstructorIdent) + collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] + collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] + collectedMacros : [(NontermIdent, ConstructorIdent, MaybeMacro)] + collectedMerges : [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] + 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 + quantCollect : QuantMap + semPragmasCollect : PragmaMap + typeSyns : TypeSyns + useMap : Map NontermIdent (Map Identifier (String,String,String)) + wrappers : Set NontermIdent + alternatives: + alternative Data: + child pos : {Pos} + child ctx : {ClassContext} + child names : NontSet + child params : {[Identifier]} + child attrs : Attrs + child alts : Alts + child ext : {Bool} + alternative Type: + child pos : {Pos} + child ctx : {ClassContext} + child name : {NontermIdent} + child params : {[Identifier]} + child type : {ComplexType} + visit 0: + local expanded : _ + local argType : _ + alternative Attr: + child pos : {Pos} + child ctx : {ClassContext} + child names : NontSet + child quants : {[String]} + child attrs : Attrs + alternative Sem: + child pos : {Pos} + child ctx : {ClassContext} + child names : NontSet + child attrs : Attrs + child quants : {[String]} + child alts : SemAlts + alternative Txt: + child pos : {Pos} + child kind : {BlockKind} + child mbNt : {Maybe NontermIdent} + child lines : {[String]} + visit 0: + local blockInfo : _ + local blockValue : _ + alternative Set: + child pos : {Pos} + child name : {NontermIdent} + child merge : {Bool} + child set : NontSet + visit 0: + local defSets2 : _ + local errs : _ + alternative Deriving: + child pos : {Pos} + child set : NontSet + child classes : {[NontermIdent]} + alternative Wrapper: + child pos : {Pos} + child set : NontSet + alternative Nocatas: + child pos : {Pos} + child set : NontSet + alternative Pragma: + child pos : {Pos} + child names : {[NontermIdent]} + alternative Module: + child pos : {Pos} + child name : {String} + child exports : {String} + child imports : {String} +-} +-- cata +sem_Elem :: Elem -> + T_Elem +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 (Type _pos _ctx _name _params _type) = + (sem_Elem_Type _pos _ctx _name _params _type) +sem_Elem (Attr _pos _ctx _names _quants _attrs) = + (sem_Elem_Attr _pos _ctx (sem_NontSet _names) _quants (sem_Attrs _attrs)) +sem_Elem (Sem _pos _ctx _names _attrs _quants _alts) = + (sem_Elem_Sem _pos _ctx (sem_NontSet _names) (sem_Attrs _attrs) _quants (sem_SemAlts _alts)) +sem_Elem (Txt _pos _kind _mbNt _lines) = + (sem_Elem_Txt _pos _kind _mbNt _lines) +sem_Elem (Set _pos _name _merge _set) = + (sem_Elem_Set _pos _name _merge (sem_NontSet _set)) +sem_Elem (Deriving _pos _set _classes) = + (sem_Elem_Deriving _pos (sem_NontSet _set) _classes) +sem_Elem (Wrapper _pos _set) = + (sem_Elem_Wrapper _pos (sem_NontSet _set)) +sem_Elem (Nocatas _pos _set) = + (sem_Elem_Nocatas _pos (sem_NontSet _set)) +sem_Elem (Pragma _pos _names) = + (sem_Elem_Pragma _pos _names) +sem_Elem (Module _pos _name _exports _imports) = + (sem_Elem_Module _pos _name _exports _imports) +-- semantic domain +newtype T_Elem = T_Elem ((Map NontermIdent (Attributes, Attributes)) -> + (Map NontermIdent (Attributes, Attributes)) -> + (Map NontermIdent (Set ConstructorIdent)) -> + DataTypes -> + (Set NontermIdent) -> + (Map NontermIdent (Attributes, Attributes)) -> + (Map NontermIdent (Attributes, Attributes)) -> + (Map Identifier (Set NontermIdent,Set Identifier)) -> + DefinedSets -> + Options -> + ( (Map NontermIdent (Attributes, Attributes)),AttrOrderMap,(Map NontermIdent (Attributes, Attributes)),Blocks,([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]),([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]),([(NontermIdent, ConstructorIdent, Set Identifier)]),([(NontermIdent, ConstructorIdent, [Type])]),(Map NontermIdent (Set ConstructorIdent)),([(NontermIdent, ConstructorIdent, FieldMap)]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([(NontermIdent, ConstructorIdent, MaybeMacro)]),([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]),(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),QuantMap,PragmaMap,TypeSyns,(Map NontermIdent (Map Identifier (String,String,String))),(Set NontermIdent))) +data Inh_Elem = Inh_Elem {allAttrDecls_Inh_Elem :: !((Map NontermIdent (Attributes, Attributes))),allAttrs_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))),attrs_Inh_Elem :: !((Map NontermIdent (Attributes, Attributes))),defSets_Inh_Elem :: !((Map Identifier (Set NontermIdent,Set Identifier))),definedSets_Inh_Elem :: !(DefinedSets),options_Inh_Elem :: !(Options)} +data Syn_Elem = Syn_Elem {attrDecls_Syn_Elem :: !((Map NontermIdent (Attributes, Attributes))),attrOrderCollect_Syn_Elem :: !(AttrOrderMap),attrs_Syn_Elem :: !((Map NontermIdent (Attributes, Attributes))),blocks_Syn_Elem :: !(Blocks),collectedArounds_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])),collectedAugments_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])),collectedConParams_Syn_Elem :: !(([(NontermIdent, ConstructorIdent, Set Identifier)])),collectedConstraints_Syn_Elem :: !(([(NontermIdent, ConstructorIdent, [Type])])),collectedConstructorsMap_Syn_Elem :: !((Map NontermIdent (Set ConstructorIdent))),collectedFields_Syn_Elem :: !(([(NontermIdent, ConstructorIdent, FieldMap)])),collectedInsts_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, [Identifier]) ])),collectedMacros_Syn_Elem :: !(([(NontermIdent, ConstructorIdent, MaybeMacro)])),collectedMerges_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])),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)),quantCollect_Syn_Elem :: !(QuantMap),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 -> + Inh_Elem -> + Syn_Elem +wrap_Elem (T_Elem sem) (Inh_Elem _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) = + (let ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers) = sem _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions + in (Syn_Elem _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _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 + _lhsIallAttrs + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIattrs + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _altsOnts :: (Set NontermIdent) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOparamsCollect :: ParamMap + _lhsOctxCollect :: ContextMap + _attrsOnts :: (Set NontermIdent) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _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) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOattrs :: (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)) + _attrsOattrs :: (Map NontermIdent (Attributes, Attributes)) + _attrsOoptions :: Options + _altsOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _altsOallNonterminals :: (Set NontermIdent) + _namesIcollectedNames :: (Set Identifier) + _namesIerrors :: (Seq Error) + _namesInontSet :: (Set NontermIdent) + _attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _attrsIattrs :: (Map NontermIdent (Attributes, Attributes)) + _attrsIerrors :: (Seq Error) + _attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _altsIcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _altsIcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _altsIcollectedConstructorNames :: (Set ConstructorIdent) + _altsIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _altsIcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + -- "./src-ag/Transform.ag"(line 179, column 10) + _altsOnts = + ({-# LINE 179 "./src-ag/Transform.ag" #-} + _namesInontSet + {-# LINE 1855 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 619, column 11) + _lhsOcollectedConstructorsMap = + ({-# LINE 619 "./src-ag/Transform.ag" #-} + Map.fromList + [ (n, _altsIcollectedConstructorNames) + | n <- Set.toList _namesInontSet + ] + {-# LINE 1864 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 944, column 7) + _lhsOparamsCollect = + ({-# LINE 944 "./src-ag/Transform.ag" #-} + if null params_ + then Map.empty + else Map.fromList [(nt, params_) | nt <- Set.toList _namesInontSet] + {-# LINE 1872 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 967, column 7) + _lhsOctxCollect = + ({-# LINE 967 "./src-ag/Transform.ag" #-} + if null ctx_ + then Map.empty + else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] + {-# LINE 1880 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1027, column 10) + _attrsOnts = + ({-# LINE 1027 "./src-ag/Transform.ag" #-} + _namesInontSet + {-# LINE 1886 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 908, column 55) + _lhsOattrOrderCollect = + ({-# LINE 908 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 1892 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 46, column 19) + _lhsOblocks = + ({-# LINE 46 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 1898 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 165, column 32) + _lhsOcollectedArounds = + ({-# LINE 165 "./src-ag/Transform.ag" #-} + [] + {-# LINE 1904 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 164, column 32) + _lhsOcollectedAugments = + ({-# LINE 164 "./src-ag/Transform.ag" #-} + [] + {-# LINE 1910 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 133, column 31) + _lhsOcollectedConParams = + ({-# LINE 133 "./src-ag/Transform.ag" #-} + _altsIcollectedConParams + {-# LINE 1916 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 132, column 33) + _lhsOcollectedConstraints = + ({-# LINE 132 "./src-ag/Transform.ag" #-} + _altsIcollectedConstraints + {-# LINE 1922 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 131, column 28) + _lhsOcollectedFields = + ({-# LINE 131 "./src-ag/Transform.ag" #-} + _altsIcollectedFields + {-# LINE 1928 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 162, column 32) + _lhsOcollectedInsts = + ({-# LINE 162 "./src-ag/Transform.ag" #-} + [] + {-# LINE 1934 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1301, column 28) + _lhsOcollectedMacros = + ({-# LINE 1301 "./src-ag/Transform.ag" #-} + _altsIcollectedMacros + {-# LINE 1940 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 166, column 32) + _lhsOcollectedMerges = + ({-# LINE 166 "./src-ag/Transform.ag" #-} + [] + {-# LINE 1946 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + _namesIcollectedNames + {-# LINE 1952 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 160, column 32) + _lhsOcollectedRules = + ({-# LINE 160 "./src-ag/Transform.ag" #-} + [] + {-# LINE 1958 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 91, column 50) + _lhsOcollectedSetNames = + ({-# LINE 91 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 1964 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 161, column 32) + _lhsOcollectedSigs = + ({-# LINE 161 "./src-ag/Transform.ag" #-} + [] + {-# LINE 1970 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 163, column 32) + _lhsOcollectedUniques = + ({-# LINE 163 "./src-ag/Transform.ag" #-} + [] + {-# LINE 1976 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1005, column 33) + _lhsOderivings = + ({-# LINE 1005 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 1982 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + _namesIerrors Seq.>< _attrsIerrors + {-# LINE 1988 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1202, column 37) + _lhsOmoduleDecl = + ({-# LINE 1202 "./src-ag/Transform.ag" #-} + mzero + {-# LINE 1994 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 801, column 34) + _lhsOpragmas = + ({-# LINE 801 "./src-ag/Transform.ag" #-} + id + {-# LINE 2000 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 988, column 36) + _lhsOquantCollect = + ({-# LINE 988 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2006 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 880, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 880 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2012 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 640, column 32) + _lhsOtypeSyns = + ({-# LINE 640 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2018 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 146, column 15) + _lhsOuseMap = + ({-# LINE 146 "./src-ag/Transform.ag" #-} + _attrsIuseMap + {-# LINE 2024 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 785, column 32) + _lhsOwrappers = + ({-# LINE 785 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 2030 "dist/build/Transform.hs" #-} + ) + -- copy rule (up) + _lhsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _attrsIattrDecls + {-# LINE 2036 "dist/build/Transform.hs" #-} + ) + -- copy rule (up) + _lhsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _attrsIattrs + {-# LINE 2042 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 110 "./src-ag/Transform.ag" #-} + _lhsIdefSets + {-# LINE 2048 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _namesOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 2054 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _namesOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 2060 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _namesOdefinedSets = + ({-# LINE 113 "./src-ag/Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 2066 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _attrsOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 2072 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _attrsOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 2078 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _attrsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _lhsIattrDecls + {-# LINE 2084 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _attrsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _lhsIattrs + {-# LINE 2090 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _attrsOoptions = + ({-# LINE 40 "./src-ag/Transform.ag" #-} + _lhsIoptions + {-# LINE 2096 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _altsOallConstructors = + ({-# LINE 102 "./src-ag/Transform.ag" #-} + _lhsIallConstructors + {-# LINE 2102 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _altsOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 2108 "dist/build/Transform.hs" #-} + ) + ( _namesIcollectedNames,_namesIerrors,_namesInontSet) = + names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets + ( _attrsIattrDecls,_attrsIattrs,_attrsIerrors,_attrsIuseMap) = + attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOattrs _attrsOnts _attrsOoptions + ( _altsIcollectedConParams,_altsIcollectedConstraints,_altsIcollectedConstructorNames,_altsIcollectedFields,_altsIcollectedMacros) = + alts_ _altsOallConstructors _altsOallNonterminals _altsOnts + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_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 + _lhsIallAttrs + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIattrs + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOtypeSyns :: TypeSyns + _lhsOparamsCollect :: ParamMap + _lhsOctxCollect :: ContextMap + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _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) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOattrs :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + -- "./src-ag/Transform.ag"(line 256, column 10) + _lhsOcollectedFields = + ({-# LINE 256 "./src-ag/Transform.ag" #-} + map (\(x,y)->(name_, x, y)) _expanded + {-# LINE 2168 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 599, column 11) + _lhsOcollectedNames = + ({-# LINE 599 "./src-ag/Transform.ag" #-} + Set.singleton name_ + {-# LINE 2174 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 653, column 11) + _expanded = + ({-# LINE 653 "./src-ag/Transform.ag" #-} + case _argType of + List tp -> [(Ident "Cons" pos_, [(Ident "hd" pos_, tp) + ,(Ident "tl" pos_, NT name_ (map getName params_) False) + ] + ) + ,(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_) False) + ]) + , (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_) False) + ]) + , (Ident "Nil" pos_, []) + ] + OrdSet tp -> [ (Ident "Entry" pos_, [ (Ident "val" pos_, tp) + , (Ident "tl" pos_, NT name_ (map getName params_) False) ]) + , (Ident "Nil" pos_, []) + ] + IntSet -> [ (Ident "Entry" pos_, [ (Ident "val" pos_, Haskell "Int") + , (Ident "tl" pos_, NT name_ (map getName params_) False) ]) + , (Ident "Nil" pos_, []) + ] + Tuple xs -> [(Ident "Tuple" pos_, xs)] + {-# LINE 2216 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 690, column 11) + _argType = + ({-# LINE 690 "./src-ag/Transform.ag" #-} + 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) + OrdSet tp -> OrdSet ( makeType _lhsIallNonterminals tp) + IntSet -> IntSet + {-# LINE 2230 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 699, column 11) + _lhsOtypeSyns = + ({-# LINE 699 "./src-ag/Transform.ag" #-} + [(name_,_argType)] + {-# LINE 2236 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 950, column 7) + _lhsOparamsCollect = + ({-# LINE 950 "./src-ag/Transform.ag" #-} + if null params_ + then Map.empty + else Map.singleton name_ params_ + {-# LINE 2244 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 973, column 7) + _lhsOctxCollect = + ({-# LINE 973 "./src-ag/Transform.ag" #-} + if null ctx_ + then Map.empty + else Map.singleton name_ ctx_ + {-# LINE 2252 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 908, column 55) + _lhsOattrOrderCollect = + ({-# LINE 908 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2258 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 46, column 19) + _lhsOblocks = + ({-# LINE 46 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2264 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 165, column 32) + _lhsOcollectedArounds = + ({-# LINE 165 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2270 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 164, column 32) + _lhsOcollectedAugments = + ({-# LINE 164 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2276 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 133, column 31) + _lhsOcollectedConParams = + ({-# LINE 133 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2282 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 132, column 33) + _lhsOcollectedConstraints = + ({-# LINE 132 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2288 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 100, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 100 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2294 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 162, column 32) + _lhsOcollectedInsts = + ({-# LINE 162 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2300 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1301, column 28) + _lhsOcollectedMacros = + ({-# LINE 1301 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2306 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 166, column 32) + _lhsOcollectedMerges = + ({-# LINE 166 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2312 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 160, column 32) + _lhsOcollectedRules = + ({-# LINE 160 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2318 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 91, column 50) + _lhsOcollectedSetNames = + ({-# LINE 91 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 2324 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 161, column 32) + _lhsOcollectedSigs = + ({-# LINE 161 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2330 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 163, column 32) + _lhsOcollectedUniques = + ({-# LINE 163 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2336 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1005, column 33) + _lhsOderivings = + ({-# LINE 1005 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2342 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + Seq.empty + {-# LINE 2348 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1202, column 37) + _lhsOmoduleDecl = + ({-# LINE 1202 "./src-ag/Transform.ag" #-} + mzero + {-# LINE 2354 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 801, column 34) + _lhsOpragmas = + ({-# LINE 801 "./src-ag/Transform.ag" #-} + id + {-# LINE 2360 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 988, column 36) + _lhsOquantCollect = + ({-# LINE 988 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2366 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 880, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 880 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2372 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 146, column 15) + _lhsOuseMap = + ({-# LINE 146 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2378 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 785, column 32) + _lhsOwrappers = + ({-# LINE 785 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 2384 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _lhsIattrDecls + {-# LINE 2390 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _lhsIattrs + {-# LINE 2396 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 110 "./src-ag/Transform.ag" #-} + _lhsIdefSets + {-# LINE 2402 "dist/build/Transform.hs" #-} + ) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Attr :: Pos -> + ClassContext -> + T_NontSet -> + ([String]) -> + T_Attrs -> + T_Elem +sem_Elem_Attr pos_ ctx_ (T_NontSet names_) quants_ (T_Attrs attrs_) = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallAttrs + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIattrs + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOctxCollect :: ContextMap + _lhsOquantCollect :: QuantMap + _attrsOnts :: (Set NontermIdent) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _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)) + _lhsOattrs :: (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)) + _attrsOattrs :: (Map NontermIdent (Attributes, Attributes)) + _attrsOoptions :: Options + _namesIcollectedNames :: (Set Identifier) + _namesIerrors :: (Seq Error) + _namesInontSet :: (Set NontermIdent) + _attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _attrsIattrs :: (Map NontermIdent (Attributes, Attributes)) + _attrsIerrors :: (Seq Error) + _attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + -- "./src-ag/Transform.ag"(line 967, column 7) + _lhsOctxCollect = + ({-# LINE 967 "./src-ag/Transform.ag" #-} + if null ctx_ + then Map.empty + else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] + {-# LINE 2474 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 992, column 7) + _lhsOquantCollect = + ({-# LINE 992 "./src-ag/Transform.ag" #-} + if null quants_ + then Map.empty + else Map.fromList [(nt, quants_) | nt <- Set.toList _namesInontSet] + {-# LINE 2482 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1028, column 10) + _attrsOnts = + ({-# LINE 1028 "./src-ag/Transform.ag" #-} + _namesInontSet + {-# LINE 2488 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 908, column 55) + _lhsOattrOrderCollect = + ({-# LINE 908 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2494 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 46, column 19) + _lhsOblocks = + ({-# LINE 46 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2500 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 165, column 32) + _lhsOcollectedArounds = + ({-# LINE 165 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2506 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 164, column 32) + _lhsOcollectedAugments = + ({-# LINE 164 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2512 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 133, column 31) + _lhsOcollectedConParams = + ({-# LINE 133 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2518 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 132, column 33) + _lhsOcollectedConstraints = + ({-# LINE 132 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2524 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 100, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 100 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2530 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 131, column 28) + _lhsOcollectedFields = + ({-# LINE 131 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2536 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 162, column 32) + _lhsOcollectedInsts = + ({-# LINE 162 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2542 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1301, column 28) + _lhsOcollectedMacros = + ({-# LINE 1301 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2548 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 166, column 32) + _lhsOcollectedMerges = + ({-# LINE 166 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2554 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + _namesIcollectedNames + {-# LINE 2560 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 160, column 32) + _lhsOcollectedRules = + ({-# LINE 160 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2566 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 91, column 50) + _lhsOcollectedSetNames = + ({-# LINE 91 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 2572 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 161, column 32) + _lhsOcollectedSigs = + ({-# LINE 161 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2578 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 163, column 32) + _lhsOcollectedUniques = + ({-# LINE 163 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2584 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1005, column 33) + _lhsOderivings = + ({-# LINE 1005 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2590 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + _namesIerrors Seq.>< _attrsIerrors + {-# LINE 2596 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1202, column 37) + _lhsOmoduleDecl = + ({-# LINE 1202 "./src-ag/Transform.ag" #-} + mzero + {-# LINE 2602 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 940, column 37) + _lhsOparamsCollect = + ({-# LINE 940 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2608 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 801, column 34) + _lhsOpragmas = + ({-# LINE 801 "./src-ag/Transform.ag" #-} + id + {-# LINE 2614 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 880, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 880 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2620 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 640, column 32) + _lhsOtypeSyns = + ({-# LINE 640 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2626 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 146, column 15) + _lhsOuseMap = + ({-# LINE 146 "./src-ag/Transform.ag" #-} + _attrsIuseMap + {-# LINE 2632 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 785, column 32) + _lhsOwrappers = + ({-# LINE 785 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 2638 "dist/build/Transform.hs" #-} + ) + -- copy rule (up) + _lhsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _attrsIattrDecls + {-# LINE 2644 "dist/build/Transform.hs" #-} + ) + -- copy rule (up) + _lhsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _attrsIattrs + {-# LINE 2650 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 110 "./src-ag/Transform.ag" #-} + _lhsIdefSets + {-# LINE 2656 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _namesOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 2662 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _namesOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 2668 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _namesOdefinedSets = + ({-# LINE 113 "./src-ag/Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 2674 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _attrsOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 2680 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _attrsOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 2686 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _attrsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _lhsIattrDecls + {-# LINE 2692 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _attrsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _lhsIattrs + {-# LINE 2698 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _attrsOoptions = + ({-# LINE 40 "./src-ag/Transform.ag" #-} + _lhsIoptions + {-# LINE 2704 "dist/build/Transform.hs" #-} + ) + ( _namesIcollectedNames,_namesIerrors,_namesInontSet) = + names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets + ( _attrsIattrDecls,_attrsIattrs,_attrsIerrors,_attrsIuseMap) = + attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOattrs _attrsOnts _attrsOoptions + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Sem :: Pos -> + ClassContext -> + T_NontSet -> + T_Attrs -> + ([String]) -> + T_SemAlts -> + T_Elem +sem_Elem_Sem pos_ ctx_ (T_NontSet names_) (T_Attrs attrs_) quants_ (T_SemAlts alts_) = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallAttrs + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIattrs + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _altsOnts :: (Set NontermIdent) + _lhsOctxCollect :: ContextMap + _lhsOquantCollect :: QuantMap + _attrsOnts :: (Set NontermIdent) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _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)) + _lhsOattrs :: (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)) + _attrsOattrs :: (Map NontermIdent (Attributes, Attributes)) + _attrsOoptions :: Options + _altsOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _altsOallAttrs :: (Map NontermIdent (Attributes, Attributes)) + _altsOallFields :: DataTypes + _altsOoptions :: Options + _namesIcollectedNames :: (Set Identifier) + _namesIerrors :: (Seq Error) + _namesInontSet :: (Set NontermIdent) + _attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _attrsIattrs :: (Map NontermIdent (Attributes, Attributes)) + _attrsIerrors :: (Seq Error) + _attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _altsIattrOrderCollect :: AttrOrderMap + _altsIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _altsIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _altsIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _altsIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _altsIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _altsIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _altsIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _altsIerrors :: (Seq Error) + _altsIsemPragmasCollect :: PragmaMap + -- "./src-ag/Transform.ag"(line 180, column 10) + _altsOnts = + ({-# LINE 180 "./src-ag/Transform.ag" #-} + _namesInontSet + {-# LINE 2794 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 967, column 7) + _lhsOctxCollect = + ({-# LINE 967 "./src-ag/Transform.ag" #-} + if null ctx_ + then Map.empty + else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] + {-# LINE 2802 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 992, column 7) + _lhsOquantCollect = + ({-# LINE 992 "./src-ag/Transform.ag" #-} + if null quants_ + then Map.empty + else Map.fromList [(nt, quants_) | nt <- Set.toList _namesInontSet] + {-# LINE 2810 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1029, column 10) + _attrsOnts = + ({-# LINE 1029 "./src-ag/Transform.ag" #-} + _namesInontSet + {-# LINE 2816 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 908, column 55) + _lhsOattrOrderCollect = + ({-# LINE 908 "./src-ag/Transform.ag" #-} + _altsIattrOrderCollect + {-# LINE 2822 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 46, column 19) + _lhsOblocks = + ({-# LINE 46 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2828 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 165, column 32) + _lhsOcollectedArounds = + ({-# LINE 165 "./src-ag/Transform.ag" #-} + _altsIcollectedArounds + {-# LINE 2834 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 164, column 32) + _lhsOcollectedAugments = + ({-# LINE 164 "./src-ag/Transform.ag" #-} + _altsIcollectedAugments + {-# LINE 2840 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 133, column 31) + _lhsOcollectedConParams = + ({-# LINE 133 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2846 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 132, column 33) + _lhsOcollectedConstraints = + ({-# LINE 132 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2852 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 100, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 100 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2858 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 131, column 28) + _lhsOcollectedFields = + ({-# LINE 131 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2864 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 162, column 32) + _lhsOcollectedInsts = + ({-# LINE 162 "./src-ag/Transform.ag" #-} + _altsIcollectedInsts + {-# LINE 2870 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1301, column 28) + _lhsOcollectedMacros = + ({-# LINE 1301 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2876 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 166, column 32) + _lhsOcollectedMerges = + ({-# LINE 166 "./src-ag/Transform.ag" #-} + _altsIcollectedMerges + {-# LINE 2882 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + _namesIcollectedNames + {-# LINE 2888 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 160, column 32) + _lhsOcollectedRules = + ({-# LINE 160 "./src-ag/Transform.ag" #-} + _altsIcollectedRules + {-# LINE 2894 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 91, column 50) + _lhsOcollectedSetNames = + ({-# LINE 91 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 2900 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 161, column 32) + _lhsOcollectedSigs = + ({-# LINE 161 "./src-ag/Transform.ag" #-} + _altsIcollectedSigs + {-# LINE 2906 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 163, column 32) + _lhsOcollectedUniques = + ({-# LINE 163 "./src-ag/Transform.ag" #-} + _altsIcollectedUniques + {-# LINE 2912 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1005, column 33) + _lhsOderivings = + ({-# LINE 1005 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2918 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + _namesIerrors Seq.>< _attrsIerrors Seq.>< _altsIerrors + {-# LINE 2924 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1202, column 37) + _lhsOmoduleDecl = + ({-# LINE 1202 "./src-ag/Transform.ag" #-} + mzero + {-# LINE 2930 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 940, column 37) + _lhsOparamsCollect = + ({-# LINE 940 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 2936 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 801, column 34) + _lhsOpragmas = + ({-# LINE 801 "./src-ag/Transform.ag" #-} + id + {-# LINE 2942 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 880, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 880 "./src-ag/Transform.ag" #-} + _altsIsemPragmasCollect + {-# LINE 2948 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 640, column 32) + _lhsOtypeSyns = + ({-# LINE 640 "./src-ag/Transform.ag" #-} + [] + {-# LINE 2954 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 146, column 15) + _lhsOuseMap = + ({-# LINE 146 "./src-ag/Transform.ag" #-} + _attrsIuseMap + {-# LINE 2960 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 785, column 32) + _lhsOwrappers = + ({-# LINE 785 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 2966 "dist/build/Transform.hs" #-} + ) + -- copy rule (up) + _lhsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _attrsIattrDecls + {-# LINE 2972 "dist/build/Transform.hs" #-} + ) + -- copy rule (up) + _lhsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _attrsIattrs + {-# LINE 2978 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 110 "./src-ag/Transform.ag" #-} + _lhsIdefSets + {-# LINE 2984 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _namesOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 2990 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _namesOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 2996 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _namesOdefinedSets = + ({-# LINE 113 "./src-ag/Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 3002 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _attrsOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 3008 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _attrsOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 3014 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _attrsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _lhsIattrDecls + {-# LINE 3020 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _attrsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _lhsIattrs + {-# LINE 3026 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _attrsOoptions = + ({-# LINE 40 "./src-ag/Transform.ag" #-} + _lhsIoptions + {-# LINE 3032 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _altsOallAttrDecls = + ({-# LINE 909 "./src-ag/Transform.ag" #-} + _lhsIallAttrDecls + {-# LINE 3038 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _altsOallAttrs = + ({-# LINE 1324 "./src-ag/Transform.ag" #-} + _lhsIallAttrs + {-# LINE 3044 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _altsOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 3050 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _altsOoptions = + ({-# LINE 40 "./src-ag/Transform.ag" #-} + _lhsIoptions + {-# LINE 3056 "dist/build/Transform.hs" #-} + ) + ( _namesIcollectedNames,_namesIerrors,_namesInontSet) = + names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets + ( _attrsIattrDecls,_attrsIattrs,_attrsIerrors,_attrsIuseMap) = + attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOattrs _attrsOnts _attrsOoptions + ( _altsIattrOrderCollect,_altsIcollectedArounds,_altsIcollectedAugments,_altsIcollectedInsts,_altsIcollectedMerges,_altsIcollectedRules,_altsIcollectedSigs,_altsIcollectedUniques,_altsIerrors,_altsIsemPragmasCollect) = + alts_ _altsOallAttrDecls _altsOallAttrs _altsOallFields _altsOnts _altsOoptions + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Txt :: Pos -> + BlockKind -> + (Maybe NontermIdent) -> + ([String]) -> + T_Elem +sem_Elem_Txt pos_ kind_ mbNt_ lines_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallAttrs + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIattrs + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOblocks :: Blocks + _lhsOerrors :: (Seq Error) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedNames :: (Set Identifier) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSetNames :: (Set Identifier) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOctxCollect :: ContextMap + _lhsOderivings :: Derivings + _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOparamsCollect :: ParamMap + _lhsOpragmas :: (Options -> Options) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOattrs :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + -- "./src-ag/Transform.ag"(line 189, column 10) + _blockInfo = + ({-# LINE 189 "./src-ag/Transform.ag" #-} + ( kind_ + , mbNt_ + ) + {-# LINE 3117 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 192, column 10) + _blockValue = + ({-# LINE 192 "./src-ag/Transform.ag" #-} + [(lines_, pos_)] + {-# LINE 3123 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 193, column 10) + _lhsOblocks = + ({-# LINE 193 "./src-ag/Transform.ag" #-} + Map.singleton _blockInfo _blockValue + {-# LINE 3129 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 194, column 10) + _lhsOerrors = + ({-# LINE 194 "./src-ag/Transform.ag" #-} + if checkParseBlock _lhsIoptions + then let exp = Expression pos_ tks + tks = [tk] + tk = HsToken (unlines lines_) pos_ + in Seq.fromList $ checkBlock $ exp + else Seq.empty + {-# LINE 3140 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 908, column 55) + _lhsOattrOrderCollect = + ({-# LINE 908 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3146 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 165, column 32) + _lhsOcollectedArounds = + ({-# LINE 165 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3152 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 164, column 32) + _lhsOcollectedAugments = + ({-# LINE 164 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3158 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 133, column 31) + _lhsOcollectedConParams = + ({-# LINE 133 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3164 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 132, column 33) + _lhsOcollectedConstraints = + ({-# LINE 132 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3170 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 100, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 100 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3176 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 131, column 28) + _lhsOcollectedFields = + ({-# LINE 131 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3182 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 162, column 32) + _lhsOcollectedInsts = + ({-# LINE 162 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3188 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1301, column 28) + _lhsOcollectedMacros = + ({-# LINE 1301 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3194 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 166, column 32) + _lhsOcollectedMerges = + ({-# LINE 166 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3200 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 3206 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 160, column 32) + _lhsOcollectedRules = + ({-# LINE 160 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3212 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 91, column 50) + _lhsOcollectedSetNames = + ({-# LINE 91 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 3218 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 161, column 32) + _lhsOcollectedSigs = + ({-# LINE 161 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3224 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 163, column 32) + _lhsOcollectedUniques = + ({-# LINE 163 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3230 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 963, column 34) + _lhsOctxCollect = + ({-# LINE 963 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3236 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1005, column 33) + _lhsOderivings = + ({-# LINE 1005 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3242 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1202, column 37) + _lhsOmoduleDecl = + ({-# LINE 1202 "./src-ag/Transform.ag" #-} + mzero + {-# LINE 3248 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 940, column 37) + _lhsOparamsCollect = + ({-# LINE 940 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3254 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 801, column 34) + _lhsOpragmas = + ({-# LINE 801 "./src-ag/Transform.ag" #-} + id + {-# LINE 3260 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 988, column 36) + _lhsOquantCollect = + ({-# LINE 988 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3266 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 880, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 880 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3272 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 640, column 32) + _lhsOtypeSyns = + ({-# LINE 640 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3278 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 146, column 15) + _lhsOuseMap = + ({-# LINE 146 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3284 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 785, column 32) + _lhsOwrappers = + ({-# LINE 785 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 3290 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _lhsIattrDecls + {-# LINE 3296 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _lhsIattrs + {-# LINE 3302 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 110 "./src-ag/Transform.ag" #-} + _lhsIdefSets + {-# LINE 3308 "dist/build/Transform.hs" #-} + ) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Set :: Pos -> + NontermIdent -> + Bool -> + T_NontSet -> + T_Elem +sem_Elem_Set pos_ name_ merge_ (T_NontSet set_) = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallAttrs + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIattrs + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOcollectedSetNames :: (Set Identifier) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _lhsOerrors :: (Seq Error) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _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) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOattrs :: (Map NontermIdent (Attributes, Attributes)) + _setOallFields :: DataTypes + _setOallNonterminals :: (Set NontermIdent) + _setOdefinedSets :: DefinedSets + _setIcollectedNames :: (Set Identifier) + _setIerrors :: (Seq Error) + _setInontSet :: (Set NontermIdent) + -- "./src-ag/Transform.ag"(line 596, column 10) + _lhsOcollectedSetNames = + ({-# LINE 596 "./src-ag/Transform.ag" #-} + Set.singleton name_ + {-# LINE 3367 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 713, column 13) + (_defSets2,_errs) = + ({-# LINE 713 "./src-ag/Transform.ag" #-} + 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.singleton(CyclicSet name_)) + | otherwise = (_setInontSet, Seq.empty) + (res, e2) = let toAdd = (nontSet,Set.insert name_ allUsedNames) + union (a,b) (c,d) = (a `Set.union` c, b `Set.union` d) + in if Set.member name_ _lhsIallNonterminals || not merge_ + then checkDuplicate DupSet name_ toAdd _lhsIdefSets + else (Map.insertWith union name_ toAdd _lhsIdefSets, Seq.empty) + in (res, e1 Seq.>< e2) + {-# LINE 3386 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 727, column 9) + _lhsOdefSets = + ({-# LINE 727 "./src-ag/Transform.ag" #-} + _defSets2 + {-# LINE 3392 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 727, column 9) + _lhsOerrors = + ({-# LINE 728 "./src-ag/Transform.ag" #-} + _errs >< _setIerrors + {-# LINE 3398 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 908, column 55) + _lhsOattrOrderCollect = + ({-# LINE 908 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3404 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 46, column 19) + _lhsOblocks = + ({-# LINE 46 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3410 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 165, column 32) + _lhsOcollectedArounds = + ({-# LINE 165 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3416 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 164, column 32) + _lhsOcollectedAugments = + ({-# LINE 164 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3422 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 133, column 31) + _lhsOcollectedConParams = + ({-# LINE 133 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3428 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 132, column 33) + _lhsOcollectedConstraints = + ({-# LINE 132 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3434 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 100, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 100 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3440 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 131, column 28) + _lhsOcollectedFields = + ({-# LINE 131 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3446 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 162, column 32) + _lhsOcollectedInsts = + ({-# LINE 162 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3452 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1301, column 28) + _lhsOcollectedMacros = + ({-# LINE 1301 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3458 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 166, column 32) + _lhsOcollectedMerges = + ({-# LINE 166 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3464 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + _setIcollectedNames + {-# LINE 3470 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 160, column 32) + _lhsOcollectedRules = + ({-# LINE 160 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3476 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 161, column 32) + _lhsOcollectedSigs = + ({-# LINE 161 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3482 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 163, column 32) + _lhsOcollectedUniques = + ({-# LINE 163 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3488 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 963, column 34) + _lhsOctxCollect = + ({-# LINE 963 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3494 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1005, column 33) + _lhsOderivings = + ({-# LINE 1005 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3500 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1202, column 37) + _lhsOmoduleDecl = + ({-# LINE 1202 "./src-ag/Transform.ag" #-} + mzero + {-# LINE 3506 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 940, column 37) + _lhsOparamsCollect = + ({-# LINE 940 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3512 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 801, column 34) + _lhsOpragmas = + ({-# LINE 801 "./src-ag/Transform.ag" #-} + id + {-# LINE 3518 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 988, column 36) + _lhsOquantCollect = + ({-# LINE 988 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3524 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 880, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 880 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3530 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 640, column 32) + _lhsOtypeSyns = + ({-# LINE 640 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3536 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 146, column 15) + _lhsOuseMap = + ({-# LINE 146 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3542 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 785, column 32) + _lhsOwrappers = + ({-# LINE 785 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 3548 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _lhsIattrDecls + {-# LINE 3554 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _lhsIattrs + {-# LINE 3560 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _setOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 3566 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _setOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 3572 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _setOdefinedSets = + ({-# LINE 113 "./src-ag/Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 3578 "dist/build/Transform.hs" #-} + ) + ( _setIcollectedNames,_setIerrors,_setInontSet) = + set_ _setOallFields _setOallNonterminals _setOdefinedSets + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Deriving :: Pos -> + T_NontSet -> + ([NontermIdent]) -> + T_Elem +sem_Elem_Deriving pos_ (T_NontSet set_) classes_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallAttrs + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIattrs + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOderivings :: Derivings + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _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) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOattrs :: (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) + -- "./src-ag/Transform.ag"(line 1012, column 14) + _lhsOderivings = + ({-# LINE 1012 "./src-ag/Transform.ag" #-} + Map.fromList [(nt,Set.fromList classes_) | nt <- Set.toList _setInontSet] + {-# LINE 3638 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 908, column 55) + _lhsOattrOrderCollect = + ({-# LINE 908 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3644 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 46, column 19) + _lhsOblocks = + ({-# LINE 46 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3650 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 165, column 32) + _lhsOcollectedArounds = + ({-# LINE 165 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3656 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 164, column 32) + _lhsOcollectedAugments = + ({-# LINE 164 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3662 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 133, column 31) + _lhsOcollectedConParams = + ({-# LINE 133 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3668 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 132, column 33) + _lhsOcollectedConstraints = + ({-# LINE 132 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3674 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 100, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 100 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3680 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 131, column 28) + _lhsOcollectedFields = + ({-# LINE 131 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3686 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 162, column 32) + _lhsOcollectedInsts = + ({-# LINE 162 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3692 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1301, column 28) + _lhsOcollectedMacros = + ({-# LINE 1301 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3698 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 166, column 32) + _lhsOcollectedMerges = + ({-# LINE 166 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3704 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + _setIcollectedNames + {-# LINE 3710 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 160, column 32) + _lhsOcollectedRules = + ({-# LINE 160 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3716 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 91, column 50) + _lhsOcollectedSetNames = + ({-# LINE 91 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 3722 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 161, column 32) + _lhsOcollectedSigs = + ({-# LINE 161 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3728 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 163, column 32) + _lhsOcollectedUniques = + ({-# LINE 163 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3734 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 963, column 34) + _lhsOctxCollect = + ({-# LINE 963 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3740 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + _setIerrors + {-# LINE 3746 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1202, column 37) + _lhsOmoduleDecl = + ({-# LINE 1202 "./src-ag/Transform.ag" #-} + mzero + {-# LINE 3752 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 940, column 37) + _lhsOparamsCollect = + ({-# LINE 940 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3758 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 801, column 34) + _lhsOpragmas = + ({-# LINE 801 "./src-ag/Transform.ag" #-} + id + {-# LINE 3764 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 988, column 36) + _lhsOquantCollect = + ({-# LINE 988 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3770 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 880, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 880 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3776 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 640, column 32) + _lhsOtypeSyns = + ({-# LINE 640 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3782 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 146, column 15) + _lhsOuseMap = + ({-# LINE 146 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3788 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 785, column 32) + _lhsOwrappers = + ({-# LINE 785 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 3794 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _lhsIattrDecls + {-# LINE 3800 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _lhsIattrs + {-# LINE 3806 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 110 "./src-ag/Transform.ag" #-} + _lhsIdefSets + {-# LINE 3812 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _setOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 3818 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _setOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 3824 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _setOdefinedSets = + ({-# LINE 113 "./src-ag/Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 3830 "dist/build/Transform.hs" #-} + ) + ( _setIcollectedNames,_setIerrors,_setInontSet) = + set_ _setOallFields _setOallNonterminals _setOdefinedSets + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Wrapper :: Pos -> + T_NontSet -> + T_Elem +sem_Elem_Wrapper pos_ (T_NontSet set_) = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallAttrs + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIattrs + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOwrappers :: (Set NontermIdent) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _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) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOattrs :: (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) + -- "./src-ag/Transform.ag"(line 788, column 13) + _lhsOwrappers = + ({-# LINE 788 "./src-ag/Transform.ag" #-} + _setInontSet + {-# LINE 3889 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 908, column 55) + _lhsOattrOrderCollect = + ({-# LINE 908 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3895 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 46, column 19) + _lhsOblocks = + ({-# LINE 46 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3901 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 165, column 32) + _lhsOcollectedArounds = + ({-# LINE 165 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3907 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 164, column 32) + _lhsOcollectedAugments = + ({-# LINE 164 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3913 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 133, column 31) + _lhsOcollectedConParams = + ({-# LINE 133 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3919 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 132, column 33) + _lhsOcollectedConstraints = + ({-# LINE 132 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3925 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 100, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 100 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3931 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 131, column 28) + _lhsOcollectedFields = + ({-# LINE 131 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3937 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 162, column 32) + _lhsOcollectedInsts = + ({-# LINE 162 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3943 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1301, column 28) + _lhsOcollectedMacros = + ({-# LINE 1301 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3949 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 166, column 32) + _lhsOcollectedMerges = + ({-# LINE 166 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3955 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + _setIcollectedNames + {-# LINE 3961 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 160, column 32) + _lhsOcollectedRules = + ({-# LINE 160 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3967 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 91, column 50) + _lhsOcollectedSetNames = + ({-# LINE 91 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 3973 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 161, column 32) + _lhsOcollectedSigs = + ({-# LINE 161 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3979 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 163, column 32) + _lhsOcollectedUniques = + ({-# LINE 163 "./src-ag/Transform.ag" #-} + [] + {-# LINE 3985 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 963, column 34) + _lhsOctxCollect = + ({-# LINE 963 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3991 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1005, column 33) + _lhsOderivings = + ({-# LINE 1005 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 3997 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + _setIerrors + {-# LINE 4003 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1202, column 37) + _lhsOmoduleDecl = + ({-# LINE 1202 "./src-ag/Transform.ag" #-} + mzero + {-# LINE 4009 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 940, column 37) + _lhsOparamsCollect = + ({-# LINE 940 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4015 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 801, column 34) + _lhsOpragmas = + ({-# LINE 801 "./src-ag/Transform.ag" #-} + id + {-# LINE 4021 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 988, column 36) + _lhsOquantCollect = + ({-# LINE 988 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4027 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 880, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 880 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4033 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 640, column 32) + _lhsOtypeSyns = + ({-# LINE 640 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4039 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 146, column 15) + _lhsOuseMap = + ({-# LINE 146 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4045 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _lhsIattrDecls + {-# LINE 4051 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _lhsIattrs + {-# LINE 4057 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 110 "./src-ag/Transform.ag" #-} + _lhsIdefSets + {-# LINE 4063 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _setOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 4069 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _setOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 4075 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _setOdefinedSets = + ({-# LINE 113 "./src-ag/Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 4081 "dist/build/Transform.hs" #-} + ) + ( _setIcollectedNames,_setIerrors,_setInontSet) = + set_ _setOallFields _setOallNonterminals _setOdefinedSets + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Nocatas :: Pos -> + T_NontSet -> + T_Elem +sem_Elem_Nocatas pos_ (T_NontSet set_) = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallAttrs + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIattrs + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOpragmas :: (Options -> Options) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _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 + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOattrs :: (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) + -- "./src-ag/Transform.ag"(line 795, column 14) + _lhsOpragmas = + ({-# LINE 795 "./src-ag/Transform.ag" #-} + \o -> o { nocatas = _setInontSet `Set.union` nocatas o } + {-# LINE 4140 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 908, column 55) + _lhsOattrOrderCollect = + ({-# LINE 908 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4146 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 46, column 19) + _lhsOblocks = + ({-# LINE 46 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4152 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 165, column 32) + _lhsOcollectedArounds = + ({-# LINE 165 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4158 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 164, column 32) + _lhsOcollectedAugments = + ({-# LINE 164 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4164 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 133, column 31) + _lhsOcollectedConParams = + ({-# LINE 133 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4170 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 132, column 33) + _lhsOcollectedConstraints = + ({-# LINE 132 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4176 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 100, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 100 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4182 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 131, column 28) + _lhsOcollectedFields = + ({-# LINE 131 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4188 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 162, column 32) + _lhsOcollectedInsts = + ({-# LINE 162 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4194 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1301, column 28) + _lhsOcollectedMacros = + ({-# LINE 1301 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4200 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 166, column 32) + _lhsOcollectedMerges = + ({-# LINE 166 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4206 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + _setIcollectedNames + {-# LINE 4212 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 160, column 32) + _lhsOcollectedRules = + ({-# LINE 160 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4218 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 91, column 50) + _lhsOcollectedSetNames = + ({-# LINE 91 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 4224 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 161, column 32) + _lhsOcollectedSigs = + ({-# LINE 161 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4230 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 163, column 32) + _lhsOcollectedUniques = + ({-# LINE 163 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4236 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 963, column 34) + _lhsOctxCollect = + ({-# LINE 963 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4242 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1005, column 33) + _lhsOderivings = + ({-# LINE 1005 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4248 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + _setIerrors + {-# LINE 4254 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1202, column 37) + _lhsOmoduleDecl = + ({-# LINE 1202 "./src-ag/Transform.ag" #-} + mzero + {-# LINE 4260 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 940, column 37) + _lhsOparamsCollect = + ({-# LINE 940 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4266 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 988, column 36) + _lhsOquantCollect = + ({-# LINE 988 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4272 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 880, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 880 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4278 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 640, column 32) + _lhsOtypeSyns = + ({-# LINE 640 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4284 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 146, column 15) + _lhsOuseMap = + ({-# LINE 146 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4290 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 785, column 32) + _lhsOwrappers = + ({-# LINE 785 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 4296 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _lhsIattrDecls + {-# LINE 4302 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _lhsIattrs + {-# LINE 4308 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 110 "./src-ag/Transform.ag" #-} + _lhsIdefSets + {-# LINE 4314 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _setOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 4320 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _setOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 4326 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _setOdefinedSets = + ({-# LINE 113 "./src-ag/Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 4332 "dist/build/Transform.hs" #-} + ) + ( _setIcollectedNames,_setIerrors,_setInontSet) = + set_ _setOallFields _setOallNonterminals _setOdefinedSets + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Pragma :: Pos -> + ([NontermIdent]) -> + T_Elem +sem_Elem_Pragma pos_ names_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallAttrs + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIattrs + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOpragmas :: (Options -> Options) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _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 + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOattrs :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + -- "./src-ag/Transform.ag"(line 804, column 13) + _lhsOpragmas = + ({-# LINE 804 "./src-ag/Transform.ag" #-} + let mk n o = case getName n of + "gencatas" -> o { folds = True } + "nogencatas" -> o { folds = False } + "gendatas" -> o { dataTypes = True } + "datarecords" -> o { dataRecords = True } + "nogendatas" -> o { dataTypes = False } + "gensems" -> o { semfuns = True } + "nogensems" -> o { semfuns = False } + "gentypesigs" -> o { typeSigs = True } + "nogentypesigs"-> o { typeSigs = False } + "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 } + "breadthfirst" -> o { breadthFirst = True } + "breadthfirstStrict" -> o { breadthFirstStrict = 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" -> sepSemModsOpt o + "genlinepragmas" -> o { genLinePragmas = True } + "newtypes" -> o { newtypes = True } + "nonewtypes" -> o { newtypes = False } + "nooptimizations" -> o { noOptimizations = True } + "kennedywarren" -> o { kennedyWarren = True } + "aspectag" -> o { genAspectAG = True } + 'n':'o':'g':'r':'o':'u':'p':'_':atts + -> o { noGroup = extract atts ++ noGroup o } + "rename" -> o { rename = True } + "parallel" -> o { parallelInvoke = True } + "monadicwrappers" -> o { monadicWrappers = True } + "dummytokenvisit" -> o { dummyTokenVisit = True } + "tupleasdummytoken" -> o { tupleAsDummyToken = True } + "stateasdummytoken" -> o { tupleAsDummyToken = False } + "strictdummytoken" -> o { strictDummyToken = True } + "noperruletypesigs" -> o { noPerRuleTypeSigs = True } + "noperstatetypesigs" -> o { noPerStateTypeSigs = True } + "noeagerblackholing" -> o { noEagerBlackholing = True } + "noperrulecostcentres" -> o { noPerRuleCostCentres = True } + "nopervisitcostcentres" -> o { noPerVisitCostCentres = True } + "helpinlining" -> o { helpInlining = True } + "noinlinepragmas" -> o { noInlinePragmas = True } + "aggressiveinlinepragmas" -> o { aggressiveInlinePragmas = True } + "latehigherorderbindings" -> o { lateHigherOrderBinding = True } + "ocaml" -> ocamlOpt o + s -> trace ("uuagc: ignoring unknown pragma: " ++ s) o + in \o -> foldr mk o names_ + {-# LINE 4449 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 908, column 55) + _lhsOattrOrderCollect = + ({-# LINE 908 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4455 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 46, column 19) + _lhsOblocks = + ({-# LINE 46 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4461 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 165, column 32) + _lhsOcollectedArounds = + ({-# LINE 165 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4467 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 164, column 32) + _lhsOcollectedAugments = + ({-# LINE 164 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4473 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 133, column 31) + _lhsOcollectedConParams = + ({-# LINE 133 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4479 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 132, column 33) + _lhsOcollectedConstraints = + ({-# LINE 132 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4485 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 100, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 100 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4491 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 131, column 28) + _lhsOcollectedFields = + ({-# LINE 131 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4497 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 162, column 32) + _lhsOcollectedInsts = + ({-# LINE 162 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4503 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1301, column 28) + _lhsOcollectedMacros = + ({-# LINE 1301 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4509 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 166, column 32) + _lhsOcollectedMerges = + ({-# LINE 166 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4515 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 4521 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 160, column 32) + _lhsOcollectedRules = + ({-# LINE 160 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4527 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 91, column 50) + _lhsOcollectedSetNames = + ({-# LINE 91 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 4533 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 161, column 32) + _lhsOcollectedSigs = + ({-# LINE 161 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4539 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 163, column 32) + _lhsOcollectedUniques = + ({-# LINE 163 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4545 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 963, column 34) + _lhsOctxCollect = + ({-# LINE 963 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4551 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1005, column 33) + _lhsOderivings = + ({-# LINE 1005 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4557 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + Seq.empty + {-# LINE 4563 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1202, column 37) + _lhsOmoduleDecl = + ({-# LINE 1202 "./src-ag/Transform.ag" #-} + mzero + {-# LINE 4569 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 940, column 37) + _lhsOparamsCollect = + ({-# LINE 940 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4575 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 988, column 36) + _lhsOquantCollect = + ({-# LINE 988 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4581 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 880, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 880 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4587 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 640, column 32) + _lhsOtypeSyns = + ({-# LINE 640 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4593 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 146, column 15) + _lhsOuseMap = + ({-# LINE 146 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4599 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 785, column 32) + _lhsOwrappers = + ({-# LINE 785 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 4605 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _lhsIattrDecls + {-# LINE 4611 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _lhsIattrs + {-# LINE 4617 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 110 "./src-ag/Transform.ag" #-} + _lhsIdefSets + {-# LINE 4623 "dist/build/Transform.hs" #-} + ) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elem_Module :: Pos -> + String -> + String -> + String -> + T_Elem +sem_Elem_Module pos_ name_ exports_ imports_ = + (T_Elem (\ _lhsIallAttrDecls + _lhsIallAttrs + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIattrs + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOmoduleDecl :: (Maybe (String,String,String)) + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _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) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOattrs :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + -- "./src-ag/Transform.ag"(line 1206, column 7) + _lhsOmoduleDecl = + ({-# LINE 1206 "./src-ag/Transform.ag" #-} + Just (name_, exports_, imports_) + {-# LINE 4676 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 908, column 55) + _lhsOattrOrderCollect = + ({-# LINE 908 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4682 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 46, column 19) + _lhsOblocks = + ({-# LINE 46 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4688 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 165, column 32) + _lhsOcollectedArounds = + ({-# LINE 165 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4694 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 164, column 32) + _lhsOcollectedAugments = + ({-# LINE 164 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4700 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 133, column 31) + _lhsOcollectedConParams = + ({-# LINE 133 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4706 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 132, column 33) + _lhsOcollectedConstraints = + ({-# LINE 132 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4712 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 100, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 100 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4718 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 131, column 28) + _lhsOcollectedFields = + ({-# LINE 131 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4724 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 162, column 32) + _lhsOcollectedInsts = + ({-# LINE 162 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4730 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1301, column 28) + _lhsOcollectedMacros = + ({-# LINE 1301 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4736 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 166, column 32) + _lhsOcollectedMerges = + ({-# LINE 166 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4742 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 4748 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 160, column 32) + _lhsOcollectedRules = + ({-# LINE 160 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4754 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 91, column 50) + _lhsOcollectedSetNames = + ({-# LINE 91 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 4760 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 161, column 32) + _lhsOcollectedSigs = + ({-# LINE 161 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4766 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 163, column 32) + _lhsOcollectedUniques = + ({-# LINE 163 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4772 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 963, column 34) + _lhsOctxCollect = + ({-# LINE 963 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4778 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1005, column 33) + _lhsOderivings = + ({-# LINE 1005 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4784 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + Seq.empty + {-# LINE 4790 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 940, column 37) + _lhsOparamsCollect = + ({-# LINE 940 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4796 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 801, column 34) + _lhsOpragmas = + ({-# LINE 801 "./src-ag/Transform.ag" #-} + id + {-# LINE 4802 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 988, column 36) + _lhsOquantCollect = + ({-# LINE 988 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4808 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 880, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 880 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4814 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 640, column 32) + _lhsOtypeSyns = + ({-# LINE 640 "./src-ag/Transform.ag" #-} + [] + {-# LINE 4820 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 146, column 15) + _lhsOuseMap = + ({-# LINE 146 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 4826 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 785, column 32) + _lhsOwrappers = + ({-# LINE 785 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 4832 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _lhsIattrDecls + {-# LINE 4838 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _lhsIattrs + {-# LINE 4844 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 110 "./src-ag/Transform.ag" #-} + _lhsIdefSets + {-# LINE 4850 "dist/build/Transform.hs" #-} + ) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +-- Elems ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allAttrDecls : Map NontermIdent (Attributes, Attributes) + allAttrs : Map NontermIdent (Attributes, Attributes) + allConstructors : Map NontermIdent (Set ConstructorIdent) + allFields : DataTypes + allNonterminals : Set NontermIdent + definedSets : DefinedSets + options : Options + chained attributes: + attrDecls : Map NontermIdent (Attributes, Attributes) + attrs : Map NontermIdent (Attributes, Attributes) + defSets : Map Identifier (Set NontermIdent,Set Identifier) + synthesized attributes: + attrOrderCollect : AttrOrderMap + blocks : Blocks + collectedArounds : [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] + collectedAugments : [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] + collectedConParams : [(NontermIdent, ConstructorIdent, Set Identifier)] + collectedConstraints : [(NontermIdent, ConstructorIdent, [Type])] + collectedConstructorsMap : Map NontermIdent (Set ConstructorIdent) + collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] + collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] + collectedMacros : [(NontermIdent, ConstructorIdent, MaybeMacro)] + collectedMerges : [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] + 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 + quantCollect : QuantMap + 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 (Attributes, Attributes)) -> + (Map NontermIdent (Set ConstructorIdent)) -> + DataTypes -> + (Set NontermIdent) -> + (Map NontermIdent (Attributes, Attributes)) -> + (Map NontermIdent (Attributes, Attributes)) -> + (Map Identifier (Set NontermIdent,Set Identifier)) -> + DefinedSets -> + Options -> + ( (Map NontermIdent (Attributes, Attributes)),AttrOrderMap,(Map NontermIdent (Attributes, Attributes)),Blocks,([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]),([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]),([(NontermIdent, ConstructorIdent, Set Identifier)]),([(NontermIdent, ConstructorIdent, [Type])]),(Map NontermIdent (Set ConstructorIdent)),([(NontermIdent, ConstructorIdent, FieldMap)]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([(NontermIdent, ConstructorIdent, MaybeMacro)]),([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]),(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),QuantMap,PragmaMap,TypeSyns,(Map NontermIdent (Map Identifier (String,String,String))),(Set NontermIdent))) +data Inh_Elems = Inh_Elems {allAttrDecls_Inh_Elems :: !((Map NontermIdent (Attributes, Attributes))),allAttrs_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))),attrs_Inh_Elems :: !((Map NontermIdent (Attributes, Attributes))),defSets_Inh_Elems :: !((Map Identifier (Set NontermIdent,Set Identifier))),definedSets_Inh_Elems :: !(DefinedSets),options_Inh_Elems :: !(Options)} +data Syn_Elems = Syn_Elems {attrDecls_Syn_Elems :: !((Map NontermIdent (Attributes, Attributes))),attrOrderCollect_Syn_Elems :: !(AttrOrderMap),attrs_Syn_Elems :: !((Map NontermIdent (Attributes, Attributes))),blocks_Syn_Elems :: !(Blocks),collectedArounds_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])),collectedAugments_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])),collectedConParams_Syn_Elems :: !(([(NontermIdent, ConstructorIdent, Set Identifier)])),collectedConstraints_Syn_Elems :: !(([(NontermIdent, ConstructorIdent, [Type])])),collectedConstructorsMap_Syn_Elems :: !((Map NontermIdent (Set ConstructorIdent))),collectedFields_Syn_Elems :: !(([(NontermIdent, ConstructorIdent, FieldMap)])),collectedInsts_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, [Identifier]) ])),collectedMacros_Syn_Elems :: !(([(NontermIdent, ConstructorIdent, MaybeMacro)])),collectedMerges_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])),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)),quantCollect_Syn_Elems :: !(QuantMap),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 -> + Inh_Elems -> + Syn_Elems +wrap_Elems (T_Elems sem) (Inh_Elems _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) = + (let ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers) = sem _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions + in (Syn_Elems _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _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 + _lhsIallAttrs + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIattrs + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _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) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOattrs :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _hdOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _hdOallAttrs :: (Map NontermIdent (Attributes, Attributes)) + _hdOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _hdOallFields :: DataTypes + _hdOallNonterminals :: (Set NontermIdent) + _hdOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _hdOattrs :: (Map NontermIdent (Attributes, Attributes)) + _hdOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _hdOdefinedSets :: DefinedSets + _hdOoptions :: Options + _tlOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _tlOallAttrs :: (Map NontermIdent (Attributes, Attributes)) + _tlOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) + _tlOallFields :: DataTypes + _tlOallNonterminals :: (Set NontermIdent) + _tlOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _tlOattrs :: (Map NontermIdent (Attributes, Attributes)) + _tlOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + _tlOdefinedSets :: DefinedSets + _tlOoptions :: Options + _hdIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _hdIattrOrderCollect :: AttrOrderMap + _hdIattrs :: (Map NontermIdent (Attributes, Attributes)) + _hdIblocks :: Blocks + _hdIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _hdIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _hdIcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _hdIcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _hdIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _hdIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _hdIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _hdIcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _hdIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _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) + _hdIquantCollect :: QuantMap + _hdIsemPragmasCollect :: PragmaMap + _hdItypeSyns :: TypeSyns + _hdIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _hdIwrappers :: (Set NontermIdent) + _tlIattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _tlIattrOrderCollect :: AttrOrderMap + _tlIattrs :: (Map NontermIdent (Attributes, Attributes)) + _tlIblocks :: Blocks + _tlIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _tlIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _tlIcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _tlIcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _tlIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _tlIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _tlIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _tlIcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _tlIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _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) + _tlIquantCollect :: QuantMap + _tlIsemPragmasCollect :: PragmaMap + _tlItypeSyns :: TypeSyns + _tlIuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _tlIwrappers :: (Set NontermIdent) + -- use rule "./src-ag/Transform.ag"(line 908, column 55) + _lhsOattrOrderCollect = + ({-# LINE 908 "./src-ag/Transform.ag" #-} + _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect + {-# LINE 5055 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 46, column 19) + _lhsOblocks = + ({-# LINE 46 "./src-ag/Transform.ag" #-} + _hdIblocks `mapUnionWithPlusPlus` _tlIblocks + {-# LINE 5061 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 165, column 32) + _lhsOcollectedArounds = + ({-# LINE 165 "./src-ag/Transform.ag" #-} + _hdIcollectedArounds ++ _tlIcollectedArounds + {-# LINE 5067 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 164, column 32) + _lhsOcollectedAugments = + ({-# LINE 164 "./src-ag/Transform.ag" #-} + _hdIcollectedAugments ++ _tlIcollectedAugments + {-# LINE 5073 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 133, column 31) + _lhsOcollectedConParams = + ({-# LINE 133 "./src-ag/Transform.ag" #-} + _hdIcollectedConParams ++ _tlIcollectedConParams + {-# LINE 5079 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 132, column 33) + _lhsOcollectedConstraints = + ({-# LINE 132 "./src-ag/Transform.ag" #-} + _hdIcollectedConstraints ++ _tlIcollectedConstraints + {-# LINE 5085 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 100, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 100 "./src-ag/Transform.ag" #-} + _hdIcollectedConstructorsMap `mapUnionWithSetUnion` _tlIcollectedConstructorsMap + {-# LINE 5091 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 131, column 28) + _lhsOcollectedFields = + ({-# LINE 131 "./src-ag/Transform.ag" #-} + _hdIcollectedFields ++ _tlIcollectedFields + {-# LINE 5097 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 162, column 32) + _lhsOcollectedInsts = + ({-# LINE 162 "./src-ag/Transform.ag" #-} + _hdIcollectedInsts ++ _tlIcollectedInsts + {-# LINE 5103 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1301, column 28) + _lhsOcollectedMacros = + ({-# LINE 1301 "./src-ag/Transform.ag" #-} + _hdIcollectedMacros ++ _tlIcollectedMacros + {-# LINE 5109 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 166, column 32) + _lhsOcollectedMerges = + ({-# LINE 166 "./src-ag/Transform.ag" #-} + _hdIcollectedMerges ++ _tlIcollectedMerges + {-# LINE 5115 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + _hdIcollectedNames `Set.union` _tlIcollectedNames + {-# LINE 5121 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 160, column 32) + _lhsOcollectedRules = + ({-# LINE 160 "./src-ag/Transform.ag" #-} + _hdIcollectedRules ++ _tlIcollectedRules + {-# LINE 5127 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 91, column 50) + _lhsOcollectedSetNames = + ({-# LINE 91 "./src-ag/Transform.ag" #-} + _hdIcollectedSetNames `Set.union` _tlIcollectedSetNames + {-# LINE 5133 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 161, column 32) + _lhsOcollectedSigs = + ({-# LINE 161 "./src-ag/Transform.ag" #-} + _hdIcollectedSigs ++ _tlIcollectedSigs + {-# LINE 5139 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 163, column 32) + _lhsOcollectedUniques = + ({-# LINE 163 "./src-ag/Transform.ag" #-} + _hdIcollectedUniques ++ _tlIcollectedUniques + {-# LINE 5145 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 963, column 34) + _lhsOctxCollect = + ({-# LINE 963 "./src-ag/Transform.ag" #-} + _hdIctxCollect `mergeCtx` _tlIctxCollect + {-# LINE 5151 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1005, column 33) + _lhsOderivings = + ({-# LINE 1005 "./src-ag/Transform.ag" #-} + _hdIderivings `mergeDerivings` _tlIderivings + {-# LINE 5157 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 5163 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1202, column 37) + _lhsOmoduleDecl = + ({-# LINE 1202 "./src-ag/Transform.ag" #-} + _hdImoduleDecl `mplus` _tlImoduleDecl + {-# LINE 5169 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 940, column 37) + _lhsOparamsCollect = + ({-# LINE 940 "./src-ag/Transform.ag" #-} + _hdIparamsCollect `mergeParams` _tlIparamsCollect + {-# LINE 5175 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 801, column 34) + _lhsOpragmas = + ({-# LINE 801 "./src-ag/Transform.ag" #-} + _hdIpragmas . _tlIpragmas + {-# LINE 5181 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 988, column 36) + _lhsOquantCollect = + ({-# LINE 988 "./src-ag/Transform.ag" #-} + _hdIquantCollect `mergeQuant` _tlIquantCollect + {-# LINE 5187 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 880, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 880 "./src-ag/Transform.ag" #-} + _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect + {-# LINE 5193 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 640, column 32) + _lhsOtypeSyns = + ({-# LINE 640 "./src-ag/Transform.ag" #-} + _hdItypeSyns ++ _tlItypeSyns + {-# LINE 5199 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 146, column 15) + _lhsOuseMap = + ({-# LINE 146 "./src-ag/Transform.ag" #-} + _hdIuseMap `merge` _tlIuseMap + {-# LINE 5205 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 785, column 32) + _lhsOwrappers = + ({-# LINE 785 "./src-ag/Transform.ag" #-} + _hdIwrappers `Set.union` _tlIwrappers + {-# LINE 5211 "dist/build/Transform.hs" #-} + ) + -- copy rule (up) + _lhsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _tlIattrDecls + {-# LINE 5217 "dist/build/Transform.hs" #-} + ) + -- copy rule (up) + _lhsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _tlIattrs + {-# LINE 5223 "dist/build/Transform.hs" #-} + ) + -- copy rule (up) + _lhsOdefSets = + ({-# LINE 110 "./src-ag/Transform.ag" #-} + _tlIdefSets + {-# LINE 5229 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOallAttrDecls = + ({-# LINE 909 "./src-ag/Transform.ag" #-} + _lhsIallAttrDecls + {-# LINE 5235 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOallAttrs = + ({-# LINE 1324 "./src-ag/Transform.ag" #-} + _lhsIallAttrs + {-# LINE 5241 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOallConstructors = + ({-# LINE 102 "./src-ag/Transform.ag" #-} + _lhsIallConstructors + {-# LINE 5247 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 5253 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 5259 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _lhsIattrDecls + {-# LINE 5265 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _lhsIattrs + {-# LINE 5271 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOdefSets = + ({-# LINE 110 "./src-ag/Transform.ag" #-} + _lhsIdefSets + {-# LINE 5277 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOdefinedSets = + ({-# LINE 113 "./src-ag/Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 5283 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 40 "./src-ag/Transform.ag" #-} + _lhsIoptions + {-# LINE 5289 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOallAttrDecls = + ({-# LINE 909 "./src-ag/Transform.ag" #-} + _lhsIallAttrDecls + {-# LINE 5295 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOallAttrs = + ({-# LINE 1324 "./src-ag/Transform.ag" #-} + _lhsIallAttrs + {-# LINE 5301 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOallConstructors = + ({-# LINE 102 "./src-ag/Transform.ag" #-} + _lhsIallConstructors + {-# LINE 5307 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 5313 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 5319 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _tlOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _hdIattrDecls + {-# LINE 5325 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _tlOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _hdIattrs + {-# LINE 5331 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _tlOdefSets = + ({-# LINE 110 "./src-ag/Transform.ag" #-} + _hdIdefSets + {-# LINE 5337 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOdefinedSets = + ({-# LINE 113 "./src-ag/Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 5343 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 40 "./src-ag/Transform.ag" #-} + _lhsIoptions + {-# LINE 5349 "dist/build/Transform.hs" #-} + ) + ( _hdIattrDecls,_hdIattrOrderCollect,_hdIattrs,_hdIblocks,_hdIcollectedArounds,_hdIcollectedAugments,_hdIcollectedConParams,_hdIcollectedConstraints,_hdIcollectedConstructorsMap,_hdIcollectedFields,_hdIcollectedInsts,_hdIcollectedMacros,_hdIcollectedMerges,_hdIcollectedNames,_hdIcollectedRules,_hdIcollectedSetNames,_hdIcollectedSigs,_hdIcollectedUniques,_hdIctxCollect,_hdIdefSets,_hdIderivings,_hdIerrors,_hdImoduleDecl,_hdIparamsCollect,_hdIpragmas,_hdIquantCollect,_hdIsemPragmasCollect,_hdItypeSyns,_hdIuseMap,_hdIwrappers) = + hd_ _hdOallAttrDecls _hdOallAttrs _hdOallConstructors _hdOallFields _hdOallNonterminals _hdOattrDecls _hdOattrs _hdOdefSets _hdOdefinedSets _hdOoptions + ( _tlIattrDecls,_tlIattrOrderCollect,_tlIattrs,_tlIblocks,_tlIcollectedArounds,_tlIcollectedAugments,_tlIcollectedConParams,_tlIcollectedConstraints,_tlIcollectedConstructorsMap,_tlIcollectedFields,_tlIcollectedInsts,_tlIcollectedMacros,_tlIcollectedMerges,_tlIcollectedNames,_tlIcollectedRules,_tlIcollectedSetNames,_tlIcollectedSigs,_tlIcollectedUniques,_tlIctxCollect,_tlIdefSets,_tlIderivings,_tlIerrors,_tlImoduleDecl,_tlIparamsCollect,_tlIpragmas,_tlIquantCollect,_tlIsemPragmasCollect,_tlItypeSyns,_tlIuseMap,_tlIwrappers) = + tl_ _tlOallAttrDecls _tlOallAttrs _tlOallConstructors _tlOallFields _tlOallNonterminals _tlOattrDecls _tlOattrs _tlOdefSets _tlOdefinedSets _tlOoptions + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +sem_Elems_Nil :: T_Elems +sem_Elems_Nil = + (T_Elems (\ _lhsIallAttrDecls + _lhsIallAttrs + _lhsIallConstructors + _lhsIallFields + _lhsIallNonterminals + _lhsIattrDecls + _lhsIattrs + _lhsIdefSets + _lhsIdefinedSets + _lhsIoptions -> + (let _lhsOattrOrderCollect :: AttrOrderMap + _lhsOblocks :: Blocks + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)]) + _lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])]) + _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) + _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _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) + _lhsOquantCollect :: QuantMap + _lhsOsemPragmasCollect :: PragmaMap + _lhsOtypeSyns :: TypeSyns + _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String))) + _lhsOwrappers :: (Set NontermIdent) + _lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes)) + _lhsOattrs :: (Map NontermIdent (Attributes, Attributes)) + _lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier)) + -- use rule "./src-ag/Transform.ag"(line 908, column 55) + _lhsOattrOrderCollect = + ({-# LINE 908 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 5402 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 46, column 19) + _lhsOblocks = + ({-# LINE 46 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 5408 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 165, column 32) + _lhsOcollectedArounds = + ({-# LINE 165 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5414 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 164, column 32) + _lhsOcollectedAugments = + ({-# LINE 164 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5420 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 133, column 31) + _lhsOcollectedConParams = + ({-# LINE 133 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5426 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 132, column 33) + _lhsOcollectedConstraints = + ({-# LINE 132 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5432 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 100, column 48) + _lhsOcollectedConstructorsMap = + ({-# LINE 100 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 5438 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 131, column 28) + _lhsOcollectedFields = + ({-# LINE 131 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5444 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 162, column 32) + _lhsOcollectedInsts = + ({-# LINE 162 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5450 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1301, column 28) + _lhsOcollectedMacros = + ({-# LINE 1301 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5456 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 166, column 32) + _lhsOcollectedMerges = + ({-# LINE 166 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5462 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 5468 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 160, column 32) + _lhsOcollectedRules = + ({-# LINE 160 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5474 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 91, column 50) + _lhsOcollectedSetNames = + ({-# LINE 91 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 5480 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 161, column 32) + _lhsOcollectedSigs = + ({-# LINE 161 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5486 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 163, column 32) + _lhsOcollectedUniques = + ({-# LINE 163 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5492 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 963, column 34) + _lhsOctxCollect = + ({-# LINE 963 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 5498 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1005, column 33) + _lhsOderivings = + ({-# LINE 1005 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 5504 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + Seq.empty + {-# LINE 5510 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1202, column 37) + _lhsOmoduleDecl = + ({-# LINE 1202 "./src-ag/Transform.ag" #-} + mzero + {-# LINE 5516 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 940, column 37) + _lhsOparamsCollect = + ({-# LINE 940 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 5522 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 801, column 34) + _lhsOpragmas = + ({-# LINE 801 "./src-ag/Transform.ag" #-} + id + {-# LINE 5528 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 988, column 36) + _lhsOquantCollect = + ({-# LINE 988 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 5534 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 880, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 880 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 5540 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 640, column 32) + _lhsOtypeSyns = + ({-# LINE 640 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5546 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 146, column 15) + _lhsOuseMap = + ({-# LINE 146 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 5552 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 785, column 32) + _lhsOwrappers = + ({-# LINE 785 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 5558 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrDecls = + ({-# LINE 145 "./src-ag/Transform.ag" #-} + _lhsIattrDecls + {-# LINE 5564 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOattrs = + ({-# LINE 1334 "./src-ag/Transform.ag" #-} + _lhsIattrs + {-# LINE 5570 "dist/build/Transform.hs" #-} + ) + -- copy rule (chain) + _lhsOdefSets = + ({-# LINE 110 "./src-ag/Transform.ag" #-} + _lhsIdefSets + {-# LINE 5576 "dist/build/Transform.hs" #-} + ) + in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers)))) +-- Field ------------------------------------------------------- +{- + visit 0: + inherited attribute: + allNonterminals : Set NontermIdent + synthesized attributes: + collectedConstraints : [Type] + collectedFields : [(Identifier, Type)] + alternatives: + alternative FChild: + child name : {Identifier} + child tp : {Type} + alternative FCtx: + child tps : {[Type]} +-} +-- cata +sem_Field :: Field -> + T_Field +sem_Field (FChild _name _tp) = + (sem_Field_FChild _name _tp) +sem_Field (FCtx _tps) = + (sem_Field_FCtx _tps) +-- semantic domain +newtype T_Field = T_Field ((Set NontermIdent) -> + ( ([Type]),([(Identifier, Type)]))) +data Inh_Field = Inh_Field {allNonterminals_Inh_Field :: !((Set NontermIdent))} +data Syn_Field = Syn_Field {collectedConstraints_Syn_Field :: !(([Type])),collectedFields_Syn_Field :: !(([(Identifier, Type)]))} +wrap_Field :: T_Field -> + Inh_Field -> + Syn_Field +wrap_Field (T_Field sem) (Inh_Field _lhsIallNonterminals) = + (let ( _lhsOcollectedConstraints,_lhsOcollectedFields) = sem _lhsIallNonterminals + in (Syn_Field _lhsOcollectedConstraints _lhsOcollectedFields)) +sem_Field_FChild :: Identifier -> + Type -> + T_Field +sem_Field_FChild name_ tp_ = + (T_Field (\ _lhsIallNonterminals -> + (let _lhsOcollectedFields :: ([(Identifier, Type)]) + _lhsOcollectedConstraints :: ([Type]) + -- "./src-ag/Transform.ag"(line 578, column 3) + _lhsOcollectedFields = + ({-# LINE 578 "./src-ag/Transform.ag" #-} + [(name_, makeType _lhsIallNonterminals tp_)] + {-# LINE 5623 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 584, column 46) + _lhsOcollectedConstraints = + ({-# LINE 584 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5629 "dist/build/Transform.hs" #-} + ) + in ( _lhsOcollectedConstraints,_lhsOcollectedFields)))) +sem_Field_FCtx :: ([Type]) -> + T_Field +sem_Field_FCtx tps_ = + (T_Field (\ _lhsIallNonterminals -> + (let _lhsOcollectedConstraints :: ([Type]) + _lhsOcollectedFields :: ([(Identifier, Type)]) + -- "./src-ag/Transform.ag"(line 587, column 3) + _lhsOcollectedConstraints = + ({-# LINE 587 "./src-ag/Transform.ag" #-} + tps_ + {-# LINE 5642 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 575, column 41) + _lhsOcollectedFields = + ({-# LINE 575 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5648 "dist/build/Transform.hs" #-} + ) + in ( _lhsOcollectedConstraints,_lhsOcollectedFields)))) +-- Fields ------------------------------------------------------ +{- + visit 0: + inherited attribute: + allNonterminals : Set NontermIdent + synthesized attributes: + collectedConstraints : [Type] + collectedFields : [(Identifier, Type)] + alternatives: + alternative Cons: + child hd : Field + child tl : Fields + alternative Nil: +-} +-- cata +sem_Fields :: Fields -> + T_Fields +sem_Fields list = + (Prelude.foldr sem_Fields_Cons sem_Fields_Nil (Prelude.map sem_Field list)) +-- semantic domain +newtype T_Fields = T_Fields ((Set NontermIdent) -> + ( ([Type]),([(Identifier, Type)]))) +data Inh_Fields = Inh_Fields {allNonterminals_Inh_Fields :: !((Set NontermIdent))} +data Syn_Fields = Syn_Fields {collectedConstraints_Syn_Fields :: !(([Type])),collectedFields_Syn_Fields :: !(([(Identifier, Type)]))} +wrap_Fields :: T_Fields -> + Inh_Fields -> + Syn_Fields +wrap_Fields (T_Fields sem) (Inh_Fields _lhsIallNonterminals) = + (let ( _lhsOcollectedConstraints,_lhsOcollectedFields) = sem _lhsIallNonterminals + in (Syn_Fields _lhsOcollectedConstraints _lhsOcollectedFields)) +sem_Fields_Cons :: T_Field -> + T_Fields -> + T_Fields +sem_Fields_Cons (T_Field hd_) (T_Fields tl_) = + (T_Fields (\ _lhsIallNonterminals -> + (let _lhsOcollectedConstraints :: ([Type]) + _lhsOcollectedFields :: ([(Identifier, Type)]) + _hdOallNonterminals :: (Set NontermIdent) + _tlOallNonterminals :: (Set NontermIdent) + _hdIcollectedConstraints :: ([Type]) + _hdIcollectedFields :: ([(Identifier, Type)]) + _tlIcollectedConstraints :: ([Type]) + _tlIcollectedFields :: ([(Identifier, Type)]) + -- use rule "./src-ag/Transform.ag"(line 584, column 46) + _lhsOcollectedConstraints = + ({-# LINE 584 "./src-ag/Transform.ag" #-} + _hdIcollectedConstraints ++ _tlIcollectedConstraints + {-# LINE 5698 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 575, column 41) + _lhsOcollectedFields = + ({-# LINE 575 "./src-ag/Transform.ag" #-} + _hdIcollectedFields ++ _tlIcollectedFields + {-# LINE 5704 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 5710 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 5716 "dist/build/Transform.hs" #-} + ) + ( _hdIcollectedConstraints,_hdIcollectedFields) = + hd_ _hdOallNonterminals + ( _tlIcollectedConstraints,_tlIcollectedFields) = + tl_ _tlOallNonterminals + in ( _lhsOcollectedConstraints,_lhsOcollectedFields)))) +sem_Fields_Nil :: T_Fields +sem_Fields_Nil = + (T_Fields (\ _lhsIallNonterminals -> + (let _lhsOcollectedConstraints :: ([Type]) + _lhsOcollectedFields :: ([(Identifier, Type)]) + -- use rule "./src-ag/Transform.ag"(line 584, column 46) + _lhsOcollectedConstraints = + ({-# LINE 584 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5732 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 575, column 41) + _lhsOcollectedFields = + ({-# LINE 575 "./src-ag/Transform.ag" #-} + [] + {-# LINE 5738 "dist/build/Transform.hs" #-} + ) + in ( _lhsOcollectedConstraints,_lhsOcollectedFields)))) +-- 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 NamedSet: + child name : {NontermIdent} + visit 0: + local nontSet : _ + local errors : _ + alternative All: + alternative Union: + child set1 : NontSet + child set2 : NontSet + alternative Intersect: + child set1 : NontSet + child set2 : NontSet + alternative Difference: + child set1 : NontSet + child set2 : NontSet + alternative Path: + child from : {NontermIdent} + child to : {NontermIdent} +-} +-- cata +sem_NontSet :: NontSet -> + T_NontSet +sem_NontSet (NamedSet _name) = + (sem_NontSet_NamedSet _name) +sem_NontSet (All) = + (sem_NontSet_All) +sem_NontSet (Union _set1 _set2) = + (sem_NontSet_Union (sem_NontSet _set1) (sem_NontSet _set2)) +sem_NontSet (Intersect _set1 _set2) = + (sem_NontSet_Intersect (sem_NontSet _set1) (sem_NontSet _set2)) +sem_NontSet (Difference _set1 _set2) = + (sem_NontSet_Difference (sem_NontSet _set1) (sem_NontSet _set2)) +sem_NontSet (Path _from _to) = + (sem_NontSet_Path _from _to) +-- 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 -> + Inh_NontSet -> + Syn_NontSet +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_NamedSet :: NontermIdent -> + T_NontSet +sem_NontSet_NamedSet name_ = + (T_NontSet (\ _lhsIallFields + _lhsIallNonterminals + _lhsIdefinedSets -> + (let _lhsOcollectedNames :: (Set Identifier) + _lhsOerrors :: (Seq Error) + _lhsOnontSet :: (Set NontermIdent) + -- "./src-ag/Transform.ag"(line 602, column 14) + _lhsOcollectedNames = + ({-# LINE 602 "./src-ag/Transform.ag" #-} + Set.singleton name_ + {-# LINE 5813 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 732, column 20) + (_nontSet,_errors) = + ({-# LINE 732 "./src-ag/Transform.ag" #-} + case Map.lookup name_ _lhsIdefinedSets of + Nothing -> (Set.empty, Seq.singleton (UndefNont name_)) + Just set -> (set, Seq.empty) + {-# LINE 5821 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + _errors + {-# LINE 5827 "dist/build/Transform.hs" #-} + ) + -- copy rule (from local) + _lhsOnontSet = + ({-# LINE 118 "./src-ag/Transform.ag" #-} + _nontSet + {-# LINE 5833 "dist/build/Transform.hs" #-} + ) + in ( _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) + -- "./src-ag/Transform.ag"(line 731, column 16) + _lhsOnontSet = + ({-# LINE 731 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 5848 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 5854 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + Seq.empty + {-# LINE 5860 "dist/build/Transform.hs" #-} + ) + 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) + -- "./src-ag/Transform.ag"(line 735, column 16) + _lhsOnontSet = + ({-# LINE 735 "./src-ag/Transform.ag" #-} + Set.union _set1InontSet _set2InontSet + {-# LINE 5889 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + _set1IcollectedNames `Set.union` _set2IcollectedNames + {-# LINE 5895 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + _set1Ierrors Seq.>< _set2Ierrors + {-# LINE 5901 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set1OallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 5907 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set1OallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 5913 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set1OdefinedSets = + ({-# LINE 113 "./src-ag/Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 5919 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set2OallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 5925 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set2OallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 5931 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set2OdefinedSets = + ({-# LINE 113 "./src-ag/Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 5937 "dist/build/Transform.hs" #-} + ) + ( _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) + -- "./src-ag/Transform.ag"(line 736, column 16) + _lhsOnontSet = + ({-# LINE 736 "./src-ag/Transform.ag" #-} + Set.intersection _set1InontSet _set2InontSet + {-# LINE 5970 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + _set1IcollectedNames `Set.union` _set2IcollectedNames + {-# LINE 5976 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + _set1Ierrors Seq.>< _set2Ierrors + {-# LINE 5982 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set1OallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 5988 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set1OallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 5994 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set1OdefinedSets = + ({-# LINE 113 "./src-ag/Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 6000 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set2OallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 6006 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set2OallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 6012 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set2OdefinedSets = + ({-# LINE 113 "./src-ag/Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 6018 "dist/build/Transform.hs" #-} + ) + ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) = + set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets + ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) = + set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets + 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) + -- "./src-ag/Transform.ag"(line 737, column 16) + _lhsOnontSet = + ({-# LINE 737 "./src-ag/Transform.ag" #-} + Set.difference _set1InontSet _set2InontSet + {-# LINE 6051 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + _set1IcollectedNames `Set.union` _set2IcollectedNames + {-# LINE 6057 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + _set1Ierrors Seq.>< _set2Ierrors + {-# LINE 6063 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set1OallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 6069 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set1OallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 6075 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set1OdefinedSets = + ({-# LINE 113 "./src-ag/Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 6081 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set2OallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 6087 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set2OallNonterminals = + ({-# LINE 94 "./src-ag/Transform.ag" #-} + _lhsIallNonterminals + {-# LINE 6093 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _set2OdefinedSets = + ({-# LINE 113 "./src-ag/Transform.ag" #-} + _lhsIdefinedSets + {-# LINE 6099 "dist/build/Transform.hs" #-} + ) + ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) = + set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets + ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) = + set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets + 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) + -- "./src-ag/Transform.ag"(line 738, column 16) + _lhsOnontSet = + ({-# LINE 738 "./src-ag/Transform.ag" #-} + let table = flattenDatas _lhsIallFields + in path table from_ to_ + {-# LINE 6121 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 740, column 16) + _lhsOerrors = + ({-# LINE 740 "./src-ag/Transform.ag" #-} + let check name | Set.member name _lhsIallNonterminals + = Seq.empty + | otherwise = Seq.singleton (UndefNont name) + in check from_ >< check to_ + {-# LINE 6130 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 92, column 50) + _lhsOcollectedNames = + ({-# LINE 92 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 6136 "dist/build/Transform.hs" #-} + ) + in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet)))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : Pattern + definedAttrs : [AttrName] + definedInsts : [Identifier] + patunder : [AttrName]->Pattern + stpos : Pos + alternatives: + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Constr _name _pats) = + (sem_Pattern_Constr _name (sem_Patterns _pats)) +sem_Pattern (Product _pos _pats) = + (sem_Pattern_Product _pos (sem_Patterns _pats)) +sem_Pattern (Alias _field _attr _pat) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat)) +sem_Pattern (Irrefutable _pat) = + (sem_Pattern_Irrefutable (sem_Pattern _pat)) +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 -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem) (Inh_Pattern) = + (let ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos) = sem + in (Syn_Pattern _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) + -- "./src-ag/Transform.ag"(line 1182, column 12) + _lhsOpatunder = + ({-# LINE 1182 "./src-ag/Transform.ag" #-} + \us -> Constr name_ (_patsIpatunder us) + {-# LINE 6214 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1193, column 16) + _lhsOstpos = + ({-# LINE 1193 "./src-ag/Transform.ag" #-} + getPos name_ + {-# LINE 6220 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1173, column 42) + _lhsOdefinedAttrs = + ({-# LINE 1173 "./src-ag/Transform.ag" #-} + _patsIdefinedAttrs + {-# LINE 6226 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + _patsIdefinedInsts + {-# LINE 6232 "dist/build/Transform.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 6238 "dist/build/Transform.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 6244 "dist/build/Transform.hs" #-} + ) + ( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) = + pats_ + 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) + -- "./src-ag/Transform.ag"(line 1183, column 13) + _lhsOpatunder = + ({-# LINE 1183 "./src-ag/Transform.ag" #-} + \us -> Product pos_ (_patsIpatunder us) + {-# LINE 6266 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1194, column 16) + _lhsOstpos = + ({-# LINE 1194 "./src-ag/Transform.ag" #-} + pos_ + {-# LINE 6272 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1173, column 42) + _lhsOdefinedAttrs = + ({-# LINE 1173 "./src-ag/Transform.ag" #-} + _patsIdefinedAttrs + {-# LINE 6278 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + _patsIdefinedInsts + {-# LINE 6284 "dist/build/Transform.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 6290 "dist/build/Transform.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 6296 "dist/build/Transform.hs" #-} + ) + ( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) = + pats_ + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos))) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_) = + (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 + -- "./src-ag/Transform.ag"(line 1178, column 11) + _lhsOdefinedAttrs = + ({-# LINE 1178 "./src-ag/Transform.ag" #-} + (field_, attr_) : _patIdefinedAttrs + {-# LINE 6320 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1179, column 11) + _lhsOpatunder = + ({-# LINE 1179 "./src-ag/Transform.ag" #-} + \us -> if ((field_,attr_) `elem` us) then Underscore noPos else _copy + {-# LINE 6326 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1180, column 11) + _lhsOdefinedInsts = + ({-# LINE 1180 "./src-ag/Transform.ag" #-} + (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts + {-# LINE 6332 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1195, column 16) + _lhsOstpos = + ({-# LINE 1195 "./src-ag/Transform.ag" #-} + getPos field_ + {-# LINE 6338 "dist/build/Transform.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Alias field_ attr_ _patIcopy + {-# LINE 6344 "dist/build/Transform.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 6350 "dist/build/Transform.hs" #-} + ) + ( _patIcopy,_patIdefinedAttrs,_patIdefinedInsts,_patIpatunder,_patIstpos) = + pat_ + 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 + -- "./src-ag/Transform.ag"(line 1184, column 17) + _lhsOpatunder = + ({-# LINE 1184 "./src-ag/Transform.ag" #-} + \us -> Irrefutable (_patIpatunder us) + {-# LINE 6372 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1173, column 42) + _lhsOdefinedAttrs = + ({-# LINE 1173 "./src-ag/Transform.ag" #-} + _patIdefinedAttrs + {-# LINE 6378 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + _patIdefinedInsts + {-# LINE 6384 "dist/build/Transform.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 6390 "dist/build/Transform.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 6396 "dist/build/Transform.hs" #-} + ) + -- copy rule (up) + _lhsOstpos = + ({-# LINE 1190 "./src-ag/Transform.ag" #-} + _patIstpos + {-# LINE 6402 "dist/build/Transform.hs" #-} + ) + ( _patIcopy,_patIdefinedAttrs,_patIdefinedInsts,_patIpatunder,_patIstpos) = + pat_ + 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 + -- "./src-ag/Transform.ag"(line 1181, column 16) + _lhsOpatunder = + ({-# LINE 1181 "./src-ag/Transform.ag" #-} + \us -> _copy + {-# LINE 6419 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1196, column 16) + _lhsOstpos = + ({-# LINE 1196 "./src-ag/Transform.ag" #-} + pos_ + {-# LINE 6425 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1173, column 42) + _lhsOdefinedAttrs = + ({-# LINE 1173 "./src-ag/Transform.ag" #-} + [] + {-# LINE 6431 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + [] + {-# LINE 6437 "dist/build/Transform.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + Underscore pos_ + {-# LINE 6443 "dist/build/Transform.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 6449 "dist/build/Transform.hs" #-} + ) + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : Patterns + 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 -> + Inh_Patterns -> + Syn_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) + -- "./src-ag/Transform.ag"(line 1188, column 10) + _lhsOpatunder = + ({-# LINE 1188 "./src-ag/Transform.ag" #-} + \us -> (_hdIpatunder us) : (_tlIpatunder us) + {-# LINE 6506 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1173, column 42) + _lhsOdefinedAttrs = + ({-# LINE 1173 "./src-ag/Transform.ag" #-} + _hdIdefinedAttrs ++ _tlIdefinedAttrs + {-# LINE 6512 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + _hdIdefinedInsts ++ _tlIdefinedInsts + {-# LINE 6518 "dist/build/Transform.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 6524 "dist/build/Transform.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 6530 "dist/build/Transform.hs" #-} + ) + ( _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 + -- "./src-ag/Transform.ag"(line 1187, column 9) + _lhsOpatunder = + ({-# LINE 1187 "./src-ag/Transform.ag" #-} + \us -> [] + {-# LINE 6547 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1173, column 42) + _lhsOdefinedAttrs = + ({-# LINE 1173 "./src-ag/Transform.ag" #-} + [] + {-# LINE 6553 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + [] + {-# LINE 6559 "dist/build/Transform.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + [] + {-# LINE 6565 "dist/build/Transform.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 22 "./src-ag/Patterns.ag" #-} + _copy + {-# LINE 6571 "dist/build/Transform.hs" #-} + ) + in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder))) +-- SemAlt ------------------------------------------------------ +{- + visit 0: + inherited attributes: + allAttrDecls : Map NontermIdent (Attributes, Attributes) + allAttrs : Map NontermIdent (Attributes, Attributes) + allFields : DataTypes + nts : Set NontermIdent + options : Options + synthesized attributes: + attrOrderCollect : AttrOrderMap + collectedArounds : [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] + collectedAugments : [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] + collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] + collectedMerges : [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] + 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)) -> + (Map NontermIdent (Attributes, Attributes)) -> + DataTypes -> + (Set NontermIdent) -> + Options -> + ( AttrOrderMap,([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]),([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]),([ (NontermIdent, ConstructorIdent, RuleInfo)]),([ (NontermIdent, ConstructorIdent, SigInfo) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),(Seq Error),PragmaMap)) +data Inh_SemAlt = Inh_SemAlt {allAttrDecls_Inh_SemAlt :: !((Map NontermIdent (Attributes, Attributes))),allAttrs_Inh_SemAlt :: !((Map NontermIdent (Attributes, Attributes))),allFields_Inh_SemAlt :: !(DataTypes),nts_Inh_SemAlt :: !((Set NontermIdent)),options_Inh_SemAlt :: !(Options)} +data Syn_SemAlt = Syn_SemAlt {attrOrderCollect_Syn_SemAlt :: !(AttrOrderMap),collectedArounds_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])),collectedAugments_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])),collectedInsts_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, [Identifier]) ])),collectedMerges_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])),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 -> + Inh_SemAlt -> + Syn_SemAlt +wrap_SemAlt (T_SemAlt sem) (Inh_SemAlt _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions) = + (let ( _lhsOattrOrderCollect,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect) = sem _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions + in (Syn_SemAlt _lhsOattrOrderCollect _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedInsts _lhsOcollectedMerges _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 + _lhsIallAttrs + _lhsIallFields + _lhsInts + _lhsIoptions -> + (let _lhsOsemPragmasCollect :: PragmaMap + _lhsOattrOrderCollect :: AttrOrderMap + _lhsOerrors :: (Seq Error) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _rulesOoptions :: Options + _constructorSetIcollectedConstructorNames :: (Set ConstructorIdent) + _constructorSetIconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) + _constructorSetIerrors :: (Seq Error) + _rulesIaroundInfos :: ([AroundInfo]) + _rulesIaugmentInfos :: ([AugmentInfo]) + _rulesIdefinedInsts :: ([Identifier]) + _rulesIerrors :: (Seq Error) + _rulesImergeInfos :: ([MergeInfo]) + _rulesIorderDepsCollect :: (Set Dependency) + _rulesIpragmaNamesCollect :: ([Identifier]) + _rulesIruleInfos :: ([RuleInfo]) + _rulesIsigInfos :: ([SigInfo]) + _rulesIuniqueInfos :: ([UniqueInfo]) + -- "./src-ag/Transform.ag"(line 884, column 7) + _pragmaNames = + ({-# LINE 884 "./src-ag/Transform.ag" #-} + Set.fromList _rulesIpragmaNamesCollect + {-# LINE 6662 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 885, column 7) + _lhsOsemPragmasCollect = + ({-# LINE 885 "./src-ag/Transform.ag" #-} + foldr pragmaMapUnion Map.empty [ pragmaMapSingle nt con _pragmaNames + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + {-# LINE 6671 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 913, column 7) + _attrOrders = + ({-# LINE 913 "./src-ag/Transform.ag" #-} + [ orderMapSingle nt con _rulesIorderDepsCollect + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + {-# LINE 6680 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 919, column 7) + _lhsOattrOrderCollect = + ({-# LINE 919 "./src-ag/Transform.ag" #-} + foldr orderMapUnion Map.empty _attrOrders + {-# LINE 6686 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1097, column 12) + _coninfo = + ({-# LINE 1097 "./src-ag/Transform.ag" #-} + [ (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 + ] + {-# LINE 6697 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1104, column 12) + _lhsOerrors = + ({-# LINE 1104 "./src-ag/Transform.ag" #-} + Seq.fromList + [ UndefAlt nt con + | (nt, conset, conkeys) <- _coninfo + , con <- Set.toList (Set.difference conset conkeys) + ] + Seq.>< _rulesIerrors + {-# LINE 6708 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1110, column 12) + _lhsOcollectedRules = + ({-# LINE 1110 "./src-ag/Transform.ag" #-} + [ (nt,con,r) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + , r <- _rulesIruleInfos + ] + {-# LINE 6718 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1116, column 12) + _lhsOcollectedSigs = + ({-# LINE 1116 "./src-ag/Transform.ag" #-} + [ (nt,con,ts) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + , ts <- _rulesIsigInfos + ] + {-# LINE 6728 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1123, column 12) + _lhsOcollectedInsts = + ({-# LINE 1123 "./src-ag/Transform.ag" #-} + [ (nt,con,_rulesIdefinedInsts) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + {-# LINE 6737 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1129, column 12) + _lhsOcollectedUniques = + ({-# LINE 1129 "./src-ag/Transform.ag" #-} + [ (nt,con,_rulesIuniqueInfos) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + {-# LINE 6746 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1135, column 12) + _lhsOcollectedAugments = + ({-# LINE 1135 "./src-ag/Transform.ag" #-} + [ (nt, con, _rulesIaugmentInfos) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + {-# LINE 6755 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1141, column 12) + _lhsOcollectedArounds = + ({-# LINE 1141 "./src-ag/Transform.ag" #-} + [ (nt, con, _rulesIaroundInfos) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + {-# LINE 6764 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1147, column 12) + _lhsOcollectedMerges = + ({-# LINE 1147 "./src-ag/Transform.ag" #-} + [ (nt, con, _rulesImergeInfos) + | (nt, conset, _) <- _coninfo + , con <- Set.toList conset + ] + {-# LINE 6773 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _rulesOoptions = + ({-# LINE 40 "./src-ag/Transform.ag" #-} + _lhsIoptions + {-# LINE 6779 "dist/build/Transform.hs" #-} + ) + ( _constructorSetIcollectedConstructorNames,_constructorSetIconstructors,_constructorSetIerrors) = + constructorSet_ + ( _rulesIaroundInfos,_rulesIaugmentInfos,_rulesIdefinedInsts,_rulesIerrors,_rulesImergeInfos,_rulesIorderDepsCollect,_rulesIpragmaNamesCollect,_rulesIruleInfos,_rulesIsigInfos,_rulesIuniqueInfos) = + rules_ _rulesOoptions + in ( _lhsOattrOrderCollect,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect)))) +-- SemAlts ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allAttrDecls : Map NontermIdent (Attributes, Attributes) + allAttrs : Map NontermIdent (Attributes, Attributes) + allFields : DataTypes + nts : Set NontermIdent + options : Options + synthesized attributes: + attrOrderCollect : AttrOrderMap + collectedArounds : [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] + collectedAugments : [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] + collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] + collectedMerges : [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] + 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)) -> + (Map NontermIdent (Attributes, Attributes)) -> + DataTypes -> + (Set NontermIdent) -> + Options -> + ( AttrOrderMap,([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]),([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]),([ (NontermIdent, ConstructorIdent, RuleInfo)]),([ (NontermIdent, ConstructorIdent, SigInfo) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),(Seq Error),PragmaMap)) +data Inh_SemAlts = Inh_SemAlts {allAttrDecls_Inh_SemAlts :: !((Map NontermIdent (Attributes, Attributes))),allAttrs_Inh_SemAlts :: !((Map NontermIdent (Attributes, Attributes))),allFields_Inh_SemAlts :: !(DataTypes),nts_Inh_SemAlts :: !((Set NontermIdent)),options_Inh_SemAlts :: !(Options)} +data Syn_SemAlts = Syn_SemAlts {attrOrderCollect_Syn_SemAlts :: !(AttrOrderMap),collectedArounds_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])),collectedAugments_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])),collectedInsts_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, [Identifier]) ])),collectedMerges_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])),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 -> + Inh_SemAlts -> + Syn_SemAlts +wrap_SemAlts (T_SemAlts sem) (Inh_SemAlts _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions) = + (let ( _lhsOattrOrderCollect,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect) = sem _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions + in (Syn_SemAlts _lhsOattrOrderCollect _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedInsts _lhsOcollectedMerges _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 + _lhsIallAttrs + _lhsIallFields + _lhsInts + _lhsIoptions -> + (let _lhsOattrOrderCollect :: AttrOrderMap + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOerrors :: (Seq Error) + _lhsOsemPragmasCollect :: PragmaMap + _hdOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _hdOallAttrs :: (Map NontermIdent (Attributes, Attributes)) + _hdOallFields :: DataTypes + _hdOnts :: (Set NontermIdent) + _hdOoptions :: Options + _tlOallAttrDecls :: (Map NontermIdent (Attributes, Attributes)) + _tlOallAttrs :: (Map NontermIdent (Attributes, Attributes)) + _tlOallFields :: DataTypes + _tlOnts :: (Set NontermIdent) + _tlOoptions :: Options + _hdIattrOrderCollect :: AttrOrderMap + _hdIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _hdIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _hdIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _hdIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _hdIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _hdIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _hdIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _hdIerrors :: (Seq Error) + _hdIsemPragmasCollect :: PragmaMap + _tlIattrOrderCollect :: AttrOrderMap + _tlIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _tlIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _tlIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _tlIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _tlIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _tlIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _tlIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _tlIerrors :: (Seq Error) + _tlIsemPragmasCollect :: PragmaMap + -- use rule "./src-ag/Transform.ag"(line 908, column 55) + _lhsOattrOrderCollect = + ({-# LINE 908 "./src-ag/Transform.ag" #-} + _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect + {-# LINE 6885 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 165, column 32) + _lhsOcollectedArounds = + ({-# LINE 165 "./src-ag/Transform.ag" #-} + _hdIcollectedArounds ++ _tlIcollectedArounds + {-# LINE 6891 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 164, column 32) + _lhsOcollectedAugments = + ({-# LINE 164 "./src-ag/Transform.ag" #-} + _hdIcollectedAugments ++ _tlIcollectedAugments + {-# LINE 6897 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 162, column 32) + _lhsOcollectedInsts = + ({-# LINE 162 "./src-ag/Transform.ag" #-} + _hdIcollectedInsts ++ _tlIcollectedInsts + {-# LINE 6903 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 166, column 32) + _lhsOcollectedMerges = + ({-# LINE 166 "./src-ag/Transform.ag" #-} + _hdIcollectedMerges ++ _tlIcollectedMerges + {-# LINE 6909 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 160, column 32) + _lhsOcollectedRules = + ({-# LINE 160 "./src-ag/Transform.ag" #-} + _hdIcollectedRules ++ _tlIcollectedRules + {-# LINE 6915 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 161, column 32) + _lhsOcollectedSigs = + ({-# LINE 161 "./src-ag/Transform.ag" #-} + _hdIcollectedSigs ++ _tlIcollectedSigs + {-# LINE 6921 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 163, column 32) + _lhsOcollectedUniques = + ({-# LINE 163 "./src-ag/Transform.ag" #-} + _hdIcollectedUniques ++ _tlIcollectedUniques + {-# LINE 6927 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 6933 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 880, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 880 "./src-ag/Transform.ag" #-} + _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect + {-# LINE 6939 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOallAttrDecls = + ({-# LINE 909 "./src-ag/Transform.ag" #-} + _lhsIallAttrDecls + {-# LINE 6945 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOallAttrs = + ({-# LINE 1324 "./src-ag/Transform.ag" #-} + _lhsIallAttrs + {-# LINE 6951 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 6957 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOnts = + ({-# LINE 176 "./src-ag/Transform.ag" #-} + _lhsInts + {-# LINE 6963 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 40 "./src-ag/Transform.ag" #-} + _lhsIoptions + {-# LINE 6969 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOallAttrDecls = + ({-# LINE 909 "./src-ag/Transform.ag" #-} + _lhsIallAttrDecls + {-# LINE 6975 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOallAttrs = + ({-# LINE 1324 "./src-ag/Transform.ag" #-} + _lhsIallAttrs + {-# LINE 6981 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOallFields = + ({-# LINE 137 "./src-ag/Transform.ag" #-} + _lhsIallFields + {-# LINE 6987 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOnts = + ({-# LINE 176 "./src-ag/Transform.ag" #-} + _lhsInts + {-# LINE 6993 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 40 "./src-ag/Transform.ag" #-} + _lhsIoptions + {-# LINE 6999 "dist/build/Transform.hs" #-} + ) + ( _hdIattrOrderCollect,_hdIcollectedArounds,_hdIcollectedAugments,_hdIcollectedInsts,_hdIcollectedMerges,_hdIcollectedRules,_hdIcollectedSigs,_hdIcollectedUniques,_hdIerrors,_hdIsemPragmasCollect) = + hd_ _hdOallAttrDecls _hdOallAttrs _hdOallFields _hdOnts _hdOoptions + ( _tlIattrOrderCollect,_tlIcollectedArounds,_tlIcollectedAugments,_tlIcollectedInsts,_tlIcollectedMerges,_tlIcollectedRules,_tlIcollectedSigs,_tlIcollectedUniques,_tlIerrors,_tlIsemPragmasCollect) = + tl_ _tlOallAttrDecls _tlOallAttrs _tlOallFields _tlOnts _tlOoptions + in ( _lhsOattrOrderCollect,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect)))) +sem_SemAlts_Nil :: T_SemAlts +sem_SemAlts_Nil = + (T_SemAlts (\ _lhsIallAttrDecls + _lhsIallAttrs + _lhsIallFields + _lhsInts + _lhsIoptions -> + (let _lhsOattrOrderCollect :: AttrOrderMap + _lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) + _lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) + _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) + _lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) + _lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]) + _lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]) + _lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) + _lhsOerrors :: (Seq Error) + _lhsOsemPragmasCollect :: PragmaMap + -- use rule "./src-ag/Transform.ag"(line 908, column 55) + _lhsOattrOrderCollect = + ({-# LINE 908 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 7027 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 165, column 32) + _lhsOcollectedArounds = + ({-# LINE 165 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7033 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 164, column 32) + _lhsOcollectedAugments = + ({-# LINE 164 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7039 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 162, column 32) + _lhsOcollectedInsts = + ({-# LINE 162 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7045 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 166, column 32) + _lhsOcollectedMerges = + ({-# LINE 166 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7051 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 160, column 32) + _lhsOcollectedRules = + ({-# LINE 160 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7057 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 161, column 32) + _lhsOcollectedSigs = + ({-# LINE 161 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7063 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 163, column 32) + _lhsOcollectedUniques = + ({-# LINE 163 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7069 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + Seq.empty + {-# LINE 7075 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 880, column 56) + _lhsOsemPragmasCollect = + ({-# LINE 880 "./src-ag/Transform.ag" #-} + Map.empty + {-# LINE 7081 "dist/build/Transform.hs" #-} + ) + in ( _lhsOattrOrderCollect,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect)))) +-- SemDef ------------------------------------------------------ +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + aroundInfos : [AroundInfo] + augmentInfos : [AugmentInfo] + definedInsts : [Identifier] + errors : Seq Error + mergeInfos : [MergeInfo] + orderDepsCollect : Set Dependency + pragmaNamesCollect : [Identifier] + ruleInfos : [RuleInfo] + sigInfos : [SigInfo] + uniqueInfos : [UniqueInfo] + alternatives: + alternative Def: + child pos : {Pos} + child mbName : {Maybe Identifier} + child pattern : Pattern + child rhs : {Expression} + child owrt : {Bool} + child pure : {Bool} + child eager : {Bool} + alternative TypeDef: + child pos : {Pos} + child ident : {Identifier} + child tp : {Type} + alternative UniqueDef: + child ident : {Identifier} + child ref : {Identifier} + alternative AugmentDef: + child ident : {Identifier} + child rhs : {Expression} + alternative AroundDef: + child ident : {Identifier} + child rhs : {Expression} + alternative MergeDef: + child target : {Identifier} + child nt : {Identifier} + child sources : {[Identifier]} + child rhs : {Expression} + alternative SemPragma: + child names : {[NontermIdent]} + alternative AttrOrderBefore: + child before : {[Occurrence]} + child after : {[Occurrence]} + visit 0: + local dependency : _ +-} +-- cata +sem_SemDef :: SemDef -> + T_SemDef +sem_SemDef (Def _pos _mbName _pattern _rhs _owrt _pure _eager) = + (sem_SemDef_Def _pos _mbName (sem_Pattern _pattern) _rhs _owrt _pure _eager) +sem_SemDef (TypeDef _pos _ident _tp) = + (sem_SemDef_TypeDef _pos _ident _tp) +sem_SemDef (UniqueDef _ident _ref) = + (sem_SemDef_UniqueDef _ident _ref) +sem_SemDef (AugmentDef _ident _rhs) = + (sem_SemDef_AugmentDef _ident _rhs) +sem_SemDef (AroundDef _ident _rhs) = + (sem_SemDef_AroundDef _ident _rhs) +sem_SemDef (MergeDef _target _nt _sources _rhs) = + (sem_SemDef_MergeDef _target _nt _sources _rhs) +sem_SemDef (SemPragma _names) = + (sem_SemDef_SemPragma _names) +sem_SemDef (AttrOrderBefore _before _after) = + (sem_SemDef_AttrOrderBefore _before _after) +-- semantic domain +newtype T_SemDef = T_SemDef (Options -> + ( ([AroundInfo]),([AugmentInfo]),([Identifier]),(Seq Error),([MergeInfo]),(Set Dependency),([Identifier]),([RuleInfo]),([SigInfo]),([UniqueInfo]))) +data Inh_SemDef = Inh_SemDef {options_Inh_SemDef :: !(Options)} +data Syn_SemDef = Syn_SemDef {aroundInfos_Syn_SemDef :: !(([AroundInfo])),augmentInfos_Syn_SemDef :: !(([AugmentInfo])),definedInsts_Syn_SemDef :: !(([Identifier])),errors_Syn_SemDef :: !((Seq Error)),mergeInfos_Syn_SemDef :: !(([MergeInfo])),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 -> + Inh_SemDef -> + Syn_SemDef +wrap_SemDef (T_SemDef sem) (Inh_SemDef _lhsIoptions) = + (let ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos) = sem _lhsIoptions + in (Syn_SemDef _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos)) +sem_SemDef_Def :: Pos -> + (Maybe Identifier) -> + T_Pattern -> + Expression -> + Bool -> + Bool -> + Bool -> + T_SemDef +sem_SemDef_Def pos_ mbName_ (T_Pattern pattern_) rhs_ owrt_ pure_ eager_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOerrors :: (Seq Error) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + _patternIcopy :: Pattern + _patternIdefinedAttrs :: ([AttrName]) + _patternIdefinedInsts :: ([Identifier]) + _patternIpatunder :: ([AttrName]->Pattern) + _patternIstpos :: Pos + -- "./src-ag/Transform.ag"(line 555, column 3) + _lhsOerrors = + ({-# LINE 555 "./src-ag/Transform.ag" #-} + if checkParseRhs _lhsIoptions + then Seq.fromList $ checkRhs rhs_ + else Seq.empty + {-# LINE 7196 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1154, column 10) + _lhsOruleInfos = + ({-# LINE 1154 "./src-ag/Transform.ag" #-} + [ (mbName_, _patternIpatunder, rhs_, _patternIdefinedAttrs, owrt_, show _patternIstpos, pure_, eager_) ] + {-# LINE 7202 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1091, column 40) + _lhsOaroundInfos = + ({-# LINE 1091 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7208 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1090, column 40) + _lhsOaugmentInfos = + ({-# LINE 1090 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7214 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + _patternIdefinedInsts + {-# LINE 7220 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1092, column 40) + _lhsOmergeInfos = + ({-# LINE 1092 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7226 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 921, column 44) + _lhsOorderDepsCollect = + ({-# LINE 921 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 7232 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 890, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 890 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7238 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1088, column 40) + _lhsOsigInfos = + ({-# LINE 1088 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7244 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1089, column 40) + _lhsOuniqueInfos = + ({-# LINE 1089 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7250 "dist/build/Transform.hs" #-} + ) + ( _patternIcopy,_patternIdefinedAttrs,_patternIdefinedInsts,_patternIpatunder,_patternIstpos) = + pattern_ + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)))) +sem_SemDef_TypeDef :: Pos -> + Identifier -> + Type -> + T_SemDef +sem_SemDef_TypeDef pos_ ident_ tp_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOerrors :: (Seq Error) + _lhsOsigInfos :: ([SigInfo]) + _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- "./src-ag/Transform.ag"(line 562, column 3) + _lhsOerrors = + ({-# LINE 562 "./src-ag/Transform.ag" #-} + if checkParseTy _lhsIoptions + then case tp_ of + Haskell s -> let exp = Expression pos_ tks + tks = [tk] + tk = HsToken s pos_ + in Seq.fromList $ checkTy exp + _ -> Seq.empty + else Seq.empty + {-# LINE 7282 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1157, column 14) + _lhsOsigInfos = + ({-# LINE 1157 "./src-ag/Transform.ag" #-} + [ (ident_, tp_) ] + {-# LINE 7288 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1091, column 40) + _lhsOaroundInfos = + ({-# LINE 1091 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7294 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1090, column 40) + _lhsOaugmentInfos = + ({-# LINE 1090 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7300 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7306 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1092, column 40) + _lhsOmergeInfos = + ({-# LINE 1092 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7312 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 921, column 44) + _lhsOorderDepsCollect = + ({-# LINE 921 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 7318 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 890, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 890 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7324 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1087, column 40) + _lhsOruleInfos = + ({-# LINE 1087 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7330 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1089, column 40) + _lhsOuniqueInfos = + ({-# LINE 1089 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7336 "dist/build/Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)))) +sem_SemDef_UniqueDef :: Identifier -> + Identifier -> + T_SemDef +sem_SemDef_UniqueDef ident_ ref_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOuniqueInfos :: ([UniqueInfo]) + _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + -- "./src-ag/Transform.ag"(line 1160, column 16) + _lhsOuniqueInfos = + ({-# LINE 1160 "./src-ag/Transform.ag" #-} + [ (ident_, ref_) ] + {-# LINE 7358 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1091, column 40) + _lhsOaroundInfos = + ({-# LINE 1091 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7364 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1090, column 40) + _lhsOaugmentInfos = + ({-# LINE 1090 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7370 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7376 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + Seq.empty + {-# LINE 7382 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1092, column 40) + _lhsOmergeInfos = + ({-# LINE 1092 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7388 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 921, column 44) + _lhsOorderDepsCollect = + ({-# LINE 921 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 7394 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 890, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 890 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7400 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1087, column 40) + _lhsOruleInfos = + ({-# LINE 1087 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7406 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1088, column 40) + _lhsOsigInfos = + ({-# LINE 1088 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7412 "dist/build/Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)))) +sem_SemDef_AugmentDef :: Identifier -> + Expression -> + T_SemDef +sem_SemDef_AugmentDef ident_ rhs_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOaroundInfos :: ([AroundInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- "./src-ag/Transform.ag"(line 1163, column 17) + _lhsOaugmentInfos = + ({-# LINE 1163 "./src-ag/Transform.ag" #-} + [ (ident_, rhs_) ] + {-# LINE 7434 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1091, column 40) + _lhsOaroundInfos = + ({-# LINE 1091 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7440 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7446 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + Seq.empty + {-# LINE 7452 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1092, column 40) + _lhsOmergeInfos = + ({-# LINE 1092 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7458 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 921, column 44) + _lhsOorderDepsCollect = + ({-# LINE 921 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 7464 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 890, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 890 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7470 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1087, column 40) + _lhsOruleInfos = + ({-# LINE 1087 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7476 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1088, column 40) + _lhsOsigInfos = + ({-# LINE 1088 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7482 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1089, column 40) + _lhsOuniqueInfos = + ({-# LINE 1089 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7488 "dist/build/Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)))) +sem_SemDef_AroundDef :: Identifier -> + Expression -> + T_SemDef +sem_SemDef_AroundDef ident_ rhs_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- "./src-ag/Transform.ag"(line 1166, column 17) + _lhsOaroundInfos = + ({-# LINE 1166 "./src-ag/Transform.ag" #-} + [ (ident_, rhs_) ] + {-# LINE 7510 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1090, column 40) + _lhsOaugmentInfos = + ({-# LINE 1090 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7516 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7522 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + Seq.empty + {-# LINE 7528 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1092, column 40) + _lhsOmergeInfos = + ({-# LINE 1092 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7534 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 921, column 44) + _lhsOorderDepsCollect = + ({-# LINE 921 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 7540 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 890, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 890 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7546 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1087, column 40) + _lhsOruleInfos = + ({-# LINE 1087 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7552 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1088, column 40) + _lhsOsigInfos = + ({-# LINE 1088 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7558 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1089, column 40) + _lhsOuniqueInfos = + ({-# LINE 1089 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7564 "dist/build/Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)))) +sem_SemDef_MergeDef :: Identifier -> + Identifier -> + ([Identifier]) -> + Expression -> + T_SemDef +sem_SemDef_MergeDef target_ nt_ sources_ rhs_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- "./src-ag/Transform.ag"(line 555, column 3) + _lhsOerrors = + ({-# LINE 555 "./src-ag/Transform.ag" #-} + if checkParseRhs _lhsIoptions + then Seq.fromList $ checkRhs rhs_ + else Seq.empty + {-# LINE 7590 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 1169, column 17) + _lhsOmergeInfos = + ({-# LINE 1169 "./src-ag/Transform.ag" #-} + [ (target_, nt_, sources_, rhs_) ] + {-# LINE 7596 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1091, column 40) + _lhsOaroundInfos = + ({-# LINE 1091 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7602 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1090, column 40) + _lhsOaugmentInfos = + ({-# LINE 1090 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7608 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7614 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 921, column 44) + _lhsOorderDepsCollect = + ({-# LINE 921 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 7620 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 890, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 890 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7626 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1087, column 40) + _lhsOruleInfos = + ({-# LINE 1087 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7632 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1088, column 40) + _lhsOsigInfos = + ({-# LINE 1088 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7638 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1089, column 40) + _lhsOuniqueInfos = + ({-# LINE 1089 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7644 "dist/build/Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)))) +sem_SemDef_SemPragma :: ([NontermIdent]) -> + T_SemDef +sem_SemDef_SemPragma names_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- "./src-ag/Transform.ag"(line 894, column 7) + _lhsOpragmaNamesCollect = + ({-# LINE 894 "./src-ag/Transform.ag" #-} + names_ + {-# LINE 7665 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1091, column 40) + _lhsOaroundInfos = + ({-# LINE 1091 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7671 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1090, column 40) + _lhsOaugmentInfos = + ({-# LINE 1090 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7677 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7683 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + Seq.empty + {-# LINE 7689 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1092, column 40) + _lhsOmergeInfos = + ({-# LINE 1092 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7695 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 921, column 44) + _lhsOorderDepsCollect = + ({-# LINE 921 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 7701 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1087, column 40) + _lhsOruleInfos = + ({-# LINE 1087 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7707 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1088, column 40) + _lhsOsigInfos = + ({-# LINE 1088 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7713 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1089, column 40) + _lhsOuniqueInfos = + ({-# LINE 1089 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7719 "dist/build/Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)))) +sem_SemDef_AttrOrderBefore :: ([Occurrence]) -> + ([Occurrence]) -> + T_SemDef +sem_SemDef_AttrOrderBefore before_ after_ = + (T_SemDef (\ _lhsIoptions -> + (let _lhsOorderDepsCollect :: (Set Dependency) + _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- "./src-ag/Transform.ag"(line 925, column 7) + _dependency = + ({-# LINE 925 "./src-ag/Transform.ag" #-} + [ Dependency b a | b <- before_, a <- after_ ] + {-# LINE 7741 "dist/build/Transform.hs" #-} + ) + -- "./src-ag/Transform.ag"(line 926, column 7) + _lhsOorderDepsCollect = + ({-# LINE 926 "./src-ag/Transform.ag" #-} + Set.fromList _dependency + {-# LINE 7747 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1091, column 40) + _lhsOaroundInfos = + ({-# LINE 1091 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7753 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1090, column 40) + _lhsOaugmentInfos = + ({-# LINE 1090 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7759 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7765 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + Seq.empty + {-# LINE 7771 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1092, column 40) + _lhsOmergeInfos = + ({-# LINE 1092 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7777 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 890, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 890 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7783 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1087, column 40) + _lhsOruleInfos = + ({-# LINE 1087 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7789 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1088, column 40) + _lhsOsigInfos = + ({-# LINE 1088 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7795 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1089, column 40) + _lhsOuniqueInfos = + ({-# LINE 1089 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7801 "dist/build/Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)))) +-- SemDefs ----------------------------------------------------- +{- + visit 0: + inherited attribute: + options : Options + synthesized attributes: + aroundInfos : [AroundInfo] + augmentInfos : [AugmentInfo] + definedInsts : [Identifier] + errors : Seq Error + mergeInfos : [MergeInfo] + 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 (Options -> + ( ([AroundInfo]),([AugmentInfo]),([Identifier]),(Seq Error),([MergeInfo]),(Set Dependency),([Identifier]),([RuleInfo]),([SigInfo]),([UniqueInfo]))) +data Inh_SemDefs = Inh_SemDefs {options_Inh_SemDefs :: !(Options)} +data Syn_SemDefs = Syn_SemDefs {aroundInfos_Syn_SemDefs :: !(([AroundInfo])),augmentInfos_Syn_SemDefs :: !(([AugmentInfo])),definedInsts_Syn_SemDefs :: !(([Identifier])),errors_Syn_SemDefs :: !((Seq Error)),mergeInfos_Syn_SemDefs :: !(([MergeInfo])),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 -> + Inh_SemDefs -> + Syn_SemDefs +wrap_SemDefs (T_SemDefs sem) (Inh_SemDefs _lhsIoptions) = + (let ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos) = sem _lhsIoptions + in (Syn_SemDefs _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _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 (\ _lhsIoptions -> + (let _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + _hdOoptions :: Options + _tlOoptions :: Options + _hdIaroundInfos :: ([AroundInfo]) + _hdIaugmentInfos :: ([AugmentInfo]) + _hdIdefinedInsts :: ([Identifier]) + _hdIerrors :: (Seq Error) + _hdImergeInfos :: ([MergeInfo]) + _hdIorderDepsCollect :: (Set Dependency) + _hdIpragmaNamesCollect :: ([Identifier]) + _hdIruleInfos :: ([RuleInfo]) + _hdIsigInfos :: ([SigInfo]) + _hdIuniqueInfos :: ([UniqueInfo]) + _tlIaroundInfos :: ([AroundInfo]) + _tlIaugmentInfos :: ([AugmentInfo]) + _tlIdefinedInsts :: ([Identifier]) + _tlIerrors :: (Seq Error) + _tlImergeInfos :: ([MergeInfo]) + _tlIorderDepsCollect :: (Set Dependency) + _tlIpragmaNamesCollect :: ([Identifier]) + _tlIruleInfos :: ([RuleInfo]) + _tlIsigInfos :: ([SigInfo]) + _tlIuniqueInfos :: ([UniqueInfo]) + -- use rule "./src-ag/Transform.ag"(line 1091, column 40) + _lhsOaroundInfos = + ({-# LINE 1091 "./src-ag/Transform.ag" #-} + _hdIaroundInfos ++ _tlIaroundInfos + {-# LINE 7883 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1090, column 40) + _lhsOaugmentInfos = + ({-# LINE 1090 "./src-ag/Transform.ag" #-} + _hdIaugmentInfos ++ _tlIaugmentInfos + {-# LINE 7889 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + _hdIdefinedInsts ++ _tlIdefinedInsts + {-# LINE 7895 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + _hdIerrors Seq.>< _tlIerrors + {-# LINE 7901 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1092, column 40) + _lhsOmergeInfos = + ({-# LINE 1092 "./src-ag/Transform.ag" #-} + _hdImergeInfos ++ _tlImergeInfos + {-# LINE 7907 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 921, column 44) + _lhsOorderDepsCollect = + ({-# LINE 921 "./src-ag/Transform.ag" #-} + _hdIorderDepsCollect `Set.union` _tlIorderDepsCollect + {-# LINE 7913 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 890, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 890 "./src-ag/Transform.ag" #-} + _hdIpragmaNamesCollect ++ _tlIpragmaNamesCollect + {-# LINE 7919 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1087, column 40) + _lhsOruleInfos = + ({-# LINE 1087 "./src-ag/Transform.ag" #-} + _hdIruleInfos ++ _tlIruleInfos + {-# LINE 7925 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1088, column 40) + _lhsOsigInfos = + ({-# LINE 1088 "./src-ag/Transform.ag" #-} + _hdIsigInfos ++ _tlIsigInfos + {-# LINE 7931 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1089, column 40) + _lhsOuniqueInfos = + ({-# LINE 1089 "./src-ag/Transform.ag" #-} + _hdIuniqueInfos ++ _tlIuniqueInfos + {-# LINE 7937 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 40 "./src-ag/Transform.ag" #-} + _lhsIoptions + {-# LINE 7943 "dist/build/Transform.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 40 "./src-ag/Transform.ag" #-} + _lhsIoptions + {-# LINE 7949 "dist/build/Transform.hs" #-} + ) + ( _hdIaroundInfos,_hdIaugmentInfos,_hdIdefinedInsts,_hdIerrors,_hdImergeInfos,_hdIorderDepsCollect,_hdIpragmaNamesCollect,_hdIruleInfos,_hdIsigInfos,_hdIuniqueInfos) = + hd_ _hdOoptions + ( _tlIaroundInfos,_tlIaugmentInfos,_tlIdefinedInsts,_tlIerrors,_tlImergeInfos,_tlIorderDepsCollect,_tlIpragmaNamesCollect,_tlIruleInfos,_tlIsigInfos,_tlIuniqueInfos) = + tl_ _tlOoptions + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)))) +sem_SemDefs_Nil :: T_SemDefs +sem_SemDefs_Nil = + (T_SemDefs (\ _lhsIoptions -> + (let _lhsOaroundInfos :: ([AroundInfo]) + _lhsOaugmentInfos :: ([AugmentInfo]) + _lhsOdefinedInsts :: ([Identifier]) + _lhsOerrors :: (Seq Error) + _lhsOmergeInfos :: ([MergeInfo]) + _lhsOorderDepsCollect :: (Set Dependency) + _lhsOpragmaNamesCollect :: ([Identifier]) + _lhsOruleInfos :: ([RuleInfo]) + _lhsOsigInfos :: ([SigInfo]) + _lhsOuniqueInfos :: ([UniqueInfo]) + -- use rule "./src-ag/Transform.ag"(line 1091, column 40) + _lhsOaroundInfos = + ({-# LINE 1091 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7973 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1090, column 40) + _lhsOaugmentInfos = + ({-# LINE 1090 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7979 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1172, column 55) + _lhsOdefinedInsts = + ({-# LINE 1172 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7985 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 44, column 19) + _lhsOerrors = + ({-# LINE 44 "./src-ag/Transform.ag" #-} + Seq.empty + {-# LINE 7991 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1092, column 40) + _lhsOmergeInfos = + ({-# LINE 1092 "./src-ag/Transform.ag" #-} + [] + {-# LINE 7997 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 921, column 44) + _lhsOorderDepsCollect = + ({-# LINE 921 "./src-ag/Transform.ag" #-} + Set.empty + {-# LINE 8003 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 890, column 46) + _lhsOpragmaNamesCollect = + ({-# LINE 890 "./src-ag/Transform.ag" #-} + [] + {-# LINE 8009 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1087, column 40) + _lhsOruleInfos = + ({-# LINE 1087 "./src-ag/Transform.ag" #-} + [] + {-# LINE 8015 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1088, column 40) + _lhsOsigInfos = + ({-# LINE 1088 "./src-ag/Transform.ag" #-} + [] + {-# LINE 8021 "dist/build/Transform.hs" #-} + ) + -- use rule "./src-ag/Transform.ag"(line 1089, column 40) + _lhsOuniqueInfos = + ({-# LINE 1089 "./src-ag/Transform.ag" #-} + [] + {-# LINE 8027 "dist/build/Transform.hs" #-} + ) + in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos)))) diff --git a/dist/build/Visage.hs b/dist/build/Visage.hs new file mode 100644 --- /dev/null +++ b/dist/build/Visage.hs @@ -0,0 +1,768 @@ + + +-- UUAGC 0.9.42.0 (src-ag/Visage.ag) +module Visage where +{-# LINE 6 "./src-ag/Visage.ag" #-} + +import UU.Scanner.Position(Pos(..)) +import CommonTypes +import ATermAbstractSyntax +import Expression +import VisagePatterns +import VisageSyntax +import qualified Data.Map as Map +import Data.Map(Map) +import Data.List(intersperse) +import TokenDef +{-# LINE 18 "dist/build/Visage.hs" #-} + +{-# LINE 2 "./src-ag/VisageSyntax.ag" #-} + +import CommonTypes +import UU.Pretty +import AbstractSyntax +import VisagePatterns +import Expression +{-# LINE 27 "dist/build/Visage.hs" #-} + +{-# LINE 2 "./src-ag/VisagePatterns.ag" #-} + +import UU.Scanner.Position(Pos) +import CommonTypes +{-# LINE 33 "dist/build/Visage.hs" #-} + +{-# LINE 2 "./src-ag/Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 39 "dist/build/Visage.hs" #-} +{-# LINE 19 "./src-ag/Visage.ag" #-} + +convert :: String -> String +convert [] = [] +convert (c:ct) | c == '\n' = '\\' : 'n' : convert ct + | otherwise = c : convert ct + +sQ :: String -> String +sQ [] = [] +sQ (x:xs) = if (x=='"') then rest else x:rest + where + rest = if not (null xs) && last xs == '"' then init xs else xs + +showAGPos :: Pos -> String +showAGPos (Pos l c f) | l == (-1) = "" + | otherwise = let file = if null f then "" else f -- No show of f + lc = "(line " ++ show l ++ ", column " ++ show c ++")" + in file ++ lc + +showMap :: (Show a, Show b) => Map a b -> String +showMap + = braces . concat . intersperse "," . map (uncurry assign) . Map.assocs + where + braces s = "{" ++ s ++ "}" + assign a b = show a ++ ":=" ++ show b +{-# LINE 65 "dist/build/Visage.hs" #-} +-- Expression -------------------------------------------------- +{- + visit 0: + synthesized attribute: + aterm : ATerm + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} +-} +-- cata +sem_Expression :: Expression -> + T_Expression +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 -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem) (Inh_Expression) = + (let ( _lhsOaterm) = sem + in (Syn_Expression _lhsOaterm)) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (let _lhsOaterm :: ATerm + -- "./src-ag/Visage.ag"(line 103, column 17) + _lhsOaterm = + ({-# LINE 103 "./src-ag/Visage.ag" #-} + AAppl "Expression" [AString (sQ (showAGPos pos_)), AString (sQ (unlines . showTokens . tokensToStrings $ tks_))] + {-# LINE 100 "dist/build/Visage.hs" #-} + ) + in ( _lhsOaterm))) +-- VisageChild ------------------------------------------------- +{- + visit 0: + synthesized attribute: + aterm : ATerm + alternatives: + alternative VChild: + child name : {Identifier} + child tp : {Type} + child inh : {Attributes} + child syn : {Attributes} + 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)) +-- 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 -> + Inh_VisageChild -> + Syn_VisageChild +wrap_VisageChild (T_VisageChild sem) (Inh_VisageChild) = + (let ( _lhsOaterm) = sem + 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_) = + (T_VisageChild (let _lhsOaterm :: ATerm + _rulesOisLoc :: Bool + _rulesIaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 85, column 18) + _lhsOaterm = + ({-# LINE 85 "./src-ag/Visage.ag" #-} + AAppl "Child" [AString (sQ (getName name_)), AString (sQ (show tp_)), + AString (sQ (showMap inh_)), + AString (sQ (showMap syn_)), + AAppl "Rules" _rulesIaterms] + {-# LINE 148 "dist/build/Visage.hs" #-} + ) + -- "./src-ag/Visage.ag"(line 89, column 18) + _rulesOisLoc = + ({-# LINE 89 "./src-ag/Visage.ag" #-} + False + {-# LINE 154 "dist/build/Visage.hs" #-} + ) + ( _rulesIaterms) = + rules_ _rulesOisLoc + in ( _lhsOaterm))) +-- VisageChildren ---------------------------------------------- +{- + visit 0: + synthesized attribute: + aterms : [ATerm] + alternatives: + alternative Cons: + 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)) +-- 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 -> + Inh_VisageChildren -> + Syn_VisageChildren +wrap_VisageChildren (T_VisageChildren sem) (Inh_VisageChildren) = + (let ( _lhsOaterms) = sem + in (Syn_VisageChildren _lhsOaterms)) +sem_VisageChildren_Cons :: T_VisageChild -> + T_VisageChildren -> + T_VisageChildren +sem_VisageChildren_Cons (T_VisageChild hd_) (T_VisageChildren tl_) = + (T_VisageChildren (let _lhsOaterms :: ([ATerm]) + _hdIaterm :: ATerm + _tlIaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 80, column 17) + _lhsOaterms = + ({-# LINE 80 "./src-ag/Visage.ag" #-} + _hdIaterm : _tlIaterms + {-# LINE 196 "dist/build/Visage.hs" #-} + ) + ( _hdIaterm) = + hd_ + ( _tlIaterms) = + tl_ + in ( _lhsOaterms))) +sem_VisageChildren_Nil :: T_VisageChildren +sem_VisageChildren_Nil = + (T_VisageChildren (let _lhsOaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 81, column 17) + _lhsOaterms = + ({-# LINE 81 "./src-ag/Visage.ag" #-} + [] + {-# LINE 210 "dist/build/Visage.hs" #-} + ) + in ( _lhsOaterms))) +-- VisageGrammar ----------------------------------------------- +{- + visit 0: + synthesized attribute: + aterm : ATerm + alternatives: + alternative VGrammar: + child nonts : VisageNonterminals +-} +-- cata +sem_VisageGrammar :: VisageGrammar -> + T_VisageGrammar +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 -> + Inh_VisageGrammar -> + Syn_VisageGrammar +wrap_VisageGrammar (T_VisageGrammar sem) (Inh_VisageGrammar) = + (let ( _lhsOaterm) = sem + in (Syn_VisageGrammar _lhsOaterm)) +sem_VisageGrammar_VGrammar :: T_VisageNonterminals -> + T_VisageGrammar +sem_VisageGrammar_VGrammar (T_VisageNonterminals nonts_) = + (T_VisageGrammar (let _lhsOaterm :: ATerm + _nontsIaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 54, column 18) + _lhsOaterm = + ({-# LINE 54 "./src-ag/Visage.ag" #-} + AAppl "Productions" _nontsIaterms + {-# LINE 246 "dist/build/Visage.hs" #-} + ) + ( _nontsIaterms) = + nonts_ + in ( _lhsOaterm))) +-- VisageNonterminal ------------------------------------------- +{- + visit 0: + synthesized attribute: + aterm : ATerm + alternatives: + alternative VNonterminal: + child nt : {NontermIdent} + child inh : {Attributes} + child syn : {Attributes} + 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)) +-- 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 -> + Inh_VisageNonterminal -> + Syn_VisageNonterminal +wrap_VisageNonterminal (T_VisageNonterminal sem) (Inh_VisageNonterminal) = + (let ( _lhsOaterm) = sem + in (Syn_VisageNonterminal _lhsOaterm)) +sem_VisageNonterminal_VNonterminal :: NontermIdent -> + Attributes -> + Attributes -> + T_VisageProductions -> + T_VisageNonterminal +sem_VisageNonterminal_VNonterminal nt_ inh_ syn_ (T_VisageProductions alts_) = + (T_VisageNonterminal (let _lhsOaterm :: ATerm + _altsIaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 63, column 19) + _lhsOaterm = + ({-# LINE 63 "./src-ag/Visage.ag" #-} + AAppl "Production" [AString (sQ (getName nt_)), AString (sQ(showMap inh_)), + AString (sQ(showMap syn_)), AAppl "Alternatives" _altsIaterms] + {-# LINE 291 "dist/build/Visage.hs" #-} + ) + ( _altsIaterms) = + alts_ + in ( _lhsOaterm))) +-- VisageNonterminals ------------------------------------------ +{- + visit 0: + synthesized attribute: + aterms : [ATerm] + alternatives: + alternative Cons: + 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)) +-- 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 -> + Inh_VisageNonterminals -> + Syn_VisageNonterminals +wrap_VisageNonterminals (T_VisageNonterminals sem) (Inh_VisageNonterminals) = + (let ( _lhsOaterms) = sem + in (Syn_VisageNonterminals _lhsOaterms)) +sem_VisageNonterminals_Cons :: T_VisageNonterminal -> + T_VisageNonterminals -> + T_VisageNonterminals +sem_VisageNonterminals_Cons (T_VisageNonterminal hd_) (T_VisageNonterminals tl_) = + (T_VisageNonterminals (let _lhsOaterms :: ([ATerm]) + _hdIaterm :: ATerm + _tlIaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 58, column 17) + _lhsOaterms = + ({-# LINE 58 "./src-ag/Visage.ag" #-} + _hdIaterm : _tlIaterms + {-# LINE 333 "dist/build/Visage.hs" #-} + ) + ( _hdIaterm) = + hd_ + ( _tlIaterms) = + tl_ + in ( _lhsOaterms))) +sem_VisageNonterminals_Nil :: T_VisageNonterminals +sem_VisageNonterminals_Nil = + (T_VisageNonterminals (let _lhsOaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 59, column 17) + _lhsOaterms = + ({-# LINE 59 "./src-ag/Visage.ag" #-} + [] + {-# LINE 347 "dist/build/Visage.hs" #-} + ) + in ( _lhsOaterms))) +-- VisagePattern ----------------------------------------------- +{- + visit 0: + synthesized attribute: + aterm : ATerm + alternatives: + alternative VConstr: + child name : {ConstructorIdent} + child pats : VisagePatterns + alternative VProduct: + child pos : {Pos} + child pats : VisagePatterns + alternative VVar: + child field : {Identifier} + child attr : {Identifier} + alternative VAlias: + child field : {Identifier} + child attr : {Identifier} + child pat : VisagePattern + alternative VUnderscore: + child pos : {Pos} +-} +-- cata +sem_VisagePattern :: VisagePattern -> + T_VisagePattern +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 (VVar _field _attr) = + (sem_VisagePattern_VVar _field _attr) +sem_VisagePattern (VAlias _field _attr _pat) = + (sem_VisagePattern_VAlias _field _attr (sem_VisagePattern _pat)) +sem_VisagePattern (VUnderscore _pos) = + (sem_VisagePattern_VUnderscore _pos) +-- 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 -> + Inh_VisagePattern -> + Syn_VisagePattern +wrap_VisagePattern (T_VisagePattern sem) (Inh_VisagePattern) = + (let ( _lhsOaterm) = sem + in (Syn_VisagePattern _lhsOaterm)) +sem_VisagePattern_VConstr :: ConstructorIdent -> + T_VisagePatterns -> + T_VisagePattern +sem_VisagePattern_VConstr name_ (T_VisagePatterns pats_) = + (T_VisagePattern (let _lhsOaterm :: ATerm + _patsIaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 112, column 18) + _lhsOaterm = + ({-# LINE 112 "./src-ag/Visage.ag" #-} + AAppl "Pattern" [AAppl "Constr" [AString (sQ (showAGPos (getPos name_))), + AString (sQ (getName name_)), + AAppl "Patterns" _patsIaterms]] + {-# LINE 407 "dist/build/Visage.hs" #-} + ) + ( _patsIaterms) = + pats_ + in ( _lhsOaterm))) +sem_VisagePattern_VProduct :: Pos -> + T_VisagePatterns -> + T_VisagePattern +sem_VisagePattern_VProduct pos_ (T_VisagePatterns pats_) = + (T_VisagePattern (let _lhsOaterm :: ATerm + _patsIaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 115, column 18) + _lhsOaterm = + ({-# LINE 115 "./src-ag/Visage.ag" #-} + AAppl "Pattern" [AAppl "Product" [AString (sQ (showAGPos pos_)), + AAppl "Patterns" _patsIaterms]] + {-# LINE 423 "dist/build/Visage.hs" #-} + ) + ( _patsIaterms) = + pats_ + in ( _lhsOaterm))) +sem_VisagePattern_VVar :: Identifier -> + Identifier -> + T_VisagePattern +sem_VisagePattern_VVar field_ attr_ = + (T_VisagePattern (let _lhsOaterm :: ATerm + -- "./src-ag/Visage.ag"(line 117, column 18) + _lhsOaterm = + ({-# LINE 117 "./src-ag/Visage.ag" #-} + AAppl "Pattern" [AAppl "Var" [AString (sQ (showAGPos (getPos field_))), + AString (sQ (getName field_ ++ "." ++ getName attr_))]] + {-# LINE 438 "dist/build/Visage.hs" #-} + ) + in ( _lhsOaterm))) +sem_VisagePattern_VAlias :: Identifier -> + Identifier -> + T_VisagePattern -> + T_VisagePattern +sem_VisagePattern_VAlias field_ attr_ (T_VisagePattern pat_) = + (T_VisagePattern (let _lhsOaterm :: ATerm + _patIaterm :: ATerm + -- "./src-ag/Visage.ag"(line 119, column 18) + _lhsOaterm = + ({-# LINE 119 "./src-ag/Visage.ag" #-} + AAppl "Pattern" [AAppl "Alias" [AString (sQ (showAGPos (getPos field_))), + AString (sQ (getName field_ ++ "." ++ getName attr_)), _patIaterm]] + {-# LINE 453 "dist/build/Visage.hs" #-} + ) + ( _patIaterm) = + pat_ + in ( _lhsOaterm))) +sem_VisagePattern_VUnderscore :: Pos -> + T_VisagePattern +sem_VisagePattern_VUnderscore pos_ = + (T_VisagePattern (let _lhsOaterm :: ATerm + -- "./src-ag/Visage.ag"(line 121, column 18) + _lhsOaterm = + ({-# LINE 121 "./src-ag/Visage.ag" #-} + AAppl "Pattern" [AAppl "Underscore" [AString (sQ (showAGPos pos_))]] + {-# LINE 466 "dist/build/Visage.hs" #-} + ) + in ( _lhsOaterm))) +-- VisagePatterns ---------------------------------------------- +{- + visit 0: + synthesized attribute: + aterms : [ATerm] + alternatives: + alternative Cons: + 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)) +-- 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 -> + Inh_VisagePatterns -> + Syn_VisagePatterns +wrap_VisagePatterns (T_VisagePatterns sem) (Inh_VisagePatterns) = + (let ( _lhsOaterms) = sem + in (Syn_VisagePatterns _lhsOaterms)) +sem_VisagePatterns_Cons :: T_VisagePattern -> + T_VisagePatterns -> + T_VisagePatterns +sem_VisagePatterns_Cons (T_VisagePattern hd_) (T_VisagePatterns tl_) = + (T_VisagePatterns (let _lhsOaterms :: ([ATerm]) + _hdIaterm :: ATerm + _tlIaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 107, column 17) + _lhsOaterms = + ({-# LINE 107 "./src-ag/Visage.ag" #-} + _hdIaterm : _tlIaterms + {-# LINE 506 "dist/build/Visage.hs" #-} + ) + ( _hdIaterm) = + hd_ + ( _tlIaterms) = + tl_ + in ( _lhsOaterms))) +sem_VisagePatterns_Nil :: T_VisagePatterns +sem_VisagePatterns_Nil = + (T_VisagePatterns (let _lhsOaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 108, column 17) + _lhsOaterms = + ({-# LINE 108 "./src-ag/Visage.ag" #-} + [] + {-# LINE 520 "dist/build/Visage.hs" #-} + ) + in ( _lhsOaterms))) +-- VisageProduction -------------------------------------------- +{- + visit 0: + synthesized attribute: + aterm : ATerm + alternatives: + alternative VProduction: + child con : {ConstructorIdent} + 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)) +-- 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 -> + Inh_VisageProduction -> + Syn_VisageProduction +wrap_VisageProduction (T_VisageProduction sem) (Inh_VisageProduction) = + (let ( _lhsOaterm) = sem + 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_) = + (T_VisageProduction (let _lhsOaterm :: ATerm + _locrulesOisLoc :: Bool + _rulesOisLoc :: Bool + _childrenIaterms :: ([ATerm]) + _rulesIaterms :: ([ATerm]) + _locrulesIaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 73, column 17) + _lhsOaterm = + ({-# LINE 73 "./src-ag/Visage.ag" #-} + AAppl "Alternative" [AString (sQ (getName con_)), AAppl "Children" _childrenIaterms, + AAppl "Rules" _rulesIaterms, + AAppl "LocRules" _locrulesIaterms] + {-# LINE 568 "dist/build/Visage.hs" #-} + ) + -- "./src-ag/Visage.ag"(line 76, column 18) + _locrulesOisLoc = + ({-# LINE 76 "./src-ag/Visage.ag" #-} + True + {-# LINE 574 "dist/build/Visage.hs" #-} + ) + -- "./src-ag/Visage.ag"(line 77, column 18) + _rulesOisLoc = + ({-# LINE 77 "./src-ag/Visage.ag" #-} + False + {-# LINE 580 "dist/build/Visage.hs" #-} + ) + ( _childrenIaterms) = + children_ + ( _rulesIaterms) = + rules_ _rulesOisLoc + ( _locrulesIaterms) = + locrules_ _locrulesOisLoc + in ( _lhsOaterm))) +-- VisageProductions ------------------------------------------- +{- + visit 0: + synthesized attribute: + aterms : [ATerm] + alternatives: + alternative Cons: + 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)) +-- 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 -> + Inh_VisageProductions -> + Syn_VisageProductions +wrap_VisageProductions (T_VisageProductions sem) (Inh_VisageProductions) = + (let ( _lhsOaterms) = sem + in (Syn_VisageProductions _lhsOaterms)) +sem_VisageProductions_Cons :: T_VisageProduction -> + T_VisageProductions -> + T_VisageProductions +sem_VisageProductions_Cons (T_VisageProduction hd_) (T_VisageProductions tl_) = + (T_VisageProductions (let _lhsOaterms :: ([ATerm]) + _hdIaterm :: ATerm + _tlIaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 68, column 17) + _lhsOaterms = + ({-# LINE 68 "./src-ag/Visage.ag" #-} + _hdIaterm : _tlIaterms + {-# LINE 626 "dist/build/Visage.hs" #-} + ) + ( _hdIaterm) = + hd_ + ( _tlIaterms) = + tl_ + in ( _lhsOaterms))) +sem_VisageProductions_Nil :: T_VisageProductions +sem_VisageProductions_Nil = + (T_VisageProductions (let _lhsOaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 69, column 17) + _lhsOaterms = + ({-# LINE 69 "./src-ag/Visage.ag" #-} + [] + {-# LINE 640 "dist/build/Visage.hs" #-} + ) + in ( _lhsOaterms))) +-- VisageRule -------------------------------------------------- +{- + visit 0: + inherited attribute: + isLoc : Bool + synthesized attribute: + aterm : ATerm + alternatives: + alternative VRule: + child fieldattrs : {[(Identifier,Identifier)]} + child attr : {Identifier} + 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) +-- 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 -> + Inh_VisageRule -> + Syn_VisageRule +wrap_VisageRule (T_VisageRule sem) (Inh_VisageRule _lhsIisLoc) = + (let ( _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_ = + (T_VisageRule (\ _lhsIisLoc -> + (let _lhsOaterm :: ATerm + _patIaterm :: ATerm + _rhsIaterm :: ATerm + -- "./src-ag/Visage.ag"(line 97, column 18) + _lhsOaterm = + ({-# LINE 97 "./src-ag/Visage.ag" #-} + AAppl (if _lhsIisLoc then "LocRule" else "Rule") + ([AString (sQ (getName attr_)), _patIaterm, _rhsIaterm] ++ if _lhsIisLoc then [AString (sQ (show owrt_))] else []) + {-# LINE 690 "dist/build/Visage.hs" #-} + ) + ( _patIaterm) = + pat_ + ( _rhsIaterm) = + rhs_ + in ( _lhsOaterm)))) +-- VisageRules ------------------------------------------------- +{- + visit 0: + inherited attribute: + isLoc : Bool + synthesized attribute: + aterms : [ATerm] + alternatives: + alternative Cons: + 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)) +-- 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 -> + Inh_VisageRules -> + Syn_VisageRules +wrap_VisageRules (T_VisageRules sem) (Inh_VisageRules _lhsIisLoc) = + (let ( _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_) = + (T_VisageRules (\ _lhsIisLoc -> + (let _lhsOaterms :: ([ATerm]) + _hdOisLoc :: Bool + _tlOisLoc :: Bool + _hdIaterm :: ATerm + _tlIaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 92, column 17) + _lhsOaterms = + ({-# LINE 92 "./src-ag/Visage.ag" #-} + _hdIaterm : _tlIaterms + {-# LINE 740 "dist/build/Visage.hs" #-} + ) + -- copy rule (down) + _hdOisLoc = + ({-# LINE 51 "./src-ag/Visage.ag" #-} + _lhsIisLoc + {-# LINE 746 "dist/build/Visage.hs" #-} + ) + -- copy rule (down) + _tlOisLoc = + ({-# LINE 51 "./src-ag/Visage.ag" #-} + _lhsIisLoc + {-# LINE 752 "dist/build/Visage.hs" #-} + ) + ( _hdIaterm) = + hd_ _hdOisLoc + ( _tlIaterms) = + tl_ _tlOisLoc + in ( _lhsOaterms)))) +sem_VisageRules_Nil :: T_VisageRules +sem_VisageRules_Nil = + (T_VisageRules (\ _lhsIisLoc -> + (let _lhsOaterms :: ([ATerm]) + -- "./src-ag/Visage.ag"(line 93, column 17) + _lhsOaterms = + ({-# LINE 93 "./src-ag/Visage.ag" #-} + [] + {-# LINE 767 "dist/build/Visage.hs" #-} + ) + in ( _lhsOaterms)))) diff --git a/dist/build/VisagePatterns.hs b/dist/build/VisagePatterns.hs new file mode 100644 --- /dev/null +++ b/dist/build/VisagePatterns.hs @@ -0,0 +1,42 @@ + + +-- UUAGC 0.9.42.0 (src-ag/VisagePatterns.ag) +module VisagePatterns where +{-# LINE 2 "./src-ag/VisagePatterns.ag" #-} + +import UU.Scanner.Position(Pos) +import CommonTypes +{-# LINE 10 "dist/build/VisagePatterns.hs" #-} +-- VisagePattern ----------------------------------------------- +{- + alternatives: + alternative VConstr: + child name : {ConstructorIdent} + child pats : VisagePatterns + alternative VProduct: + child pos : {Pos} + child pats : VisagePatterns + alternative VVar: + child field : {Identifier} + child attr : {Identifier} + alternative VAlias: + child field : {Identifier} + child attr : {Identifier} + child pat : VisagePattern + alternative VUnderscore: + child pos : {Pos} +-} +data VisagePattern = VConstr (ConstructorIdent) (VisagePatterns) + | VProduct (Pos) (VisagePatterns) + | VVar (Identifier) (Identifier) + | VAlias (Identifier) (Identifier) (VisagePattern) + | VUnderscore (Pos) +-- VisagePatterns ---------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : VisagePattern + child tl : VisagePatterns + alternative Nil: +-} +type VisagePatterns = [VisagePattern] diff --git a/dist/build/VisageSyntax.hs b/dist/build/VisageSyntax.hs new file mode 100644 --- /dev/null +++ b/dist/build/VisageSyntax.hs @@ -0,0 +1,97 @@ + + +-- UUAGC 0.9.42.0 (src-ag/VisageSyntax.ag) +module VisageSyntax where +{-# LINE 2 "./src-ag/VisageSyntax.ag" #-} + +import CommonTypes +import UU.Pretty +import AbstractSyntax +import VisagePatterns +import Expression +{-# LINE 13 "dist/build/VisageSyntax.hs" #-} +-- VisageChild ------------------------------------------------- +{- + alternatives: + alternative VChild: + child name : {Identifier} + child tp : {Type} + child inh : {Attributes} + child syn : {Attributes} + child rules : VisageRules +-} +data VisageChild = VChild (Identifier) (Type) (Attributes) (Attributes) (VisageRules) +-- VisageChildren ---------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : VisageChild + child tl : VisageChildren + alternative Nil: +-} +type VisageChildren = [VisageChild] +-- VisageGrammar ----------------------------------------------- +{- + alternatives: + alternative VGrammar: + child nonts : VisageNonterminals +-} +data VisageGrammar = VGrammar (VisageNonterminals) +-- VisageNonterminal ------------------------------------------- +{- + alternatives: + alternative VNonterminal: + child nt : {NontermIdent} + child inh : {Attributes} + child syn : {Attributes} + child alts : VisageProductions +-} +data VisageNonterminal = VNonterminal (NontermIdent) (Attributes) (Attributes) (VisageProductions) +-- VisageNonterminals ------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : VisageNonterminal + child tl : VisageNonterminals + alternative Nil: +-} +type VisageNonterminals = [VisageNonterminal] +-- VisageProduction -------------------------------------------- +{- + alternatives: + alternative VProduction: + child con : {ConstructorIdent} + child children : VisageChildren + child rules : VisageRules + child locrules : VisageRules +-} +data VisageProduction = VProduction (ConstructorIdent) (VisageChildren) (VisageRules) (VisageRules) +-- VisageProductions ------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : VisageProduction + child tl : VisageProductions + alternative Nil: +-} +type VisageProductions = [VisageProduction] +-- VisageRule -------------------------------------------------- +{- + alternatives: + alternative VRule: + child fieldattrs : {[(Identifier,Identifier)]} + child attr : {Identifier} + child pat : {VisagePattern} + child rhs : {Expression} + child owrt : {Bool} +-} +data VisageRule = VRule (([(Identifier,Identifier)])) (Identifier) (VisagePattern) (Expression) (Bool) +-- VisageRules ------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : VisageRule + child tl : VisageRules + alternative Nil: +-} +type VisageRules = [VisageRule] diff --git a/src-ag/DefaultRules.ag b/src-ag/DefaultRules.ag --- a/src-ag/DefaultRules.ag +++ b/src-ag/DefaultRules.ag @@ -25,6 +25,7 @@ import HsToken import HsTokenScanner import Data.List(intersperse) +import Data.Char import AbstractSyntax import ErrorMessages @@ -89,28 +90,53 @@ mkLocVar = AGField _LOC -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" = "(:)" +buildConExpr ocaml typeSyns rename nt con1 fs + | nt `elem` map fst typeSyns = if ocaml then synonymMl else synonymHs + | otherwise = normalExpr + where con = getName con1 + tup = " " ++ buildTuple fs + args = " " ++ unwords fs + normalExpr = conname' ++ args + + conname' | rename = getName nt ++ "_" ++ getName con1 + | otherwise = getName con1 + + synonymHs | con == "Tuple" = buildTuple fs + | con == "Cons" = "(:)" ++ args | con == "Nil" = case lookup nt typeSyns of Just (Map _ _) -> "Data.Map.empty" Just (IntMap _) -> "Data.IntMap.empty" Just (OrdSet _) -> "Data.Set.empty" Just IntSet -> "Data.IntSet.empty" _ -> "[]" - | con == "Just" = "Just" + | con == "Just" = "Just" ++ args | con == "Nothing" = "Nothing" - | con == "Entry" = case lookup nt typeSyns of - Just (Map _ _) -> "Data.Map.insert" - Just (IntMap _) -> "Data.IntMap.insert" - Just (OrdSet _) -> "Data.Set.insert" - Just IntSet -> "Data.IntSet.insert" - | otherwise = normalName + | con == "Entry" = ( case lookup nt typeSyns of + Just (Map _ _) -> "Data.Map.insert" + Just (IntMap _) -> "Data.IntMap.insert" + Just (OrdSet _) -> "Data.Set.insert" + Just IntSet -> "Data.IntSet.insert" ) ++ args + | otherwise = normalExpr + synonymMl | con == "Tuple" = buildTuple fs + | con == "Cons" = "(::)" ++ tup + | con == "Nil" = case lookup nt typeSyns of + Just (Map _ _) -> prefixMod nt "empty" + Just (IntMap _) -> prefixMod nt "empty" + Just (OrdSet _) -> prefixMod nt "empty" + Just IntSet -> prefixMod nt "empty" + _ -> "[]" + | con == "Just" = "Some" ++ tup + | con == "Nothing" = "None" + | con == "Entry" = ( case lookup nt typeSyns of + Just (Map _ _) -> prefixMod nt "add" + Just (IntMap _) -> prefixMod nt "add" + Just (OrdSet _) -> prefixMod nt "add" + Just IntSet -> prefixMod nt "add" ) ++ args + | otherwise = normalExpr + + prefixMod nt nm = "M_" ++ getName nt ++ "." ++ nm + concatSeq = foldr (Seq.><) Seq.empty splitAttrs :: Map Identifier a -> [Identifier] -> ([(Identifier,a)],[Identifier]) -- a used as (String,String) @@ -256,17 +282,23 @@ , 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) + isOp [] = False + isOp (c:cs) + | isSpace c = isOp cs + | isAlpha c = case dropWhile isAlpha cs of + ('.':cs2) -> isOp cs2 -- fully qualified name, drop prefix + _ -> False + | c == '(' = False + | otherwise = True tks | Set.member n locals = [mkLocVar 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) + opExpr l r + | isOp op = l ++ " " ++ op ++ " " ++ r -- takes the associativity of the operator + | otherwise = "(" ++ op ++ " " ++ l ++ " " ++ r ++ ")" -- associates to the right + str = foldr1 opExpr (map (flip attrName n) elems) in makeRule (_LHS,n) (Expression noPos tks) @@ -404,10 +436,7 @@ _ | nm `Set.member` locals -> locName nm | otherwise -> fieldName nm constructor fs - | getName @con == "Tuple" && @lhs.nt `elem` map fst @lhs.typeSyns - = "(" ++ concat (intersperse "," fs) ++ ")" - | otherwise - = getConName @lhs.typeSyns @lhs.o_rename @lhs.nt @con ++ " " ++ unwords fs + = buildConExpr (ocaml @lhs.options) @lhs.typeSyns @lhs.o_rename @lhs.nt @con fs childExists ChildAttr = False childExists _ = True @@ -429,6 +458,8 @@ in (uRules++selfLocRules++selfRules++rules5++rules1, errors1> [Rule] -> [Rule] addAugments (_, exprs) rules | null exprs = rules @@ -546,7 +577,7 @@ { elimSelfId :: NontermIdent -> [Identifier] -> Type -> Type -elimSelfId nt args Self = NT nt (map locname args) False +elimSelfId nt args Self = NT nt (map getName args) False elimSelfId _ _ tp = tp elimSelfStr :: NontermIdent -> [String] -> Type -> Type diff --git a/src-ag/ExecutionPlan2Caml.ag b/src-ag/ExecutionPlan2Caml.ag new file mode 100644 --- /dev/null +++ b/src-ag/ExecutionPlan2Caml.ag @@ -0,0 +1,1482 @@ +-- As expected, the code generation for ML resembles the code generation for Haskell quite a bit. +-- However, there are several differences: +-- * no inline pragmas +-- * no strictness annotations (not needed) +-- * separating data types from code +-- +-- Generator conventions: +-- * we generate functions definitions with an 'and' binding and a match statement +-- * for some type aliasses, we'll introduce module decls in addition to a type +-- +-- Future work: +-- * abuse the module system more? +-- * parse ocaml blocks? +-- * lazy evaluation? +-- +-- Other comments: +-- * Empty records are not allowed in Ocaml. Mapping them to units. +-- * line pragmas. There are now line pragmas around the body of rules. +-- There cannot be syntactical mistakes in the patterns. However, there can be +-- type errors if a function returns a value with a type that differs from what +-- is expected. It's then not clear which location is reported. +-- Also, errors in type signatures are not caught. +-- However, usually, the problematic cases are syntax errors, and these are +-- prevented by parsing the definitions first. + +INCLUDE "ExecutionPlan.ag" +INCLUDE "Patterns.ag" +INCLUDE "Expression.ag" +INCLUDE "HsToken.ag" + +imports +{ +import ExecutionPlan +import Pretty +import PPUtil +import Options +import Data.Monoid(mappend,mempty) +import Data.Maybe +import Data.Graph +import Debug.Trace +import System.IO +import System.Directory +import System.FilePath +import UU.Scanner.Position + +import TokenDef +import HsToken +import ErrorMessages + +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Sequence(Seq) +import qualified Data.Sequence as Seq +import Data.Foldable(toList) +} + +ATTR ExecutionPlan ENonterminals ENonterminal EProductions EProduction ERules ERule EChildren EChild + [ mainFile, mainName : String | | ] + +------------------------------------------------------------------------------- +-- Options +------------------------------------------------------------------------------- +ATTR ExecutionPlan + ENonterminals ENonterminal + EProductions EProduction + ERules ERule + Pattern Patterns + EChildren EChild + Visits Visit + VisitSteps VisitStep [ options : {Options} | | ] +ATTR EProductions EProduction [ rename : {Bool} | | ] + +SEM ENonterminal | ENonterminal + prods.rename = rename @lhs.options + +------------------------------------------------------------------------------- +-- Context info (nonterminal ident, constructor ident, nonterm params, etc.) +------------------------------------------------------------------------------- + +ATTR Visit Visits EProduction EProductions EChildren EChild ERules ERule [ nt : NontermIdent | | ] +SEM ENonterminal | ENonterminal + prods.nt = @nt + +ATTR EChildren EChild ERules ERule Visits Visit [ con : ConstructorIdent | | ] + +SEM EProduction | EProduction children.con = @con + rules.con = @con + visits.con = @con + +ATTR EProductions EProduction Visits Visit [ params : {[Identifier]} | | ] +SEM ENonterminal | ENonterminal + prods.params = @params + +------------------------------------------------------------------------------- +-- output attributes: we make a distinction between data declarations +-- and code +------------------------------------------------------------------------------- +ATTR ExecutionPlan [ | | datas, code, modules : {PP_Doc} ] + +SEM ExecutionPlan | ExecutionPlan + lhs.code = @nonts.code >-< @loc.wrappersExtra + lhs.datas = @nonts.datas >-< @loc.commonExtra + +ATTR ENonterminal ENonterminals + [ wrappers : {Set NontermIdent} | | datas,code,modules USE {>-<} {empty} : {PP_Doc} ] + +SEM ExecutionPlan | ExecutionPlan + nonts.wrappers = @wrappers + +SEM ENonterminal | ENonterminal + lhs.datas = ( text "" + >-< "(* *** " ++ getName @nt ++ " *** [data] *)") + >-< (if dataTypes @lhs.options + then pp "(* data *)" + >-< @loc.datatypeNt + >-< @loc.datatypeProds + >-< "" + else empty) + >-< (if @loc.hasWrapper + then pp "(* wrapper *)" + >-< @loc.wr_inh + >-< @loc.wr_syn + >-< "" + else empty) + >-< (if semfuns @lhs.options + then pp "(* semantic domain *)" + >-< @loc.t_init + >-< @loc.t_states + >-< @loc.c_states + >-< @prods.t_visits + >-< "" + else empty) + + lhs.code = ( text "" + >-< "(* *** " ++ getName @nt ++ " *** [code] *)") + >-< (if dataTypes @lhs.options + then pp "(* constructor functions *)" + >-< @loc.datatypeCon + else empty) + >-< (if @loc.hasWrapper + then pp "(* wrapper *)" + >-< @loc.wrapper + >-< "" + else empty) + >-< (if folds @lhs.options + then "(* cata *)" + >-< @loc.sem_nt + >-< "" + else empty) + >-< (if semfuns @lhs.options + then "(* semantic domain *)" + >-< @prods.sem_prod + >-< "" + else empty) + + -- note: we assume that these module declarations are not recursive, and + -- that their parameters do not depends on types generated by AG in the + -- same file. + lhs.modules = @loc.moduleDecl + + loc.hasWrapper = @nt `Set.member` @lhs.wrappers + +------------------------------------------------------------------------------- +-- Nonterminal datatype +------------------------------------------------------------------------------- +ATTR ENonterminal ENonterminals [ typeSyns : {TypeSyns} | | ] + +SEM ExecutionPlan | ExecutionPlan + nonts.typeSyns = @typeSyns + +{ +ppRecordTp :: PP a => [a] -> PP_Doc +ppRecordTp es + | null es = text "unit" + | otherwise = pp_block "{" "}" "; " (map pp es) + +ppRecordVal :: PP a => [a] -> PP_Doc +ppRecordVal es + | null es = text "()" + | otherwise = pp_block "{" "}" "; " (map pp es) + +ppFieldsVal :: Bool -> [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)] -> PP_Doc +ppFieldsVal record fields + | null fields = text "()" + | record = ppRecordVal [ r >#< "=" >#< x | (r,x,_,_) <- fields ] + | otherwise = pp_block "(" ")" "," [ x | (_,x,_,_) <- fields ] + +ppFieldsType :: Bool -> Bool -> [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)] -> PP_Doc +ppFieldsType record defor fields + | null fields = text "unit" + | record = ppRecordTp [ r >#< ":" >#< (if defor then d else f) | (r,_,d,f) <- fields ] + | otherwise = pp_block "(" ")" "*" [ if defor then d else f | (_,_,d,f) <- fields ] +} + + +-- for each nonterminal, the following data types in ocmal: +-- * data type for the nonterminal, with a constructor for +-- each production. The constructor takes a single field +-- with the type explained below. +-- * for each production, a record type comprising the +-- children of the production. +-- +-- * class contexts are ignored +-- * at most one type variable +-- +-- aliasses: lists, tuples +-- *** think about maps, sets, etc. Perhaps the name of +-- the alias should become a local module name. +-- + +SEM ENonterminal | ENonterminal + loc.t_params = ppTypeParams @params + loc.aliasPre = "and" >#< @loc.t_params >#< @nt >#< "=" + loc.aliasMod = @loc.aliasPre >#< modName @nt >|< ".t" + loc.datatypeNt + = case lookup @nt @lhs.typeSyns of + -- generate special code for certain type aliasses + Just (List t) -> @loc.aliasPre >#< ppTp t >#< "list" + Just (Maybe t) -> @loc.aliasPre >#< ppTp t >#< "option" + Just (Tuple ts) -> @loc.aliasPre >#< (pp_block "(" ")" " * " $ map (ppTp . snd) ts) + + Just (Map k v) -> @loc.aliasMod + Just (IntMap t) -> @loc.aliasMod + Just (OrdSet t) -> @loc.aliasMod + Just IntSet -> @loc.aliasMod + + -- use the constructor-based data-type generation for all other types + _ -> "and" >#< @loc.t_params >#< @nt >#< "=" + >-< ( if null @prods.datatype + then pp "unit" + else indent 2 $ vlist @prods.datatype_call + ) + + loc.datatypeCon + = case lookup @nt @lhs.typeSyns of + Just _ -> empty -- no constructor funs for type aliasses + Nothing -> vlist @prods.datatype_con + + loc.moduleDecl + = let ppModule expr = "module" >#< modName @nt >#< "=" + in case lookup @nt @lhs.typeSyns of + Just (Map k _) -> ppModule ("Map.Make" >#< pp_parens (ppTp k)) + Just (IntMap _) -> ppModule ("Map.Make ()") + Just (OrdSet t) -> ppModule ("Set.Make" >#< pp_parens (ppTp t)) + Just IntSet -> ppModule ("Set.Make (struct type t = int let compare = Pervasives.compare end)") + _ -> empty + + loc.datatypeProds = vlist @prods.datatype + +ATTR EProduction [ | | datatype, datatype_call, datatype_con : {PP_Doc} ] +ATTR EProductions [ | | datatype, datatype_call, datatype_con USE {:} {[]} : {[PP_Doc]} ] + +SEM EProduction | EProduction + loc.o_records = dataRecords @lhs.options + loc.t_params = ppTypeParams @lhs.params + loc.t_c_params = ppTypeParams (cont_tvar : map pp @params) + loc.conname = conname @lhs.rename @lhs.nt @con + loc.recname = pp "fields_" >|< @loc.conname + lhs.datatype = "and" >#< @loc.t_params >#< @loc.recname >#< "=" + >#< ppFieldsType @loc.o_records False @children.sigs + lhs.datatype_call = pp "|" >#< @loc.conname >#< "of" >#< pp_parens (@loc.t_params >#< @loc.recname) + lhs.datatype_con + = let funNm = @lhs.nt >|< "_" >|< @con + decl = "and" >#< ppFunDecl @loc.o_sigs funNm params (@loc.t_params >#< @lhs.nt) body + params = [ (x, t) | (_,x,_,t) <- @children.sigs ] + body = @loc.conname >#< ppFieldsVal @loc.o_records @children.sigs + in decl + +ATTR EChild EChildren [ | | sigs USE {++} {[]} : {[(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]} ] + +SEM EChild + | EChild ETerm + loc.tpDocFor = ppTp $ removeDeforested @tp + loc.tpDocDefor = ppTp $ forceDeforested @tp + loc.fieldNm = text $ recordFieldname @lhs.nt @lhs.con @name + loc.childNm = text (fieldname @name) + loc.field = (@loc.fieldNm, @loc.childNm, @loc.tpDocDefor, @loc.tpDocFor) + | EChild lhs.sigs = case @kind of + ChildAttr -> [] -- higher order attributes are not part of the data type + _ -> [@loc.field] + | ETerm lhs.sigs = [@loc.field] + +{ +ppTp :: Type -> PP_Doc +ppTp tp = case tp of + Haskell t -> pp t -- ocaml type + NT nt tps deforested + | nt == _SELF -> pp "?SELF?" + | null tps -> ppNontTp nt deforested + | otherwise -> pp_parens (ppSpaced (map pp_parens tps) >#< ppNontTp nt deforested) + Self -> pp "?SELF?" + +ppNontTp :: NontermIdent -> Bool -> PP_Doc +ppNontTp nt True = pp "t_" >|< pp nt +ppNontTp nt False = pp nt + +-- multiple type parameters go into a tuple +ppTypeParams :: PP a => [a] -> PP_Doc +ppTypeParams [] = empty +ppTypeParams [x] = pp x +ppTypeParams xs = pp_block "(" ")" "," (map pp xs) +} + +------------------------------------------------------------------------------- +-- Nonterminal semantic function +------------------------------------------------------------------------------- +SEM ENonterminal | ENonterminal + loc.fsemname = \x -> prefix @lhs.options ++ show x + loc.semname = @loc.fsemname @nt + loc.frecarg = \t x -> case t of + NT nt _ _ -> pp_parens (@fsemname nt >#< x) + _ -> x + + loc.sem_param_tp = @loc.t_params >#< @nt + loc.sem_res_tp = @loc.t_params >#< @loc.t_type + loc.sem_tp = @loc.sem_param_tp >#< "->" >#< @loc.sem_res_tp + + loc.o_sigs = typeSigs @lhs.options + loc.sem_nt_body = "match arg with" >-< (indent 2 $ @prods.sem_nt) + loc.sem_nt = let genSem nm body = "and" >#< ppFunDecl @loc.o_sigs (pp @loc.semname) [(pp nm, @loc.sem_param_tp)] @loc.sem_res_tp body + genAlias alts = genSem (pp "arg") (pp "match arg with" >-< (indent 2 $ vlist $ map (pp "|" >#<) alts)) + genMap v = let body = modName @nt >|< ".fold" >#< @loc.semname >|< "_Entry" >#< @loc.semname >|< "_Nil" >#< els + els = case v of + NT nt _ _ -> pp_parens (modName @nt >|< ".map" >#< @loc.fsemname nt >#< "m") + _ -> pp "m" + in genSem "m" body + genSet mbNt = let body = "List.fold_right" >#< @loc.semname >|< "_Entry" >#< + els (pp_parens (modName @nt >|< ".elements" >#< "s")) >#< @loc.semname >|< "_Nil" + els r = maybe r (\nt -> pp_parens ("List.map" >#< @loc.fsemname nt >#< r)) mbNt + in genSem "s" body + in case lookup @nt @lhs.typeSyns of + -- generate special code for some aliasses + Just (List t) -> let body = "List.fold_right" >#< @loc.semname >|< "_Cons" >#< els >#< @loc.semname >|< "_Nil" + els = case t of + NT nt _ _ -> pp_parens ("List.map" >#< @loc.fsemname nt >#< "list") + _ -> pp "list" + in genSem "list" body + Just (Tuple ts) -> let pat = pp_parens (ppCommas $ map fst ts) + body = @loc.semname >|< "_Tuple" >#< ppSpaced (map (\t -> @loc.frecarg (snd t) (pp $ fst t)) ts) + in genSem pat body + Just (Map _ v) -> genMap v + Just (IntMap v) -> genMap v + Just (Maybe t) -> genAlias + [ "None" >#< "->" >#< "=" >#< @loc.semname >|< "_Nothing" + , "Some" >#< "just" >#< "->" >#< @loc.semname >|< "_Just" >#< @frecarg t (pp "just") + ] + Just (OrdSet t) -> genSet $ case t of + NT nt _ _ -> Just nt + _ -> Nothing + Just (IntSet) -> genSet Nothing + + -- structural fold for the remaining cases + _ -> genSem "arg" @loc.sem_nt_body + +{ +-- convention for nonterminals to module names +modName :: NontermIdent -> PP_Doc +modName nt = pp "M_" >|< pp nt + +ppFunDecl :: Bool -> PP_Doc -> [(PP_Doc,PP_Doc)] -> PP_Doc -> PP_Doc -> PP_Doc +ppFunDecl gensigs nm args resSig expr = body where + body = nm >#< ppSpaced (map arg args) >#< ppRes >#< "=" + >-< indent 2 expr + arg (arg,tp) = ppArg gensigs arg tp + ppRes + | gensigs = ":" >#< resSig + | otherwise = empty + +ppArg :: Bool -> PP_Doc -> PP_Doc -> PP_Doc +ppArg gensigs arg tp + | gensigs = pp_parens (arg >#< ":" >#< tp) + | otherwise = arg + +} + +-- The number of productions +ATTR EProductions EProduction [ | | count USE {+} {0} : {Int} ] +SEM EProduction | EProduction lhs.count = {1} + +-- The per-production match-expr cases for the sem_NT function +ATTR EProduction EProductions [ | | sem_nt USE {>-<} {empty} : {PP_Doc} ] +SEM EProduction | EProduction + lhs.sem_nt = "|" >#< conname @lhs.rename @lhs.nt @con >#< ppFieldsVal @loc.o_records @children.sigs >#< "->" >#< + prefix @lhs.options >|< @lhs.nt >|< "_" >|< @con >#< ppSpaced @children.argnamesw + +ATTR EChild [ | | argnamesw : { PP_Doc } ] +ATTR EChildren [ | | argnamesw USE {:} {[]} : {[PP_Doc]} ] + +SEM EChild + | EChild lhs.argnamesw = case @kind of + ChildSyntax -> "(" >#< prefix @lhs.options >|< @loc.nt >#< @name >|< "_" >#< ")" + ChildAttr -> empty -- no sem-case for a higher-order child + ChildReplace tp -> "(" >#< prefix @lhs.options >|< extractNonterminal tp >#< @name >|< "_" >#< ")" + | ETerm lhs.argnamesw = text $ fieldname @name + +------------------------------------------------------------------------------- +-- Types of attributes +------------------------------------------------------------------------------- +ATTR ExecutionPlan + ENonterminals + ENonterminal [ inhmap : {Map NontermIdent Attributes} + synmap : {Map NontermIdent Attributes} | | ] + +ATTR EProductions EProduction + ERules ERule + Patterns Pattern + Visits + Visit [ inhmap : {Attributes} + synmap : {Attributes} + allInhmap : {Map NontermIdent Attributes} + allSynmap : {Map NontermIdent Attributes} | | ] + +SEM ENonterminal + | ENonterminal (Just prods.inhmap) = Map.lookup @nt @lhs.inhmap + (Just prods.synmap) = Map.lookup @nt @lhs.synmap + prods.allInhmap = @lhs.inhmap + prods.allSynmap = @lhs.synmap + +------------------------------------------------------------------------------- +-- State datatypes +------------------------------------------------------------------------------- +{type VisitStateState = (VisitIdentifier,StateIdentifier, StateIdentifier)} + +ATTR Visit [ | | allvisits : { VisitStateState }] +ATTR Visits [ | | allvisits USE {:} {[]} : {[VisitStateState]}] +ATTR EProduction + EProductions [ | | allvisits: {[VisitStateState]}] + +SEM Visit + | Visit lhs.allvisits = (@ident, @from, @to) + +SEM EProductions + | Cons lhs.allvisits = @hd.allvisits -- just pick the first production + | Nil lhs.allvisits = error "Every nonterminal should have at least 1 production" + +-- type of tree in a given state s +SEM ENonterminal | ENonterminal + loc.allstates = orderStates @initial @prods.allvisits + loc.stvisits = \st -> filter (\(v,f,t) -> f == st) @prods.allvisits + loc.t_type = type_nt_sem_top @nt + loc.t_c_params = ppTypeParams (cont_tvar : map pp @params) + + -- the initial "s" type: contains the "attach" function that delivers the initial st + loc.t_init = "and" >#< @loc.t_params >#< @loc.t_type >#< "=" >#< pp_braces ( nm_attach @nt >#< ":" >#< "unit" >#< "->" >#< @loc.t_params >#< type_nt_sem @nt @initial) + + -- the "s" type in a given state: contains the invoke function to go to a next state + loc.t_states = vlist $ map (\st -> + let s_st = type_nt_state @nt st + t_st = type_nt_sem @nt st + c_st = type_caller @nt st + nextVisits = Map.findWithDefault ManyVis st @nextVisits + decl = "and" >#< @loc.t_params >#< t_st >#< "=" + in case nextVisits of + NoneVis -> decl >#< "unit" -- final state: no more subsequent visits + _ -> decl >#< ppRecordVal [ nm_invoke @nt st >#< ":" >#< cont_tvar >#< "." >#< @loc.t_c_params >#< c_st >#< "->" >#< cont_tvar ] + ) @loc.allstates + +{ +-- +-- conventions +-- + +-- type of the state of a node: a closure containing the children states and attributes, +-- with code of type 'type_nt_sem' that represents the subsequent visits to successor states. +type_nt_state nt st = "s_" >|< nt >|< "_" >|< st + +-- type of a visit to a node (the initial, and when in a given state) +-- an instance of this type is called the "semantics" +type_nt_sem_top nt = "t_" >|< nt +type_nt_sem nt st = type_nt_sem_top nt >|< "_s" >|< st + +-- type of a caller (contains visit selection + inputs + continuation) +type_caller nt st = "c_" >|< nt >|< "_s" >|< st + +-- names of records +nm_attach nt = "attach_">|< nt +nm_invoke nt st = "inv_" >|< nt >|< "_s" >|< st + +-- name of the type variable representing the result type of the continuation +cont_tvar = text "'cont__" + + +-- order states in reverse topological order so that successor states are +-- earlier in the resulting list. +orderStates :: StateIdentifier -> [VisitStateState] -> [StateIdentifier] +orderStates initial edges = res where + source = Map.singleton initial Set.empty -- ensures that the initial state is in graph even when there are no edges + targets = [ Map.singleton t Set.empty | (_,_,t) <- edges ] + deps = [ Map.singleton f (Set.singleton t) | (_,f,t) <- edges ] + + mp = Map.unionsWith Set.union (source : (targets ++ deps)) + es = [ (f,f,Set.toList ts) | (f,ts) <- Map.toList mp ] + cps = stronglyConnComp es + res = flattenSCCs cps +} + +-- type of a caller that selects a visit v from state s of the child, and +-- provides a continuation of the caller after the visit to the child +SEM ENonterminal | ENonterminal + loc.c_states = vlist $ map (\st -> + let nt_st = type_nt_state @nt st + c_st = type_caller @nt st + outg = filter (\(_,f,_) -> f == st) @prods.allvisits + nextVisits = Map.findWithDefault ManyVis st @nextVisits + declHead = "and" >#< @loc.t_c_params >#< c_st >#< "=" + visitcons = vlist $ map (\(v,_,_) -> + "|" >#< con_visit @nt v >#< "of" >#< @loc.t_c_params >#< type_caller_visit @nt v + ) outg + in case nextVisits of -- slight optimization for when there is only one visit + NoneVis -> empty -- st is final state, no subsequent visits, thus no more caller info + OneVis v -> declHead >#< @loc.t_c_params >#< type_caller_visit @nt v + ManyVis -> declHead >-< indent 3 visitcons + ) @loc.allstates + +{ +type_caller_visit nt v = "c_" >|< nt >|< "_v" >|< v +con_visit nt v = "C_" >|< nt >|< "_v" >|< v + +-- field names +nm_inh nt v = "inh_" >|< nt >|< "_v" >|< v +nm_cont nt v = "cont_" >|< nt >|< "_v" >|< v +} + +-- type t_visit of a call to a visit v (inputs to the visit + continuation of the parents that gets the output + new state of the child) +ATTR Visit Visits EProduction EProductions [ | | t_visits USE {>-<} {empty} : {PP_Doc} ] + +SEM EProductions | Cons + lhs.t_visits = @hd.t_visits + -- just pick the first production (these results are the same for all of them) + -- todo: that means we should actually represent visit declarations in the AST... + +SEM Visit | Visit + loc.nameTIn_visit = conNmTVisitIn @lhs.nt @ident + loc.nameTOut_visit = conNmTVisitOut @lhs.nt @ident + loc.nameNextState = type_nt_sem @lhs.nt @to + loc.nameCaller_visit = type_caller_visit @lhs.nt @ident + + loc.nextVisitInfo = Map.findWithDefault ManyVis @to @lhs.nextVisits -- which visits can we do after we reach the @to state? + + loc.t_params = ppTypeParams @lhs.params + loc.t_c_params = ppTypeParams (cont_tvar : map pp @lhs.params) + + -- data type decls for the t_visit type + -- we generate a type for the caller of a visit, the arguments of the visit and the result of the visit + lhs.t_visits = "and" >#< @loc.t_c_params >#< @loc.nameCaller_visit >#< "=" >#< ppRecordTp + [ nm_inh @lhs.nt @ident >#< ":" >#< @loc.t_params >#< conNmTVisitIn @lhs.nt @ident + , nm_cont @lhs.nt @ident >#< ":" >#< @loc.t_params >#< conNmTVisitOut @lhs.nt @ident >#< "->" >#< cont_tvar + ] + >-< "and" >#< @loc.t_params >#< @loc.nameTIn_visit >#< "=" >#< ppRecordTp @loc.inhpart + >-< "and" >#< @loc.t_params >#< @loc.nameTOut_visit >#< "=" >#< ppRecordTp (@loc.synpart ++ @loc.contpart) + + loc.contpart = case @loc.nextVisitInfo of + NoneVis -> [] -- don't provide a continuation at all + _ -> [ nm_outarg_cont @lhs.nt @ident >#< ":" >#< @loc.t_params >#< @loc.nameNextState ] -- normal route: select the next semantics + + loc.inhpart = @loc.ppTypeList nm_inarg @inh @lhs.inhmap + loc.synpart = @loc.ppTypeList nm_outarg @syn @lhs.synmap + loc.ppTypeList = \f s m -> map (\i -> case Map.lookup i m of + Just tp -> f i @lhs.nt @ident >#< ":" >#< ppTp tp ) $ Set.toList s + +{ +-- more naming conventions +nm_inarg nm nt v = "i_" >|< nm >|< "_" >|< nt >|< "_v" >|< v +nm_outarg nm nt v = "o_" >|< nm >|< "_" >|< nt >|< "_v" >|< v +nm_outarg_cont = nm_outarg "_cont" + +conNmTVisit nt vId = "t_" >|< nt >|< "_v" >|< vId +conNmTVisitIn nt vId = "t_" >|< nt >|< "_vIn" >|< vId +conNmTVisitOut nt vId = "t_" >|< nt >|< "_vOut" >|< vId + +-- todo: remove ppMonadType +ppMonadType :: Options -> PP_Doc +ppMonadType opts + | parallelInvoke opts = text "IO" + | otherwise = text "Identity" +} + +------------------------------------------------------------------------------- +-- Inh and Syn wrappers +------------------------------------------------------------------------------- +SEM ENonterminal | ENonterminal + loc.wr_inh = @loc.genwrap "inh" @loc.wr_inhs1 -- todo: is perhaps a mistake in 2hs + loc.wr_syn = @loc.genwrap "syn" @loc.wr_syns + loc.genwrap = \nm attrs -> + "and" >#< @loc.t_params >#< nm >|< "_" >|< @nt >#< "=" >#< ppRecordTp + [ i >|< "_" >|< nm >|< "_" >|< @nt >#< ":" >#< ppTp t | (i,t) <- attrs ] + + loc.inhAttrs = fromJust $ Map.lookup @nt @lhs.inhmap + loc.wr_inhs = Map.toList $ @loc.wr_filter $ @loc.inhAttrs + loc.wr_inhs1 = Map.toList @loc.inhAttrs + loc.wr_filter = if kennedyWarren @lhs.options && lateHigherOrderBinding @lhs.options + then Map.delete idLateBindingAttr + else id + loc.wr_syns = Map.toList $ fromJust $ Map.lookup @nt @lhs.synmap + + loc.wrapname = text ("wrap_" ++ show @nt) + loc.inhname = text ("inh_" ++ show @nt) + loc.synname = text ("syn_" ++ show @nt) + loc.firstVisitInfo = Map.findWithDefault ManyVis @initial @nextVisits + + loc.wrapArgSemTp = @loc.t_params >#< @loc.t_type + loc.wrapArgInhTp = @loc.t_params >#< @loc.inhname + loc.wrapArgPats = ppRecordVal [ i >|< "_inh_" >|< @nt >#< "=" >#< lhsname True i | (i,_) <- @loc.wr_inhs1 ] + loc.wrapResTp = @loc.t_params >#< @loc.synname + loc.wrapper = "and" >#< ppFunDecl @loc.o_sigs @loc.wrapname [(pp "act", @loc.wrapArgSemTp), (@loc.wrapArgPats, @loc.wrapArgInhTp)] @loc.wrapResTp @loc.wrapperPreamble + loc.wrapperPreamble + = ( if lateHigherOrderBinding @lhs.options + then "let" >#< lhsname True idLateBindingAttr >#< "=" >#< lateBindingFieldNm @lhs.mainName >#< "in" + else empty + ) -- initial attribute for late binding + >-< @loc.wrapperBody + loc.wrapperBody + = case @initialv of + Nothing -> text "{ }" -- case where there are no inherited or synthesized attributes + Just initv -> + let attach = "let" >#< "sem" >#< "=" >#< "act." >|< nm_attach @nt >#< "()" >#< "in" -- run attach code + + -- result transformer to wrapper output record + pat = ppRecordVal [ nm_outarg i @nt initv >#< "=" >#< lhsname False i | (i,_) <- @loc.wr_syns ] + bld = ppRecordVal [ i >|< "_syn_" >|< @nt >#< "=" >#< lhsname False i | (i,_) <- @loc.wr_syns ] + res = "let res = function" >#< pat >#< "->" >#< bld >#< "in" + + -- input to the visit (inh attrs + continuation) + inps = "let" >#< "inps" >#< "=" >#< ppRecordVal [ nm_inarg i @nt initv >#< "=" >#< lhsname True i | (i,_) <- @loc.wr_inhs ] >#< "in" + arg = "let" >#< "arg" >#< "=" >#< argcon >#< argrec >#< "in" + argcon = case @loc.firstVisitInfo of + ManyVis -> con_visit @nt initv + _ -> empty + argrec = ppRecordVal + [ nm_inh @nt initv >#< "=" >#< "inps" + , nm_cont @nt initv >#< "=" >#< "res" + ] + invoke = "sem." >|< nm_invoke @nt @initial >#< "arg" -- invoke the visit + in attach >-< res >-< inps >-< arg >-< invoke + +------------------------------------------------------------------------------- +-- Collection of NT / Production sem funs references +------------------------------------------------------------------------------- + +ATTR ENonterminals ENonterminal EProductions EProduction [ | | semFunBndDefs, semFunBndTps USE {Seq.><} {Seq.empty} : {Seq PP_Doc} ] +SEM ENonterminal | ENonterminal + lhs.semFunBndDefs = @loc.semFunBndDef Seq.<| @prods.semFunBndDefs + lhs.semFunBndTps = @loc.semFunBndTp Seq.<| @prods.semFunBndTps + loc.semFunBndDef = @loc.semFunBndNm >#< "=" >#< @loc.semname + loc.semFunBndTp = @loc.semFunBndNm >#< ":" >#< @loc.sem_tp + loc.semFunBndNm = lateSemNtLabel @nt + +SEM EProduction | EProduction + lhs.semFunBndDefs = Seq.singleton @loc.semFunBndDef + lhs.semFunBndTps = Seq.singleton @loc.semFunBndTp + loc.semFunBndDef = @loc.semFunBndNm >#< "=" >#< @loc.semname + loc.semFunBndTp = @loc.semFunBndNm >#< ":" >#< @loc.sem_tp + loc.semFunBndNm = lateSemConLabel @lhs.nt @con + +-- Generate a dictionary that contains the semantics of all semantic functions +SEM ExecutionPlan | ExecutionPlan + loc.wrappersExtra = if lateHigherOrderBinding @lhs.options + then @loc.lateSemBndDef + else empty + loc.commonExtra = if lateHigherOrderBinding @lhs.options + then @loc.lateSemBndTp + else empty + loc.lateSemBndTp = "and" >#< lateBindingTypeNm @lhs.mainName >#< "=" >#< ppRecordTp (toList @nonts.semFunBndTps) + loc.lateSemBndDef = "and" >#< lateBindingFieldNm @lhs.mainName >#< ":" >#< lateBindingTypeNm @lhs.mainName >#< "=" + >-< (indent 2 $ ppRecordVal $ toList @nonts.semFunBndDefs) + +------------------------------------------------------------------------------- +-- Production semantic functions +------------------------------------------------------------------------------- +ATTR EProduction [ | | sem_prod : {PP_Doc} ] +ATTR EProductions [ | | sem_prod USE {>-<} {empty} : {PP_Doc} ] + +ATTR EProduction EProductions [ initial : {StateIdentifier} + allstates : {[StateIdentifier]} | | ] +SEM ENonterminal | ENonterminal + prods.initial = @initial + prods.allstates = @loc.allstates + +SEM EProduction | EProduction + loc.o_sigs = typeSigs @lhs.options + loc.t_type = type_nt_sem_top @lhs.nt + loc.semname = prefix @lhs.options >|< @lhs.nt >|< "_" >|< @con + loc.sem_res_tp = @loc.t_params >#< @loc.t_type + loc.sem_tp = pp_block "" "" "->" [ d | (_,_,d,_) <- @children.sigs ] >#< "->" >#< @loc.sem_res_tp + + loc.initializer + = -- some actions, performed upon attaching a child, can + -- be specified here in the form of a let-expression. + -- The resulting bindings of these actions are + -- in scope of the rules of the production + empty -- nothing for now + + loc.sem_prod = "and" >#< ppFunDecl @loc.o_sigs @loc.semname [ (x,d) | (_,x,d,_) <- @children.sigs ] @loc.sem_res_tp @loc.prod_body + loc.prod_body + = @loc.initializer + >-< "{" >#< nm_attach @lhs.nt >#< "=" >#< "function () ->" + >-< indent 2 + ( "(* rules of production" >#< @con >#< "*)" + >-< @rules.sem_rules + >-< "(* states of production" >#< @con >#< "*)" + >-< vlist @loc.statefuns + >-< nm_st @lhs.initial + ) + >#< "}" + + -- the semantic function of a production: defines a series of states and + -- their transitions. Two sorts of functions are important: + -- k-functions: inspect the caller_type to find out which visit the + -- caller wants and then dispatches that visit and continuation. + -- v-functions: the actual code of the visit. + loc.statefuns = map @loc.genstfn @lhs.allstates + loc.genstfn + = \st -> let nextVisitInfo = Map.findWithDefault ManyVis st @lhs.nextVisits + stNm = nm_st st + + -- note about the initial state: the initial state should be the only + -- state-binding that is not a function. It is non-recursive, its definition does + -- not involve side effect, and its not needed + -- anywhere except to be delivered as initial result. + stDef body = "let" >#< stNm >#< (if st == @lhs.initial then empty else @loc.stargs st) >#< "=" + >-< indent 2 body >#< "in" + + in case nextVisitInfo of + NoneVis -> -- the (empty) closure of a (non-initial) end state is not referenced + -- thus generating it is not needed (and omitting it may catch some small mistakes). + if st == @lhs.initial + then stDef (pp "unit") -- empty state + else empty -- no state generated + _ -> stDef $ mklets (@loc.stvs st ++ @loc.stks st) $ ppRecordVal + [ nm_invoke @lhs.nt st >#< "=" >#< nm_k st ] + + loc.stargs + = \st -> let attrs = maybe Map.empty id $ Map.lookup st @visits.intramap in ppSpaced + [ case mbAttr of + Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs @lhs.options) -> + case Map.lookup nm @loc.localAttrTypes of + Just tp -> pp_parens (strNm >#< ":" >#< ppTp tp) + Nothing -> pp strNm + Just attr | not (noPerStateTypeSigs @lhs.options) -> + case lookupAttrType attr @lhs.allInhmap @lhs.allSynmap @loc.childTypes of + Just tpDoc -> pp_parens (strNm >#< ":" >#< tpDoc) + Nothing -> pp strNm + _ -> pp strNm + | (strNm, mbAttr) <- Map.assocs attrs + ] >#< dummyPat @lhs.options (Map.null attrs) + + -- produces the "k" function that inspect the caller argument to dispatch a visit + loc.stvisits = \st -> filter (\(_,f,_) -> f == st) @visits.allvisits + loc.stks + = \st -> let stvisits = @loc.stvisits st + def = ppFunDecl False {- @loc.o_sigs -} (pp $ nm_k st) + [(pp "arg", @loc.t_c_params >#< type_caller @lhs.nt st)] (pp cont_tvar) body + + nextVisitInfo = Map.findWithDefault ManyVis st @lhs.nextVisits + body = case nextVisitInfo of + NoneVis -> text "?no next visit?" + OneVis v -> dispatch "arg" v + ManyVis -> let alt (v,_,_) = "|" >#< con_visit @lhs.nt v >#< "chosen" >#< "->" >-< indent 2 (dispatch "chosen" v) + in "match arg with" >-< (indent 2 $ vlist $ map alt stvisits) + + dispatch nm v = "let" >#< ppRecordVal + [ nm_inh @lhs.nt v >#< "=" >#< "inp" + , nm_cont @lhs.nt v >#< "=" >#< "cont" ] + >#< "=" >#< pp nm + >-< "in" >#< "cont" >#< pp_parens (nm_visit v >#< "inp") -- call cont with res of visit + + in if null stvisits + then [] + else [ "(* k-function for production" >#< @con >#< " *)" >-< def ] + + loc.stvs = \st -> [ppf | (f,ppf) <- @visits.sem_visit, f == st] + visits.mrules = @rules.mrules + +{ +nm_visit v = "__v" >|< v +nm_k st = "__k" >|< st +nm_st st = "__st" >|< st + +mklets :: (PP b, PP c) => [b] -> c -> PP_Doc +mklets defs body = res where + ppLet def = "let" >#< def >#< "in" + res = vlist (map ppLet defs) >-< body +} + +------------------------------------------------------------------------------- +-- Visit semantic functions +------------------------------------------------------------------------------- +ATTR Visit [ | | sem_visit : { (StateIdentifier,PP_Doc) } ] +ATTR Visits [ | | sem_visit USE {:} {[]} : { [(StateIdentifier,PP_Doc)] } ] + +SEM Visit | Visit + loc.o_sigs = typeSigs @lhs.options + lhs.sem_visit = ( @from + , let resTp = @loc.t_params >#< @loc.nameTOut_visit + argTp = @loc.t_params >#< @loc.nameTIn_visit + argMatch = ppRecordVal [ nm_inarg i @lhs.nt @ident >#< "=" >#< lhsname True i | i <- Set.toList @inh ] + in ppFunDecl @loc.o_sigs (nm_visit @ident) [(argMatch, argTp)] resTp @steps.sem_steps + ) + + steps.follow = @loc.nextStBuild >-< @loc.resultval + + loc.nextArgsMp = maybe Map.empty id $ Map.lookup @to @lhs.allintramap + loc.nextArgs = ppSpaced $ Map.keys $ @loc.nextArgsMp + loc.nextStExp = nm_st @to >#< @loc.nextArgs >#< dummyArg @lhs.options (Map.null @loc.nextArgsMp) + + loc.resultval = ppRecordVal + ( [ nm_outarg i @lhs.nt @ident >#< "=" >#< lhsname False i | i <- Set.toList @syn ] + ++ [ @loc.nextStRefExp ]) + + (loc.nextStBuild, loc.nextStRefExp) + = case @loc.nextVisitInfo of + NoneVis -> (empty, empty) + _ -> ( "let" >#< nextStName >#< "=" >#< @loc.nextStExp >#< "in" + , nm_outarg_cont @lhs.nt @ident >#< "=" >#< nextStName) + +{ +resultValName :: String +resultValName = "__result_" + +nextStName :: String +nextStName = "__st_" +} + +-- Propagate the visit kind to the steps +ATTR VisitStep VisitSteps [ kind : VisitKind | | ] +SEM Visit | Visit steps.kind = @kind + +-- the steps in this group should be executed in a pure fashion +SEM VisitStep | PureGroup + steps.kind = VisitPure @ordered + +-- follow: the code of steps that follows after the VisitStep +ATTR Visits Visit VisitStep VisitSteps [ mrules : {Map Identifier (VisitKind -> Either Error PP_Doc)} | | ] +ATTR VisitStep VisitSteps [ follow : PP_Doc | | sem_steps USE {>-<} {empty} : PP_Doc ] + +-- continuation flow (passing the right steps as left follow steps) +SEM VisitSteps + | Cons hd.follow = @tl.sem_steps + lhs.sem_steps = @hd.sem_steps + | Nil lhs.sem_steps = @lhs.follow + +SEM VisitStep + | Sem loc.ruleItf = Map.findWithDefault (error $ "Rule " ++ show @name ++ " not found") @name @lhs.mrules + (lhs.errors, loc.sem_steps) = case @loc.ruleItf @lhs.kind of + Left e -> (Seq.singleton e, empty) + Right stmt -> (Seq.empty, stmt) + lhs.sem_steps = @loc.sem_steps >-< @lhs.follow + | ChildIntro loc.attachItf = Map.findWithDefault (error $ "Child " ++ show @child ++ " not found") @child @lhs.childintros + (lhs.errors,loc.sem_steps,lhs.defs,lhs.uses) + = case @loc.attachItf @lhs.kind of + Left e -> (Seq.singleton e, empty, Set.empty, Map.empty) + Right (code, defs, uses) -> (Seq.empty, code, defs, uses) + lhs.sem_steps = @loc.sem_steps >-< @lhs.follow + | ChildVisit loc.visitItf = Map.findWithDefault (error $ "Visit " ++ show @visit ++ " not found") @visit @lhs.allchildvisit + loc.childType = Map.findWithDefault (error ("type of child " ++ show @child ++ " is not in the childTypes map! " ++ show @lhs.childTypes)) @child @lhs.childTypes + (lhs.errors, lhs.sem_steps) = case @loc.visitItf @child @loc.childType @lhs.kind @lhs.follow of + Left e -> (Seq.singleton e, empty) + Right steps -> (Seq.empty, steps) + | Sim -- simply propagates + | PureGroup -- simply propagates + +-- +-- Some properties of VisitStep(s) +-- + +-- Number of steps in a 'Sim' block +ATTR VisitSteps [ | | size : Int ] +SEM VisitSteps + | Nil lhs.size = 0 + | Cons lhs.size = 1 + @tl.size + +-- Number the steps in a 'Sim' block +ATTR VisitSteps VisitStep [ | index : Int | ] +SEM VisitSteps | Cons + hd.index = @lhs.index -- copy rule + tl.index = 1 + @lhs.index + lhs.index = @tl.index -- copy rule +SEM Visit | Visit steps.index = 0 +SEM VisitStep | Sim steps.index = 0 + lhs.index = @lhs.index -- needed for if we ever allow nested Sims + +-- Biggest number of steps in previous blocks that used parallel invocation +-- This number - 1 (minimum 0) is the number of references for parallel invocation created +ATTR VisitSteps VisitStep [ | prevMaxSimRefs : Int | ] +SEM Visit | Visit steps.prevMaxSimRefs = 0 +SEM VisitStep | Sim + lhs.prevMaxSimRefs = if @loc.useParallel + then @lhs.prevMaxSimRefs `max` (@steps.index - 1) -- possibly new references made + else @lhs.prevMaxSimRefs -- no references created + +-- Is this the last step? +ATTR VisitSteps VisitStep [ | | isLast : Bool ] +ATTR VisitStep [ isLast : Bool | | ] +SEM VisitSteps + | Nil lhs.isLast = True + | Cons lhs.isLast = False + hd.isLast = @tl.isLast + +-- Use parallel invocation: only when option enabled and there is more than one visit to a child +-- Todo: implement a parallel evaluator +SEM VisitSteps VisitStep [ useParallel : Bool | | ] +SEM Visit | Visit steps.useParallel = False +SEM VisitStep | Sim loc.useParallel = parallelInvoke @lhs.options && @steps.size > 1 + +-- Child introduction +ATTR EChild EChildren + [ | | childintros USE {`Map.union`} {Map.empty} : {Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))} ] + +ATTR Visits Visit VisitSteps VisitStep + [ childintros : {Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))} | | ] + +SEM EProduction | EProduction + visits.childintros = @children.childintros + +SEM EChild + | ETerm lhs.childintros = Map.singleton @name (\_ -> Right (empty, Set.empty, Map.empty)) + | EChild lhs.childintros = Map.singleton @name @loc.introcode + loc.isDefor = case @tp of + NT _ _ defor -> defor + _ -> False + loc.valcode = case @kind of + ChildSyntax -> @name >|< "_" + ChildAttr -> -- decide if we need to invoke the sem-function under the hood + let head | not @loc.isDefor = if lateHigherOrderBinding @lhs.options + then lateSemNtLabel @loc.nt >#< lhsname True idLateBindingAttr + else prefix @lhs.options >|< @loc.nt + | otherwise = empty -- no need to intro a terminal + in pp_parens (head >#< instname @name) + ChildReplace _ -> -- the higher-order attribute is actually a function that transforms + -- the semantics of the child (always deforested) + pp_parens (instname @name >#< @name >|< "_") + loc.aroundcode = if @hasAround + then locname @name >|< "_around" + else empty + loc.introcode = \kind -> let pat = text $ stname @name @loc.initSt + attach = pp_parens (@loc.aroundcode >#< @loc.valcode) >|< "." >|< nm_attach @loc.nt >#< "()" + decl = pat >#< "=" >#< attach + in if compatibleAttach kind @loc.nt @lhs.options + then Right ( "let" >#< decl >#< "in" + , Set.singleton (stname @name @loc.initSt) -- variables defined by the child intro + , case @kind of -- variables used by the child introduction + ChildAttr -> Map.insert (instname @name) Nothing $ -- the sem attr + ( if @loc.isDefor || not (lateHigherOrderBinding @lhs.options) + then id -- the sem dictionary attr is not used + else Map.insert (lhsname True idLateBindingAttr) (Just $ AttrInh _LHS idLateBindingAttr) + ) $ + ( if @hasAround + then Map.insert (locname (@name) ++ "_around") Nothing + else id + ) $ Map.empty + ChildReplace _ -> Map.singleton (instname @name) Nothing -- uses the transformation function + ChildSyntax -> Map.empty + ) + else Left $ IncompatibleAttachKind @name kind + loc.nt = extractNonterminal @tp + +{ +stname :: Identifier -> Int -> String +stname child st = "_" ++ getName child ++ "X" ++ show st + +-- should actually return some conversion info +compatibleAttach :: VisitKind -> NontermIdent -> Options -> Bool +compatibleAttach _ _ _ = True +} + +-- rules +ATTR ERules ERule [ | | sem_rules USE {>-<} {empty} : {PP_Doc} + mrules USE {`Map.union`} {Map.empty} : {Map Identifier (VisitKind -> Either Error PP_Doc)} ] + +SEM ERule | ERule + lhs.sem_rules = if @loc.used == 0 + then empty + else @loc.rulecode + loc.rulecode = ( if @loc.genpragma + then @loc.pragma -- this additional pragma *may* help to give some AG source location in the presence of + -- type errors in the rule. It will definitely not be precise, and may take some additional + -- source space, but let's see if it's worth it in practice. + else empty + ) + >-< @loc.declHead + >-< indent ((column @rhs.pos - 2) `max` 2) + ( if @loc.genpragma + then @loc.pragma >-< @rhs.semfunc >-< @loc.endpragma + else @rhs.semfunc + ) + >#< "in" + loc.pragma = ppLinePragma @lhs.options (line @rhs.pos) (file @rhs.pos) + loc.endpragma = ppWithLineNr (\ln -> ppLinePragma @lhs.options (ln+1) @lhs.mainFile) + loc.genpragma = genLinePragmas @lhs.options && @explicit && @loc.haspos + loc.haspos = line @rhs.pos > 0 && column @rhs.pos >= 0 && not (null (file @rhs.pos)) + + -- Note: we also ensure that all rules are functions, so that they are not made part of any closures + -- but are lambda-lifted instead. + loc.declHead = "let" >#< @name >#< @loc.argPats >#< dummyPat @lhs.options (Map.null @rhs.attrs) >#< "=" + loc.argPats + = ppSpaced + [ case mbAttr of + Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs @lhs.options) -> + case Map.lookup nm @lhs.localAttrTypes of + Just tp -> pp_parens (strNm >#< ":" >#< ppTp tp) + Nothing -> pp strNm + Just attr | not (noPerStateTypeSigs @lhs.options) -> + case lookupAttrType attr @lhs.allInhmap @lhs.allSynmap @lhs.childTypes of + Just tpDoc -> pp_parens (strNm >#< ":" >#< tpDoc) + Nothing -> pp strNm + _ -> pp strNm + | (strNm, mbAttr) <- Map.assocs @rhs.attrs + ] + + loc.argExprs = ppSpaced $ Map.keys @rhs.attrs + loc.stepcode = \kind -> + let mkBind (pat,expr) = "let" >#< pat >#< "=" >#< expr >#< "in" + in if kind `compatibleRule` @pure + then Right $ mkBind (@pattern.sem_lhs, @name >#< @loc.argExprs >#< dummyArg @lhs.options (Map.null @rhs.attrs)) + >-< vlist (map mkBind @pattern.extraDefs) + else Left $ IncompatibleRuleKind @name kind + + lhs.mrules = Map.singleton @name @loc.stepcode + +ATTR Expression [ | | tks : {[HsToken]} ] +SEM Expression + | Expression lhs.tks = @tks + +{ +dummyPat :: Options -> Bool -> PP_Doc +dummyPat opts noArgs + | not noArgs = empty + | strictDummyToken opts = text "()" + | otherwise = text "(_ : unit)" + +dummyArg :: Options -> Bool -> PP_Doc +dummyArg opts noArgs + | not noArgs = empty + | otherwise = text "()" + +dummyType :: Options -> Bool -> PP_Doc +dummyType opts noArgs + | not noArgs = empty + | otherwise = text "unit" +} + +ATTR Expression [ | | pos : {Pos} ] +SEM Expression | Expression lhs.pos = @pos + +-- pattern and expression semantics +ATTR Pattern [ | | sem_lhs : { PP_Doc } ] +ATTR Patterns [ | | sem_lhs USE {:} {[]} : {[PP_Doc]} ] +ATTR Pattern Patterns [ | | extraDefs USE {++} {[]} : {[(PP_Doc,PP_Doc)]} ] + +SEM Pattern + | Alias loc.var = text $ attrname False @field @attr + loc.hasTp = isJust @loc.mbTp + loc.o_sigs = typeSigs @lhs.options + + lhs.sem_lhs = ppArg (@loc.hasTp && @loc.o_sigs) @loc.var (maybe (text "?no type?") ppTp @loc.mbTp) + lhs.extraDefs = if @pat.isUnderscore + then [] + else [ (@pat.sem_lhs, @loc.var) ] + | Product lhs.sem_lhs = pp_block "(" ")" "," @pats.sem_lhs + | Constr lhs.sem_lhs = pp_parens $ @name >#< pp_block "(" ")" "," @pats.sem_lhs + | Underscore lhs.sem_lhs = text "_" + | Irrefutable lhs.sem_lhs = pp_parens (text "lazy" >#< @pat.sem_lhs) + -- note that the above has the inverse meaning compared to Haskell: + -- the above forces the evaluation of a lazy value. It seems appropriate though. + +-- Check if a pattern is just an underscore +ATTR Pattern [ | | isUnderscore:{Bool}] +SEM Pattern + | Constr lhs.isUnderscore = False + | Product lhs.isUnderscore = False + | Alias lhs.isUnderscore = False + | Underscore lhs.isUnderscore = True + +-- Collect the attributes defined by a pattern +ATTR Pattern Patterns [ | | attrs USE {`Set.union`} {Set.empty} : {Set String} ] +SEM Pattern | Alias + lhs.attrs = Set.insert (attrname False @field @attr) @pat.attrs + +-- All attribute types of this pattern +-- Todo: if possible, make attribute types part of the pattern +ATTR Pattern Patterns [ | | attrTypes USE {>-<} {empty} : {PP_Doc} ] +SEM Pattern | Alias + loc.mbTp = if @field == _LHS + then Map.lookup @attr @lhs.synmap + else if @field == _LOC + then Map.lookup @attr @lhs.localAttrTypes + else Nothing + lhs.attrTypes = maybe empty (\tp -> (attrname False @field @attr) >#< "::" >#< ppTp tp) @loc.mbTp + >-< @pat.attrTypes + +-- Collect the attributes used by the right-hand side +ATTR HsToken Expression [ | | attrs USE {`Map.union`} {Map.empty} : {Map String (Maybe NonLocalAttr)} ] +SEM HsToken + | AGLocal lhs.attrs = Map.singleton (fieldname @var) Nothing + | AGField loc.mbAttr = if @field == _INST || @field == _FIELD || @field == _INST' + then Nothing -- should not be used in the first place + else Just $ mkNonLocalAttr (@field == _LHS) @field @attr + lhs.attrs = Map.singleton (attrname True @field @attr) @loc.mbAttr + +{ +data NonLocalAttr + = AttrInh Identifier Identifier + | AttrSyn Identifier Identifier deriving Show + +mkNonLocalAttr :: Bool -> Identifier -> Identifier -> NonLocalAttr +mkNonLocalAttr True = AttrInh -- True: inherited attr +mkNonLocalAttr False = AttrSyn + +lookupAttrType :: NonLocalAttr -> Map Identifier Attributes -> Map Identifier Attributes -> Map Identifier Type -> Maybe PP_Doc +lookupAttrType (AttrInh child name) inhs _ = lookupType child name inhs +lookupAttrType (AttrSyn child name) _ syns = lookupType child name syns + +-- Note: if the child takes type parameters, the type of an attribute of this child may refer to these parameters. This means that +-- the actual type of the attribute needs to have its type parameters substituted with the actual type argument of the child. +-- However, for now we simply decide to return Nothing in this case, which skips the type annotation. +lookupType :: Identifier -> Identifier -> Map Identifier Attributes -> Map Identifier Type -> Maybe PP_Doc +lookupType child name attrMp childMp + | noParameters childTp = Just ppDoc + | otherwise = Nothing + where + attrTp = Map.findWithDefault (error "lookupType: the attribute is not in the attrs of the child") name childAttrs + childAttrs = Map.findWithDefault (error "lookupType: the attributes of the nonterm are not in the map") nonterm attrMp + nonterm = extractNonterminal childTp + childTp = Map.findWithDefault (error ("lookupType: the child " ++ show child ++ "is not in the appropriate map")) child childMp + ppDoc = ppTp attrTp + +noParameters :: Type -> Bool +noParameters (Haskell _) = True +noParameters (NT _ args _) = null args +} + +ATTR Expression [ | | semfunc : {PP_Doc} ] + +SEM Expression + | Expression lhs.attrs = Map.unions $ map (\tok -> attrs_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) @tks + lhs.semfunc = vlist $ showTokens $ map (\tok -> tok_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) @tks + +-- child visit map +ATTR Visit + Visits + EProduction + EProductions + ENonterminal + ENonterminals [ allchildvisit : {Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)} + | | childvisit USE {`Map.union`} {Map.empty} : {Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)} ] + +ATTR VisitSteps VisitStep [ allchildvisit : {Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)} | | ] + +SEM ExecutionPlan + | ExecutionPlan nonts.allchildvisit = @nonts.childvisit + +-- code for the invocation of the visit: +-- * "follow" is the pretty print of the code that follows this step, and is thus the code that comprises the continuation. +-- * the child state contain a field which is the operation to invoke +-- * we create a parameter with the inputs to the visit and the continuation +-- * the continuation obtains the resulting outputs plus the updated state +SEM Visit | Visit + loc.prevVisitInfo = Map.findWithDefault ManyVis @from @lhs.nextVisits + lhs.childvisit = Map.singleton @ident @loc.invokecode + loc.invokecode + = \chld childTp kind follow -> -- "chld" is the name of the child at the place of invocation, and "kind" the kind of the calling visit + let code = cont >-< inps >-< call + + childNmTo = text $ stname chld @to + childNmFrom = text $ stname chld @from + childTpArgs = case childTp of + NT _ args _ -> args + _ -> error "generate visit call: type of the child is not a nonterminal!" + + -- cont is parameterized with the outputs of the child and brings them in scope + cont = "let" >#< contNm >#< ppArg @loc.o_sigs (ppRecordVal cont_in) cont_in_tp >#< "=" + >-< indent 2 follow -- the continuation-code + >#< "in" + cont_in = [ nm_outarg i @lhs.nt @ident >#< "=" >#< attrname True chld i | i <- Set.toList @syn ] + ++ case @loc.nextVisitInfo of + NoneVis -> [] + _ -> [ nm_outarg_cont @lhs.nt @ident >#< "=" >#< childNmTo ] + cont_in_tp = ppTypeParams childTpArgs >#< @loc.nameTOut_visit + + -- defines the input records to the visit function + inps = "let" >#< inpsNm >#< "=" >#< ppRecordVal + [ nm_inh @lhs.nt @ident >#< "=" >#< ppRecordVal inps_in + , nm_cont @lhs.nt @ident >#< "=" >#< contNm + ] >#< "in" + inps_in = [ nm_inarg i @lhs.nt @ident >#< "=" >#< attrname False chld i | i <- Set.toList @inh ] + + -- the call to the visit function, with possible the need to specify which visit function to dispatch to + call = childNmFrom >|< "." >|< nm_invoke @lhs.nt @from >#< arg + arg = case @loc.prevVisitInfo of + NoneVis -> error "error: invocation of a visit from a state that has no next visits" + OneVis _ -> pp inpsNm + ManyVis -> pp_parens (con_visit @lhs.nt @ident >#< inpsNm) + in if kind `compatibleKind` @kind + then Right code + else Left $ IncompatibleVisitKind chld @ident kind @kind + +{ +contNm = text "__cont_" +inpsNm = text "__inps_" + +-- a `compatibleKind` b means: can kind b be invoked from a +compatibleKind :: VisitKind -> VisitKind -> Bool +compatibleKind _ _ = True + +compatibleRule :: VisitKind -> Bool -> Bool +compatibleRule (VisitPure _) False = False +compatibleRule _ _ = True +} + +------------------------------------------------------------------------------- +-- Properties of rules +------------------------------------------------------------------------------- + +-- Construct an environment that counts how often certain rules are used +ATTR Visits Visit VisitSteps VisitStep [ | | ruleUsage USE {`unionWithSum`} {Map.empty} : {Map Identifier Int} ] +ATTR ERules ERule [ usageInfo : {Map Identifier Int} | | ] + +SEM EProduction | EProduction rules.usageInfo = @visits.ruleUsage +SEM VisitStep | Sem lhs.ruleUsage = Map.singleton @name 1 +SEM ERule | ERule loc.used = Map.findWithDefault 0 @name @lhs.usageInfo + +{ +unionWithSum = Map.unionWith (+) +} + +-- Collect in what visit-kinds a rule is used +ATTR Visits Visit VisitSteps VisitStep [ | | ruleKinds USE {`unionWithMappend`} {Map.empty} : {Map Identifier (Set VisitKind)} ] +SEM VisitStep | Sem + lhs.ruleKinds = Map.singleton @name (Set.singleton @lhs.kind) + +ATTR ERules ERule [ ruleKinds : {Map Identifier (Set VisitKind)} | | ] +SEM EProduction | EProduction + rules.ruleKinds = @visits.ruleKinds + +SEM ERule | ERule + loc.kinds = Map.findWithDefault Set.empty @name @lhs.ruleKinds + loc.anyLazyKind = Set.fold (\k r -> isLazyKind k || r) False @loc.kinds + +ATTR Pattern Patterns [ anyLazyKind : Bool | | ] + + +------------------------------------------------------------------------------- +-- Intra attributes +------------------------------------------------------------------------------- +{ +uwSetUnion :: (Ord a, Ord b) => Map a (Set b) -> Map a (Set b) -> Map a (Set b) +uwSetUnion = Map.unionWith Set.union + +uwMapUnion :: (Ord a, Ord b) => Map a (Map b c) -> Map a (Map b c) -> Map a (Map b c) +uwMapUnion = Map.unionWith Map.union +} +ATTR Visit Visits [ allintramap : {Map StateIdentifier (Map String (Maybe NonLocalAttr))} + | | intramap USE {`uwMapUnion`} {Map.empty} : {Map StateIdentifier (Map String (Maybe NonLocalAttr))} ] + +ATTR Visit Visits [ terminaldefs : {Set String} | | ] +ATTR EChild EChildren [ | | terminaldefs USE {`Set.union`} {Set.empty} : {Set String} ] + +SEM EChild | ETerm + lhs.terminaldefs = Set.singleton $ fieldname @name + +SEM EProduction | EProduction + visits.allintramap = @visits.intramap + visits.terminaldefs = @children.terminaldefs + +SEM Visit + | Visit loc.thisintra = (@loc.uses `Map.union` @loc.nextintra) `Map.difference` @loc.defsAsMap + lhs.intramap = Map.singleton @from @loc.thisintra + loc.nextintra = maybe Map.empty id $ Map.lookup @to @lhs.allintramap + loc.uses = let mp1 = @steps.uses + mp2 = Map.fromList [ (lhsname False i, Just (AttrSyn _LHS i)) | i <- Set.elems @syn ] + in mp1 `Map.union` mp2 + loc.inhVarNms = Set.map (lhsname True) @inh + loc.defs = @steps.defs `Set.union` @loc.inhVarNms `Set.union` @lhs.terminaldefs + loc.defsAsMap = Map.fromList [ (a, Nothing) | a <- Set.elems @loc.defs ] + +ATTR ERule ERules [ | | ruledefs USE {`uwSetUnion`} {Map.empty} : {Map Identifier (Set String)} + ruleuses USE {`uwMapUnion`} {Map.empty} : {Map Identifier (Map String (Maybe NonLocalAttr))} ] +ATTR Visit Visits + VisitSteps VisitStep [ ruledefs : {Map Identifier (Set String)} + ruleuses : {Map Identifier (Map String (Maybe NonLocalAttr))} | | ] + +SEM ERule + | ERule lhs.ruledefs = Map.singleton @name @pattern.attrs + lhs.ruleuses = Map.singleton @name @rhs.attrs + +SEM EProduction + | EProduction visits.ruledefs = @rules.ruledefs + visits.ruleuses = @rules.ruleuses + +ATTR Visit Visits + EProduction + EProductions + ENonterminal + ENonterminals [ | | visitdefs USE {`uwSetUnion`} {Map.empty} : {Map VisitIdentifier (Set Identifier)} + visituses USE {`uwSetUnion`} {Map.empty} : {Map VisitIdentifier (Set Identifier)} ] + +SEM Visit + | Visit lhs.visitdefs = Map.singleton @ident @syn + lhs.visituses = Map.singleton @ident @inh + +ATTR Visit Visits + VisitSteps VisitStep + EProduction EProductions + ENonterminal ENonterminals [ avisitdefs : {Map VisitIdentifier (Set Identifier)} + avisituses : {Map VisitIdentifier (Set Identifier)} | | ] + +SEM ExecutionPlan + | ExecutionPlan nonts.avisitdefs = @nonts.visitdefs + nonts.avisituses = @nonts.visituses + +ATTR VisitSteps VisitStep [ | | defs USE {`Set.union`} {Set.empty} : {Set String} + uses USE {`Map.union`} {Map.empty} : {Map String (Maybe NonLocalAttr)} ] +SEM VisitStep + | Sem lhs.defs = maybe (error "Rule not found") id $ Map.lookup @name @lhs.ruledefs + lhs.uses = maybe (error "Rule not found") id $ Map.lookup @name @lhs.ruleuses + | ChildVisit lhs.defs = Set.insert (stname @child @to) $ maybe (error "Visit not found") (Set.map $ attrname True @child) $ Map.lookup @visit @lhs.avisitdefs + lhs.uses = let convert attrs = Map.fromList [ (attrname False @child attr, Just $ mkNonLocalAttr True @child attr) | attr <- Set.elems attrs ] + in Map.insert (stname @child @from) Nothing $ convert $ + maybe (error "Visit not found") id $ Map.lookup @visit @lhs.avisituses + +------------------------------------------------------------------------------- +-- Identification of lazy intra defs within a production +-- +-- These identifiers will not be marked as strict in rules and state closures +------------------------------------------------------------------------------- + +ATTR Visits Visit VisitSteps VisitStep [ | | lazyIntras USE {`Set.union`} {Set.empty} : {Set String} ] +ATTR ERules ERule [ lazyIntras : {Set String} | | ] + +SEM Visit | Visit + loc.lazyIntrasInh = case @kind of + VisitPure False -> @loc.inhVarNms `Set.union` @steps.defs + _ -> Set.empty + lhs.lazyIntras = @loc.lazyIntrasInh `Set.union` @steps.lazyIntras + +SEM VisitStep | PureGroup + lhs.lazyIntras = if @ordered + then @steps.lazyIntras + else @steps.defs + +SEM EProduction | EProduction + loc.lazyIntras = @visits.lazyIntras + +------------------------------------------------------------------------------- +-- Pretty printing of haskell code +------------------------------------------------------------------------------- + +-- note: this function produces strings, which are passed to showTokens which +-- preserves layout. +-- note: this may not be that important for ocaml code in comparison to Haskell +SEM HsTokens [ || tks : {[(Pos,String)]} ] + | Cons lhs.tks = @hd.tok : @tl.tks + | Nil lhs.tks = [] + +SEM HsToken + | AGLocal loc.tok = (@pos,fieldname @var) + +SEM HsToken [ || tok:{(Pos,String)}] + | AGField + loc.addTrace = case @rdesc of + Just d -> \x -> "(prerr_endline " ++ show (d ++ " -> " ++ show @field ++ "." ++ show @attr) ++ "; " ++ x ++ ")" + Nothing -> id + lhs.tok = (@pos, @loc.addTrace $ attrname True @field @attr) + + | HsToken lhs.tok = (@pos, @value) + + | CharToken lhs.tok = (@pos, if null @value + then "" + else showCharShort (head @value) + ) + + | StrToken lhs.tok = (@pos, showStrShort @value) + | Err lhs.tok = (@pos, "") + +-- +-- Distribute single-visit-next map downward +-- + +ATTR EProductions EProduction Visits Visit + [ prevVisits, nextVisits : {Map StateIdentifier StateCtx} | | ] + +SEM ENonterminal | ENonterminal + prods.nextVisits = @nextVisits + prods.prevVisits = @prevVisits + +-- +-- Collect and distribute the from/to states of a visit +-- + +ATTR ENonterminals ENonterminal EProductions EProduction Visits Visit + [ | | fromToStates USE {`mappend`} {mempty} : {Map VisitIdentifier (Int,Int)} ] + +ATTR ENonterminals ENonterminal EProductions EProduction Visits Visit VisitSteps VisitStep + [ allFromToStates : {Map VisitIdentifier (Int,Int)} | | ] + +SEM Visit | Visit + lhs.fromToStates = Map.singleton @ident (@from, @to) + +SEM ExecutionPlan | ExecutionPlan + nonts.allFromToStates = @nonts.fromToStates + +SEM VisitStep | ChildVisit + (loc.from, loc.to) = Map.findWithDefault (error "visit not in allFromToStates") @visit @lhs.allFromToStates + + +-- +-- Collect and distribute the actual types of children of productions +-- + +ATTR EChildren EChild [ | | childTypes USE {`mappend`} {mempty} : {Map Identifier Type} ] +ATTR ERules ERule Visits Visit VisitSteps VisitStep [ childTypes : {Map Identifier Type} | | ] + +SEM EProduction | EProduction + loc.childTypes = Map.singleton _LHS @lhs.ntType `Map.union` @children.childTypes + +SEM EChild | EChild ETerm + lhs.childTypes = Map.singleton @name @tp + +-- +-- Distribute types of local attributes +-- + +ATTR ExecutionPlan ENonterminals ENonterminal [ localAttrTypes : {Map NontermIdent (Map ConstructorIdent (Map Identifier Type))} | | ] +ATTR EProductions EProduction [ localAttrTypes : {Map ConstructorIdent (Map Identifier Type)} | | ] +ATTR ERules ERule Pattern Patterns [ localAttrTypes : {Map Identifier Type} | | ] + +SEM ENonterminal | ENonterminal + prods.localAttrTypes = Map.findWithDefault Map.empty @nt @lhs.localAttrTypes + +SEM EProduction | EProduction + loc.localAttrTypes = Map.findWithDefault Map.empty @con @lhs.localAttrTypes + +-- +-- Collect and distribute visit kinds +-- + +ATTR ENonterminals ENonterminal EProductions EProduction Visits Visit VisitSteps VisitStep + [ allVisitKinds : {Map VisitIdentifier VisitKind} | | visitKinds USE {`mappend`} {mempty} : {Map VisitIdentifier VisitKind} ] + +SEM Visit | Visit + lhs.visitKinds = Map.singleton @ident @kind + +SEM ExecutionPlan | ExecutionPlan + nonts.allVisitKinds = @nonts.visitKinds + +-- +-- Collect and distribute the initial state of nonterminals +-- + +ATTR ENonterminals ENonterminal [ | | initStates USE {`mappend`} {mempty} : {Map NontermIdent Int} ] +ATTR ENonterminals ENonterminal EProductions EProduction EChildren EChild Visits Visit VisitSteps VisitStep + [ allInitStates : {Map NontermIdent Int} | | ] + +SEM ENonterminal | ENonterminal + lhs.initStates = Map.singleton @nt @initial + +SEM ExecutionPlan | ExecutionPlan + nonts.allInitStates = @nonts.initStates + +SEM EChild | EChild + loc.initSt = Map.findWithDefault (error "nonterminal not in allInitStates map") @loc.nt @lhs.allInitStates + +-- +-- Push the nonterminal type downward +-- + +ATTR EProductions EProduction [ ntType : Type | | ] +SEM ENonterminal | ENonterminal + loc.ntType = NT @nt (map show @params) False + +-- +-- Collect errors contained in rules that should be yielded when the +-- rules are scheduled. +-- + +ATTR ExecutionPlan ENonterminals ENonterminal EProductions EProduction ERules ERule Visits Visit VisitSteps VisitStep [ | | errors USE {Seq.><} {Seq.empty} : {Seq Error} ] +SEM ERule | ERule + lhs.errors = case @mbError of + Just e | @loc.used > 0 -> Seq.singleton e + _ -> Seq.empty diff --git a/src-ag/ExecutionPlan2Hs.ag b/src-ag/ExecutionPlan2Hs.ag --- a/src-ag/ExecutionPlan2Hs.ag +++ b/src-ag/ExecutionPlan2Hs.ag @@ -215,10 +215,7 @@ { ppTp :: Type -> PP_Doc -ppTp (Haskell s) = text s -ppTp (NT nt args for) = prefix >|< nt >#< ppSpaced (map pp_parens args) where - prefix | for = text "T_" - | otherwise = empty +ppTp = text . typeToHaskellString Nothing [] } ------------------------------------------------------------------------------- @@ -450,7 +447,7 @@ loc.synAttrs = fromJust $ Map.lookup @nt @lhs.inhmap loc.wr_inhs = Map.toList $ @loc.wr_filter $ @loc.synAttrs loc.wr_inhs1 = Map.toList @loc.synAttrs - loc.wr_filter = if kennedyWarren @lhs.options && lateHigherOrderBinding @lhs.options + loc.wr_filter = if lateHigherOrderBinding @lhs.options then Map.delete idLateBindingAttr else id loc.wr_syns = Map.toList $ fromJust $ Map.lookup @nt @lhs.synmap @@ -499,7 +496,7 @@ ) ) >-< ")" ) - >-< if kennedyWarren @lhs.options && lateHigherOrderBinding @lhs.options + >-< if lateHigherOrderBinding @lhs.options then indent 2 ("where" >#< lhsname True idLateBindingAttr >#< "=" >#< lateBindingFieldNm @lhs.mainName) else empty loc.wrapPragma = if parallelInvoke @lhs.options && not (monadicWrappers @lhs.options) @@ -529,10 +526,10 @@ -- Generate a dictionary that contains the semantics of all semantic functions SEM ExecutionPlan | ExecutionPlan - loc.wrappersExtra = if kennedyWarren @lhs.options && lateHigherOrderBinding @lhs.options + loc.wrappersExtra = if lateHigherOrderBinding @lhs.options then @loc.lateSemBndDef else empty - loc.commonExtra = if kennedyWarren @lhs.options && lateHigherOrderBinding @lhs.options + loc.commonExtra = if lateHigherOrderBinding @lhs.options then @loc.lateSemBndTp else empty loc.lateSemBndTp = "data" >#< lateBindingTypeNm @lhs.mainName >#< "=" >#< lateBindingTypeNm @lhs.mainName @@ -684,7 +681,7 @@ then ppNoInline ("k" >|< st) else empty ) - >-< "k" >|< st >#< "::" >#< "K_" >|< @lhs.nt >|< "_s" >|< st >#< "t" >#< "->" >#< "t" + >-< "k" >|< st >#< "::" >#< "K_" >|< @lhs.nt >|< "_s" >|< st >#< @loc.t_params >#< "t" >#< "->" >#< "t" >-< vlist (map (\(v,f,t) -> "k" >|< st >#< "K_" >|< @lhs.nt >|< "_v" >|< v >#< "=" >#< "v" >|< v) $ @loc.stvisits st) loc.stvisits = \st -> filter (\(v,f,t) -> f == st) @visits.allvisits diff --git a/src-ag/Transform.ag b/src-ag/Transform.ag --- a/src-ag/Transform.ag +++ b/src-ag/Transform.ag @@ -54,6 +54,7 @@ @elems.paramsCollect @loc.allConParams @loc.allFields + @loc.prodOrder @loc.allConstraints @loc.allAttrDecls @elems.useMap @@ -256,7 +257,10 @@ SEM AG | AG - + loc.prodOrder = let f (nt,con,fm) = Map.insertWith g nt [con] + g [con] lst | con `elem` lst = lst + | otherwise = con : lst + in foldr f Map.empty @elems.collectedFields loc.allFields = let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm) in foldr f (Map.empty) @elems.collectedFields @@ -360,7 +364,7 @@ type AccumRuleCheck = (RulesAndErrors, AttrOverwrite) type AccumDefiCheck = (Seq Error, AttrOverwrite, [AttrName], [AttrName]) -checkRules :: Map NontermIdent (Attributes, Attributes) -> Map NontermIdent (Map ConstructorIdent FieldMap) -> +checkRules :: Map NontermIdent (Attributes, Attributes) -> DataTypes -> Map NontermIdent (Map ConstructorIdent [Identifier]) -> Map NontermIdent (Map ConstructorIdent [SigInfo]) -> Map NontermIdent (Map ConstructorIdent [MergeInfo]) -> NontermIdent -> ConstructorIdent -> [RuleInfo] -> RulesAndErrors @@ -417,7 +421,7 @@ else (TypeSig ide typ:sigs, errs) in foldr checkSig ([],Seq.empty) sis -checkInsts :: Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [SigInfo]) -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> NontermIdent -> ConstructorIdent -> [Identifier] -> InstsAndErrors +checkInsts :: Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [SigInfo]) -> DataTypes -> NontermIdent -> ConstructorIdent -> [Identifier] -> InstsAndErrors checkInsts allNts sigMap fieldMap nt con = foldr (\inst (insts, errs) -> maybe (insts, Seq.singleton (MissingInstSig nt con inst) >< errs) @@ -471,7 +475,7 @@ (inhs,syns) = Map.findWithDefault (Map.empty,Map.empty) nt allAttrs in foldr checkAugment (Map.empty, Seq.empty) augments -checkArounds :: Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> NontermIdent -> ConstructorIdent -> [AroundInfo] -> AroundsAndErrors +checkArounds :: DataTypes -> NontermIdent -> ConstructorIdent -> [AroundInfo] -> AroundsAndErrors checkArounds fieldMap nt con arounds = let checkAround (ident,expr) (as,errs) = if ident `Map.member` as @@ -482,7 +486,7 @@ fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fieldMap) in foldr checkAround (Map.empty, Seq.empty) arounds -checkMerges :: Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [Identifier]) -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> NontermIdent -> ConstructorIdent -> [MergeInfo] -> MergesAndErrors +checkMerges :: Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [Identifier]) -> DataTypes -> NontermIdent -> ConstructorIdent -> [MergeInfo] -> MergesAndErrors checkMerges allNts allInsts fieldMap nt con merges = let checkMerge (target,nt,sources,expr) (m,errs) = let fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fieldMap) @@ -505,7 +509,7 @@ { -mkUniqueRules :: Options -> Map NontermIdent (Map ConstructorIdent [RuleInfo]) -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> Map NontermIdent (Attributes,Attributes) -> NontermIdent -> ConstructorIdent -> Map Identifier Identifier -> [Rule] +mkUniqueRules :: Options -> Map NontermIdent (Map ConstructorIdent [RuleInfo]) -> DataTypes -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> Map NontermIdent (Attributes,Attributes) -> NontermIdent -> ConstructorIdent -> Map Identifier Identifier -> [Rule] mkUniqueRules opts allRules allFields allInsts allAttrDecls nt con usMap = map apply groups where @@ -834,7 +838,7 @@ "genusetraces" -> o { genUseTraces = True } "splitsems" -> o { splitSems = True } "gencostcentres" -> o { genCostCentres = True } - "sepsemmods" -> o { sepSemMods = True } + "sepsemmods" -> sepSemModsOpt o "genlinepragmas" -> o { genLinePragmas = True } "newtypes" -> o { newtypes = True } "nonewtypes" -> o { newtypes = False } @@ -860,6 +864,7 @@ "noinlinepragmas" -> o { noInlinePragmas = True } "aggressiveinlinepragmas" -> o { aggressiveInlinePragmas = True } "latehigherorderbindings" -> o { lateHigherOrderBinding = True } + "ocaml" -> ocamlOpt o s -> trace ("uuagc: ignoring unknown pragma: " ++ s) o in \o -> foldr mk o @names @@ -1215,6 +1220,7 @@ -> ParamMap -> Map NontermIdent (Map ConstructorIdent (Set Identifier)) -> DataTypes + -> Map NontermIdent [ConstructorIdent] -> Map NontermIdent (Map ConstructorIdent [Type]) -> Map NontermIdent (Attributes, Attributes) -> Map NontermIdent (Map Identifier (String, String, String)) @@ -1235,8 +1241,8 @@ -> Map NontermIdent (Map ConstructorIdent MaybeMacro) -> Grammar -constructGrammar nts ntParams prodParams gram constraints attrs uses derivings wrappers allrules tsigs allinsts tsyns pragmaMap orderMap contextMap quantMap uniqueMap augmentsMap aroundsMap mergeMap macros = - let gr = [ (nt,Map.toList alts) | (nt,alts) <- Map.toList gram] +constructGrammar nts ntParams prodParams gram prodOrder constraints attrs uses derivings wrappers allrules tsigs allinsts tsyns pragmaMap orderMap contextMap quantMap uniqueMap augmentsMap aroundsMap mergeMap macros = + let gr = [ (nt,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 @@ -1247,8 +1253,10 @@ macromap = Map.findWithDefault Map.empty nt macros csmap = Map.findWithDefault Map.empty nt constraints psmap = Map.findWithDefault Map.empty nt prodParams - alt (con,flds) = - let rules = Map.findWithDefault [] con rmap + prs = Map.findWithDefault [] nt prodOrder + alt con = + let flds = Map.findWithDefault [] con alts + rules = Map.findWithDefault [] con rmap tsigs = Map.findWithDefault [] con tsmap insts = Map.findWithDefault [] con instsmap merges = [ (n, NT t [] False) | (n, (t, _, _)) <- Map.assocs $ maybe Map.empty id (Map.lookup con mergemap) ] @@ -1274,7 +1282,7 @@ existsAsField (nm,_) = maybe False (const True) (lookup nm flds) existsAsMerge nm = maybe False (const True) (lookup nm merges) in Production con ps cs cldrn rules tsigs mbMacro - in Nonterminal nt params inh syn (map alt alts) + in Nonterminal nt params inh syn (map alt prs) in Grammar tsyns uses derivings wrappers nonts pragmaMap orderMap ntParams contextMap quantMap uniqueMap augmentsMap aroundsMap mergeMap } diff --git a/src-options/Options.hs b/src-options/Options.hs --- a/src-options/Options.hs +++ b/src-options/Options.hs @@ -5,6 +5,8 @@ import UU.Scanner.Position(Pos,noPos) import Data.List(intercalate) import qualified Data.Set as Set +import System.IO +import System.Exit -- From CommonTypes data Identifier = Ident { getName::String, getPos::Pos } @@ -115,7 +117,7 @@ , MyOpt ['H'] ["haskellsyntax"] (NoArg haskellSyntaxOpt) noOpt "Use Haskell like syntax (equivalent to --lckeywords and --doublecolons --genlinepragmas)" , MyOpt [] ["reference"] (NoArg referenceOpt) (boolOpt reference) "Use reference attributes" , MyOpt [] ["monadic"] (NoArg monadicOpt) (boolOpt monadic) "Experimental: generate monadic code" - , MyOpt [] ["ocaml"] (NoArg ocamlOpt) (boolOpt ocaml) "Experimental: generate Ocaml code" + , MyOpt [] ["ocaml"] (NoArg ocamlOpt) (boolOpt ocaml) "Generate Ocaml code" , MyOpt [] ["breadthfirst"] (NoArg breadthfirstOpt) (boolOpt breadthFirst)"Experimental: generate breadth-first code" , MyOpt [] ["breadthfirst-strict"] (NoArg breadthfirstStrictOpt) (boolOpt breadthFirstStrict) "Experimental: outermost breadth-first evaluator is strict instead of lazy" , MyOpt [] ["visitcode"] (NoArg visitorsOutputOpt) (boolOpt visitorsOutput) "Experimental: generate visitors code" @@ -142,6 +144,8 @@ , MyOpt [] ["noinlinepragmas"] (NoArg noInlinePragmasOpt) (boolOpt noInlinePragmas) "Definitely not generate inline directives" , MyOpt [] ["aggressiveinlinepragmas"] (NoArg aggressiveInlinePragmasOpt) (boolOpt aggressiveInlinePragmas) "Generate more aggressive inline directives" , MyOpt [] ["latehigherorderbinding"] (NoArg lateHigherOrderBindingOpt) (boolOpt lateHigherOrderBinding) "Generate an attribute and wrapper for late binding of higher-order attributes" + , MyOpt [] ["noincludes"] (NoArg noIncludesOpt) (boolOpt noIncludes) "Ignore include directives in .ag files" + , MyOpt [] ["quiet"] (NoArg beQuietOpt) (boolOpt beQuiet) "Dont print some compilation information" ] -- For compatibility @@ -193,6 +197,7 @@ , dumpgrammar :: Bool , dumpcgrammar :: Bool , sepSemMods :: Bool + , allowSepSemMods :: Bool , genFileDeps :: Bool , genLinePragmas :: Bool , genvisage :: Bool @@ -216,6 +221,11 @@ , nocatas :: Set NontermIdent , noOptimizations :: Bool , reference :: Bool + , noIncludes :: Bool + , outputStr :: String -> IO () + , failWithCode :: Int -> IO () + , mainFilename :: Maybe String + , beQuiet :: Bool -- KW code path , kennedyWarren :: Bool @@ -240,7 +250,7 @@ , helpInlining :: Bool , noInlinePragmas :: Bool , aggressiveInlinePragmas :: Bool - } deriving (Eq, Show) + } -- deriving (Eq, Show) noOptions = Options { moduleName = NoName , dataTypes = False @@ -281,6 +291,7 @@ , dumpgrammar = False , dumpcgrammar = False , sepSemMods = False + , allowSepSemMods = True , genFileDeps = False , genLinePragmas = False , genvisage = False @@ -304,6 +315,11 @@ , nocatas = Set.empty , noOptimizations = False , reference = False + , noIncludes = False + , outputStr = hPutStr stderr + , failWithCode = exitWith . ExitFailure + , mainFilename = Nothing + , beQuiet = False -- defaults for the KW-code path , kennedyWarren = False @@ -377,7 +393,7 @@ genTracesOpt opts = opts{genTraces = True} genUseTracesOpt opts = opts{genUseTraces = True} genCostCentresOpt opts = opts{genCostCentres = True} -sepSemModsOpt opts = opts{sepSemMods = True} +sepSemModsOpt opts = opts{sepSemMods = allowSepSemMods opts} genFileDepsOpt opts = opts{genFileDeps = True} genLinePragmasOpt opts = opts{genLinePragmas = True} genVisageOpt opts = opts{genvisage = True } @@ -420,7 +436,7 @@ haskellSyntaxOpt = lcKeywordsOpt . doubleColonsOpt . genLinePragmasOpt monadicOpt opts = opts { monadic = True } parallelOpt opts = opts { parallelInvoke = True } -ocamlOpt opts = opts { ocaml = True } +ocamlOpt opts = opts { ocaml = True, kennedyWarren = True, withCycle = True, visit = True } visitorsOutputOpt opts = opts { visitorsOutput = True } statisticsOpt nm opts = opts { statsFile = Just nm } breadthfirstOpt opts = opts { breadthFirst = True } @@ -453,6 +469,8 @@ else [nm, intercalate ":" (searchPath opts)] allOpt = moduleOpt Nothing . dataOpt . cataOpt . semfunsOpt . signaturesOpt . prettyOpt . renameOpt . dataRecOpt optimizeOpt = visitOpt . casesOpt +noIncludesOpt opts = opts { noIncludes = True } +beQuietOpt opts = opts { beQuiet = True } condDisableOptimizations opts | noOptimizations opts = diff --git a/src/Ag.hs b/src/Ag.hs --- a/src/Ag.hs +++ b/src/Ag.hs @@ -1,4 +1,5 @@ -module Ag (uuagcLib, uuagcExe) where +-- Todo: we should make a nicer pipeline. Perhaps use Atze's "compile run" combinators. +module Ag (uuagcLib, uuagcExe,compile) where import System.Environment (getArgs, getProgName) import System.Exit (exitFailure) @@ -13,6 +14,7 @@ import qualified Data.Sequence as Seq ((><),null) import Data.Foldable(toList) import Pretty +import PPUtil import UU.Parsing (Message(..), Action(..)) import UU.Scanner.Position (Pos, line, file) @@ -27,6 +29,7 @@ import qualified GenerateCode as Pass4 (sem_CGrammar, wrap_CGrammar, Syn_CGrammar(..), Inh_CGrammar(..)) import qualified PrintVisitCode as Pass4a (sem_CGrammar, wrap_CGrammar, Syn_CGrammar(..), Inh_CGrammar(..)) import qualified ExecutionPlan2Hs as Pass4b (sem_ExecutionPlan, wrap_ExecutionPlan, Syn_ExecutionPlan(..), Inh_ExecutionPlan(..), warrenFlagsPP) +import qualified ExecutionPlan2Caml as Pass4c (sem_ExecutionPlan, wrap_ExecutionPlan, Syn_ExecutionPlan(..), Inh_ExecutionPlan(..)) import qualified PrintCode as Pass5 (sem_Program, wrap_Program, Syn_Program (..), Inh_Program (..)) import qualified PrintOcamlCode as Pass5a (sem_Program, wrap_Program, Syn_Program (..), Inh_Program (..)) import qualified PrintErrorMessages as PrErr (sem_Errors , wrap_Errors , Syn_Errors (..), Inh_Errors (..), isError) @@ -45,7 +48,7 @@ import ATermWrite -- Library version -import System.Exit (ExitCode(..)) +import System.Exit (ExitCode(..), exitWith) uuagcLib :: [String] -> FilePath -> IO (ExitCode, [FilePath]) uuagcLib args file @@ -73,19 +76,24 @@ (flags,files,errs) = getOptions args if showVersion flags - then putStrLn banner - else if null files || showHelp flags || (not.null) errs - then mapM_ putStrLn (usageInfo usageheader options : errs) - else if genFileDeps flags - then reportDeps flags files - else zipWithM_ (compile flags) files (outputFiles flags++repeat "") + then putStrLn banner + else if showHelp flags + then putStrLn (usageInfo usageheader options) + else if null files || (not.null) errs + then do mapM_ putStrLn (usageInfo usageheader options : errs) + exitWith (ExitFailure 2) + else if genFileDeps flags + then reportDeps flags files + else zipWithM_ (compile flags) files (outputFiles flags++repeat "") -compile :: Options -> String -> String -> IO () +compile :: Options -> FilePath -> FilePath -> IO () compile flags input output - = do (output0,parseErrors) <- parseAG flags (searchPath flags) (inputFile input) + = do (output0,parseErrors) <- parseAG flags (searchPath flags) input irrefutableMap <- readIrrefutableMap flags - + let printStr = outputStr flags + failWith = failWithCode flags + inputfile = maybe input id (mainFilename flags) let output1 = Pass1.wrap_AG (Pass1.sem_AG output0 ) Pass1.Inh_AG {Pass1.options_Inh_AG = flags} flags' = condDisableOptimizations (Pass1.pragmas_Syn_AG output1 flags) grammar1 = Pass1.output_Syn_AG output1 @@ -104,6 +112,7 @@ output4 = Pass4.wrap_CGrammar (Pass4.sem_CGrammar(Pass3.output_Syn_Grammar output3)) Pass4.Inh_CGrammar {Pass4.options_Inh_CGrammar = flags'} output4a = Pass4a.wrap_CGrammar (Pass4a.sem_CGrammar(Pass3.output_Syn_Grammar output3)) Pass4a.Inh_CGrammar {Pass4a.options_Inh_CGrammar = flags'} output4b = Pass4b.wrap_ExecutionPlan (Pass4b.sem_ExecutionPlan grammar3a) Pass4b.Inh_ExecutionPlan {Pass4b.options_Inh_ExecutionPlan = flags', Pass4b.inhmap_Inh_ExecutionPlan = Pass3a.inhmap_Syn_Grammar output3a, Pass4b.synmap_Inh_ExecutionPlan = Pass3a.synmap_Syn_Grammar output3a, Pass4b.pragmaBlocks_Inh_ExecutionPlan = pragmaBlocksTxt, Pass4b.importBlocks_Inh_ExecutionPlan = importBlocksTxt, Pass4b.textBlocks_Inh_ExecutionPlan = textBlocksDoc, Pass4b.moduleHeader_Inh_ExecutionPlan = mkModuleHeader $ Pass1.moduleDecl_Syn_AG output1, Pass4b.mainName_Inh_ExecutionPlan = mkMainName mainName $ Pass1.moduleDecl_Syn_AG output1, Pass4b.mainFile_Inh_ExecutionPlan = mainFile, Pass4b.textBlockMap_Inh_ExecutionPlan = textBlockMap, Pass4b.mainBlocksDoc_Inh_ExecutionPlan = mainBlocksDoc,Pass4b.localAttrTypes_Inh_ExecutionPlan = Pass3a.localSigMap_Syn_Grammar output3a} + output4c = Pass4c.wrap_ExecutionPlan (Pass4c.sem_ExecutionPlan grammar3a) Pass4c.Inh_ExecutionPlan {Pass4c.options_Inh_ExecutionPlan = flags', Pass4c.inhmap_Inh_ExecutionPlan = Pass3a.inhmap_Syn_Grammar output3a, Pass4c.synmap_Inh_ExecutionPlan = Pass3a.synmap_Syn_Grammar output3a, Pass4c.mainName_Inh_ExecutionPlan = mkMainName mainName $ Pass1.moduleDecl_Syn_AG output1, Pass4c.mainFile_Inh_ExecutionPlan = mainFile, Pass4c.localAttrTypes_Inh_ExecutionPlan = Pass3a.localSigMap_Syn_Grammar output3a} 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.mainBlocksDoc_Inh_Program = mainBlocksDoc, 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} output5a = Pass5a.wrap_Program (Pass5a.sem_Program (Pass4.output_Syn_CGrammar output4)) Pass5a.Inh_Program { Pass5a.options_Inh_Program = flags', Pass5a.textBlockMap_Inh_Program = textBlockMap } output6 = PrErr.wrap_Errors (PrErr.sem_Errors errorsToReport) PrErr.Inh_Errors {PrErr.options_Inh_Errors = flags', PrErr.dups_Inh_Errors = [] } @@ -124,7 +133,9 @@ furtherErrors = if kennedyWarren flags' then let errs3a = Pass3a.errors_Syn_Grammar output3a in if Seq.null errs3a - then toList ( Pass4b.errors_Syn_ExecutionPlan output4b ) + then if ocaml flags' + then toList ( Pass4c.errors_Syn_ExecutionPlan output4c ) + else toList ( Pass4b.errors_Syn_ExecutionPlan output4b ) else toList errs3a else toList ( Pass3.errors_Syn_Grammar output3 Seq.>< Pass4.errors_Syn_CGrammar output4) @@ -155,20 +166,22 @@ importBlocksTxt = vlist_sep "" . map addLocationPragma . concat . Map.elems $ importBlocks textBlocksDoc = vlist_sep "" . map addLocationPragma . Map.findWithDefault [] (BlockOther, Nothing) $ textBlocks mainBlocksDoc = vlist_sep "" . map addLocationPragma . Map.findWithDefault [] (BlockMain, Nothing) $ textBlocks + dataBlocksDoc = vlist_sep "" . map addLocationPragma . Map.findWithDefault [] (BlockData, Nothing) $ textBlocks + recBlocksDoc = vlist_sep "" . map addLocationPragma . Map.findWithDefault [] (BlockRec, 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 - mainFile | null output = outputFile input - | otherwise = dropExtension output - mainName = dropExtension $ takeFileName input + outputfile = if null output then outputFile flags' inputfile else output + mainFile | null output = outputFile flags' inputfile + | otherwise = output + mainName = dropExtension $ takeFileName inputfile addLocationPragma :: ([String], Pos) -> PP_Doc addLocationPragma (strs, p) - | genLinePragmas flags' - = "{-# LINE" >#< pp (show (line p)) >#< show (file p) >#< "#-}" >-< vlist (map pp strs) >-< "{-# LINE" >#< ppWithLineNr (pp.show.(+1)) >#< show outputfile >#< "#-}" - | otherwise - = vlist (map pp strs) + | genLinePragmas flags' = + ppLinePragma flags' (line p) (file p) >-< vlist (map pp strs) + >-< ppWithLineNr (\l -> ppLinePragma flags' (l+1) outputfile) + | otherwise = vlist (map pp strs) optionsGHC = option (unbox flags') "-fglasgow-exts" ++ option (bangpats flags') "-XBangPatterns" option True s = [s] @@ -184,7 +197,6 @@ additionalWarnings = totalNrOfWarnings - nrOfWarningsToReport pluralS n = if n == 1 then "" else "s" - (outAgi, ext) <- --marcos if genAspectAG flags' then parseAGI flags (searchPath flags) (agiFile input) @@ -200,20 +212,19 @@ , AspectAGDump.agi_Inh_Grammar = agi , AspectAGDump.ext_Inh_Grammar = ext' } --marcos - - putStr . formatErrors $ PrErr.pp_Syn_Errors output6 + printStr . formatErrors $ PrErr.pp_Syn_Errors output6 if additionalErrors > 0 - then putStr $ "\nPlus " ++ show additionalErrors ++ " more error" ++ pluralS additionalErrors ++ + then printStr $ "\nPlus " ++ show additionalErrors ++ " more error" ++ pluralS additionalErrors ++ if additionalWarnings > 0 then " and " ++ show additionalWarnings ++ " more warning" ++ pluralS additionalWarnings ++ ".\n" else ".\n" else if additionalWarnings > 0 - then putStr $ "\nPlus " ++ show additionalWarnings ++ " more warning" ++ pluralS additionalWarnings ++ ".\n" + then printStr $ "\nPlus " ++ show additionalWarnings ++ " more warning" ++ pluralS additionalWarnings ++ ".\n" else return () if not (null errorsToStopOn) -- note: this may already run quite a part of the compilation... - then exitFailure + then failWith 1 else do if genvisage flags' @@ -227,9 +238,11 @@ if sepSemMods flags' then do -- alternative module gen if kennedyWarren flags' - then Pass4b.genIO_Syn_ExecutionPlan output4b + then if ocaml flags' + then error "sepsemmods is not implemented for the ocaml output generation" + else Pass4b.genIO_Syn_ExecutionPlan output4b else Pass5.genIO_Syn_Program output5 - if not (null errorsToStopOn) then exitFailure else return () + if not (null errorsToStopOn) then failWith 1 else return () else do -- conventional module gen let doc | visitorsOutput flags' @@ -250,6 +263,8 @@ , AspectAGDump.imp_Syn_Grammar aspectAG , pp "\n\n{-- AspectAG Code --}\n\n" , AspectAGDump.pp_Syn_Grammar aspectAG + , dataBlocksDoc + , mainBlocksDoc , textBlocksDoc , if dumpgrammar flags' then vlist [ pp "{- Dump of AGI" @@ -261,8 +276,44 @@ ] else empty] | kennedyWarren flags' - = vlist [ Pass4b.warrenFlagsPP flags' + = if ocaml flags' + then vlist + [ text "(* generated by UUAG from" >#< mainFile >#< "*)" , pp pragmaBlocksTxt + , text "(* module imports *)" + , pp importBlocksTxt + , Pass4c.modules_Syn_ExecutionPlan output4c + , text "" + , text "(* generated data types *)" + , text "module Data__ = struct" + , indent 2 $ vlist + [ text "type __generated_by_uuagc__ = Generated_by_uuagc__" + , Pass4c.datas_Syn_ExecutionPlan output4c + ] + , text "end" + , text "open Data__" + , text "" + , text "(* embedded data types *)" + , dataBlocksDoc + , text "" + , text "(* embedded utilty functions *)" + , textBlocksDoc + , text "(* generated evaluationcode *)" + , text "module Code__ = struct" + , indent 2 $ vlist + [ text "let rec __generated_by_uuagc__ = Generated_by_uuagc__" + , Pass4c.code_Syn_ExecutionPlan output4c + , recBlocksDoc + ] + , text "end" + , text "open Code__" + , text "" + , text "(* main code *)" + , mainBlocksDoc + ] + else vlist + [ Pass4b.warrenFlagsPP flags' + , pp pragmaBlocksTxt , pp $ if isNothing $ Pass1.moduleDecl_Syn_AG output1 then moduleHeader flags' mainName Nothing else mkModuleHeader (Pass1.moduleDecl_Syn_AG output1) mainName "" "" False @@ -277,7 +328,10 @@ , pp $ "import Control.Concurrent(newEmptyMVar,forkIO,putMVar,takeMVar)"] else vlist [ pp $ "import Control.Monad.Identity (Identity)" , pp $ "import qualified Control.Monad.Identity" ] + , dataBlocksDoc + , mainBlocksDoc , textBlocksDoc + , recBlocksDoc --, pp $ "{-" --, Pass3a.depgraphs_Syn_Grammar output3a --, Pass3a.visitgraph_Syn_Grammar output3a @@ -301,6 +355,8 @@ else [] ) , pp importBlocksTxt + , dataBlocksDoc + , mainBlocksDoc , textBlocksDoc , vlist $ if not (ocaml flags') then Pass5.output_Syn_Program output5 @@ -327,11 +383,11 @@ -- HACK: write statistics let nAuto = Pass3.nAutoRules_Syn_Grammar output3 nExpl = Pass3.nExplicitRules_Syn_Grammar output3 - line = input ++ "," ++ show nAuto ++ "," ++ show nExpl ++ "\r\n" + line = inputfile ++ "," ++ show nAuto ++ "," ++ show nExpl ++ "\r\n" case statsFile flags' of Nothing -> return () Just file -> appendFile file line - if not (null errorsToStopOn) then exitFailure else return () + if not (null errorsToStopOn) then failWith 1 else return () @@ -363,11 +419,6 @@ genExp Nothing _ = "" genExp (Just e) x = "(module " ++ x ++ ", module " ++ e ++ ")" -inputFile :: String -> String -inputFile name - | takeExtension name == ".ag" || takeExtension name == ".lag" = name - | otherwise = replaceExtension name "ag" - --marcos agiFile :: String -> String agiFile name = replaceExtension name "agi" @@ -375,8 +426,10 @@ remAgi :: String -> String remAgi = dropExtension -outputFile :: String -> String -outputFile name = replaceExtension name "hs" +outputFile :: Options -> String -> String +outputFile opts name + | ocaml opts = replaceExtension name "ml" + | otherwise = replaceExtension name "hs" defaultModuleName :: String -> String defaultModuleName = dropExtension @@ -415,7 +468,8 @@ if null errs then return fs else do putStr . formatErrors $ PrErr.pp_Syn_Errors ppErrs - exitFailure + failWithCode flags 1 + return [] where combine :: ([a],[b]) -> ([a], [b]) -> ([a], [b]) combine (fs, mesgs) (fsr, mesgsr) diff --git a/src/CommonTypes.hs b/src/CommonTypes.hs --- a/src/CommonTypes.hs +++ b/src/CommonTypes.hs @@ -8,6 +8,7 @@ import Data.Set(Set) import qualified Data.Set as Set import Data.Monoid(mappend,mempty,Monoid) +import Data.Char type Blocks = Map BlockInfo [([String], Pos)] @@ -16,6 +17,8 @@ = BlockImport | BlockPragma | BlockMain + | BlockData + | BlockRec | BlockOther deriving (Eq, Ord, Show) @@ -117,9 +120,12 @@ cataname pre name = pre++getName name conname :: Bool -> NontermIdent -> ConstructorIdent -> String -conname rename nt con | rename = getName nt ++ "_" ++ getName con +conname rename nt con | rename = capitalize (getName nt) ++ "_" ++ getName con | otherwise = getName con +capitalize [] = [] +capitalize (c:cs) = toUpper c : cs + semname :: String -> NontermIdent -> ConstructorIdent -> String semname pre nt con = pre ++ (getName nt ++ "_" ++ getName con) @@ -153,12 +159,18 @@ removeDeforested (NT nt args _) = NT nt args False removeDeforested tp = tp +forceDeforested :: Type -> Type +forceDeforested (NT nt args _) = NT nt args True +forceDeforested tp = tp + typeToHaskellString :: Maybe NontermIdent -> [String] -> Type -> String typeToHaskellString mbNt params tp = case tp of - Haskell t -> t + Haskell t -> filter (/= '@') t -- Apparently haskell types can contain @ to refer to + -- a type parameter, removing @ makes it backwards compatible NT nt tps for | nt == _SELF -> formatNonterminalToHaskell for (maybe "?SELF?" getName mbNt) params | otherwise -> formatNonterminalToHaskell for (getName nt) tps + Self -> maybe "?SELF?" getName mbNt formatNonterminalToHaskell :: Bool -> String -> [String] -> String formatNonterminalToHaskell for nt tps diff --git a/src/KennedyWarren.hs b/src/KennedyWarren.hs --- a/src/KennedyWarren.hs +++ b/src/KennedyWarren.hs @@ -146,8 +146,9 @@ -- Print some debug info nodes <- gets vgNodeNum edges <- gets vgEdgeNum - traceVG $ "Number of nodes = " ++ show nodes - traceVG $ "Number of edges = " ++ show edges + when (not $ beQuiet opts) $ do + traceVG $ "Number of nodes = " ++ show nodes + traceVG $ "Number of edges = " ++ show edges -- Generate execution plan ex <- kennedyWarrenExecutionPlan opts indi initvs wr typesyns derivings -- Get visit graph diff --git a/src/PPUtil.hs b/src/PPUtil.hs --- a/src/PPUtil.hs +++ b/src/PPUtil.hs @@ -8,6 +8,7 @@ import Data.List import qualified Data.Map as Map import Pretty +import Options ppListSep :: (PP s, PP c, PP o, PP a) => o -> c -> s -> [a] -> PP_Doc ppListSep o c s pps = o >|< hlist (intersperse (pp s) (map pp pps)) >|< c @@ -50,3 +51,8 @@ mkInfo1 :: String -> PP_Doc -> (String,PP_Doc) mkInfo1 = (,) + +ppLinePragma :: Options -> Int -> String -> PP_Doc +ppLinePragma opts ln fl + | ocaml opts = "#" >#< show ln >#< show fl + | otherwise = "{-# LINE" >#< show ln >#< show fl >#< "#-}" diff --git a/src/Parser.hs b/src/Parser.hs --- a/src/Parser.hs +++ b/src/Parser.hs @@ -24,19 +24,33 @@ import System.FilePath import HsTokenScanner import Options +import Scanner(lowercaseKeywords) type AGParser = AnaParser Input Pair Token Pos -pIdentifier, pIdentifierU :: AGParser Identifier +pIdentifier, pIdentifierU, pIdentifierExcl :: AGParser Identifier pIdentifierU = uncurry Ident <$> pConidPos -pIdentifier = uncurry Ident <$> pVaridPos +-- Jeroen (3-10-2012): for some reason using pKeywordAsIdent +-- drastically slows down parsing of some of my AG files, as +-- in: I thought there was some infinite loop in there, but I +-- guess that eventually it could have given an answer. So +-- probably this does generate a lot of ambiguity. +pIdentifier = pIdentifierExcl -- <|> pKeywordAsIdent +pIdentifierExcl = uncurry Ident <$> pVaridPos +-- see Scanner.lowercaseKeywords for the list of keywords that may +-- be used as an identifier. To prevent ambiguities, it's probably +-- sufficient when the keyword is always followed by a token that +-- can never follow an identifier for any possible prefix. +pKeywordAsIdent :: AGParser Identifier +pKeywordAsIdent = pAny (\nm -> Ident nm <$> pKeyPos nm) lowercaseKeywords + parseAG :: Options -> [FilePath] -> String -> IO (AG,[Message Token Pos]) -parseAG opts searchPath file - = do (es,_,_,_,mesg) <- parseFile False opts searchPath file - return (AG es, mesg) +parseAG opts searchPath file = do + (es,_,_,_,mesg) <- parseFile False opts searchPath file + return (AG es, mesg) --marcos parseAGI :: Options -> [FilePath] -> String -> IO (AG, Maybe String) @@ -52,9 +66,11 @@ -- marcos: added the parameter 'agi' and the 'ext' part parseFile :: Bool -> Options -> [FilePath] -> String -> IO ([Elem],[String],[String], Maybe String,[Message Token Pos ]) -parseFile agi opts searchPath file - = do txt <- readFile file - let litMode = ".lag" `isSuffixOf` file +parseFile agi opts searchPath filename + = do file <- resolveFile opts searchPath filename + txt <- readFile file + let searchPath' = takeDirectory file : searchPath -- search first relative to the including file + litMode = ".lag" `isSuffixOf` file (files,text) = if litMode then scanLit txt else ([],txt) tokens = input opts (initPos file) text @@ -62,8 +78,7 @@ steps = parse (pElemsFiles agi) tokens stop (_,fs,_,_,_) = null fs cont (es,fs,allfs,ext,msg) - = do files <- mapM (resolveFile searchPath) fs - res <- mapM (parseFile agi opts searchPath) files + = do res <- mapM (parseFile agi opts searchPath') fs let (ess,fss,allfss,_, msgs) = unzip5 res return (es ++ concat ess, concat fss, concat allfss ++ allfs, ext, msg ++ concat msgs) let (Pair (es,fls,ext) _ ,mesg) = evalStepsMessages steps @@ -83,8 +98,12 @@ <|> pINCLUDE *> (addInc <$> pStringPos) <|> pEXTENDS *> (addExt <$> pStringPos) addElem e (es,fs,ext) = (e:es, fs, ext) - addInc (fn,_) (es,fs,ext) = ( es,fn:fs, ext) - addExt (fn,_) (es,fs,ext) = if agi then (es,fs, Just fn) else (es,fn:fs, ext) --marcos + addInc (fn,_) (es,fs,ext) + | noIncludes opts = (es, fs, ext) -- skip includes + | otherwise = (es,fn:fs, ext) + addExt (fn,_) (es,fs,ext) + | noIncludes opts = (es, fs, ext) -- skip includes + | otherwise = if agi then (es,fs, Just fn) else (es,fn:fs, ext) --marcos pCodescrapL = (\(ValToken _ str pos) -> (str, pos))<$> parseScrapL "a code block" @@ -117,34 +136,46 @@ | (n,(f,t)) <- zip [1..] xs ] + pOptClassContext' :: AGParser ClassContext + pOptClassContext' + | ocaml opts = pSucceed [] + | otherwise = pOptClassContext + + pTyVars :: AGParser [Identifier] + pTyVars + | ocaml opts = return <$> pTypeVar + <|> pSucceed [] + <|> pParens (pListSep pComma pTypeVar) + | otherwise = pList pIdentifier + pElem :: AGParser Elem pElem - = Data <$> pDATA - <*> pOptClassContext + = Data <$> (pDATA <|> pTYPE) + <*> pOptClassContext' <*> pNontSet - <*> pList pIdentifier + <*> pTyVars <*> pOptAttrs <*> pAlts <*> pSucceed False <|> Attr <$> pATTR - <*> pOptClassContext + <*> pOptClassContext' <*> pNontSet <*> pOptQuantifiers <*> pAttrs <|> Type <$> pTYPE - <*> pOptClassContext - <*> pIdentifierU - <*> pList pIdentifier + <*> pOptClassContext' + <*> pTypeCon + <*> pTyVars <* pEquals <*> pComplexType <|> Sem <$> pSEM - <*> pOptClassContext + <*> pOptClassContext' <*> pNontSet <*> pOptAttrs <*> pOptQuantifiers <*> pSemAlts <|> Set <$> pSET - <*> pIdentifierU + <*> pTypeCon <*> ( False <$ pEquals <|> True <$ pColon ) @@ -162,20 +193,22 @@ <*> pNontSet <|> Pragma <$> pPRAGMA - <*> pNames + <*> pList1 pIdentifier <|> Module <$> pMODULE <*> pCodescrap' <*> pCodescrap' <*> pCodescrap' - <|> codeBlock <$> pBlockKind <*> ((Just <$ pATTACH <*> pIdentifierU) <|> pSucceed Nothing) <*> pCodeBlock "a statement" - where codeBlock knd mbNt (txt,pos) = Txt pos knd mbNt (lines txt) + <|> codeBlock <$> pBlockKind <*> ((Just <$ pATTACH <*> pTypeCon) <|> pSucceed Nothing) <*> pCodeBlock "a statement" + where codeBlock knd mbNt (txt,pos) = Txt pos knd mbNt (lines txt) pBlockKind :: AGParser BlockKind pBlockKind = BlockPragma <$ pOPTPRAGMAS <|> BlockImport <$ pIMPORTS <|> BlockMain <$ pTOPLEVEL -- block is moved to the toplevel ("main") module when "sepsemmods" is used + <|> BlockData <$ pDATABLOCK + <|> BlockRec <$ pRECBLOCK <|> pSucceed BlockOther pAttrs :: AGParser Attrs @@ -218,7 +251,7 @@ <$> pAttrIdentifiers <*> pUse <* pTypeColon <*> pTypeOrSelf "attribute declarations" pAlt :: AGParser Alt - pAlt = (Alt <$> pBar <*> pSimpleConstructorSet <*> pList_ng pIdentifier <*> pFields <*> pMaybeMacro "a datatype alternative") + pAlt = (Alt <$> pBar <*> pSimpleConstructorSet <*> (pList1_ng pTypeVar <* pDot <|> pSucceed []) <*> pFields <*> pMaybeMacro "a datatype alternative") pAlts :: AGParser Alts pAlts = pList_ng pAlt "datatype alternatives" @@ -266,6 +299,9 @@ pLocDecl = pDot <**> (pIdentifier <**> (pTypeColon <**> ( (\(tp,pos) _ ident _ -> TypeDef pos ident tp) <$> pLocType <|> (\ref _ ident _ -> UniqueDef ident ref) <$ pUNIQUEREF <*> pIdentifier ))) + pLocType :: AGParser (Type, Pos) + pLocType = (\u -> (Haskell $ getName u, getPos u)) <$> pTypeCon + <|> (\(s,p) -> (Haskell s,p)) <$> pCodescrap "a type" pInstDecl :: AGParser SemDef pInstDecl = (\ident tp -> TypeDef (getPos ident) ident tp) @@ -301,20 +337,82 @@ flip ChildChild <$> pIdentifier <|> flip ValueChild <$> pCodescrap' ) + pTypeNt :: AGParser Type + pTypeNt + = ((\nt -> mkNtType nt []) <$> pTypeCon "nonterminal name (no brackets)") + <|> (pParens (mkNtType <$> pTypeCon <*> pList pTypeHaskellAnyAsString) "nonterminal name with parameters (using parenthesis)") + + pTypeCon :: AGParser Identifier + pTypeCon + | ocaml opts = pIdentifierExcl + | otherwise = pIdentifierU + + pTypeVar :: AGParser Identifier + pTypeVar + | ocaml opts = (\(nm, pos) -> Ident nm pos) <$> pTextnmPos + | otherwise = pIdentifier + + pTypeHaskellAnyAsString :: AGParser String + pTypeHaskellAnyAsString + = getName <$> pTypeVar + <|> getName <$> pTypeCon + <|> pCodescrap' "a type" + + -- if the type is within some kind of parentheses or brackets (then we allow lowercase identifiers as well) + pTypeEncapsulated :: AGParser Type + pTypeEncapsulated + = pParens pTypeEncapsulated + <|> mkNtType <$> pTypeCon <*> pList pTypeHaskellAnyAsString + <|> (Haskell . getName) <$> pTypeVar + <|> pTypePrimitive + + pTypePrimitive :: AGParser Type + pTypePrimitive + = Haskell <$> pCodescrap' "a type" + + pType :: AGParser Type + pType = pTypeNt + <|> pTypePrimitive + + pTypeOrSelf :: AGParser Type + pTypeOrSelf = pType <|> Self <$ pSELF + + pOptClassContext :: AGParser ClassContext + pOptClassContext + = pClassContext <* pDoubleArrow + <|> pSucceed [] + + pClassContext :: AGParser ClassContext + pClassContext + = pListSep pComma ((,) <$> pIdentifierU <*> pList pTypeHaskellAnyAsString) + + pNontSet = set0 where + set0 = pChainr (Intersect <$ pIntersect) set1 + set1 = pChainl (Difference <$ pMinus) set2 + set2 = pChainr (pSucceed Union) set3 + set3 = pTypeCon <**> opt (flip Path <$ pArrow <*> pTypeCon) NamedSet + <|> All <$ pStar + <|> pParens set0 + -- -- End of AG Parser -- -resolveFile :: [FilePath] -> FilePath -> IO FilePath -resolveFile path fname = search (path ++ ["."]) +resolveFile :: Options -> [FilePath] -> FilePath -> IO FilePath +resolveFile opts path fname = search (path ++ ["."]) where search (p:ps) = do let filename = joinPath [p, fname] fExists <- doesFileExist filename if fExists then return filename - else search ps - search [] = error ("File: " ++ show fname ++ " not found in search path: " ++ show (concat (intersperse ";" (path ++ ["."]))) ) - -pathSeparator = "/" + else do let filename' = joinPath [p, replaceExtension fname "ag"] + fExists' <- doesFileExist filename' + if fExists' + then return filename' + else search ps + search [] = do + outputStr opts ("File: " ++ show fname ++ " not found in search path: " ++ show (concat (intersperse ";" (path ++ ["."]))) ++ "\n") + failWithCode opts 1 + return (error "resolveFile: file not found") evalStepsMessages :: (Eq s, Show s, Show p) => Steps a s p -> (a,[Message s p]) evalStepsMessages steps = case steps of @@ -344,66 +442,17 @@ | otherwise =(p,[],x:xs) scrapL ref p [] = (p,[],[]) -pNontSet = set0 - where set0 = pChainr (Intersect <$ pIntersect) set1 - set1 = pChainl (Difference <$ pMinus) set2 - set2 = pChainr (pSucceed Union) set3 - set3 = pIdentifierU <**> opt (flip Path <$ pArrow <*> pIdentifierU) NamedSet - <|> All <$ pStar - <|> pParens set0 - pNames :: AGParser [Identifier] -pNames = pList1 pIdentifier - - +pNames = pIdentifiers -- Insertion is expensive for pCodeBlock in order to prevent infinite inserts. pCodeBlock :: AGParser (String,Pos) pCodeBlock = pCostValToken 90 TkTextln "" "a code block" -pOptClassContext :: AGParser ClassContext -pOptClassContext - = pClassContext <* pDoubleArrow - <|> pSucceed [] - -pClassContext :: AGParser ClassContext -pClassContext - = pListSep pComma ((,) <$> pIdentifierU <*> pList pTypeHaskellAnyAsString) - pOptQuantifiers :: AGParser [String] pOptQuantifiers = (return <$ pDoubleColon <*> pCodescrap') `opt` [] -pTypeNt :: AGParser Type -pTypeNt - = ((\nt -> mkNtType nt []) <$> pIdentifierU "nonterminal name (no brackets)") - <|> (pParens (mkNtType <$> pIdentifierU <*> pList pTypeHaskellAnyAsString) "nonterminal name with parameters (using parenthesis)") - -pTypeHaskellAnyAsString :: AGParser String -pTypeHaskellAnyAsString - = getName <$> pIdentifier - <|> getName <$> pIdentifierU - <|> pCodescrap' "a type" - --- if the type is within some kind of parentheses or brackets (then we allow lowercase identifiers as well) -pTypeEncapsulated :: AGParser Type -pTypeEncapsulated - = pParens pTypeEncapsulated - <|> mkNtType <$> pIdentifierU <*> pList pTypeHaskellAnyAsString - <|> (Haskell . getName) <$> pIdentifier - <|> pTypePrimitive - -pTypePrimitive :: AGParser Type -pTypePrimitive - = Haskell <$> pCodescrap' "a type" - -pType :: AGParser Type -pType = pTypeNt - <|> pTypePrimitive - -pTypeOrSelf :: AGParser Type -pTypeOrSelf = pType <|> Self <$ pSELF - pIdentifiers :: AGParser [Identifier] pIdentifiers = pList1Sep pComma pIdentifier "lowercase identifiers" @@ -453,10 +502,6 @@ nl2sp '\r' = ' ' nl2sp x = x -pLocType :: AGParser (Type, Pos) -pLocType = (\u -> (Haskell $ getName u, getPos u)) <$> pIdentifierU - <|> (\(s,p) -> (Haskell s,p)) <$> pCodescrap "a type" - pVar :: AGParser (Identifier -> (Identifier, Identifier)) pVar = (\att fld -> (fld,att)) <$> pAttrIdentifier @@ -497,7 +542,7 @@ pBar, pColon, pLHS,pINST,pSET,pDERIVING,pMinus,pIntersect,pDoubleArrow,pArrow, pDot, pUScore, pEXT,pAt,pStar, pSmaller, pWRAPPER, pNOCATAS, pPRAGMA, pMAYBE, pEITHER, pMAP, pINTMAP, pMODULE, pATTACH, pUNIQUEREF, pINH, pSYN, pAUGMENT, pPlus, pAROUND, pSEMPRAGMA, pMERGE, pAS, pSELF, - pIMPORTS, pOPTPRAGMAS, pSmallerEqual, pINTSET + pIMPORTS, pOPTPRAGMAS, pSmallerEqual, pINTSET, pDATABLOCK, pRECBLOCK :: AGParser Pos pSET = pCostReserved 90 "SET" "SET" pDERIVING = pCostReserved 90 "DERIVING" "DERIVING" @@ -552,3 +597,5 @@ pIMPORTS = pCostReserved 5 "imports" "imports" pOPTPRAGMAS = pCostReserved 5 "optpragmas" "optpragmas" pTOPLEVEL = pCostReserved 5 "toplevel" "toplevel" +pDATABLOCK = pCostReserved 5 "datablock" "datadecl block" +pRECBLOCK = pCostReserved 5 "recblock" "recursive block" diff --git a/src/Pretty.hs b/src/Pretty.hs --- a/src/Pretty.hs +++ b/src/Pretty.hs @@ -188,4 +188,3 @@ 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,5 +1,4 @@ -{-# LANGUAGE MagicHash, - UnboxedTuples, FlexibleInstances #-} +{-# LANGUAGE MagicHash, UnboxedTuples, FlexibleInstances #-} module Scanner where import GHC.Prim import TokenDef @@ -39,8 +38,9 @@ type Lexer s = Pos -> String -> Maybe (s,Pos,String) scan :: Options -> Lexer Token -scan opts - = scan +scan opts p0 + | column p0 == 1 = scanBeginOfLine p0 + | otherwise = scan p0 where keywords' = if lcKeywords opts then map (map toLower) keywords @@ -98,6 +98,11 @@ scan' ('-' :rs) = (reserved "-" p, advc 1 p, rs) scan' ('*' :rs) = (reserved "*" p, advc 1 p, rs) + scan' ('\'' :rs) | ocaml opts = -- note: ocaml type variables are encoded as 'TkTextnm' tokens + let (var,rest) = ident rs + str = '\'' : var + in (valueToken TkTextnm str p, advc (length str) p, rest) + scan' (x:rs) | isLower x = let (var,rest) = ident rs str = (x:var) tok | str `elem` keywords' = reserved (mkKeyword str) @@ -131,8 +136,9 @@ ident = span isValid - where isValid x = isAlphaNum x || x =='_' || x == '\'' -lowercaseKeywords = ["loc","lhs", "inst", "optpragmas", "imports", "toplevel"] + where isValid x = isAlphaNum x || x == '_' || x == '\'' + +lowercaseKeywords = ["loc","lhs", "inst", "optpragmas", "imports", "toplevel", "datablock", "recblock"] keywords = lowercaseKeywords ++ [ "DATA", "EXT", "ATTR", "SEM","TYPE", "USE", "INCLUDE" , "EXTENDS" -- marcos diff --git a/src/UU/UUAGC.hs b/src/UU/UUAGC.hs --- a/src/UU/UUAGC.hs +++ b/src/UU/UUAGC.hs @@ -1,6 +1,7 @@ -module UU.UUAGC (uuagc, uuagcMain) where +module UU.UUAGC (uuagc, uuagcMain, compile, module Options) where -import Ag (uuagcLib, uuagcExe) +import Ag (uuagcLib, uuagcExe, compile) +import Options import System.Exit (ExitCode(..)) diff --git a/src/UU/UUAGC/Version.hs b/src/UU/UUAGC/Version.hs --- a/src/UU/UUAGC/Version.hs +++ b/src/UU/UUAGC/Version.hs @@ -1,5 +1,4 @@ --- | Module is only supposed to be included for the bootstrapped version of UUAGC. --- It imports a module that is only present while building that version. +-- | Get current version of UUAGC module UU.UUAGC.Version(version) where import Paths_uuagc(version) diff --git a/uuagc.cabal b/uuagc.cabal --- a/uuagc.cabal +++ b/uuagc.cabal @@ -1,13 +1,10 @@ cabal-version: >= 1.8 build-type: Custom -x-bootstrap-build-type: Simple name: uuagc -x-bootstrap-name: uuagc-bootstrap -version: 0.9.40.3 -x-bootstrap-version: 0.9.40.3 +version: 0.9.42.0 license: BSD3 license-file: LICENSE -maintainer: Arie Middelkoop +maintainer: Arie Middelkoop homepage: http://www.cs.uu.nl/wiki/HUT/WebHome description: Generates Haskell files from an attribute grammar specification synopsis: Attribute Grammar System of Universiteit Utrecht @@ -22,74 +19,14 @@ extra-source-files: src-ag/DistChildAttr.ag executable uuagc - build-depends: uuagc-bootstrap >= 0.9.40.0 build-depends: uuagc-cabal >= 1.0.2.0 - build-depends: base >= 4, base < 5, ghc-prim >= 0.2.0.0 - build-depends: containers >= 0.3, directory >= 1.0.1.1, array >= 0.3.0.1 - build-depends: uulib >= 0.9.14, mtl >= 1.1.1.1 - build-depends: haskell-src-exts >= 1.11.1 - build-depends: filepath >= 1.1.0.4 + build-depends: base >= 4, base < 5 + -- Self dependency, depend on library below + build-depends: uuagc == 0.9.42.0 main-is: Main.hs - hs-source-dirs: src, src-version, src-ag, src-options, src-main - x-bootstrap-hs-source-dirs: src, src-version, src-derived, src-options, src-main - extensions: TypeSynonymInstances, MultiParamTypeClasses - x-bootstrap-other-modules: Paths_uuagc_bootstrap - other-modules: Paths_uuagc - , Ag - , CommonTypes - , GrammarInfo - , HsTokenScanner - , Options - , PPUtil - , Parser - , Pretty - , Scanner - , SequentialComputation - , SequentialTypes - , TokenDef - , Version - , AbstractSyntax - , AbstractSyntaxDump - , Code - , CodeSyntax - , CodeSyntaxDump - , ConcreteSyntax - , DeclBlocks - , DefaultRules - , Desugar - , ErrorMessages - , Expression - , GenerateCode - , HsToken - , Interfaces - , InterfacesRules - , Order - , Patterns - , PrintCode - , PrintOcamlCode - , PrintVisitCode - , PrintErrorMessages - , SemHsTokens - , Transform - , ATermWrite - , ATermAbstractSyntax - , TfmToVisage - , Visage - , VisageSyntax - , VisagePatterns - , AG2AspectAG - , Macro - , RhsCheck - , ResolveLocals - , Knuth1 - , KennedyWarren - , KWOrder - , ExecutionPlan - , ExecutionPlan2Hs - + hs-source-dirs: src-main library - build-depends: uuagc-bootstrap >= 0.9.40.0 build-depends: uuagc-cabal >= 1.0.2.0 build-depends: base >= 4, base < 5, ghc-prim >= 0.2.0.0 build-depends: containers >= 0.3, directory >= 1.0.1.1, array >= 0.3.0.1 @@ -97,11 +34,8 @@ build-depends: haskell-src-exts >= 1.11.1 build-depends: filepath >= 1.1.0.4 hs-source-dirs: src, src-version, src-ag, src-options - x-bootstrap-hs-source-dirs: src, src-version, src-derived, src-options exposed-modules: UU.UUAGC, UU.UUAGC.Version - x-bootstrap-exposed-modules: UU.UUAGC.Bootstrap, UU.UUAGC.BootstrapVersion extensions: TypeSynonymInstances, MultiParamTypeClasses - x-bootstrap-other-modules: Paths_uuagc_bootstrap other-modules: Paths_uuagc , Ag , CommonTypes @@ -154,3 +88,4 @@ , KWOrder , ExecutionPlan , ExecutionPlan2Hs + , ExecutionPlan2Caml diff --git a/uuagc_options b/uuagc_options --- a/uuagc_options +++ b/uuagc_options @@ -96,5 +96,8 @@ file: "src-ag/ExecutionPlan2Hs.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell +file: "src-ag/ExecutionPlan2Caml.ag" +options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell + file: "src-ag/InterfacesRules.lag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell