diff --git a/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs b/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs +++ /dev/null @@ -1,3125 +0,0 @@ - - --- UUAGC 0.9.39.0.0 (src-ag/AG2AspectAG.ag) -module AG2AspectAG where -{-# LINE 7 "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 -{-# LINE 23 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 CommonTypes -{-# LINE 33 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs" #-} - -{-# LINE 2 "src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 40 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs" #-} - -{-# LINE 2 "src-ag/Expression.ag" #-} - -import UU.Scanner.Position(Pos) -import HsToken -{-# LINE 46 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs" #-} - -{-# LINE 2 "src-ag/HsToken.ag" #-} - -import CommonTypes -import UU.Scanner.Position(Pos) -{-# LINE 52 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs" #-} -{-# LINE 25 "src-ag/AG2AspectAG.ag" #-} - -pragmaAspectAG = pp "{-# LANGUAGE EmptyDataDecls, NoMonomorphismRestriction , TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts #-}" - -{-# LINE 57 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs" #-} - -{-# LINE 30 "src-ag/AG2AspectAG.ag" #-} - -ppName l = ppListSep "" "" "_" l -{-# LINE 62 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs" #-} - -{-# LINE 58 "src-ag/AG2AspectAG.ag" #-} - -type FieldMap = [(Identifier, Type)] -type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap) -{-# LINE 68 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs" #-} - -{-# LINE 324 "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 97 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs" #-} - -{-# LINE 379 "src-ag/AG2AspectAG.ag" #-} - -ntsList att ppNtL = "nts_" ++ att ++ " = " >|< ppListSep "" "" " .*. " ((map fst ppNtL) ++ [pp "hNil"]) - -filterNts att = filter ( Map.member (identifier att) . snd ) -{-# LINE 104 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs" #-} - -{-# LINE 439 "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 116 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs" #-} - -{-# LINE 474 "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 "(" ")" "," $ mapGRuleDefs ((== "loc") . show) 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 - - - -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) inhNoGroup synNoGroup rhs = \chids locals -> - let ppAtt = if (elem (getName att) inhNoGroup || elem (getName att) synNoGroup) - 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 field inhNoGroup synNoGroup chids locals) - - -rhsRule ppNt ppProd tks field inhNoGroup synNoGroup chids locals = vlist . lines2PP . (map (token2PP ppNt ppProd field chids locals inhNoGroup synNoGroup )) $ tks - - -lines2PP [] = [] -lines2PP xs = map line2PP . shiftLeft . getLines $ xs - - -token2PP ppNt ppProd field chids locals inhNoGroup synNoGroup 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) inhNoGroup || elem (getName attr) synNoGroup ) - 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 336 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs" #-} - -{-# LINE 717 "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 346 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs" #-} - -{-# LINE 760 "src-ag/AG2AspectAG.ag" #-} - -attTypes atts = map (\(a,t) -> "(HCons (LVPair (Proxy Att_" >|< a >|< ") " >|< ppShow t >|< ") ") $ Map.toAscList atts -{-# LINE 351 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs" #-} - -{-# LINE 814 "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 360 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AG2AspectAG.hs" #-} --- Child ------------------------------------------------------- -{- - visit 0: - inherited attributes: - ext : Maybe String - inhNoGroup : [String] - o_rename : Bool - ppNt : PP_Doc - ppProd : PP_Doc - synNoGroup : [String] - synthesized attributes: - idCL : [(Identifier,Type)] - ppCSF : [(Identifier,(PP_Doc,PP_Doc))] - ppL : PP_Doc - ppLI : [PP_Doc] - ppR : PP_Doc - alternatives: - alternative Child: - child name : {Identifier} - child tp : {Type} - child inh : {Attributes} - child syn : {Attributes} - child virtual : {Maybe (Maybe Type)} - visit 0: - local ppCh : _ - local ppTCh : _ - local chName : _ - local chLabel : _ - local chTLabel : _ --} --- cata -sem_Child :: Child -> - T_Child -sem_Child (Child _name _tp _inh _syn _virtual ) = - (sem_Child_Child _name _tp _inh _syn _virtual ) --- semantic domain -newtype T_Child = T_Child ((Maybe String) -> - ([String]) -> - Bool -> - PP_Doc -> - PP_Doc -> - ([String]) -> - ( ([(Identifier,Type)]),([(Identifier,(PP_Doc,PP_Doc))]),PP_Doc,([PP_Doc]),PP_Doc)) -data Inh_Child = Inh_Child {ext_Inh_Child :: (Maybe String),inhNoGroup_Inh_Child :: ([String]),o_rename_Inh_Child :: Bool,ppNt_Inh_Child :: PP_Doc,ppProd_Inh_Child :: PP_Doc,synNoGroup_Inh_Child :: ([String])} -data Syn_Child = Syn_Child {idCL_Syn_Child :: ([(Identifier,Type)]),ppCSF_Syn_Child :: ([(Identifier,(PP_Doc,PP_Doc))]),ppL_Syn_Child :: PP_Doc,ppLI_Syn_Child :: ([PP_Doc]),ppR_Syn_Child :: PP_Doc} -wrap_Child :: T_Child -> - Inh_Child -> - Syn_Child -wrap_Child (T_Child sem ) (Inh_Child _lhsIext _lhsIinhNoGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynNoGroup ) = - (let ( _lhsOidCL,_lhsOppCSF,_lhsOppL,_lhsOppLI,_lhsOppR) = sem _lhsIext _lhsIinhNoGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynNoGroup - in (Syn_Child _lhsOidCL _lhsOppCSF _lhsOppL _lhsOppLI _lhsOppR )) -sem_Child_Child :: Identifier -> - Type -> - Attributes -> - Attributes -> - (Maybe (Maybe Type)) -> - T_Child -sem_Child_Child name_ tp_ inh_ syn_ virtual_ = - (T_Child (\ _lhsIext - _lhsIinhNoGroup - _lhsIo_rename - _lhsIppNt - _lhsIppProd - _lhsIsynNoGroup -> - (let _lhsOppL :: PP_Doc - _lhsOppLI :: ([PP_Doc]) - _lhsOppR :: PP_Doc - _lhsOidCL :: ([(Identifier,Type)]) - _lhsOppCSF :: ([(Identifier,(PP_Doc,PP_Doc))]) - -- "src-ag/AG2AspectAG.ag"(line 170, column 25) - _ppCh = - ({-# LINE 170 "src-ag/AG2AspectAG.ag" #-} - pp name_ - {-# LINE 434 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 171, column 25) - _ppTCh = - ({-# LINE 171 "src-ag/AG2AspectAG.ag" #-} - ppShow tp_ - {-# LINE 440 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 172, column 25) - _chName = - ({-# LINE 172 "src-ag/AG2AspectAG.ag" #-} - ppName [_ppCh , _lhsIppNt, _lhsIppProd] - {-# LINE 446 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 272, column 25) - _chLabel = - ({-# LINE 272 "src-ag/AG2AspectAG.ag" #-} - "ch_" >|< _chName - {-# LINE 452 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 273, column 25) - _chTLabel = - ({-# LINE 273 "src-ag/AG2AspectAG.ag" #-} - "Ch_" >|< _chName - {-# LINE 458 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 274, column 25) - _lhsOppL = - ({-# LINE 274 "src-ag/AG2AspectAG.ag" #-} - "data " >|< _chTLabel >|< "; " >|< _chLabel >|< pp " = proxy :: " >|< - case virtual_ of - Nothing -> "Proxy " >|< "(" >|< _chTLabel >|< ", " >|< _ppTCh >|< ")" - otherwise -> "SemType " >|< _ppTCh >|< pp " nt => Proxy " >|< - "(" >|< _chTLabel >|< ", nt)" - {-# LINE 468 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 280, column 25) - _lhsOppLI = - ({-# LINE 280 "src-ag/AG2AspectAG.ag" #-} - [ _chLabel , _chTLabel ] - {-# LINE 474 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 435, column 25) - _lhsOppR = - ({-# LINE 435 "src-ag/AG2AspectAG.ag" #-} - let chName = ppListSep "" "" "_" [pp name_, _lhsIppNt, _lhsIppProd] - in pp name_ >|< " <- at ch_" >|< chName - {-# LINE 481 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 466, column 25) - _lhsOidCL = - ({-# LINE 466 "src-ag/AG2AspectAG.ag" #-} - [ (name_, case (stripPrefix "T_" (show tp_)) of - Nothing -> tp_ - Just t -> NT (Ident t undefined) [] - ) ] - {-# LINE 490 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 789, column 25) - _lhsOppCSF = - ({-# LINE 789 "src-ag/AG2AspectAG.ag" #-} - let - semC = if (isNonterminal tp_) - then "sem_" >|< ppShow tp_ >|< " _" >|< name_ - else "sem_Lit _" >|< name_ - in case virtual_ of - Nothing -> [(name_, ( _chLabel >|< " .=. (" >|< semC >|< ") .*. " - , _chLabel >|< " .=. _" >|< name_ >|< " .*. "))] - otherwise -> [] - {-# LINE 503 "src-ag/AG2AspectAG.hs" #-} - ) - in ( _lhsOidCL,_lhsOppCSF,_lhsOppL,_lhsOppLI,_lhsOppR))) ) --- Children ---------------------------------------------------- -{- - visit 0: - inherited attributes: - ext : Maybe String - inhNoGroup : [String] - o_rename : Bool - ppNt : PP_Doc - ppProd : PP_Doc - synNoGroup : [String] - synthesized attributes: - idCL : [(Identifier,Type)] - ppCSF : [(Identifier,(PP_Doc,PP_Doc))] - ppL : PP_Doc - ppLI : [PP_Doc] - ppR : 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 ((Maybe String) -> - ([String]) -> - Bool -> - PP_Doc -> - PP_Doc -> - ([String]) -> - ( ([(Identifier,Type)]),([(Identifier,(PP_Doc,PP_Doc))]),PP_Doc,([PP_Doc]),PP_Doc)) -data Inh_Children = Inh_Children {ext_Inh_Children :: (Maybe String),inhNoGroup_Inh_Children :: ([String]),o_rename_Inh_Children :: Bool,ppNt_Inh_Children :: PP_Doc,ppProd_Inh_Children :: PP_Doc,synNoGroup_Inh_Children :: ([String])} -data Syn_Children = Syn_Children {idCL_Syn_Children :: ([(Identifier,Type)]),ppCSF_Syn_Children :: ([(Identifier,(PP_Doc,PP_Doc))]),ppL_Syn_Children :: PP_Doc,ppLI_Syn_Children :: ([PP_Doc]),ppR_Syn_Children :: PP_Doc} -wrap_Children :: T_Children -> - Inh_Children -> - Syn_Children -wrap_Children (T_Children sem ) (Inh_Children _lhsIext _lhsIinhNoGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynNoGroup ) = - (let ( _lhsOidCL,_lhsOppCSF,_lhsOppL,_lhsOppLI,_lhsOppR) = sem _lhsIext _lhsIinhNoGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynNoGroup - in (Syn_Children _lhsOidCL _lhsOppCSF _lhsOppL _lhsOppLI _lhsOppR )) -sem_Children_Cons :: T_Child -> - T_Children -> - T_Children -sem_Children_Cons (T_Child hd_ ) (T_Children tl_ ) = - (T_Children (\ _lhsIext - _lhsIinhNoGroup - _lhsIo_rename - _lhsIppNt - _lhsIppProd - _lhsIsynNoGroup -> - (let _lhsOidCL :: ([(Identifier,Type)]) - _lhsOppCSF :: ([(Identifier,(PP_Doc,PP_Doc))]) - _lhsOppL :: PP_Doc - _lhsOppLI :: ([PP_Doc]) - _lhsOppR :: PP_Doc - _hdOext :: (Maybe String) - _hdOinhNoGroup :: ([String]) - _hdOo_rename :: Bool - _hdOppNt :: PP_Doc - _hdOppProd :: PP_Doc - _hdOsynNoGroup :: ([String]) - _tlOext :: (Maybe String) - _tlOinhNoGroup :: ([String]) - _tlOo_rename :: Bool - _tlOppNt :: PP_Doc - _tlOppProd :: PP_Doc - _tlOsynNoGroup :: ([String]) - _hdIidCL :: ([(Identifier,Type)]) - _hdIppCSF :: ([(Identifier,(PP_Doc,PP_Doc))]) - _hdIppL :: PP_Doc - _hdIppLI :: ([PP_Doc]) - _hdIppR :: PP_Doc - _tlIidCL :: ([(Identifier,Type)]) - _tlIppCSF :: ([(Identifier,(PP_Doc,PP_Doc))]) - _tlIppL :: PP_Doc - _tlIppLI :: ([PP_Doc]) - _tlIppR :: PP_Doc - -- use rule "src-ag/AG2AspectAG.ag"(line 464, column 31) - _lhsOidCL = - ({-# LINE 464 "src-ag/AG2AspectAG.ag" #-} - _hdIidCL ++ _tlIidCL - {-# LINE 590 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 785, column 34) - _lhsOppCSF = - ({-# LINE 785 "src-ag/AG2AspectAG.ag" #-} - _hdIppCSF ++ _tlIppCSF - {-# LINE 596 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 246, column 79) - _lhsOppL = - ({-# LINE 246 "src-ag/AG2AspectAG.ag" #-} - _hdIppL >-< _tlIppL - {-# LINE 602 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 246, column 112) - _lhsOppLI = - ({-# LINE 246 "src-ag/AG2AspectAG.ag" #-} - _hdIppLI ++ _tlIppLI - {-# LINE 608 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 402, column 79) - _lhsOppR = - ({-# LINE 402 "src-ag/AG2AspectAG.ag" #-} - _hdIppR >-< _tlIppR - {-# LINE 614 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOext = - ({-# LINE 107 "src-ag/AG2AspectAG.ag" #-} - _lhsIext - {-# LINE 620 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOinhNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIinhNoGroup - {-# LINE 626 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOo_rename = - ({-# LINE 38 "src-ag/AG2AspectAG.ag" #-} - _lhsIo_rename - {-# LINE 632 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOppNt = - ({-# LINE 175 "src-ag/AG2AspectAG.ag" #-} - _lhsIppNt - {-# LINE 638 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOppProd = - ({-# LINE 180 "src-ag/AG2AspectAG.ag" #-} - _lhsIppProd - {-# LINE 644 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOsynNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIsynNoGroup - {-# LINE 650 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOext = - ({-# LINE 107 "src-ag/AG2AspectAG.ag" #-} - _lhsIext - {-# LINE 656 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOinhNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIinhNoGroup - {-# LINE 662 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOo_rename = - ({-# LINE 38 "src-ag/AG2AspectAG.ag" #-} - _lhsIo_rename - {-# LINE 668 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOppNt = - ({-# LINE 175 "src-ag/AG2AspectAG.ag" #-} - _lhsIppNt - {-# LINE 674 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOppProd = - ({-# LINE 180 "src-ag/AG2AspectAG.ag" #-} - _lhsIppProd - {-# LINE 680 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOsynNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIsynNoGroup - {-# LINE 686 "src-ag/AG2AspectAG.hs" #-} - ) - ( _hdIidCL,_hdIppCSF,_hdIppL,_hdIppLI,_hdIppR) = - hd_ _hdOext _hdOinhNoGroup _hdOo_rename _hdOppNt _hdOppProd _hdOsynNoGroup - ( _tlIidCL,_tlIppCSF,_tlIppL,_tlIppLI,_tlIppR) = - tl_ _tlOext _tlOinhNoGroup _tlOo_rename _tlOppNt _tlOppProd _tlOsynNoGroup - in ( _lhsOidCL,_lhsOppCSF,_lhsOppL,_lhsOppLI,_lhsOppR))) ) -sem_Children_Nil :: T_Children -sem_Children_Nil = - (T_Children (\ _lhsIext - _lhsIinhNoGroup - _lhsIo_rename - _lhsIppNt - _lhsIppProd - _lhsIsynNoGroup -> - (let _lhsOidCL :: ([(Identifier,Type)]) - _lhsOppCSF :: ([(Identifier,(PP_Doc,PP_Doc))]) - _lhsOppL :: PP_Doc - _lhsOppLI :: ([PP_Doc]) - _lhsOppR :: PP_Doc - -- use rule "src-ag/AG2AspectAG.ag"(line 464, column 31) - _lhsOidCL = - ({-# LINE 464 "src-ag/AG2AspectAG.ag" #-} - [] - {-# LINE 710 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 785, column 34) - _lhsOppCSF = - ({-# LINE 785 "src-ag/AG2AspectAG.ag" #-} - [] - {-# LINE 716 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 246, column 79) - _lhsOppL = - ({-# LINE 246 "src-ag/AG2AspectAG.ag" #-} - empty - {-# LINE 722 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 246, column 112) - _lhsOppLI = - ({-# LINE 246 "src-ag/AG2AspectAG.ag" #-} - [] - {-# LINE 728 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 402, column 79) - _lhsOppR = - ({-# LINE 402 "src-ag/AG2AspectAG.ag" #-} - empty - {-# LINE 734 "src-ag/AG2AspectAG.hs" #-} - ) - in ( _lhsOidCL,_lhsOppCSF,_lhsOppL,_lhsOppLI,_lhsOppR))) ) --- Expression -------------------------------------------------- -{- - visit 0: - inherited attributes: - ppNt : PP_Doc - ppProd : PP_Doc - synthesized attribute: - ppRE : Identifier -> [String] -> [String] -> [(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 -> - ( (Identifier -> [String] -> [String] -> [(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 :: (Identifier -> [String] -> [String] -> [(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 :: (Identifier -> [String] -> [String] -> [(Identifier,Type)] -> [Identifier] -> PP_Doc) - -- "src-ag/AG2AspectAG.ag"(line 460, column 25) - _lhsOppRE = - ({-# LINE 460 "src-ag/AG2AspectAG.ag" #-} - rhsRule _lhsIppNt _lhsIppProd tks_ - {-# LINE 778 "src-ag/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 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 - _nontsOext :: (Maybe String) - _nontsIextendedNTs :: (Set NontermIdent) - _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 - -- "src-ag/AG2AspectAG.ag"(line 40, column 14) - _nontsOo_rename = - ({-# LINE 40 "src-ag/AG2AspectAG.ag" #-} - rename _lhsIoptions - {-# LINE 879 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 44, column 14) - _o_noGroup = - ({-# LINE 44 "src-ag/AG2AspectAG.ag" #-} - sort $ noGroup _lhsIoptions - {-# LINE 885 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 45, column 14) - _nontsOo_noGroup = - ({-# LINE 45 "src-ag/AG2AspectAG.ag" #-} - _o_noGroup - {-# LINE 891 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 68, column 23) - _newAtts = - ({-# LINE 68 "src-ag/AG2AspectAG.ag" #-} - case _lhsIagi of - (_,_,atts) -> ( Map.unions . (\(a,b) -> a++b) . unzip . Map.elems) atts - {-# LINE 898 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 70, column 23) - _nontsOnewAtts = - ({-# LINE 70 "src-ag/AG2AspectAG.ag" #-} - _newAtts - {-# LINE 904 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 76, column 23) - _newProds = - ({-# LINE 76 "src-ag/AG2AspectAG.ag" #-} - case _lhsIagi of - (_,prods,_) -> prods - {-# LINE 911 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 78, column 23) - _nontsOnewProds = - ({-# LINE 78 "src-ag/AG2AspectAG.ag" #-} - _newProds - {-# LINE 917 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 100, column 23) - _nontsOnewNTs = - ({-# LINE 100 "src-ag/AG2AspectAG.ag" #-} - case _lhsIagi of - (newNTs,_,_) -> Set.difference newNTs _nontsIextendedNTs - {-# LINE 924 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 115, column 25) - _lhsOimp = - ({-# LINE 115 "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 )) _lhsIext - {-# LINE 936 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 128, column 25) - _lhsOpp = - ({-# LINE 128 "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 959 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 190, column 25) - _nontsOderivs = - ({-# LINE 190 "src-ag/AG2AspectAG.ag" #-} - derivings_ - {-# LINE 965 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 238, column 34) - _nontsOtSyns = - ({-# LINE 238 "src-ag/AG2AspectAG.ag" #-} - typeSyns_ - {-# LINE 971 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 287, column 25) - _ppA = - ({-# LINE 287 "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 982 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 294, column 25) - _ppAI = - ({-# LINE 294 "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 994 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 374, column 25) - _ppNtL = - ({-# LINE 374 "src-ag/AG2AspectAG.ag" #-} - _nontsIppNtL - {-# LINE 1000 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 375, column 25) - _ppR = - ({-# LINE 375 "src-ag/AG2AspectAG.ag" #-} - ntsList "group" _ppNtL >-< - vlist (map (\att -> ntsList att (filterNts att _ppNtL )) (filterAtts _newAtts _o_noGroup )) >-< - _nontsIppR - {-# LINE 1008 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _nontsOext = - ({-# LINE 107 "src-ag/AG2AspectAG.ag" #-} - _lhsIext - {-# LINE 1014 "src-ag/AG2AspectAG.hs" #-} - ) - ( _nontsIextendedNTs,_nontsIppA,_nontsIppAI,_nontsIppCata,_nontsIppD,_nontsIppDI,_nontsIppL,_nontsIppLI,_nontsIppNtL,_nontsIppR,_nontsIppSF,_nontsIppW) = - nonts_ _nontsOderivs _nontsOext _nontsOnewAtts _nontsOnewNTs _nontsOnewProds _nontsOo_noGroup _nontsOo_rename _nontsOtSyns - in ( _lhsOimp,_lhsOpp))) ) --- HsToken ----------------------------------------------------- -{- - alternatives: - alternative AGField: - child field : {Identifier} - child attr : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - alternative AGLocal: - child var : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - alternative CharToken: - child value : {String} - child pos : {Pos} - alternative Err: - child mesg : {String} - child pos : {Pos} - alternative HsToken: - child value : {String} - child pos : {Pos} - alternative StrToken: - child value : {String} - child pos : {Pos} --} --- cata -sem_HsToken :: HsToken -> - T_HsToken -sem_HsToken (AGField _field _attr _pos _rdesc ) = - (sem_HsToken_AGField _field _attr _pos _rdesc ) -sem_HsToken (AGLocal _var _pos _rdesc ) = - (sem_HsToken_AGLocal _var _pos _rdesc ) -sem_HsToken (CharToken _value _pos ) = - (sem_HsToken_CharToken _value _pos ) -sem_HsToken (Err _mesg _pos ) = - (sem_HsToken_Err _mesg _pos ) -sem_HsToken (HsToken _value _pos ) = - (sem_HsToken_HsToken _value _pos ) -sem_HsToken (StrToken _value _pos ) = - (sem_HsToken_StrToken _value _pos ) --- semantic domain -newtype T_HsToken = T_HsToken (( )) -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_AGField :: Identifier -> - Identifier -> - Pos -> - (Maybe String) -> - T_HsToken -sem_HsToken_AGField field_ attr_ pos_ rdesc_ = - (T_HsToken (let - in ( )) ) -sem_HsToken_AGLocal :: Identifier -> - Pos -> - (Maybe String) -> - T_HsToken -sem_HsToken_AGLocal var_ pos_ rdesc_ = - (T_HsToken (let - in ( )) ) -sem_HsToken_CharToken :: String -> - Pos -> - T_HsToken -sem_HsToken_CharToken value_ pos_ = - (T_HsToken (let - in ( )) ) -sem_HsToken_Err :: String -> - Pos -> - T_HsToken -sem_HsToken_Err mesg_ pos_ = - (T_HsToken (let - in ( )) ) -sem_HsToken_HsToken :: String -> - Pos -> - T_HsToken -sem_HsToken_HsToken value_ pos_ = - (T_HsToken (let - in ( )) ) -sem_HsToken_StrToken :: String -> - Pos -> - T_HsToken -sem_HsToken_StrToken value_ 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 - newAtts : Attributes - newNTs : Set NontermIdent - newProds : DataTypes - o_noGroup : [String] - o_rename : Bool - tSyns : TypeSyns - synthesized attributes: - extendedNTs : Set NontermIdent - 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 - 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) -> - ( Attributes ) -> - (Set NontermIdent) -> - ( DataTypes ) -> - ([String]) -> - Bool -> - TypeSyns -> - ( (Set NontermIdent),PP_Doc,([PP_Doc]),PP_Doc,PP_Doc,([PP_Doc]),PP_Doc,([PP_Doc]),([(PP_Doc, Attributes)]),PP_Doc,PP_Doc,PP_Doc)) -data Inh_Nonterminal = Inh_Nonterminal {derivs_Inh_Nonterminal :: Derivings,ext_Inh_Nonterminal :: (Maybe String),newAtts_Inh_Nonterminal :: ( Attributes ),newNTs_Inh_Nonterminal :: (Set NontermIdent),newProds_Inh_Nonterminal :: ( DataTypes ),o_noGroup_Inh_Nonterminal :: ([String]),o_rename_Inh_Nonterminal :: Bool,tSyns_Inh_Nonterminal :: TypeSyns} -data Syn_Nonterminal = Syn_Nonterminal {extendedNTs_Syn_Nonterminal :: (Set NontermIdent),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} -wrap_Nonterminal :: T_Nonterminal -> - Inh_Nonterminal -> - Syn_Nonterminal -wrap_Nonterminal (T_Nonterminal sem ) (Inh_Nonterminal _lhsIderivs _lhsIext _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsItSyns ) = - (let ( _lhsOextendedNTs,_lhsOppA,_lhsOppAI,_lhsOppCata,_lhsOppD,_lhsOppDI,_lhsOppL,_lhsOppLI,_lhsOppNtL,_lhsOppR,_lhsOppSF,_lhsOppW) = sem _lhsIderivs _lhsIext _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsItSyns - in (Syn_Nonterminal _lhsOextendedNTs _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW )) -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 - _lhsInewAtts - _lhsInewNTs - _lhsInewProds - _lhsIo_noGroup - _lhsIo_rename - _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 - _prodsOext :: (Maybe String) - _prodsOnewAtts :: ( Attributes ) - _prodsOo_rename :: Bool - _prodsIhasMoreProds :: ( Bool ) - _prodsIppA :: PP_Doc - _prodsIppCata :: PP_Doc - _prodsIppL :: PP_Doc - _prodsIppLI :: ([PP_Doc]) - _prodsIppR :: PP_Doc - _prodsIppRA :: ([PP_Doc]) - _prodsIppSF :: PP_Doc - _prodsIppSPF :: PP_Doc - -- "src-ag/AG2AspectAG.ag"(line 48, column 18) - _inhNoGroup = - ({-# LINE 48 "src-ag/AG2AspectAG.ag" #-} - Map.filterWithKey (\att _ -> elem (getName att) _lhsIo_noGroup) inh_ - {-# LINE 1278 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 49, column 18) - _synNoGroup = - ({-# LINE 49 "src-ag/AG2AspectAG.ag" #-} - Map.filterWithKey (\att _ -> elem (getName att) _lhsIo_noGroup) syn_ - {-# LINE 1284 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 54, column 18) - _prodsOinhNoGroup = - ({-# LINE 54 "src-ag/AG2AspectAG.ag" #-} - map show $ Map.keys _inhNoGroup - {-# LINE 1290 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 55, column 18) - _prodsOsynNoGroup = - ({-# LINE 55 "src-ag/AG2AspectAG.ag" #-} - map show $ Map.keys _synNoGroup - {-# LINE 1296 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 82, column 17) - _prodsOnewProds = - ({-# LINE 82 "src-ag/AG2AspectAG.ag" #-} - case Map.lookup nt_ _lhsInewProds of - Just prds -> prds - Nothing -> Map.empty - {-# LINE 1304 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 95, column 31) - _lhsOextendedNTs = - ({-# LINE 95 "src-ag/AG2AspectAG.ag" #-} - if _prodsIhasMoreProds - then Set.singleton nt_ - else Set.empty - {-# LINE 1312 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 161, column 25) - _ppNt = - ({-# LINE 161 "src-ag/AG2AspectAG.ag" #-} - pp nt_ - {-# LINE 1318 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 178, column 25) - _prodsOppNt = - ({-# LINE 178 "src-ag/AG2AspectAG.ag" #-} - _ppNt - {-# LINE 1324 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 196, column 25) - _lhsOppD = - ({-# LINE 196 "src-ag/AG2AspectAG.ag" #-} - if (Set.member nt_ _lhsInewNTs) - then case (lookup nt_ _lhsItSyns) of - Nothing -> "data " >|< _ppNt - Just tp -> "type " >|< _ppNt >|< " = " >|< ppShow tp - else empty - {-# LINE 1334 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 209, column 25) - _lhsOppDI = - ({-# LINE 209 "src-ag/AG2AspectAG.ag" #-} - if (not $ Set.member nt_ _lhsInewNTs) - then [ _ppNt ] - else [ ] - {-# LINE 1342 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 249, column 25) - _ntLabel = - ({-# LINE 249 "src-ag/AG2AspectAG.ag" #-} - "nt_" >|< _ppNt - {-# LINE 1348 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 251, column 25) - _lhsOppL = - ({-# LINE 251 "src-ag/AG2AspectAG.ag" #-} - ( if (Set.member nt_ _lhsInewNTs) - then _ntLabel >|< " = proxy :: Proxy " >|< _ppNt - else empty) >-< - _prodsIppL - {-# LINE 1357 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 256, column 25) - _lhsOppLI = - ({-# LINE 256 "src-ag/AG2AspectAG.ag" #-} - ( if (not $ Set.member nt_ _lhsInewNTs) - then [ _ntLabel ] - else [ ]) ++ - _prodsIppLI - {-# LINE 1366 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 307, column 25) - _lhsOppA = - ({-# LINE 307 "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 1376 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 320, column 25) - _lhsOppAI = - ({-# LINE 320 "src-ag/AG2AspectAG.ag" #-} - if (not $ Set.member nt_ _lhsInewNTs) - then [ ppName [(pp "InhG"), _ppNt ] >#< pp "(..)", ppName [(pp "SynG"), _ppNt ] >#< pp "(..)" ] - else [ ] - {-# LINE 1384 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 388, column 25) - _lhsOppNtL = - ({-# LINE 388 "src-ag/AG2AspectAG.ag" #-} - [ ("nt_" >|< nt_, Map.union inh_ syn_) ] - {-# LINE 1390 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 399, column 25) - _prodsOnewNT = - ({-# LINE 399 "src-ag/AG2AspectAG.ag" #-} - Set.member nt_ _lhsInewNTs - {-# LINE 1396 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 409, column 25) - _lhsOppR = - ({-# LINE 409 "src-ag/AG2AspectAG.ag" #-} - pp "----" >|< pp nt_ >-< _prodsIppR - {-# LINE 1402 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 703, column 25) - _lhsOppCata = - ({-# LINE 703 "src-ag/AG2AspectAG.ag" #-} - "----" >|< _ppNt >-< _prodsIppCata - {-# LINE 1408 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 729, column 25) - _prodsOsyn = - ({-# LINE 729 "src-ag/AG2AspectAG.ag" #-} - syn_ - {-# LINE 1414 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 730, column 25) - _prodsOinh = - ({-# LINE 730 "src-ag/AG2AspectAG.ag" #-} - inh_ - {-# LINE 1420 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 741, column 25) - _lhsOppSF = - ({-# LINE 741 "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 1441 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 809, column 25) - _lhsOppW = - ({-# LINE 809 "src-ag/AG2AspectAG.ag" #-} - ppName [pp "wrap", _ppNt ] >|< " sem " >|< attVars inh_ >|< " = " >-< - " sem " >|< attFields inh_ _inhNoGroup _ppNt - {-# LINE 1448 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _prodsOext = - ({-# LINE 107 "src-ag/AG2AspectAG.ag" #-} - _lhsIext - {-# LINE 1454 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _prodsOnewAtts = - ({-# LINE 66 "src-ag/AG2AspectAG.ag" #-} - _lhsInewAtts - {-# LINE 1460 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _prodsOo_rename = - ({-# LINE 38 "src-ag/AG2AspectAG.ag" #-} - _lhsIo_rename - {-# LINE 1466 "src-ag/AG2AspectAG.hs" #-} - ) - ( _prodsIhasMoreProds,_prodsIppA,_prodsIppCata,_prodsIppL,_prodsIppLI,_prodsIppR,_prodsIppRA,_prodsIppSF,_prodsIppSPF) = - prods_ _prodsOext _prodsOinh _prodsOinhNoGroup _prodsOnewAtts _prodsOnewNT _prodsOnewProds _prodsOo_rename _prodsOppNt _prodsOsyn _prodsOsynNoGroup - in ( _lhsOextendedNTs,_lhsOppA,_lhsOppAI,_lhsOppCata,_lhsOppD,_lhsOppDI,_lhsOppL,_lhsOppLI,_lhsOppNtL,_lhsOppR,_lhsOppSF,_lhsOppW))) ) --- Nonterminals ------------------------------------------------ -{- - visit 0: - inherited attributes: - derivs : Derivings - ext : Maybe String - newAtts : Attributes - newNTs : Set NontermIdent - newProds : DataTypes - o_noGroup : [String] - o_rename : Bool - tSyns : TypeSyns - synthesized attributes: - extendedNTs : Set NontermIdent - 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 - 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) -> - ( Attributes ) -> - (Set NontermIdent) -> - ( DataTypes ) -> - ([String]) -> - Bool -> - TypeSyns -> - ( (Set NontermIdent),PP_Doc,([PP_Doc]),PP_Doc,PP_Doc,([PP_Doc]),PP_Doc,([PP_Doc]),([(PP_Doc, Attributes)]),PP_Doc,PP_Doc,PP_Doc)) -data Inh_Nonterminals = Inh_Nonterminals {derivs_Inh_Nonterminals :: Derivings,ext_Inh_Nonterminals :: (Maybe String),newAtts_Inh_Nonterminals :: ( Attributes ),newNTs_Inh_Nonterminals :: (Set NontermIdent),newProds_Inh_Nonterminals :: ( DataTypes ),o_noGroup_Inh_Nonterminals :: ([String]),o_rename_Inh_Nonterminals :: Bool,tSyns_Inh_Nonterminals :: TypeSyns} -data Syn_Nonterminals = Syn_Nonterminals {extendedNTs_Syn_Nonterminals :: (Set NontermIdent),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} -wrap_Nonterminals :: T_Nonterminals -> - Inh_Nonterminals -> - Syn_Nonterminals -wrap_Nonterminals (T_Nonterminals sem ) (Inh_Nonterminals _lhsIderivs _lhsIext _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsItSyns ) = - (let ( _lhsOextendedNTs,_lhsOppA,_lhsOppAI,_lhsOppCata,_lhsOppD,_lhsOppDI,_lhsOppL,_lhsOppLI,_lhsOppNtL,_lhsOppR,_lhsOppSF,_lhsOppW) = sem _lhsIderivs _lhsIext _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsItSyns - in (Syn_Nonterminals _lhsOextendedNTs _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW )) -sem_Nonterminals_Cons :: T_Nonterminal -> - T_Nonterminals -> - T_Nonterminals -sem_Nonterminals_Cons (T_Nonterminal hd_ ) (T_Nonterminals tl_ ) = - (T_Nonterminals (\ _lhsIderivs - _lhsIext - _lhsInewAtts - _lhsInewNTs - _lhsInewProds - _lhsIo_noGroup - _lhsIo_rename - _lhsItSyns -> - (let _lhsOextendedNTs :: (Set NontermIdent) - _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 - _hdOderivs :: Derivings - _hdOext :: (Maybe String) - _hdOnewAtts :: ( Attributes ) - _hdOnewNTs :: (Set NontermIdent) - _hdOnewProds :: ( DataTypes ) - _hdOo_noGroup :: ([String]) - _hdOo_rename :: Bool - _hdOtSyns :: TypeSyns - _tlOderivs :: Derivings - _tlOext :: (Maybe String) - _tlOnewAtts :: ( Attributes ) - _tlOnewNTs :: (Set NontermIdent) - _tlOnewProds :: ( DataTypes ) - _tlOo_noGroup :: ([String]) - _tlOo_rename :: Bool - _tlOtSyns :: TypeSyns - _hdIextendedNTs :: (Set NontermIdent) - _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 - _tlIextendedNTs :: (Set NontermIdent) - _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 - -- use rule "src-ag/AG2AspectAG.ag"(line 93, column 52) - _lhsOextendedNTs = - ({-# LINE 93 "src-ag/AG2AspectAG.ag" #-} - _hdIextendedNTs `Set.union` _tlIextendedNTs - {-# LINE 1593 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 304, column 64) - _lhsOppA = - ({-# LINE 304 "src-ag/AG2AspectAG.ag" #-} - _hdIppA >-< _tlIppA - {-# LINE 1599 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 317, column 42) - _lhsOppAI = - ({-# LINE 317 "src-ag/AG2AspectAG.ag" #-} - _hdIppAI ++ _tlIppAI - {-# LINE 1605 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 700, column 67) - _lhsOppCata = - ({-# LINE 700 "src-ag/AG2AspectAG.ag" #-} - _hdIppCata >-< _tlIppCata - {-# LINE 1611 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 193, column 41) - _lhsOppD = - ({-# LINE 193 "src-ag/AG2AspectAG.ag" #-} - _hdIppD >-< _tlIppD - {-# LINE 1617 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 193, column 75) - _lhsOppDI = - ({-# LINE 193 "src-ag/AG2AspectAG.ag" #-} - _hdIppDI ++ _tlIppDI - {-# LINE 1623 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 246, column 79) - _lhsOppL = - ({-# LINE 246 "src-ag/AG2AspectAG.ag" #-} - _hdIppL >-< _tlIppL - {-# LINE 1629 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 246, column 112) - _lhsOppLI = - ({-# LINE 246 "src-ag/AG2AspectAG.ag" #-} - _hdIppLI ++ _tlIppLI - {-# LINE 1635 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 385, column 44) - _lhsOppNtL = - ({-# LINE 385 "src-ag/AG2AspectAG.ag" #-} - _hdIppNtL ++ _tlIppNtL - {-# LINE 1641 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 402, column 79) - _lhsOppR = - ({-# LINE 402 "src-ag/AG2AspectAG.ag" #-} - _hdIppR >-< _tlIppR - {-# LINE 1647 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 736, column 66) - _lhsOppSF = - ({-# LINE 736 "src-ag/AG2AspectAG.ag" #-} - _hdIppSF >-< _tlIppSF - {-# LINE 1653 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 806, column 42) - _lhsOppW = - ({-# LINE 806 "src-ag/AG2AspectAG.ag" #-} - _hdIppW >-< _tlIppW - {-# LINE 1659 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOderivs = - ({-# LINE 187 "src-ag/AG2AspectAG.ag" #-} - _lhsIderivs - {-# LINE 1665 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOext = - ({-# LINE 107 "src-ag/AG2AspectAG.ag" #-} - _lhsIext - {-# LINE 1671 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOnewAtts = - ({-# LINE 66 "src-ag/AG2AspectAG.ag" #-} - _lhsInewAtts - {-# LINE 1677 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOnewNTs = - ({-# LINE 87 "src-ag/AG2AspectAG.ag" #-} - _lhsInewNTs - {-# LINE 1683 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOnewProds = - ({-# LINE 73 "src-ag/AG2AspectAG.ag" #-} - _lhsInewProds - {-# LINE 1689 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOo_noGroup = - ({-# LINE 42 "src-ag/AG2AspectAG.ag" #-} - _lhsIo_noGroup - {-# LINE 1695 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOo_rename = - ({-# LINE 38 "src-ag/AG2AspectAG.ag" #-} - _lhsIo_rename - {-# LINE 1701 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOtSyns = - ({-# LINE 235 "src-ag/AG2AspectAG.ag" #-} - _lhsItSyns - {-# LINE 1707 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOderivs = - ({-# LINE 187 "src-ag/AG2AspectAG.ag" #-} - _lhsIderivs - {-# LINE 1713 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOext = - ({-# LINE 107 "src-ag/AG2AspectAG.ag" #-} - _lhsIext - {-# LINE 1719 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOnewAtts = - ({-# LINE 66 "src-ag/AG2AspectAG.ag" #-} - _lhsInewAtts - {-# LINE 1725 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOnewNTs = - ({-# LINE 87 "src-ag/AG2AspectAG.ag" #-} - _lhsInewNTs - {-# LINE 1731 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOnewProds = - ({-# LINE 73 "src-ag/AG2AspectAG.ag" #-} - _lhsInewProds - {-# LINE 1737 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOo_noGroup = - ({-# LINE 42 "src-ag/AG2AspectAG.ag" #-} - _lhsIo_noGroup - {-# LINE 1743 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOo_rename = - ({-# LINE 38 "src-ag/AG2AspectAG.ag" #-} - _lhsIo_rename - {-# LINE 1749 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOtSyns = - ({-# LINE 235 "src-ag/AG2AspectAG.ag" #-} - _lhsItSyns - {-# LINE 1755 "src-ag/AG2AspectAG.hs" #-} - ) - ( _hdIextendedNTs,_hdIppA,_hdIppAI,_hdIppCata,_hdIppD,_hdIppDI,_hdIppL,_hdIppLI,_hdIppNtL,_hdIppR,_hdIppSF,_hdIppW) = - hd_ _hdOderivs _hdOext _hdOnewAtts _hdOnewNTs _hdOnewProds _hdOo_noGroup _hdOo_rename _hdOtSyns - ( _tlIextendedNTs,_tlIppA,_tlIppAI,_tlIppCata,_tlIppD,_tlIppDI,_tlIppL,_tlIppLI,_tlIppNtL,_tlIppR,_tlIppSF,_tlIppW) = - tl_ _tlOderivs _tlOext _tlOnewAtts _tlOnewNTs _tlOnewProds _tlOo_noGroup _tlOo_rename _tlOtSyns - in ( _lhsOextendedNTs,_lhsOppA,_lhsOppAI,_lhsOppCata,_lhsOppD,_lhsOppDI,_lhsOppL,_lhsOppLI,_lhsOppNtL,_lhsOppR,_lhsOppSF,_lhsOppW))) ) -sem_Nonterminals_Nil :: T_Nonterminals -sem_Nonterminals_Nil = - (T_Nonterminals (\ _lhsIderivs - _lhsIext - _lhsInewAtts - _lhsInewNTs - _lhsInewProds - _lhsIo_noGroup - _lhsIo_rename - _lhsItSyns -> - (let _lhsOextendedNTs :: (Set NontermIdent) - _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 - -- use rule "src-ag/AG2AspectAG.ag"(line 93, column 52) - _lhsOextendedNTs = - ({-# LINE 93 "src-ag/AG2AspectAG.ag" #-} - Set.empty - {-# LINE 1788 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 304, column 64) - _lhsOppA = - ({-# LINE 304 "src-ag/AG2AspectAG.ag" #-} - empty - {-# LINE 1794 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 317, column 42) - _lhsOppAI = - ({-# LINE 317 "src-ag/AG2AspectAG.ag" #-} - [] - {-# LINE 1800 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 700, column 67) - _lhsOppCata = - ({-# LINE 700 "src-ag/AG2AspectAG.ag" #-} - empty - {-# LINE 1806 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 193, column 41) - _lhsOppD = - ({-# LINE 193 "src-ag/AG2AspectAG.ag" #-} - empty - {-# LINE 1812 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 193, column 75) - _lhsOppDI = - ({-# LINE 193 "src-ag/AG2AspectAG.ag" #-} - [] - {-# LINE 1818 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 246, column 79) - _lhsOppL = - ({-# LINE 246 "src-ag/AG2AspectAG.ag" #-} - empty - {-# LINE 1824 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 246, column 112) - _lhsOppLI = - ({-# LINE 246 "src-ag/AG2AspectAG.ag" #-} - [] - {-# LINE 1830 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 385, column 44) - _lhsOppNtL = - ({-# LINE 385 "src-ag/AG2AspectAG.ag" #-} - [] - {-# LINE 1836 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 402, column 79) - _lhsOppR = - ({-# LINE 402 "src-ag/AG2AspectAG.ag" #-} - empty - {-# LINE 1842 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 736, column 66) - _lhsOppSF = - ({-# LINE 736 "src-ag/AG2AspectAG.ag" #-} - empty - {-# LINE 1848 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 806, column 42) - _lhsOppW = - ({-# LINE 806 "src-ag/AG2AspectAG.ag" #-} - empty - {-# LINE 1854 "src-ag/AG2AspectAG.hs" #-} - ) - in ( _lhsOextendedNTs,_lhsOppA,_lhsOppAI,_lhsOppCata,_lhsOppD,_lhsOppDI,_lhsOppL,_lhsOppLI,_lhsOppNtL,_lhsOppR,_lhsOppSF,_lhsOppW))) ) --- Pattern ----------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - info : (Identifier, Identifier) - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern (Alias _field _attr _pat _parts ) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) -sem_Pattern (Constr _name _pats ) = - (sem_Pattern_Constr _name (sem_Patterns _pats ) ) -sem_Pattern (Irrefutable _pat ) = - (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) -sem_Pattern (Product _pos _pats ) = - (sem_Pattern_Product _pos (sem_Patterns _pats ) ) -sem_Pattern (Underscore _pos ) = - (sem_Pattern_Underscore _pos ) --- semantic domain -newtype T_Pattern = T_Pattern (( Pattern ,((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_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = - (T_Pattern (let _lhsOinfo :: ((Identifier, Identifier)) - _lhsOcopy :: Pattern - _patIcopy :: Pattern - _patIinfo :: ((Identifier, Identifier)) - _partsIcopy :: Patterns - -- "src-ag/AG2AspectAG.ag"(line 364, column 25) - _lhsOinfo = - ({-# LINE 364 "src-ag/AG2AspectAG.ag" #-} - (field_, attr_) - {-# LINE 1928 "src-ag/AG2AspectAG.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 1934 "src-ag/AG2AspectAG.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1940 "src-ag/AG2AspectAG.hs" #-} - ) - ( _patIcopy,_patIinfo) = - pat_ - ( _partsIcopy) = - parts_ - in ( _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 365, column 25) - _lhsOinfo = - ({-# LINE 365 "src-ag/AG2AspectAG.ag" #-} - error "Pattern Constr undefined!!" - {-# LINE 1958 "src-ag/AG2AspectAG.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 1964 "src-ag/AG2AspectAG.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1970 "src-ag/AG2AspectAG.hs" #-} - ) - ( _patsIcopy) = - pats_ - 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 23 "src-ag/Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 1986 "src-ag/AG2AspectAG.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1992 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (up) - _lhsOinfo = - ({-# LINE 362 "src-ag/AG2AspectAG.ag" #-} - _patIinfo - {-# LINE 1998 "src-ag/AG2AspectAG.hs" #-} - ) - ( _patIcopy,_patIinfo) = - pat_ - 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 366, column 25) - _lhsOinfo = - ({-# LINE 366 "src-ag/AG2AspectAG.ag" #-} - error "Pattern Product undefined!!" - {-# LINE 2014 "src-ag/AG2AspectAG.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 2020 "src-ag/AG2AspectAG.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 2026 "src-ag/AG2AspectAG.hs" #-} - ) - ( _patsIcopy) = - pats_ - 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 367, column 25) - _lhsOinfo = - ({-# LINE 367 "src-ag/AG2AspectAG.ag" #-} - error "Pattern Underscore undefined!!" - {-# LINE 2040 "src-ag/AG2AspectAG.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Underscore pos_ - {-# LINE 2046 "src-ag/AG2AspectAG.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 2052 "src-ag/AG2AspectAG.hs" #-} - ) - in ( _lhsOcopy,_lhsOinfo)) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - copy : SELF - 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 23 "src-ag/Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 2097 "src-ag/AG2AspectAG.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 2103 "src-ag/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 23 "src-ag/Patterns.ag" #-} - [] - {-# LINE 2117 "src-ag/AG2AspectAG.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 2123 "src-ag/AG2AspectAG.hs" #-} - ) - in ( _lhsOcopy)) ) --- Production -------------------------------------------------- -{- - visit 0: - inherited attributes: - ext : Maybe String - inh : Attributes - inhNoGroup : [String] - newAtts : Attributes - newNT : Bool - newProds : Map.Map ConstructorIdent FieldMap - o_rename : Bool - ppNt : PP_Doc - syn : Attributes - synNoGroup : [String] - synthesized attributes: - hasMoreProds : Bool - ppA : PP_Doc - ppCata : PP_Doc - ppL : PP_Doc - ppLI : [PP_Doc] - ppR : PP_Doc - ppRA : [PP_Doc] - ppSF : PP_Doc - ppSPF : PP_Doc - alternatives: - alternative Production: - child con : {ConstructorIdent} - child children : Children - child rules : Rules - child typeSigs : TypeSigs - visit 0: - local ppProd : _ - local prodName : _ - local conName : _ - local newProd : _ - local _tup1 : _ - local ppR : _ - local ppRA : _ --} --- cata -sem_Production :: Production -> - T_Production -sem_Production (Production _con _children _rules _typeSigs ) = - (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) --- semantic domain -newtype T_Production = T_Production ((Maybe String) -> - ( Attributes ) -> - ([String]) -> - ( Attributes ) -> - Bool -> - ( Map.Map ConstructorIdent FieldMap ) -> - Bool -> - PP_Doc -> - ( Attributes ) -> - ([String]) -> - ( ( Bool ),PP_Doc,PP_Doc,PP_Doc,([PP_Doc]),PP_Doc,([PP_Doc]),PP_Doc,PP_Doc)) -data Inh_Production = Inh_Production {ext_Inh_Production :: (Maybe String),inh_Inh_Production :: ( Attributes ),inhNoGroup_Inh_Production :: ([String]),newAtts_Inh_Production :: ( Attributes ),newNT_Inh_Production :: Bool,newProds_Inh_Production :: ( Map.Map ConstructorIdent FieldMap ),o_rename_Inh_Production :: Bool,ppNt_Inh_Production :: PP_Doc,syn_Inh_Production :: ( Attributes ),synNoGroup_Inh_Production :: ([String])} -data Syn_Production = Syn_Production {hasMoreProds_Syn_Production :: ( Bool ),ppA_Syn_Production :: PP_Doc,ppCata_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} -wrap_Production :: T_Production -> - Inh_Production -> - Syn_Production -wrap_Production (T_Production sem ) (Inh_Production _lhsIext _lhsIinh _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynNoGroup ) = - (let ( _lhsOhasMoreProds,_lhsOppA,_lhsOppCata,_lhsOppL,_lhsOppLI,_lhsOppR,_lhsOppRA,_lhsOppSF,_lhsOppSPF) = sem _lhsIext _lhsIinh _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynNoGroup - in (Syn_Production _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF )) -sem_Production_Production :: ConstructorIdent -> - T_Children -> - T_Rules -> - T_TypeSigs -> - T_Production -sem_Production_Production con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) = - (T_Production (\ _lhsIext - _lhsIinh - _lhsIinhNoGroup - _lhsInewAtts - _lhsInewNT - _lhsInewProds - _lhsIo_rename - _lhsIppNt - _lhsIsyn - _lhsIsynNoGroup -> - (let _lhsOhasMoreProds :: ( Bool ) - _childrenOppProd :: PP_Doc - _rulesOppProd :: PP_Doc - _lhsOppL :: PP_Doc - _lhsOppLI :: ([PP_Doc]) - _lhsOppA :: PP_Doc - _lhsOppCata :: PP_Doc - _lhsOppSF :: PP_Doc - _lhsOppSPF :: PP_Doc - _lhsOppR :: PP_Doc - _lhsOppRA :: ([PP_Doc]) - _childrenOext :: (Maybe String) - _childrenOinhNoGroup :: ([String]) - _childrenOo_rename :: Bool - _childrenOppNt :: PP_Doc - _childrenOsynNoGroup :: ([String]) - _rulesOext :: (Maybe String) - _rulesOinhNoGroup :: ([String]) - _rulesOppNt :: PP_Doc - _rulesOsynNoGroup :: ([String]) - _childrenIidCL :: ([(Identifier,Type)]) - _childrenIppCSF :: ([(Identifier,(PP_Doc,PP_Doc))]) - _childrenIppL :: PP_Doc - _childrenIppLI :: ([PP_Doc]) - _childrenIppR :: PP_Doc - _rulesIlocals :: ([Identifier]) - _rulesIppRL :: ([ PPRule ]) - -- "src-ag/AG2AspectAG.ag"(line 91, column 29) - _lhsOhasMoreProds = - ({-# LINE 91 "src-ag/AG2AspectAG.ag" #-} - not $ Map.member con_ _lhsInewProds - {-# LINE 2237 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 164, column 25) - _ppProd = - ({-# LINE 164 "src-ag/AG2AspectAG.ag" #-} - pp con_ - {-# LINE 2243 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 165, column 25) - _prodName = - ({-# LINE 165 "src-ag/AG2AspectAG.ag" #-} - ppName [_lhsIppNt, _ppProd ] - {-# LINE 2249 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 166, column 25) - _conName = - ({-# LINE 166 "src-ag/AG2AspectAG.ag" #-} - if _lhsIo_rename - then _prodName - else _ppProd - {-# LINE 2257 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 183, column 25) - _childrenOppProd = - ({-# LINE 183 "src-ag/AG2AspectAG.ag" #-} - _ppProd - {-# LINE 2263 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 184, column 25) - _rulesOppProd = - ({-# LINE 184 "src-ag/AG2AspectAG.ag" #-} - _ppProd - {-# LINE 2269 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 262, column 25) - _lhsOppL = - ({-# LINE 262 "src-ag/AG2AspectAG.ag" #-} - if (Map.member con_ _lhsInewProds) - then _childrenIppL - else empty - {-# LINE 2277 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 266, column 25) - _lhsOppLI = - ({-# LINE 266 "src-ag/AG2AspectAG.ag" #-} - if (not $ Map.member con_ _lhsInewProds) - then _childrenIppLI - else [] - {-# LINE 2285 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 314, column 25) - _lhsOppA = - ({-# LINE 314 "src-ag/AG2AspectAG.ag" #-} - defLocalAtts _prodName (length _rulesIlocals) 1 $ sort _rulesIlocals - {-# LINE 2291 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 412, column 25) - _newProd = - ({-# LINE 412 "src-ag/AG2AspectAG.ag" #-} - Map.member con_ _lhsInewProds - {-# LINE 2297 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 413, column 41) - __tup1 = - ({-# LINE 413 "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 2320 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 413, column 41) - (_ppR,_) = - ({-# LINE 413 "src-ag/AG2AspectAG.ag" #-} - __tup1 - {-# LINE 2326 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 413, column 41) - (_,_ppRA) = - ({-# LINE 413 "src-ag/AG2AspectAG.ag" #-} - __tup1 - {-# LINE 2332 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 707, column 25) - _lhsOppCata = - ({-# LINE 707 "src-ag/AG2AspectAG.ag" #-} - let extend = maybe [] - ( \ext -> if (_lhsInewNT || (not _lhsInewNT && _newProd )) - then [] - else [ ext >|< ".atts_" >|< _prodName ]) - _lhsIext - in "atts_" >|< _prodName >|< " = " >|< - ppListSep "" "" " `ext` " - (_ppRA ++ extend ) >-< - "sem_" >|< _prodName >|< pp " = knit atts_" >|< _prodName - {-# LINE 2346 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 766, column 25) - _lhsOppSF = - ({-# LINE 766 "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 2359 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 778, column 25) - _lhsOppSPF = - ({-# LINE 778 "src-ag/AG2AspectAG.ag" #-} - let chi = _childrenIppCSF - ppParams f = f $ map (((>|<) (pp "_")) . fst) chi - in "semP_" >|< _lhsIppNt >|< "_" >|< con_ >#< ppParams ppSpaced >|< " = sem_" >|< _prodName >|< - " (" >|< map (snd . snd) chi >|< "emptyRecord)" - {-# LINE 2368 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 402, column 79) - _lhsOppR = - ({-# LINE 402 "src-ag/AG2AspectAG.ag" #-} - _ppR - {-# LINE 2374 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 403, column 43) - _lhsOppRA = - ({-# LINE 403 "src-ag/AG2AspectAG.ag" #-} - _ppRA - {-# LINE 2380 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _childrenOext = - ({-# LINE 107 "src-ag/AG2AspectAG.ag" #-} - _lhsIext - {-# LINE 2386 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _childrenOinhNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIinhNoGroup - {-# LINE 2392 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _childrenOo_rename = - ({-# LINE 38 "src-ag/AG2AspectAG.ag" #-} - _lhsIo_rename - {-# LINE 2398 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _childrenOppNt = - ({-# LINE 175 "src-ag/AG2AspectAG.ag" #-} - _lhsIppNt - {-# LINE 2404 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _childrenOsynNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIsynNoGroup - {-# LINE 2410 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _rulesOext = - ({-# LINE 107 "src-ag/AG2AspectAG.ag" #-} - _lhsIext - {-# LINE 2416 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _rulesOinhNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIinhNoGroup - {-# LINE 2422 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _rulesOppNt = - ({-# LINE 175 "src-ag/AG2AspectAG.ag" #-} - _lhsIppNt - {-# LINE 2428 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _rulesOsynNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIsynNoGroup - {-# LINE 2434 "src-ag/AG2AspectAG.hs" #-} - ) - ( _childrenIidCL,_childrenIppCSF,_childrenIppL,_childrenIppLI,_childrenIppR) = - children_ _childrenOext _childrenOinhNoGroup _childrenOo_rename _childrenOppNt _childrenOppProd _childrenOsynNoGroup - ( _rulesIlocals,_rulesIppRL) = - rules_ _rulesOext _rulesOinhNoGroup _rulesOppNt _rulesOppProd _rulesOsynNoGroup - in ( _lhsOhasMoreProds,_lhsOppA,_lhsOppCata,_lhsOppL,_lhsOppLI,_lhsOppR,_lhsOppRA,_lhsOppSF,_lhsOppSPF))) ) --- Productions ------------------------------------------------- -{- - visit 0: - inherited attributes: - ext : Maybe String - inh : Attributes - inhNoGroup : [String] - newAtts : Attributes - newNT : Bool - newProds : Map.Map ConstructorIdent FieldMap - o_rename : Bool - ppNt : PP_Doc - syn : Attributes - synNoGroup : [String] - synthesized attributes: - hasMoreProds : Bool - ppA : PP_Doc - ppCata : PP_Doc - ppL : PP_Doc - ppLI : [PP_Doc] - ppR : PP_Doc - ppRA : [PP_Doc] - ppSF : PP_Doc - ppSPF : 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 ((Maybe String) -> - ( Attributes ) -> - ([String]) -> - ( Attributes ) -> - Bool -> - ( Map.Map ConstructorIdent FieldMap ) -> - Bool -> - PP_Doc -> - ( Attributes ) -> - ([String]) -> - ( ( Bool ),PP_Doc,PP_Doc,PP_Doc,([PP_Doc]),PP_Doc,([PP_Doc]),PP_Doc,PP_Doc)) -data Inh_Productions = Inh_Productions {ext_Inh_Productions :: (Maybe String),inh_Inh_Productions :: ( Attributes ),inhNoGroup_Inh_Productions :: ([String]),newAtts_Inh_Productions :: ( Attributes ),newNT_Inh_Productions :: Bool,newProds_Inh_Productions :: ( Map.Map ConstructorIdent FieldMap ),o_rename_Inh_Productions :: Bool,ppNt_Inh_Productions :: PP_Doc,syn_Inh_Productions :: ( Attributes ),synNoGroup_Inh_Productions :: ([String])} -data Syn_Productions = Syn_Productions {hasMoreProds_Syn_Productions :: ( Bool ),ppA_Syn_Productions :: PP_Doc,ppCata_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} -wrap_Productions :: T_Productions -> - Inh_Productions -> - Syn_Productions -wrap_Productions (T_Productions sem ) (Inh_Productions _lhsIext _lhsIinh _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynNoGroup ) = - (let ( _lhsOhasMoreProds,_lhsOppA,_lhsOppCata,_lhsOppL,_lhsOppLI,_lhsOppR,_lhsOppRA,_lhsOppSF,_lhsOppSPF) = sem _lhsIext _lhsIinh _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynNoGroup - in (Syn_Productions _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF )) -sem_Productions_Cons :: T_Production -> - T_Productions -> - T_Productions -sem_Productions_Cons (T_Production hd_ ) (T_Productions tl_ ) = - (T_Productions (\ _lhsIext - _lhsIinh - _lhsIinhNoGroup - _lhsInewAtts - _lhsInewNT - _lhsInewProds - _lhsIo_rename - _lhsIppNt - _lhsIsyn - _lhsIsynNoGroup -> - (let _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 - _hdOext :: (Maybe String) - _hdOinh :: ( Attributes ) - _hdOinhNoGroup :: ([String]) - _hdOnewAtts :: ( Attributes ) - _hdOnewNT :: Bool - _hdOnewProds :: ( Map.Map ConstructorIdent FieldMap ) - _hdOo_rename :: Bool - _hdOppNt :: PP_Doc - _hdOsyn :: ( Attributes ) - _hdOsynNoGroup :: ([String]) - _tlOext :: (Maybe String) - _tlOinh :: ( Attributes ) - _tlOinhNoGroup :: ([String]) - _tlOnewAtts :: ( Attributes ) - _tlOnewNT :: Bool - _tlOnewProds :: ( Map.Map ConstructorIdent FieldMap ) - _tlOo_rename :: Bool - _tlOppNt :: PP_Doc - _tlOsyn :: ( Attributes ) - _tlOsynNoGroup :: ([String]) - _hdIhasMoreProds :: ( Bool ) - _hdIppA :: PP_Doc - _hdIppCata :: PP_Doc - _hdIppL :: PP_Doc - _hdIppLI :: ([PP_Doc]) - _hdIppR :: PP_Doc - _hdIppRA :: ([PP_Doc]) - _hdIppSF :: PP_Doc - _hdIppSPF :: PP_Doc - _tlIhasMoreProds :: ( Bool ) - _tlIppA :: PP_Doc - _tlIppCata :: PP_Doc - _tlIppL :: PP_Doc - _tlIppLI :: ([PP_Doc]) - _tlIppR :: PP_Doc - _tlIppRA :: ([PP_Doc]) - _tlIppSF :: PP_Doc - _tlIppSPF :: PP_Doc - -- use rule "src-ag/AG2AspectAG.ag"(line 89, column 51) - _lhsOhasMoreProds = - ({-# LINE 89 "src-ag/AG2AspectAG.ag" #-} - _hdIhasMoreProds || _tlIhasMoreProds - {-# LINE 2561 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 304, column 64) - _lhsOppA = - ({-# LINE 304 "src-ag/AG2AspectAG.ag" #-} - _hdIppA >-< _tlIppA - {-# LINE 2567 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 700, column 67) - _lhsOppCata = - ({-# LINE 700 "src-ag/AG2AspectAG.ag" #-} - _hdIppCata >-< _tlIppCata - {-# LINE 2573 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 246, column 79) - _lhsOppL = - ({-# LINE 246 "src-ag/AG2AspectAG.ag" #-} - _hdIppL >-< _tlIppL - {-# LINE 2579 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 246, column 112) - _lhsOppLI = - ({-# LINE 246 "src-ag/AG2AspectAG.ag" #-} - _hdIppLI ++ _tlIppLI - {-# LINE 2585 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 402, column 79) - _lhsOppR = - ({-# LINE 402 "src-ag/AG2AspectAG.ag" #-} - _hdIppR >-< _tlIppR - {-# LINE 2591 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 403, column 43) - _lhsOppRA = - ({-# LINE 403 "src-ag/AG2AspectAG.ag" #-} - _hdIppRA ++ _tlIppRA - {-# LINE 2597 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 736, column 66) - _lhsOppSF = - ({-# LINE 736 "src-ag/AG2AspectAG.ag" #-} - _hdIppSF >-< _tlIppSF - {-# LINE 2603 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 737, column 42) - _lhsOppSPF = - ({-# LINE 737 "src-ag/AG2AspectAG.ag" #-} - _hdIppSPF >-< _tlIppSPF - {-# LINE 2609 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOext = - ({-# LINE 107 "src-ag/AG2AspectAG.ag" #-} - _lhsIext - {-# LINE 2615 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOinh = - ({-# LINE 726 "src-ag/AG2AspectAG.ag" #-} - _lhsIinh - {-# LINE 2621 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOinhNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIinhNoGroup - {-# LINE 2627 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOnewAtts = - ({-# LINE 66 "src-ag/AG2AspectAG.ag" #-} - _lhsInewAtts - {-# LINE 2633 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOnewNT = - ({-# LINE 396 "src-ag/AG2AspectAG.ag" #-} - _lhsInewNT - {-# LINE 2639 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOnewProds = - ({-# LINE 74 "src-ag/AG2AspectAG.ag" #-} - _lhsInewProds - {-# LINE 2645 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOo_rename = - ({-# LINE 38 "src-ag/AG2AspectAG.ag" #-} - _lhsIo_rename - {-# LINE 2651 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOppNt = - ({-# LINE 175 "src-ag/AG2AspectAG.ag" #-} - _lhsIppNt - {-# LINE 2657 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOsyn = - ({-# LINE 726 "src-ag/AG2AspectAG.ag" #-} - _lhsIsyn - {-# LINE 2663 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOsynNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIsynNoGroup - {-# LINE 2669 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOext = - ({-# LINE 107 "src-ag/AG2AspectAG.ag" #-} - _lhsIext - {-# LINE 2675 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOinh = - ({-# LINE 726 "src-ag/AG2AspectAG.ag" #-} - _lhsIinh - {-# LINE 2681 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOinhNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIinhNoGroup - {-# LINE 2687 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOnewAtts = - ({-# LINE 66 "src-ag/AG2AspectAG.ag" #-} - _lhsInewAtts - {-# LINE 2693 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOnewNT = - ({-# LINE 396 "src-ag/AG2AspectAG.ag" #-} - _lhsInewNT - {-# LINE 2699 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOnewProds = - ({-# LINE 74 "src-ag/AG2AspectAG.ag" #-} - _lhsInewProds - {-# LINE 2705 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOo_rename = - ({-# LINE 38 "src-ag/AG2AspectAG.ag" #-} - _lhsIo_rename - {-# LINE 2711 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOppNt = - ({-# LINE 175 "src-ag/AG2AspectAG.ag" #-} - _lhsIppNt - {-# LINE 2717 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOsyn = - ({-# LINE 726 "src-ag/AG2AspectAG.ag" #-} - _lhsIsyn - {-# LINE 2723 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOsynNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIsynNoGroup - {-# LINE 2729 "src-ag/AG2AspectAG.hs" #-} - ) - ( _hdIhasMoreProds,_hdIppA,_hdIppCata,_hdIppL,_hdIppLI,_hdIppR,_hdIppRA,_hdIppSF,_hdIppSPF) = - hd_ _hdOext _hdOinh _hdOinhNoGroup _hdOnewAtts _hdOnewNT _hdOnewProds _hdOo_rename _hdOppNt _hdOsyn _hdOsynNoGroup - ( _tlIhasMoreProds,_tlIppA,_tlIppCata,_tlIppL,_tlIppLI,_tlIppR,_tlIppRA,_tlIppSF,_tlIppSPF) = - tl_ _tlOext _tlOinh _tlOinhNoGroup _tlOnewAtts _tlOnewNT _tlOnewProds _tlOo_rename _tlOppNt _tlOsyn _tlOsynNoGroup - in ( _lhsOhasMoreProds,_lhsOppA,_lhsOppCata,_lhsOppL,_lhsOppLI,_lhsOppR,_lhsOppRA,_lhsOppSF,_lhsOppSPF))) ) -sem_Productions_Nil :: T_Productions -sem_Productions_Nil = - (T_Productions (\ _lhsIext - _lhsIinh - _lhsIinhNoGroup - _lhsInewAtts - _lhsInewNT - _lhsInewProds - _lhsIo_rename - _lhsIppNt - _lhsIsyn - _lhsIsynNoGroup -> - (let _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 - -- use rule "src-ag/AG2AspectAG.ag"(line 89, column 51) - _lhsOhasMoreProds = - ({-# LINE 89 "src-ag/AG2AspectAG.ag" #-} - False - {-# LINE 2761 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 304, column 64) - _lhsOppA = - ({-# LINE 304 "src-ag/AG2AspectAG.ag" #-} - empty - {-# LINE 2767 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 700, column 67) - _lhsOppCata = - ({-# LINE 700 "src-ag/AG2AspectAG.ag" #-} - empty - {-# LINE 2773 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 246, column 79) - _lhsOppL = - ({-# LINE 246 "src-ag/AG2AspectAG.ag" #-} - empty - {-# LINE 2779 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 246, column 112) - _lhsOppLI = - ({-# LINE 246 "src-ag/AG2AspectAG.ag" #-} - [] - {-# LINE 2785 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 402, column 79) - _lhsOppR = - ({-# LINE 402 "src-ag/AG2AspectAG.ag" #-} - empty - {-# LINE 2791 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 403, column 43) - _lhsOppRA = - ({-# LINE 403 "src-ag/AG2AspectAG.ag" #-} - [] - {-# LINE 2797 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 736, column 66) - _lhsOppSF = - ({-# LINE 736 "src-ag/AG2AspectAG.ag" #-} - empty - {-# LINE 2803 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 737, column 42) - _lhsOppSPF = - ({-# LINE 737 "src-ag/AG2AspectAG.ag" #-} - empty - {-# LINE 2809 "src-ag/AG2AspectAG.hs" #-} - ) - in ( _lhsOhasMoreProds,_lhsOppA,_lhsOppCata,_lhsOppL,_lhsOppLI,_lhsOppR,_lhsOppRA,_lhsOppSF,_lhsOppSPF))) ) --- Rule -------------------------------------------------------- -{- - visit 0: - inherited attributes: - ext : Maybe String - inhNoGroup : [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} --} --- cata -sem_Rule :: Rule -> - T_Rule -sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit ) = - (sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) --- semantic domain -newtype T_Rule = T_Rule ((Maybe String) -> - ([String]) -> - PP_Doc -> - PP_Doc -> - ([String]) -> - ( ([Identifier]),([ PPRule ]))) -data Inh_Rule = Inh_Rule {ext_Inh_Rule :: (Maybe String),inhNoGroup_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 _lhsIppNt _lhsIppProd _lhsIsynNoGroup ) = - (let ( _lhsOlocals,_lhsOppRL) = sem _lhsIext _lhsIinhNoGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup - in (Syn_Rule _lhsOlocals _lhsOppRL )) -sem_Rule_Rule :: (Maybe Identifier) -> - T_Pattern -> - T_Expression -> - Bool -> - String -> - Bool -> - T_Rule -sem_Rule_Rule mbName_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ = - (T_Rule (\ _lhsIext - _lhsIinhNoGroup - _lhsIppNt - _lhsIppProd - _lhsIsynNoGroup -> - (let _lhsOlocals :: ([Identifier]) - _lhsOppRL :: ([ PPRule ]) - _rhsOppNt :: PP_Doc - _rhsOppProd :: PP_Doc - _patternIcopy :: Pattern - _patternIinfo :: ((Identifier, Identifier)) - _rhsIppRE :: (Identifier -> [String] -> [String] -> [(Identifier,Type)] -> [Identifier] -> PP_Doc) - -- "src-ag/AG2AspectAG.ag"(line 357, column 25) - _lhsOlocals = - ({-# LINE 357 "src-ag/AG2AspectAG.ag" #-} - if (show (fst _patternIinfo) == "loc") - then [ snd _patternIinfo ] - else [ ] - {-# LINE 2879 "src-ag/AG2AspectAG.hs" #-} - ) - -- "src-ag/AG2AspectAG.ag"(line 456, column 33) - _lhsOppRL = - ({-# LINE 456 "src-ag/AG2AspectAG.ag" #-} - [ ppRule _patternIinfo owrt_ (defRule _lhsIppNt _patternIinfo _lhsIinhNoGroup _lhsIsynNoGroup _rhsIppRE) ] - {-# LINE 2885 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _rhsOppNt = - ({-# LINE 175 "src-ag/AG2AspectAG.ag" #-} - _lhsIppNt - {-# LINE 2891 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _rhsOppProd = - ({-# LINE 180 "src-ag/AG2AspectAG.ag" #-} - _lhsIppProd - {-# LINE 2897 "src-ag/AG2AspectAG.hs" #-} - ) - ( _patternIcopy,_patternIinfo) = - pattern_ - ( _rhsIppRE) = - rhs_ _rhsOppNt _rhsOppProd - in ( _lhsOlocals,_lhsOppRL))) ) --- Rules ------------------------------------------------------- -{- - visit 0: - inherited attributes: - ext : Maybe String - inhNoGroup : [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]) -> - PP_Doc -> - PP_Doc -> - ([String]) -> - ( ([Identifier]),([ PPRule ]))) -data Inh_Rules = Inh_Rules {ext_Inh_Rules :: (Maybe String),inhNoGroup_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 _lhsIppNt _lhsIppProd _lhsIsynNoGroup ) = - (let ( _lhsOlocals,_lhsOppRL) = sem _lhsIext _lhsIinhNoGroup _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 - _lhsIppNt - _lhsIppProd - _lhsIsynNoGroup -> - (let _lhsOppRL :: ([ PPRule ]) - _lhsOlocals :: ([Identifier]) - _hdOext :: (Maybe String) - _hdOinhNoGroup :: ([String]) - _hdOppNt :: PP_Doc - _hdOppProd :: PP_Doc - _hdOsynNoGroup :: ([String]) - _tlOext :: (Maybe String) - _tlOinhNoGroup :: ([String]) - _tlOppNt :: PP_Doc - _tlOppProd :: PP_Doc - _tlOsynNoGroup :: ([String]) - _hdIlocals :: ([Identifier]) - _hdIppRL :: ([ PPRule ]) - _tlIlocals :: ([Identifier]) - _tlIppRL :: ([ PPRule ]) - -- "src-ag/AG2AspectAG.ag"(line 452, column 33) - _lhsOppRL = - ({-# LINE 452 "src-ag/AG2AspectAG.ag" #-} - _hdIppRL ++ _tlIppRL - {-# LINE 2971 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 353, column 30) - _lhsOlocals = - ({-# LINE 353 "src-ag/AG2AspectAG.ag" #-} - _hdIlocals ++ _tlIlocals - {-# LINE 2977 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOext = - ({-# LINE 107 "src-ag/AG2AspectAG.ag" #-} - _lhsIext - {-# LINE 2983 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOinhNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIinhNoGroup - {-# LINE 2989 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOppNt = - ({-# LINE 175 "src-ag/AG2AspectAG.ag" #-} - _lhsIppNt - {-# LINE 2995 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOppProd = - ({-# LINE 180 "src-ag/AG2AspectAG.ag" #-} - _lhsIppProd - {-# LINE 3001 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _hdOsynNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIsynNoGroup - {-# LINE 3007 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOext = - ({-# LINE 107 "src-ag/AG2AspectAG.ag" #-} - _lhsIext - {-# LINE 3013 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOinhNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIinhNoGroup - {-# LINE 3019 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOppNt = - ({-# LINE 175 "src-ag/AG2AspectAG.ag" #-} - _lhsIppNt - {-# LINE 3025 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOppProd = - ({-# LINE 180 "src-ag/AG2AspectAG.ag" #-} - _lhsIppProd - {-# LINE 3031 "src-ag/AG2AspectAG.hs" #-} - ) - -- copy rule (down) - _tlOsynNoGroup = - ({-# LINE 52 "src-ag/AG2AspectAG.ag" #-} - _lhsIsynNoGroup - {-# LINE 3037 "src-ag/AG2AspectAG.hs" #-} - ) - ( _hdIlocals,_hdIppRL) = - hd_ _hdOext _hdOinhNoGroup _hdOppNt _hdOppProd _hdOsynNoGroup - ( _tlIlocals,_tlIppRL) = - tl_ _tlOext _tlOinhNoGroup _tlOppNt _tlOppProd _tlOsynNoGroup - in ( _lhsOlocals,_lhsOppRL))) ) -sem_Rules_Nil :: T_Rules -sem_Rules_Nil = - (T_Rules (\ _lhsIext - _lhsIinhNoGroup - _lhsIppNt - _lhsIppProd - _lhsIsynNoGroup -> - (let _lhsOppRL :: ([ PPRule ]) - _lhsOlocals :: ([Identifier]) - -- "src-ag/AG2AspectAG.ag"(line 453, column 33) - _lhsOppRL = - ({-# LINE 453 "src-ag/AG2AspectAG.ag" #-} - [] - {-# LINE 3057 "src-ag/AG2AspectAG.hs" #-} - ) - -- use rule "src-ag/AG2AspectAG.ag"(line 353, column 30) - _lhsOlocals = - ({-# LINE 353 "src-ag/AG2AspectAG.ag" #-} - [] - {-# LINE 3063 "src-ag/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/uuagc/uuagc-tmp/AbstractSyntax.hs b/dist/build/uuagc/uuagc-tmp/AbstractSyntax.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/AbstractSyntax.hs +++ /dev/null @@ -1,130 +0,0 @@ - - --- UUAGC 0.9.39.0.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 CommonTypes -{-# LINE 14 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AbstractSyntax.hs" #-} --- Child ------------------------------------------------------- -{- - alternatives: - alternative Child: - child name : {Identifier} - child tp : {Type} - child inh : {Attributes} - child syn : {Attributes} - child virtual : {Maybe (Maybe Type)} --} -data Child = Child (Identifier) (Type) (Attributes) (Attributes) ((Maybe (Maybe Type))) --- 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 children : Children - child rules : Rules - child typeSigs : TypeSigs --} -data Production = Production (ConstructorIdent) (Children ) (Rules ) (TypeSigs ) --- 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} --} -data Rule = Rule ((Maybe Identifier)) (Pattern) (Expression) (Bool) (String) (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/uuagc/uuagc-tmp/AbstractSyntaxDump.hs b/dist/build/uuagc/uuagc-tmp/AbstractSyntaxDump.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/AbstractSyntaxDump.hs +++ /dev/null @@ -1,1035 +0,0 @@ - - --- UUAGC 0.9.39.0.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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 CommonTypes -{-# LINE 26 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AbstractSyntaxDump.hs" #-} - -{-# LINE 2 "src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 33 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AbstractSyntaxDump.hs" #-} - -{-# LINE 2 "src-ag/Expression.ag" #-} - -import UU.Scanner.Position(Pos) -import HsToken -{-# LINE 39 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/AbstractSyntaxDump.hs" #-} --- Child ------------------------------------------------------- -{- - visit 0: - synthesized attribute: - pp : PP_Doc - alternatives: - alternative Child: - child name : {Identifier} - child tp : {Type} - child inh : {Attributes} - child syn : {Attributes} - child virtual : {Maybe (Maybe Type)} --} --- cata -sem_Child :: Child -> - T_Child -sem_Child (Child _name _tp _inh _syn _virtual ) = - (sem_Child_Child _name _tp _inh _syn _virtual ) --- semantic domain -newtype T_Child = T_Child (( 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 -> - Attributes -> - Attributes -> - (Maybe (Maybe Type)) -> - T_Child -sem_Child_Child name_ tp_ inh_ syn_ virtual_ = - (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 "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_] [] - {-# LINE 80 "src-ag/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 123 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- use rule "src-ag/AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - ({-# LINE 17 "src-ag/AbstractSyntaxDump.ag" #-} - _hdIpp >-< _tlIpp - {-# LINE 129 "src-ag/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 144 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- use rule "src-ag/AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - ({-# LINE 17 "src-ag/AbstractSyntaxDump.ag" #-} - empty - {-# LINE 150 "src-ag/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 187 "src-ag/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 256 "src-ag/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 303 "src-ag/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 348 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- use rule "src-ag/AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - ({-# LINE 17 "src-ag/AbstractSyntaxDump.ag" #-} - _hdIpp >-< _tlIpp - {-# LINE 354 "src-ag/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 369 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- use rule "src-ag/AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - ({-# LINE 17 "src-ag/AbstractSyntaxDump.ag" #-} - empty - {-# LINE 375 "src-ag/AbstractSyntaxDump.hs" #-} - ) - in ( _lhsOpp,_lhsOppL)) ) --- Pattern ----------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - pp : PP_Doc - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern (Alias _field _attr _pat _parts ) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) -sem_Pattern (Constr _name _pats ) = - (sem_Pattern_Constr _name (sem_Patterns _pats ) ) -sem_Pattern (Irrefutable _pat ) = - (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) -sem_Pattern (Product _pos _pats ) = - (sem_Pattern_Product _pos (sem_Patterns _pats ) ) -sem_Pattern (Underscore _pos ) = - (sem_Pattern_Underscore _pos ) --- semantic domain -newtype T_Pattern = T_Pattern (( Pattern ,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_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = - (T_Pattern (let _lhsOpp :: PP_Doc - _lhsOcopy :: Pattern - _patIcopy :: Pattern - _patIpp :: PP_Doc - _partsIcopy :: Patterns - _partsIpp :: PP_Doc - _partsIppL :: ([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 451 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 457 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 463 "src-ag/AbstractSyntaxDump.hs" #-} - ) - ( _patIcopy,_patIpp) = - pat_ - ( _partsIcopy,_partsIpp,_partsIppL) = - parts_ - in ( _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 483 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 489 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 495 "src-ag/AbstractSyntaxDump.hs" #-} - ) - ( _patsIcopy,_patsIpp,_patsIppL) = - pats_ - 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 511 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 517 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 523 "src-ag/AbstractSyntaxDump.hs" #-} - ) - ( _patIcopy,_patIpp) = - pat_ - 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 541 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 547 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 553 "src-ag/AbstractSyntaxDump.hs" #-} - ) - ( _patsIcopy,_patsIpp,_patsIppL) = - pats_ - 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 567 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Underscore pos_ - {-# LINE 573 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 579 "src-ag/AbstractSyntaxDump.hs" #-} - ) - in ( _lhsOcopy,_lhsOpp)) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - 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 630 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- use rule "src-ag/AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - ({-# LINE 17 "src-ag/AbstractSyntaxDump.ag" #-} - _hdIpp >-< _tlIpp - {-# LINE 636 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 642 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 648 "src-ag/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 664 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- use rule "src-ag/AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - ({-# LINE 17 "src-ag/AbstractSyntaxDump.ag" #-} - empty - {-# LINE 670 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - [] - {-# LINE 676 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 682 "src-ag/AbstractSyntaxDump.hs" #-} - ) - in ( _lhsOcopy,_lhsOpp,_lhsOppL)) ) --- Production -------------------------------------------------- -{- - visit 0: - synthesized attribute: - pp : PP_Doc - alternatives: - alternative Production: - child con : {ConstructorIdent} - child children : Children - child rules : Rules - child typeSigs : TypeSigs --} --- cata -sem_Production :: Production -> - T_Production -sem_Production (Production _con _children _rules _typeSigs ) = - (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) --- semantic domain -newtype T_Production = T_Production (( 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 -> - T_Children -> - T_Rules -> - T_TypeSigs -> - T_Production -sem_Production_Production con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) = - (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 729 "src-ag/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 778 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- use rule "src-ag/AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - ({-# LINE 17 "src-ag/AbstractSyntaxDump.ag" #-} - _hdIpp >-< _tlIpp - {-# LINE 784 "src-ag/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 799 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- use rule "src-ag/AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - ({-# LINE 17 "src-ag/AbstractSyntaxDump.ag" #-} - empty - {-# LINE 805 "src-ag/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} --} --- cata -sem_Rule :: Rule -> - T_Rule -sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit ) = - (sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) --- 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 -> - T_Rule -sem_Rule_Rule mbName_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ = - (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 853 "src-ag/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 900 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- use rule "src-ag/AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - ({-# LINE 17 "src-ag/AbstractSyntaxDump.ag" #-} - _hdIpp >-< _tlIpp - {-# LINE 906 "src-ag/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 921 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- use rule "src-ag/AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - ({-# LINE 17 "src-ag/AbstractSyntaxDump.ag" #-} - empty - {-# LINE 927 "src-ag/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 964 "src-ag/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 1007 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- use rule "src-ag/AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - ({-# LINE 17 "src-ag/AbstractSyntaxDump.ag" #-} - _hdIpp >-< _tlIpp - {-# LINE 1013 "src-ag/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 1028 "src-ag/AbstractSyntaxDump.hs" #-} - ) - -- use rule "src-ag/AbstractSyntaxDump.ag"(line 17, column 58) - _lhsOpp = - ({-# LINE 17 "src-ag/AbstractSyntaxDump.ag" #-} - empty - {-# LINE 1034 "src-ag/AbstractSyntaxDump.hs" #-} - ) - in ( _lhsOpp,_lhsOppL)) ) diff --git a/dist/build/uuagc/uuagc-tmp/Code.hs b/dist/build/uuagc/uuagc-tmp/Code.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/Code.hs +++ /dev/null @@ -1,352 +0,0 @@ - - --- UUAGC 0.9.39.0.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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Code.hs" #-} -{-# LINE 145 "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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 Bind: - child left : Lhs - child rhs : Expr - alternative BindLet: - child left : Lhs - child rhs : Expr - alternative Comment: - child txt : {String} - alternative Data: - child name : {String} - child params : {[String]} - child alts : DataAlts - child strict : {Bool} - child derivings : {[String]} - alternative Decl: - child left : Lhs - child rhs : Expr - child binds : {Set String} - child uses : {Set String} - alternative EvalDecl: - child nt : {String} - child left : Lhs - child rhs : Expr - alternative NewType: - child name : {String} - child params : {[String]} - child con : {String} - child tp : Type - alternative PragmaDecl: - child txt : {String} - alternative Resume: - child monadic : {Bool} - child nt : {String} - child left : Lhs - child rhs : Expr - alternative TSig: - child name : {String} - child tp : Type - alternative Type: - child name : {String} - child params : {[String]} - child tp : Type --} -data Decl = Bind (Lhs ) (Expr ) - | BindLet (Lhs ) (Expr ) - | Comment (String) - | Data (String) (([String])) (DataAlts ) (Bool) (([String])) - | Decl (Lhs ) (Expr ) ((Set String)) ((Set String)) - | EvalDecl (String) (Lhs ) (Expr ) - | NewType (String) (([String])) (String) (Type ) - | PragmaDecl (String) - | Resume (Bool) (String) (Lhs ) (Expr ) - | TSig (String) (Type ) - | Type (String) (([String])) (Type ) --- Decls ------------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : Decl - child tl : Decls - alternative Nil: --} -type Decls = [Decl ] --- Expr -------------------------------------------------------- -{- - alternatives: - alternative App: - child name : {String} - child args : Exprs - alternative Case: - child expr : Expr - child alts : CaseAlts - alternative Do: - child stmts : Decls - child body : Expr - alternative InvokeExpr: - child nt : {String} - child expr : Expr - child args : Exprs - alternative Lambda: - child args : Exprs - child body : Expr - alternative Let: - child decls : Decls - child body : Expr - alternative LineExpr: - child expr : Expr - alternative PragmaExpr: - child onLeftSide : {Bool} - child onNewLine : {Bool} - child txt : {String} - child expr : Expr - alternative ResultExpr: - child nt : {String} - child expr : Expr - 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 - alternative SimpleExpr: - child txt : {String} - alternative TextExpr: - child lns : {[String]} - alternative Trace: - child txt : {String} - child expr : Expr - alternative TupleExpr: - child exprs : Exprs - alternative TypedExpr: - child expr : Expr - child tp : Type - alternative UnboxedTupleExpr: - child exprs : Exprs --} -data Expr = App (String) (Exprs ) - | Case (Expr ) (CaseAlts ) - | Do (Decls ) (Expr ) - | InvokeExpr (String) (Expr ) (Exprs ) - | Lambda (Exprs ) (Expr ) - | Let (Decls ) (Expr ) - | LineExpr (Expr ) - | PragmaExpr (Bool) (Bool) (String) (Expr ) - | ResultExpr (String) (Expr ) - | ResumeExpr (String) (Expr ) (Lhs ) (Expr ) - | SemFun (String) (Exprs ) (Expr ) - | SimpleExpr (String) - | TextExpr (([String])) - | Trace (String) (Expr ) - | TupleExpr (Exprs ) - | TypedExpr (Expr ) (Type ) - | UnboxedTupleExpr (Exprs ) --- Exprs ------------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : Expr - child tl : Exprs - alternative Nil: --} -type Exprs = [Expr ] --- Lhs --------------------------------------------------------- -{- - alternatives: - alternative Fun: - child name : {String} - child args : Exprs - alternative Pattern3: - child pat3 : {Pattern} - alternative Pattern3SM: - child pat3 : {Pattern} - alternative TupleLhs: - child comps : {[String]} - alternative UnboxedTupleLhs: - child comps : {[String]} - alternative Unwrap: - child name : {String} - child sub : Lhs --} -data Lhs = Fun (String) (Exprs ) - | Pattern3 (Pattern) - | Pattern3SM (Pattern) - | TupleLhs (([String])) - | UnboxedTupleLhs (([String])) - | 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 List: - child tp : Type - alternative NontermType: - child name : {String} - child params : {[String]} - alternative QuantApp: - child left : {String} - child right : Type - alternative SimpleType: - child txt : {String} - alternative TEither: - child left : Type - child right : Type - alternative TIntMap: - child value : Type - alternative TMap: - child key : Type - child value : Type - alternative TMaybe: - child tp : Type - alternative TupleType: - child tps : Types - alternative TypeApp: - child func : Type - child args : Types - alternative UnboxedTupleType: - child tps : Types --} -data Type = Arr (Type ) (Type ) - | CtxApp (([(String, [String])])) (Type ) - | List (Type ) - | NontermType (String) (([String])) - | QuantApp (String) (Type ) - | SimpleType (String) - | TEither (Type ) (Type ) - | TIntMap (Type ) - | TMap (Type ) (Type ) - | TMaybe (Type ) - | TupleType (Types ) - | TypeApp (Type ) (Types ) - | UnboxedTupleType (Types ) - deriving ( Show) --- Types ------------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : Type - child tl : Types - alternative Nil: --} -type Types = [Type ] diff --git a/dist/build/uuagc/uuagc-tmp/CodeSyntax.hs b/dist/build/uuagc/uuagc-tmp/CodeSyntax.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/CodeSyntax.hs +++ /dev/null @@ -1,151 +0,0 @@ - - --- UUAGC 0.9.39.0.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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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,Maybe (Maybe Type))]} - child terminals : {[Identifier]} --} -data CProduction = CProduction (ConstructorIdent) (CVisits ) (([(Identifier,Type,Maybe (Maybe Type))])) (([Identifier])) --- CProductions ------------------------------------------------ -{- - alternatives: - alternative Cons: - child hd : CProduction - child tl : CProductions - alternative Nil: --} -type CProductions = [CProduction ] --- CRule ------------------------------------------------------- -{- - alternatives: - alternative CChildVisit: - child name : {Identifier} - child nt : {NontermIdent} - child nr : {Int} - child inh : {Attributes} - child syn : {Attributes} - child isLast : {Bool} - 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} --} -data CRule = CChildVisit (Identifier) (NontermIdent) (Int) (Attributes) (Attributes) (Bool) - | 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)) --- 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/uuagc/uuagc-tmp/CodeSyntaxDump.hs b/dist/build/uuagc/uuagc-tmp/CodeSyntaxDump.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/CodeSyntaxDump.hs +++ /dev/null @@ -1,1077 +0,0 @@ - - --- UUAGC 0.9.39.0.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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/CodeSyntaxDump.hs" #-} - -{-# LINE 2 "src-ag/CodeSyntax.ag" #-} - -import Patterns -import CommonTypes -import Data.Map(Map) -import Data.Set(Set) -{-# LINE 23 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/CodeSyntaxDump.hs" #-} - -{-# LINE 2 "src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 30 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/CodeSyntaxDump.hs" #-} -{-# LINE 15 "src-ag/CodeSyntaxDump.ag" #-} - -ppChild :: (Identifier,Type,Maybe (Maybe Type)) -> 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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 "src-ag/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 "src-ag/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 "src-ag/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 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- use rule "src-ag/CodeSyntaxDump.ag"(line 44, column 40) - _lhsOpp = - ({-# LINE 44 "src-ag/CodeSyntaxDump.ag" #-} - _hdIpp >-< _tlIpp - {-# LINE 259 "src-ag/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 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- use rule "src-ag/CodeSyntaxDump.ag"(line 44, column 40) - _lhsOpp = - ({-# LINE 44 "src-ag/CodeSyntaxDump.ag" #-} - empty - {-# LINE 280 "src-ag/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,Maybe (Maybe Type))]} - 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,Maybe (Maybe Type))]) -> - ([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 "src-ag/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 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- use rule "src-ag/CodeSyntaxDump.ag"(line 44, column 40) - _lhsOpp = - ({-# LINE 44 "src-ag/CodeSyntaxDump.ag" #-} - _hdIpp >-< _tlIpp - {-# LINE 374 "src-ag/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 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- use rule "src-ag/CodeSyntaxDump.ag"(line 44, column 40) - _lhsOpp = - ({-# LINE 44 "src-ag/CodeSyntaxDump.ag" #-} - empty - {-# LINE 395 "src-ag/CodeSyntaxDump.hs" #-} - ) - in ( _lhsOpp,_lhsOppL)) ) --- CRule ------------------------------------------------------- -{- - visit 0: - synthesized attribute: - pp : PP_Doc - alternatives: - alternative CChildVisit: - child name : {Identifier} - child nt : {NontermIdent} - child nr : {Int} - child inh : {Attributes} - child syn : {Attributes} - child isLast : {Bool} - 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} --} --- cata -sem_CRule :: CRule -> - T_CRule -sem_CRule (CChildVisit _name _nt _nr _inh _syn _isLast ) = - (sem_CRule_CChildVisit _name _nt _nr _inh _syn _isLast ) -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 ) --- 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_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 459 "src-ag/CodeSyntaxDump.hs" #-} - ) - in ( _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 487 "src-ag/CodeSyntaxDump.hs" #-} - ) - ( _patternIcopy,_patternIpp) = - pattern_ - 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 "src-ag/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 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- use rule "src-ag/CodeSyntaxDump.ag"(line 44, column 40) - _lhsOpp = - ({-# LINE 44 "src-ag/CodeSyntaxDump.ag" #-} - _hdIpp >-< _tlIpp - {-# LINE 575 "src-ag/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 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- use rule "src-ag/CodeSyntaxDump.ag"(line 44, column 40) - _lhsOpp = - ({-# LINE 44 "src-ag/CodeSyntaxDump.ag" #-} - empty - {-# LINE 596 "src-ag/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 "src-ag/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 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- use rule "src-ag/CodeSyntaxDump.ag"(line 44, column 40) - _lhsOpp = - ({-# LINE 44 "src-ag/CodeSyntaxDump.ag" #-} - _hdIpp >-< _tlIpp - {-# LINE 694 "src-ag/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 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- use rule "src-ag/CodeSyntaxDump.ag"(line 44, column 40) - _lhsOpp = - ({-# LINE 44 "src-ag/CodeSyntaxDump.ag" #-} - empty - {-# LINE 715 "src-ag/CodeSyntaxDump.hs" #-} - ) - in ( _lhsOpp,_lhsOppL)) ) --- Pattern ----------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - pp : PP_Doc - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern (Alias _field _attr _pat _parts ) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) -sem_Pattern (Constr _name _pats ) = - (sem_Pattern_Constr _name (sem_Patterns _pats ) ) -sem_Pattern (Irrefutable _pat ) = - (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) -sem_Pattern (Product _pos _pats ) = - (sem_Pattern_Product _pos (sem_Patterns _pats ) ) -sem_Pattern (Underscore _pos ) = - (sem_Pattern_Underscore _pos ) --- semantic domain -newtype T_Pattern = T_Pattern (( Pattern ,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_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = - (T_Pattern (let _lhsOpp :: PP_Doc - _lhsOcopy :: Pattern - _patIcopy :: Pattern - _patIpp :: PP_Doc - _partsIcopy :: Patterns - _partsIpp :: PP_Doc - _partsIppL :: ([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 791 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 797 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 803 "src-ag/CodeSyntaxDump.hs" #-} - ) - ( _patIcopy,_patIpp) = - pat_ - ( _partsIcopy,_partsIpp,_partsIppL) = - parts_ - in ( _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 823 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 829 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 835 "src-ag/CodeSyntaxDump.hs" #-} - ) - ( _patsIcopy,_patsIpp,_patsIppL) = - pats_ - 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 851 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 857 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 863 "src-ag/CodeSyntaxDump.hs" #-} - ) - ( _patIcopy,_patIpp) = - pat_ - 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 881 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 887 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 893 "src-ag/CodeSyntaxDump.hs" #-} - ) - ( _patsIcopy,_patsIpp,_patsIppL) = - pats_ - 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 907 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Underscore pos_ - {-# LINE 913 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 919 "src-ag/CodeSyntaxDump.hs" #-} - ) - in ( _lhsOcopy,_lhsOpp)) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - 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 970 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- use rule "src-ag/CodeSyntaxDump.ag"(line 44, column 40) - _lhsOpp = - ({-# LINE 44 "src-ag/CodeSyntaxDump.ag" #-} - _hdIpp >-< _tlIpp - {-# LINE 976 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 982 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 988 "src-ag/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 1004 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- use rule "src-ag/CodeSyntaxDump.ag"(line 44, column 40) - _lhsOpp = - ({-# LINE 44 "src-ag/CodeSyntaxDump.ag" #-} - empty - {-# LINE 1010 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - [] - {-# LINE 1016 "src-ag/CodeSyntaxDump.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1022 "src-ag/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 1062 "src-ag/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 1076 "src-ag/CodeSyntaxDump.hs" #-} - ) - in ( _lhsOppL)) ) diff --git a/dist/build/uuagc/uuagc-tmp/ConcreteSyntax.hs b/dist/build/uuagc/uuagc-tmp/ConcreteSyntax.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/ConcreteSyntax.hs +++ /dev/null @@ -1,235 +0,0 @@ - - --- UUAGC 0.9.39.0.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 -{-# LINE 12 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/ConcreteSyntax.hs" #-} --- AG ---------------------------------------------------------- -{- - alternatives: - alternative AG: - child elems : Elems --} -data AG = AG (Elems ) --- Alt --------------------------------------------------------- -{- - alternatives: - alternative Alt: - child pos : {Pos} - child names : ConstructorSet - child fields : {Fields} --} -data Alt = Alt (Pos) (ConstructorSet ) (Fields) --- 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 CAll: - alternative CDifference: - child set1 : ConstructorSet - child set2 : ConstructorSet - alternative CName: - child name : {ConstructorIdent} - alternative CUnion: - child set1 : ConstructorSet - child set2 : ConstructorSet --} -data ConstructorSet = CAll - | CDifference (ConstructorSet ) (ConstructorSet ) - | CName (ConstructorIdent) - | CUnion (ConstructorSet ) (ConstructorSet ) --- Elem -------------------------------------------------------- -{- - alternatives: - alternative Attr: - child pos : {Pos} - child ctx : {ClassContext} - child names : NontSet - child quants : {[String]} - child attrs : Attrs - alternative Data: - child pos : {Pos} - child ctx : {ClassContext} - child names : NontSet - child params : {[Identifier]} - child attrs : Attrs - child alts : Alts - child ext : {Bool} - alternative Deriving: - child pos : {Pos} - child set : NontSet - child classes : {[NontermIdent]} - alternative Module: - child pos : {Pos} - child name : {String} - child exports : {String} - child imports : {String} - alternative Nocatas: - child pos : {Pos} - child set : NontSet - alternative Pragma: - child pos : {Pos} - child names : {[NontermIdent]} - alternative Sem: - child pos : {Pos} - child ctx : {ClassContext} - child names : NontSet - child attrs : Attrs - child quants : {[String]} - child alts : SemAlts - alternative Set: - child pos : {Pos} - child name : {NontermIdent} - child merge : {Bool} - child set : NontSet - alternative Txt: - child pos : {Pos} - child name : {Identifier} - child mbNt : {Maybe NontermIdent} - child lines : {[String]} - alternative Type: - child pos : {Pos} - child ctx : {ClassContext} - child name : {NontermIdent} - child params : {[Identifier]} - child type : {ComplexType} - alternative Wrapper: - child pos : {Pos} - child set : NontSet --} -data Elem = Attr (Pos) (ClassContext) (NontSet ) (([String])) (Attrs ) - | Data (Pos) (ClassContext) (NontSet ) (([Identifier])) (Attrs ) (Alts ) (Bool) - | Deriving (Pos) (NontSet ) (([NontermIdent])) - | Module (Pos) (String) (String) (String) - | Nocatas (Pos) (NontSet ) - | Pragma (Pos) (([NontermIdent])) - | Sem (Pos) (ClassContext) (NontSet ) (Attrs ) (([String])) (SemAlts ) - | Set (Pos) (NontermIdent) (Bool) (NontSet ) - | Txt (Pos) (Identifier) ((Maybe NontermIdent)) (([String])) - | Type (Pos) (ClassContext) (NontermIdent) (([Identifier])) (ComplexType) - | Wrapper (Pos) (NontSet ) --- Elems ------------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : Elem - child tl : Elems - alternative Nil: --} -type Elems = [Elem ] --- NontSet ----------------------------------------------------- -{- - alternatives: - alternative All: - alternative Difference: - child set1 : NontSet - child set2 : NontSet - alternative Intersect: - child set1 : NontSet - child set2 : NontSet - alternative NamedSet: - child name : {NontermIdent} - alternative Path: - child from : {NontermIdent} - child to : {NontermIdent} - alternative Union: - child set1 : NontSet - child set2 : NontSet --} -data NontSet = All - | Difference (NontSet ) (NontSet ) - | Intersect (NontSet ) (NontSet ) - | NamedSet (NontermIdent) - | Path (NontermIdent) (NontermIdent) - | Union (NontSet ) (NontSet ) --- 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 AroundDef: - child ident : {Identifier} - child rhs : {Expression} - alternative AttrOrderBefore: - child before : {[Occurrence]} - child after : {[Occurrence]} - alternative AugmentDef: - child ident : {Identifier} - child rhs : {Expression} - alternative Def: - child pos : {Pos} - child mbName : {Maybe Identifier} - child pattern : {Pattern} - child rhs : {Expression} - child owrt : {Bool} - alternative MergeDef: - child target : {Identifier} - child nt : {Identifier} - child sources : {[Identifier]} - child rhs : {Expression} - alternative SemPragma: - child names : {[NontermIdent]} - alternative TypeDef: - child pos : {Pos} - child ident : {Identifier} - child tp : {Type} - alternative UniqueDef: - child ident : {Identifier} - child ref : {Identifier} --} -data SemDef = AroundDef (Identifier) (Expression) - | AttrOrderBefore (([Occurrence])) (([Occurrence])) - | AugmentDef (Identifier) (Expression) - | Def (Pos) ((Maybe Identifier)) (Pattern) (Expression) (Bool) - | MergeDef (Identifier) (Identifier) (([Identifier])) (Expression) - | SemPragma (([NontermIdent])) - | TypeDef (Pos) (Identifier) (Type) - | UniqueDef (Identifier) (Identifier) --- SemDefs ----------------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : SemDef - child tl : SemDefs - alternative Nil: --} -type SemDefs = [SemDef ] diff --git a/dist/build/uuagc/uuagc-tmp/DeclBlocks.hs b/dist/build/uuagc/uuagc-tmp/DeclBlocks.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/DeclBlocks.hs +++ /dev/null @@ -1,28 +0,0 @@ - - --- UUAGC 0.9.39.0.0 (src-ag/DeclBlocks.ag) -module DeclBlocks where -{-# LINE 2 "src-ag/DeclBlocks.ag" #-} - -import Code (Decl,Expr) -{-# LINE 9 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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/uuagc/uuagc-tmp/DefaultRules.hs b/dist/build/uuagc/uuagc-tmp/DefaultRules.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/DefaultRules.hs +++ /dev/null @@ -1,2657 +0,0 @@ -{-# OPTIONS_GHC -XBangPatterns #-} - --- UUAGC 0.9.39.0.0 (src-ag/DefaultRules.ag) -module DefaultRules where -{-# LINE 10 "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 AbstractSyntax -import ErrorMessages - -import Options(Options,modcopy,rename) -{-# LINE 25 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 CommonTypes -{-# LINE 35 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/DefaultRules.hs" #-} - -{-# LINE 2 "src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 42 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/DefaultRules.hs" #-} -{-# LINE 60 "src-ag/DefaultRules.ag" #-} - -fieldName n = '@' : getName n - -locName n = '@' : getName n - -attrName fld attr - | fld == _LOC = '@' : getName attr - | otherwise = '@' : getName fld ++ "." ++ getName attr - -_ACHILD = Ident "(" noPos -- hack - - -getConName typeSyns rename nt con1 - | nt `elem` map fst typeSyns = synonym - | otherwise = normalName - where con = getName con1 - normalName | rename = getName nt++"_"++ con - | otherwise = con - synonym | con == "Cons" = "(:)" - | con == "Nil" = case lookup nt typeSyns of - Just (Map _ _) -> "Data.Map.empty" - Just (IntMap _) -> "Data.IntMap.empty" - _ -> "[]" - | con == "Just" = "Just" - | con == "Nothing" = "Nothing" - | con == "Entry" = case lookup nt typeSyns of - Just (Map _ _) -> "Data.Map.insert" - Just (IntMap _) -> "Data.IntMap.insert" - | otherwise = normalName - -concatSeq = foldr (Seq.><) Seq.empty - -splitAttrs :: Map Identifier a -> [Identifier] -> ([(Identifier,a)],[Identifier]) -- a used as (String,String) -splitAttrs _ [] - = ([],[]) -splitAttrs useMap (n:rest) - = let (uses,normals) = splitAttrs useMap rest - in case Map.lookup n useMap of - Just x -> ((n,x):uses , normals ) - Nothing -> ( uses , n:normals ) - -removeDefined :: Set (Identifier,Identifier) -> (Identifier,Attributes) -> (Identifier,[Identifier]) -removeDefined defined (fld,as) - = ( fld - , [ a - | a <- Map.keys as - , not (Set.member (fld,a) defined) - ] - ) - -{-# LINE 94 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/DefaultRules.hs" #-} - -{-# LINE 175 "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 -> Rule -makeRule (f1,a1) expr origin - = Rule Nothing - (Alias f1 a1 (Underscore noPos) []) - expr - False - origin - False - - -useRule :: Set Identifier -> [(Identifier,Attributes)] -> (Identifier,(String,String,String)) -> Rule -useRule locals ch_outs (n,(op,e,pos)) - = let elems = [ fld - | (fld,as) <- ch_outs - , Map.member n as - ] - - expr | Set.member n locals = attrName _LOC n - | null elems = e - | otherwise = foldr1 (\x y -> x ++ " " ++ op ++ " " ++ y) - (map (flip attrName n) elems) - - tks | Set.member n locals = [AGLocal n noPos Nothing] - | null elems = lexTokens noPos e - | otherwise = lexTokens noPos str - where - str = foldr1 (\x y -> x ++ " " ++ op ++ " " ++ y) - (map (flip attrName n) elems) - - in makeRule (_LHS,n) - (Expression noPos tks) - ("use rule " ++ pos) - - - - -selfRule lhsNecLoc attr x - = let expr | lhsNecLoc = locName attr - | otherwise = x - - tks | lhsNecLoc = [AGLocal attr noPos Nothing] - | otherwise = lexTokens noPos x - - in makeRule (if lhsNecLoc then _LHS else _LOC,attr) - (Expression noPos tks) - "self rule" - - - - -concatRE rsess = let (rss,ess) = unzip rsess - in (concat rss, concatSeq ess) - - -copyRule :: Identifier -> Identifier -> Bool -> Set Identifier -> (Map Identifier Identifier, (Identifier,[Identifier])) -> ([Rule], Seq Error) -copyRule nt con modcopy locals (env,(fld,as)) - = concatRE (map copyRu as) - - where - copyRu a - = ( [ makeRule (fld,a) - (Expression noPos tks) - (cruletxt sel) - ] - , err - ) - - where - sel - | not modcopy - && Set.member a locals = Just _LOC - | otherwise = Map.lookup a env - - (expr,err) - = case sel of - Nothing -> ( missingRuleErrorExpr nt con fld a - , Seq.singleton (MissingRule nt con fld a) - ) - Just f - | f == _ACHILD -> ( fieldName a - , Seq.singleton (deprecatedCopyRuleError nt con fld a) - ) - | otherwise -> ( attrName f a - , Seq.empty - ) - - (tks,err') - = case sel of - Nothing -> ( [HsToken (missingRuleErrorExpr nt con fld a) noPos] - , Seq.singleton (MissingRule nt con fld a) - ) - Just f - | f == _ACHILD -> ( [AGLocal a noPos Nothing] - , Seq.singleton (deprecatedCopyRuleError nt con fld a) - ) - | otherwise -> ( [AGField f a noPos Nothing] - , Seq.empty - ) - - cruletxt sel - | local = "copy rule (from local)" - | deprChild = "deprecated child copy" - | Set.member a locals && nonlocal = "modified copy rule" - | incoming && outgoing = "copy rule (chain)" - | incoming = "copy rule (down)" - | outgoing = "copy rule (up)" - | otherwise = "copy rule (chain)" - where outgoing = fld == _LHS - incoming = maybe False (== _LHS) sel - nonlocal = maybe False (/= _LOC) sel - local = maybe False (== _LOC) sel - deprChild = maybe False (== _ACHILD) sel -{-# LINE 247 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/DefaultRules.hs" #-} - -{-# LINE 406 "src-ag/DefaultRules.ag" #-} - -addAugments :: (Identifier, [Expression]) -> [Rule] -> [Rule] -addAugments (_, exprs) rules - | null exprs = rules -addAugments (syn, exprs) rules - = [rule] ++ funRules ++ map modify rules - where - rule = Rule Nothing (Alias _LHS syn (Underscore noPos) []) rhs False "augmented rule" False - rhs = Expression noPos tks - tks = [ HsToken "foldr ($) " noPos, AGLocal substSyn noPos Nothing, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] - funs = intersperse (HsToken ", " noPos) (map (\n -> AGLocal n noPos Nothing) funNames) - - substSyn = Ident (show syn ++ "_augmented_syn") (getPos syn) - funNames = zipWith (\i _ -> Ident (show syn ++ "_augmented_f" ++ show i) (getPos syn)) [1..] exprs - funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos) []) expr False "augment function" False) funNames exprs - - modify (Rule mbNm pat rhs owrt origin expl) - | containsSyn pat = Rule mbNm (modifyPat pat) rhs owrt origin expl - modify r = r - - containsSyn (Constr _ pats) = any containsSyn pats - containsSyn (Product _ pats) = any containsSyn pats - containsSyn (Irrefutable pat) = containsSyn pat - containsSyn (Alias field attr pat parts) = (field == _LHS && attr == syn) || containsSyn pat || any containsSyn parts - containsSyn _ = False - - modifyPat (Constr name pats) = Constr name (map modifyPat pats) - modifyPat (Product pos pats) = Product pos (map modifyPat pats) - modifyPat (Irrefutable pat) = Irrefutable (modifyPat pat) - modifyPat (Alias field attr pat parts) - | field == _LHS && attr == syn = Alias _LOC substSyn (modifyPat pat) (map modifyPat parts) - | otherwise = Alias field attr (modifyPat pat) (map modifyPat parts) - modifyPat p = p - -addArounds :: (Identifier, [Expression]) -> [Rule] -> [Rule] -addArounds (_, exprs) rules | null exprs = rules -addArounds (child, exprs) rules - = [rule] ++ funRules ++ rules - where - rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos) []) rhs False "around rule" False - rhs = Expression noPos tks - tks = [ HsToken "\\s -> foldr ($) s " noPos, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] - funs = intersperse (HsToken ", " noPos) (map (\n -> AGLocal n noPos Nothing) funNames) - - childLoc = Ident (show child ++ "_around") (getPos child) - funNames = zipWith (\i _ -> Ident (show child ++ "_around_f" ++ show i) (getPos child)) [1..] exprs - funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos) []) expr False "around function" False) funNames exprs - -addMerges :: (Identifier, (Identifier,[Identifier],Expression)) -> [Rule] -> [Rule] -addMerges (target,(_,_,expr)) rules - = rule : rules - where - rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos) []) expr False "merge rule" False - childLoc = Ident (show target ++ "_merge") (getPos target) -{-# LINE 304 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/DefaultRules.hs" #-} - -{-# LINE 521 "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 (Just nm) pat expr owrt origin expl) uniq - = let pos = getPos nm - r = Rule Nothing (Alias _LOC (Ident ("_rule_" ++ show nm) pos) (Underscore pos) []) expr owrt origin expl - expr' = Expression pos tks - tks = [AGLocal (Ident ("_rule_" ++ show nm) pos) pos (Just ("Indirection to rule " ++ show nm))] - (rs,uniq') = multiRule (Rule Nothing pat expr' owrt origin False) uniq - in (r:rs, uniq') - -multiRule (Rule Nothing pat expr owrt origin expl) uniq - = let f :: Bool -> (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int)) - f expl' w e (Product pos pats) n - = let freshName = Ident ("_tup" ++ show n) pos - freshExpr = Expression pos freshTks - freshTks = [AGField _LOC freshName pos Nothing] - freshPat = Alias _LOC freshName (Underscore pos) pats - a = length pats - 1 - us b p = Product pos (replicate (a-b) (Underscore pos) ++ [p] ++ replicate b (Underscore pos)) - g :: Pattern -> ([Pattern],[Rule],Int) -> ([Pattern],[Rule],Int) - g p (xs1,rs1,n1) = let (x2,(rs2,n2)) = f False (us (length xs1)) freshExpr p n1 - in (x2:xs1, rs2++rs1, n2) - (xs9,rs9,n9) = foldr g ([], [], n+1) pats - in ( freshPat - , ( Rule Nothing (w freshPat) e owrt origin expl' : rs9 - , n9 - ) - ) - f expl' w e p n - = ( p - , ( [Rule Nothing (w p) e owrt origin expl'] - , n - ) - ) - in snd (f expl id expr pat uniq) - -{-# LINE 362 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/DefaultRules.hs" #-} --- Child ------------------------------------------------------- -{- - visit 0: - inherited attributes: - con : ConstructorIdent - cr : Bool - merged : Set Identifier - nt : NontermIdent - synthesized attributes: - errors : Seq Error - field : (Identifier,Type,Maybe (Maybe Type)) - inherited : Attributes - name : Identifier - output : SELF - synthesized : Attributes - alternatives: - alternative Child: - child name : {Identifier} - child tp : {Type} - child inh : {Attributes} - child syn : {Attributes} - child virtual : {Maybe (Maybe Type)} - visit 0: - local output : _ --} --- cata -sem_Child :: Child -> - T_Child -sem_Child !(Child _name _tp _inh _syn _virtual ) = - (sem_Child_Child _name _tp _inh _syn _virtual ) --- semantic domain -newtype T_Child = T_Child (ConstructorIdent -> - Bool -> - (Set Identifier) -> - NontermIdent -> - ( (Seq Error),( (Identifier,Type,Maybe (Maybe Type)) ),Attributes,Identifier,Child ,Attributes)) -data Inh_Child = Inh_Child {con_Inh_Child :: !(ConstructorIdent),cr_Inh_Child :: !(Bool),merged_Inh_Child :: !((Set Identifier)),nt_Inh_Child :: !(NontermIdent)} -data Syn_Child = Syn_Child {errors_Syn_Child :: !((Seq Error)),field_Syn_Child :: !(( (Identifier,Type,Maybe (Maybe Type)) )),inherited_Syn_Child :: !(Attributes),name_Syn_Child :: !(Identifier),output_Syn_Child :: !(Child ),synthesized_Syn_Child :: !(Attributes)} -wrap_Child :: T_Child -> - Inh_Child -> - Syn_Child -wrap_Child !(T_Child sem ) !(Inh_Child _lhsIcon _lhsIcr _lhsImerged _lhsInt ) = - (let ( !_lhsOerrors,!_lhsOfield,!_lhsOinherited,!_lhsOname,!_lhsOoutput,!_lhsOsynthesized) = sem _lhsIcon _lhsIcr _lhsImerged _lhsInt - in (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized )) -sem_Child_Child :: Identifier -> - Type -> - Attributes -> - Attributes -> - (Maybe (Maybe Type)) -> - T_Child -sem_Child_Child !name_ !tp_ !inh_ !syn_ !virtual_ = - (T_Child (\ (!_lhsIcon) - (!_lhsIcr) - (!_lhsImerged) - (!_lhsInt) -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - Seq.empty - {-# LINE 420 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 480 "src-ag/DefaultRules.ag" #-} - (name_,tp_,virtual_) - {-# LINE 425 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOfield -> - (case (({-# LINE 158 "src-ag/DefaultRules.ag" #-} - inh_ - {-# LINE 430 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOinherited -> - (case (({-# LINE 149 "src-ag/DefaultRules.ag" #-} - name_ - {-# LINE 435 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOname -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - Child name_ tp_ inh_ syn_ virtual_ - {-# LINE 440 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 445 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 159 "src-ag/DefaultRules.ag" #-} - if name_ `Set.member` _lhsImerged - then Map.empty - else syn_ - {-# LINE 452 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOsynthesized -> - ( _lhsOerrors,_lhsOfield,_lhsOinherited,_lhsOname,_lhsOoutput,_lhsOsynthesized) }) }) }) }) }) }) })) ) --- Children ---------------------------------------------------- -{- - visit 0: - inherited attributes: - con : ConstructorIdent - cr : Bool - merged : Set Identifier - nt : NontermIdent - synthesized attributes: - errors : Seq Error - fields : [(Identifier,Type,Maybe (Maybe Type))] - inputs : [(Identifier, Attributes)] - output : SELF - outputs : [(Identifier, Attributes)] - alternatives: - alternative Cons: - child hd : Child - child tl : Children - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Children :: Children -> - T_Children -sem_Children !list = - (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) ) --- semantic domain -newtype T_Children = T_Children (ConstructorIdent -> - Bool -> - (Set Identifier) -> - NontermIdent -> - ( (Seq Error),([(Identifier,Type,Maybe (Maybe Type))]),([(Identifier, Attributes)]),Children ,([(Identifier, Attributes)]))) -data Inh_Children = Inh_Children {con_Inh_Children :: !(ConstructorIdent),cr_Inh_Children :: !(Bool),merged_Inh_Children :: !((Set Identifier)),nt_Inh_Children :: !(NontermIdent)} -data Syn_Children = Syn_Children {errors_Syn_Children :: !((Seq Error)),fields_Syn_Children :: !(([(Identifier,Type,Maybe (Maybe Type))])),inputs_Syn_Children :: !(([(Identifier, Attributes)])),output_Syn_Children :: !(Children ),outputs_Syn_Children :: !(([(Identifier, Attributes)]))} -wrap_Children :: T_Children -> - Inh_Children -> - Syn_Children -wrap_Children !(T_Children sem ) !(Inh_Children _lhsIcon _lhsIcr _lhsImerged _lhsInt ) = - (let ( !_lhsOerrors,!_lhsOfields,!_lhsOinputs,!_lhsOoutput,!_lhsOoutputs) = sem _lhsIcon _lhsIcr _lhsImerged _lhsInt - in (Syn_Children _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs )) -sem_Children_Cons :: T_Child -> - T_Children -> - T_Children -sem_Children_Cons !(T_Child hd_ ) !(T_Children tl_ ) = - (T_Children (\ (!_lhsIcon) - (!_lhsIcr) - (!_lhsImerged) - (!_lhsInt) -> - (case (({-# LINE 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 509 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOnt -> - (case (({-# LINE 665 "src-ag/DefaultRules.ag" #-} - _lhsImerged - {-# LINE 514 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOmerged -> - (case (({-# LINE 46 "src-ag/DefaultRules.ag" #-} - _lhsIcr - {-# LINE 519 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOcr -> - (case (({-# LINE 34 "src-ag/DefaultRules.ag" #-} - _lhsIcon - {-# LINE 524 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOcon -> - (case (tl_ _tlOcon _tlOcr _tlOmerged _tlOnt ) of - { ( !_tlIerrors,!_tlIfields,!_tlIinputs,!_tlIoutput,!_tlIoutputs) -> - (case (({-# LINE 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 531 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOnt -> - (case (({-# LINE 665 "src-ag/DefaultRules.ag" #-} - _lhsImerged - {-# LINE 536 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOmerged -> - (case (({-# LINE 46 "src-ag/DefaultRules.ag" #-} - _lhsIcr - {-# LINE 541 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOcr -> - (case (({-# LINE 34 "src-ag/DefaultRules.ag" #-} - _lhsIcon - {-# LINE 546 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOcon -> - (case (hd_ _hdOcon _hdOcr _hdOmerged _hdOnt ) of - { ( !_hdIerrors,!_hdIfield,!_hdIinherited,!_hdIname,!_hdIoutput,!_hdIsynthesized) -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 553 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 476 "src-ag/DefaultRules.ag" #-} - _hdIfield : _tlIfields - {-# LINE 558 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOfields -> - (case (({-# LINE 164 "src-ag/DefaultRules.ag" #-} - (_hdIname, _hdIinherited) : _tlIinputs - {-# LINE 563 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOinputs -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 568 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 573 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 165 "src-ag/DefaultRules.ag" #-} - (_hdIname, _hdIsynthesized) : _tlIoutputs - {-# LINE 578 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutputs -> - ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Children_Nil :: T_Children -sem_Children_Nil = - (T_Children (\ (!_lhsIcon) - (!_lhsIcr) - (!_lhsImerged) - (!_lhsInt) -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - Seq.empty - {-# LINE 590 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 477 "src-ag/DefaultRules.ag" #-} - [] - {-# LINE 595 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOfields -> - (case (({-# LINE 166 "src-ag/DefaultRules.ag" #-} - [] - {-# LINE 600 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOinputs -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - [] - {-# LINE 605 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 610 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 167 "src-ag/DefaultRules.ag" #-} - [] - {-# LINE 615 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutputs -> - ( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) }) }) }) }) }) })) ) --- Grammar ----------------------------------------------------- -{- - visit 0: - inherited attribute: - options : Options - synthesized attributes: - errors : Seq Error - output : SELF - alternatives: - alternative Grammar: - child typeSyns : {TypeSyns} - child useMap : {UseMap} - child derivings : {Derivings} - child wrappers : {Set NontermIdent} - child nonts : Nonterminals - child pragmas : {PragmaMap} - child manualAttrOrderMap : {AttrOrderMap} - child paramMap : {ParamMap} - child contextMap : {ContextMap} - child quantMap : {QuantMap} - child uniqueMap : {UniqueMap} - child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} - child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} - child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} - visit 0: - local output : _ --} --- cata -sem_Grammar :: Grammar -> - T_Grammar -sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) = - (sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts ) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap ) --- semantic domain -newtype T_Grammar = T_Grammar (Options -> - ( (Seq Error),Grammar )) -data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: !(Options)} -data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: !((Seq Error)),output_Syn_Grammar :: !(Grammar )} -wrap_Grammar :: T_Grammar -> - Inh_Grammar -> - Syn_Grammar -wrap_Grammar !(T_Grammar sem ) !(Inh_Grammar _lhsIoptions ) = - (let ( !_lhsOerrors,!_lhsOoutput) = sem _lhsIoptions - in (Syn_Grammar _lhsOerrors _lhsOoutput )) -sem_Grammar_Grammar :: TypeSyns -> - UseMap -> - Derivings -> - (Set NontermIdent) -> - T_Nonterminals -> - PragmaMap -> - AttrOrderMap -> - ParamMap -> - ContextMap -> - QuantMap -> - UniqueMap -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> - T_Grammar -sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_ ) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !quantMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ !mergeMap_ = - (T_Grammar (\ (!_lhsIoptions) -> - (case (({-# LINE 667 "src-ag/DefaultRules.ag" #-} - mergeMap_ - {-# LINE 681 "src-ag/DefaultRules.hs" #-} - )) of - { !_nontsOmergesIn -> - (case (({-# LINE 586 "src-ag/DefaultRules.ag" #-} - manualAttrOrderMap_ - {-# LINE 686 "src-ag/DefaultRules.hs" #-} - )) of - { !_nontsOmanualAttrOrderMap -> - (case (({-# LINE 153 "src-ag/DefaultRules.ag" #-} - typeSyns_ - {-# LINE 691 "src-ag/DefaultRules.hs" #-} - )) of - { !_nontsOtypeSyns -> - (case (({-# LINE 151 "src-ag/DefaultRules.ag" #-} - useMap_ - {-# LINE 696 "src-ag/DefaultRules.hs" #-} - )) of - { !_nontsOuseMap -> - (case (({-# LINE 49 "src-ag/DefaultRules.ag" #-} - modcopy _lhsIoptions - {-# LINE 701 "src-ag/DefaultRules.hs" #-} - )) of - { !_nontsOcr -> - (case (({-# LINE 48 "src-ag/DefaultRules.ag" #-} - rename _lhsIoptions - {-# LINE 706 "src-ag/DefaultRules.hs" #-} - )) of - { !_nontsOo_rename -> - (case (nonts_ ) of - { ( !_nontsIcollect_nts,!T_Nonterminals_1 nonts_1) -> - (case (({-# LINE 659 "src-ag/DefaultRules.ag" #-} - aroundsMap_ - {-# LINE 713 "src-ag/DefaultRules.hs" #-} - )) of - { !_nontsOaroundsIn -> - (case (({-# LINE 652 "src-ag/DefaultRules.ag" #-} - augmentsMap_ - {-# LINE 718 "src-ag/DefaultRules.hs" #-} - )) of - { !_nontsOaugmentsIn -> - (case (({-# LINE 497 "src-ag/DefaultRules.ag" #-} - 1 - {-# LINE 723 "src-ag/DefaultRules.hs" #-} - )) of - { !_nontsOuniq -> - (case (({-# LINE 130 "src-ag/DefaultRules.ag" #-} - _nontsIcollect_nts - {-# LINE 728 "src-ag/DefaultRules.hs" #-} - )) of - { !_nontsOnonterminals -> - (case (nonts_1 _nontsOaroundsIn _nontsOaugmentsIn _nontsOcr _nontsOmanualAttrOrderMap _nontsOmergesIn _nontsOnonterminals _nontsOo_rename _nontsOtypeSyns _nontsOuniq _nontsOuseMap ) of - { ( !_nontsIerrors,!_nontsIoutput,!_nontsIuniq) -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - _nontsIerrors - {-# LINE 735 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ - {-# LINE 740 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 745 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) --- Nonterminal ------------------------------------------------- -{- - visit 0: - synthesized attribute: - collect_nts : Set NontermIdent - visit 1: - inherited attributes: - aroundsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - cr : Bool - manualAttrOrderMap : AttrOrderMap - mergesIn : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) - nonterminals : Set NontermIdent - o_rename : Bool - typeSyns : TypeSyns - useMap : UseMap - chained attribute: - uniq : Int - synthesized attributes: - errors : Seq Error - output : SELF - alternatives: - alternative Nonterminal: - child nt : {NontermIdent} - child params : {[Identifier]} - child inh : {Attributes} - child syn : {Attributes} - child prods : Productions - visit 1: - local mergesIn : _ - local augmentsIn : _ - local aroundsIn : _ - local output : _ --} --- cata -sem_Nonterminal :: Nonterminal -> - T_Nonterminal -sem_Nonterminal !(Nonterminal _nt _params _inh _syn _prods ) = - (sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods ) ) --- semantic domain -newtype T_Nonterminal = T_Nonterminal (( (Set NontermIdent),T_Nonterminal_1 )) -newtype T_Nonterminal_1 = T_Nonterminal_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - Bool -> - AttrOrderMap -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> - (Set NontermIdent) -> - Bool -> - TypeSyns -> - Int -> - UseMap -> - ( (Seq Error),Nonterminal ,Int)) -data Inh_Nonterminal = Inh_Nonterminal {aroundsIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),augmentsIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cr_Inh_Nonterminal :: !(Bool),manualAttrOrderMap_Inh_Nonterminal :: !(AttrOrderMap),mergesIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))))),nonterminals_Inh_Nonterminal :: !((Set NontermIdent)),o_rename_Inh_Nonterminal :: !(Bool),typeSyns_Inh_Nonterminal :: !(TypeSyns),uniq_Inh_Nonterminal :: !(Int),useMap_Inh_Nonterminal :: !(UseMap)} -data Syn_Nonterminal = Syn_Nonterminal {collect_nts_Syn_Nonterminal :: !((Set NontermIdent)),errors_Syn_Nonterminal :: !((Seq Error)),output_Syn_Nonterminal :: !(Nonterminal ),uniq_Syn_Nonterminal :: !(Int)} -wrap_Nonterminal :: T_Nonterminal -> - Inh_Nonterminal -> - Syn_Nonterminal -wrap_Nonterminal !(T_Nonterminal sem ) !(Inh_Nonterminal _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = - (let ( !_lhsOcollect_nts,!T_Nonterminal_1 sem_1) = sem - ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem_1 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap - in (Syn_Nonterminal _lhsOcollect_nts _lhsOerrors _lhsOoutput _lhsOuniq )) -sem_Nonterminal_Nonterminal :: NontermIdent -> - ([Identifier]) -> - Attributes -> - Attributes -> - T_Productions -> - T_Nonterminal -sem_Nonterminal_Nonterminal !nt_ !params_ !inh_ !syn_ !(T_Productions prods_ ) = - (T_Nonterminal (case (({-# LINE 126 "src-ag/DefaultRules.ag" #-} - Set.singleton nt_ - {-# LINE 819 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcollect_nts -> - (case ((let sem_Nonterminal_Nonterminal_1 :: T_Nonterminal_1 - sem_Nonterminal_Nonterminal_1 = - (T_Nonterminal_1 (\ (!_lhsIaroundsIn) - (!_lhsIaugmentsIn) - (!_lhsIcr) - (!_lhsImanualAttrOrderMap) - (!_lhsImergesIn) - (!_lhsInonterminals) - (!_lhsIo_rename) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (({-# LINE 54 "src-ag/DefaultRules.ag" #-} - _lhsItypeSyns - {-# LINE 836 "src-ag/DefaultRules.hs" #-} - )) of - { !_prodsOtypeSyns -> - (case (({-# LINE 42 "src-ag/DefaultRules.ag" #-} - _lhsIo_rename - {-# LINE 841 "src-ag/DefaultRules.hs" #-} - )) of - { !_prodsOo_rename -> - (case (({-# LINE 668 "src-ag/DefaultRules.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsImergesIn - {-# LINE 846 "src-ag/DefaultRules.hs" #-} - )) of - { !_mergesIn -> - (case (({-# LINE 664 "src-ag/DefaultRules.ag" #-} - _mergesIn - {-# LINE 851 "src-ag/DefaultRules.hs" #-} - )) of - { !_prodsOmergesIn -> - (case (({-# LINE 582 "src-ag/DefaultRules.ag" #-} - _lhsImanualAttrOrderMap - {-# LINE 856 "src-ag/DefaultRules.hs" #-} - )) of - { !_prodsOmanualAttrOrderMap -> - (case (({-# LINE 43 "src-ag/DefaultRules.ag" #-} - _lhsIcr - {-# LINE 861 "src-ag/DefaultRules.hs" #-} - )) of - { !_prodsOcr -> - (case (({-# LINE 155 "src-ag/DefaultRules.ag" #-} - nt_ - {-# LINE 866 "src-ag/DefaultRules.hs" #-} - )) of - { !_prodsOnt -> - (case (({-# LINE 143 "src-ag/DefaultRules.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsIuseMap - {-# LINE 871 "src-ag/DefaultRules.hs" #-} - )) of - { !_prodsOuseMap -> - (case (({-# LINE 142 "src-ag/DefaultRules.ag" #-} - syn_ - {-# LINE 876 "src-ag/DefaultRules.hs" #-} - )) of - { !_prodsOsyn -> - (case (({-# LINE 141 "src-ag/DefaultRules.ag" #-} - inh_ - {-# LINE 881 "src-ag/DefaultRules.hs" #-} - )) of - { !_prodsOinh -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 886 "src-ag/DefaultRules.hs" #-} - )) of - { !_prodsOuniq -> - (case (({-# LINE 128 "src-ag/DefaultRules.ag" #-} - _lhsInonterminals - {-# LINE 891 "src-ag/DefaultRules.hs" #-} - )) of - { !_prodsOnonterminals -> - (case (({-# LINE 653 "src-ag/DefaultRules.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn - {-# LINE 896 "src-ag/DefaultRules.hs" #-} - )) of - { !_augmentsIn -> - (case (({-# LINE 650 "src-ag/DefaultRules.ag" #-} - _augmentsIn - {-# LINE 901 "src-ag/DefaultRules.hs" #-} - )) of - { !_prodsOaugmentsIn -> - (case (({-# LINE 660 "src-ag/DefaultRules.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsIaroundsIn - {-# LINE 906 "src-ag/DefaultRules.hs" #-} - )) of - { !_aroundsIn -> - (case (({-# LINE 657 "src-ag/DefaultRules.ag" #-} - _aroundsIn - {-# LINE 911 "src-ag/DefaultRules.hs" #-} - )) of - { !_prodsOaroundsIn -> - (case (prods_ _prodsOaroundsIn _prodsOaugmentsIn _prodsOcr _prodsOinh _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnonterminals _prodsOnt _prodsOo_rename _prodsOsyn _prodsOtypeSyns _prodsOuniq _prodsOuseMap ) of - { ( !_prodsIerrors,!_prodsIoutput,!_prodsIuniq) -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - _prodsIerrors - {-# LINE 918 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - Nonterminal nt_ params_ inh_ syn_ _prodsIoutput - {-# LINE 923 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 928 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _prodsIuniq - {-# LINE 933 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) - in sem_Nonterminal_Nonterminal_1)) of - { ( !sem_Nonterminal_1) -> - ( _lhsOcollect_nts,sem_Nonterminal_1) }) }) ) --- Nonterminals ------------------------------------------------ -{- - visit 0: - synthesized attribute: - collect_nts : Set NontermIdent - visit 1: - inherited attributes: - aroundsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - cr : Bool - manualAttrOrderMap : AttrOrderMap - mergesIn : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) - nonterminals : Set NontermIdent - o_rename : Bool - typeSyns : TypeSyns - useMap : UseMap - chained attribute: - uniq : Int - synthesized attributes: - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Nonterminal - child tl : Nonterminals - visit 1: - local output : _ - alternative Nil: - visit 1: - local output : _ --} --- cata -sem_Nonterminals :: Nonterminals -> - T_Nonterminals -sem_Nonterminals !list = - (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) ) --- semantic domain -newtype T_Nonterminals = T_Nonterminals (( (Set NontermIdent),T_Nonterminals_1 )) -newtype T_Nonterminals_1 = T_Nonterminals_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - Bool -> - AttrOrderMap -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> - (Set NontermIdent) -> - Bool -> - TypeSyns -> - Int -> - UseMap -> - ( (Seq Error),Nonterminals ,Int)) -data Inh_Nonterminals = Inh_Nonterminals {aroundsIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),augmentsIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cr_Inh_Nonterminals :: !(Bool),manualAttrOrderMap_Inh_Nonterminals :: !(AttrOrderMap),mergesIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))))),nonterminals_Inh_Nonterminals :: !((Set NontermIdent)),o_rename_Inh_Nonterminals :: !(Bool),typeSyns_Inh_Nonterminals :: !(TypeSyns),uniq_Inh_Nonterminals :: !(Int),useMap_Inh_Nonterminals :: !(UseMap)} -data Syn_Nonterminals = Syn_Nonterminals {collect_nts_Syn_Nonterminals :: !((Set NontermIdent)),errors_Syn_Nonterminals :: !((Seq Error)),output_Syn_Nonterminals :: !(Nonterminals ),uniq_Syn_Nonterminals :: !(Int)} -wrap_Nonterminals :: T_Nonterminals -> - Inh_Nonterminals -> - Syn_Nonterminals -wrap_Nonterminals !(T_Nonterminals sem ) !(Inh_Nonterminals _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = - (let ( !_lhsOcollect_nts,!T_Nonterminals_1 sem_1) = sem - ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem_1 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsItypeSyns _lhsIuniq _lhsIuseMap - in (Syn_Nonterminals _lhsOcollect_nts _lhsOerrors _lhsOoutput _lhsOuniq )) -sem_Nonterminals_Cons :: T_Nonterminal -> - T_Nonterminals -> - T_Nonterminals -sem_Nonterminals_Cons !(T_Nonterminal hd_ ) !(T_Nonterminals tl_ ) = - (T_Nonterminals (case (tl_ ) of - { ( !_tlIcollect_nts,!T_Nonterminals_1 tl_1) -> - (case (hd_ ) of - { ( !_hdIcollect_nts,!T_Nonterminal_1 hd_1) -> - (case (({-# LINE 124 "src-ag/DefaultRules.ag" #-} - _hdIcollect_nts `Set.union` _tlIcollect_nts - {-# LINE 1008 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcollect_nts -> - (case ((let sem_Nonterminals_Cons_1 :: T_Nonterminals_1 - sem_Nonterminals_Cons_1 = - (T_Nonterminals_1 (\ (!_lhsIaroundsIn) - (!_lhsIaugmentsIn) - (!_lhsIcr) - (!_lhsImanualAttrOrderMap) - (!_lhsImergesIn) - (!_lhsInonterminals) - (!_lhsIo_rename) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (({-# LINE 137 "src-ag/DefaultRules.ag" #-} - _lhsIuseMap - {-# LINE 1025 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOuseMap -> - (case (({-# LINE 54 "src-ag/DefaultRules.ag" #-} - _lhsItypeSyns - {-# LINE 1030 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOtypeSyns -> - (case (({-# LINE 42 "src-ag/DefaultRules.ag" #-} - _lhsIo_rename - {-# LINE 1035 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOo_rename -> - (case (({-# LINE 663 "src-ag/DefaultRules.ag" #-} - _lhsImergesIn - {-# LINE 1040 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOmergesIn -> - (case (({-# LINE 582 "src-ag/DefaultRules.ag" #-} - _lhsImanualAttrOrderMap - {-# LINE 1045 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOmanualAttrOrderMap -> - (case (({-# LINE 43 "src-ag/DefaultRules.ag" #-} - _lhsIcr - {-# LINE 1050 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOcr -> - (case (({-# LINE 137 "src-ag/DefaultRules.ag" #-} - _lhsIuseMap - {-# LINE 1055 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOuseMap -> - (case (({-# LINE 54 "src-ag/DefaultRules.ag" #-} - _lhsItypeSyns - {-# LINE 1060 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOtypeSyns -> - (case (({-# LINE 42 "src-ag/DefaultRules.ag" #-} - _lhsIo_rename - {-# LINE 1065 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOo_rename -> - (case (({-# LINE 663 "src-ag/DefaultRules.ag" #-} - _lhsImergesIn - {-# LINE 1070 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOmergesIn -> - (case (({-# LINE 582 "src-ag/DefaultRules.ag" #-} - _lhsImanualAttrOrderMap - {-# LINE 1075 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOmanualAttrOrderMap -> - (case (({-# LINE 43 "src-ag/DefaultRules.ag" #-} - _lhsIcr - {-# LINE 1080 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOcr -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 1085 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOuniq -> - (case (({-# LINE 128 "src-ag/DefaultRules.ag" #-} - _lhsInonterminals - {-# LINE 1090 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOnonterminals -> - (case (({-# LINE 649 "src-ag/DefaultRules.ag" #-} - _lhsIaugmentsIn - {-# LINE 1095 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOaugmentsIn -> - (case (({-# LINE 656 "src-ag/DefaultRules.ag" #-} - _lhsIaroundsIn - {-# LINE 1100 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOaroundsIn -> - (case (hd_1 _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOmanualAttrOrderMap _hdOmergesIn _hdOnonterminals _hdOo_rename _hdOtypeSyns _hdOuniq _hdOuseMap ) of - { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _hdIuniq - {-# LINE 1107 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOuniq -> - (case (({-# LINE 128 "src-ag/DefaultRules.ag" #-} - _lhsInonterminals - {-# LINE 1112 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOnonterminals -> - (case (({-# LINE 649 "src-ag/DefaultRules.ag" #-} - _lhsIaugmentsIn - {-# LINE 1117 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOaugmentsIn -> - (case (({-# LINE 656 "src-ag/DefaultRules.ag" #-} - _lhsIaroundsIn - {-# LINE 1122 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOaroundsIn -> - (case (tl_1 _tlOaroundsIn _tlOaugmentsIn _tlOcr _tlOmanualAttrOrderMap _tlOmergesIn _tlOnonterminals _tlOo_rename _tlOtypeSyns _tlOuniq _tlOuseMap ) of - { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 1129 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 1134 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 1139 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _tlIuniq - {-# LINE 1144 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) - in sem_Nonterminals_Cons_1)) of - { ( !sem_Nonterminals_1) -> - ( _lhsOcollect_nts,sem_Nonterminals_1) }) }) }) }) ) -sem_Nonterminals_Nil :: T_Nonterminals -sem_Nonterminals_Nil = - (T_Nonterminals (case (({-# LINE 124 "src-ag/DefaultRules.ag" #-} - Set.empty - {-# LINE 1155 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcollect_nts -> - (case ((let sem_Nonterminals_Nil_1 :: T_Nonterminals_1 - sem_Nonterminals_Nil_1 = - (T_Nonterminals_1 (\ (!_lhsIaroundsIn) - (!_lhsIaugmentsIn) - (!_lhsIcr) - (!_lhsImanualAttrOrderMap) - (!_lhsImergesIn) - (!_lhsInonterminals) - (!_lhsIo_rename) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - Seq.empty - {-# LINE 1172 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - [] - {-# LINE 1177 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 1182 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 1187 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) })) ) - in sem_Nonterminals_Nil_1)) of - { ( !sem_Nonterminals_1) -> - ( _lhsOcollect_nts,sem_Nonterminals_1) }) }) ) --- Pattern ----------------------------------------------------- -{- - visit 0: - inherited attributes: - con : ConstructorIdent - nt : NontermIdent - synthesized attributes: - containsVars : Bool - copy : SELF - definedAttrs : Set (Identifier,Identifier) - errors : Seq Error - locals : Set Identifier - output : SELF - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - local output : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - local output : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - local output : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - local output : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ - local output : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern !(Alias _field _attr _pat _parts ) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) -sem_Pattern !(Constr _name _pats ) = - (sem_Pattern_Constr _name (sem_Patterns _pats ) ) -sem_Pattern !(Irrefutable _pat ) = - (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) -sem_Pattern !(Product _pos _pats ) = - (sem_Pattern_Product _pos (sem_Patterns _pats ) ) -sem_Pattern !(Underscore _pos ) = - (sem_Pattern_Underscore _pos ) --- semantic domain -newtype T_Pattern = T_Pattern (ConstructorIdent -> - NontermIdent -> - ( Bool,Pattern ,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Pattern )) -data Inh_Pattern = Inh_Pattern {con_Inh_Pattern :: !(ConstructorIdent),nt_Inh_Pattern :: !(NontermIdent)} -data Syn_Pattern = Syn_Pattern {containsVars_Syn_Pattern :: !(Bool),copy_Syn_Pattern :: !(Pattern ),definedAttrs_Syn_Pattern :: !((Set (Identifier,Identifier))),errors_Syn_Pattern :: !((Seq Error)),locals_Syn_Pattern :: !((Set Identifier)),output_Syn_Pattern :: !(Pattern )} -wrap_Pattern :: T_Pattern -> - Inh_Pattern -> - Syn_Pattern -wrap_Pattern !(T_Pattern sem ) !(Inh_Pattern _lhsIcon _lhsInt ) = - (let ( !_lhsOcontainsVars,!_lhsOcopy,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput) = sem _lhsIcon _lhsInt - in (Syn_Pattern _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput )) -sem_Pattern_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_ ) !(T_Patterns parts_ ) = - (T_Pattern (\ (!_lhsIcon) - (!_lhsInt) -> - (case (({-# LINE 488 "src-ag/DefaultRules.ag" #-} - True - {-# LINE 1274 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 1279 "src-ag/DefaultRules.hs" #-} - )) of - { !_partsOnt -> - (case (({-# LINE 34 "src-ag/DefaultRules.ag" #-} - _lhsIcon - {-# LINE 1284 "src-ag/DefaultRules.hs" #-} - )) of - { !_partsOcon -> - (case (parts_ _partsOcon _partsOnt ) of - { ( !_partsIcontainsVars,!_partsIcopy,!_partsIdefinedAttrs,!_partsIerrors,!_partsIlocals,!_partsIoutput) -> - (case (({-# LINE 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 1291 "src-ag/DefaultRules.hs" #-} - )) of - { !_patOnt -> - (case (({-# LINE 34 "src-ag/DefaultRules.ag" #-} - _lhsIcon - {-# LINE 1296 "src-ag/DefaultRules.hs" #-} - )) of - { !_patOcon -> - (case (pat_ _patOcon _patOnt ) of - { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 1303 "src-ag/DefaultRules.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1308 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 470 "src-ag/DefaultRules.ag" #-} - Set.insert (field_,attr_) _patIdefinedAttrs - {-# LINE 1313 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - _patIerrors Seq.>< _partsIerrors - {-# LINE 1318 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 471 "src-ag/DefaultRules.ag" #-} - if field_ == _LOC - then Set.insert attr_ _patIlocals - else _patIlocals - {-# LINE 1325 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - Alias field_ attr_ _patIoutput _partsIoutput - {-# LINE 1330 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 1335 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Pattern_Constr :: ConstructorIdent -> - T_Patterns -> - T_Pattern -sem_Pattern_Constr !name_ !(T_Patterns pats_ ) = - (T_Pattern (\ (!_lhsIcon) - (!_lhsInt) -> - (case (({-# LINE 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 1347 "src-ag/DefaultRules.hs" #-} - )) of - { !_patsOnt -> - (case (({-# LINE 34 "src-ag/DefaultRules.ag" #-} - _lhsIcon - {-# LINE 1352 "src-ag/DefaultRules.hs" #-} - )) of - { !_patsOcon -> - (case (pats_ _patsOcon _patsOnt ) of - { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) -> - (case (({-# LINE 485 "src-ag/DefaultRules.ag" #-} - _patsIcontainsVars - {-# LINE 1359 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 1364 "src-ag/DefaultRules.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1369 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 465 "src-ag/DefaultRules.ag" #-} - _patsIdefinedAttrs - {-# LINE 1374 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - _patsIerrors - {-# LINE 1379 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 464 "src-ag/DefaultRules.ag" #-} - _patsIlocals - {-# LINE 1384 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - Constr name_ _patsIoutput - {-# LINE 1389 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 1394 "src-ag/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 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 1405 "src-ag/DefaultRules.hs" #-} - )) of - { !_patOnt -> - (case (({-# LINE 34 "src-ag/DefaultRules.ag" #-} - _lhsIcon - {-# LINE 1410 "src-ag/DefaultRules.hs" #-} - )) of - { !_patOcon -> - (case (pat_ _patOcon _patOnt ) of - { ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) -> - (case (({-# LINE 485 "src-ag/DefaultRules.ag" #-} - _patIcontainsVars - {-# LINE 1417 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 1422 "src-ag/DefaultRules.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1427 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 465 "src-ag/DefaultRules.ag" #-} - _patIdefinedAttrs - {-# LINE 1432 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - _patIerrors - {-# LINE 1437 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 464 "src-ag/DefaultRules.ag" #-} - _patIlocals - {-# LINE 1442 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - Irrefutable _patIoutput - {-# LINE 1447 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 1452 "src-ag/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 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 1464 "src-ag/DefaultRules.hs" #-} - )) of - { !_patsOnt -> - (case (({-# LINE 34 "src-ag/DefaultRules.ag" #-} - _lhsIcon - {-# LINE 1469 "src-ag/DefaultRules.hs" #-} - )) of - { !_patsOcon -> - (case (pats_ _patsOcon _patsOnt ) of - { ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) -> - (case (({-# LINE 485 "src-ag/DefaultRules.ag" #-} - _patsIcontainsVars - {-# LINE 1476 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 1481 "src-ag/DefaultRules.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1486 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 465 "src-ag/DefaultRules.ag" #-} - _patsIdefinedAttrs - {-# LINE 1491 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - _patsIerrors - {-# LINE 1496 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 464 "src-ag/DefaultRules.ag" #-} - _patsIlocals - {-# LINE 1501 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - Product pos_ _patsIoutput - {-# LINE 1506 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 1511 "src-ag/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 485 "src-ag/DefaultRules.ag" #-} - False - {-# LINE 1522 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Underscore pos_ - {-# LINE 1527 "src-ag/DefaultRules.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1532 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 465 "src-ag/DefaultRules.ag" #-} - Set.empty - {-# LINE 1537 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - Seq.empty - {-# LINE 1542 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 464 "src-ag/DefaultRules.ag" #-} - Set.empty - {-# LINE 1547 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - Underscore pos_ - {-# LINE 1552 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 1557 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) })) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - inherited attributes: - con : ConstructorIdent - nt : NontermIdent - synthesized attributes: - containsVars : Bool - copy : SELF - definedAttrs : Set (Identifier,Identifier) - errors : Seq Error - locals : Set Identifier - output : SELF - alternatives: - alternative Cons: - child hd : Pattern - child tl : Patterns - visit 0: - local copy : _ - local output : _ - alternative Nil: - visit 0: - local copy : _ - local output : _ --} --- cata -sem_Patterns :: Patterns -> - T_Patterns -sem_Patterns !list = - (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) ) --- semantic domain -newtype T_Patterns = T_Patterns (ConstructorIdent -> - NontermIdent -> - ( Bool,Patterns ,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Patterns )) -data Inh_Patterns = Inh_Patterns {con_Inh_Patterns :: !(ConstructorIdent),nt_Inh_Patterns :: !(NontermIdent)} -data Syn_Patterns = Syn_Patterns {containsVars_Syn_Patterns :: !(Bool),copy_Syn_Patterns :: !(Patterns ),definedAttrs_Syn_Patterns :: !((Set (Identifier,Identifier))),errors_Syn_Patterns :: !((Seq Error)),locals_Syn_Patterns :: !((Set Identifier)),output_Syn_Patterns :: !(Patterns )} -wrap_Patterns :: T_Patterns -> - Inh_Patterns -> - Syn_Patterns -wrap_Patterns !(T_Patterns sem ) !(Inh_Patterns _lhsIcon _lhsInt ) = - (let ( !_lhsOcontainsVars,!_lhsOcopy,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput) = sem _lhsIcon _lhsInt - in (Syn_Patterns _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput )) -sem_Patterns_Cons :: T_Pattern -> - T_Patterns -> - T_Patterns -sem_Patterns_Cons !(T_Pattern hd_ ) !(T_Patterns tl_ ) = - (T_Patterns (\ (!_lhsIcon) - (!_lhsInt) -> - (case (({-# LINE 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 1611 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOnt -> - (case (({-# LINE 34 "src-ag/DefaultRules.ag" #-} - _lhsIcon - {-# LINE 1616 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOcon -> - (case (tl_ _tlOcon _tlOnt ) of - { ( !_tlIcontainsVars,!_tlIcopy,!_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput) -> - (case (({-# LINE 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 1623 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOnt -> - (case (({-# LINE 34 "src-ag/DefaultRules.ag" #-} - _lhsIcon - {-# LINE 1628 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOcon -> - (case (hd_ _hdOcon _hdOnt ) of - { ( !_hdIcontainsVars,!_hdIcopy,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput) -> - (case (({-# LINE 485 "src-ag/DefaultRules.ag" #-} - _hdIcontainsVars || _tlIcontainsVars - {-# LINE 1635 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 1640 "src-ag/DefaultRules.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1645 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 465 "src-ag/DefaultRules.ag" #-} - _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs - {-# LINE 1650 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 1655 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 464 "src-ag/DefaultRules.ag" #-} - _hdIlocals `Set.union` _tlIlocals - {-# LINE 1660 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 1665 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 1670 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = - (T_Patterns (\ (!_lhsIcon) - (!_lhsInt) -> - (case (({-# LINE 485 "src-ag/DefaultRules.ag" #-} - False - {-# LINE 1680 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - [] - {-# LINE 1685 "src-ag/DefaultRules.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1690 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 465 "src-ag/DefaultRules.ag" #-} - Set.empty - {-# LINE 1695 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - Seq.empty - {-# LINE 1700 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 464 "src-ag/DefaultRules.ag" #-} - Set.empty - {-# LINE 1705 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - [] - {-# LINE 1710 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 1715 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) })) ) --- Production -------------------------------------------------- -{- - visit 0: - inherited attributes: - aroundsIn : Map ConstructorIdent (Map Identifier [Expression]) - augmentsIn : Map ConstructorIdent (Map Identifier [Expression]) - cr : Bool - inh : Attributes - manualAttrOrderMap : AttrOrderMap - mergesIn : Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)) - nonterminals : Set NontermIdent - nt : NontermIdent - o_rename : Bool - syn : Attributes - typeSyns : TypeSyns - useMap : Map Identifier (String,String,String) - chained attribute: - uniq : Int - synthesized attributes: - errors : Seq Error - output : SELF - alternatives: - alternative Production: - child con : {ConstructorIdent} - child children : Children - child rules : Rules - child typeSigs : TypeSigs - visit 0: - local mergesIn : _ - local merged : _ - local orderDeps : _ - local orderErrs : _ - local _tup1 : _ - local errs : _ - local aroundsIn : _ - local augmentsIn : _ - local newRls : _ - local extra1 : _ - local extra2 : _ - local extra3 : _ --} --- cata -sem_Production :: Production -> - T_Production -sem_Production !(Production _con _children _rules _typeSigs ) = - (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) --- semantic domain -newtype T_Production = T_Production ((Map ConstructorIdent (Map Identifier [Expression])) -> - (Map ConstructorIdent (Map Identifier [Expression])) -> - Bool -> - Attributes -> - AttrOrderMap -> - (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> - (Set NontermIdent) -> - NontermIdent -> - Bool -> - Attributes -> - TypeSyns -> - Int -> - (Map Identifier (String,String,String)) -> - ( (Seq Error),Production ,Int)) -data Inh_Production = Inh_Production {aroundsIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),augmentsIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),cr_Inh_Production :: !(Bool),inh_Inh_Production :: !(Attributes),manualAttrOrderMap_Inh_Production :: !(AttrOrderMap),mergesIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))),nonterminals_Inh_Production :: !((Set NontermIdent)),nt_Inh_Production :: !(NontermIdent),o_rename_Inh_Production :: !(Bool),syn_Inh_Production :: !(Attributes),typeSyns_Inh_Production :: !(TypeSyns),uniq_Inh_Production :: !(Int),useMap_Inh_Production :: !((Map Identifier (String,String,String)))} -data Syn_Production = Syn_Production {errors_Syn_Production :: !((Seq Error)),output_Syn_Production :: !(Production ),uniq_Syn_Production :: !(Int)} -wrap_Production :: T_Production -> - Inh_Production -> - Syn_Production -wrap_Production !(T_Production sem ) !(Inh_Production _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = - (let ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap - in (Syn_Production _lhsOerrors _lhsOoutput _lhsOuniq )) -sem_Production_Production :: ConstructorIdent -> - T_Children -> - T_Rules -> - T_TypeSigs -> - T_Production -sem_Production_Production !con_ !(T_Children children_ ) !(T_Rules rules_ ) !(T_TypeSigs typeSigs_ ) = - (T_Production (\ (!_lhsIaroundsIn) - (!_lhsIaugmentsIn) - (!_lhsIcr) - (!_lhsIinh) - (!_lhsImanualAttrOrderMap) - (!_lhsImergesIn) - (!_lhsInonterminals) - (!_lhsInt) - (!_lhsIo_rename) - (!_lhsIsyn) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (({-# LINE 669 "src-ag/DefaultRules.ag" #-} - Map.findWithDefault Map.empty con_ _lhsImergesIn - {-# LINE 1809 "src-ag/DefaultRules.hs" #-} - )) of - { !_mergesIn -> - (case (({-# LINE 670 "src-ag/DefaultRules.ag" #-} - Set.fromList [ c | (_,cs,_) <- Map.elems _mergesIn , c <- cs ] - {-# LINE 1814 "src-ag/DefaultRules.hs" #-} - )) of - { !_merged -> - (case (({-# LINE 665 "src-ag/DefaultRules.ag" #-} - _merged - {-# LINE 1819 "src-ag/DefaultRules.hs" #-} - )) of - { !_childrenOmerged -> - (case (({-# LINE 596 "src-ag/DefaultRules.ag" #-} - Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap - {-# LINE 1824 "src-ag/DefaultRules.hs" #-} - )) of - { !_orderDeps -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 1829 "src-ag/DefaultRules.hs" #-} - )) of - { !_rulesOuniq -> - (case (({-# LINE 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 1834 "src-ag/DefaultRules.hs" #-} - )) of - { !_rulesOnt -> - (case (({-# LINE 146 "src-ag/DefaultRules.ag" #-} - con_ - {-# LINE 1839 "src-ag/DefaultRules.hs" #-} - )) of - { !_rulesOcon -> - (case (rules_ _rulesOcon _rulesOnt _rulesOuniq ) of - { ( !_rulesIdefinedAttrs,!_rulesIerrors,!_rulesIlocals,!_rulesIoutput,!_rulesIruleNames,!_rulesIuniq) -> - (case (({-# LINE 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 1846 "src-ag/DefaultRules.hs" #-} - )) of - { !_childrenOnt -> - (case (({-# LINE 46 "src-ag/DefaultRules.ag" #-} - _lhsIcr - {-# LINE 1851 "src-ag/DefaultRules.hs" #-} - )) of - { !_childrenOcr -> - (case (({-# LINE 147 "src-ag/DefaultRules.ag" #-} - con_ - {-# LINE 1856 "src-ag/DefaultRules.hs" #-} - )) of - { !_childrenOcon -> - (case (children_ _childrenOcon _childrenOcr _childrenOmerged _childrenOnt ) of - { ( !_childrenIerrors,!_childrenIfields,!_childrenIinputs,!_childrenIoutput,!_childrenIoutputs) -> - (case (({-# LINE 598 "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 1897 "src-ag/DefaultRules.hs" #-} - )) of - { !_orderErrs -> - (case (({-# LINE 335 "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.partition isSELFNonterminal _lhsIsyn - (_,undefAttrs) - = removeDefined _rulesIdefinedAttrs (_LHS, normalAttrs) - (useAttrs,others) - = splitAttrs _lhsIuseMap undefAttrs - (rules1, errors1) - = concatRE $ map (copyRule _lhsInt con_ _lhsIcr locals) - (zip envs (map (removeDefined _rulesIdefinedAttrs) _childrenIinputs)) - uRules - = map (useRule locals _childrenIoutputs) useAttrs - selfLocRules - = [ selfRule False attr (constructor [childSelf attr nm tp | (nm,tp,virt) <- _childrenIfields, childExists virt]) - | attr <- Map.keys selfAttrs - , not (Set.member attr locals) - ] - where - childSelf self nm tp - = case tp of NT nt _ -> attrName nm self - _ | nm `Set.member` locals -> locname nm - | otherwise -> fieldName nm - constructor fs - | getName con_ == "Tuple" && _lhsInt `elem` map fst _lhsItypeSyns - = "(" ++ concat (intersperse "," fs) ++ ")" - | otherwise - = getConName _lhsItypeSyns _lhsIo_rename _lhsInt con_ ++ " " ++ unwords fs - childExists Nothing = True - childExists (Just (Just _)) = True - childExists (Just Nothing) = False - selfRules - = [ selfRule True attr undefined - | attr <- Map.keys selfAttrs - , not (Set.member (_LHS,attr) _rulesIdefinedAttrs) - ] - (rules5, errs5) - = copyRule _lhsInt - con_ - _lhsIcr - locals - (lhs_env, (_LHS, others)) - in (uRules++selfLocRules++selfRules++rules5++rules1, errors1> - (case (({-# LINE 335 "src-ag/DefaultRules.ag" #-} - __tup1 - {-# LINE 1962 "src-ag/DefaultRules.hs" #-} - )) of - { !(_,!_errs) -> - (case (({-# LINE 333 "src-ag/DefaultRules.ag" #-} - _childrenIerrors >< _errs >< _rulesIerrors >< _orderErrs - {-# LINE 1967 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 661 "src-ag/DefaultRules.ag" #-} - Map.findWithDefault Map.empty con_ _lhsIaroundsIn - {-# LINE 1972 "src-ag/DefaultRules.hs" #-} - )) of - { !_aroundsIn -> - (case (({-# LINE 654 "src-ag/DefaultRules.ag" #-} - Map.findWithDefault Map.empty con_ _lhsIaugmentsIn - {-# LINE 1977 "src-ag/DefaultRules.hs" #-} - )) of - { !_augmentsIn -> - (case (({-# LINE 335 "src-ag/DefaultRules.ag" #-} - __tup1 - {-# LINE 1982 "src-ag/DefaultRules.hs" #-} - )) of - { !(!_newRls,_) -> - (case (({-# LINE 508 "src-ag/DefaultRules.ag" #-} - foldr addAugments (_rulesIoutput ++ _newRls) (Map.assocs _augmentsIn ) - {-# LINE 1987 "src-ag/DefaultRules.hs" #-} - )) of - { !_extra1 -> - (case (({-# LINE 509 "src-ag/DefaultRules.ag" #-} - foldr addArounds _extra1 (Map.assocs _aroundsIn ) - {-# LINE 1992 "src-ag/DefaultRules.hs" #-} - )) of - { !_extra2 -> - (case (({-# LINE 510 "src-ag/DefaultRules.ag" #-} - foldr addMerges _extra2 (Map.assocs _mergesIn ) - {-# LINE 1997 "src-ag/DefaultRules.hs" #-} - )) of - { !_extra3 -> - (case (typeSigs_ ) of - { ( !_typeSigsIoutput) -> - (case (({-# LINE 511 "src-ag/DefaultRules.ag" #-} - Production con_ _childrenIoutput _extra3 _typeSigsIoutput - {-# LINE 2004 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _rulesIuniq - {-# LINE 2009 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) --- Productions ------------------------------------------------- -{- - visit 0: - inherited attributes: - aroundsIn : Map ConstructorIdent (Map Identifier [Expression]) - augmentsIn : Map ConstructorIdent (Map Identifier [Expression]) - cr : Bool - inh : Attributes - manualAttrOrderMap : AttrOrderMap - mergesIn : Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)) - nonterminals : Set NontermIdent - nt : NontermIdent - o_rename : Bool - syn : Attributes - typeSyns : TypeSyns - useMap : Map Identifier (String,String,String) - chained attribute: - uniq : Int - synthesized attributes: - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Production - child tl : Productions - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Productions :: Productions -> - T_Productions -sem_Productions !list = - (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) ) --- semantic domain -newtype T_Productions = T_Productions ((Map ConstructorIdent (Map Identifier [Expression])) -> - (Map ConstructorIdent (Map Identifier [Expression])) -> - Bool -> - Attributes -> - AttrOrderMap -> - (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> - (Set NontermIdent) -> - NontermIdent -> - Bool -> - Attributes -> - TypeSyns -> - Int -> - (Map Identifier (String,String,String)) -> - ( (Seq Error),Productions ,Int)) -data Inh_Productions = Inh_Productions {aroundsIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),augmentsIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),cr_Inh_Productions :: !(Bool),inh_Inh_Productions :: !(Attributes),manualAttrOrderMap_Inh_Productions :: !(AttrOrderMap),mergesIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))),nonterminals_Inh_Productions :: !((Set NontermIdent)),nt_Inh_Productions :: !(NontermIdent),o_rename_Inh_Productions :: !(Bool),syn_Inh_Productions :: !(Attributes),typeSyns_Inh_Productions :: !(TypeSyns),uniq_Inh_Productions :: !(Int),useMap_Inh_Productions :: !((Map Identifier (String,String,String)))} -data Syn_Productions = Syn_Productions {errors_Syn_Productions :: !((Seq Error)),output_Syn_Productions :: !(Productions ),uniq_Syn_Productions :: !(Int)} -wrap_Productions :: T_Productions -> - Inh_Productions -> - Syn_Productions -wrap_Productions !(T_Productions sem ) !(Inh_Productions _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap ) = - (let ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIsyn _lhsItypeSyns _lhsIuniq _lhsIuseMap - in (Syn_Productions _lhsOerrors _lhsOoutput _lhsOuniq )) -sem_Productions_Cons :: T_Production -> - T_Productions -> - T_Productions -sem_Productions_Cons !(T_Production hd_ ) !(T_Productions tl_ ) = - (T_Productions (\ (!_lhsIaroundsIn) - (!_lhsIaugmentsIn) - (!_lhsIcr) - (!_lhsIinh) - (!_lhsImanualAttrOrderMap) - (!_lhsImergesIn) - (!_lhsInonterminals) - (!_lhsInt) - (!_lhsIo_rename) - (!_lhsIsyn) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (({-# LINE 138 "src-ag/DefaultRules.ag" #-} - _lhsIuseMap - {-# LINE 2091 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOuseMap -> - (case (({-# LINE 54 "src-ag/DefaultRules.ag" #-} - _lhsItypeSyns - {-# LINE 2096 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOtypeSyns -> - (case (({-# LINE 138 "src-ag/DefaultRules.ag" #-} - _lhsIsyn - {-# LINE 2101 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOsyn -> - (case (({-# LINE 42 "src-ag/DefaultRules.ag" #-} - _lhsIo_rename - {-# LINE 2106 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOo_rename -> - (case (({-# LINE 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 2111 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOnt -> - (case (({-# LINE 664 "src-ag/DefaultRules.ag" #-} - _lhsImergesIn - {-# LINE 2116 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOmergesIn -> - (case (({-# LINE 582 "src-ag/DefaultRules.ag" #-} - _lhsImanualAttrOrderMap - {-# LINE 2121 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOmanualAttrOrderMap -> - (case (({-# LINE 138 "src-ag/DefaultRules.ag" #-} - _lhsIinh - {-# LINE 2126 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOinh -> - (case (({-# LINE 43 "src-ag/DefaultRules.ag" #-} - _lhsIcr - {-# LINE 2131 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOcr -> - (case (({-# LINE 138 "src-ag/DefaultRules.ag" #-} - _lhsIuseMap - {-# LINE 2136 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOuseMap -> - (case (({-# LINE 54 "src-ag/DefaultRules.ag" #-} - _lhsItypeSyns - {-# LINE 2141 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOtypeSyns -> - (case (({-# LINE 138 "src-ag/DefaultRules.ag" #-} - _lhsIsyn - {-# LINE 2146 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOsyn -> - (case (({-# LINE 42 "src-ag/DefaultRules.ag" #-} - _lhsIo_rename - {-# LINE 2151 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOo_rename -> - (case (({-# LINE 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 2156 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOnt -> - (case (({-# LINE 664 "src-ag/DefaultRules.ag" #-} - _lhsImergesIn - {-# LINE 2161 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOmergesIn -> - (case (({-# LINE 582 "src-ag/DefaultRules.ag" #-} - _lhsImanualAttrOrderMap - {-# LINE 2166 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOmanualAttrOrderMap -> - (case (({-# LINE 138 "src-ag/DefaultRules.ag" #-} - _lhsIinh - {-# LINE 2171 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOinh -> - (case (({-# LINE 43 "src-ag/DefaultRules.ag" #-} - _lhsIcr - {-# LINE 2176 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOcr -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 2181 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOuniq -> - (case (({-# LINE 128 "src-ag/DefaultRules.ag" #-} - _lhsInonterminals - {-# LINE 2186 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOnonterminals -> - (case (({-# LINE 650 "src-ag/DefaultRules.ag" #-} - _lhsIaugmentsIn - {-# LINE 2191 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOaugmentsIn -> - (case (({-# LINE 657 "src-ag/DefaultRules.ag" #-} - _lhsIaroundsIn - {-# LINE 2196 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOaroundsIn -> - (case (hd_ _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOinh _hdOmanualAttrOrderMap _hdOmergesIn _hdOnonterminals _hdOnt _hdOo_rename _hdOsyn _hdOtypeSyns _hdOuniq _hdOuseMap ) of - { ( !_hdIerrors,!_hdIoutput,!_hdIuniq) -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _hdIuniq - {-# LINE 2203 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOuniq -> - (case (({-# LINE 128 "src-ag/DefaultRules.ag" #-} - _lhsInonterminals - {-# LINE 2208 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOnonterminals -> - (case (({-# LINE 650 "src-ag/DefaultRules.ag" #-} - _lhsIaugmentsIn - {-# LINE 2213 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOaugmentsIn -> - (case (({-# LINE 657 "src-ag/DefaultRules.ag" #-} - _lhsIaroundsIn - {-# LINE 2218 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOaroundsIn -> - (case (tl_ _tlOaroundsIn _tlOaugmentsIn _tlOcr _tlOinh _tlOmanualAttrOrderMap _tlOmergesIn _tlOnonterminals _tlOnt _tlOo_rename _tlOsyn _tlOtypeSyns _tlOuniq _tlOuseMap ) of - { ( !_tlIerrors,!_tlIoutput,!_tlIuniq) -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 2225 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 2230 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 2235 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _tlIuniq - {-# LINE 2240 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Productions_Nil :: T_Productions -sem_Productions_Nil = - (T_Productions (\ (!_lhsIaroundsIn) - (!_lhsIaugmentsIn) - (!_lhsIcr) - (!_lhsIinh) - (!_lhsImanualAttrOrderMap) - (!_lhsImergesIn) - (!_lhsInonterminals) - (!_lhsInt) - (!_lhsIo_rename) - (!_lhsIsyn) - (!_lhsItypeSyns) - (!_lhsIuniq) - (!_lhsIuseMap) -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - Seq.empty - {-# LINE 2261 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - [] - {-# LINE 2266 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 2271 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 2276 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) })) ) --- Rule -------------------------------------------------------- -{- - visit 0: - inherited attributes: - con : ConstructorIdent - nt : NontermIdent - chained attribute: - uniq : Int - synthesized attributes: - containsVars : Bool - definedAttrs : Set (Identifier,Identifier) - errors : Seq Error - locals : Set Identifier - output : SELF - outputs : Rules - ruleNames : Set Identifier - alternatives: - alternative Rule: - child mbName : {Maybe Identifier} - child pattern : Pattern - child rhs : {Expression} - child owrt : {Bool} - child origin : {String} - child explicit : {Bool} - visit 0: - local output : _ - local _tup2 : {(Rules,Int)} --} --- cata -sem_Rule :: Rule -> - T_Rule -sem_Rule !(Rule _mbName _pattern _rhs _owrt _origin _explicit ) = - (sem_Rule_Rule _mbName (sem_Pattern _pattern ) _rhs _owrt _origin _explicit ) --- semantic domain -newtype T_Rule = T_Rule (ConstructorIdent -> - NontermIdent -> - Int -> - ( Bool,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rule ,Rules ,(Set Identifier),Int)) -data Inh_Rule = Inh_Rule {con_Inh_Rule :: !(ConstructorIdent),nt_Inh_Rule :: !(NontermIdent),uniq_Inh_Rule :: !(Int)} -data Syn_Rule = Syn_Rule {containsVars_Syn_Rule :: !(Bool),definedAttrs_Syn_Rule :: !((Set (Identifier,Identifier))),errors_Syn_Rule :: !((Seq Error)),locals_Syn_Rule :: !((Set Identifier)),output_Syn_Rule :: !(Rule ),outputs_Syn_Rule :: !(Rules ),ruleNames_Syn_Rule :: !((Set Identifier)),uniq_Syn_Rule :: !(Int)} -wrap_Rule :: T_Rule -> - Inh_Rule -> - Syn_Rule -wrap_Rule !(T_Rule sem ) !(Inh_Rule _lhsIcon _lhsInt _lhsIuniq ) = - (let ( !_lhsOcontainsVars,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput,!_lhsOoutputs,!_lhsOruleNames,!_lhsOuniq) = sem _lhsIcon _lhsInt _lhsIuniq - in (Syn_Rule _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOruleNames _lhsOuniq )) -sem_Rule_Rule :: (Maybe Identifier) -> - T_Pattern -> - Expression -> - Bool -> - String -> - Bool -> - T_Rule -sem_Rule_Rule !mbName_ !(T_Pattern pattern_ ) !rhs_ !owrt_ !origin_ !explicit_ = - (T_Rule (\ (!_lhsIcon) - (!_lhsInt) - (!_lhsIuniq) -> - (case (({-# LINE 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 2339 "src-ag/DefaultRules.hs" #-} - )) of - { !_patternOnt -> - (case (({-# LINE 34 "src-ag/DefaultRules.ag" #-} - _lhsIcon - {-# LINE 2344 "src-ag/DefaultRules.hs" #-} - )) of - { !_patternOcon -> - (case (pattern_ _patternOcon _patternOnt ) of - { ( !_patternIcontainsVars,!_patternIcopy,!_patternIdefinedAttrs,!_patternIerrors,!_patternIlocals,!_patternIoutput) -> - (case (({-# LINE 485 "src-ag/DefaultRules.ag" #-} - _patternIcontainsVars - {-# LINE 2351 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOcontainsVars -> - (case (({-# LINE 465 "src-ag/DefaultRules.ag" #-} - _patternIdefinedAttrs - {-# LINE 2356 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - _patternIerrors - {-# LINE 2361 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 464 "src-ag/DefaultRules.ag" #-} - _patternIlocals - {-# LINE 2366 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - Rule mbName_ _patternIoutput rhs_ owrt_ origin_ explicit_ - {-# LINE 2371 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 2376 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 518 "src-ag/DefaultRules.ag" #-} - multiRule _output _lhsIuniq - {-# LINE 2381 "src-ag/DefaultRules.hs" #-} - )) of - { !__tup2 -> - (case (({-# LINE 518 "src-ag/DefaultRules.ag" #-} - __tup2 - {-# LINE 2386 "src-ag/DefaultRules.hs" #-} - )) of - { !(!_lhsOoutputs,_) -> - (case (({-# LINE 590 "src-ag/DefaultRules.ag" #-} - case mbName_ of - Nothing -> Set.empty - Just nm -> Set.singleton nm - {-# LINE 2393 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOruleNames -> - (case (({-# LINE 518 "src-ag/DefaultRules.ag" #-} - __tup2 - {-# LINE 2398 "src-ag/DefaultRules.hs" #-} - )) of - { !(_,!_lhsOuniq) -> - ( _lhsOcontainsVars,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOoutputs,_lhsOruleNames,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) })) ) --- Rules ------------------------------------------------------- -{- - visit 0: - inherited attributes: - con : ConstructorIdent - nt : NontermIdent - chained attribute: - uniq : Int - synthesized attributes: - definedAttrs : Set (Identifier,Identifier) - errors : Seq Error - locals : Set Identifier - output : SELF - ruleNames : Set Identifier - alternatives: - alternative Cons: - child hd : Rule - child tl : Rules - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Rules :: Rules -> - T_Rules -sem_Rules !list = - (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) ) --- semantic domain -newtype T_Rules = T_Rules (ConstructorIdent -> - NontermIdent -> - Int -> - ( (Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rules ,(Set Identifier),Int)) -data Inh_Rules = Inh_Rules {con_Inh_Rules :: !(ConstructorIdent),nt_Inh_Rules :: !(NontermIdent),uniq_Inh_Rules :: !(Int)} -data Syn_Rules = Syn_Rules {definedAttrs_Syn_Rules :: !((Set (Identifier,Identifier))),errors_Syn_Rules :: !((Seq Error)),locals_Syn_Rules :: !((Set Identifier)),output_Syn_Rules :: !(Rules ),ruleNames_Syn_Rules :: !((Set Identifier)),uniq_Syn_Rules :: !(Int)} -wrap_Rules :: T_Rules -> - Inh_Rules -> - Syn_Rules -wrap_Rules !(T_Rules sem ) !(Inh_Rules _lhsIcon _lhsInt _lhsIuniq ) = - (let ( !_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput,!_lhsOruleNames,!_lhsOuniq) = sem _lhsIcon _lhsInt _lhsIuniq - in (Syn_Rules _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq )) -sem_Rules_Cons :: T_Rule -> - T_Rules -> - T_Rules -sem_Rules_Cons !(T_Rule hd_ ) !(T_Rules tl_ ) = - (T_Rules (\ (!_lhsIcon) - (!_lhsInt) - (!_lhsIuniq) -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 2451 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOuniq -> - (case (({-# LINE 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 2456 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOnt -> - (case (({-# LINE 34 "src-ag/DefaultRules.ag" #-} - _lhsIcon - {-# LINE 2461 "src-ag/DefaultRules.hs" #-} - )) of - { !_hdOcon -> - (case (hd_ _hdOcon _hdOnt _hdOuniq ) of - { ( !_hdIcontainsVars,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput,!_hdIoutputs,!_hdIruleNames,!_hdIuniq) -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _hdIuniq - {-# LINE 2468 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOuniq -> - (case (({-# LINE 33 "src-ag/DefaultRules.ag" #-} - _lhsInt - {-# LINE 2473 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOnt -> - (case (({-# LINE 34 "src-ag/DefaultRules.ag" #-} - _lhsIcon - {-# LINE 2478 "src-ag/DefaultRules.hs" #-} - )) of - { !_tlOcon -> - (case (tl_ _tlOcon _tlOnt _tlOuniq ) of - { ( !_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput,!_tlIruleNames,!_tlIuniq) -> - (case (({-# LINE 465 "src-ag/DefaultRules.ag" #-} - _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs - {-# LINE 2485 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 2490 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 464 "src-ag/DefaultRules.ag" #-} - _hdIlocals `Set.union` _tlIlocals - {-# LINE 2495 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 514 "src-ag/DefaultRules.ag" #-} - if _hdIcontainsVars then _hdIoutputs ++ _tlIoutput else _tlIoutput - {-# LINE 2500 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 588 "src-ag/DefaultRules.ag" #-} - _hdIruleNames `Set.union` _tlIruleNames - {-# LINE 2505 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOruleNames -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _tlIuniq - {-# LINE 2510 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOruleNames,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Rules_Nil :: T_Rules -sem_Rules_Nil = - (T_Rules (\ (!_lhsIcon) - (!_lhsInt) - (!_lhsIuniq) -> - (case (({-# LINE 465 "src-ag/DefaultRules.ag" #-} - Set.empty - {-# LINE 2521 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOdefinedAttrs -> - (case (({-# LINE 118 "src-ag/DefaultRules.ag" #-} - Seq.empty - {-# LINE 2526 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 464 "src-ag/DefaultRules.ag" #-} - Set.empty - {-# LINE 2531 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOlocals -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - [] - {-# LINE 2536 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 2541 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - (case (({-# LINE 588 "src-ag/DefaultRules.ag" #-} - Set.empty - {-# LINE 2546 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOruleNames -> - (case (({-# LINE 494 "src-ag/DefaultRules.ag" #-} - _lhsIuniq - {-# LINE 2551 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOuniq -> - ( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOruleNames,_lhsOuniq) }) }) }) }) }) }) })) ) --- TypeSig ----------------------------------------------------- -{- - visit 0: - synthesized attribute: - output : SELF - alternatives: - alternative TypeSig: - child name : {Identifier} - child tp : {Type} - visit 0: - local output : _ --} --- cata -sem_TypeSig :: TypeSig -> - T_TypeSig -sem_TypeSig !(TypeSig _name _tp ) = - (sem_TypeSig_TypeSig _name _tp ) --- semantic domain -newtype T_TypeSig = T_TypeSig (( TypeSig )) -data Inh_TypeSig = Inh_TypeSig {} -data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: !(TypeSig )} -wrap_TypeSig :: T_TypeSig -> - Inh_TypeSig -> - Syn_TypeSig -wrap_TypeSig !(T_TypeSig sem ) !(Inh_TypeSig ) = - (let ( !_lhsOoutput) = sem - in (Syn_TypeSig _lhsOoutput )) -sem_TypeSig_TypeSig :: Identifier -> - Type -> - T_TypeSig -sem_TypeSig_TypeSig !name_ !tp_ = - (T_TypeSig (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - TypeSig name_ tp_ - {-# LINE 2588 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 2593 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOoutput) }) }) ) --- TypeSigs ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - output : SELF - alternatives: - alternative Cons: - child hd : TypeSig - child tl : TypeSigs - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_TypeSigs :: TypeSigs -> - T_TypeSigs -sem_TypeSigs !list = - (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) ) --- semantic domain -newtype T_TypeSigs = T_TypeSigs (( TypeSigs )) -data Inh_TypeSigs = Inh_TypeSigs {} -data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: !(TypeSigs )} -wrap_TypeSigs :: T_TypeSigs -> - Inh_TypeSigs -> - Syn_TypeSigs -wrap_TypeSigs !(T_TypeSigs sem ) !(Inh_TypeSigs ) = - (let ( !_lhsOoutput) = sem - in (Syn_TypeSigs _lhsOoutput )) -sem_TypeSigs_Cons :: T_TypeSig -> - T_TypeSigs -> - T_TypeSigs -sem_TypeSigs_Cons !(T_TypeSig hd_ ) !(T_TypeSigs tl_ ) = - (T_TypeSigs (case (tl_ ) of - { ( !_tlIoutput) -> - (case (hd_ ) of - { ( !_hdIoutput) -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 2637 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 2642 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOoutput) }) }) }) }) ) -sem_TypeSigs_Nil :: T_TypeSigs -sem_TypeSigs_Nil = - (T_TypeSigs (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - [] - {-# LINE 2650 "src-ag/DefaultRules.hs" #-} - )) of - { !_output -> - (case (({-# LINE 501 "src-ag/DefaultRules.ag" #-} - _output - {-# LINE 2655 "src-ag/DefaultRules.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOoutput) }) }) ) diff --git a/dist/build/uuagc/uuagc-tmp/Desugar.hs b/dist/build/uuagc/uuagc-tmp/Desugar.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/Desugar.hs +++ /dev/null @@ -1,2811 +0,0 @@ -{-# OPTIONS_GHC -XBangPatterns #-} - --- UUAGC 0.9.39.0.0 (src-ag/Desugar.ag) -module Desugar where -{-# LINE 13 "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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 CommonTypes -{-# LINE 34 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Desugar.hs" #-} - -{-# LINE 2 "src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 41 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Desugar.hs" #-} - -{-# LINE 2 "src-ag/Expression.ag" #-} - -import UU.Scanner.Position(Pos) -import HsToken -{-# LINE 47 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Desugar.hs" #-} - -{-# LINE 2 "src-ag/HsToken.ag" #-} - -import CommonTypes -import UU.Scanner.Position(Pos) -{-# LINE 53 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Desugar.hs" #-} -{-# LINE 97 "src-ag/Desugar.ag" #-} - -addl :: Int -> Pos -> Pos -addl n (Pos l c f) = Pos (l+n) c f -{-# LINE 58 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Desugar.hs" #-} - -{-# LINE 132 "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 73 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Desugar.hs" #-} - -{-# LINE 203 "src-ag/Desugar.ag" #-} - -mergeAttributes :: AttrMap -> AttrMap -> AttrMap -mergeAttributes = Map.unionWith $ Map.unionWith $ Set.union -{-# LINE 79 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Desugar.hs" #-} - -{-# LINE 250 "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 105 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Desugar.hs" #-} --- Child ------------------------------------------------------- -{- - visit 0: - synthesized attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - output : SELF - alternatives: - alternative Child: - child name : {Identifier} - child tp : {Type} - child inh : {Attributes} - child syn : {Attributes} - child virtual : {Maybe (Maybe Type)} - visit 0: - local output : _ --} --- cata -sem_Child :: Child -> - T_Child -sem_Child !(Child _name _tp _inh _syn _virtual ) = - (sem_Child_Child _name _tp _inh _syn _virtual ) --- semantic domain -newtype T_Child = T_Child (( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Child )) -data Inh_Child = Inh_Child {} -data Syn_Child = Syn_Child {childInhs_Syn_Child :: !(([(Identifier, Identifier)])),childSyns_Syn_Child :: !(([(Identifier, Identifier)])),output_Syn_Child :: !(Child )} -wrap_Child :: T_Child -> - Inh_Child -> - Syn_Child -wrap_Child !(T_Child sem ) !(Inh_Child ) = - (let ( !_lhsOchildInhs,!_lhsOchildSyns,!_lhsOoutput) = sem - in (Syn_Child _lhsOchildInhs _lhsOchildSyns _lhsOoutput )) -sem_Child_Child :: Identifier -> - Type -> - Attributes -> - Attributes -> - (Maybe (Maybe Type)) -> - T_Child -sem_Child_Child !name_ !tp_ !inh_ !syn_ !virtual_ = - (T_Child (case (({-# LINE 129 "src-ag/Desugar.ag" #-} - [(i, name_) | i <- Map.keys inh_ ] - {-# LINE 147 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOchildInhs -> - (case (({-# LINE 130 "src-ag/Desugar.ag" #-} - [(s, name_) | s <- Map.keys syn_ ] - {-# LINE 152 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOchildSyns -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - Child name_ tp_ inh_ syn_ virtual_ - {-# LINE 157 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 162 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) }) ) --- Children ---------------------------------------------------- -{- - visit 0: - synthesized attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - output : SELF - alternatives: - alternative Cons: - child hd : Child - child tl : Children - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Children :: Children -> - T_Children -sem_Children !list = - (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) ) --- semantic domain -newtype T_Children = T_Children (( ([(Identifier, Identifier)]),([(Identifier, Identifier)]),Children )) -data Inh_Children = Inh_Children {} -data Syn_Children = Syn_Children {childInhs_Syn_Children :: !(([(Identifier, Identifier)])),childSyns_Syn_Children :: !(([(Identifier, Identifier)])),output_Syn_Children :: !(Children )} -wrap_Children :: T_Children -> - Inh_Children -> - Syn_Children -wrap_Children !(T_Children sem ) !(Inh_Children ) = - (let ( !_lhsOchildInhs,!_lhsOchildSyns,!_lhsOoutput) = sem - in (Syn_Children _lhsOchildInhs _lhsOchildSyns _lhsOoutput )) -sem_Children_Cons :: T_Child -> - T_Children -> - T_Children -sem_Children_Cons !(T_Child hd_ ) !(T_Children tl_ ) = - (T_Children (case (tl_ ) of - { ( !_tlIchildInhs,!_tlIchildSyns,!_tlIoutput) -> - (case (hd_ ) of - { ( !_hdIchildInhs,!_hdIchildSyns,!_hdIoutput) -> - (case (({-# LINE 124 "src-ag/Desugar.ag" #-} - _hdIchildInhs ++ _tlIchildInhs - {-# LINE 208 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOchildInhs -> - (case (({-# LINE 124 "src-ag/Desugar.ag" #-} - _hdIchildSyns ++ _tlIchildSyns - {-# LINE 213 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOchildSyns -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 218 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 223 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOchildInhs,_lhsOchildSyns,_lhsOoutput) }) }) }) }) }) }) ) -sem_Children_Nil :: T_Children -sem_Children_Nil = - (T_Children (case (({-# LINE 124 "src-ag/Desugar.ag" #-} - [] - {-# LINE 231 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOchildInhs -> - (case (({-# LINE 124 "src-ag/Desugar.ag" #-} - [] - {-# LINE 236 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOchildSyns -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - [] - {-# LINE 241 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 246 "src-ag/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 : SELF - alternatives: - alternative Expression: - child pos : {Pos} - child tks : {[HsToken]} - visit 0: - local _tup1 : _ - local tks' : _ --} --- cata -sem_Expression :: Expression -> - T_Expression -sem_Expression !(Expression _pos _tks ) = - (sem_Expression_Expression _pos _tks ) --- semantic domain -newtype T_Expression = T_Expression (([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - NontermIdent -> - Options -> - String -> - ( (Seq Error),Expression )) -data Inh_Expression = Inh_Expression {childInhs_Inh_Expression :: !(([(Identifier, Identifier)])),childSyns_Inh_Expression :: !(([(Identifier, Identifier)])),con_Inh_Expression :: !(ConstructorIdent),nt_Inh_Expression :: !(NontermIdent),options_Inh_Expression :: !(Options),ruleDescr_Inh_Expression :: !(String)} -data Syn_Expression = Syn_Expression {errors_Syn_Expression :: !((Seq Error)),output_Syn_Expression :: !(Expression )} -wrap_Expression :: T_Expression -> - 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 48 "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 313 "src-ag/Desugar.hs" #-} - )) of - { !__tup1 -> - (case (({-# LINE 48 "src-ag/Desugar.ag" #-} - __tup1 - {-# LINE 318 "src-ag/Desugar.hs" #-} - )) of - { !(_,!_lhsOerrors) -> - (case (({-# LINE 48 "src-ag/Desugar.ag" #-} - __tup1 - {-# LINE 323 "src-ag/Desugar.hs" #-} - )) of - { !(!_tks',_) -> - (case (({-# LINE 58 "src-ag/Desugar.ag" #-} - Expression pos_ _tks' - {-# LINE 328 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOerrors,_lhsOoutput) }) }) }) })) ) --- Grammar ----------------------------------------------------- -{- - visit 0: - inherited attributes: - forcedIrrefutables : AttrMap - options : Options - synthesized attributes: - allAttributes : AttrMap - errors : Seq Error - output : SELF - alternatives: - alternative Grammar: - child typeSyns : {TypeSyns} - child useMap : {UseMap} - child derivings : {Derivings} - child wrappers : {Set NontermIdent} - child nonts : Nonterminals - child pragmas : {PragmaMap} - child manualAttrOrderMap : {AttrOrderMap} - child paramMap : {ParamMap} - child contextMap : {ContextMap} - child 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 -> - Options -> - ( AttrMap,(Seq Error),Grammar )) -data Inh_Grammar = Inh_Grammar {forcedIrrefutables_Inh_Grammar :: !(AttrMap),options_Inh_Grammar :: !(Options)} -data Syn_Grammar = Syn_Grammar {allAttributes_Syn_Grammar :: !(AttrMap),errors_Syn_Grammar :: !((Seq Error)),output_Syn_Grammar :: !(Grammar )} -wrap_Grammar :: T_Grammar -> - Inh_Grammar -> - Syn_Grammar -wrap_Grammar !(T_Grammar sem ) !(Inh_Grammar _lhsIforcedIrrefutables _lhsIoptions ) = - (let ( !_lhsOallAttributes,!_lhsOerrors,!_lhsOoutput) = sem _lhsIforcedIrrefutables _lhsIoptions - in (Syn_Grammar _lhsOallAttributes _lhsOerrors _lhsOoutput )) -sem_Grammar_Grammar :: TypeSyns -> - UseMap -> - Derivings -> - (Set NontermIdent) -> - T_Nonterminals -> - PragmaMap -> - AttrOrderMap -> - ParamMap -> - ContextMap -> - 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) - (!_lhsIoptions) -> - (case (({-# LINE 35 "src-ag/Desugar.ag" #-} - _lhsIoptions - {-# LINE 396 "src-ag/Desugar.hs" #-} - )) of - { !_nontsOoptions -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 401 "src-ag/Desugar.hs" #-} - )) of - { !_nontsOforcedIrrefutables -> - (case (({-# LINE 234 "src-ag/Desugar.ag" #-} - augmentsMap_ - {-# LINE 406 "src-ag/Desugar.hs" #-} - )) of - { !_nontsOaugmentsIn -> - (case (nonts_ _nontsOaugmentsIn _nontsOforcedIrrefutables _nontsOoptions ) of - { ( !_nontsIallAttributes,!_nontsIaugmentsOut,!_nontsIerrors,!_nontsIoutput) -> - (case (({-# LINE 195 "src-ag/Desugar.ag" #-} - _nontsIallAttributes - {-# LINE 413 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - _nontsIerrors - {-# LINE 418 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 290 "src-ag/Desugar.ag" #-} - Grammar typeSyns_ - useMap_ - derivings_ - wrappers_ - _nontsIoutput - pragmas_ - manualAttrOrderMap_ - paramMap_ - contextMap_ - quantMap_ - uniqueMap_ - _nontsIaugmentsOut - aroundsMap_ - mergeMap_ - {-# LINE 436 "src-ag/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 : SELF - alternatives: - alternative AGField: - child field : {Identifier} - child attr : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - visit 0: - local mField : _ - local field' : _ - local tks : _ - alternative AGLocal: - child var : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - visit 0: - local tks : _ - alternative CharToken: - child value : {String} - child pos : {Pos} - visit 0: - local tks : _ - alternative Err: - child mesg : {String} - child pos : {Pos} - visit 0: - local tks : _ - alternative HsToken: - child value : {String} - child pos : {Pos} - visit 0: - local tks : _ - alternative StrToken: - child value : {String} - child pos : {Pos} - visit 0: - local tks : _ --} --- cata -sem_HsToken :: HsToken -> - T_HsToken -sem_HsToken !(AGField _field _attr _pos _rdesc ) = - (sem_HsToken_AGField _field _attr _pos _rdesc ) -sem_HsToken !(AGLocal _var _pos _rdesc ) = - (sem_HsToken_AGLocal _var _pos _rdesc ) -sem_HsToken !(CharToken _value _pos ) = - (sem_HsToken_CharToken _value _pos ) -sem_HsToken !(Err _mesg _pos ) = - (sem_HsToken_Err _mesg _pos ) -sem_HsToken !(HsToken _value _pos ) = - (sem_HsToken_HsToken _value _pos ) -sem_HsToken !(StrToken _value _pos ) = - (sem_HsToken_StrToken _value _pos ) --- semantic domain -newtype T_HsToken = T_HsToken (Int -> - ([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - NontermIdent -> - String -> - Bool -> - ( Int,(Seq Error),HsToken )) -data Inh_HsToken = Inh_HsToken {addLines_Inh_HsToken :: !(Int),childInhs_Inh_HsToken :: !(([(Identifier, Identifier)])),childSyns_Inh_HsToken :: !(([(Identifier, Identifier)])),con_Inh_HsToken :: !(ConstructorIdent),nt_Inh_HsToken :: !(NontermIdent),ruleDescr_Inh_HsToken :: !(String),useFieldIdent_Inh_HsToken :: !(Bool)} -data Syn_HsToken = Syn_HsToken {addLines_Syn_HsToken :: !(Int),errors_Syn_HsToken :: !((Seq Error)),tks_Syn_HsToken :: !(HsToken )} -wrap_HsToken :: T_HsToken -> - 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_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 78 "src-ag/Desugar.ag" #-} - findField field_ attr_ _lhsIchildSyns - {-# LINE 539 "src-ag/Desugar.hs" #-} - )) of - { !_mField -> - (case (({-# LINE 80 "src-ag/Desugar.ag" #-} - maybe field_ id _mField - {-# LINE 544 "src-ag/Desugar.hs" #-} - )) of - { !_field' -> - (case (({-# LINE 83 "src-ag/Desugar.ag" #-} - if _lhsIuseFieldIdent || length (getName field_) < length (getName _field' ) - then _lhsIaddLines + 1 - else _lhsIaddLines - {-# LINE 551 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOaddLines -> - (case (({-# LINE 81 "src-ag/Desugar.ag" #-} - maybe (Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ (Ident "" (getPos field_)) False)) (const Seq.empty) _mField - {-# LINE 556 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 87 "src-ag/Desugar.ag" #-} - AGField _field' attr_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing) - {-# LINE 561 "src-ag/Desugar.hs" #-} - )) of - { !_tks -> - (case (({-# LINE 69 "src-ag/Desugar.ag" #-} - _tks - {-# LINE 566 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOtks -> - ( _lhsOaddLines,_lhsOerrors,_lhsOtks) }) }) }) }) }) })) ) -sem_HsToken_AGLocal :: Identifier -> - Pos -> - (Maybe String) -> - T_HsToken -sem_HsToken_AGLocal !var_ !pos_ !rdesc_ = - (T_HsToken (\ (!_lhsIaddLines) - (!_lhsIchildInhs) - (!_lhsIchildSyns) - (!_lhsIcon) - (!_lhsInt) - (!_lhsIruleDescr) - (!_lhsIuseFieldIdent) -> - (case (({-# LINE 73 "src-ag/Desugar.ag" #-} - if _lhsIuseFieldIdent - then _lhsIaddLines + 1 - else _lhsIaddLines - {-# LINE 586 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOaddLines -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - Seq.empty - {-# LINE 591 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 76 "src-ag/Desugar.ag" #-} - AGLocal var_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing) - {-# LINE 596 "src-ag/Desugar.hs" #-} - )) of - { !_tks -> - (case (({-# LINE 69 "src-ag/Desugar.ag" #-} - _tks - {-# LINE 601 "src-ag/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 63 "src-ag/Desugar.ag" #-} - _lhsIaddLines - {-# LINE 618 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOaddLines -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - Seq.empty - {-# LINE 623 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 91 "src-ag/Desugar.ag" #-} - CharToken value_ (addl _lhsIaddLines pos_) - {-# LINE 628 "src-ag/Desugar.hs" #-} - )) of - { !_tks -> - (case (({-# LINE 69 "src-ag/Desugar.ag" #-} - _tks - {-# LINE 633 "src-ag/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 63 "src-ag/Desugar.ag" #-} - _lhsIaddLines - {-# LINE 650 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOaddLines -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - Seq.empty - {-# LINE 655 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 95 "src-ag/Desugar.ag" #-} - Err mesg_ (addl _lhsIaddLines pos_) - {-# LINE 660 "src-ag/Desugar.hs" #-} - )) of - { !_tks -> - (case (({-# LINE 69 "src-ag/Desugar.ag" #-} - _tks - {-# LINE 665 "src-ag/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 63 "src-ag/Desugar.ag" #-} - _lhsIaddLines - {-# LINE 682 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOaddLines -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - Seq.empty - {-# LINE 687 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 89 "src-ag/Desugar.ag" #-} - HsToken value_ (addl _lhsIaddLines pos_) - {-# LINE 692 "src-ag/Desugar.hs" #-} - )) of - { !_tks -> - (case (({-# LINE 69 "src-ag/Desugar.ag" #-} - _tks - {-# LINE 697 "src-ag/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 63 "src-ag/Desugar.ag" #-} - _lhsIaddLines - {-# LINE 714 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOaddLines -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - Seq.empty - {-# LINE 719 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 93 "src-ag/Desugar.ag" #-} - StrToken value_ (addl _lhsIaddLines pos_) - {-# LINE 724 "src-ag/Desugar.hs" #-} - )) of - { !_tks -> - (case (({-# LINE 69 "src-ag/Desugar.ag" #-} - _tks - {-# LINE 729 "src-ag/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 : SELF - alternatives: - alternative Cons: - child hd : HsToken - child tl : HsTokens - visit 0: - local tks : _ - alternative Nil: - visit 0: - local tks : _ --} --- cata -sem_HsTokens :: HsTokens -> - T_HsTokens -sem_HsTokens !list = - (Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) ) --- semantic domain -newtype T_HsTokens = T_HsTokens (Int -> - ([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - NontermIdent -> - String -> - Bool -> - ( Int,(Seq Error),HsTokens )) -data Inh_HsTokens = Inh_HsTokens {addLines_Inh_HsTokens :: !(Int),childInhs_Inh_HsTokens :: !(([(Identifier, Identifier)])),childSyns_Inh_HsTokens :: !(([(Identifier, Identifier)])),con_Inh_HsTokens :: !(ConstructorIdent),nt_Inh_HsTokens :: !(NontermIdent),ruleDescr_Inh_HsTokens :: !(String),useFieldIdent_Inh_HsTokens :: !(Bool)} -data Syn_HsTokens = Syn_HsTokens {addLines_Syn_HsTokens :: !(Int),errors_Syn_HsTokens :: !((Seq Error)),tks_Syn_HsTokens :: !(HsTokens )} -wrap_HsTokens :: T_HsTokens -> - 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 61 "src-ag/Desugar.ag" #-} - _lhsIuseFieldIdent - {-# LINE 793 "src-ag/Desugar.hs" #-} - )) of - { !_tlOuseFieldIdent -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildSyns - {-# LINE 798 "src-ag/Desugar.hs" #-} - )) of - { !_tlOchildSyns -> - (case (({-# LINE 61 "src-ag/Desugar.ag" #-} - _lhsIuseFieldIdent - {-# LINE 803 "src-ag/Desugar.hs" #-} - )) of - { !_hdOuseFieldIdent -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildSyns - {-# LINE 808 "src-ag/Desugar.hs" #-} - )) of - { !_hdOchildSyns -> - (case (({-# LINE 63 "src-ag/Desugar.ag" #-} - _lhsIaddLines - {-# LINE 813 "src-ag/Desugar.hs" #-} - )) of - { !_hdOaddLines -> - (case (({-# LINE 167 "src-ag/Desugar.ag" #-} - _lhsIruleDescr - {-# LINE 818 "src-ag/Desugar.hs" #-} - )) of - { !_hdOruleDescr -> - (case (({-# LINE 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 823 "src-ag/Desugar.hs" #-} - )) of - { !_hdOnt -> - (case (({-# LINE 152 "src-ag/Desugar.ag" #-} - _lhsIcon - {-# LINE 828 "src-ag/Desugar.hs" #-} - )) of - { !_hdOcon -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildInhs - {-# LINE 833 "src-ag/Desugar.hs" #-} - )) of - { !_hdOchildInhs -> - (case (hd_ _hdOaddLines _hdOchildInhs _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent ) of - { ( !_hdIaddLines,!_hdIerrors,!_hdItks) -> - (case (({-# LINE 63 "src-ag/Desugar.ag" #-} - _hdIaddLines - {-# LINE 840 "src-ag/Desugar.hs" #-} - )) of - { !_tlOaddLines -> - (case (({-# LINE 167 "src-ag/Desugar.ag" #-} - _lhsIruleDescr - {-# LINE 845 "src-ag/Desugar.hs" #-} - )) of - { !_tlOruleDescr -> - (case (({-# LINE 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 850 "src-ag/Desugar.hs" #-} - )) of - { !_tlOnt -> - (case (({-# LINE 152 "src-ag/Desugar.ag" #-} - _lhsIcon - {-# LINE 855 "src-ag/Desugar.hs" #-} - )) of - { !_tlOcon -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildInhs - {-# LINE 860 "src-ag/Desugar.hs" #-} - )) of - { !_tlOchildInhs -> - (case (tl_ _tlOaddLines _tlOchildInhs _tlOchildSyns _tlOcon _tlOnt _tlOruleDescr _tlOuseFieldIdent ) of - { ( !_tlIaddLines,!_tlIerrors,!_tlItks) -> - (case (({-# LINE 63 "src-ag/Desugar.ag" #-} - _tlIaddLines - {-# LINE 867 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOaddLines -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 872 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 69 "src-ag/Desugar.ag" #-} - (:) _hdItks _tlItks - {-# LINE 877 "src-ag/Desugar.hs" #-} - )) of - { !_tks -> - (case (({-# LINE 69 "src-ag/Desugar.ag" #-} - _tks - {-# LINE 882 "src-ag/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 63 "src-ag/Desugar.ag" #-} - _lhsIaddLines - {-# LINE 897 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOaddLines -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - Seq.empty - {-# LINE 902 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 69 "src-ag/Desugar.ag" #-} - [] - {-# LINE 907 "src-ag/Desugar.hs" #-} - )) of - { !_tks -> - (case (({-# LINE 69 "src-ag/Desugar.ag" #-} - _tks - {-# LINE 912 "src-ag/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 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 965 "src-ag/Desugar.hs" #-} - )) of - { !_tokensOnt -> - (case (({-# LINE 152 "src-ag/Desugar.ag" #-} - _lhsIcon - {-# LINE 970 "src-ag/Desugar.hs" #-} - )) of - { !_tokensOcon -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildSyns - {-# LINE 975 "src-ag/Desugar.hs" #-} - )) of - { !_tokensOchildSyns -> - (case (({-# LINE 61 "src-ag/Desugar.ag" #-} - _lhsIuseFieldIdent - {-# LINE 980 "src-ag/Desugar.hs" #-} - )) of - { !_tokensOuseFieldIdent -> - (case (({-# LINE 167 "src-ag/Desugar.ag" #-} - _lhsIruleDescr - {-# LINE 985 "src-ag/Desugar.hs" #-} - )) of - { !_tokensOruleDescr -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildInhs - {-# LINE 990 "src-ag/Desugar.hs" #-} - )) of - { !_tokensOchildInhs -> - (case (({-# LINE 66 "src-ag/Desugar.ag" #-} - 0 - {-# LINE 995 "src-ag/Desugar.hs" #-} - )) of - { !_tokensOaddLines -> - (case (tokens_ _tokensOaddLines _tokensOchildInhs _tokensOchildSyns _tokensOcon _tokensOnt _tokensOruleDescr _tokensOuseFieldIdent ) of - { ( !_tokensIaddLines,!_tokensIerrors,!_tokensItks) -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - _tokensIerrors - {-# LINE 1002 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 68 "src-ag/Desugar.ag" #-} - _tokensItks - {-# LINE 1007 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOtks -> - ( _lhsOerrors,_lhsOtks) }) }) }) }) }) }) }) }) }) })) ) --- Nonterminal ------------------------------------------------- -{- - visit 0: - inherited attributes: - augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - forcedIrrefutables : AttrMap - options : Options - synthesized attributes: - allAttributes : AttrMap - augmentsOut : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - errors : Seq Error - output : SELF - alternatives: - alternative Nonterminal: - child nt : {NontermIdent} - child params : {[Identifier]} - child inh : {Attributes} - child syn : {Attributes} - child prods : Productions - visit 0: - local augmentsIn : _ - local augmentsOut : _ - 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 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - AttrMap -> - Options -> - ( 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),options_Inh_Nonterminal :: !(Options)} -data Syn_Nonterminal = Syn_Nonterminal {allAttributes_Syn_Nonterminal :: !(AttrMap),augmentsOut_Syn_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),errors_Syn_Nonterminal :: !((Seq Error)),output_Syn_Nonterminal :: !(Nonterminal )} -wrap_Nonterminal :: T_Nonterminal -> - Inh_Nonterminal -> - Syn_Nonterminal -wrap_Nonterminal !(T_Nonterminal sem ) !(Inh_Nonterminal _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIoptions ) = - (let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIoptions - in (Syn_Nonterminal _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput )) -sem_Nonterminal_Nonterminal :: NontermIdent -> - ([Identifier]) -> - Attributes -> - Attributes -> - T_Productions -> - T_Nonterminal -sem_Nonterminal_Nonterminal !nt_ !params_ !inh_ !syn_ !(T_Productions prods_ ) = - (T_Nonterminal (\ (!_lhsIaugmentsIn) - (!_lhsIforcedIrrefutables) - (!_lhsIoptions) -> - (case (({-# LINE 156 "src-ag/Desugar.ag" #-} - nt_ - {-# LINE 1065 "src-ag/Desugar.hs" #-} - )) of - { !_prodsOnt -> - (case (({-# LINE 35 "src-ag/Desugar.ag" #-} - _lhsIoptions - {-# LINE 1070 "src-ag/Desugar.hs" #-} - )) of - { !_prodsOoptions -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 1075 "src-ag/Desugar.hs" #-} - )) of - { !_prodsOforcedIrrefutables -> - (case (({-# LINE 238 "src-ag/Desugar.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn - {-# LINE 1080 "src-ag/Desugar.hs" #-} - )) of - { !_augmentsIn -> - (case (({-# LINE 229 "src-ag/Desugar.ag" #-} - _augmentsIn - {-# LINE 1085 "src-ag/Desugar.hs" #-} - )) of - { !_prodsOaugmentsIn -> - (case (prods_ _prodsOaugmentsIn _prodsOforcedIrrefutables _prodsOnt _prodsOoptions ) of - { ( !_prodsIallAttributes,!_prodsIaugmentsOut,!_prodsIerrors,!_prodsIoutput) -> - (case (({-# LINE 195 "src-ag/Desugar.ag" #-} - _prodsIallAttributes - {-# LINE 1092 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 239 "src-ag/Desugar.ag" #-} - Map.singleton nt_ _prodsIaugmentsOut - {-# LINE 1097 "src-ag/Desugar.hs" #-} - )) of - { !_augmentsOut -> - (case (({-# LINE 228 "src-ag/Desugar.ag" #-} - _augmentsOut - {-# LINE 1102 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOaugmentsOut -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - _prodsIerrors - {-# LINE 1107 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - Nonterminal nt_ params_ inh_ syn_ _prodsIoutput - {-# LINE 1112 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 1117 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) })) ) --- Nonterminals ------------------------------------------------ -{- - visit 0: - inherited attributes: - augmentsIn : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - forcedIrrefutables : AttrMap - options : Options - synthesized attributes: - allAttributes : AttrMap - augmentsOut : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Nonterminal - child tl : Nonterminals - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Nonterminals :: Nonterminals -> - T_Nonterminals -sem_Nonterminals !list = - (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) ) --- semantic domain -newtype T_Nonterminals = T_Nonterminals ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - AttrMap -> - Options -> - ( 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),options_Inh_Nonterminals :: !(Options)} -data Syn_Nonterminals = Syn_Nonterminals {allAttributes_Syn_Nonterminals :: !(AttrMap),augmentsOut_Syn_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),errors_Syn_Nonterminals :: !((Seq Error)),output_Syn_Nonterminals :: !(Nonterminals )} -wrap_Nonterminals :: T_Nonterminals -> - Inh_Nonterminals -> - Syn_Nonterminals -wrap_Nonterminals !(T_Nonterminals sem ) !(Inh_Nonterminals _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIoptions ) = - (let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIoptions - in (Syn_Nonterminals _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput )) -sem_Nonterminals_Cons :: T_Nonterminal -> - T_Nonterminals -> - T_Nonterminals -sem_Nonterminals_Cons !(T_Nonterminal hd_ ) !(T_Nonterminals tl_ ) = - (T_Nonterminals (\ (!_lhsIaugmentsIn) - (!_lhsIforcedIrrefutables) - (!_lhsIoptions) -> - (case (({-# LINE 35 "src-ag/Desugar.ag" #-} - _lhsIoptions - {-# LINE 1170 "src-ag/Desugar.hs" #-} - )) of - { !_tlOoptions -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 1175 "src-ag/Desugar.hs" #-} - )) of - { !_tlOforcedIrrefutables -> - (case (({-# LINE 227 "src-ag/Desugar.ag" #-} - _lhsIaugmentsIn - {-# LINE 1180 "src-ag/Desugar.hs" #-} - )) of - { !_tlOaugmentsIn -> - (case (tl_ _tlOaugmentsIn _tlOforcedIrrefutables _tlOoptions ) of - { ( !_tlIallAttributes,!_tlIaugmentsOut,!_tlIerrors,!_tlIoutput) -> - (case (({-# LINE 35 "src-ag/Desugar.ag" #-} - _lhsIoptions - {-# LINE 1187 "src-ag/Desugar.hs" #-} - )) of - { !_hdOoptions -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 1192 "src-ag/Desugar.hs" #-} - )) of - { !_hdOforcedIrrefutables -> - (case (({-# LINE 227 "src-ag/Desugar.ag" #-} - _lhsIaugmentsIn - {-# LINE 1197 "src-ag/Desugar.hs" #-} - )) of - { !_hdOaugmentsIn -> - (case (hd_ _hdOaugmentsIn _hdOforcedIrrefutables _hdOoptions ) of - { ( !_hdIallAttributes,!_hdIaugmentsOut,!_hdIerrors,!_hdIoutput) -> - (case (({-# LINE 195 "src-ag/Desugar.ag" #-} - _hdIallAttributes `mergeAttributes` _tlIallAttributes - {-# LINE 1204 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 228 "src-ag/Desugar.ag" #-} - _hdIaugmentsOut `Map.union` _tlIaugmentsOut - {-# LINE 1209 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOaugmentsOut -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 1214 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 1219 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 1224 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Nonterminals_Nil :: T_Nonterminals -sem_Nonterminals_Nil = - (T_Nonterminals (\ (!_lhsIaugmentsIn) - (!_lhsIforcedIrrefutables) - (!_lhsIoptions) -> - (case (({-# LINE 195 "src-ag/Desugar.ag" #-} - Map.empty - {-# LINE 1235 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 228 "src-ag/Desugar.ag" #-} - Map.empty - {-# LINE 1240 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOaugmentsOut -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - Seq.empty - {-# LINE 1245 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - [] - {-# LINE 1250 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 1255 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) })) ) --- Pattern ----------------------------------------------------- -{- - visit 0: - synthesized attribute: - defsCollect : Set (Identifier, Identifier) - visit 1: - inherited attributes: - childInhs : [(Identifier, Identifier)] - childSyns : [(Identifier, Identifier)] - con : ConstructorIdent - defs : Set (Identifier, Identifier) - forcedIrrefutables : AttrMap - nt : NontermIdent - synthesized attributes: - allAttributes : AttrMap - copy : SELF - errors : Seq Error - output : SELF - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local def : _ - visit 1: - local copy : _ - local _tup2 : _ - local field' : _ - local err2 : _ - local err1 : _ - local output : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 1: - local copy : _ - local output : _ - alternative Irrefutable: - child pat : Pattern - visit 1: - local copy : _ - local output : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 1: - local copy : _ - local output : _ - alternative Underscore: - child pos : {Pos} - visit 1: - local copy : _ - local output : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern !(Alias _field _attr _pat _parts ) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) -sem_Pattern !(Constr _name _pats ) = - (sem_Pattern_Constr _name (sem_Patterns _pats ) ) -sem_Pattern !(Irrefutable _pat ) = - (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) -sem_Pattern !(Product _pos _pats ) = - (sem_Pattern_Product _pos (sem_Patterns _pats ) ) -sem_Pattern !(Underscore _pos ) = - (sem_Pattern_Underscore _pos ) --- semantic domain -newtype T_Pattern = T_Pattern (( (Set (Identifier, Identifier)),T_Pattern_1 )) -newtype T_Pattern_1 = T_Pattern_1 (([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - (Set (Identifier, Identifier)) -> - AttrMap -> - NontermIdent -> - ( AttrMap,Pattern ,(Seq Error),Pattern )) -data Inh_Pattern = Inh_Pattern {childInhs_Inh_Pattern :: !(([(Identifier, Identifier)])),childSyns_Inh_Pattern :: !(([(Identifier, Identifier)])),con_Inh_Pattern :: !(ConstructorIdent),defs_Inh_Pattern :: !((Set (Identifier, Identifier))),forcedIrrefutables_Inh_Pattern :: !(AttrMap),nt_Inh_Pattern :: !(NontermIdent)} -data Syn_Pattern = Syn_Pattern {allAttributes_Syn_Pattern :: !(AttrMap),copy_Syn_Pattern :: !(Pattern ),defsCollect_Syn_Pattern :: !((Set (Identifier, Identifier))),errors_Syn_Pattern :: !((Seq Error)),output_Syn_Pattern :: !(Pattern )} -wrap_Pattern :: T_Pattern -> - 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_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_ ) !(T_Patterns parts_ ) = - (T_Pattern (case (({-# LINE 181 "src-ag/Desugar.ag" #-} - Set.singleton (field_, attr_) - {-# LINE 1354 "src-ag/Desugar.hs" #-} - )) of - { !_def -> - (case (parts_ ) of - { ( !_partsIdefsCollect,!T_Patterns_1 parts_1) -> - (case (pat_ ) of - { ( !_patIdefsCollect,!T_Pattern_1 pat_1) -> - (case (({-# LINE 182 "src-ag/Desugar.ag" #-} - _def `Set.union` _patIdefsCollect `Set.union` _partsIdefsCollect - {-# LINE 1363 "src-ag/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 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 1376 "src-ag/Desugar.hs" #-} - )) of - { !_patOnt -> - (case (({-# LINE 152 "src-ag/Desugar.ag" #-} - _lhsIcon - {-# LINE 1381 "src-ag/Desugar.hs" #-} - )) of - { !_patOcon -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 1386 "src-ag/Desugar.hs" #-} - )) of - { !_patOforcedIrrefutables -> - (case (({-# LINE 184 "src-ag/Desugar.ag" #-} - _lhsIdefs - {-# LINE 1391 "src-ag/Desugar.hs" #-} - )) of - { !_patOdefs -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildSyns - {-# LINE 1396 "src-ag/Desugar.hs" #-} - )) of - { !_patOchildSyns -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildInhs - {-# LINE 1401 "src-ag/Desugar.hs" #-} - )) of - { !_patOchildInhs -> - (case (pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt ) of - { ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) -> - (case (({-# LINE 199 "src-ag/Desugar.ag" #-} - (Map.singleton _lhsInt $ Map.singleton _lhsIcon $ Set.singleton (field_, attr_)) `mergeAttributes` _patIallAttributes - {-# LINE 1408 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 1413 "src-ag/Desugar.hs" #-} - )) of - { !_partsOnt -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 1418 "src-ag/Desugar.hs" #-} - )) of - { !_partsOforcedIrrefutables -> - (case (({-# LINE 184 "src-ag/Desugar.ag" #-} - _lhsIdefs - {-# LINE 1423 "src-ag/Desugar.hs" #-} - )) of - { !_partsOdefs -> - (case (({-# LINE 152 "src-ag/Desugar.ag" #-} - _lhsIcon - {-# LINE 1428 "src-ag/Desugar.hs" #-} - )) of - { !_partsOcon -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildSyns - {-# LINE 1433 "src-ag/Desugar.hs" #-} - )) of - { !_partsOchildSyns -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildInhs - {-# LINE 1438 "src-ag/Desugar.hs" #-} - )) of - { !_partsOchildInhs -> - (case (parts_1 _partsOchildInhs _partsOchildSyns _partsOcon _partsOdefs _partsOforcedIrrefutables _partsOnt ) of - { ( !_partsIallAttributes,!_partsIcopy,!_partsIerrors,!_partsIoutput) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 1445 "src-ag/Desugar.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1450 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 109 "src-ag/Desugar.ag" #-} - maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "" (getPos field_)) attr_ True) $ - findField field_ attr_ _lhsIchildInhs - {-# LINE 1456 "src-ag/Desugar.hs" #-} - )) of - { !__tup2 -> - (case (({-# LINE 109 "src-ag/Desugar.ag" #-} - __tup2 - {-# LINE 1461 "src-ag/Desugar.hs" #-} - )) of - { !(!_field',_) -> - (case (({-# LINE 111 "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 1470 "src-ag/Desugar.hs" #-} - )) of - { !_err2 -> - (case (({-# LINE 109 "src-ag/Desugar.ag" #-} - __tup2 - {-# LINE 1475 "src-ag/Desugar.hs" #-} - )) of - { !(_,!_err1) -> - (case (({-# LINE 116 "src-ag/Desugar.ag" #-} - _err1 Seq.>< _err2 Seq.>< _patIerrors Seq.>< _partsIerrors - {-# LINE 1480 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 117 "src-ag/Desugar.ag" #-} - Alias _field' attr_ _patIoutput _partsIoutput - {-# LINE 1485 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 218 "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 1492 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) - in sem_Pattern_Alias_1)) of - { ( !sem_Pattern_1) -> - ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) }) }) ) -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 178 "src-ag/Desugar.ag" #-} - _patsIdefsCollect - {-# LINE 1507 "src-ag/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 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 1520 "src-ag/Desugar.hs" #-} - )) of - { !_patsOnt -> - (case (({-# LINE 152 "src-ag/Desugar.ag" #-} - _lhsIcon - {-# LINE 1525 "src-ag/Desugar.hs" #-} - )) of - { !_patsOcon -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 1530 "src-ag/Desugar.hs" #-} - )) of - { !_patsOforcedIrrefutables -> - (case (({-# LINE 184 "src-ag/Desugar.ag" #-} - _lhsIdefs - {-# LINE 1535 "src-ag/Desugar.hs" #-} - )) of - { !_patsOdefs -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildSyns - {-# LINE 1540 "src-ag/Desugar.hs" #-} - )) of - { !_patsOchildSyns -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildInhs - {-# LINE 1545 "src-ag/Desugar.hs" #-} - )) of - { !_patsOchildInhs -> - (case (pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt ) of - { ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) -> - (case (({-# LINE 195 "src-ag/Desugar.ag" #-} - _patsIallAttributes - {-# LINE 1552 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 1557 "src-ag/Desugar.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1562 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - _patsIerrors - {-# LINE 1567 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - Constr name_ _patsIoutput - {-# LINE 1572 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 1577 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) ) - in sem_Pattern_Constr_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 178 "src-ag/Desugar.ag" #-} - _patIdefsCollect - {-# LINE 1591 "src-ag/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 201 "src-ag/Desugar.ag" #-} - Map.empty - {-# LINE 1604 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 1609 "src-ag/Desugar.hs" #-} - )) of - { !_patOnt -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 1614 "src-ag/Desugar.hs" #-} - )) of - { !_patOforcedIrrefutables -> - (case (({-# LINE 184 "src-ag/Desugar.ag" #-} - _lhsIdefs - {-# LINE 1619 "src-ag/Desugar.hs" #-} - )) of - { !_patOdefs -> - (case (({-# LINE 152 "src-ag/Desugar.ag" #-} - _lhsIcon - {-# LINE 1624 "src-ag/Desugar.hs" #-} - )) of - { !_patOcon -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildSyns - {-# LINE 1629 "src-ag/Desugar.hs" #-} - )) of - { !_patOchildSyns -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildInhs - {-# LINE 1634 "src-ag/Desugar.hs" #-} - )) of - { !_patOchildInhs -> - (case (pat_1 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt ) of - { ( !_patIallAttributes,!_patIcopy,!_patIerrors,!_patIoutput) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 1641 "src-ag/Desugar.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1646 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - _patIerrors - {-# LINE 1651 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - Irrefutable _patIoutput - {-# LINE 1656 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 1661 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) ) - in sem_Pattern_Irrefutable_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 178 "src-ag/Desugar.ag" #-} - _patsIdefsCollect - {-# LINE 1676 "src-ag/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 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 1689 "src-ag/Desugar.hs" #-} - )) of - { !_patsOnt -> - (case (({-# LINE 152 "src-ag/Desugar.ag" #-} - _lhsIcon - {-# LINE 1694 "src-ag/Desugar.hs" #-} - )) of - { !_patsOcon -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 1699 "src-ag/Desugar.hs" #-} - )) of - { !_patsOforcedIrrefutables -> - (case (({-# LINE 184 "src-ag/Desugar.ag" #-} - _lhsIdefs - {-# LINE 1704 "src-ag/Desugar.hs" #-} - )) of - { !_patsOdefs -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildSyns - {-# LINE 1709 "src-ag/Desugar.hs" #-} - )) of - { !_patsOchildSyns -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildInhs - {-# LINE 1714 "src-ag/Desugar.hs" #-} - )) of - { !_patsOchildInhs -> - (case (pats_1 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt ) of - { ( !_patsIallAttributes,!_patsIcopy,!_patsIerrors,!_patsIoutput) -> - (case (({-# LINE 195 "src-ag/Desugar.ag" #-} - _patsIallAttributes - {-# LINE 1721 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 1726 "src-ag/Desugar.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1731 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - _patsIerrors - {-# LINE 1736 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - Product pos_ _patsIoutput - {-# LINE 1741 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 1746 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOcopy,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) })) ) - in sem_Pattern_Product_1)) of - { ( !sem_Pattern_1) -> - ( _lhsOdefsCollect,sem_Pattern_1) }) }) }) ) -sem_Pattern_Underscore :: Pos -> - T_Pattern -sem_Pattern_Underscore !pos_ = - (T_Pattern (case (({-# LINE 178 "src-ag/Desugar.ag" #-} - Set.empty - {-# LINE 1758 "src-ag/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 195 "src-ag/Desugar.ag" #-} - Map.empty - {-# LINE 1771 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Underscore pos_ - {-# LINE 1776 "src-ag/Desugar.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1781 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - Seq.empty - {-# LINE 1786 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - Underscore pos_ - {-# LINE 1791 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 1796 "src-ag/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 : SELF - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Pattern - child tl : Patterns - visit 1: - local copy : _ - local output : _ - alternative Nil: - visit 1: - local copy : _ - local output : _ --} --- cata -sem_Patterns :: Patterns -> - T_Patterns -sem_Patterns !list = - (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) ) --- semantic domain -newtype T_Patterns = T_Patterns (( (Set (Identifier, Identifier)),T_Patterns_1 )) -newtype T_Patterns_1 = T_Patterns_1 (([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - (Set (Identifier, Identifier)) -> - AttrMap -> - NontermIdent -> - ( AttrMap,Patterns ,(Seq Error),Patterns )) -data Inh_Patterns = Inh_Patterns {childInhs_Inh_Patterns :: !(([(Identifier, Identifier)])),childSyns_Inh_Patterns :: !(([(Identifier, Identifier)])),con_Inh_Patterns :: !(ConstructorIdent),defs_Inh_Patterns :: !((Set (Identifier, Identifier))),forcedIrrefutables_Inh_Patterns :: !(AttrMap),nt_Inh_Patterns :: !(NontermIdent)} -data Syn_Patterns = Syn_Patterns {allAttributes_Syn_Patterns :: !(AttrMap),copy_Syn_Patterns :: !(Patterns ),defsCollect_Syn_Patterns :: !((Set (Identifier, Identifier))),errors_Syn_Patterns :: !((Seq Error)),output_Syn_Patterns :: !(Patterns )} -wrap_Patterns :: T_Patterns -> - 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 178 "src-ag/Desugar.ag" #-} - _hdIdefsCollect `Set.union` _tlIdefsCollect - {-# LINE 1866 "src-ag/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 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 1879 "src-ag/Desugar.hs" #-} - )) of - { !_tlOnt -> - (case (({-# LINE 152 "src-ag/Desugar.ag" #-} - _lhsIcon - {-# LINE 1884 "src-ag/Desugar.hs" #-} - )) of - { !_tlOcon -> - (case (({-# LINE 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 1889 "src-ag/Desugar.hs" #-} - )) of - { !_hdOnt -> - (case (({-# LINE 152 "src-ag/Desugar.ag" #-} - _lhsIcon - {-# LINE 1894 "src-ag/Desugar.hs" #-} - )) of - { !_hdOcon -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 1899 "src-ag/Desugar.hs" #-} - )) of - { !_tlOforcedIrrefutables -> - (case (({-# LINE 184 "src-ag/Desugar.ag" #-} - _lhsIdefs - {-# LINE 1904 "src-ag/Desugar.hs" #-} - )) of - { !_tlOdefs -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildSyns - {-# LINE 1909 "src-ag/Desugar.hs" #-} - )) of - { !_tlOchildSyns -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildInhs - {-# LINE 1914 "src-ag/Desugar.hs" #-} - )) of - { !_tlOchildInhs -> - (case (tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt ) of - { ( !_tlIallAttributes,!_tlIcopy,!_tlIerrors,!_tlIoutput) -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 1921 "src-ag/Desugar.hs" #-} - )) of - { !_hdOforcedIrrefutables -> - (case (({-# LINE 184 "src-ag/Desugar.ag" #-} - _lhsIdefs - {-# LINE 1926 "src-ag/Desugar.hs" #-} - )) of - { !_hdOdefs -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildSyns - {-# LINE 1931 "src-ag/Desugar.hs" #-} - )) of - { !_hdOchildSyns -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildInhs - {-# LINE 1936 "src-ag/Desugar.hs" #-} - )) of - { !_hdOchildInhs -> - (case (hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt ) of - { ( !_hdIallAttributes,!_hdIcopy,!_hdIerrors,!_hdIoutput) -> - (case (({-# LINE 195 "src-ag/Desugar.ag" #-} - _hdIallAttributes `mergeAttributes` _tlIallAttributes - {-# LINE 1943 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 1948 "src-ag/Desugar.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1953 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 1958 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 1963 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 1968 "src-ag/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 178 "src-ag/Desugar.ag" #-} - Set.empty - {-# LINE 1979 "src-ag/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 195 "src-ag/Desugar.ag" #-} - Map.empty - {-# LINE 1992 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - [] - {-# LINE 1997 "src-ag/Desugar.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 2002 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - Seq.empty - {-# LINE 2007 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - [] - {-# LINE 2012 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 2017 "src-ag/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 - nt : NontermIdent - options : Options - synthesized attributes: - allAttributes : AttrMap - augmentsOut : Map ConstructorIdent (Map Identifier [Expression]) - errors : Seq Error - output : SELF - alternatives: - alternative Production: - child con : {ConstructorIdent} - child children : Children - child rules : Rules - child typeSigs : TypeSigs - visit 0: - local augmentsIn : _ - local _tup3 : _ - local augmentsOut1 : _ - local augmentsOut : _ - local augmentErrs : _ - local output : _ --} --- cata -sem_Production :: Production -> - T_Production -sem_Production !(Production _con _children _rules _typeSigs ) = - (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) --- semantic domain -newtype T_Production = T_Production ((Map ConstructorIdent (Map Identifier [Expression])) -> - AttrMap -> - NontermIdent -> - Options -> - ( 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),nt_Inh_Production :: !(NontermIdent),options_Inh_Production :: !(Options)} -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 _lhsInt _lhsIoptions ) = - (let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsInt _lhsIoptions - in (Syn_Production _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput )) -sem_Production_Production :: ConstructorIdent -> - T_Children -> - T_Rules -> - T_TypeSigs -> - T_Production -sem_Production_Production !con_ !(T_Children children_ ) !(T_Rules rules_ ) !(T_TypeSigs typeSigs_ ) = - (T_Production (\ (!_lhsIaugmentsIn) - (!_lhsIforcedIrrefutables) - (!_lhsInt) - (!_lhsIoptions) -> - (case (({-# LINE 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 2082 "src-ag/Desugar.hs" #-} - )) of - { !_rulesOnt -> - (case (({-# LINE 160 "src-ag/Desugar.ag" #-} - con_ - {-# LINE 2087 "src-ag/Desugar.hs" #-} - )) of - { !_rulesOcon -> - (case (rules_ ) of - { ( !_rulesIdefsCollect,!T_Rules_1 rules_1) -> - (case (({-# LINE 35 "src-ag/Desugar.ag" #-} - _lhsIoptions - {-# LINE 2094 "src-ag/Desugar.hs" #-} - )) of - { !_rulesOoptions -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 2099 "src-ag/Desugar.hs" #-} - )) of - { !_rulesOforcedIrrefutables -> - (case (children_ ) of - { ( !_childrenIchildInhs,!_childrenIchildSyns,!_childrenIoutput) -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _childrenIchildSyns - {-# LINE 2106 "src-ag/Desugar.hs" #-} - )) of - { !_rulesOchildSyns -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _childrenIchildInhs - {-# LINE 2111 "src-ag/Desugar.hs" #-} - )) of - { !_rulesOchildInhs -> - (case (({-# LINE 187 "src-ag/Desugar.ag" #-} - _rulesIdefsCollect - {-# LINE 2116 "src-ag/Desugar.hs" #-} - )) of - { !_rulesOdefs -> - (case (rules_1 _rulesOchildInhs _rulesOchildSyns _rulesOcon _rulesOdefs _rulesOforcedIrrefutables _rulesOnt _rulesOoptions ) of - { ( !_rulesIallAttributes,!_rulesIerrors,!_rulesIoutput) -> - (case (({-# LINE 195 "src-ag/Desugar.ag" #-} - _rulesIallAttributes - {-# LINE 2123 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 243 "src-ag/Desugar.ag" #-} - Map.findWithDefault Map.empty con_ _lhsIaugmentsIn - {-# LINE 2128 "src-ag/Desugar.hs" #-} - )) of - { !_augmentsIn -> - (case (({-# LINE 246 "src-ag/Desugar.ag" #-} - Map.mapAccum (desugarExprs _lhsIoptions _lhsInt con_ _childrenIchildInhs _childrenIchildSyns) Seq.empty _augmentsIn - {-# LINE 2133 "src-ag/Desugar.hs" #-} - )) of - { !__tup3 -> - (case (({-# LINE 246 "src-ag/Desugar.ag" #-} - __tup3 - {-# LINE 2138 "src-ag/Desugar.hs" #-} - )) of - { !(_,!_augmentsOut1) -> - (case (({-# LINE 244 "src-ag/Desugar.ag" #-} - Map.singleton con_ _augmentsOut1 - {-# LINE 2143 "src-ag/Desugar.hs" #-} - )) of - { !_augmentsOut -> - (case (({-# LINE 230 "src-ag/Desugar.ag" #-} - _augmentsOut - {-# LINE 2148 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOaugmentsOut -> - (case (({-# LINE 246 "src-ag/Desugar.ag" #-} - __tup3 - {-# LINE 2153 "src-ag/Desugar.hs" #-} - )) of - { !(!_augmentErrs,_) -> - (case (({-# LINE 282 "src-ag/Desugar.ag" #-} - _rulesIerrors Seq.>< _augmentErrs - {-# LINE 2158 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (typeSigs_ ) of - { ( !_typeSigsIoutput) -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - Production con_ _childrenIoutput _rulesIoutput _typeSigsIoutput - {-# LINE 2165 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 2170 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) --- Productions ------------------------------------------------- -{- - visit 0: - inherited attributes: - augmentsIn : Map ConstructorIdent (Map Identifier [Expression]) - forcedIrrefutables : AttrMap - nt : NontermIdent - options : Options - synthesized attributes: - allAttributes : AttrMap - augmentsOut : Map ConstructorIdent (Map Identifier [Expression]) - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Production - child tl : Productions - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Productions :: Productions -> - T_Productions -sem_Productions !list = - (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) ) --- semantic domain -newtype T_Productions = T_Productions ((Map ConstructorIdent (Map Identifier [Expression])) -> - AttrMap -> - NontermIdent -> - Options -> - ( 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),nt_Inh_Productions :: !(NontermIdent),options_Inh_Productions :: !(Options)} -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 _lhsInt _lhsIoptions ) = - (let ( !_lhsOallAttributes,!_lhsOaugmentsOut,!_lhsOerrors,!_lhsOoutput) = sem _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsInt _lhsIoptions - 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) - (!_lhsInt) - (!_lhsIoptions) -> - (case (({-# LINE 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 2226 "src-ag/Desugar.hs" #-} - )) of - { !_tlOnt -> - (case (({-# LINE 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 2231 "src-ag/Desugar.hs" #-} - )) of - { !_hdOnt -> - (case (({-# LINE 35 "src-ag/Desugar.ag" #-} - _lhsIoptions - {-# LINE 2236 "src-ag/Desugar.hs" #-} - )) of - { !_tlOoptions -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 2241 "src-ag/Desugar.hs" #-} - )) of - { !_tlOforcedIrrefutables -> - (case (({-# LINE 229 "src-ag/Desugar.ag" #-} - _lhsIaugmentsIn - {-# LINE 2246 "src-ag/Desugar.hs" #-} - )) of - { !_tlOaugmentsIn -> - (case (tl_ _tlOaugmentsIn _tlOforcedIrrefutables _tlOnt _tlOoptions ) of - { ( !_tlIallAttributes,!_tlIaugmentsOut,!_tlIerrors,!_tlIoutput) -> - (case (({-# LINE 35 "src-ag/Desugar.ag" #-} - _lhsIoptions - {-# LINE 2253 "src-ag/Desugar.hs" #-} - )) of - { !_hdOoptions -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 2258 "src-ag/Desugar.hs" #-} - )) of - { !_hdOforcedIrrefutables -> - (case (({-# LINE 229 "src-ag/Desugar.ag" #-} - _lhsIaugmentsIn - {-# LINE 2263 "src-ag/Desugar.hs" #-} - )) of - { !_hdOaugmentsIn -> - (case (hd_ _hdOaugmentsIn _hdOforcedIrrefutables _hdOnt _hdOoptions ) of - { ( !_hdIallAttributes,!_hdIaugmentsOut,!_hdIerrors,!_hdIoutput) -> - (case (({-# LINE 195 "src-ag/Desugar.ag" #-} - _hdIallAttributes `mergeAttributes` _tlIallAttributes - {-# LINE 2270 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 230 "src-ag/Desugar.ag" #-} - _hdIaugmentsOut `Map.union` _tlIaugmentsOut - {-# LINE 2275 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOaugmentsOut -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 2280 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 2285 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 2290 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOallAttributes,_lhsOaugmentsOut,_lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Productions_Nil :: T_Productions -sem_Productions_Nil = - (T_Productions (\ (!_lhsIaugmentsIn) - (!_lhsIforcedIrrefutables) - (!_lhsInt) - (!_lhsIoptions) -> - (case (({-# LINE 195 "src-ag/Desugar.ag" #-} - Map.empty - {-# LINE 2302 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 230 "src-ag/Desugar.ag" #-} - Map.empty - {-# LINE 2307 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOaugmentsOut -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - Seq.empty - {-# LINE 2312 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - [] - {-# LINE 2317 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 2322 "src-ag/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 : SELF - alternatives: - alternative Rule: - child mbName : {Maybe Identifier} - child pattern : Pattern - child rhs : Expression - child owrt : {Bool} - child origin : {String} - child explicit : {Bool} - visit 1: - local ruleDescr : _ - local output : _ --} --- cata -sem_Rule :: Rule -> - T_Rule -sem_Rule !(Rule _mbName _pattern _rhs _owrt _origin _explicit ) = - (sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) --- 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 -> - T_Rule -sem_Rule_Rule !mbName_ !(T_Pattern pattern_ ) !(T_Expression rhs_ ) !owrt_ !origin_ !explicit_ = - (T_Rule (case (pattern_ ) of - { ( !_patternIdefsCollect,!T_Pattern_1 pattern_1) -> - (case (({-# LINE 178 "src-ag/Desugar.ag" #-} - _patternIdefsCollect - {-# LINE 2392 "src-ag/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 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 2406 "src-ag/Desugar.hs" #-} - )) of - { !_patternOnt -> - (case (({-# LINE 152 "src-ag/Desugar.ag" #-} - _lhsIcon - {-# LINE 2411 "src-ag/Desugar.hs" #-} - )) of - { !_patternOcon -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 2416 "src-ag/Desugar.hs" #-} - )) of - { !_patternOforcedIrrefutables -> - (case (({-# LINE 184 "src-ag/Desugar.ag" #-} - _lhsIdefs - {-# LINE 2421 "src-ag/Desugar.hs" #-} - )) of - { !_patternOdefs -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildSyns - {-# LINE 2426 "src-ag/Desugar.hs" #-} - )) of - { !_patternOchildSyns -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildInhs - {-# LINE 2431 "src-ag/Desugar.hs" #-} - )) of - { !_patternOchildInhs -> - (case (pattern_1 _patternOchildInhs _patternOchildSyns _patternOcon _patternOdefs _patternOforcedIrrefutables _patternOnt ) of - { ( !_patternIallAttributes,!_patternIcopy,!_patternIerrors,!_patternIoutput) -> - (case (({-# LINE 195 "src-ag/Desugar.ag" #-} - _patternIallAttributes - {-# LINE 2438 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 171 "src-ag/Desugar.ag" #-} - show _lhsInt ++ " :: " ++ show _lhsIcon ++ " :: " ++ (concat $ intersperse "," $ map (\(f,a) -> show f ++ "." ++ show a) $ Set.toList _patternIdefsCollect) - {-# LINE 2443 "src-ag/Desugar.hs" #-} - )) of - { !_ruleDescr -> - (case (({-# LINE 167 "src-ag/Desugar.ag" #-} - _ruleDescr - {-# LINE 2448 "src-ag/Desugar.hs" #-} - )) of - { !_rhsOruleDescr -> - (case (({-# LINE 35 "src-ag/Desugar.ag" #-} - _lhsIoptions - {-# LINE 2453 "src-ag/Desugar.hs" #-} - )) of - { !_rhsOoptions -> - (case (({-# LINE 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 2458 "src-ag/Desugar.hs" #-} - )) of - { !_rhsOnt -> - (case (({-# LINE 152 "src-ag/Desugar.ag" #-} - _lhsIcon - {-# LINE 2463 "src-ag/Desugar.hs" #-} - )) of - { !_rhsOcon -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildSyns - {-# LINE 2468 "src-ag/Desugar.hs" #-} - )) of - { !_rhsOchildSyns -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildInhs - {-# LINE 2473 "src-ag/Desugar.hs" #-} - )) of - { !_rhsOchildInhs -> - (case (rhs_ _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr ) of - { ( !_rhsIerrors,!_rhsIoutput) -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - _patternIerrors Seq.>< _rhsIerrors - {-# LINE 2480 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - Rule mbName_ _patternIoutput _rhsIoutput owrt_ origin_ explicit_ - {-# LINE 2485 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 2490 "src-ag/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 : SELF - alternatives: - alternative Cons: - child hd : Rule - child tl : Rules - visit 1: - local output : _ - alternative Nil: - visit 1: - local output : _ --} --- cata -sem_Rules :: Rules -> - T_Rules -sem_Rules !list = - (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) ) --- semantic domain -newtype T_Rules = T_Rules (( (Set (Identifier, Identifier)),T_Rules_1 )) -newtype T_Rules_1 = T_Rules_1 (([(Identifier, Identifier)]) -> - ([(Identifier, Identifier)]) -> - ConstructorIdent -> - (Set (Identifier, Identifier)) -> - AttrMap -> - NontermIdent -> - Options -> - ( AttrMap,(Seq Error),Rules )) -data Inh_Rules = Inh_Rules {childInhs_Inh_Rules :: !(([(Identifier, Identifier)])),childSyns_Inh_Rules :: !(([(Identifier, Identifier)])),con_Inh_Rules :: !(ConstructorIdent),defs_Inh_Rules :: !((Set (Identifier, Identifier))),forcedIrrefutables_Inh_Rules :: !(AttrMap),nt_Inh_Rules :: !(NontermIdent),options_Inh_Rules :: !(Options)} -data Syn_Rules = Syn_Rules {allAttributes_Syn_Rules :: !(AttrMap),defsCollect_Syn_Rules :: !((Set (Identifier, Identifier))),errors_Syn_Rules :: !((Seq Error)),output_Syn_Rules :: !(Rules )} -wrap_Rules :: T_Rules -> - 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 178 "src-ag/Desugar.ag" #-} - _hdIdefsCollect `Set.union` _tlIdefsCollect - {-# LINE 2559 "src-ag/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 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 2573 "src-ag/Desugar.hs" #-} - )) of - { !_tlOnt -> - (case (({-# LINE 152 "src-ag/Desugar.ag" #-} - _lhsIcon - {-# LINE 2578 "src-ag/Desugar.hs" #-} - )) of - { !_tlOcon -> - (case (({-# LINE 151 "src-ag/Desugar.ag" #-} - _lhsInt - {-# LINE 2583 "src-ag/Desugar.hs" #-} - )) of - { !_hdOnt -> - (case (({-# LINE 152 "src-ag/Desugar.ag" #-} - _lhsIcon - {-# LINE 2588 "src-ag/Desugar.hs" #-} - )) of - { !_hdOcon -> - (case (({-# LINE 35 "src-ag/Desugar.ag" #-} - _lhsIoptions - {-# LINE 2593 "src-ag/Desugar.hs" #-} - )) of - { !_tlOoptions -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 2598 "src-ag/Desugar.hs" #-} - )) of - { !_tlOforcedIrrefutables -> - (case (({-# LINE 184 "src-ag/Desugar.ag" #-} - _lhsIdefs - {-# LINE 2603 "src-ag/Desugar.hs" #-} - )) of - { !_tlOdefs -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildSyns - {-# LINE 2608 "src-ag/Desugar.hs" #-} - )) of - { !_tlOchildSyns -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildInhs - {-# LINE 2613 "src-ag/Desugar.hs" #-} - )) of - { !_tlOchildInhs -> - (case (tl_1 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt _tlOoptions ) of - { ( !_tlIallAttributes,!_tlIerrors,!_tlIoutput) -> - (case (({-# LINE 35 "src-ag/Desugar.ag" #-} - _lhsIoptions - {-# LINE 2620 "src-ag/Desugar.hs" #-} - )) of - { !_hdOoptions -> - (case (({-# LINE 214 "src-ag/Desugar.ag" #-} - _lhsIforcedIrrefutables - {-# LINE 2625 "src-ag/Desugar.hs" #-} - )) of - { !_hdOforcedIrrefutables -> - (case (({-# LINE 184 "src-ag/Desugar.ag" #-} - _lhsIdefs - {-# LINE 2630 "src-ag/Desugar.hs" #-} - )) of - { !_hdOdefs -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildSyns - {-# LINE 2635 "src-ag/Desugar.hs" #-} - )) of - { !_hdOchildSyns -> - (case (({-# LINE 125 "src-ag/Desugar.ag" #-} - _lhsIchildInhs - {-# LINE 2640 "src-ag/Desugar.hs" #-} - )) of - { !_hdOchildInhs -> - (case (hd_1 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt _hdOoptions ) of - { ( !_hdIallAttributes,!_hdIerrors,!_hdIoutput) -> - (case (({-# LINE 195 "src-ag/Desugar.ag" #-} - _hdIallAttributes `mergeAttributes` _tlIallAttributes - {-# LINE 2647 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 2652 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 2657 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 2662 "src-ag/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 178 "src-ag/Desugar.ag" #-} - Set.empty - {-# LINE 2673 "src-ag/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 195 "src-ag/Desugar.ag" #-} - Map.empty - {-# LINE 2687 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOallAttributes -> - (case (({-# LINE 37 "src-ag/Desugar.ag" #-} - Seq.empty - {-# LINE 2692 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOerrors -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - [] - {-# LINE 2697 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 2702 "src-ag/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 : SELF - alternatives: - alternative TypeSig: - child name : {Identifier} - child tp : {Type} - visit 0: - local output : _ --} --- cata -sem_TypeSig :: TypeSig -> - T_TypeSig -sem_TypeSig !(TypeSig _name _tp ) = - (sem_TypeSig_TypeSig _name _tp ) --- semantic domain -newtype T_TypeSig = T_TypeSig (( TypeSig )) -data Inh_TypeSig = Inh_TypeSig {} -data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: !(TypeSig )} -wrap_TypeSig :: T_TypeSig -> - Inh_TypeSig -> - Syn_TypeSig -wrap_TypeSig !(T_TypeSig sem ) !(Inh_TypeSig ) = - (let ( !_lhsOoutput) = sem - in (Syn_TypeSig _lhsOoutput )) -sem_TypeSig_TypeSig :: Identifier -> - Type -> - T_TypeSig -sem_TypeSig_TypeSig !name_ !tp_ = - (T_TypeSig (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - TypeSig name_ tp_ - {-# LINE 2742 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 2747 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOoutput) }) }) ) --- TypeSigs ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - output : SELF - alternatives: - alternative Cons: - child hd : TypeSig - child tl : TypeSigs - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_TypeSigs :: TypeSigs -> - T_TypeSigs -sem_TypeSigs !list = - (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) ) --- semantic domain -newtype T_TypeSigs = T_TypeSigs (( TypeSigs )) -data Inh_TypeSigs = Inh_TypeSigs {} -data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: !(TypeSigs )} -wrap_TypeSigs :: T_TypeSigs -> - Inh_TypeSigs -> - Syn_TypeSigs -wrap_TypeSigs !(T_TypeSigs sem ) !(Inh_TypeSigs ) = - (let ( !_lhsOoutput) = sem - in (Syn_TypeSigs _lhsOoutput )) -sem_TypeSigs_Cons :: T_TypeSig -> - T_TypeSigs -> - T_TypeSigs -sem_TypeSigs_Cons !(T_TypeSig hd_ ) !(T_TypeSigs tl_ ) = - (T_TypeSigs (case (tl_ ) of - { ( !_tlIoutput) -> - (case (hd_ ) of - { ( !_hdIoutput) -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 2791 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 2796 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOoutput) }) }) }) }) ) -sem_TypeSigs_Nil :: T_TypeSigs -sem_TypeSigs_Nil = - (T_TypeSigs (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - [] - {-# LINE 2804 "src-ag/Desugar.hs" #-} - )) of - { !_output -> - (case (({-# LINE 39 "src-ag/Desugar.ag" #-} - _output - {-# LINE 2809 "src-ag/Desugar.hs" #-} - )) of - { !_lhsOoutput -> - ( _lhsOoutput) }) }) ) diff --git a/dist/build/uuagc/uuagc-tmp/ErrorMessages.hs b/dist/build/uuagc/uuagc-tmp/ErrorMessages.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/ErrorMessages.hs +++ /dev/null @@ -1,181 +0,0 @@ - - --- UUAGC 0.9.39.0.0 (src-ag/ErrorMessages.ag) -module ErrorMessages where -{-# LINE 2 "src-ag/ErrorMessages.ag" #-} - -import UU.Scanner.Position(Pos) -import Pretty -import DepTypes(Trace) -import CodeSyntax -import CommonTypes -{-# LINE 13 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/ErrorMessages.hs" #-} --- Error ------------------------------------------------------- -{- - alternatives: - alternative ChildAsLocal: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child var : {Identifier} - alternative CustomError: - child isWarning : {Bool} - child pos : {Pos} - child mesg : {PP_Doc} - alternative CyclicSet: - child name : {Identifier} - alternative DirectCirc: - child nt : {NontermIdent} - child o_visit : {Bool} - child cyclic : {[((Identifier,Identifier),[String],[String])]} - alternative DupAlt: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child occ1 : {ConstructorIdent} - alternative DupChild: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child name : {Identifier} - child occ1 : {Identifier} - alternative DupInhAttr: - child nt : {NontermIdent} - child attr : {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 DupSet: - child name : {NontermIdent} - child occ1 : {NontermIdent} - alternative DupSig: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - alternative DupSynAttr: - child nt : {NontermIdent} - child attr : {Identifier} - child occ1 : {Identifier} - alternative DupSynonym: - child nt : {NontermIdent} - child occ1 : {NontermIdent} - alternative DupUnique: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - alternative HsParseError: - child pos : {Pos} - child msg : {String} - alternative InducedCirc: - child nt : {NontermIdent} - child cinter : {CInterface} - child cyclic : {[((Identifier,Identifier),[String],[String])]} - alternative InstCirc: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - child o_visit : {Bool} - child path : {[String]} - alternative LocalCirc: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - child o_visit : {Bool} - child path : {[String]} - alternative MissingInstSig: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - alternative MissingNamedRule: - child nt : {NontermIdent} - child con : {Identifier} - child name : {Identifier} - alternative MissingRule: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child field : {Identifier} - child attr : {Identifier} - alternative MissingSyn: - child nt : {NontermIdent} - child attr : {Identifier} - alternative MissingTypeSig: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - alternative MissingUnique: - child nt : {NontermIdent} - child attr : {Identifier} - alternative ParserError: - child pos : {Pos} - child problem : {String} - child action : {String} - alternative SuperfluousRule: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child field : {Identifier} - child attr : {Identifier} - alternative UndefAlt: - child nt : {NontermIdent} - child con : {ConstructorIdent} - alternative UndefAttr: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child field : {Identifier} - child attr : {Identifier} - child isOut : {Bool} - alternative UndefChild: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child name : {Identifier} - alternative UndefLocal: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child var : {Identifier} - alternative UndefNont: - child nt : {NontermIdent} --} -data Error = ChildAsLocal (NontermIdent) (ConstructorIdent) (Identifier) - | CustomError (Bool) (Pos) (PP_Doc) - | CyclicSet (Identifier) - | DirectCirc (NontermIdent) (Bool) (([((Identifier,Identifier),[String],[String])])) - | DupAlt (NontermIdent) (ConstructorIdent) (ConstructorIdent) - | DupChild (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) - | DupInhAttr (NontermIdent) (Identifier) (Identifier) - | DupRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) (Identifier) - | DupRuleName (NontermIdent) (ConstructorIdent) (Identifier) - | DupSet (NontermIdent) (NontermIdent) - | DupSig (NontermIdent) (ConstructorIdent) (Identifier) - | DupSynAttr (NontermIdent) (Identifier) (Identifier) - | DupSynonym (NontermIdent) (NontermIdent) - | DupUnique (NontermIdent) (ConstructorIdent) (Identifier) - | HsParseError (Pos) (String) - | InducedCirc (NontermIdent) (CInterface) (([((Identifier,Identifier),[String],[String])])) - | InstCirc (NontermIdent) (ConstructorIdent) (Identifier) (Bool) (([String])) - | LocalCirc (NontermIdent) (ConstructorIdent) (Identifier) (Bool) (([String])) - | MissingInstSig (NontermIdent) (ConstructorIdent) (Identifier) - | MissingNamedRule (NontermIdent) (Identifier) (Identifier) - | MissingRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) - | MissingSyn (NontermIdent) (Identifier) - | MissingTypeSig (NontermIdent) (ConstructorIdent) (Identifier) - | MissingUnique (NontermIdent) (Identifier) - | ParserError (Pos) (String) (String) - | SuperfluousRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) - | UndefAlt (NontermIdent) (ConstructorIdent) - | UndefAttr (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) (Bool) - | UndefChild (NontermIdent) (ConstructorIdent) (Identifier) - | UndefLocal (NontermIdent) (ConstructorIdent) (Identifier) - | UndefNont (NontermIdent) --- Errors ------------------------------------------------------ -{- - alternatives: - alternative Cons: - child hd : Error - child tl : Errors - alternative Nil: --} -type Errors = [Error ] diff --git a/dist/build/uuagc/uuagc-tmp/ExecutionPlan.hs b/dist/build/uuagc/uuagc-tmp/ExecutionPlan.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/ExecutionPlan.hs +++ /dev/null @@ -1,149 +0,0 @@ - - --- UUAGC 0.9.39.0.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 qualified Data.Set as Set -{-# LINE 14 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/ExecutionPlan.hs" #-} --- EChild ------------------------------------------------------ -{- - alternatives: - alternative EChild: - child name : {Identifier} - child tp : {Type} - child virtual : {Maybe (Maybe Type)} --} -data EChild = EChild (Identifier) (Type) ((Maybe (Maybe 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 initial : {StateIdentifier} - child initialv : {Maybe VisitIdentifier} - child prods : EProductions --} -data ENonterminal = ENonterminal (NontermIdent) (([Identifier])) (StateIdentifier) ((Maybe VisitIdentifier)) (EProductions ) --- ENonterminals ----------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : ENonterminal - child tl : ENonterminals - alternative Nil: --} -type ENonterminals = [ENonterminal ] --- EProduction ------------------------------------------------- -{- - alternatives: - alternative EProduction: - child con : {ConstructorIdent} - child rules : ERules - child children : EChildren - child visits : Visits --} -data EProduction = EProduction (ConstructorIdent) (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} --} -data ERule = ERule (Identifier) (Pattern) (Expression) (Bool) (String) (Bool) --- 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.Set NontermIdent} - child derivings : {Derivings} --} -data ExecutionPlan = ExecutionPlan (ENonterminals ) (TypeSyns) ((Set.Set NontermIdent)) (Derivings) --- Visit ------------------------------------------------------- -{- - alternatives: - alternative Visit: - child ident : {VisitIdentifier} - child from : {StateIdentifier} - child to : {StateIdentifier} - child inh : {Set.Set Identifier} - child syn : {Set.Set Identifier} - child steps : VisitSteps --} -data Visit = Visit (VisitIdentifier) (StateIdentifier) (StateIdentifier) ((Set.Set Identifier)) ((Set.Set Identifier)) (VisitSteps ) --- VisitStep --------------------------------------------------- -{- - alternatives: - alternative ChildIntro: - child child : {Identifier} - alternative ChildVisit: - child child : {Identifier} - child nonterm : {NontermIdent} - child visit : {VisitIdentifier} - alternative Sem: - child name : {Identifier} - alternative Sim: - child steps : VisitSteps --} -data VisitStep = ChildIntro (Identifier) - | ChildVisit (Identifier) (NontermIdent) (VisitIdentifier) - | Sem (Identifier) - | Sim (VisitSteps ) --- 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/uuagc/uuagc-tmp/ExecutionPlan2Hs.hs b/dist/build/uuagc/uuagc-tmp/ExecutionPlan2Hs.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/ExecutionPlan2Hs.hs +++ /dev/null @@ -1,4744 +0,0 @@ - - --- UUAGC 0.9.39.0.0 (src-ag/ExecutionPlan2Hs.ag) -module ExecutionPlan2Hs where -{-# LINE 7 "src-ag/ExecutionPlan2Hs.ag" #-} - -import ExecutionPlan -import Pretty -import PPUtil -import Options -import Data.Maybe -import Debug.Trace -import System.IO -import System.Directory - -import TokenDef -import HsToken - -import qualified Data.Set as Set -import qualified Data.Map as Map -{-# LINE 22 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/ExecutionPlan2Hs.hs" #-} - -{-# LINE 2 "src-ag/ExecutionPlan.ag" #-} - --- VisitSyntax.ag imports -import Patterns (Pattern(..),Patterns) -import Expression (Expression(..)) -import CommonTypes - -import qualified Data.Set as Set -{-# LINE 32 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/ExecutionPlan2Hs.hs" #-} - -{-# LINE 2 "src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 39 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/ExecutionPlan2Hs.hs" #-} - -{-# LINE 2 "src-ag/Expression.ag" #-} - -import UU.Scanner.Position(Pos) -import HsToken -{-# LINE 45 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/ExecutionPlan2Hs.hs" #-} - -{-# LINE 2 "src-ag/HsToken.ag" #-} - -import CommonTypes -import UU.Scanner.Position(Pos) -{-# LINE 51 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/ExecutionPlan2Hs.hs" #-} -{-# LINE 204 "src-ag/ExecutionPlan2Hs.ag" #-} -type VisitStateState = (VisitIdentifier,StateIdentifier, StateIdentifier) -{-# LINE 54 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/ExecutionPlan2Hs.hs" #-} - -{-# LINE 475 "src-ag/ExecutionPlan2Hs.ag" #-} - -uwSetUnion :: (Ord a, Ord b) => Map.Map a (Set.Set b) -> Map.Map a (Set.Set b) -> Map.Map a (Set.Set b) -uwSetUnion = Map.unionWith Set.union -{-# LINE 60 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/ExecutionPlan2Hs.hs" #-} - -{-# LINE 644 "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 80 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/ExecutionPlan2Hs.hs" #-} --- EChild ------------------------------------------------------ -{- - visit 0: - inherited attributes: - nt : NontermIdent - options : Options - synthesized attributes: - argnames : PP_Doc - argnamesw : PP_Doc - argtps : PP_Doc - childintros : Map.Map Identifier PP_Doc - datatype : PP_Doc - terminaldefs : Set.Set String - alternatives: - alternative EChild: - child name : {Identifier} - child tp : {Type} - child virtual : {Maybe (Maybe Type)} - visit 0: - local addStrict : _ - local argnames : _ --} --- cata -sem_EChild :: EChild -> - T_EChild -sem_EChild (EChild _name _tp _virtual ) = - (sem_EChild_EChild _name _tp _virtual ) --- semantic domain -newtype T_EChild = T_EChild (NontermIdent -> - Options -> - ( ( PP_Doc ),( PP_Doc ),( PP_Doc ),(Map.Map Identifier PP_Doc),PP_Doc,(Set.Set String))) -data Inh_EChild = Inh_EChild {nt_Inh_EChild :: NontermIdent,options_Inh_EChild :: Options} -data Syn_EChild = Syn_EChild {argnames_Syn_EChild :: ( PP_Doc ),argnamesw_Syn_EChild :: ( PP_Doc ),argtps_Syn_EChild :: ( PP_Doc ),childintros_Syn_EChild :: (Map.Map Identifier PP_Doc),datatype_Syn_EChild :: PP_Doc,terminaldefs_Syn_EChild :: (Set.Set String)} -wrap_EChild :: T_EChild -> - Inh_EChild -> - Syn_EChild -wrap_EChild (T_EChild sem ) (Inh_EChild _lhsInt _lhsIoptions ) = - (let ( _lhsOargnames,_lhsOargnamesw,_lhsOargtps,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs) = sem _lhsInt _lhsIoptions - in (Syn_EChild _lhsOargnames _lhsOargnamesw _lhsOargtps _lhsOchildintros _lhsOdatatype _lhsOterminaldefs )) -sem_EChild_EChild :: Identifier -> - Type -> - (Maybe (Maybe Type)) -> - T_EChild -sem_EChild_EChild name_ tp_ virtual_ = - (T_EChild (\ _lhsInt - _lhsIoptions -> - (let _lhsOdatatype :: PP_Doc - _lhsOargnamesw :: ( PP_Doc ) - _lhsOargtps :: ( PP_Doc ) - _lhsOchildintros :: (Map.Map Identifier PP_Doc) - _lhsOterminaldefs :: (Set.Set String) - _lhsOargnames :: ( PP_Doc ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 127, column 12) - _lhsOdatatype = - ({-# LINE 127 "src-ag/ExecutionPlan2Hs.ag" #-} - if isJust virtual_ - then empty - else _addStrict $ pp_parens $ typeToHaskellString (Just _lhsInt) [] tp_ - {-# LINE 139 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 130, column 12) - _addStrict = - ({-# LINE 130 "src-ag/ExecutionPlan2Hs.ag" #-} - \x -> if strictData _lhsIoptions then "!" >|< x else x - {-# LINE 145 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 177, column 12) - _lhsOargnamesw = - ({-# LINE 177 "src-ag/ExecutionPlan2Hs.ag" #-} - if isJust virtual_ - then empty - else if isNonterminal tp_ - then "(" >#< "sem_" >|< extractNonterminal tp_ >#< "field_" >|< name_ >#< ")" - else text $ locname name_ - {-# LINE 155 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 324, column 12) - _lhsOargtps = - ({-# LINE 324 "src-ag/ExecutionPlan2Hs.ag" #-} - if isJust virtual_ - then empty - else if isNonterminal tp_ - then ("T_" >|< extractNonterminal tp_) >#< "->" - else (text $ show tp_) >#< "->" - {-# LINE 165 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 329, column 12) - _argnames = - ({-# LINE 329 "src-ag/ExecutionPlan2Hs.ag" #-} - if isJust virtual_ - then empty - else if isNonterminal tp_ - then "field_" >|< name_ - else text $ locname name_ - {-# LINE 175 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 390, column 12) - _lhsOchildintros = - ({-# LINE 390 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton name_ $ locname name_ >#< "<-" >#< "return" >#< "$" >#< - if isJust virtual_ - then "sem_" >|< extractNonterminal tp_ >#< instname name_ - else "field_" >|< name_ - {-# LINE 184 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 486, column 12) - _lhsOterminaldefs = - ({-# LINE 486 "src-ag/ExecutionPlan2Hs.ag" #-} - if isJust virtual_ || isNonterminal tp_ - then Set.empty - else Set.singleton $ locname name_ - {-# LINE 192 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (from local) - _lhsOargnames = - ({-# LINE 319 "src-ag/ExecutionPlan2Hs.ag" #-} - _argnames - {-# LINE 198 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOargnames,_lhsOargnamesw,_lhsOargtps,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs))) ) --- EChildren --------------------------------------------------- -{- - visit 0: - inherited attributes: - nt : NontermIdent - options : Options - synthesized attributes: - argnames : [PP_Doc] - argnamesw : [PP_Doc] - argtps : [PP_Doc] - childintros : Map.Map Identifier PP_Doc - datatype : [PP_Doc] - terminaldefs : Set.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 (NontermIdent -> - Options -> - ( ( [PP_Doc] ),([PP_Doc]),( [PP_Doc] ),(Map.Map Identifier PP_Doc),([PP_Doc]),(Set.Set String))) -data Inh_EChildren = Inh_EChildren {nt_Inh_EChildren :: NontermIdent,options_Inh_EChildren :: Options} -data Syn_EChildren = Syn_EChildren {argnames_Syn_EChildren :: ( [PP_Doc] ),argnamesw_Syn_EChildren :: ([PP_Doc]),argtps_Syn_EChildren :: ( [PP_Doc] ),childintros_Syn_EChildren :: (Map.Map Identifier PP_Doc),datatype_Syn_EChildren :: ([PP_Doc]),terminaldefs_Syn_EChildren :: (Set.Set String)} -wrap_EChildren :: T_EChildren -> - Inh_EChildren -> - Syn_EChildren -wrap_EChildren (T_EChildren sem ) (Inh_EChildren _lhsInt _lhsIoptions ) = - (let ( _lhsOargnames,_lhsOargnamesw,_lhsOargtps,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs) = sem _lhsInt _lhsIoptions - in (Syn_EChildren _lhsOargnames _lhsOargnamesw _lhsOargtps _lhsOchildintros _lhsOdatatype _lhsOterminaldefs )) -sem_EChildren_Cons :: T_EChild -> - T_EChildren -> - T_EChildren -sem_EChildren_Cons (T_EChild hd_ ) (T_EChildren tl_ ) = - (T_EChildren (\ _lhsInt - _lhsIoptions -> - (let _lhsOargnames :: ( [PP_Doc] ) - _lhsOargnamesw :: ([PP_Doc]) - _lhsOargtps :: ( [PP_Doc] ) - _lhsOchildintros :: (Map.Map Identifier PP_Doc) - _lhsOdatatype :: ([PP_Doc]) - _lhsOterminaldefs :: (Set.Set String) - _hdOnt :: NontermIdent - _hdOoptions :: Options - _tlOnt :: NontermIdent - _tlOoptions :: Options - _hdIargnames :: ( PP_Doc ) - _hdIargnamesw :: ( PP_Doc ) - _hdIargtps :: ( PP_Doc ) - _hdIchildintros :: (Map.Map Identifier PP_Doc) - _hdIdatatype :: PP_Doc - _hdIterminaldefs :: (Set.Set String) - _tlIargnames :: ( [PP_Doc] ) - _tlIargnamesw :: ([PP_Doc]) - _tlIargtps :: ( [PP_Doc] ) - _tlIchildintros :: (Map.Map Identifier PP_Doc) - _tlIdatatype :: ([PP_Doc]) - _tlIterminaldefs :: (Set.Set String) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 321, column 31) - _lhsOargnames = - ({-# LINE 321 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIargnames : _tlIargnames - {-# LINE 269 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 174, column 32) - _lhsOargnamesw = - ({-# LINE 174 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIargnamesw : _tlIargnamesw - {-# LINE 275 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 320, column 31) - _lhsOargtps = - ({-# LINE 320 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIargtps : _tlIargtps - {-# LINE 281 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 381, column 41) - _lhsOchildintros = - ({-# LINE 381 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIchildintros `Map.union` _tlIchildintros - {-# LINE 287 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 124, column 51) - _lhsOdatatype = - ({-# LINE 124 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIdatatype : _tlIdatatype - {-# LINE 293 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 483, column 42) - _lhsOterminaldefs = - ({-# LINE 483 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIterminaldefs `Set.union` _tlIterminaldefs - {-# LINE 299 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 123 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsInt - {-# LINE 305 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 41 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptions - {-# LINE 311 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 124 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsInt - {-# LINE 317 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 41 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptions - {-# LINE 323 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _hdIargnames,_hdIargnamesw,_hdIargtps,_hdIchildintros,_hdIdatatype,_hdIterminaldefs) = - hd_ _hdOnt _hdOoptions - ( _tlIargnames,_tlIargnamesw,_tlIargtps,_tlIchildintros,_tlIdatatype,_tlIterminaldefs) = - tl_ _tlOnt _tlOoptions - in ( _lhsOargnames,_lhsOargnamesw,_lhsOargtps,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs))) ) -sem_EChildren_Nil :: T_EChildren -sem_EChildren_Nil = - (T_EChildren (\ _lhsInt - _lhsIoptions -> - (let _lhsOargnames :: ( [PP_Doc] ) - _lhsOargnamesw :: ([PP_Doc]) - _lhsOargtps :: ( [PP_Doc] ) - _lhsOchildintros :: (Map.Map Identifier PP_Doc) - _lhsOdatatype :: ([PP_Doc]) - _lhsOterminaldefs :: (Set.Set String) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 321, column 31) - _lhsOargnames = - ({-# LINE 321 "src-ag/ExecutionPlan2Hs.ag" #-} - [] - {-# LINE 344 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 174, column 32) - _lhsOargnamesw = - ({-# LINE 174 "src-ag/ExecutionPlan2Hs.ag" #-} - [] - {-# LINE 350 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 320, column 31) - _lhsOargtps = - ({-# LINE 320 "src-ag/ExecutionPlan2Hs.ag" #-} - [] - {-# LINE 356 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 381, column 41) - _lhsOchildintros = - ({-# LINE 381 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.empty - {-# LINE 362 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 124, column 51) - _lhsOdatatype = - ({-# LINE 124 "src-ag/ExecutionPlan2Hs.ag" #-} - [] - {-# LINE 368 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 483, column 42) - _lhsOterminaldefs = - ({-# LINE 483 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.empty - {-# LINE 374 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOargnames,_lhsOargnamesw,_lhsOargtps,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs))) ) --- ENonterminal ------------------------------------------------ -{- - visit 0: - inherited attributes: - allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) - avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) - avisituses : Map.Map VisitIdentifier (Set.Set Identifier) - derivings : Derivings - importBlocks : PP_Doc - inhmap : Map.Map NontermIdent Attributes - mainFile : String - mainName : String - moduleHeader : String -> String -> String -> Bool -> String - options : Options - optionsLine : String - pragmaBlocks : String - synmap : Map.Map NontermIdent Attributes - textBlocks : PP_Doc - typeSyns : TypeSyns - wrappers : Set.Set NontermIdent - synthesized attributes: - appendCommon : PP_Doc - appendMain : PP_Doc - childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) - genProdIO : IO () - imports : [PP_Doc] - output : PP_Doc - visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) - visituses : Map.Map VisitIdentifier (Set.Set Identifier) - alternatives: - alternative ENonterminal: - child nt : {NontermIdent} - child params : {[Identifier]} - child initial : {StateIdentifier} - child initialv : {Maybe VisitIdentifier} - child prods : EProductions - visit 0: - local datatype : _ - local derivings : _ - local fsemname : _ - local semname : _ - local frecarg : _ - local sem_nt : _ - local outedges : _ - local inedges : _ - local allstates : _ - local t_type : _ - local t_init : _ - local t_states : _ - local k_type : _ - local k_states : _ - local wr_inh : _ - local wr_syn : _ - local genwrap : _ - local wr_inhs : _ - local wr_syns : _ - local inhlist : _ - local synlist : _ - local wrapname : _ - local inhname : _ - local synname : _ - local wrapper : _ --} --- cata -sem_ENonterminal :: ENonterminal -> - T_ENonterminal -sem_ENonterminal (ENonterminal _nt _params _initial _initialv _prods ) = - (sem_ENonterminal_ENonterminal _nt _params _initial _initialv (sem_EProductions _prods ) ) --- semantic domain -newtype T_ENonterminal = T_ENonterminal ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - Derivings -> - PP_Doc -> - (Map.Map NontermIdent Attributes) -> - String -> - String -> - (String -> String -> String -> Bool -> String) -> - Options -> - String -> - String -> - (Map.Map NontermIdent Attributes) -> - PP_Doc -> - TypeSyns -> - (Set.Set NontermIdent) -> - ( ( PP_Doc ),( PP_Doc ),(Map.Map VisitIdentifier (Identifier -> PP_Doc)),(IO ()),([PP_Doc]),PP_Doc,(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) -data Inh_ENonterminal = Inh_ENonterminal {allchildvisit_Inh_ENonterminal :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),avisitdefs_Inh_ENonterminal :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_ENonterminal :: (Map.Map VisitIdentifier (Set.Set Identifier)),derivings_Inh_ENonterminal :: Derivings,importBlocks_Inh_ENonterminal :: PP_Doc,inhmap_Inh_ENonterminal :: (Map.Map NontermIdent Attributes),mainFile_Inh_ENonterminal :: String,mainName_Inh_ENonterminal :: String,moduleHeader_Inh_ENonterminal :: (String -> String -> String -> Bool -> String),options_Inh_ENonterminal :: Options,optionsLine_Inh_ENonterminal :: String,pragmaBlocks_Inh_ENonterminal :: String,synmap_Inh_ENonterminal :: (Map.Map NontermIdent Attributes),textBlocks_Inh_ENonterminal :: PP_Doc,typeSyns_Inh_ENonterminal :: TypeSyns,wrappers_Inh_ENonterminal :: (Set.Set NontermIdent)} -data Syn_ENonterminal = Syn_ENonterminal {appendCommon_Syn_ENonterminal :: ( PP_Doc ),appendMain_Syn_ENonterminal :: ( PP_Doc ),childvisit_Syn_ENonterminal :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),genProdIO_Syn_ENonterminal :: (IO ()),imports_Syn_ENonterminal :: ([PP_Doc]),output_Syn_ENonterminal :: PP_Doc,visitdefs_Syn_ENonterminal :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_ENonterminal :: (Map.Map VisitIdentifier (Set.Set Identifier))} -wrap_ENonterminal :: T_ENonterminal -> - Inh_ENonterminal -> - Syn_ENonterminal -wrap_ENonterminal (T_ENonterminal sem ) (Inh_ENonterminal _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers ) = - (let ( _lhsOappendCommon,_lhsOappendMain,_lhsOchildvisit,_lhsOgenProdIO,_lhsOimports,_lhsOoutput,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers - in (Syn_ENonterminal _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOgenProdIO _lhsOimports _lhsOoutput _lhsOvisitdefs _lhsOvisituses )) -sem_ENonterminal_ENonterminal :: NontermIdent -> - ([Identifier]) -> - StateIdentifier -> - (Maybe VisitIdentifier) -> - T_EProductions -> - T_ENonterminal -sem_ENonterminal_ENonterminal nt_ params_ initial_ initialv_ (T_EProductions prods_ ) = - (T_ENonterminal (\ _lhsIallchildvisit - _lhsIavisitdefs - _lhsIavisituses - _lhsIderivings - _lhsIimportBlocks - _lhsIinhmap - _lhsImainFile - _lhsImainName - _lhsImoduleHeader - _lhsIoptions - _lhsIoptionsLine - _lhsIpragmaBlocks - _lhsIsynmap - _lhsItextBlocks - _lhsItypeSyns - _lhsIwrappers -> - (let _prodsOrename :: Bool - _lhsOoutput :: PP_Doc - _prodsOinhmap :: Attributes - _prodsOsynmap :: Attributes - _prodsOnt :: NontermIdent - _prodsOinitial :: StateIdentifier - _prodsOallstates :: (Set.Set StateIdentifier) - _lhsOappendMain :: ( PP_Doc ) - _lhsOappendCommon :: ( PP_Doc ) - _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _lhsOgenProdIO :: (IO ()) - _lhsOimports :: ([PP_Doc]) - _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _prodsOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _prodsOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _prodsOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _prodsOimportBlocks :: PP_Doc - _prodsOmainFile :: String - _prodsOmainName :: String - _prodsOmoduleHeader :: (String -> String -> String -> Bool -> String) - _prodsOoptions :: Options - _prodsOoptionsLine :: String - _prodsOpragmaBlocks :: String - _prodsOtextBlocks :: PP_Doc - _prodsIallvisits :: ([VisitStateState]) - _prodsIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _prodsIdatatype :: ([PP_Doc]) - _prodsIgenProdIO :: (IO ()) - _prodsIimports :: ([PP_Doc]) - _prodsIsem_nt :: PP_Doc - _prodsIsem_prod :: PP_Doc - _prodsIt_visits :: PP_Doc - _prodsIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _prodsIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - -- "src-ag/ExecutionPlan2Hs.ag"(line 45, column 18) - _prodsOrename = - ({-# LINE 45 "src-ag/ExecutionPlan2Hs.ag" #-} - rename _lhsIoptions - {-# LINE 533 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 62, column 18) - _lhsOoutput = - ({-# LINE 62 "src-ag/ExecutionPlan2Hs.ag" #-} - ("-- " ++ getName nt_ ++ " " ++ replicate (60 - length (getName nt_)) '-') - >-< (if dataTypes _lhsIoptions - then "-- data" - >-< _datatype - >-< "" - else empty) - >-< (if nt_ `Set.member` _lhsIwrappers - 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 565 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 101, column 18) - _datatype = - ({-# LINE 101 "src-ag/ExecutionPlan2Hs.ag" #-} - case lookup nt_ _lhsItypeSyns of - Nothing -> "data" >#< nt_ >#< (vlist $ ("=" >#< head _prodsIdatatype) - : (map ("|" >#<) $ tail _prodsIdatatype)) >#< _derivings - Just (List t) -> "type" >#< nt_ >#< "=" >#< "[" >#< show t >#< "]" - Just (Maybe t) -> "type" >#< nt_ >#< "=" >#< "Maybe" >#< show t - Just (Tuple ts) -> "type" >#< nt_ >#< "=" >#< pp_parens (ppCommas $ map (show . snd) ts) - Just (Either l r) -> "type" >#< nt_ >#< "=" >#< "Either" >#< show l >#< show r - Just (Map k v) -> "type" >#< nt_ >#< "=" >#< "Data.Map.Map" >#< pp_parens (show k) >#< show v - Just (IntMap t) -> "type" >#< nt_ >#< "=" >#< "Data.IntMap.IntMap" >#< show t - {-# LINE 579 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 111, column 18) - _derivings = - ({-# LINE 111 "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 589 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 136, column 18) - _fsemname = - ({-# LINE 136 "src-ag/ExecutionPlan2Hs.ag" #-} - \x -> "sem_" ++ show x - {-# LINE 595 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 137, column 18) - _semname = - ({-# LINE 137 "src-ag/ExecutionPlan2Hs.ag" #-} - _fsemname nt_ - {-# LINE 601 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 138, column 18) - _frecarg = - ({-# LINE 138 "src-ag/ExecutionPlan2Hs.ag" #-} - \t x -> case t of - NT nt _ -> pp_parens (_fsemname nt >#< x) - _ -> pp x - {-# LINE 609 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 141, column 18) - _sem_nt = - ({-# LINE 141 "src-ag/ExecutionPlan2Hs.ag" #-} - _semname >#< "::" >#< nt_ >#< "->" >#< _t_type - >-< 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" - {-# LINE 639 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 198, column 19) - (Just _prodsOinhmap ) = - ({-# LINE 198 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.lookup nt_ _lhsIinhmap - {-# LINE 645 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 199, column 19) - (Just _prodsOsynmap ) = - ({-# LINE 199 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.lookup nt_ _lhsIsynmap - {-# LINE 651 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 220, column 18) - _outedges = - ({-# LINE 220 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.fromList $ map (\(_,f,_) -> f) _prodsIallvisits - {-# LINE 657 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 221, column 18) - _inedges = - ({-# LINE 221 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.fromList $ map (\(_,_,t) -> t) _prodsIallvisits - {-# LINE 663 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 222, column 18) - _allstates = - ({-# LINE 222 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.insert initial_ $ _inedges `Set.union` _outedges - {-# LINE 669 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 223, column 18) - _t_type = - ({-# LINE 223 "src-ag/ExecutionPlan2Hs.ag" #-} - "T_" ++ show nt_ - {-# LINE 675 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 224, column 18) - _t_init = - ({-# LINE 224 "src-ag/ExecutionPlan2Hs.ag" #-} - "type" >#< _t_type >#< "=" >#< _t_type >|< "_s" >|< initial_ - {-# LINE 681 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 225, column 18) - _t_states = - ({-# LINE 225 "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 - in "data" >#< t_st >#< "where" >#< c_st >#< "::" >#< "{" >#< inv_st >#< "::" - >#< "!" >|< pp_parens ("forall t." >#< k_st >#< "t" >#< "->" >#< "t") >#< "}" - >#< "->" >#< t_st - ) $ Set.toList _allstates - {-# LINE 696 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 238, column 18) - _k_type = - ({-# LINE 238 "src-ag/ExecutionPlan2Hs.ag" #-} - "K_" ++ show nt_ - {-# LINE 702 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 239, column 18) - _k_states = - ({-# LINE 239 "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_type >|< "_v" >|< v - ) outg - in "data" >#< k_st >#< "k" >#< "where" - >-< indent 3 visitlist) $ Set.toList _allstates - {-# LINE 716 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 259, column 18) - _prodsOnt = - ({-# LINE 259 "src-ag/ExecutionPlan2Hs.ag" #-} - nt_ - {-# LINE 722 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 276, column 18) - _wr_inh = - ({-# LINE 276 "src-ag/ExecutionPlan2Hs.ag" #-} - _genwrap "Inh" _wr_inhs - {-# LINE 728 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 277, column 18) - _wr_syn = - ({-# LINE 277 "src-ag/ExecutionPlan2Hs.ag" #-} - _genwrap "Syn" _wr_syns - {-# LINE 734 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 278, column 18) - _genwrap = - ({-# LINE 278 "src-ag/ExecutionPlan2Hs.ag" #-} - \nm attr -> "data" >#< nm >|< "_" >|< nt_ >#< "=" >#< nm >|< "_" >|< nt_ >#< "{" - >#< (ppCommas $ map (\(i,t) -> i >|< "_" >|< nm >|< "_" >|< nt_ >#< "::" - >#< typeToHaskellString (Just nt_) [] t) attr) >#< "}" - {-# LINE 742 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 281, column 18) - _wr_inhs = - ({-# LINE 281 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.toList $ fromJust $ Map.lookup nt_ _lhsIinhmap - {-# LINE 748 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 282, column 18) - _wr_syns = - ({-# LINE 282 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.toList $ fromJust $ Map.lookup nt_ _lhsIsynmap - {-# LINE 754 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 283, column 18) - _inhlist = - ({-# LINE 283 "src-ag/ExecutionPlan2Hs.ag" #-} - map (lhsname True . fst) _wr_inhs - {-# LINE 760 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 284, column 18) - _synlist = - ({-# LINE 284 "src-ag/ExecutionPlan2Hs.ag" #-} - map (lhsname False . fst) _wr_syns - {-# LINE 766 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 285, column 18) - _wrapname = - ({-# LINE 285 "src-ag/ExecutionPlan2Hs.ag" #-} - "wrap_" ++ show nt_ - {-# LINE 772 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 286, column 18) - _inhname = - ({-# LINE 286 "src-ag/ExecutionPlan2Hs.ag" #-} - "Inh_" ++ show nt_ - {-# LINE 778 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 287, column 18) - _synname = - ({-# LINE 287 "src-ag/ExecutionPlan2Hs.ag" #-} - "Syn_" ++ show nt_ - {-# LINE 784 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 288, column 18) - _wrapper = - ({-# LINE 288 "src-ag/ExecutionPlan2Hs.ag" #-} - (_wrapname >#< "::" >#< _t_type >#< "->" - >#< _inhname >#< "->" >#< _synname ) - >-< - (_wrapname >#< "sem" >#< "(" >#< _inhname - >#< ppSpaced _inhlist >#< ")" >#< "=") - >-< - indent 3 (case initialv_ of - Nothing -> _synname >#< " { }" - Just initv -> - "let" >#< "(" >#< ppCommas _synlist >#< "," >#< "_" >#< ")" >#< "=" - >#< "Control.Monad.Identity.runIdentity" - >#< pp_parens ("inv_" >|< nt_ >|< "_s" >|< initial_ - >#< "sem" >#< _k_type >|< "_v" >|< initv - >#< ppSpaced _inhlist ) - >-< - "in " >#< "(" >#< _synname >#< ppSpaced _synlist >#< ")") - {-# LINE 805 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 315, column 18) - _prodsOinitial = - ({-# LINE 315 "src-ag/ExecutionPlan2Hs.ag" #-} - initial_ - {-# LINE 811 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 316, column 18) - _prodsOallstates = - ({-# LINE 316 "src-ag/ExecutionPlan2Hs.ag" #-} - _allstates - {-# LINE 817 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 613, column 18) - _lhsOappendMain = - ({-# LINE 613 "src-ag/ExecutionPlan2Hs.ag" #-} - (if nt_ `Set.member` _lhsIwrappers - then _wr_inh - >-< _wr_syn - >-< _wrapper - else empty) - >-< _sem_nt - {-# LINE 828 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 619, column 18) - _lhsOappendCommon = - ({-# LINE 619 "src-ag/ExecutionPlan2Hs.ag" #-} - (if dataTypes _lhsIoptions then _datatype else empty) - >-< _t_init - >-< _t_states - >-< _k_states - >-< _prodsIt_visits - {-# LINE 838 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 458, column 37) - _lhsOchildvisit = - ({-# LINE 458 "src-ag/ExecutionPlan2Hs.ag" #-} - _prodsIchildvisit - {-# LINE 844 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 627, column 49) - _lhsOgenProdIO = - ({-# LINE 627 "src-ag/ExecutionPlan2Hs.ag" #-} - _prodsIgenProdIO - {-# LINE 850 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 626, column 47) - _lhsOimports = - ({-# LINE 626 "src-ag/ExecutionPlan2Hs.ag" #-} - _prodsIimports - {-# LINE 856 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 518, column 36) - _lhsOvisitdefs = - ({-# LINE 518 "src-ag/ExecutionPlan2Hs.ag" #-} - _prodsIvisitdefs - {-# LINE 862 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 519, column 36) - _lhsOvisituses = - ({-# LINE 519 "src-ag/ExecutionPlan2Hs.ag" #-} - _prodsIvisituses - {-# LINE 868 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _prodsOallchildvisit = - ({-# LINE 457 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallchildvisit - {-# LINE 874 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _prodsOavisitdefs = - ({-# LINE 528 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisitdefs - {-# LINE 880 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _prodsOavisituses = - ({-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisituses - {-# LINE 886 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _prodsOimportBlocks = - ({-# LINE 25 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIimportBlocks - {-# LINE 892 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _prodsOmainFile = - ({-# LINE 29 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainFile - {-# LINE 898 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _prodsOmainName = - ({-# LINE 31 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainName - {-# LINE 904 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _prodsOmoduleHeader = - ({-# LINE 28 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImoduleHeader - {-# LINE 910 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _prodsOoptions = - ({-# LINE 41 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptions - {-# LINE 916 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _prodsOoptionsLine = - ({-# LINE 30 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptionsLine - {-# LINE 922 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _prodsOpragmaBlocks = - ({-# LINE 26 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIpragmaBlocks - {-# LINE 928 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _prodsOtextBlocks = - ({-# LINE 27 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsItextBlocks - {-# LINE 934 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _prodsIallvisits,_prodsIchildvisit,_prodsIdatatype,_prodsIgenProdIO,_prodsIimports,_prodsIsem_nt,_prodsIsem_prod,_prodsIt_visits,_prodsIvisitdefs,_prodsIvisituses) = - prods_ _prodsOallchildvisit _prodsOallstates _prodsOavisitdefs _prodsOavisituses _prodsOimportBlocks _prodsOinhmap _prodsOinitial _prodsOmainFile _prodsOmainName _prodsOmoduleHeader _prodsOnt _prodsOoptions _prodsOoptionsLine _prodsOpragmaBlocks _prodsOrename _prodsOsynmap _prodsOtextBlocks - in ( _lhsOappendCommon,_lhsOappendMain,_lhsOchildvisit,_lhsOgenProdIO,_lhsOimports,_lhsOoutput,_lhsOvisitdefs,_lhsOvisituses))) ) --- ENonterminals ----------------------------------------------- -{- - visit 0: - inherited attributes: - allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) - avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) - avisituses : Map.Map VisitIdentifier (Set.Set Identifier) - derivings : Derivings - importBlocks : PP_Doc - inhmap : Map.Map NontermIdent Attributes - mainFile : String - mainName : String - moduleHeader : String -> String -> String -> Bool -> String - options : Options - optionsLine : String - pragmaBlocks : String - synmap : Map.Map NontermIdent Attributes - textBlocks : PP_Doc - typeSyns : TypeSyns - wrappers : Set.Set NontermIdent - synthesized attributes: - appendCommon : [PP_Doc] - appendMain : [PP_Doc] - childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) - genProdIO : IO () - imports : [PP_Doc] - output : PP_Doc - visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) - visituses : Map.Map VisitIdentifier (Set.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.Map VisitIdentifier (Identifier -> PP_Doc)) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - Derivings -> - PP_Doc -> - (Map.Map NontermIdent Attributes) -> - String -> - String -> - (String -> String -> String -> Bool -> String) -> - Options -> - String -> - String -> - (Map.Map NontermIdent Attributes) -> - PP_Doc -> - TypeSyns -> - (Set.Set NontermIdent) -> - ( ([PP_Doc]),([PP_Doc]),(Map.Map VisitIdentifier (Identifier -> PP_Doc)),(IO ()),([PP_Doc]),PP_Doc,(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) -data Inh_ENonterminals = Inh_ENonterminals {allchildvisit_Inh_ENonterminals :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),avisitdefs_Inh_ENonterminals :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_ENonterminals :: (Map.Map VisitIdentifier (Set.Set Identifier)),derivings_Inh_ENonterminals :: Derivings,importBlocks_Inh_ENonterminals :: PP_Doc,inhmap_Inh_ENonterminals :: (Map.Map NontermIdent Attributes),mainFile_Inh_ENonterminals :: String,mainName_Inh_ENonterminals :: String,moduleHeader_Inh_ENonterminals :: (String -> String -> String -> Bool -> String),options_Inh_ENonterminals :: Options,optionsLine_Inh_ENonterminals :: String,pragmaBlocks_Inh_ENonterminals :: String,synmap_Inh_ENonterminals :: (Map.Map NontermIdent Attributes),textBlocks_Inh_ENonterminals :: PP_Doc,typeSyns_Inh_ENonterminals :: TypeSyns,wrappers_Inh_ENonterminals :: (Set.Set NontermIdent)} -data Syn_ENonterminals = Syn_ENonterminals {appendCommon_Syn_ENonterminals :: ([PP_Doc]),appendMain_Syn_ENonterminals :: ([PP_Doc]),childvisit_Syn_ENonterminals :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),genProdIO_Syn_ENonterminals :: (IO ()),imports_Syn_ENonterminals :: ([PP_Doc]),output_Syn_ENonterminals :: PP_Doc,visitdefs_Syn_ENonterminals :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_ENonterminals :: (Map.Map VisitIdentifier (Set.Set Identifier))} -wrap_ENonterminals :: T_ENonterminals -> - Inh_ENonterminals -> - Syn_ENonterminals -wrap_ENonterminals (T_ENonterminals sem ) (Inh_ENonterminals _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers ) = - (let ( _lhsOappendCommon,_lhsOappendMain,_lhsOchildvisit,_lhsOgenProdIO,_lhsOimports,_lhsOoutput,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers - in (Syn_ENonterminals _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOgenProdIO _lhsOimports _lhsOoutput _lhsOvisitdefs _lhsOvisituses )) -sem_ENonterminals_Cons :: T_ENonterminal -> - T_ENonterminals -> - T_ENonterminals -sem_ENonterminals_Cons (T_ENonterminal hd_ ) (T_ENonterminals tl_ ) = - (T_ENonterminals (\ _lhsIallchildvisit - _lhsIavisitdefs - _lhsIavisituses - _lhsIderivings - _lhsIimportBlocks - _lhsIinhmap - _lhsImainFile - _lhsImainName - _lhsImoduleHeader - _lhsIoptions - _lhsIoptionsLine - _lhsIpragmaBlocks - _lhsIsynmap - _lhsItextBlocks - _lhsItypeSyns - _lhsIwrappers -> - (let _lhsOappendCommon :: ([PP_Doc]) - _lhsOappendMain :: ([PP_Doc]) - _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _lhsOgenProdIO :: (IO ()) - _lhsOimports :: ([PP_Doc]) - _lhsOoutput :: PP_Doc - _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _hdOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _hdOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _hdOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _hdOderivings :: Derivings - _hdOimportBlocks :: PP_Doc - _hdOinhmap :: (Map.Map NontermIdent Attributes) - _hdOmainFile :: String - _hdOmainName :: String - _hdOmoduleHeader :: (String -> String -> String -> Bool -> String) - _hdOoptions :: Options - _hdOoptionsLine :: String - _hdOpragmaBlocks :: String - _hdOsynmap :: (Map.Map NontermIdent Attributes) - _hdOtextBlocks :: PP_Doc - _hdOtypeSyns :: TypeSyns - _hdOwrappers :: (Set.Set NontermIdent) - _tlOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _tlOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _tlOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _tlOderivings :: Derivings - _tlOimportBlocks :: PP_Doc - _tlOinhmap :: (Map.Map NontermIdent Attributes) - _tlOmainFile :: String - _tlOmainName :: String - _tlOmoduleHeader :: (String -> String -> String -> Bool -> String) - _tlOoptions :: Options - _tlOoptionsLine :: String - _tlOpragmaBlocks :: String - _tlOsynmap :: (Map.Map NontermIdent Attributes) - _tlOtextBlocks :: PP_Doc - _tlOtypeSyns :: TypeSyns - _tlOwrappers :: (Set.Set NontermIdent) - _hdIappendCommon :: ( PP_Doc ) - _hdIappendMain :: ( PP_Doc ) - _hdIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _hdIgenProdIO :: (IO ()) - _hdIimports :: ([PP_Doc]) - _hdIoutput :: PP_Doc - _hdIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _hdIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _tlIappendCommon :: ([PP_Doc]) - _tlIappendMain :: ([PP_Doc]) - _tlIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _tlIgenProdIO :: (IO ()) - _tlIimports :: ([PP_Doc]) - _tlIoutput :: PP_Doc - _tlIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _tlIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 610, column 51) - _lhsOappendCommon = - ({-# LINE 610 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIappendCommon : _tlIappendCommon - {-# LINE 1085 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 610, column 51) - _lhsOappendMain = - ({-# LINE 610 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIappendMain : _tlIappendMain - {-# LINE 1091 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 458, column 37) - _lhsOchildvisit = - ({-# LINE 458 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIchildvisit `Map.union` _tlIchildvisit - {-# LINE 1097 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 627, column 49) - _lhsOgenProdIO = - ({-# LINE 627 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIgenProdIO >> _tlIgenProdIO - {-# LINE 1103 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 626, column 47) - _lhsOimports = - ({-# LINE 626 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIimports ++ _tlIimports - {-# LINE 1109 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 56, column 45) - _lhsOoutput = - ({-# LINE 56 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIoutput >-< _tlIoutput - {-# LINE 1115 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 518, column 36) - _lhsOvisitdefs = - ({-# LINE 518 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIvisitdefs `uwSetUnion` _tlIvisitdefs - {-# LINE 1121 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 519, column 36) - _lhsOvisituses = - ({-# LINE 519 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIvisituses `uwSetUnion` _tlIvisituses - {-# LINE 1127 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOallchildvisit = - ({-# LINE 457 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallchildvisit - {-# LINE 1133 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOavisitdefs = - ({-# LINE 528 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisitdefs - {-# LINE 1139 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOavisituses = - ({-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisituses - {-# LINE 1145 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOderivings = - ({-# LINE 94 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIderivings - {-# LINE 1151 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOimportBlocks = - ({-# LINE 25 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIimportBlocks - {-# LINE 1157 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOinhmap = - ({-# LINE 188 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIinhmap - {-# LINE 1163 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOmainFile = - ({-# LINE 29 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainFile - {-# LINE 1169 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOmainName = - ({-# LINE 31 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainName - {-# LINE 1175 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOmoduleHeader = - ({-# LINE 28 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImoduleHeader - {-# LINE 1181 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 41 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptions - {-# LINE 1187 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOoptionsLine = - ({-# LINE 30 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptionsLine - {-# LINE 1193 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOpragmaBlocks = - ({-# LINE 26 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIpragmaBlocks - {-# LINE 1199 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOsynmap = - ({-# LINE 189 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIsynmap - {-# LINE 1205 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOtextBlocks = - ({-# LINE 27 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsItextBlocks - {-# LINE 1211 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOtypeSyns = - ({-# LINE 93 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsItypeSyns - {-# LINE 1217 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOwrappers = - ({-# LINE 55 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIwrappers - {-# LINE 1223 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOallchildvisit = - ({-# LINE 457 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallchildvisit - {-# LINE 1229 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOavisitdefs = - ({-# LINE 528 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisitdefs - {-# LINE 1235 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOavisituses = - ({-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisituses - {-# LINE 1241 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOderivings = - ({-# LINE 94 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIderivings - {-# LINE 1247 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOimportBlocks = - ({-# LINE 25 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIimportBlocks - {-# LINE 1253 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOinhmap = - ({-# LINE 188 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIinhmap - {-# LINE 1259 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOmainFile = - ({-# LINE 29 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainFile - {-# LINE 1265 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOmainName = - ({-# LINE 31 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainName - {-# LINE 1271 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOmoduleHeader = - ({-# LINE 28 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImoduleHeader - {-# LINE 1277 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 41 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptions - {-# LINE 1283 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOoptionsLine = - ({-# LINE 30 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptionsLine - {-# LINE 1289 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOpragmaBlocks = - ({-# LINE 26 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIpragmaBlocks - {-# LINE 1295 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOsynmap = - ({-# LINE 189 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIsynmap - {-# LINE 1301 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOtextBlocks = - ({-# LINE 27 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsItextBlocks - {-# LINE 1307 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOtypeSyns = - ({-# LINE 93 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsItypeSyns - {-# LINE 1313 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOwrappers = - ({-# LINE 55 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIwrappers - {-# LINE 1319 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _hdIappendCommon,_hdIappendMain,_hdIchildvisit,_hdIgenProdIO,_hdIimports,_hdIoutput,_hdIvisitdefs,_hdIvisituses) = - hd_ _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOderivings _hdOimportBlocks _hdOinhmap _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOoptions _hdOoptionsLine _hdOpragmaBlocks _hdOsynmap _hdOtextBlocks _hdOtypeSyns _hdOwrappers - ( _tlIappendCommon,_tlIappendMain,_tlIchildvisit,_tlIgenProdIO,_tlIimports,_tlIoutput,_tlIvisitdefs,_tlIvisituses) = - tl_ _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOderivings _tlOimportBlocks _tlOinhmap _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOoptions _tlOoptionsLine _tlOpragmaBlocks _tlOsynmap _tlOtextBlocks _tlOtypeSyns _tlOwrappers - in ( _lhsOappendCommon,_lhsOappendMain,_lhsOchildvisit,_lhsOgenProdIO,_lhsOimports,_lhsOoutput,_lhsOvisitdefs,_lhsOvisituses))) ) -sem_ENonterminals_Nil :: T_ENonterminals -sem_ENonterminals_Nil = - (T_ENonterminals (\ _lhsIallchildvisit - _lhsIavisitdefs - _lhsIavisituses - _lhsIderivings - _lhsIimportBlocks - _lhsIinhmap - _lhsImainFile - _lhsImainName - _lhsImoduleHeader - _lhsIoptions - _lhsIoptionsLine - _lhsIpragmaBlocks - _lhsIsynmap - _lhsItextBlocks - _lhsItypeSyns - _lhsIwrappers -> - (let _lhsOappendCommon :: ([PP_Doc]) - _lhsOappendMain :: ([PP_Doc]) - _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _lhsOgenProdIO :: (IO ()) - _lhsOimports :: ([PP_Doc]) - _lhsOoutput :: PP_Doc - _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 610, column 51) - _lhsOappendCommon = - ({-# LINE 610 "src-ag/ExecutionPlan2Hs.ag" #-} - [] - {-# LINE 1356 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 610, column 51) - _lhsOappendMain = - ({-# LINE 610 "src-ag/ExecutionPlan2Hs.ag" #-} - [] - {-# LINE 1362 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 458, column 37) - _lhsOchildvisit = - ({-# LINE 458 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.empty - {-# LINE 1368 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 627, column 49) - _lhsOgenProdIO = - ({-# LINE 627 "src-ag/ExecutionPlan2Hs.ag" #-} - return () - {-# LINE 1374 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 626, column 47) - _lhsOimports = - ({-# LINE 626 "src-ag/ExecutionPlan2Hs.ag" #-} - [] - {-# LINE 1380 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 56, column 45) - _lhsOoutput = - ({-# LINE 56 "src-ag/ExecutionPlan2Hs.ag" #-} - empty - {-# LINE 1386 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 518, column 36) - _lhsOvisitdefs = - ({-# LINE 518 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.empty - {-# LINE 1392 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 519, column 36) - _lhsOvisituses = - ({-# LINE 519 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.empty - {-# LINE 1398 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOappendCommon,_lhsOappendMain,_lhsOchildvisit,_lhsOgenProdIO,_lhsOimports,_lhsOoutput,_lhsOvisitdefs,_lhsOvisituses))) ) --- EProduction ------------------------------------------------- -{- - visit 0: - inherited attributes: - allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) - allstates : Set.Set StateIdentifier - avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) - avisituses : Map.Map VisitIdentifier (Set.Set Identifier) - importBlocks : PP_Doc - inhmap : Attributes - initial : StateIdentifier - mainFile : String - mainName : String - moduleHeader : String -> String -> String -> Bool -> String - nt : NontermIdent - options : Options - optionsLine : String - pragmaBlocks : String - rename : Bool - synmap : Attributes - textBlocks : PP_Doc - synthesized attributes: - allvisits : [VisitStateState] - childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) - datatype : PP_Doc - genProdIO : IO () - imports : [PP_Doc] - sem_nt : PP_Doc - sem_prod : PP_Doc - t_visits : PP_Doc - visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) - visituses : Map.Map VisitIdentifier (Set.Set Identifier) - alternatives: - alternative EProduction: - child con : {ConstructorIdent} - child rules : ERules - child children : EChildren - child visits : Visits - visit 0: - local args : _ - local semname : _ - local sem_prod : _ - local statefns : _ - local stargs : _ - local stks : _ - local stvisits : _ - local stvs : _ - local moduleName : _ - local suffix : _ - local outputfile : _ --} --- cata -sem_EProduction :: EProduction -> - T_EProduction -sem_EProduction (EProduction _con _rules _children _visits ) = - (sem_EProduction_EProduction _con (sem_ERules _rules ) (sem_EChildren _children ) (sem_Visits _visits ) ) --- semantic domain -newtype T_EProduction = T_EProduction ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> - (Set.Set StateIdentifier) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - PP_Doc -> - Attributes -> - StateIdentifier -> - String -> - String -> - (String -> String -> String -> Bool -> String) -> - NontermIdent -> - Options -> - String -> - String -> - Bool -> - Attributes -> - PP_Doc -> - ( ([VisitStateState]),(Map.Map VisitIdentifier (Identifier -> PP_Doc)),PP_Doc,(IO ()),([PP_Doc]),PP_Doc,PP_Doc,PP_Doc,(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) -data Inh_EProduction = Inh_EProduction {allchildvisit_Inh_EProduction :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),allstates_Inh_EProduction :: (Set.Set StateIdentifier),avisitdefs_Inh_EProduction :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_EProduction :: (Map.Map VisitIdentifier (Set.Set Identifier)),importBlocks_Inh_EProduction :: PP_Doc,inhmap_Inh_EProduction :: Attributes,initial_Inh_EProduction :: StateIdentifier,mainFile_Inh_EProduction :: String,mainName_Inh_EProduction :: String,moduleHeader_Inh_EProduction :: (String -> String -> String -> Bool -> String),nt_Inh_EProduction :: NontermIdent,options_Inh_EProduction :: Options,optionsLine_Inh_EProduction :: String,pragmaBlocks_Inh_EProduction :: String,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.Map VisitIdentifier (Identifier -> PP_Doc)),datatype_Syn_EProduction :: PP_Doc,genProdIO_Syn_EProduction :: (IO ()),imports_Syn_EProduction :: ([PP_Doc]),sem_nt_Syn_EProduction :: PP_Doc,sem_prod_Syn_EProduction :: PP_Doc,t_visits_Syn_EProduction :: PP_Doc,visitdefs_Syn_EProduction :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_EProduction :: (Map.Map VisitIdentifier (Set.Set Identifier))} -wrap_EProduction :: T_EProduction -> - Inh_EProduction -> - Syn_EProduction -wrap_EProduction (T_EProduction sem ) (Inh_EProduction _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsIrename _lhsIsynmap _lhsItextBlocks ) = - (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOdatatype,_lhsOgenProdIO,_lhsOimports,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsIrename _lhsIsynmap _lhsItextBlocks - in (Syn_EProduction _lhsOallvisits _lhsOchildvisit _lhsOdatatype _lhsOgenProdIO _lhsOimports _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitdefs _lhsOvisituses )) -sem_EProduction_EProduction :: ConstructorIdent -> - T_ERules -> - T_EChildren -> - T_Visits -> - T_EProduction -sem_EProduction_EProduction con_ (T_ERules rules_ ) (T_EChildren children_ ) (T_Visits visits_ ) = - (T_EProduction (\ _lhsIallchildvisit - _lhsIallstates - _lhsIavisitdefs - _lhsIavisituses - _lhsIimportBlocks - _lhsIinhmap - _lhsIinitial - _lhsImainFile - _lhsImainName - _lhsImoduleHeader - _lhsInt - _lhsIoptions - _lhsIoptionsLine - _lhsIpragmaBlocks - _lhsIrename - _lhsIsynmap - _lhsItextBlocks -> - (let _lhsOdatatype :: PP_Doc - _lhsOsem_nt :: PP_Doc - _visitsOmrules :: (Map.Map Identifier PP_Doc) - _visitsOchildintros :: (Map.Map Identifier PP_Doc) - _rulesOusedrules :: (Set.Set Identifier) - _visitsOallintramap :: (Map.Map StateIdentifier (Set.Set String)) - _visitsOterminaldefs :: (Set.Set String) - _visitsOruledefs :: (Map.Map Identifier (Set.Set String)) - _visitsOruleuses :: (Map.Map Identifier (Set.Set String)) - _lhsOimports :: ([PP_Doc]) - _lhsOgenProdIO :: (IO ()) - _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _lhsOt_visits :: PP_Doc - _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _lhsOallvisits :: ([VisitStateState]) - _lhsOsem_prod :: PP_Doc - _rulesOoptions :: Options - _childrenOnt :: NontermIdent - _childrenOoptions :: Options - _visitsOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _visitsOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _visitsOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _visitsOinhmap :: Attributes - _visitsOnt :: NontermIdent - _visitsOoptions :: Options - _visitsOsynmap :: Attributes - _rulesImrules :: (Map.Map Identifier PP_Doc) - _rulesIruledefs :: (Map.Map Identifier (Set.Set String)) - _rulesIruleuses :: (Map.Map Identifier (Set.Set String)) - _rulesIsem_rules :: PP_Doc - _childrenIargnames :: ( [PP_Doc] ) - _childrenIargnamesw :: ([PP_Doc]) - _childrenIargtps :: ( [PP_Doc] ) - _childrenIchildintros :: (Map.Map Identifier PP_Doc) - _childrenIdatatype :: ([PP_Doc]) - _childrenIterminaldefs :: (Set.Set String) - _visitsIallvisits :: ([VisitStateState]) - _visitsIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _visitsIintramap :: (Map.Map StateIdentifier (Set.Set String)) - _visitsIsem_visit :: ( [(StateIdentifier,PP_Doc)] ) - _visitsIt_visits :: PP_Doc - _visitsIusedrules :: (Set.Set Identifier) - _visitsIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _visitsIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - -- "src-ag/ExecutionPlan2Hs.ag"(line 121, column 17) - _lhsOdatatype = - ({-# LINE 121 "src-ag/ExecutionPlan2Hs.ag" #-} - conname _lhsIrename _lhsInt con_ >#< ppSpaced _childrenIdatatype - {-# LINE 1556 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 170, column 17) - _lhsOsem_nt = - ({-# LINE 170 "src-ag/ExecutionPlan2Hs.ag" #-} - "sem_" >|< _lhsInt >#< "(" >#< conname _lhsIrename _lhsInt con_ >#< ppSpaced _childrenIargnames >#< ")" - >#< "=" >#< "sem_" >|< _lhsInt >|< "_" >|< con_ >#< ppSpaced _childrenIargnamesw - {-# LINE 1563 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 336, column 17) - _args = - ({-# LINE 336 "src-ag/ExecutionPlan2Hs.ag" #-} - _childrenIargnames - {-# LINE 1569 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 337, column 17) - _semname = - ({-# LINE 337 "src-ag/ExecutionPlan2Hs.ag" #-} - "sem_" ++ show _lhsInt ++ "_" ++ show con_ - {-# LINE 1575 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 338, column 17) - _sem_prod = - ({-# LINE 338 "src-ag/ExecutionPlan2Hs.ag" #-} - _semname >#< "::" >#< ppSpaced _childrenIargtps >#< "T_" >|< _lhsInt - >-< _semname >#< ppSpaced _args >#< "=" - >#< "st" >|< _lhsIinitial >#< "where" - >-< (indent 3 $ vlist _statefns >-< _rulesIsem_rules) - {-# LINE 1584 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 342, column 17) - _statefns = - ({-# LINE 342 "src-ag/ExecutionPlan2Hs.ag" #-} - map (\st -> "st" >|< st >#< _stargs st >#< "=" >#< - "C_" >|< _lhsInt >|< "_s" >|< st >#< "k" >|< st >#< "where" - >-< indent 3 (_stks st >-< _stvs st) - ) $ Set.toList _lhsIallstates - {-# LINE 1593 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 346, column 17) - _stargs = - ({-# LINE 346 "src-ag/ExecutionPlan2Hs.ag" #-} - \st -> ppSpaced $ Set.toList $ maybe Set.empty id $ Map.lookup st _visitsIintramap - {-# LINE 1599 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 347, column 17) - _stks = - ({-# LINE 347 "src-ag/ExecutionPlan2Hs.ag" #-} - \st -> "k" >|< st >#< "::" >#< "K_" >|< _lhsInt >|< "_s" >|< st >#< "t" >#< "->" >#< "t" - >-< vlist (map (\(v,f,t) -> "k" >|< st >#< "K_" >|< _lhsInt >|< "_v" >|< v >#< "=" - >#< "v" >|< v) $ _stvisits st) - >-< if null (_stvisits st) - then "k" >|< st >#< "_" >#< "=" >#< "error \"unreachable\"" - else empty - {-# LINE 1610 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 353, column 17) - _stvisits = - ({-# LINE 353 "src-ag/ExecutionPlan2Hs.ag" #-} - \st -> filter (\(v,f,t) -> f == st) _visitsIallvisits - {-# LINE 1616 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 354, column 17) - _stvs = - ({-# LINE 354 "src-ag/ExecutionPlan2Hs.ag" #-} - \st -> vlist $ map snd $ filter (\(f,pp) -> f == st) _visitsIsem_visit - {-# LINE 1622 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 355, column 17) - _visitsOmrules = - ({-# LINE 355 "src-ag/ExecutionPlan2Hs.ag" #-} - _rulesImrules - {-# LINE 1628 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 387, column 17) - _visitsOchildintros = - ({-# LINE 387 "src-ag/ExecutionPlan2Hs.ag" #-} - _childrenIchildintros - {-# LINE 1634 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 403, column 17) - _rulesOusedrules = - ({-# LINE 403 "src-ag/ExecutionPlan2Hs.ag" #-} - _visitsIusedrules - {-# LINE 1640 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 491, column 17) - _visitsOallintramap = - ({-# LINE 491 "src-ag/ExecutionPlan2Hs.ag" #-} - _visitsIintramap - {-# LINE 1646 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 492, column 17) - _visitsOterminaldefs = - ({-# LINE 492 "src-ag/ExecutionPlan2Hs.ag" #-} - _childrenIterminaldefs - {-# LINE 1652 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 511, column 17) - _visitsOruledefs = - ({-# LINE 511 "src-ag/ExecutionPlan2Hs.ag" #-} - _rulesIruledefs - {-# LINE 1658 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 512, column 17) - _visitsOruleuses = - ({-# LINE 512 "src-ag/ExecutionPlan2Hs.ag" #-} - _rulesIruleuses - {-# LINE 1664 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 630, column 17) - _lhsOimports = - ({-# LINE 630 "src-ag/ExecutionPlan2Hs.ag" #-} - [pp $ "import " ++ _moduleName ] - {-# LINE 1670 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 631, column 17) - _moduleName = - ({-# LINE 631 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainName ++ _suffix - {-# LINE 1676 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 632, column 17) - _suffix = - ({-# LINE 632 "src-ag/ExecutionPlan2Hs.ag" #-} - "_" ++ show _lhsInt ++ "_" ++ show con_ - {-# LINE 1682 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 633, column 17) - _outputfile = - ({-# LINE 633 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainFile ++ _suffix ++ ".hs" - {-# LINE 1688 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 634, column 17) - _lhsOgenProdIO = - ({-# LINE 634 "src-ag/ExecutionPlan2Hs.ag" #-} - writeModule _outputfile - [ pp "{-# LANGUAGE Rank2Types, GADTs, EmptyDataDecls #-}" - , pp $ _lhsIpragmaBlocks - , pp $ _lhsIoptionsLine - , pp $ _lhsImoduleHeader _lhsImainName _suffix _semname True - , pp $ "import Control.Monad.Identity" - , pp $ "import " ++ _lhsImainName ++ "_common" - , _sem_prod - ] - {-# LINE 1702 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 458, column 37) - _lhsOchildvisit = - ({-# LINE 458 "src-ag/ExecutionPlan2Hs.ag" #-} - _visitsIchildvisit - {-# LINE 1708 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 253, column 54) - _lhsOt_visits = - ({-# LINE 253 "src-ag/ExecutionPlan2Hs.ag" #-} - _visitsIt_visits - {-# LINE 1714 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 518, column 36) - _lhsOvisitdefs = - ({-# LINE 518 "src-ag/ExecutionPlan2Hs.ag" #-} - _visitsIvisitdefs - {-# LINE 1720 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 519, column 36) - _lhsOvisituses = - ({-# LINE 519 "src-ag/ExecutionPlan2Hs.ag" #-} - _visitsIvisituses - {-# LINE 1726 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (up) - _lhsOallvisits = - ({-# LINE 209 "src-ag/ExecutionPlan2Hs.ag" #-} - _visitsIallvisits - {-# LINE 1732 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (from local) - _lhsOsem_prod = - ({-# LINE 309 "src-ag/ExecutionPlan2Hs.ag" #-} - _sem_prod - {-# LINE 1738 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _rulesOoptions = - ({-# LINE 41 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptions - {-# LINE 1744 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _childrenOnt = - ({-# LINE 124 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsInt - {-# LINE 1750 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _childrenOoptions = - ({-# LINE 41 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptions - {-# LINE 1756 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _visitsOallchildvisit = - ({-# LINE 457 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallchildvisit - {-# LINE 1762 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _visitsOavisitdefs = - ({-# LINE 528 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisitdefs - {-# LINE 1768 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _visitsOavisituses = - ({-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisituses - {-# LINE 1774 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _visitsOinhmap = - ({-# LINE 194 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIinhmap - {-# LINE 1780 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _visitsOnt = - ({-# LINE 253 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsInt - {-# LINE 1786 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _visitsOoptions = - ({-# LINE 41 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptions - {-# LINE 1792 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _visitsOsynmap = - ({-# LINE 195 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIsynmap - {-# LINE 1798 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _rulesImrules,_rulesIruledefs,_rulesIruleuses,_rulesIsem_rules) = - rules_ _rulesOoptions _rulesOusedrules - ( _childrenIargnames,_childrenIargnamesw,_childrenIargtps,_childrenIchildintros,_childrenIdatatype,_childrenIterminaldefs) = - children_ _childrenOnt _childrenOoptions - ( _visitsIallvisits,_visitsIchildvisit,_visitsIintramap,_visitsIsem_visit,_visitsIt_visits,_visitsIusedrules,_visitsIvisitdefs,_visitsIvisituses) = - visits_ _visitsOallchildvisit _visitsOallintramap _visitsOavisitdefs _visitsOavisituses _visitsOchildintros _visitsOinhmap _visitsOmrules _visitsOnt _visitsOoptions _visitsOruledefs _visitsOruleuses _visitsOsynmap _visitsOterminaldefs - in ( _lhsOallvisits,_lhsOchildvisit,_lhsOdatatype,_lhsOgenProdIO,_lhsOimports,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitdefs,_lhsOvisituses))) ) --- EProductions ------------------------------------------------ -{- - visit 0: - inherited attributes: - allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) - allstates : Set.Set StateIdentifier - avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) - avisituses : Map.Map VisitIdentifier (Set.Set Identifier) - importBlocks : PP_Doc - inhmap : Attributes - initial : StateIdentifier - mainFile : String - mainName : String - moduleHeader : String -> String -> String -> Bool -> String - nt : NontermIdent - options : Options - optionsLine : String - pragmaBlocks : String - rename : Bool - synmap : Attributes - textBlocks : PP_Doc - synthesized attributes: - allvisits : [VisitStateState] - childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) - datatype : [PP_Doc] - genProdIO : IO () - imports : [PP_Doc] - sem_nt : PP_Doc - sem_prod : PP_Doc - t_visits : PP_Doc - visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) - visituses : Map.Map VisitIdentifier (Set.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.Map VisitIdentifier (Identifier -> PP_Doc)) -> - (Set.Set StateIdentifier) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - PP_Doc -> - Attributes -> - StateIdentifier -> - String -> - String -> - (String -> String -> String -> Bool -> String) -> - NontermIdent -> - Options -> - String -> - String -> - Bool -> - Attributes -> - PP_Doc -> - ( ([VisitStateState]),(Map.Map VisitIdentifier (Identifier -> PP_Doc)),([PP_Doc]),(IO ()),([PP_Doc]),PP_Doc,PP_Doc,PP_Doc,(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) -data Inh_EProductions = Inh_EProductions {allchildvisit_Inh_EProductions :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),allstates_Inh_EProductions :: (Set.Set StateIdentifier),avisitdefs_Inh_EProductions :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_EProductions :: (Map.Map VisitIdentifier (Set.Set Identifier)),importBlocks_Inh_EProductions :: PP_Doc,inhmap_Inh_EProductions :: Attributes,initial_Inh_EProductions :: StateIdentifier,mainFile_Inh_EProductions :: String,mainName_Inh_EProductions :: String,moduleHeader_Inh_EProductions :: (String -> String -> String -> Bool -> String),nt_Inh_EProductions :: NontermIdent,options_Inh_EProductions :: Options,optionsLine_Inh_EProductions :: String,pragmaBlocks_Inh_EProductions :: String,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.Map VisitIdentifier (Identifier -> PP_Doc)),datatype_Syn_EProductions :: ([PP_Doc]),genProdIO_Syn_EProductions :: (IO ()),imports_Syn_EProductions :: ([PP_Doc]),sem_nt_Syn_EProductions :: PP_Doc,sem_prod_Syn_EProductions :: PP_Doc,t_visits_Syn_EProductions :: PP_Doc,visitdefs_Syn_EProductions :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_EProductions :: (Map.Map VisitIdentifier (Set.Set Identifier))} -wrap_EProductions :: T_EProductions -> - Inh_EProductions -> - Syn_EProductions -wrap_EProductions (T_EProductions sem ) (Inh_EProductions _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsIrename _lhsIsynmap _lhsItextBlocks ) = - (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOdatatype,_lhsOgenProdIO,_lhsOimports,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsIrename _lhsIsynmap _lhsItextBlocks - in (Syn_EProductions _lhsOallvisits _lhsOchildvisit _lhsOdatatype _lhsOgenProdIO _lhsOimports _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitdefs _lhsOvisituses )) -sem_EProductions_Cons :: T_EProduction -> - T_EProductions -> - T_EProductions -sem_EProductions_Cons (T_EProduction hd_ ) (T_EProductions tl_ ) = - (T_EProductions (\ _lhsIallchildvisit - _lhsIallstates - _lhsIavisitdefs - _lhsIavisituses - _lhsIimportBlocks - _lhsIinhmap - _lhsIinitial - _lhsImainFile - _lhsImainName - _lhsImoduleHeader - _lhsInt - _lhsIoptions - _lhsIoptionsLine - _lhsIpragmaBlocks - _lhsIrename - _lhsIsynmap - _lhsItextBlocks -> - (let _lhsOallvisits :: ([VisitStateState]) - _lhsOt_visits :: PP_Doc - _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _lhsOdatatype :: ([PP_Doc]) - _lhsOgenProdIO :: (IO ()) - _lhsOimports :: ([PP_Doc]) - _lhsOsem_nt :: PP_Doc - _lhsOsem_prod :: PP_Doc - _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _hdOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _hdOallstates :: (Set.Set StateIdentifier) - _hdOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _hdOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _hdOimportBlocks :: PP_Doc - _hdOinhmap :: Attributes - _hdOinitial :: StateIdentifier - _hdOmainFile :: String - _hdOmainName :: String - _hdOmoduleHeader :: (String -> String -> String -> Bool -> String) - _hdOnt :: NontermIdent - _hdOoptions :: Options - _hdOoptionsLine :: String - _hdOpragmaBlocks :: String - _hdOrename :: Bool - _hdOsynmap :: Attributes - _hdOtextBlocks :: PP_Doc - _tlOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _tlOallstates :: (Set.Set StateIdentifier) - _tlOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _tlOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _tlOimportBlocks :: PP_Doc - _tlOinhmap :: Attributes - _tlOinitial :: StateIdentifier - _tlOmainFile :: String - _tlOmainName :: String - _tlOmoduleHeader :: (String -> String -> String -> Bool -> String) - _tlOnt :: NontermIdent - _tlOoptions :: Options - _tlOoptionsLine :: String - _tlOpragmaBlocks :: String - _tlOrename :: Bool - _tlOsynmap :: Attributes - _tlOtextBlocks :: PP_Doc - _hdIallvisits :: ([VisitStateState]) - _hdIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _hdIdatatype :: PP_Doc - _hdIgenProdIO :: (IO ()) - _hdIimports :: ([PP_Doc]) - _hdIsem_nt :: PP_Doc - _hdIsem_prod :: PP_Doc - _hdIt_visits :: PP_Doc - _hdIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _hdIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _tlIallvisits :: ([VisitStateState]) - _tlIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _tlIdatatype :: ([PP_Doc]) - _tlIgenProdIO :: (IO ()) - _tlIimports :: ([PP_Doc]) - _tlIsem_nt :: PP_Doc - _tlIsem_prod :: PP_Doc - _tlIt_visits :: PP_Doc - _tlIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _tlIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - -- "src-ag/ExecutionPlan2Hs.ag"(line 215, column 10) - _lhsOallvisits = - ({-# LINE 215 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIallvisits - {-# LINE 1966 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 256, column 10) - _lhsOt_visits = - ({-# LINE 256 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIt_visits - {-# LINE 1972 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 458, column 37) - _lhsOchildvisit = - ({-# LINE 458 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIchildvisit `Map.union` _tlIchildvisit - {-# LINE 1978 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 118, column 34) - _lhsOdatatype = - ({-# LINE 118 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIdatatype : _tlIdatatype - {-# LINE 1984 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 627, column 49) - _lhsOgenProdIO = - ({-# LINE 627 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIgenProdIO >> _tlIgenProdIO - {-# LINE 1990 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 626, column 47) - _lhsOimports = - ({-# LINE 626 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIimports ++ _tlIimports - {-# LINE 1996 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 168, column 44) - _lhsOsem_nt = - ({-# LINE 168 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIsem_nt >-< _tlIsem_nt - {-# LINE 2002 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 310, column 34) - _lhsOsem_prod = - ({-# LINE 310 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIsem_prod >-< _tlIsem_prod - {-# LINE 2008 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 518, column 36) - _lhsOvisitdefs = - ({-# LINE 518 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIvisitdefs `uwSetUnion` _tlIvisitdefs - {-# LINE 2014 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 519, column 36) - _lhsOvisituses = - ({-# LINE 519 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIvisituses `uwSetUnion` _tlIvisituses - {-# LINE 2020 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOallchildvisit = - ({-# LINE 457 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallchildvisit - {-# LINE 2026 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOallstates = - ({-# LINE 313 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallstates - {-# LINE 2032 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOavisitdefs = - ({-# LINE 528 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisitdefs - {-# LINE 2038 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOavisituses = - ({-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisituses - {-# LINE 2044 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOimportBlocks = - ({-# LINE 25 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIimportBlocks - {-# LINE 2050 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOinhmap = - ({-# LINE 194 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIinhmap - {-# LINE 2056 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOinitial = - ({-# LINE 312 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIinitial - {-# LINE 2062 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOmainFile = - ({-# LINE 29 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainFile - {-# LINE 2068 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOmainName = - ({-# LINE 31 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainName - {-# LINE 2074 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOmoduleHeader = - ({-# LINE 28 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImoduleHeader - {-# LINE 2080 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 253 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsInt - {-# LINE 2086 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 41 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptions - {-# LINE 2092 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOoptionsLine = - ({-# LINE 30 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptionsLine - {-# LINE 2098 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOpragmaBlocks = - ({-# LINE 26 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIpragmaBlocks - {-# LINE 2104 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOrename = - ({-# LINE 42 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIrename - {-# LINE 2110 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOsynmap = - ({-# LINE 195 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIsynmap - {-# LINE 2116 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOtextBlocks = - ({-# LINE 27 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsItextBlocks - {-# LINE 2122 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOallchildvisit = - ({-# LINE 457 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallchildvisit - {-# LINE 2128 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOallstates = - ({-# LINE 313 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallstates - {-# LINE 2134 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOavisitdefs = - ({-# LINE 528 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisitdefs - {-# LINE 2140 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOavisituses = - ({-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisituses - {-# LINE 2146 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOimportBlocks = - ({-# LINE 25 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIimportBlocks - {-# LINE 2152 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOinhmap = - ({-# LINE 194 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIinhmap - {-# LINE 2158 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOinitial = - ({-# LINE 312 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIinitial - {-# LINE 2164 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOmainFile = - ({-# LINE 29 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainFile - {-# LINE 2170 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOmainName = - ({-# LINE 31 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainName - {-# LINE 2176 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOmoduleHeader = - ({-# LINE 28 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImoduleHeader - {-# LINE 2182 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 253 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsInt - {-# LINE 2188 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 41 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptions - {-# LINE 2194 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOoptionsLine = - ({-# LINE 30 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptionsLine - {-# LINE 2200 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOpragmaBlocks = - ({-# LINE 26 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIpragmaBlocks - {-# LINE 2206 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOrename = - ({-# LINE 42 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIrename - {-# LINE 2212 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOsynmap = - ({-# LINE 195 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIsynmap - {-# LINE 2218 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOtextBlocks = - ({-# LINE 27 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsItextBlocks - {-# LINE 2224 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _hdIallvisits,_hdIchildvisit,_hdIdatatype,_hdIgenProdIO,_hdIimports,_hdIsem_nt,_hdIsem_prod,_hdIt_visits,_hdIvisitdefs,_hdIvisituses) = - hd_ _hdOallchildvisit _hdOallstates _hdOavisitdefs _hdOavisituses _hdOimportBlocks _hdOinhmap _hdOinitial _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnt _hdOoptions _hdOoptionsLine _hdOpragmaBlocks _hdOrename _hdOsynmap _hdOtextBlocks - ( _tlIallvisits,_tlIchildvisit,_tlIdatatype,_tlIgenProdIO,_tlIimports,_tlIsem_nt,_tlIsem_prod,_tlIt_visits,_tlIvisitdefs,_tlIvisituses) = - tl_ _tlOallchildvisit _tlOallstates _tlOavisitdefs _tlOavisituses _tlOimportBlocks _tlOinhmap _tlOinitial _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnt _tlOoptions _tlOoptionsLine _tlOpragmaBlocks _tlOrename _tlOsynmap _tlOtextBlocks - in ( _lhsOallvisits,_lhsOchildvisit,_lhsOdatatype,_lhsOgenProdIO,_lhsOimports,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitdefs,_lhsOvisituses))) ) -sem_EProductions_Nil :: T_EProductions -sem_EProductions_Nil = - (T_EProductions (\ _lhsIallchildvisit - _lhsIallstates - _lhsIavisitdefs - _lhsIavisituses - _lhsIimportBlocks - _lhsIinhmap - _lhsIinitial - _lhsImainFile - _lhsImainName - _lhsImoduleHeader - _lhsInt - _lhsIoptions - _lhsIoptionsLine - _lhsIpragmaBlocks - _lhsIrename - _lhsIsynmap - _lhsItextBlocks -> - (let _lhsOallvisits :: ([VisitStateState]) - _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _lhsOdatatype :: ([PP_Doc]) - _lhsOgenProdIO :: (IO ()) - _lhsOimports :: ([PP_Doc]) - _lhsOsem_nt :: PP_Doc - _lhsOsem_prod :: PP_Doc - _lhsOt_visits :: PP_Doc - _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - -- "src-ag/ExecutionPlan2Hs.ag"(line 216, column 10) - _lhsOallvisits = - ({-# LINE 216 "src-ag/ExecutionPlan2Hs.ag" #-} - error "Every nonterminal should have at least 1 production" - {-# LINE 2264 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 458, column 37) - _lhsOchildvisit = - ({-# LINE 458 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.empty - {-# LINE 2270 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 118, column 34) - _lhsOdatatype = - ({-# LINE 118 "src-ag/ExecutionPlan2Hs.ag" #-} - [] - {-# LINE 2276 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 627, column 49) - _lhsOgenProdIO = - ({-# LINE 627 "src-ag/ExecutionPlan2Hs.ag" #-} - return () - {-# LINE 2282 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 626, column 47) - _lhsOimports = - ({-# LINE 626 "src-ag/ExecutionPlan2Hs.ag" #-} - [] - {-# LINE 2288 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 168, column 44) - _lhsOsem_nt = - ({-# LINE 168 "src-ag/ExecutionPlan2Hs.ag" #-} - empty - {-# LINE 2294 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 310, column 34) - _lhsOsem_prod = - ({-# LINE 310 "src-ag/ExecutionPlan2Hs.ag" #-} - empty - {-# LINE 2300 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 253, column 54) - _lhsOt_visits = - ({-# LINE 253 "src-ag/ExecutionPlan2Hs.ag" #-} - empty - {-# LINE 2306 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 518, column 36) - _lhsOvisitdefs = - ({-# LINE 518 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.empty - {-# LINE 2312 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 519, column 36) - _lhsOvisituses = - ({-# LINE 519 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.empty - {-# LINE 2318 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOallvisits,_lhsOchildvisit,_lhsOdatatype,_lhsOgenProdIO,_lhsOimports,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitdefs,_lhsOvisituses))) ) --- ERule ------------------------------------------------------- -{- - visit 0: - inherited attributes: - options : Options - usedrules : Set.Set Identifier - synthesized attributes: - mrules : Map.Map Identifier PP_Doc - ruledefs : Map.Map Identifier (Set.Set String) - ruleuses : Map.Map Identifier (Set.Set String) - 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} - visit 0: - local attrlst : _ - local addbang : _ --} --- cata -sem_ERule :: ERule -> - T_ERule -sem_ERule (ERule _name _pattern _rhs _owrt _origin _explicit ) = - (sem_ERule_ERule _name (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) --- semantic domain -newtype T_ERule = T_ERule (Options -> - (Set.Set Identifier) -> - ( (Map.Map Identifier PP_Doc),(Map.Map Identifier (Set.Set String)),(Map.Map Identifier (Set.Set String)),PP_Doc)) -data Inh_ERule = Inh_ERule {options_Inh_ERule :: Options,usedrules_Inh_ERule :: (Set.Set Identifier)} -data Syn_ERule = Syn_ERule {mrules_Syn_ERule :: (Map.Map Identifier PP_Doc),ruledefs_Syn_ERule :: (Map.Map Identifier (Set.Set String)),ruleuses_Syn_ERule :: (Map.Map Identifier (Set.Set String)),sem_rules_Syn_ERule :: PP_Doc} -wrap_ERule :: T_ERule -> - Inh_ERule -> - Syn_ERule -wrap_ERule (T_ERule sem ) (Inh_ERule _lhsIoptions _lhsIusedrules ) = - (let ( _lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules) = sem _lhsIoptions _lhsIusedrules - in (Syn_ERule _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules )) -sem_ERule_ERule :: Identifier -> - T_Pattern -> - T_Expression -> - Bool -> - String -> - Bool -> - T_ERule -sem_ERule_ERule name_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ = - (T_ERule (\ _lhsIoptions - _lhsIusedrules -> - (let _lhsOsem_rules :: PP_Doc - _lhsOmrules :: (Map.Map Identifier PP_Doc) - _patternOaddtilde :: (PP_Doc -> PP_Doc) - _lhsOruledefs :: (Map.Map Identifier (Set.Set String)) - _lhsOruleuses :: (Map.Map Identifier (Set.Set String)) - _patternIattrs :: (Set.Set String) - _patternIcopy :: Pattern - _patternIsem_lhs :: ( PP_Doc ) - _rhsIattrs :: (Set.Set String) - _rhsIsemfunc :: PP_Doc - -- "src-ag/ExecutionPlan2Hs.ag"(line 410, column 11) - _lhsOsem_rules = - ({-# LINE 410 "src-ag/ExecutionPlan2Hs.ag" #-} - if Set.member name_ _lhsIusedrules - then (name_ >#< "=" >#< - (if Set.null _rhsIattrs - then empty - else "\\" >|< _attrlst >#< "->") - >#< _rhsIsemfunc) - else empty - {-# LINE 2391 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 417, column 11) - _attrlst = - ({-# LINE 417 "src-ag/ExecutionPlan2Hs.ag" #-} - ppSpaced $ Set.toList _rhsIattrs - {-# LINE 2397 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 418, column 11) - _lhsOmrules = - ({-# LINE 418 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton name_ $ _addbang _patternIsem_lhs >#< "<-" >#< "return" >#< "$" >#< name_ >#< _attrlst - {-# LINE 2403 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 419, column 11) - _patternOaddtilde = - ({-# LINE 419 "src-ag/ExecutionPlan2Hs.ag" #-} - \x -> if cases _lhsIoptions then x else "~" >|< x - {-# LINE 2409 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 420, column 11) - _addbang = - ({-# LINE 420 "src-ag/ExecutionPlan2Hs.ag" #-} - \x -> if bangpats _lhsIoptions then "!" >|< x else x - {-# LINE 2415 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 507, column 11) - _lhsOruledefs = - ({-# LINE 507 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton name_ _patternIattrs - {-# LINE 2421 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 508, column 11) - _lhsOruleuses = - ({-# LINE 508 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton name_ _rhsIattrs - {-# LINE 2427 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _patternIattrs,_patternIcopy,_patternIsem_lhs) = - pattern_ _patternOaddtilde - ( _rhsIattrs,_rhsIsemfunc) = - rhs_ - in ( _lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules))) ) --- ERules ------------------------------------------------------ -{- - visit 0: - inherited attributes: - options : Options - usedrules : Set.Set Identifier - synthesized attributes: - mrules : Map.Map Identifier PP_Doc - ruledefs : Map.Map Identifier (Set.Set String) - ruleuses : Map.Map Identifier (Set.Set String) - 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 (Options -> - (Set.Set Identifier) -> - ( (Map.Map Identifier PP_Doc),(Map.Map Identifier (Set.Set String)),(Map.Map Identifier (Set.Set String)),PP_Doc)) -data Inh_ERules = Inh_ERules {options_Inh_ERules :: Options,usedrules_Inh_ERules :: (Set.Set Identifier)} -data Syn_ERules = Syn_ERules {mrules_Syn_ERules :: (Map.Map Identifier PP_Doc),ruledefs_Syn_ERules :: (Map.Map Identifier (Set.Set String)),ruleuses_Syn_ERules :: (Map.Map Identifier (Set.Set String)),sem_rules_Syn_ERules :: PP_Doc} -wrap_ERules :: T_ERules -> - Inh_ERules -> - Syn_ERules -wrap_ERules (T_ERules sem ) (Inh_ERules _lhsIoptions _lhsIusedrules ) = - (let ( _lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules) = sem _lhsIoptions _lhsIusedrules - in (Syn_ERules _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 (\ _lhsIoptions - _lhsIusedrules -> - (let _lhsOmrules :: (Map.Map Identifier PP_Doc) - _lhsOruledefs :: (Map.Map Identifier (Set.Set String)) - _lhsOruleuses :: (Map.Map Identifier (Set.Set String)) - _lhsOsem_rules :: PP_Doc - _hdOoptions :: Options - _hdOusedrules :: (Set.Set Identifier) - _tlOoptions :: Options - _tlOusedrules :: (Set.Set Identifier) - _hdImrules :: (Map.Map Identifier PP_Doc) - _hdIruledefs :: (Map.Map Identifier (Set.Set String)) - _hdIruleuses :: (Map.Map Identifier (Set.Set String)) - _hdIsem_rules :: PP_Doc - _tlImrules :: (Map.Map Identifier PP_Doc) - _tlIruledefs :: (Map.Map Identifier (Set.Set String)) - _tlIruleuses :: (Map.Map Identifier (Set.Set String)) - _tlIsem_rules :: PP_Doc - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 407, column 32) - _lhsOmrules = - ({-# LINE 407 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdImrules `Map.union` _tlImrules - {-# LINE 2494 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 500, column 34) - _lhsOruledefs = - ({-# LINE 500 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIruledefs `uwSetUnion` _tlIruledefs - {-# LINE 2500 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 501, column 34) - _lhsOruleuses = - ({-# LINE 501 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIruleuses `uwSetUnion` _tlIruleuses - {-# LINE 2506 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 406, column 35) - _lhsOsem_rules = - ({-# LINE 406 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIsem_rules >-< _tlIsem_rules - {-# LINE 2512 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 41 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptions - {-# LINE 2518 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOusedrules = - ({-# LINE 397 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIusedrules - {-# LINE 2524 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 41 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptions - {-# LINE 2530 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOusedrules = - ({-# LINE 397 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIusedrules - {-# LINE 2536 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _hdImrules,_hdIruledefs,_hdIruleuses,_hdIsem_rules) = - hd_ _hdOoptions _hdOusedrules - ( _tlImrules,_tlIruledefs,_tlIruleuses,_tlIsem_rules) = - tl_ _tlOoptions _tlOusedrules - in ( _lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules))) ) -sem_ERules_Nil :: T_ERules -sem_ERules_Nil = - (T_ERules (\ _lhsIoptions - _lhsIusedrules -> - (let _lhsOmrules :: (Map.Map Identifier PP_Doc) - _lhsOruledefs :: (Map.Map Identifier (Set.Set String)) - _lhsOruleuses :: (Map.Map Identifier (Set.Set String)) - _lhsOsem_rules :: PP_Doc - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 407, column 32) - _lhsOmrules = - ({-# LINE 407 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.empty - {-# LINE 2555 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 500, column 34) - _lhsOruledefs = - ({-# LINE 500 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.empty - {-# LINE 2561 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 501, column 34) - _lhsOruleuses = - ({-# LINE 501 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.empty - {-# LINE 2567 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 406, column 35) - _lhsOsem_rules = - ({-# LINE 406 "src-ag/ExecutionPlan2Hs.ag" #-} - empty - {-# LINE 2573 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules))) ) --- ExecutionPlan ----------------------------------------------- -{- - visit 0: - inherited attributes: - importBlocks : PP_Doc - inhmap : Map.Map NontermIdent Attributes - mainFile : String - mainName : String - moduleHeader : String -> String -> String -> Bool -> String - options : Options - optionsLine : String - pragmaBlocks : String - synmap : Map.Map NontermIdent Attributes - textBlocks : PP_Doc - synthesized attributes: - genIO : IO () - output : PP_Doc - alternatives: - alternative ExecutionPlan: - child nonts : ENonterminals - child typeSyns : {TypeSyns} - child wrappers : {Set.Set NontermIdent} - child derivings : {Derivings} - visit 0: - local mainModuleFile : _ - 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.Map NontermIdent Attributes) -> - String -> - String -> - (String -> String -> String -> Bool -> String) -> - Options -> - String -> - String -> - (Map.Map NontermIdent Attributes) -> - PP_Doc -> - ( (IO ()),PP_Doc)) -data Inh_ExecutionPlan = Inh_ExecutionPlan {importBlocks_Inh_ExecutionPlan :: PP_Doc,inhmap_Inh_ExecutionPlan :: (Map.Map NontermIdent Attributes),mainFile_Inh_ExecutionPlan :: String,mainName_Inh_ExecutionPlan :: String,moduleHeader_Inh_ExecutionPlan :: (String -> String -> String -> Bool -> String),options_Inh_ExecutionPlan :: Options,optionsLine_Inh_ExecutionPlan :: String,pragmaBlocks_Inh_ExecutionPlan :: String,synmap_Inh_ExecutionPlan :: (Map.Map NontermIdent Attributes),textBlocks_Inh_ExecutionPlan :: PP_Doc} -data Syn_ExecutionPlan = Syn_ExecutionPlan {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 _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks ) = - (let ( _lhsOgenIO,_lhsOoutput) = sem _lhsIimportBlocks _lhsIinhmap _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks - in (Syn_ExecutionPlan _lhsOgenIO _lhsOoutput )) -sem_ExecutionPlan_ExecutionPlan :: T_ENonterminals -> - TypeSyns -> - (Set.Set NontermIdent) -> - Derivings -> - T_ExecutionPlan -sem_ExecutionPlan_ExecutionPlan (T_ENonterminals nonts_ ) typeSyns_ wrappers_ derivings_ = - (T_ExecutionPlan (\ _lhsIimportBlocks - _lhsIinhmap - _lhsImainFile - _lhsImainName - _lhsImoduleHeader - _lhsIoptions - _lhsIoptionsLine - _lhsIpragmaBlocks - _lhsIsynmap - _lhsItextBlocks -> - (let _lhsOoutput :: PP_Doc - _nontsOwrappers :: (Set.Set NontermIdent) - _nontsOtypeSyns :: TypeSyns - _nontsOderivings :: Derivings - _nontsOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _nontsOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _nontsOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _lhsOgenIO :: (IO ()) - _nontsOimportBlocks :: PP_Doc - _nontsOinhmap :: (Map.Map NontermIdent Attributes) - _nontsOmainFile :: String - _nontsOmainName :: String - _nontsOmoduleHeader :: (String -> String -> String -> Bool -> String) - _nontsOoptions :: Options - _nontsOoptionsLine :: String - _nontsOpragmaBlocks :: String - _nontsOsynmap :: (Map.Map NontermIdent Attributes) - _nontsOtextBlocks :: PP_Doc - _nontsIappendCommon :: ([PP_Doc]) - _nontsIappendMain :: ([PP_Doc]) - _nontsIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _nontsIgenProdIO :: (IO ()) - _nontsIimports :: ([PP_Doc]) - _nontsIoutput :: PP_Doc - _nontsIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _nontsIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - -- "src-ag/ExecutionPlan2Hs.ag"(line 53, column 19) - _lhsOoutput = - ({-# LINE 53 "src-ag/ExecutionPlan2Hs.ag" #-} - _nontsIoutput - {-# LINE 2676 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 59, column 19) - _nontsOwrappers = - ({-# LINE 59 "src-ag/ExecutionPlan2Hs.ag" #-} - wrappers_ - {-# LINE 2682 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 97, column 19) - _nontsOtypeSyns = - ({-# LINE 97 "src-ag/ExecutionPlan2Hs.ag" #-} - typeSyns_ - {-# LINE 2688 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 98, column 19) - _nontsOderivings = - ({-# LINE 98 "src-ag/ExecutionPlan2Hs.ag" #-} - derivings_ - {-# LINE 2694 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 463, column 19) - _nontsOallchildvisit = - ({-# LINE 463 "src-ag/ExecutionPlan2Hs.ag" #-} - _nontsIchildvisit - {-# LINE 2700 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 532, column 19) - _nontsOavisitdefs = - ({-# LINE 532 "src-ag/ExecutionPlan2Hs.ag" #-} - _nontsIvisitdefs - {-# LINE 2706 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 533, column 19) - _nontsOavisituses = - ({-# LINE 533 "src-ag/ExecutionPlan2Hs.ag" #-} - _nontsIvisituses - {-# LINE 2712 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 581, column 19) - _lhsOgenIO = - ({-# LINE 581 "src-ag/ExecutionPlan2Hs.ag" #-} - do _genMainModule - _genCommonModule - _nontsIgenProdIO - {-# LINE 2720 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 584, column 19) - _mainModuleFile = - ({-# LINE 584 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainFile ++ ".hs" - {-# LINE 2726 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 585, column 19) - _genMainModule = - ({-# LINE 585 "src-ag/ExecutionPlan2Hs.ag" #-} - writeModule _mainModuleFile - ( [ pp $ "{-# LANGUAGE Rank2Types, GADTs, EmptyDataDecls #-}" - , pp $ _lhsIpragmaBlocks - , pp $ _lhsIoptionsLine - , pp $ _lhsImoduleHeader _lhsImainName "" "" False - , pp $ "import Control.Monad.Identity" - , pp $ "import " ++ _lhsImainName ++ "_common" - ] - ++ _nontsIimports - ++ _nontsIappendMain - ) - {-# LINE 2742 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 596, column 19) - _commonFile = - ({-# LINE 596 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainFile ++ "_common.hs" - {-# LINE 2748 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 597, column 19) - _genCommonModule = - ({-# LINE 597 "src-ag/ExecutionPlan2Hs.ag" #-} - writeModule _commonFile - ( [ pp $ "{-# LANGUAGE Rank2Types, GADTs, EmptyDataDecls #-}" - , pp $ _lhsIpragmaBlocks - , pp $ _lhsIoptionsLine - , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True - , pp $ "import Control.Monad.Identity" - , _lhsIimportBlocks - , _lhsItextBlocks - ] - ++ _nontsIappendCommon - ) - {-# LINE 2764 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _nontsOimportBlocks = - ({-# LINE 25 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIimportBlocks - {-# LINE 2770 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _nontsOinhmap = - ({-# LINE 188 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIinhmap - {-# LINE 2776 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _nontsOmainFile = - ({-# LINE 29 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainFile - {-# LINE 2782 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _nontsOmainName = - ({-# LINE 31 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainName - {-# LINE 2788 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _nontsOmoduleHeader = - ({-# LINE 28 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImoduleHeader - {-# LINE 2794 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _nontsOoptions = - ({-# LINE 41 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptions - {-# LINE 2800 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _nontsOoptionsLine = - ({-# LINE 30 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptionsLine - {-# LINE 2806 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _nontsOpragmaBlocks = - ({-# LINE 26 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIpragmaBlocks - {-# LINE 2812 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _nontsOsynmap = - ({-# LINE 189 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIsynmap - {-# LINE 2818 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _nontsOtextBlocks = - ({-# LINE 27 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsItextBlocks - {-# LINE 2824 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _nontsIappendCommon,_nontsIappendMain,_nontsIchildvisit,_nontsIgenProdIO,_nontsIimports,_nontsIoutput,_nontsIvisitdefs,_nontsIvisituses) = - nonts_ _nontsOallchildvisit _nontsOavisitdefs _nontsOavisituses _nontsOderivings _nontsOimportBlocks _nontsOinhmap _nontsOmainFile _nontsOmainName _nontsOmoduleHeader _nontsOoptions _nontsOoptionsLine _nontsOpragmaBlocks _nontsOsynmap _nontsOtextBlocks _nontsOtypeSyns _nontsOwrappers - in ( _lhsOgenIO,_lhsOoutput))) ) --- Expression -------------------------------------------------- -{- - visit 0: - synthesized attributes: - attrs : Set.Set String - semfunc : 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 (( (Set.Set String),PP_Doc)) -data Inh_Expression = Inh_Expression {} -data Syn_Expression = Syn_Expression {attrs_Syn_Expression :: (Set.Set String),semfunc_Syn_Expression :: PP_Doc} -wrap_Expression :: T_Expression -> - Inh_Expression -> - Syn_Expression -wrap_Expression (T_Expression sem ) (Inh_Expression ) = - (let ( _lhsOattrs,_lhsOsemfunc) = sem - in (Syn_Expression _lhsOattrs _lhsOsemfunc )) -sem_Expression_Expression :: Pos -> - ([HsToken]) -> - T_Expression -sem_Expression_Expression pos_ tks_ = - (T_Expression (let _lhsOattrs :: (Set.Set String) - _lhsOsemfunc :: PP_Doc - -- "src-ag/ExecutionPlan2Hs.ag"(line 448, column 16) - _lhsOattrs = - ({-# LINE 448 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.unions $ map (\tok -> attrs_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_ - {-# LINE 2865 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 449, column 16) - _lhsOsemfunc = - ({-# LINE 449 "src-ag/ExecutionPlan2Hs.ag" #-} - vlist $ showTokens $ map (\tok -> tok_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_ - {-# LINE 2871 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOattrs,_lhsOsemfunc)) ) --- HsToken ----------------------------------------------------- -{- - visit 0: - synthesized attributes: - attrs : Set.Set String - tok : (Pos,String) - alternatives: - alternative AGField: - child field : {Identifier} - child attr : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - visit 0: - local addTrace : _ - alternative AGLocal: - child var : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - visit 0: - local tok : _ - alternative CharToken: - child value : {String} - child pos : {Pos} - alternative Err: - child mesg : {String} - child pos : {Pos} - alternative HsToken: - child value : {String} - child pos : {Pos} - alternative StrToken: - child value : {String} - child pos : {Pos} --} --- cata -sem_HsToken :: HsToken -> - T_HsToken -sem_HsToken (AGField _field _attr _pos _rdesc ) = - (sem_HsToken_AGField _field _attr _pos _rdesc ) -sem_HsToken (AGLocal _var _pos _rdesc ) = - (sem_HsToken_AGLocal _var _pos _rdesc ) -sem_HsToken (CharToken _value _pos ) = - (sem_HsToken_CharToken _value _pos ) -sem_HsToken (Err _mesg _pos ) = - (sem_HsToken_Err _mesg _pos ) -sem_HsToken (HsToken _value _pos ) = - (sem_HsToken_HsToken _value _pos ) -sem_HsToken (StrToken _value _pos ) = - (sem_HsToken_StrToken _value _pos ) --- semantic domain -newtype T_HsToken = T_HsToken (( (Set.Set String),((Pos,String)))) -data Inh_HsToken = Inh_HsToken {} -data Syn_HsToken = Syn_HsToken {attrs_Syn_HsToken :: (Set.Set String),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_AGField :: Identifier -> - Identifier -> - Pos -> - (Maybe String) -> - T_HsToken -sem_HsToken_AGField field_ attr_ pos_ rdesc_ = - (T_HsToken (let _lhsOattrs :: (Set.Set String) - _lhsOtok :: ((Pos,String)) - -- "src-ag/ExecutionPlan2Hs.ag"(line 443, column 15) - _lhsOattrs = - ({-# LINE 443 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.singleton $ attrname True field_ attr_ - {-# LINE 2944 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 559, column 8) - _addTrace = - ({-# LINE 559 "src-ag/ExecutionPlan2Hs.ag" #-} - case rdesc_ of - Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))" - Nothing -> id - {-# LINE 2952 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 562, column 8) - _lhsOtok = - ({-# LINE 562 "src-ag/ExecutionPlan2Hs.ag" #-} - (pos_, _addTrace $ attrname True field_ attr_) - {-# LINE 2958 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOattrs,_lhsOtok)) ) -sem_HsToken_AGLocal :: Identifier -> - Pos -> - (Maybe String) -> - T_HsToken -sem_HsToken_AGLocal var_ pos_ rdesc_ = - (T_HsToken (let _lhsOattrs :: (Set.Set String) - _lhsOtok :: ((Pos,String)) - -- "src-ag/ExecutionPlan2Hs.ag"(line 442, column 15) - _lhsOattrs = - ({-# LINE 442 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.singleton $ locname var_ - {-# LINE 2972 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 555, column 15) - _tok = - ({-# LINE 555 "src-ag/ExecutionPlan2Hs.ag" #-} - (pos_,locname var_) - {-# LINE 2978 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (from local) - _lhsOtok = - ({-# LINE 557 "src-ag/ExecutionPlan2Hs.ag" #-} - _tok - {-# LINE 2984 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOattrs,_lhsOtok)) ) -sem_HsToken_CharToken :: String -> - Pos -> - T_HsToken -sem_HsToken_CharToken value_ pos_ = - (T_HsToken (let _lhsOtok :: ((Pos,String)) - _lhsOattrs :: (Set.Set String) - -- "src-ag/ExecutionPlan2Hs.ag"(line 566, column 16) - _lhsOtok = - ({-# LINE 566 "src-ag/ExecutionPlan2Hs.ag" #-} - (pos_, if null value_ - then "" - else showCharShort (head value_) - ) - {-# LINE 3000 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 440, column 37) - _lhsOattrs = - ({-# LINE 440 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.empty - {-# LINE 3006 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOattrs,_lhsOtok)) ) -sem_HsToken_Err :: String -> - Pos -> - T_HsToken -sem_HsToken_Err mesg_ pos_ = - (T_HsToken (let _lhsOtok :: ((Pos,String)) - _lhsOattrs :: (Set.Set String) - -- "src-ag/ExecutionPlan2Hs.ag"(line 572, column 16) - _lhsOtok = - ({-# LINE 572 "src-ag/ExecutionPlan2Hs.ag" #-} - (pos_, "") - {-# LINE 3019 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 440, column 37) - _lhsOattrs = - ({-# LINE 440 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.empty - {-# LINE 3025 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOattrs,_lhsOtok)) ) -sem_HsToken_HsToken :: String -> - Pos -> - T_HsToken -sem_HsToken_HsToken value_ pos_ = - (T_HsToken (let _lhsOtok :: ((Pos,String)) - _lhsOattrs :: (Set.Set String) - -- "src-ag/ExecutionPlan2Hs.ag"(line 564, column 14) - _lhsOtok = - ({-# LINE 564 "src-ag/ExecutionPlan2Hs.ag" #-} - (pos_, value_) - {-# LINE 3038 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 440, column 37) - _lhsOattrs = - ({-# LINE 440 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.empty - {-# LINE 3044 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOattrs,_lhsOtok)) ) -sem_HsToken_StrToken :: String -> - Pos -> - T_HsToken -sem_HsToken_StrToken value_ pos_ = - (T_HsToken (let _lhsOtok :: ((Pos,String)) - _lhsOattrs :: (Set.Set String) - -- "src-ag/ExecutionPlan2Hs.ag"(line 571, column 16) - _lhsOtok = - ({-# LINE 571 "src-ag/ExecutionPlan2Hs.ag" #-} - (pos_, showStrShort value_) - {-# LINE 3057 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 440, column 37) - _lhsOattrs = - ({-# LINE 440 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.empty - {-# LINE 3063 "src-ag/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 :: (Set.Set String) - _hdItok :: ((Pos,String)) - _tlItks :: ([(Pos,String)]) - -- "src-ag/ExecutionPlan2Hs.ag"(line 551, column 10) - _lhsOtks = - ({-# LINE 551 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdItok : _tlItks - {-# LINE 3104 "src-ag/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 552, column 10) - _lhsOtks = - ({-# LINE 552 "src-ag/ExecutionPlan2Hs.ag" #-} - [] - {-# LINE 3118 "src-ag/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 attribute: - addtilde : PP_Doc -> PP_Doc - synthesized attributes: - attrs : Set.Set String - copy : SELF - sem_lhs : PP_Doc - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern (Alias _field _attr _pat _parts ) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) -sem_Pattern (Constr _name _pats ) = - (sem_Pattern_Constr _name (sem_Patterns _pats ) ) -sem_Pattern (Irrefutable _pat ) = - (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) -sem_Pattern (Product _pos _pats ) = - (sem_Pattern_Product _pos (sem_Patterns _pats ) ) -sem_Pattern (Underscore _pos ) = - (sem_Pattern_Underscore _pos ) --- semantic domain -newtype T_Pattern = T_Pattern ((PP_Doc -> PP_Doc) -> - ( (Set.Set String),Pattern ,( PP_Doc ))) -data Inh_Pattern = Inh_Pattern {addtilde_Inh_Pattern :: (PP_Doc -> PP_Doc)} -data Syn_Pattern = Syn_Pattern {attrs_Syn_Pattern :: (Set.Set String),copy_Syn_Pattern :: Pattern ,sem_lhs_Syn_Pattern :: ( PP_Doc )} -wrap_Pattern :: T_Pattern -> - Inh_Pattern -> - Syn_Pattern -wrap_Pattern (T_Pattern sem ) (Inh_Pattern _lhsIaddtilde ) = - (let ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs) = sem _lhsIaddtilde - in (Syn_Pattern _lhsOattrs _lhsOcopy _lhsOsem_lhs )) -sem_Pattern_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = - (T_Pattern (\ _lhsIaddtilde -> - (let _lhsOsem_lhs :: ( PP_Doc ) - _lhsOattrs :: (Set.Set String) - _lhsOcopy :: Pattern - _patOaddtilde :: (PP_Doc -> PP_Doc) - _partsOaddtilde :: (PP_Doc -> PP_Doc) - _patIattrs :: (Set.Set String) - _patIcopy :: Pattern - _patIsem_lhs :: ( PP_Doc ) - _partsIattrs :: (Set.Set String) - _partsIcopy :: Patterns - _partsIsem_lhs :: ([PP_Doc]) - -- "src-ag/ExecutionPlan2Hs.ag"(line 430, column 17) - _lhsOsem_lhs = - ({-# LINE 430 "src-ag/ExecutionPlan2Hs.ag" #-} - text $ attrname False field_ attr_ - {-# LINE 3231 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 431, column 17) - _lhsOattrs = - ({-# LINE 431 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.singleton $ attrname False field_ attr_ - {-# LINE 3237 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 3243 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3249 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _patOaddtilde = - ({-# LINE 425 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIaddtilde - {-# LINE 3255 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _partsOaddtilde = - ({-# LINE 425 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIaddtilde - {-# LINE 3261 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _patIattrs,_patIcopy,_patIsem_lhs) = - pat_ _patOaddtilde - ( _partsIattrs,_partsIcopy,_partsIsem_lhs) = - parts_ _partsOaddtilde - in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs))) ) -sem_Pattern_Constr :: ConstructorIdent -> - T_Patterns -> - T_Pattern -sem_Pattern_Constr name_ (T_Patterns pats_ ) = - (T_Pattern (\ _lhsIaddtilde -> - (let _lhsOsem_lhs :: ( PP_Doc ) - _patsOaddtilde :: (PP_Doc -> PP_Doc) - _lhsOattrs :: (Set.Set String) - _lhsOcopy :: Pattern - _patsIattrs :: (Set.Set String) - _patsIcopy :: Patterns - _patsIsem_lhs :: ([PP_Doc]) - -- "src-ag/ExecutionPlan2Hs.ag"(line 434, column 17) - _lhsOsem_lhs = - ({-# LINE 434 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIaddtilde $ pp_parens $ name_ >#< hv_sp _patsIsem_lhs - {-# LINE 3284 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 435, column 17) - _patsOaddtilde = - ({-# LINE 435 "src-ag/ExecutionPlan2Hs.ag" #-} - id - {-# LINE 3290 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 427, column 36) - _lhsOattrs = - ({-# LINE 427 "src-ag/ExecutionPlan2Hs.ag" #-} - _patsIattrs - {-# LINE 3296 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 3302 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3308 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _patsIattrs,_patsIcopy,_patsIsem_lhs) = - pats_ _patsOaddtilde - in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs))) ) -sem_Pattern_Irrefutable :: T_Pattern -> - T_Pattern -sem_Pattern_Irrefutable (T_Pattern pat_ ) = - (T_Pattern (\ _lhsIaddtilde -> - (let _lhsOsem_lhs :: ( PP_Doc ) - _patOaddtilde :: (PP_Doc -> PP_Doc) - _lhsOattrs :: (Set.Set String) - _lhsOcopy :: Pattern - _patIattrs :: (Set.Set String) - _patIcopy :: Pattern - _patIsem_lhs :: ( PP_Doc ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 437, column 17) - _lhsOsem_lhs = - ({-# LINE 437 "src-ag/ExecutionPlan2Hs.ag" #-} - text "~" >|< pp_parens _patIsem_lhs - {-# LINE 3328 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 438, column 17) - _patOaddtilde = - ({-# LINE 438 "src-ag/ExecutionPlan2Hs.ag" #-} - id - {-# LINE 3334 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 427, column 36) - _lhsOattrs = - ({-# LINE 427 "src-ag/ExecutionPlan2Hs.ag" #-} - _patIattrs - {-# LINE 3340 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 3346 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3352 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _patIattrs,_patIcopy,_patIsem_lhs) = - pat_ _patOaddtilde - in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs))) ) -sem_Pattern_Product :: Pos -> - T_Patterns -> - T_Pattern -sem_Pattern_Product pos_ (T_Patterns pats_ ) = - (T_Pattern (\ _lhsIaddtilde -> - (let _lhsOsem_lhs :: ( PP_Doc ) - _patsOaddtilde :: (PP_Doc -> PP_Doc) - _lhsOattrs :: (Set.Set String) - _lhsOcopy :: Pattern - _patsIattrs :: (Set.Set String) - _patsIcopy :: Patterns - _patsIsem_lhs :: ([PP_Doc]) - -- "src-ag/ExecutionPlan2Hs.ag"(line 432, column 17) - _lhsOsem_lhs = - ({-# LINE 432 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIaddtilde $ pp_block "(" ")" "," _patsIsem_lhs - {-# LINE 3373 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 433, column 17) - _patsOaddtilde = - ({-# LINE 433 "src-ag/ExecutionPlan2Hs.ag" #-} - id - {-# LINE 3379 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 427, column 36) - _lhsOattrs = - ({-# LINE 427 "src-ag/ExecutionPlan2Hs.ag" #-} - _patsIattrs - {-# LINE 3385 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 3391 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3397 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _patsIattrs,_patsIcopy,_patsIsem_lhs) = - pats_ _patsOaddtilde - in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs))) ) -sem_Pattern_Underscore :: Pos -> - T_Pattern -sem_Pattern_Underscore pos_ = - (T_Pattern (\ _lhsIaddtilde -> - (let _lhsOsem_lhs :: ( PP_Doc ) - _lhsOattrs :: (Set.Set String) - _lhsOcopy :: Pattern - -- "src-ag/ExecutionPlan2Hs.ag"(line 436, column 17) - _lhsOsem_lhs = - ({-# LINE 436 "src-ag/ExecutionPlan2Hs.ag" #-} - text "_" - {-# LINE 3413 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 427, column 36) - _lhsOattrs = - ({-# LINE 427 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.empty - {-# LINE 3419 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Underscore pos_ - {-# LINE 3425 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3431 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs))) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - inherited attribute: - addtilde : PP_Doc -> PP_Doc - synthesized attributes: - attrs : Set.Set String - copy : SELF - 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 ((PP_Doc -> PP_Doc) -> - ( (Set.Set String),Patterns ,([PP_Doc]))) -data Inh_Patterns = Inh_Patterns {addtilde_Inh_Patterns :: (PP_Doc -> PP_Doc)} -data Syn_Patterns = Syn_Patterns {attrs_Syn_Patterns :: (Set.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 _lhsIaddtilde ) = - (let ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs) = sem _lhsIaddtilde - in (Syn_Patterns _lhsOattrs _lhsOcopy _lhsOsem_lhs )) -sem_Patterns_Cons :: T_Pattern -> - T_Patterns -> - T_Patterns -sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) = - (T_Patterns (\ _lhsIaddtilde -> - (let _lhsOattrs :: (Set.Set String) - _lhsOsem_lhs :: ([PP_Doc]) - _lhsOcopy :: Patterns - _hdOaddtilde :: (PP_Doc -> PP_Doc) - _tlOaddtilde :: (PP_Doc -> PP_Doc) - _hdIattrs :: (Set.Set String) - _hdIcopy :: Pattern - _hdIsem_lhs :: ( PP_Doc ) - _tlIattrs :: (Set.Set String) - _tlIcopy :: Patterns - _tlIsem_lhs :: ([PP_Doc]) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 427, column 36) - _lhsOattrs = - ({-# LINE 427 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIattrs `Set.union` _tlIattrs - {-# LINE 3489 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 424, column 29) - _lhsOsem_lhs = - ({-# LINE 424 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIsem_lhs : _tlIsem_lhs - {-# LINE 3495 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 3501 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3507 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOaddtilde = - ({-# LINE 425 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIaddtilde - {-# LINE 3513 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOaddtilde = - ({-# LINE 425 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIaddtilde - {-# LINE 3519 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _hdIattrs,_hdIcopy,_hdIsem_lhs) = - hd_ _hdOaddtilde - ( _tlIattrs,_tlIcopy,_tlIsem_lhs) = - tl_ _tlOaddtilde - in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs))) ) -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = - (T_Patterns (\ _lhsIaddtilde -> - (let _lhsOattrs :: (Set.Set String) - _lhsOsem_lhs :: ([PP_Doc]) - _lhsOcopy :: Patterns - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 427, column 36) - _lhsOattrs = - ({-# LINE 427 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.empty - {-# LINE 3536 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 424, column 29) - _lhsOsem_lhs = - ({-# LINE 424 "src-ag/ExecutionPlan2Hs.ag" #-} - [] - {-# LINE 3542 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - [] - {-# LINE 3548 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3554 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs))) ) --- Visit ------------------------------------------------------- -{- - visit 0: - inherited attributes: - allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) - allintramap : Map.Map StateIdentifier (Set.Set String) - avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) - avisituses : Map.Map VisitIdentifier (Set.Set Identifier) - childintros : Map.Map Identifier PP_Doc - inhmap : Attributes - mrules : Map.Map Identifier PP_Doc - nt : NontermIdent - options : Options - ruledefs : Map.Map Identifier (Set.Set String) - ruleuses : Map.Map Identifier (Set.Set String) - synmap : Attributes - terminaldefs : Set.Set String - synthesized attributes: - allvisits : VisitStateState - childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) - intramap : Map.Map StateIdentifier (Set.Set String) - sem_visit : (StateIdentifier,PP_Doc) - t_visits : PP_Doc - usedrules : Set.Set Identifier - visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) - visituses : Map.Map VisitIdentifier (Set.Set Identifier) - alternatives: - alternative Visit: - child ident : {VisitIdentifier} - child from : {StateIdentifier} - child to : {StateIdentifier} - child inh : {Set.Set Identifier} - child syn : {Set.Set Identifier} - child steps : VisitSteps - visit 0: - local inhpart : _ - local synpart : _ - local inhargs : _ - local synargs : _ - local nextargs : _ - local sem_steps : _ - local addbang : _ - local nextintra : _ - local uses : _ - local defs : _ --} --- cata -sem_Visit :: Visit -> - T_Visit -sem_Visit (Visit _ident _from _to _inh _syn _steps ) = - (sem_Visit_Visit _ident _from _to _inh _syn (sem_VisitSteps _steps ) ) --- semantic domain -newtype T_Visit = T_Visit ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> - (Map.Map StateIdentifier (Set.Set String)) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - (Map.Map Identifier PP_Doc) -> - Attributes -> - (Map.Map Identifier PP_Doc) -> - NontermIdent -> - Options -> - (Map.Map Identifier (Set.Set String)) -> - (Map.Map Identifier (Set.Set String)) -> - Attributes -> - (Set.Set String) -> - ( ( VisitStateState ),(Map.Map VisitIdentifier (Identifier -> PP_Doc)),(Map.Map StateIdentifier (Set.Set String)),( (StateIdentifier,PP_Doc) ),PP_Doc,(Set.Set Identifier),(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) -data Inh_Visit = Inh_Visit {allchildvisit_Inh_Visit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),allintramap_Inh_Visit :: (Map.Map StateIdentifier (Set.Set String)),avisitdefs_Inh_Visit :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_Visit :: (Map.Map VisitIdentifier (Set.Set Identifier)),childintros_Inh_Visit :: (Map.Map Identifier PP_Doc),inhmap_Inh_Visit :: Attributes,mrules_Inh_Visit :: (Map.Map Identifier PP_Doc),nt_Inh_Visit :: NontermIdent,options_Inh_Visit :: Options,ruledefs_Inh_Visit :: (Map.Map Identifier (Set.Set String)),ruleuses_Inh_Visit :: (Map.Map Identifier (Set.Set String)),synmap_Inh_Visit :: Attributes,terminaldefs_Inh_Visit :: (Set.Set String)} -data Syn_Visit = Syn_Visit {allvisits_Syn_Visit :: ( VisitStateState ),childvisit_Syn_Visit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),intramap_Syn_Visit :: (Map.Map StateIdentifier (Set.Set String)),sem_visit_Syn_Visit :: ( (StateIdentifier,PP_Doc) ),t_visits_Syn_Visit :: PP_Doc,usedrules_Syn_Visit :: (Set.Set Identifier),visitdefs_Syn_Visit :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_Visit :: (Map.Map VisitIdentifier (Set.Set Identifier))} -wrap_Visit :: T_Visit -> - Inh_Visit -> - Syn_Visit -wrap_Visit (T_Visit sem ) (Inh_Visit _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsIinhmap _lhsImrules _lhsInt _lhsIoptions _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs ) = - (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOintramap,_lhsOsem_visit,_lhsOt_visits,_lhsOusedrules,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsIinhmap _lhsImrules _lhsInt _lhsIoptions _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs - in (Syn_Visit _lhsOallvisits _lhsOchildvisit _lhsOintramap _lhsOsem_visit _lhsOt_visits _lhsOusedrules _lhsOvisitdefs _lhsOvisituses )) -sem_Visit_Visit :: VisitIdentifier -> - StateIdentifier -> - StateIdentifier -> - (Set.Set Identifier) -> - (Set.Set Identifier) -> - T_VisitSteps -> - T_Visit -sem_Visit_Visit ident_ from_ to_ inh_ syn_ (T_VisitSteps steps_ ) = - (T_Visit (\ _lhsIallchildvisit - _lhsIallintramap - _lhsIavisitdefs - _lhsIavisituses - _lhsIchildintros - _lhsIinhmap - _lhsImrules - _lhsInt - _lhsIoptions - _lhsIruledefs - _lhsIruleuses - _lhsIsynmap - _lhsIterminaldefs -> - (let _lhsOallvisits :: ( VisitStateState ) - _lhsOt_visits :: PP_Doc - _lhsOsem_visit :: ( (StateIdentifier,PP_Doc) ) - _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _lhsOintramap :: (Map.Map StateIdentifier (Set.Set String)) - _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _lhsOusedrules :: (Set.Set Identifier) - _stepsOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _stepsOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _stepsOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _stepsOchildintros :: (Map.Map Identifier PP_Doc) - _stepsOmrules :: (Map.Map Identifier PP_Doc) - _stepsOruledefs :: (Map.Map Identifier (Set.Set String)) - _stepsOruleuses :: (Map.Map Identifier (Set.Set String)) - _stepsIdefs :: (Set.Set String) - _stepsIsem_steps :: PP_Doc - _stepsIusedrules :: (Set.Set Identifier) - _stepsIuses :: (Set.Set String) - -- "src-ag/ExecutionPlan2Hs.ag"(line 212, column 11) - _lhsOallvisits = - ({-# LINE 212 "src-ag/ExecutionPlan2Hs.ag" #-} - (ident_, from_, to_) - {-# LINE 3675 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 262, column 11) - _lhsOt_visits = - ({-# LINE 262 "src-ag/ExecutionPlan2Hs.ag" #-} - "type" >#< "T_" >|< _lhsInt >|< "_v" >|< ident_ >#< "=" >#< _inhpart >#< - "Identity" >#< "(" >#< _synpart >#< "T_" >|< _lhsInt >|< "_s" >|< to_ >#< ")" - {-# LINE 3682 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 264, column 11) - _inhpart = - ({-# LINE 264 "src-ag/ExecutionPlan2Hs.ag" #-} - if Set.null inh_ - then empty - else (ppSpaced $ map (\i -> (\x -> pp_parens x >#< "->") $ typeToHaskellString (Just _lhsInt) [] - $ fromJust $ Map.lookup i _lhsIinhmap) $ Set.toList inh_) - {-# LINE 3691 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 268, column 11) - _synpart = - ({-# LINE 268 "src-ag/ExecutionPlan2Hs.ag" #-} - if Set.null syn_ - then empty - else (ppCommas $ map (\i -> typeToHaskellString (Just _lhsInt) [] $ fromJust $ Map.lookup i _lhsIsynmap) $ Set.toList syn_) >#< "," - {-# LINE 3699 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 364, column 11) - _lhsOsem_visit = - ({-# LINE 364 "src-ag/ExecutionPlan2Hs.ag" #-} - (from_, "v" >|< ident_ >#< "::" >#< "T_" >|< _lhsInt >|< "_v" >|< ident_ - >-< "v" >|< ident_ >#< (_inhargs _LHS True) >#< "=" >#< "do" - >-< indent 3 _sem_steps ) - {-# LINE 3707 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 367, column 11) - _inhargs = - ({-# LINE 367 "src-ag/ExecutionPlan2Hs.ag" #-} - \chn inh -> ppSpaced $ map (\arg -> attrname inh chn arg) $ Set.toList inh_ - {-# LINE 3713 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 368, column 11) - _synargs = - ({-# LINE 368 "src-ag/ExecutionPlan2Hs.ag" #-} - ppSpaced $ map (\arg -> attrname False _LHS arg >#< ",") $ Set.toList syn_ - {-# LINE 3719 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 369, column 11) - _nextargs = - ({-# LINE 369 "src-ag/ExecutionPlan2Hs.ag" #-} - ppSpaced $ Set.toList $ maybe Set.empty id $ Map.lookup to_ _lhsIallintramap - {-# LINE 3725 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 370, column 11) - _sem_steps = - ({-# LINE 370 "src-ag/ExecutionPlan2Hs.ag" #-} - _stepsIsem_steps - >-< "return" >#< "(" >#< _synargs >#< "st" >|< to_ >#< _nextargs >#< ")" - {-# LINE 3732 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 466, column 11) - _lhsOchildvisit = - ({-# LINE 466 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton ident_ $ \chn -> _addbang ("(" >#< ppSpaced ( - map (\x -> attrname True chn x >#< ",") $ Set.toList syn_) >#< locname chn - >#< ")") >#< "<-" >#< "inv_" >|< _lhsInt >|< "_s" >|< from_ >#< locname chn - >#< "K_" >|< _lhsInt >|< "_v" >|< ident_ >#< _inhargs chn False - {-# LINE 3741 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 470, column 11) - _addbang = - ({-# LINE 470 "src-ag/ExecutionPlan2Hs.ag" #-} - \x -> if bangpats _lhsIoptions then "!" >|< x else x - {-# LINE 3747 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 495, column 11) - _lhsOintramap = - ({-# LINE 495 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton from_ $ (_uses `Set.union` _nextintra ) `Set.difference` _defs - {-# LINE 3753 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 496, column 11) - _nextintra = - ({-# LINE 496 "src-ag/ExecutionPlan2Hs.ag" #-} - maybe Set.empty id $ Map.lookup to_ _lhsIallintramap - {-# LINE 3759 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 497, column 11) - _uses = - ({-# LINE 497 "src-ag/ExecutionPlan2Hs.ag" #-} - _stepsIuses - {-# LINE 3765 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 498, column 11) - _defs = - ({-# LINE 498 "src-ag/ExecutionPlan2Hs.ag" #-} - _stepsIdefs `Set.union` (Set.map (lhsname True) inh_) `Set.union` _lhsIterminaldefs - {-# LINE 3771 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 522, column 11) - _lhsOvisitdefs = - ({-# LINE 522 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton ident_ syn_ - {-# LINE 3777 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 523, column 11) - _lhsOvisituses = - ({-# LINE 523 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton ident_ inh_ - {-# LINE 3783 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 396, column 56) - _lhsOusedrules = - ({-# LINE 396 "src-ag/ExecutionPlan2Hs.ag" #-} - _stepsIusedrules - {-# LINE 3789 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _stepsOallchildvisit = - ({-# LINE 460 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallchildvisit - {-# LINE 3795 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _stepsOavisitdefs = - ({-# LINE 528 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisitdefs - {-# LINE 3801 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _stepsOavisituses = - ({-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisituses - {-# LINE 3807 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _stepsOchildintros = - ({-# LINE 384 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIchildintros - {-# LINE 3813 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _stepsOmrules = - ({-# LINE 373 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImrules - {-# LINE 3819 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _stepsOruledefs = - ({-# LINE 503 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIruledefs - {-# LINE 3825 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _stepsOruleuses = - ({-# LINE 504 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIruleuses - {-# LINE 3831 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _stepsIdefs,_stepsIsem_steps,_stepsIusedrules,_stepsIuses) = - steps_ _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildintros _stepsOmrules _stepsOruledefs _stepsOruleuses - in ( _lhsOallvisits,_lhsOchildvisit,_lhsOintramap,_lhsOsem_visit,_lhsOt_visits,_lhsOusedrules,_lhsOvisitdefs,_lhsOvisituses))) ) --- VisitStep --------------------------------------------------- -{- - visit 0: - inherited attributes: - allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) - avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) - avisituses : Map.Map VisitIdentifier (Set.Set Identifier) - childintros : Map.Map Identifier PP_Doc - mrules : Map.Map Identifier PP_Doc - ruledefs : Map.Map Identifier (Set.Set String) - ruleuses : Map.Map Identifier (Set.Set String) - synthesized attributes: - defs : Set.Set String - sem_steps : PP_Doc - usedrules : Set.Set Identifier - uses : Set.Set String - alternatives: - alternative ChildIntro: - child child : {Identifier} - alternative ChildVisit: - child child : {Identifier} - child nonterm : {NontermIdent} - child visit : {VisitIdentifier} - alternative Sem: - child name : {Identifier} - alternative Sim: - child steps : VisitSteps --} --- cata -sem_VisitStep :: VisitStep -> - T_VisitStep -sem_VisitStep (ChildIntro _child ) = - (sem_VisitStep_ChildIntro _child ) -sem_VisitStep (ChildVisit _child _nonterm _visit ) = - (sem_VisitStep_ChildVisit _child _nonterm _visit ) -sem_VisitStep (Sem _name ) = - (sem_VisitStep_Sem _name ) -sem_VisitStep (Sim _steps ) = - (sem_VisitStep_Sim (sem_VisitSteps _steps ) ) --- semantic domain -newtype T_VisitStep = T_VisitStep ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - (Map.Map Identifier PP_Doc) -> - (Map.Map Identifier PP_Doc) -> - (Map.Map Identifier (Set.Set String)) -> - (Map.Map Identifier (Set.Set String)) -> - ( (Set.Set String),PP_Doc,(Set.Set Identifier),(Set.Set String))) -data Inh_VisitStep = Inh_VisitStep {allchildvisit_Inh_VisitStep :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),avisitdefs_Inh_VisitStep :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_VisitStep :: (Map.Map VisitIdentifier (Set.Set Identifier)),childintros_Inh_VisitStep :: (Map.Map Identifier PP_Doc),mrules_Inh_VisitStep :: (Map.Map Identifier PP_Doc),ruledefs_Inh_VisitStep :: (Map.Map Identifier (Set.Set String)),ruleuses_Inh_VisitStep :: (Map.Map Identifier (Set.Set String))} -data Syn_VisitStep = Syn_VisitStep {defs_Syn_VisitStep :: (Set.Set String),sem_steps_Syn_VisitStep :: PP_Doc,usedrules_Syn_VisitStep :: (Set.Set Identifier),uses_Syn_VisitStep :: (Set.Set String)} -wrap_VisitStep :: T_VisitStep -> - Inh_VisitStep -> - Syn_VisitStep -wrap_VisitStep (T_VisitStep sem ) (Inh_VisitStep _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsImrules _lhsIruledefs _lhsIruleuses ) = - (let ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses) = sem _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsImrules _lhsIruledefs _lhsIruleuses - in (Syn_VisitStep _lhsOdefs _lhsOsem_steps _lhsOusedrules _lhsOuses )) -sem_VisitStep_ChildIntro :: Identifier -> - T_VisitStep -sem_VisitStep_ChildIntro child_ = - (T_VisitStep (\ _lhsIallchildvisit - _lhsIavisitdefs - _lhsIavisituses - _lhsIchildintros - _lhsImrules - _lhsIruledefs - _lhsIruleuses -> - (let _lhsOsem_steps :: PP_Doc - _lhsOdefs :: (Set.Set String) - _lhsOusedrules :: (Set.Set Identifier) - _lhsOuses :: (Set.Set String) - -- "src-ag/ExecutionPlan2Hs.ag"(line 377, column 16) - _lhsOsem_steps = - ({-# LINE 377 "src-ag/ExecutionPlan2Hs.ag" #-} - maybe (error $ "Child " ++ show child_ ++ " not found") id $ Map.lookup child_ _lhsIchildintros - {-# LINE 3910 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 540, column 16) - _lhsOdefs = - ({-# LINE 540 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.singleton $ locname child_ - {-# LINE 3916 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 396, column 56) - _lhsOusedrules = - ({-# LINE 396 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.empty - {-# LINE 3922 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 536, column 38) - _lhsOuses = - ({-# LINE 536 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.empty - {-# LINE 3928 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) -sem_VisitStep_ChildVisit :: Identifier -> - NontermIdent -> - VisitIdentifier -> - T_VisitStep -sem_VisitStep_ChildVisit child_ nonterm_ visit_ = - (T_VisitStep (\ _lhsIallchildvisit - _lhsIavisitdefs - _lhsIavisituses - _lhsIchildintros - _lhsImrules - _lhsIruledefs - _lhsIruleuses -> - (let _lhsOsem_steps :: PP_Doc - _lhsOdefs :: (Set.Set String) - _lhsOuses :: (Set.Set String) - _lhsOusedrules :: (Set.Set Identifier) - -- "src-ag/ExecutionPlan2Hs.ag"(line 378, column 16) - _lhsOsem_steps = - ({-# LINE 378 "src-ag/ExecutionPlan2Hs.ag" #-} - (maybe (error $ "Visit " ++ show visit_ ++ " not found") id $ Map.lookup visit_ _lhsIallchildvisit) $ child_ - {-# LINE 3951 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 541, column 16) - _lhsOdefs = - ({-# LINE 541 "src-ag/ExecutionPlan2Hs.ag" #-} - maybe (error "Visit not found") (Set.map $ attrname True child_) $ Map.lookup visit_ _lhsIavisitdefs - {-# LINE 3957 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 542, column 16) - _lhsOuses = - ({-# LINE 542 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.insert (locname child_) $ - maybe (error "Visit not found") (Set.map $ attrname False child_) $ Map.lookup visit_ _lhsIavisituses - {-# LINE 3964 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 396, column 56) - _lhsOusedrules = - ({-# LINE 396 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.empty - {-# LINE 3970 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) -sem_VisitStep_Sem :: Identifier -> - T_VisitStep -sem_VisitStep_Sem name_ = - (T_VisitStep (\ _lhsIallchildvisit - _lhsIavisitdefs - _lhsIavisituses - _lhsIchildintros - _lhsImrules - _lhsIruledefs - _lhsIruleuses -> - (let _lhsOsem_steps :: PP_Doc - _lhsOusedrules :: (Set.Set Identifier) - _lhsOdefs :: (Set.Set String) - _lhsOuses :: (Set.Set String) - -- "src-ag/ExecutionPlan2Hs.ag"(line 376, column 16) - _lhsOsem_steps = - ({-# LINE 376 "src-ag/ExecutionPlan2Hs.ag" #-} - maybe (error $ "Rule " ++ show name_ ++ " not found") id $ Map.lookup name_ _lhsImrules - {-# LINE 3991 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 400, column 9) - _lhsOusedrules = - ({-# LINE 400 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.singleton name_ - {-# LINE 3997 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 538, column 16) - _lhsOdefs = - ({-# LINE 538 "src-ag/ExecutionPlan2Hs.ag" #-} - maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruledefs - {-# LINE 4003 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- "src-ag/ExecutionPlan2Hs.ag"(line 539, column 16) - _lhsOuses = - ({-# LINE 539 "src-ag/ExecutionPlan2Hs.ag" #-} - maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruleuses - {-# LINE 4009 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) -sem_VisitStep_Sim :: T_VisitSteps -> - T_VisitStep -sem_VisitStep_Sim (T_VisitSteps steps_ ) = - (T_VisitStep (\ _lhsIallchildvisit - _lhsIavisitdefs - _lhsIavisituses - _lhsIchildintros - _lhsImrules - _lhsIruledefs - _lhsIruleuses -> - (let _lhsOdefs :: (Set.Set String) - _lhsOsem_steps :: PP_Doc - _lhsOusedrules :: (Set.Set Identifier) - _lhsOuses :: (Set.Set String) - _stepsOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _stepsOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _stepsOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _stepsOchildintros :: (Map.Map Identifier PP_Doc) - _stepsOmrules :: (Map.Map Identifier PP_Doc) - _stepsOruledefs :: (Map.Map Identifier (Set.Set String)) - _stepsOruleuses :: (Map.Map Identifier (Set.Set String)) - _stepsIdefs :: (Set.Set String) - _stepsIsem_steps :: PP_Doc - _stepsIusedrules :: (Set.Set Identifier) - _stepsIuses :: (Set.Set String) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 535, column 38) - _lhsOdefs = - ({-# LINE 535 "src-ag/ExecutionPlan2Hs.ag" #-} - _stepsIdefs - {-# LINE 4041 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 374, column 43) - _lhsOsem_steps = - ({-# LINE 374 "src-ag/ExecutionPlan2Hs.ag" #-} - _stepsIsem_steps - {-# LINE 4047 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 396, column 56) - _lhsOusedrules = - ({-# LINE 396 "src-ag/ExecutionPlan2Hs.ag" #-} - _stepsIusedrules - {-# LINE 4053 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 536, column 38) - _lhsOuses = - ({-# LINE 536 "src-ag/ExecutionPlan2Hs.ag" #-} - _stepsIuses - {-# LINE 4059 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _stepsOallchildvisit = - ({-# LINE 460 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallchildvisit - {-# LINE 4065 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _stepsOavisitdefs = - ({-# LINE 528 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisitdefs - {-# LINE 4071 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _stepsOavisituses = - ({-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisituses - {-# LINE 4077 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _stepsOchildintros = - ({-# LINE 384 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIchildintros - {-# LINE 4083 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _stepsOmrules = - ({-# LINE 373 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImrules - {-# LINE 4089 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _stepsOruledefs = - ({-# LINE 503 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIruledefs - {-# LINE 4095 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _stepsOruleuses = - ({-# LINE 504 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIruleuses - {-# LINE 4101 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _stepsIdefs,_stepsIsem_steps,_stepsIusedrules,_stepsIuses) = - steps_ _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildintros _stepsOmrules _stepsOruledefs _stepsOruleuses - in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) --- VisitSteps -------------------------------------------------- -{- - visit 0: - inherited attributes: - allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) - avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) - avisituses : Map.Map VisitIdentifier (Set.Set Identifier) - childintros : Map.Map Identifier PP_Doc - mrules : Map.Map Identifier PP_Doc - ruledefs : Map.Map Identifier (Set.Set String) - ruleuses : Map.Map Identifier (Set.Set String) - synthesized attributes: - defs : Set.Set String - sem_steps : PP_Doc - usedrules : Set.Set Identifier - uses : Set.Set String - 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.Map VisitIdentifier (Identifier -> PP_Doc)) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - (Map.Map Identifier PP_Doc) -> - (Map.Map Identifier PP_Doc) -> - (Map.Map Identifier (Set.Set String)) -> - (Map.Map Identifier (Set.Set String)) -> - ( (Set.Set String),PP_Doc,(Set.Set Identifier),(Set.Set String))) -data Inh_VisitSteps = Inh_VisitSteps {allchildvisit_Inh_VisitSteps :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),avisitdefs_Inh_VisitSteps :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_VisitSteps :: (Map.Map VisitIdentifier (Set.Set Identifier)),childintros_Inh_VisitSteps :: (Map.Map Identifier PP_Doc),mrules_Inh_VisitSteps :: (Map.Map Identifier PP_Doc),ruledefs_Inh_VisitSteps :: (Map.Map Identifier (Set.Set String)),ruleuses_Inh_VisitSteps :: (Map.Map Identifier (Set.Set String))} -data Syn_VisitSteps = Syn_VisitSteps {defs_Syn_VisitSteps :: (Set.Set String),sem_steps_Syn_VisitSteps :: PP_Doc,usedrules_Syn_VisitSteps :: (Set.Set Identifier),uses_Syn_VisitSteps :: (Set.Set String)} -wrap_VisitSteps :: T_VisitSteps -> - Inh_VisitSteps -> - Syn_VisitSteps -wrap_VisitSteps (T_VisitSteps sem ) (Inh_VisitSteps _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsImrules _lhsIruledefs _lhsIruleuses ) = - (let ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses) = sem _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsImrules _lhsIruledefs _lhsIruleuses - in (Syn_VisitSteps _lhsOdefs _lhsOsem_steps _lhsOusedrules _lhsOuses )) -sem_VisitSteps_Cons :: T_VisitStep -> - T_VisitSteps -> - T_VisitSteps -sem_VisitSteps_Cons (T_VisitStep hd_ ) (T_VisitSteps tl_ ) = - (T_VisitSteps (\ _lhsIallchildvisit - _lhsIavisitdefs - _lhsIavisituses - _lhsIchildintros - _lhsImrules - _lhsIruledefs - _lhsIruleuses -> - (let _lhsOdefs :: (Set.Set String) - _lhsOsem_steps :: PP_Doc - _lhsOusedrules :: (Set.Set Identifier) - _lhsOuses :: (Set.Set String) - _hdOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _hdOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _hdOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _hdOchildintros :: (Map.Map Identifier PP_Doc) - _hdOmrules :: (Map.Map Identifier PP_Doc) - _hdOruledefs :: (Map.Map Identifier (Set.Set String)) - _hdOruleuses :: (Map.Map Identifier (Set.Set String)) - _tlOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _tlOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _tlOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _tlOchildintros :: (Map.Map Identifier PP_Doc) - _tlOmrules :: (Map.Map Identifier PP_Doc) - _tlOruledefs :: (Map.Map Identifier (Set.Set String)) - _tlOruleuses :: (Map.Map Identifier (Set.Set String)) - _hdIdefs :: (Set.Set String) - _hdIsem_steps :: PP_Doc - _hdIusedrules :: (Set.Set Identifier) - _hdIuses :: (Set.Set String) - _tlIdefs :: (Set.Set String) - _tlIsem_steps :: PP_Doc - _tlIusedrules :: (Set.Set Identifier) - _tlIuses :: (Set.Set String) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 535, column 38) - _lhsOdefs = - ({-# LINE 535 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIdefs `Set.union` _tlIdefs - {-# LINE 4191 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 374, column 43) - _lhsOsem_steps = - ({-# LINE 374 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIsem_steps >-< _tlIsem_steps - {-# LINE 4197 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 396, column 56) - _lhsOusedrules = - ({-# LINE 396 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIusedrules `Set.union` _tlIusedrules - {-# LINE 4203 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 536, column 38) - _lhsOuses = - ({-# LINE 536 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIuses `Set.union` _tlIuses - {-# LINE 4209 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOallchildvisit = - ({-# LINE 460 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallchildvisit - {-# LINE 4215 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOavisitdefs = - ({-# LINE 528 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisitdefs - {-# LINE 4221 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOavisituses = - ({-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisituses - {-# LINE 4227 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOchildintros = - ({-# LINE 384 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIchildintros - {-# LINE 4233 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOmrules = - ({-# LINE 373 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImrules - {-# LINE 4239 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOruledefs = - ({-# LINE 503 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIruledefs - {-# LINE 4245 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOruleuses = - ({-# LINE 504 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIruleuses - {-# LINE 4251 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOallchildvisit = - ({-# LINE 460 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallchildvisit - {-# LINE 4257 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOavisitdefs = - ({-# LINE 528 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisitdefs - {-# LINE 4263 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOavisituses = - ({-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisituses - {-# LINE 4269 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOchildintros = - ({-# LINE 384 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIchildintros - {-# LINE 4275 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOmrules = - ({-# LINE 373 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImrules - {-# LINE 4281 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOruledefs = - ({-# LINE 503 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIruledefs - {-# LINE 4287 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOruleuses = - ({-# LINE 504 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIruleuses - {-# LINE 4293 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _hdIdefs,_hdIsem_steps,_hdIusedrules,_hdIuses) = - hd_ _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOchildintros _hdOmrules _hdOruledefs _hdOruleuses - ( _tlIdefs,_tlIsem_steps,_tlIusedrules,_tlIuses) = - tl_ _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOchildintros _tlOmrules _tlOruledefs _tlOruleuses - in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) -sem_VisitSteps_Nil :: T_VisitSteps -sem_VisitSteps_Nil = - (T_VisitSteps (\ _lhsIallchildvisit - _lhsIavisitdefs - _lhsIavisituses - _lhsIchildintros - _lhsImrules - _lhsIruledefs - _lhsIruleuses -> - (let _lhsOdefs :: (Set.Set String) - _lhsOsem_steps :: PP_Doc - _lhsOusedrules :: (Set.Set Identifier) - _lhsOuses :: (Set.Set String) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 535, column 38) - _lhsOdefs = - ({-# LINE 535 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.empty - {-# LINE 4317 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 374, column 43) - _lhsOsem_steps = - ({-# LINE 374 "src-ag/ExecutionPlan2Hs.ag" #-} - empty - {-# LINE 4323 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 396, column 56) - _lhsOusedrules = - ({-# LINE 396 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.empty - {-# LINE 4329 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 536, column 38) - _lhsOuses = - ({-# LINE 536 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.empty - {-# LINE 4335 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) --- Visits ------------------------------------------------------ -{- - visit 0: - inherited attributes: - allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) - allintramap : Map.Map StateIdentifier (Set.Set String) - avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) - avisituses : Map.Map VisitIdentifier (Set.Set Identifier) - childintros : Map.Map Identifier PP_Doc - inhmap : Attributes - mrules : Map.Map Identifier PP_Doc - nt : NontermIdent - options : Options - ruledefs : Map.Map Identifier (Set.Set String) - ruleuses : Map.Map Identifier (Set.Set String) - synmap : Attributes - terminaldefs : Set.Set String - synthesized attributes: - allvisits : [VisitStateState] - childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) - intramap : Map.Map StateIdentifier (Set.Set String) - sem_visit : [(StateIdentifier,PP_Doc)] - t_visits : PP_Doc - usedrules : Set.Set Identifier - visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) - visituses : Map.Map VisitIdentifier (Set.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.Map VisitIdentifier (Identifier -> PP_Doc)) -> - (Map.Map StateIdentifier (Set.Set String)) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - (Map.Map VisitIdentifier (Set.Set Identifier)) -> - (Map.Map Identifier PP_Doc) -> - Attributes -> - (Map.Map Identifier PP_Doc) -> - NontermIdent -> - Options -> - (Map.Map Identifier (Set.Set String)) -> - (Map.Map Identifier (Set.Set String)) -> - Attributes -> - (Set.Set String) -> - ( ([VisitStateState]),(Map.Map VisitIdentifier (Identifier -> PP_Doc)),(Map.Map StateIdentifier (Set.Set String)),( [(StateIdentifier,PP_Doc)] ),PP_Doc,(Set.Set Identifier),(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) -data Inh_Visits = Inh_Visits {allchildvisit_Inh_Visits :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),allintramap_Inh_Visits :: (Map.Map StateIdentifier (Set.Set String)),avisitdefs_Inh_Visits :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_Visits :: (Map.Map VisitIdentifier (Set.Set Identifier)),childintros_Inh_Visits :: (Map.Map Identifier PP_Doc),inhmap_Inh_Visits :: Attributes,mrules_Inh_Visits :: (Map.Map Identifier PP_Doc),nt_Inh_Visits :: NontermIdent,options_Inh_Visits :: Options,ruledefs_Inh_Visits :: (Map.Map Identifier (Set.Set String)),ruleuses_Inh_Visits :: (Map.Map Identifier (Set.Set String)),synmap_Inh_Visits :: Attributes,terminaldefs_Inh_Visits :: (Set.Set String)} -data Syn_Visits = Syn_Visits {allvisits_Syn_Visits :: ([VisitStateState]),childvisit_Syn_Visits :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),intramap_Syn_Visits :: (Map.Map StateIdentifier (Set.Set String)),sem_visit_Syn_Visits :: ( [(StateIdentifier,PP_Doc)] ),t_visits_Syn_Visits :: PP_Doc,usedrules_Syn_Visits :: (Set.Set Identifier),visitdefs_Syn_Visits :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_Visits :: (Map.Map VisitIdentifier (Set.Set Identifier))} -wrap_Visits :: T_Visits -> - Inh_Visits -> - Syn_Visits -wrap_Visits (T_Visits sem ) (Inh_Visits _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsIinhmap _lhsImrules _lhsInt _lhsIoptions _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs ) = - (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOintramap,_lhsOsem_visit,_lhsOt_visits,_lhsOusedrules,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsIinhmap _lhsImrules _lhsInt _lhsIoptions _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs - in (Syn_Visits _lhsOallvisits _lhsOchildvisit _lhsOintramap _lhsOsem_visit _lhsOt_visits _lhsOusedrules _lhsOvisitdefs _lhsOvisituses )) -sem_Visits_Cons :: T_Visit -> - T_Visits -> - T_Visits -sem_Visits_Cons (T_Visit hd_ ) (T_Visits tl_ ) = - (T_Visits (\ _lhsIallchildvisit - _lhsIallintramap - _lhsIavisitdefs - _lhsIavisituses - _lhsIchildintros - _lhsIinhmap - _lhsImrules - _lhsInt - _lhsIoptions - _lhsIruledefs - _lhsIruleuses - _lhsIsynmap - _lhsIterminaldefs -> - (let _lhsOallvisits :: ([VisitStateState]) - _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _lhsOintramap :: (Map.Map StateIdentifier (Set.Set String)) - _lhsOsem_visit :: ( [(StateIdentifier,PP_Doc)] ) - _lhsOt_visits :: PP_Doc - _lhsOusedrules :: (Set.Set Identifier) - _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _hdOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _hdOallintramap :: (Map.Map StateIdentifier (Set.Set String)) - _hdOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _hdOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _hdOchildintros :: (Map.Map Identifier PP_Doc) - _hdOinhmap :: Attributes - _hdOmrules :: (Map.Map Identifier PP_Doc) - _hdOnt :: NontermIdent - _hdOoptions :: Options - _hdOruledefs :: (Map.Map Identifier (Set.Set String)) - _hdOruleuses :: (Map.Map Identifier (Set.Set String)) - _hdOsynmap :: Attributes - _hdOterminaldefs :: (Set.Set String) - _tlOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _tlOallintramap :: (Map.Map StateIdentifier (Set.Set String)) - _tlOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _tlOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _tlOchildintros :: (Map.Map Identifier PP_Doc) - _tlOinhmap :: Attributes - _tlOmrules :: (Map.Map Identifier PP_Doc) - _tlOnt :: NontermIdent - _tlOoptions :: Options - _tlOruledefs :: (Map.Map Identifier (Set.Set String)) - _tlOruleuses :: (Map.Map Identifier (Set.Set String)) - _tlOsynmap :: Attributes - _tlOterminaldefs :: (Set.Set String) - _hdIallvisits :: ( VisitStateState ) - _hdIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _hdIintramap :: (Map.Map StateIdentifier (Set.Set String)) - _hdIsem_visit :: ( (StateIdentifier,PP_Doc) ) - _hdIt_visits :: PP_Doc - _hdIusedrules :: (Set.Set Identifier) - _hdIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _hdIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _tlIallvisits :: ([VisitStateState]) - _tlIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _tlIintramap :: (Map.Map StateIdentifier (Set.Set String)) - _tlIsem_visit :: ( [(StateIdentifier,PP_Doc)] ) - _tlIt_visits :: PP_Doc - _tlIusedrules :: (Set.Set Identifier) - _tlIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _tlIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 207, column 29) - _lhsOallvisits = - ({-# LINE 207 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIallvisits : _tlIallvisits - {-# LINE 4469 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 458, column 37) - _lhsOchildvisit = - ({-# LINE 458 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIchildvisit `Map.union` _tlIchildvisit - {-# LINE 4475 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 480, column 34) - _lhsOintramap = - ({-# LINE 480 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIintramap `uwSetUnion` _tlIintramap - {-# LINE 4481 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 361, column 29) - _lhsOsem_visit = - ({-# LINE 361 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIsem_visit : _tlIsem_visit - {-# LINE 4487 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 253, column 54) - _lhsOt_visits = - ({-# LINE 253 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIt_visits >-< _tlIt_visits - {-# LINE 4493 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 396, column 56) - _lhsOusedrules = - ({-# LINE 396 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIusedrules `Set.union` _tlIusedrules - {-# LINE 4499 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 518, column 36) - _lhsOvisitdefs = - ({-# LINE 518 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIvisitdefs `uwSetUnion` _tlIvisitdefs - {-# LINE 4505 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 519, column 36) - _lhsOvisituses = - ({-# LINE 519 "src-ag/ExecutionPlan2Hs.ag" #-} - _hdIvisituses `uwSetUnion` _tlIvisituses - {-# LINE 4511 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOallchildvisit = - ({-# LINE 457 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallchildvisit - {-# LINE 4517 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOallintramap = - ({-# LINE 479 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallintramap - {-# LINE 4523 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOavisitdefs = - ({-# LINE 528 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisitdefs - {-# LINE 4529 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOavisituses = - ({-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisituses - {-# LINE 4535 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOchildintros = - ({-# LINE 384 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIchildintros - {-# LINE 4541 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOinhmap = - ({-# LINE 194 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIinhmap - {-# LINE 4547 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOmrules = - ({-# LINE 373 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImrules - {-# LINE 4553 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 253 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsInt - {-# LINE 4559 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 41 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptions - {-# LINE 4565 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOruledefs = - ({-# LINE 503 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIruledefs - {-# LINE 4571 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOruleuses = - ({-# LINE 504 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIruleuses - {-# LINE 4577 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOsynmap = - ({-# LINE 195 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIsynmap - {-# LINE 4583 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _hdOterminaldefs = - ({-# LINE 482 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIterminaldefs - {-# LINE 4589 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOallchildvisit = - ({-# LINE 457 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallchildvisit - {-# LINE 4595 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOallintramap = - ({-# LINE 479 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIallintramap - {-# LINE 4601 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOavisitdefs = - ({-# LINE 528 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisitdefs - {-# LINE 4607 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOavisituses = - ({-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIavisituses - {-# LINE 4613 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOchildintros = - ({-# LINE 384 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIchildintros - {-# LINE 4619 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOinhmap = - ({-# LINE 194 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIinhmap - {-# LINE 4625 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOmrules = - ({-# LINE 373 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImrules - {-# LINE 4631 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 253 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsInt - {-# LINE 4637 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 41 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIoptions - {-# LINE 4643 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOruledefs = - ({-# LINE 503 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIruledefs - {-# LINE 4649 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOruleuses = - ({-# LINE 504 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIruleuses - {-# LINE 4655 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOsynmap = - ({-# LINE 195 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIsynmap - {-# LINE 4661 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- copy rule (down) - _tlOterminaldefs = - ({-# LINE 482 "src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIterminaldefs - {-# LINE 4667 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - ( _hdIallvisits,_hdIchildvisit,_hdIintramap,_hdIsem_visit,_hdIt_visits,_hdIusedrules,_hdIvisitdefs,_hdIvisituses) = - hd_ _hdOallchildvisit _hdOallintramap _hdOavisitdefs _hdOavisituses _hdOchildintros _hdOinhmap _hdOmrules _hdOnt _hdOoptions _hdOruledefs _hdOruleuses _hdOsynmap _hdOterminaldefs - ( _tlIallvisits,_tlIchildvisit,_tlIintramap,_tlIsem_visit,_tlIt_visits,_tlIusedrules,_tlIvisitdefs,_tlIvisituses) = - tl_ _tlOallchildvisit _tlOallintramap _tlOavisitdefs _tlOavisituses _tlOchildintros _tlOinhmap _tlOmrules _tlOnt _tlOoptions _tlOruledefs _tlOruleuses _tlOsynmap _tlOterminaldefs - in ( _lhsOallvisits,_lhsOchildvisit,_lhsOintramap,_lhsOsem_visit,_lhsOt_visits,_lhsOusedrules,_lhsOvisitdefs,_lhsOvisituses))) ) -sem_Visits_Nil :: T_Visits -sem_Visits_Nil = - (T_Visits (\ _lhsIallchildvisit - _lhsIallintramap - _lhsIavisitdefs - _lhsIavisituses - _lhsIchildintros - _lhsIinhmap - _lhsImrules - _lhsInt - _lhsIoptions - _lhsIruledefs - _lhsIruleuses - _lhsIsynmap - _lhsIterminaldefs -> - (let _lhsOallvisits :: ([VisitStateState]) - _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) - _lhsOintramap :: (Map.Map StateIdentifier (Set.Set String)) - _lhsOsem_visit :: ( [(StateIdentifier,PP_Doc)] ) - _lhsOt_visits :: PP_Doc - _lhsOusedrules :: (Set.Set Identifier) - _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) - _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 207, column 29) - _lhsOallvisits = - ({-# LINE 207 "src-ag/ExecutionPlan2Hs.ag" #-} - [] - {-# LINE 4701 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 458, column 37) - _lhsOchildvisit = - ({-# LINE 458 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.empty - {-# LINE 4707 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 480, column 34) - _lhsOintramap = - ({-# LINE 480 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.empty - {-# LINE 4713 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 361, column 29) - _lhsOsem_visit = - ({-# LINE 361 "src-ag/ExecutionPlan2Hs.ag" #-} - [] - {-# LINE 4719 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 253, column 54) - _lhsOt_visits = - ({-# LINE 253 "src-ag/ExecutionPlan2Hs.ag" #-} - empty - {-# LINE 4725 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 396, column 56) - _lhsOusedrules = - ({-# LINE 396 "src-ag/ExecutionPlan2Hs.ag" #-} - Set.empty - {-# LINE 4731 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 518, column 36) - _lhsOvisitdefs = - ({-# LINE 518 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.empty - {-# LINE 4737 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - -- use rule "src-ag/ExecutionPlan2Hs.ag"(line 519, column 36) - _lhsOvisituses = - ({-# LINE 519 "src-ag/ExecutionPlan2Hs.ag" #-} - Map.empty - {-# LINE 4743 "src-ag/ExecutionPlan2Hs.hs" #-} - ) - in ( _lhsOallvisits,_lhsOchildvisit,_lhsOintramap,_lhsOsem_visit,_lhsOt_visits,_lhsOusedrules,_lhsOvisitdefs,_lhsOvisituses))) ) diff --git a/dist/build/uuagc/uuagc-tmp/Expression.hs b/dist/build/uuagc/uuagc-tmp/Expression.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/Expression.hs +++ /dev/null @@ -1,17 +0,0 @@ - - --- UUAGC 0.9.39.0.0 (src-ag/Expression.ag) -module Expression where -{-# LINE 2 "src-ag/Expression.ag" #-} - -import UU.Scanner.Position(Pos) -import HsToken -{-# LINE 10 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Expression.hs" #-} --- Expression -------------------------------------------------- -{- - alternatives: - alternative Expression: - child pos : {Pos} - child tks : {[HsToken]} --} -data Expression = Expression (Pos) (([HsToken])) diff --git a/dist/build/uuagc/uuagc-tmp/GenerateCode.hs b/dist/build/uuagc/uuagc-tmp/GenerateCode.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/GenerateCode.hs +++ /dev/null @@ -1,8044 +0,0 @@ - - --- UUAGC 0.9.39.0.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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/GenerateCode.hs" #-} - -{-# LINE 2 "src-ag/CodeSyntax.ag" #-} - -import Patterns -import CommonTypes -import Data.Map(Map) -import Data.Set(Set) -{-# LINE 41 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/GenerateCode.hs" #-} - -{-# LINE 2 "src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 48 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/GenerateCode.hs" #-} - -{-# LINE 2 "src-ag/DeclBlocks.ag" #-} - -import Code (Decl,Expr) -{-# LINE 53 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/GenerateCode.hs" #-} - -{-# LINE 245 "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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/GenerateCode.hs" #-} - -{-# LINE 411 "src-ag/GenerateCode.ag" #-} - -substSelf nt tp = case tp of - NT t tps | t == _SELF -> Haskell (getName nt ++ " " ++ unwords tps) - _ -> tp -{-# LINE 92 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/GenerateCode.hs" #-} - -{-# LINE 534 "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 :: Maybe (Maybe Type) -> Bool -isHigherOrder (Just Nothing) = True -isHigherOrder _ = False - -pickOrigType :: (Identifier, Type, Maybe (Maybe Type)) -> (Identifier, Type, Maybe (Maybe Type)) -pickOrigType (nm, tp, virt@(Just (Just x))) = (nm, x, virt) -pickOrigType x = x -{-# LINE 116 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/GenerateCode.hs" #-} - -{-# LINE 630 "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 130 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/GenerateCode.hs" #-} - -{-# LINE 680 "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 153 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/GenerateCode.hs" #-} - -{-# LINE 758 "src-ag/GenerateCode.ag" #-} - -typeToCodeType :: Maybe NontermIdent -> [String] -> Type -> Code.Type -typeToCodeType mbNt params tp - = case tp of - NT nt tps | nt == _SELF -> NontermType (maybe "Unknown" getName mbNt) params - | otherwise -> NontermType (getName nt) tps - 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 192 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/GenerateCode.hs" #-} - -{-# LINE 883 "src-ag/GenerateCode.ag" #-} - --- for a virtual child that already existed as a child, returns -isFirstOrder :: Maybe (Maybe Type) -> Type -> Maybe Type -isFirstOrder Nothing tp = Just tp -isFirstOrder (Just x) _ = x -{-# LINE 200 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/GenerateCode.hs" #-} - -{-# LINE 903 "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 209 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/GenerateCode.hs" #-} - -{-# LINE 934 "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 255 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 351 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 53, column 17) - _nontsOo_cata = - ({-# LINE 54 "src-ag/GenerateCode.ag" #-} - folds _lhsIoptions - {-# LINE 357 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 53, column 17) - _nontsOo_sem = - ({-# LINE 55 "src-ag/GenerateCode.ag" #-} - semfuns _lhsIoptions - {-# LINE 363 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 53, column 17) - _nontsOo_newtypes = - ({-# LINE 56 "src-ag/GenerateCode.ag" #-} - newtypes _lhsIoptions - {-# LINE 369 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 53, column 17) - _nontsOo_unbox = - ({-# LINE 57 "src-ag/GenerateCode.ag" #-} - unbox _lhsIoptions - {-# LINE 375 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 53, column 17) - _nontsOo_case = - ({-# LINE 58 "src-ag/GenerateCode.ag" #-} - cases _lhsIoptions - {-# LINE 381 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 53, column 17) - _nontsOo_pretty = - ({-# LINE 59 "src-ag/GenerateCode.ag" #-} - attrInfo _lhsIoptions - {-# LINE 387 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 53, column 17) - _nontsOo_rename = - ({-# LINE 60 "src-ag/GenerateCode.ag" #-} - rename _lhsIoptions - {-# LINE 393 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 53, column 17) - _nontsOo_strictwrap = - ({-# LINE 61 "src-ag/GenerateCode.ag" #-} - strictWrap _lhsIoptions - {-# LINE 399 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 53, column 17) - _nontsOo_splitsems = - ({-# LINE 62 "src-ag/GenerateCode.ag" #-} - splitSems _lhsIoptions - {-# LINE 405 "src-ag/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 411 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 53, column 17) - _nontsOprefix = - ({-# LINE 64 "src-ag/GenerateCode.ag" #-} - prefix _lhsIoptions - {-# LINE 417 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 53, column 17) - _nontsOo_traces = - ({-# LINE 65 "src-ag/GenerateCode.ag" #-} - genTraces _lhsIoptions - {-# LINE 423 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 53, column 17) - _nontsOo_costcentre = - ({-# LINE 66 "src-ag/GenerateCode.ag" #-} - genCostCentres _lhsIoptions - {-# LINE 429 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 53, column 17) - _nontsOo_linePragmas = - ({-# LINE 67 "src-ag/GenerateCode.ag" #-} - genLinePragmas _lhsIoptions - {-# LINE 435 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 53, column 17) - _nontsOo_monadic = - ({-# LINE 68 "src-ag/GenerateCode.ag" #-} - monadic _lhsIoptions - {-# LINE 441 "src-ag/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 447 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 76, column 15) - _nontsOallPragmas = - ({-# LINE 76 "src-ag/GenerateCode.ag" #-} - pragmas_ - {-# LINE 453 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 98, column 14) - _nontsOparamMap = - ({-# LINE 98 "src-ag/GenerateCode.ag" #-} - paramMap_ - {-# LINE 459 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 119, column 7) - _nontsOcontextMap = - ({-# LINE 119 "src-ag/GenerateCode.ag" #-} - contextMap_ - {-# LINE 465 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 120, column 7) - _nontsOquantMap = - ({-# LINE 120 "src-ag/GenerateCode.ag" #-} - quantMap_ - {-# LINE 471 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 136, column 7) - _nontsOallNts = - ({-# LINE 136 "src-ag/GenerateCode.ag" #-} - _nontsIgathNts - {-# LINE 477 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 579, column 34) - _aroundMap = - ({-# LINE 579 "src-ag/GenerateCode.ag" #-} - aroundsMap_ - {-# LINE 483 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 595, column 34) - _mergeMap = - ({-# LINE 595 "src-ag/GenerateCode.ag" #-} - mergeMap_ - {-# LINE 489 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 751, column 7) - _unfoldSemDom = - ({-# LINE 751 "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 499 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 852, column 14) - _nontsOwith_sig = - ({-# LINE 852 "src-ag/GenerateCode.ag" #-} - typeSigs _lhsIoptions - {-# LINE 505 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 855, column 15) - _lhsOerrors = - ({-# LINE 855 "src-ag/GenerateCode.ag" #-} - Seq.empty - {-# LINE 511 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 920, column 17) - _lhsOoutput = - ({-# LINE 920 "src-ag/GenerateCode.ag" #-} - Program _nontsIchunks multivisit_ - {-# LINE 517 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 985, column 14) - _nontsOtypeSyns = - ({-# LINE 985 "src-ag/GenerateCode.ag" #-} - typeSyns_ - {-# LINE 523 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 985, column 14) - _nontsOderivings = - ({-# LINE 986 "src-ag/GenerateCode.ag" #-} - derivings_ - {-# LINE 529 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 985, column 14) - _nontsOwrappers = - ({-# LINE 987 "src-ag/GenerateCode.ag" #-} - wrappers_ - {-# LINE 535 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _nontsOaroundMap = - ({-# LINE 572 "src-ag/GenerateCode.ag" #-} - _aroundMap - {-# LINE 541 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _nontsOmergeMap = - ({-# LINE 588 "src-ag/GenerateCode.ag" #-} - _mergeMap - {-# LINE 547 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _nontsOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _options - {-# LINE 553 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _nontsOunfoldSemDom = - ({-# LINE 747 "src-ag/GenerateCode.ag" #-} - _unfoldSemDom - {-# LINE 559 "src-ag/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 282, column 17) - _segOnr = - ({-# LINE 282 "src-ag/GenerateCode.ag" #-} - 0 - {-# LINE 693 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 709, column 18) - _lhsOsemDom = - ({-# LINE 709 "src-ag/GenerateCode.ag" #-} - Comment "semantic domain" : _segIsemDom - {-# LINE 699 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 866, column 52) - _lhsOcomments = - ({-# LINE 866 "src-ag/GenerateCode.ag" #-} - _segIcomments - {-# LINE 705 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 741, column 86) - _lhsOsemDomUnfoldGath = - ({-# LINE 741 "src-ag/GenerateCode.ag" #-} - _segIsemDomUnfoldGath - {-# LINE 711 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 827, column 52) - _lhsOwrapDecls = - ({-# LINE 827 "src-ag/GenerateCode.ag" #-} - _segIwrapDecls - {-# LINE 717 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOinh = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIinh - {-# LINE 723 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOnt = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsInt - {-# LINE 729 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_case - {-# LINE 735 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 741 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 747 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 753 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 759 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 765 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 771 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 777 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 783 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 789 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 795 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_splitsems - {-# LINE 801 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 807 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 813 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 819 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 825 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 831 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 837 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _segOsyn = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIsyn - {-# LINE 843 "src-ag/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 _tup1 : {(Attributes,Attributes,NontermIdent)} - local _tup2 : {(Attributes,Attributes,NontermIdent)} - 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 __tup1 :: ((Attributes,Attributes,NontermIdent)) - _interOinh :: Attributes - _interOsyn :: Attributes - _interOnt :: NontermIdent - __tup2 :: ((Attributes,Attributes,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 - _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) - __tup1 = - ({-# LINE 86 "src-ag/GenerateCode.ag" #-} - (inh_,syn_,nt_) - {-# LINE 1053 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 86, column 26) - (_interOinh,_,_) = - ({-# LINE 86 "src-ag/GenerateCode.ag" #-} - __tup1 - {-# LINE 1059 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 86, column 26) - (_,_interOsyn,_) = - ({-# LINE 86 "src-ag/GenerateCode.ag" #-} - __tup1 - {-# LINE 1065 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 86, column 26) - (_,_,_interOnt) = - ({-# LINE 86 "src-ag/GenerateCode.ag" #-} - __tup1 - {-# LINE 1071 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 87, column 25) - __tup2 = - ({-# LINE 87 "src-ag/GenerateCode.ag" #-} - (inh_,syn_,nt_) - {-# LINE 1077 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 87, column 25) - (_prodsOinh,_,_) = - ({-# LINE 87 "src-ag/GenerateCode.ag" #-} - __tup2 - {-# LINE 1083 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 87, column 25) - (_,_prodsOsyn,_) = - ({-# LINE 87 "src-ag/GenerateCode.ag" #-} - __tup2 - {-# LINE 1089 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 87, column 25) - (_,_,_prodsOnt) = - ({-# LINE 87 "src-ag/GenerateCode.ag" #-} - __tup2 - {-# LINE 1095 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 142, column 7) - _lhsOgathNts = - ({-# LINE 142 "src-ag/GenerateCode.ag" #-} - Set.singleton nt_ - {-# LINE 1101 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 580, column 34) - _aroundMap = - ({-# LINE 580 "src-ag/GenerateCode.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsIaroundMap - {-# LINE 1107 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 596, column 34) - _mergeMap = - ({-# LINE 596 "src-ag/GenerateCode.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsImergeMap - {-# LINE 1113 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 801, column 18) - _semWrapper = - ({-# LINE 801 "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' 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 1142 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 862, column 18) - _comment = - ({-# LINE 862 "src-ag/GenerateCode.ag" #-} - Comment . unlines . map ind $ ( _interIcomments ++ ("alternatives:" : map ind _prodsIcomments) ) - {-# LINE 1148 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 923, column 19) - _lhsOchunks = - ({-# LINE 923 "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 1163 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 990, column 18) - _dataDef = - ({-# LINE 990 "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 1183 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 1022, column 18) - _genCata = - ({-# LINE 1022 "src-ag/GenerateCode.ag" #-} - not (nt_ `Set.member` nocatas _lhsIoptions) - {-# LINE 1189 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 1023, column 18) - _cataFun = - ({-# LINE 1023 "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 1275 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 741, column 86) - _lhsOsemDomUnfoldGath = - ({-# LINE 741 "src-ag/GenerateCode.ag" #-} - _interIsemDomUnfoldGath - {-# LINE 1281 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOallNts = - ({-# LINE 132 "src-ag/GenerateCode.ag" #-} - _lhsIallNts - {-# LINE 1287 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOallPragmas = - ({-# LINE 73 "src-ag/GenerateCode.ag" #-} - _lhsIallPragmas - {-# LINE 1293 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _prodsOaroundMap = - ({-# LINE 575 "src-ag/GenerateCode.ag" #-} - _aroundMap - {-# LINE 1299 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOcontextMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIcontextMap - {-# LINE 1305 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _prodsOmergeMap = - ({-# LINE 591 "src-ag/GenerateCode.ag" #-} - _mergeMap - {-# LINE 1311 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_case - {-# LINE 1317 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 1323 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 1329 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 1335 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 1341 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 1347 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 1353 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 1359 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 1365 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 1371 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 1377 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_splitsems - {-# LINE 1383 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 1389 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 1395 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 1401 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 1407 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 1413 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 1419 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOquantMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIquantMap - {-# LINE 1425 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOunfoldSemDom = - ({-# LINE 747 "src-ag/GenerateCode.ag" #-} - _lhsIunfoldSemDom - {-# LINE 1431 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _prodsOwith_sig = - ({-# LINE 849 "src-ag/GenerateCode.ag" #-} - _lhsIwith_sig - {-# LINE 1437 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_case - {-# LINE 1443 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 1449 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 1455 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 1461 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 1467 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 1473 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 1479 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 1485 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 1491 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 1497 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 1503 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_splitsems - {-# LINE 1509 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 1515 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 1521 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 1527 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 1533 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 1539 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _interOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 1545 "src-ag/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 - ( _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 915, column 49) - _lhsOchunks = - ({-# LINE 915 "src-ag/GenerateCode.ag" #-} - _hdIchunks ++ _tlIchunks - {-# LINE 1743 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 138, column 47) - _lhsOgathNts = - ({-# LINE 138 "src-ag/GenerateCode.ag" #-} - _hdIgathNts `Set.union` _tlIgathNts - {-# LINE 1749 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 741, column 86) - _lhsOsemDomUnfoldGath = - ({-# LINE 741 "src-ag/GenerateCode.ag" #-} - _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath - {-# LINE 1755 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOallNts = - ({-# LINE 132 "src-ag/GenerateCode.ag" #-} - _lhsIallNts - {-# LINE 1761 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOallPragmas = - ({-# LINE 73 "src-ag/GenerateCode.ag" #-} - _lhsIallPragmas - {-# LINE 1767 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOaroundMap = - ({-# LINE 572 "src-ag/GenerateCode.ag" #-} - _lhsIaroundMap - {-# LINE 1773 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOcontextMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIcontextMap - {-# LINE 1779 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOderivings = - ({-# LINE 983 "src-ag/GenerateCode.ag" #-} - _lhsIderivings - {-# LINE 1785 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOmergeMap = - ({-# LINE 588 "src-ag/GenerateCode.ag" #-} - _lhsImergeMap - {-# LINE 1791 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_case - {-# LINE 1797 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 1803 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 1809 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 1815 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 1821 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 1827 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 1833 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 1839 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 1845 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 1851 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 1857 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_splitsems - {-# LINE 1863 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 1869 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 1875 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 1881 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 1887 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 1893 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 1899 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOquantMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIquantMap - {-# LINE 1905 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOtypeSyns = - ({-# LINE 983 "src-ag/GenerateCode.ag" #-} - _lhsItypeSyns - {-# LINE 1911 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOunfoldSemDom = - ({-# LINE 747 "src-ag/GenerateCode.ag" #-} - _lhsIunfoldSemDom - {-# LINE 1917 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOwith_sig = - ({-# LINE 849 "src-ag/GenerateCode.ag" #-} - _lhsIwith_sig - {-# LINE 1923 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOwrappers = - ({-# LINE 983 "src-ag/GenerateCode.ag" #-} - _lhsIwrappers - {-# LINE 1929 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOallNts = - ({-# LINE 132 "src-ag/GenerateCode.ag" #-} - _lhsIallNts - {-# LINE 1935 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOallPragmas = - ({-# LINE 73 "src-ag/GenerateCode.ag" #-} - _lhsIallPragmas - {-# LINE 1941 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOaroundMap = - ({-# LINE 572 "src-ag/GenerateCode.ag" #-} - _lhsIaroundMap - {-# LINE 1947 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOcontextMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIcontextMap - {-# LINE 1953 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOderivings = - ({-# LINE 983 "src-ag/GenerateCode.ag" #-} - _lhsIderivings - {-# LINE 1959 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOmergeMap = - ({-# LINE 588 "src-ag/GenerateCode.ag" #-} - _lhsImergeMap - {-# LINE 1965 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_case - {-# LINE 1971 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 1977 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 1983 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 1989 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 1995 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 2001 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 2007 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 2013 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 2019 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 2025 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 2031 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_splitsems - {-# LINE 2037 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 2043 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 2049 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 2055 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 2061 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 2067 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 2073 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOquantMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIquantMap - {-# LINE 2079 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOtypeSyns = - ({-# LINE 983 "src-ag/GenerateCode.ag" #-} - _lhsItypeSyns - {-# LINE 2085 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOunfoldSemDom = - ({-# LINE 747 "src-ag/GenerateCode.ag" #-} - _lhsIunfoldSemDom - {-# LINE 2091 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOwith_sig = - ({-# LINE 849 "src-ag/GenerateCode.ag" #-} - _lhsIwith_sig - {-# LINE 2097 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOwrappers = - ({-# LINE 983 "src-ag/GenerateCode.ag" #-} - _lhsIwrappers - {-# LINE 2103 "src-ag/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 915, column 49) - _lhsOchunks = - ({-# LINE 915 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 2148 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 138, column 47) - _lhsOgathNts = - ({-# LINE 138 "src-ag/GenerateCode.ag" #-} - Set.empty - {-# LINE 2154 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 741, column 86) - _lhsOsemDomUnfoldGath = - ({-# LINE 741 "src-ag/GenerateCode.ag" #-} - Map.empty - {-# LINE 2160 "src-ag/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 - 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,Maybe (Maybe Type))]} - 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 -> - ( 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)} -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 ) = - (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 - in (Syn_CProduction _lhsOcataAlt _lhsOcomments _lhsOdataAlt _lhsOdecls _lhsOsemNames )) -sem_CProduction_CProduction :: ConstructorIdent -> - T_CVisits -> - ([(Identifier,Type,Maybe (Maybe Type))]) -> - ([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 -> - (let _visitsOcon :: ConstructorIdent - _visitsOterminals :: ([Identifier]) - _visitsOvisitedSet :: (Set Identifier) - _visitsOnr :: Int - _visitsOchildren :: ([(Identifier,Type, Maybe (Maybe Type))]) - _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 - _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 2347 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 93, column 20) - _visitsOterminals = - ({-# LINE 93 "src-ag/GenerateCode.ag" #-} - terminals_ - {-# LINE 2353 "src-ag/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 2359 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 146, column 32) - _visitsOvisitedSet = - ({-# LINE 146 "src-ag/GenerateCode.ag" #-} - Set.empty - {-# LINE 2365 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 278, column 18) - _visitsOnr = - ({-# LINE 278 "src-ag/GenerateCode.ag" #-} - 0 - {-# LINE 2371 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 419, column 18) - _visitsOchildren = - ({-# LINE 419 "src-ag/GenerateCode.ag" #-} - children_ - {-# LINE 2377 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 561, column 7) - _visitsOinstVisitNrs = - ({-# LINE 561 "src-ag/GenerateCode.ag" #-} - _visitsIgatherInstVisitNrs - {-# LINE 2383 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 581, column 34) - _aroundMap = - ({-# LINE 581 "src-ag/GenerateCode.ag" #-} - Map.findWithDefault Set.empty con_ _lhsIaroundMap - {-# LINE 2389 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 597, column 34) - _mergeMap = - ({-# LINE 597 "src-ag/GenerateCode.ag" #-} - Map.findWithDefault Map.empty con_ _lhsImergeMap - {-# LINE 2395 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 877, column 18) - _firstOrderChildren = - ({-# LINE 877 "src-ag/GenerateCode.ag" #-} - [ (nm,fromJust mb,virt) | (nm,tp,virt) <- children_, let mb = isFirstOrder virt tp, isJust mb ] - {-# LINE 2401 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 878, column 18) - _lhsOcomments = - ({-# LINE 878 "src-ag/GenerateCode.ag" #-} - ("alternative " ++ getName con_ ++ ":") - : map ind ( map (\(x,y,_) -> makeLocalComment 14 "child" x (Just y)) _firstOrderChildren - ++ _visitsIcomments - ) - {-# LINE 2410 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 1014, column 17) - _params = - ({-# LINE 1014 "src-ag/GenerateCode.ag" #-} - map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap - {-# LINE 2416 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 1015, column 17) - _lhsOdataAlt = - ({-# LINE 1015 "src-ag/GenerateCode.ag" #-} - DataAlt (conname _lhsIo_rename _lhsInt con_) (map (\(_,t,_) -> typeToCodeType (Just _lhsInt) _params t) _firstOrderChildren ) - {-# LINE 2422 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 1115, column 17) - _lhsOcataAlt = - ({-# LINE 1115 "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 _,_) = let tp' = maybe tp id (deforestedNt tp) - in App (cataname _lhsIprefix tp') - [SimpleExpr (locname nm)] - argument (nm, _,_) = SimpleExpr (locname nm) - in Decl lhs rhs Set.empty Set.empty - {-# LINE 2437 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 916, column 44) - _lhsOdecls = - ({-# LINE 916 "src-ag/GenerateCode.ag" #-} - _visitsIdecls - {-# LINE 2443 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 1131, column 61) - _lhsOsemNames = - ({-# LINE 1131 "src-ag/GenerateCode.ag" #-} - _visitsIsemNames - {-# LINE 2449 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOallNts = - ({-# LINE 132 "src-ag/GenerateCode.ag" #-} - _lhsIallNts - {-# LINE 2455 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOallPragmas = - ({-# LINE 73 "src-ag/GenerateCode.ag" #-} - _lhsIallPragmas - {-# LINE 2461 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _visitsOaroundMap = - ({-# LINE 577 "src-ag/GenerateCode.ag" #-} - _aroundMap - {-# LINE 2467 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOcontextMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIcontextMap - {-# LINE 2473 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOinh = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIinh - {-# LINE 2479 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _visitsOmergeMap = - ({-# LINE 593 "src-ag/GenerateCode.ag" #-} - _mergeMap - {-# LINE 2485 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOnt = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsInt - {-# LINE 2491 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_case - {-# LINE 2497 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 2503 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 2509 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 2515 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 2521 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 2527 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 2533 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 2539 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 2545 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 2551 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 2557 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_splitsems - {-# LINE 2563 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 2569 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 2575 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 2581 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 2587 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _visitsOparamInstMap = - ({-# LINE 101 "src-ag/GenerateCode.ag" #-} - _paramInstMap - {-# LINE 2593 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 2599 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 2605 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOquantMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIquantMap - {-# LINE 2611 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOsyn = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIsyn - {-# LINE 2617 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOunfoldSemDom = - ({-# LINE 747 "src-ag/GenerateCode.ag" #-} - _lhsIunfoldSemDom - {-# LINE 2623 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _visitsOwith_sig = - ({-# LINE 849 "src-ag/GenerateCode.ag" #-} - _lhsIwith_sig - {-# LINE 2629 "src-ag/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 - 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 - 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 -> - ( 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)} -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 ) = - (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 - 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 -> - (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 - _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 - _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 1010, column 17) - _lhsOdataAlts = - ({-# LINE 1010 "src-ag/GenerateCode.ag" #-} - _hdIdataAlt : _tlIdataAlts - {-# LINE 2833 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 1111, column 10) - _lhsOcataAlts = - ({-# LINE 1111 "src-ag/GenerateCode.ag" #-} - _hdIcataAlt : _tlIcataAlts - {-# LINE 2839 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 866, column 52) - _lhsOcomments = - ({-# LINE 866 "src-ag/GenerateCode.ag" #-} - _hdIcomments ++ _tlIcomments - {-# LINE 2845 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 916, column 44) - _lhsOdecls = - ({-# LINE 916 "src-ag/GenerateCode.ag" #-} - _hdIdecls ++ _tlIdecls - {-# LINE 2851 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 1131, column 61) - _lhsOsemNames = - ({-# LINE 1131 "src-ag/GenerateCode.ag" #-} - _hdIsemNames ++ _tlIsemNames - {-# LINE 2857 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOallNts = - ({-# LINE 132 "src-ag/GenerateCode.ag" #-} - _lhsIallNts - {-# LINE 2863 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOallPragmas = - ({-# LINE 73 "src-ag/GenerateCode.ag" #-} - _lhsIallPragmas - {-# LINE 2869 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOaroundMap = - ({-# LINE 575 "src-ag/GenerateCode.ag" #-} - _lhsIaroundMap - {-# LINE 2875 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOcontextMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIcontextMap - {-# LINE 2881 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOinh = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIinh - {-# LINE 2887 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOmergeMap = - ({-# LINE 591 "src-ag/GenerateCode.ag" #-} - _lhsImergeMap - {-# LINE 2893 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsInt - {-# LINE 2899 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_case - {-# LINE 2905 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 2911 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 2917 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 2923 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 2929 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 2935 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 2941 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 2947 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 2953 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 2959 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 2965 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_splitsems - {-# LINE 2971 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 2977 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 2983 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 2989 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 2995 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 3001 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 3007 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOquantMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIquantMap - {-# LINE 3013 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOsyn = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIsyn - {-# LINE 3019 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOunfoldSemDom = - ({-# LINE 747 "src-ag/GenerateCode.ag" #-} - _lhsIunfoldSemDom - {-# LINE 3025 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOwith_sig = - ({-# LINE 849 "src-ag/GenerateCode.ag" #-} - _lhsIwith_sig - {-# LINE 3031 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOallNts = - ({-# LINE 132 "src-ag/GenerateCode.ag" #-} - _lhsIallNts - {-# LINE 3037 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOallPragmas = - ({-# LINE 73 "src-ag/GenerateCode.ag" #-} - _lhsIallPragmas - {-# LINE 3043 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOaroundMap = - ({-# LINE 575 "src-ag/GenerateCode.ag" #-} - _lhsIaroundMap - {-# LINE 3049 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOcontextMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIcontextMap - {-# LINE 3055 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOinh = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIinh - {-# LINE 3061 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOmergeMap = - ({-# LINE 591 "src-ag/GenerateCode.ag" #-} - _lhsImergeMap - {-# LINE 3067 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsInt - {-# LINE 3073 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_case - {-# LINE 3079 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 3085 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 3091 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 3097 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 3103 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 3109 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 3115 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 3121 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 3127 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 3133 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 3139 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_splitsems - {-# LINE 3145 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 3151 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 3157 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 3163 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 3169 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 3175 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 3181 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOquantMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIquantMap - {-# LINE 3187 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOsyn = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIsyn - {-# LINE 3193 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOunfoldSemDom = - ({-# LINE 747 "src-ag/GenerateCode.ag" #-} - _lhsIunfoldSemDom - {-# LINE 3199 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOwith_sig = - ({-# LINE 849 "src-ag/GenerateCode.ag" #-} - _lhsIwith_sig - {-# LINE 3205 "src-ag/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 - ( _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 - 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 -> - (let _lhsOdataAlts :: DataAlts - _lhsOcataAlts :: Decls - _lhsOcomments :: ([String]) - _lhsOdecls :: Decls - _lhsOsemNames :: ([String]) - -- "src-ag/GenerateCode.ag"(line 1011, column 17) - _lhsOdataAlts = - ({-# LINE 1011 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 3252 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 1112, column 10) - _lhsOcataAlts = - ({-# LINE 1112 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 3258 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 866, column 52) - _lhsOcomments = - ({-# LINE 866 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 3264 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 916, column 44) - _lhsOdecls = - ({-# LINE 916 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 3270 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 1131, column 61) - _lhsOsemNames = - ({-# LINE 1131 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 3276 "src-ag/GenerateCode.hs" #-} - ) - in ( _lhsOcataAlts,_lhsOcomments,_lhsOdataAlts,_lhsOdecls,_lhsOsemNames))) ) --- CRule ------------------------------------------------------- -{- - visit 0: - inherited attributes: - allNts : Set NontermIdent - aroundMap : Set Identifier - children : [(Identifier,Type,Maybe (Maybe Type))] - 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 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 : _ - 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 : _ - local _tup3 : {([Type],Bool)} --} --- cata -sem_CRule :: CRule -> - T_CRule -sem_CRule (CChildVisit _name _nt _nr _inh _syn _isLast ) = - (sem_CRule_CChildVisit _name _nt _nr _inh _syn _isLast ) -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 ) --- semantic domain -newtype T_CRule = T_CRule ((Set NontermIdent) -> - (Set Identifier) -> - ([(Identifier,Type,Maybe (Maybe Type))]) -> - 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,Maybe (Maybe Type))])),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_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 3494 "src-ag/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 3500 "src-ag/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 3508 "src-ag/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,mb) : r) - | nm == n = isJust mb - | 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 3549 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 325, column 7) - _isSuperfluousHigherOrderIntra = - ({-# LINE 325 "src-ag/GenerateCode.ag" #-} - _lhsInr <= Map.findWithDefault (-1) name_ _lhsIinstVisitNrs - {-# LINE 3555 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 339, column 8) - _names = - ({-# LINE 339 "src-ag/GenerateCode.ag" #-} - if _isSuperfluousHigherOrderIntra - then [] - else [funname name_ (nr_+1)] - {-# LINE 3563 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 343, column 8) - _lhsOexprs = - ({-# LINE 343 "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 3572 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 355, column 7) - _lhsOusedVars = - ({-# LINE 355 "src-ag/GenerateCode.ag" #-} - Set.fromList _names - {-# LINE 3578 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 394, column 19) - _mkTp = - ({-# LINE 394 "src-ag/GenerateCode.ag" #-} - _evalTp . typeToCodeType (Just nt_) _orgParams - {-# LINE 3584 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 395, column 19) - _definedTps = - ({-# LINE 395 "src-ag/GenerateCode.ag" #-} - [ TSig (attrname True name_ a) (_mkTp tp) | (a,tp) <- Map.toList syn_ ] - {-# LINE 3590 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 396, column 19) - _nextTp = - ({-# LINE 396 "src-ag/GenerateCode.ag" #-} - typeName nt_ (nr_+1) - {-# LINE 3596 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 397, column 19) - _lhsOtSigs = - ({-# LINE 397 "src-ag/GenerateCode.ag" #-} - (if isLast_ then id else (TSig (funname name_ (nr_+1)) (TypeApp (SimpleType _nextTp) (map SimpleType _instParams )) :)) _definedTps - {-# LINE 3602 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 399, column 19) - _orgParams = - ({-# LINE 399 "src-ag/GenerateCode.ag" #-} - map getName $ Map.findWithDefault [] nt_ _lhsIparamMap - {-# LINE 3608 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 400, column 19) - _instParams = - ({-# LINE 400 "src-ag/GenerateCode.ag" #-} - snd $ Map.findWithDefault (nt_,[]) name_ _lhsIparamInstMap - {-# LINE 3614 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 401, column 19) - _replParamMap = - ({-# LINE 401 "src-ag/GenerateCode.ag" #-} - Map.fromList (zip _orgParams _instParams ) - {-# LINE 3620 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 402, column 19) - _replace = - ({-# LINE 402 "src-ag/GenerateCode.ag" #-} - \k -> Map.findWithDefault k k _replParamMap - {-# LINE 3626 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 403, column 19) - _evalTp = - ({-# LINE 403 "src-ag/GenerateCode.ag" #-} - if null _orgParams then id else evalType _replace - {-# LINE 3632 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 426, column 19) - _lhsOtps = - ({-# LINE 426 "src-ag/GenerateCode.ag" #-} - if _isSuperfluousHigherOrderIntra - then [] - else [NT (ntOfVisit nt_ (nr_+1)) _instParams ] - {-# LINE 3640 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 615, column 7) - _lhsOdeclsAbove = - ({-# LINE 615 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 3646 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 628, column 7) - _lhsObldBlocksFun = - ({-# LINE 628 "src-ag/GenerateCode.ag" #-} - DeclBlock _lhsIdeclsAbove (head _decls ) - {-# LINE 3652 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 423, column 39) - _lhsOallTpsFound = - ({-# LINE 423 "src-ag/GenerateCode.ag" #-} - True - {-# LINE 3658 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 866, column 52) - _lhsOcomments = - ({-# LINE 866 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 3664 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 155, column 34) - _lhsOdecls = - ({-# LINE 155 "src-ag/GenerateCode.ag" #-} - _decls - {-# LINE 3670 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 259, column 55) - _lhsOdefinedInsts = - ({-# LINE 259 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 3676 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _lhsOvisitedSet = - ({-# LINE 145 "src-ag/GenerateCode.ag" #-} - _visitedSet - {-# LINE 3682 "src-ag/GenerateCode.hs" #-} - ) - in ( _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]) - __tup3 :: (([Type],Bool)) - _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)) | (n, NT t _, mb) <- _lhsIchildren ] - {-# LINE 3756 "src-ag/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 3764 "src-ag/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) = fromJust $ inst `lookup` _instTypes - in unwrapSem _lhsIo_newtypes (maybe nm id (deforestedNt nm)) - $ case mb of - Just (Just tp') -> App instLocFieldName [SimpleExpr $ fieldname inst] - _ -> - case nm `Set.member` _lhsIallNts of - True -> App (cataname _lhsIprefix nm) - [SimpleExpr instLocFieldName] - False -> SimpleExpr instLocFieldName - ) - (Set.singleton instSemFieldName) - (Set.singleton instLocFieldName) - | inst <- _definedInsts - , let instLocFieldName = attrname True _INST inst - instSemFieldName = attrname False _INST' inst - ] - {-# LINE 3786 "src-ag/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 3794 "src-ag/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 3800 "src-ag/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 3808 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 186, column 12) - _costCentreDescr = - ({-# LINE 186 "src-ag/GenerateCode.ag" #-} - show nt_ ++ ":" ++ show con_ ++ ":" ++ _patDescr - {-# LINE 3814 "src-ag/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 3822 "src-ag/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 3834 "src-ag/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 3845 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 264, column 12) - _definedInsts = - ({-# LINE 264 "src-ag/GenerateCode.ag" #-} - if isIn_ then [] else _patternIdefinedInsts - {-# LINE 3851 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 334, column 12) - _rulename = - ({-# LINE 334 "src-ag/GenerateCode.ag" #-} - if field_ == _LOC && name_ `elem` _lhsIterminals - then funname name_ 0 - else attrname isIn_ field_ name_ - {-# LINE 3859 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 337, column 12) - _lhsOexprs = - ({-# LINE 337 "src-ag/GenerateCode.ag" #-} - [SimpleExpr _rulename ] - {-# LINE 3865 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 353, column 7) - _lhsOusedVars = - ({-# LINE 353 "src-ag/GenerateCode.ag" #-} - Set.singleton _rulename - {-# LINE 3871 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 363, column 19) - _mkTp = - ({-# LINE 363 "src-ag/GenerateCode.ag" #-} - typeToCodeType (Just _lhsInt) _orgParams - {-# LINE 3877 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 364, column 19) - _lhsOtSigs = - ({-# LINE 364 "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 tp'' = case tp' of - NT n params -> NT (Ident ("T_" ++ show n) (getPos n)) params - _ -> tp' - tp2 = _evalTp field $ _mkTp tp'' - in Arr tp2 tp1 - Nothing -> tp1 - findOrigType nm [] = Nothing - findOrigType nm ((n,_,mb) : r) - | nm == n = case mb of - Just (Just orig) -> Just orig - _ -> Nothing - | otherwise = findOrigType nm r - ] - {-# LINE 3899 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 382, column 19) - _orgParams = - ({-# LINE 382 "src-ag/GenerateCode.ag" #-} - map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap - {-# LINE 3905 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 383, column 19) - _evalTp = - ({-# LINE 383 "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 3919 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 425, column 23) - __tup3 = - ({-# LINE 425 "src-ag/GenerateCode.ag" #-} - maybe ([],False) (\tp -> ([substSelf (fromJust childnt_) tp],True)) tp_ - {-# LINE 3925 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 425, column 23) - (_lhsOtps,_) = - ({-# LINE 425 "src-ag/GenerateCode.ag" #-} - __tup3 - {-# LINE 3931 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 425, column 23) - (_,_lhsOallTpsFound) = - ({-# LINE 425 "src-ag/GenerateCode.ag" #-} - __tup3 - {-# LINE 3937 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 613, column 7) - _lhsOdeclsAbove = - ({-# LINE 613 "src-ag/GenerateCode.ag" #-} - _lhsIdeclsAbove ++ _decls - {-# LINE 3943 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 626, column 7) - _lhsObldBlocksFun = - ({-# LINE 626 "src-ag/GenerateCode.ag" #-} - id - {-# LINE 3949 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 900, column 18) - _lhsOcomments = - ({-# LINE 900 "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 3956 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 155, column 34) - _lhsOdecls = - ({-# LINE 155 "src-ag/GenerateCode.ag" #-} - _decls - {-# LINE 3962 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 259, column 55) - _lhsOdefinedInsts = - ({-# LINE 259 "src-ag/GenerateCode.ag" #-} - _definedInsts - {-# LINE 3968 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (chain) - _lhsOvisitedSet = - ({-# LINE 145 "src-ag/GenerateCode.ag" #-} - _lhsIvisitedSet - {-# LINE 3974 "src-ag/GenerateCode.hs" #-} - ) - ( _patternIcopy,_patternIdefinedInsts,_patternIpatternAttributes) = - pattern_ - 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 712, column 15) - _altSemForm = - ({-# LINE 712 "src-ag/GenerateCode.ag" #-} - breadthFirst _lhsIoptions - {-# LINE 4105 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 713, column 15) - _tp = - ({-# LINE 713 "src-ag/GenerateCode.ag" #-} - if _altSemForm - then TypeApp (SimpleType "Child") [SimpleType "EvalInfo", _indexExpr ] - else foldr Arr _synTps _inhTps - {-# LINE 4113 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 716, column 15) - _inhTps = - ({-# LINE 716 "src-ag/GenerateCode.ag" #-} - [typeToCodeType (Just _lhsInt) _params tp | tp <- Map.elems inh_] - {-# LINE 4119 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 717, column 15) - _inhTup = - ({-# LINE 717 "src-ag/GenerateCode.ag" #-} - mkTupleType _lhsIo_unbox (null _inhTps ) _inhTps - {-# LINE 4125 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 718, column 15) - _synTps = - ({-# LINE 718 "src-ag/GenerateCode.ag" #-} - mkTupleType _lhsIo_unbox (null _inhTps ) ([typeToCodeType (Just _lhsInt) _params tp | tp <- Map.elems syn_] ++ _continuation ) - {-# LINE 4131 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 719, column 15) - _curTypeName = - ({-# LINE 719 "src-ag/GenerateCode.ag" #-} - typeName _lhsInt _lhsInr - {-# LINE 4137 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 720, column 15) - _nextTypeName = - ({-# LINE 720 "src-ag/GenerateCode.ag" #-} - typeName _lhsInt (_lhsInr + 1) - {-# LINE 4143 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 721, column 15) - _indexName = - ({-# LINE 721 "src-ag/GenerateCode.ag" #-} - "I_" ++ _curTypeName - {-# LINE 4149 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 722, column 15) - _dataIndex = - ({-# LINE 722 "src-ag/GenerateCode.ag" #-} - Code.Data _indexName _params [DataAlt _indexName []] False [] - {-# LINE 4155 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 723, column 15) - _indexExpr = - ({-# LINE 723 "src-ag/GenerateCode.ag" #-} - TypeApp (SimpleType _indexName ) (map (SimpleType . ('@':)) _params ) - {-# LINE 4161 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 724, column 15) - _indexStr = - ({-# LINE 724 "src-ag/GenerateCode.ag" #-} - "(" ++ _indexName ++ concatMap (\p -> " " ++ p) _params ++ ")" - {-# LINE 4167 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 725, column 15) - _inhInstance = - ({-# LINE 725 "src-ag/GenerateCode.ag" #-} - Code.Data "instance Inh" [_indexStr ] [DataAlt (typeName _lhsInt _lhsInr ++ "_Inh") [_inhTup ] ] False [] - {-# LINE 4173 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 726, column 15) - _synInstance = - ({-# LINE 726 "src-ag/GenerateCode.ag" #-} - Code.Data "instance Syn" [_indexStr ] [DataAlt (typeName _lhsInt _lhsInr ++ "_Syn") [_synTps ] ] False [] - {-# LINE 4179 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 727, column 15) - _continuation = - ({-# LINE 727 "src-ag/GenerateCode.ag" #-} - if _lhsIisLast - then [] - else [TypeApp (SimpleType _nextTypeName ) (map (SimpleType . ('@':)) _params )] - {-# LINE 4187 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 730, column 15) - _params = - ({-# LINE 730 "src-ag/GenerateCode.ag" #-} - map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap - {-# LINE 4193 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 731, column 15) - _lhsOsemDom = - ({-# LINE 731 "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 4207 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 745, column 7) - _lhsOsemDomUnfoldGath = - ({-# LINE 745 "src-ag/GenerateCode.ag" #-} - Map.singleton (_lhsInt, _lhsInr) (_params , _tp ) - {-# LINE 4213 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 829, column 15) - _lhsOwrapDecls = - ({-# LINE 829 "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 4228 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 871, column 18) - _lhsOcomments = - ({-# LINE 871 "src-ag/GenerateCode.ag" #-} - let body = map ind (showsSegment (CSegment inh_ syn_)) - in if null body - then [] - else ("visit " ++ show _lhsInr ++ ":") : body - {-# LINE 4237 "src-ag/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 284, column 11) - _tlOnr = - ({-# LINE 284 "src-ag/GenerateCode.ag" #-} - _lhsInr + 1 - {-# LINE 4404 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 297, column 12) - _lhsOisNil = - ({-# LINE 297 "src-ag/GenerateCode.ag" #-} - False - {-# LINE 4410 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 298, column 12) - _hdOisLast = - ({-# LINE 298 "src-ag/GenerateCode.ag" #-} - _tlIisNil - {-# LINE 4416 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 866, column 52) - _lhsOcomments = - ({-# LINE 866 "src-ag/GenerateCode.ag" #-} - _hdIcomments ++ _tlIcomments - {-# LINE 4422 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 707, column 50) - _lhsOsemDom = - ({-# LINE 707 "src-ag/GenerateCode.ag" #-} - _hdIsemDom ++ _tlIsemDom - {-# LINE 4428 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 741, column 86) - _lhsOsemDomUnfoldGath = - ({-# LINE 741 "src-ag/GenerateCode.ag" #-} - _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath - {-# LINE 4434 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 827, column 52) - _lhsOwrapDecls = - ({-# LINE 827 "src-ag/GenerateCode.ag" #-} - _hdIwrapDecls ++ _tlIwrapDecls - {-# LINE 4440 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOinh = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIinh - {-# LINE 4446 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOnr = - ({-# LINE 276 "src-ag/GenerateCode.ag" #-} - _lhsInr - {-# LINE 4452 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsInt - {-# LINE 4458 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_case - {-# LINE 4464 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 4470 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 4476 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 4482 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 4488 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 4494 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 4500 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 4506 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 4512 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 4518 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 4524 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_splitsems - {-# LINE 4530 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 4536 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 4542 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 4548 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 4554 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 4560 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 4566 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOsyn = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIsyn - {-# LINE 4572 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOinh = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIinh - {-# LINE 4578 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsInt - {-# LINE 4584 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_case - {-# LINE 4590 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 4596 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 4602 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 4608 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 4614 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 4620 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 4626 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 4632 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 4638 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 4644 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 4650 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_splitsems - {-# LINE 4656 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 4662 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 4668 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 4674 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 4680 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 4686 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 4692 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOsyn = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIsyn - {-# LINE 4698 "src-ag/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 299, column 10) - _lhsOisNil = - ({-# LINE 299 "src-ag/GenerateCode.ag" #-} - True - {-# LINE 4738 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 866, column 52) - _lhsOcomments = - ({-# LINE 866 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 4744 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 707, column 50) - _lhsOsemDom = - ({-# LINE 707 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 4750 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 741, column 86) - _lhsOsemDomUnfoldGath = - ({-# LINE 741 "src-ag/GenerateCode.ag" #-} - Map.empty - {-# LINE 4756 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 827, column 52) - _lhsOwrapDecls = - ({-# LINE 827 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 4762 "src-ag/GenerateCode.hs" #-} - ) - in ( _lhsOcomments,_lhsOisNil,_lhsOsemDom,_lhsOsemDomUnfoldGath,_lhsOwrapDecls))) ) --- CVisit ------------------------------------------------------ -{- - visit 0: - inherited attributes: - allNts : Set NontermIdent - allPragmas : PragmaMap - aroundMap : Set Identifier - children : [(Identifier,Type, Maybe (Maybe Type))] - 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 - 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 _tup4 : _ - local higherOrderChildren : _ - local firstOrderChildren : _ - local firstOrderOrig : _ - local funcname : _ - local nextVisitName : _ - local nextVisitDecl : _ - local decls : _ - local lastExprVars : _ - local _tup5 : _ - 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, Maybe (Maybe Type))]) -> - 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 -> - ( ([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, Maybe (Maybe Type))])),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)} -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 ) = - (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 - 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 -> - (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,Maybe (Maybe Type))]) - _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,Maybe (Maybe Type))]) - _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 308, column 13) - _lhsOintra = - ({-# LINE 308 "src-ag/GenerateCode.ag" #-} - _intraIexprs - {-# LINE 5053 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 309, column 13) - _lhsOintraVars = - ({-# LINE 309 "src-ag/GenerateCode.ag" #-} - _intraIusedVars - {-# LINE 5059 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 448, column 13) - __tup4 = - ({-# LINE 448 "src-ag/GenerateCode.ag" #-} - partition (\(_,_,virt) -> isHigherOrder virt) _lhsIchildren - {-# LINE 5065 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 448, column 13) - (_higherOrderChildren,_) = - ({-# LINE 448 "src-ag/GenerateCode.ag" #-} - __tup4 - {-# LINE 5071 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 448, column 13) - (_,_firstOrderChildren) = - ({-# LINE 448 "src-ag/GenerateCode.ag" #-} - __tup4 - {-# LINE 5077 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 449, column 13) - _firstOrderOrig = - ({-# LINE 449 "src-ag/GenerateCode.ag" #-} - map pickOrigType _firstOrderChildren - {-# LINE 5083 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 450, column 13) - _funcname = - ({-# LINE 450 "src-ag/GenerateCode.ag" #-} - seqSemname _lhsIprefix _lhsInt _lhsIcon _lhsInr - {-# LINE 5089 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 451, column 13) - _nextVisitName = - ({-# LINE 451 "src-ag/GenerateCode.ag" #-} - if _lhsIisLast then [] else [visitname _lhsIprefix _lhsInt (_lhsInr+1)] - {-# LINE 5095 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 452, column 13) - _nextVisitDecl = - ({-# LINE 452 "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 5106 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 459, column 13) - _decls = - ({-# LINE 459 "src-ag/GenerateCode.ag" #-} - _typeSigs ++ _vssIdecls ++ _nextVisitDecl - {-# LINE 5112 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 460, column 13) - _vssOlastExpr = - ({-# LINE 460 "src-ag/GenerateCode.ag" #-} - mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_) $ map (SimpleExpr . lhsname False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName - {-# LINE 5118 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 461, column 13) - _intraOlastExpr = - ({-# LINE 461 "src-ag/GenerateCode.ag" #-} - error "lastExpr: not used here" - {-# LINE 5124 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 462, column 13) - _lastExprVars = - ({-# LINE 462 "src-ag/GenerateCode.ag" #-} - map (lhsname False) (Map.keys syn_) ++ _nextVisitName - {-# LINE 5130 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 463, column 13) - __tup5 = - ({-# LINE 463 "src-ag/GenerateCode.ag" #-} - mkPartitionedFunction _funcname _o_case _nextVisitDecl _lastExprVars _vssIblockDecls - {-# LINE 5136 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 463, column 13) - (_blockFunDecls,_) = - ({-# LINE 463 "src-ag/GenerateCode.ag" #-} - __tup5 - {-# LINE 5142 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 463, column 13) - (_,_blockFirstFunCall) = - ({-# LINE 463 "src-ag/GenerateCode.ag" #-} - __tup5 - {-# LINE 5148 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 465, column 13) - _costCentreDescr = - ({-# LINE 465 "src-ag/GenerateCode.ag" #-} - "b" ++ ":" ++ show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show _lhsInr - {-# LINE 5154 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 466, column 13) - _addCostCentre = - ({-# LINE 466 "src-ag/GenerateCode.ag" #-} - \v -> if _lhsIo_costcentre - then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v - else v - {-# LINE 5162 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 470, column 13) - _params = - ({-# LINE 470 "src-ag/GenerateCode.ag" #-} - map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap - {-# LINE 5168 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 471, column 13) - _semFun = - ({-# LINE 471 "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 tp) - mbEvalTp | null _params = const Nothing - | otherwise = Just . idEvalType - rhs = wrap - . mkSemFun _lhsInt _lhsInr [mkLambdaArg (lhsname True nm) (mbEvalTp $ typeToCodeType (Just _lhsInt) _params 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 5199 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 502, column 13) - _tsig = - ({-# LINE 502 "src-ag/GenerateCode.ag" #-} - TSig _funcname _semType - {-# LINE 5205 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 503, column 13) - _semType = - ({-# LINE 503 "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 5219 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 514, column 13) - _lhsOdecls = - ({-# LINE 514 "src-ag/GenerateCode.ag" #-} - ( if _lhsIwith_sig - then [_tsig, _semFun] - else [_semFun] - ) ++ - ( if ordered_ && _o_splitsems - then _blockFunDecls - else [] - ) - {-# LINE 5232 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 522, column 13) - _typeSigs = - ({-# LINE 522 "src-ag/GenerateCode.ag" #-} - if _lhsIo_sig && not _o_case - then _vssItSigs - else [] - {-# LINE 5240 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 525, column 13) - _o_do = - ({-# LINE 525 "src-ag/GenerateCode.ag" #-} - ordered_ && _lhsIo_monadic - {-# LINE 5246 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 526, column 13) - _o_case = - ({-# LINE 526 "src-ag/GenerateCode.ag" #-} - not _o_do && _lhsIo_case && ordered_ && not (hasPragma _lhsIallPragmas _lhsInt _lhsIcon _NOCASE) - {-# LINE 5252 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 527, column 13) - _declsType = - ({-# LINE 527 "src-ag/GenerateCode.ag" #-} - if _o_do - then DeclsDo - else if _o_case - then DeclsCase - else DeclsLet - {-# LINE 5262 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 532, column 13) - _o_splitsems = - ({-# LINE 532 "src-ag/GenerateCode.ag" #-} - ordered_ && _lhsIo_splitsems - {-# LINE 5268 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 565, column 7) - _lhsOgatherInstVisitNrs = - ({-# LINE 565 "src-ag/GenerateCode.ag" #-} - Map.fromList [(i,_lhsInr) | i <- _vssIdefinedInsts] - {-# LINE 5274 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 608, column 7) - _vssOdeclsAbove = - ({-# LINE 608 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 5280 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 609, column 7) - _intraOdeclsAbove = - ({-# LINE 609 "src-ag/GenerateCode.ag" #-} - error "declsAbove: not used here" - {-# LINE 5286 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 891, column 18) - _lhsOcomments = - ({-# LINE 891 "src-ag/GenerateCode.ag" #-} - let body = map ind (_vssIcomments ++ _intraIcomments) - in if null body - then [] - else ("visit " ++ show _lhsInr ++ ":") : body - {-# LINE 5295 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 895, column 18) - _vssOwhat = - ({-# LINE 895 "src-ag/GenerateCode.ag" #-} - "local" - {-# LINE 5301 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 896, column 18) - _intraOwhat = - ({-# LINE 896 "src-ag/GenerateCode.ag" #-} - "intra" - {-# LINE 5307 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 1141, column 7) - _lhsOsemNames = - ({-# LINE 1141 "src-ag/GenerateCode.ag" #-} - [_funcname ] - {-# LINE 5313 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (up) - _lhsOvisitedSet = - ({-# LINE 145 "src-ag/GenerateCode.ag" #-} - _intraIvisitedSet - {-# LINE 5319 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOallNts = - ({-# LINE 132 "src-ag/GenerateCode.ag" #-} - _lhsIallNts - {-# LINE 5325 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOaroundMap = - ({-# LINE 577 "src-ag/GenerateCode.ag" #-} - _lhsIaroundMap - {-# LINE 5331 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOchildren = - ({-# LINE 257 "src-ag/GenerateCode.ag" #-} - _lhsIchildren - {-# LINE 5337 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOcon = - ({-# LINE 89 "src-ag/GenerateCode.ag" #-} - _lhsIcon - {-# LINE 5343 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOinh = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIinh - {-# LINE 5349 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOinstVisitNrs = - ({-# LINE 557 "src-ag/GenerateCode.ag" #-} - _lhsIinstVisitNrs - {-# LINE 5355 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOmergeMap = - ({-# LINE 593 "src-ag/GenerateCode.ag" #-} - _lhsImergeMap - {-# LINE 5361 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOnr = - ({-# LINE 276 "src-ag/GenerateCode.ag" #-} - _lhsInr - {-# LINE 5367 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOnt = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsInt - {-# LINE 5373 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _vssOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _o_case - {-# LINE 5379 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 5385 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 5391 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 5397 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 5403 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 5409 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 5415 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 5421 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 5427 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 5433 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 5439 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _vssOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _o_splitsems - {-# LINE 5445 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 5451 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 5457 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 5463 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 5469 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOparamInstMap = - ({-# LINE 101 "src-ag/GenerateCode.ag" #-} - _lhsIparamInstMap - {-# LINE 5475 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 5481 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 5487 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOsyn = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIsyn - {-# LINE 5493 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOterminals = - ({-# LINE 90 "src-ag/GenerateCode.ag" #-} - _lhsIterminals - {-# LINE 5499 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOunfoldSemDom = - ({-# LINE 747 "src-ag/GenerateCode.ag" #-} - _lhsIunfoldSemDom - {-# LINE 5505 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _vssOvisitedSet = - ({-# LINE 145 "src-ag/GenerateCode.ag" #-} - _lhsIvisitedSet - {-# LINE 5511 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOallNts = - ({-# LINE 132 "src-ag/GenerateCode.ag" #-} - _lhsIallNts - {-# LINE 5517 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOaroundMap = - ({-# LINE 577 "src-ag/GenerateCode.ag" #-} - _lhsIaroundMap - {-# LINE 5523 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOchildren = - ({-# LINE 257 "src-ag/GenerateCode.ag" #-} - _lhsIchildren - {-# LINE 5529 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOcon = - ({-# LINE 89 "src-ag/GenerateCode.ag" #-} - _lhsIcon - {-# LINE 5535 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOinh = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIinh - {-# LINE 5541 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOinstVisitNrs = - ({-# LINE 557 "src-ag/GenerateCode.ag" #-} - _lhsIinstVisitNrs - {-# LINE 5547 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOmergeMap = - ({-# LINE 593 "src-ag/GenerateCode.ag" #-} - _lhsImergeMap - {-# LINE 5553 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOnr = - ({-# LINE 276 "src-ag/GenerateCode.ag" #-} - _lhsInr - {-# LINE 5559 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOnt = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsInt - {-# LINE 5565 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _intraOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _o_case - {-# LINE 5571 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 5577 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 5583 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 5589 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 5595 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 5601 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 5607 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 5613 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 5619 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 5625 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 5631 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _intraOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _o_splitsems - {-# LINE 5637 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 5643 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 5649 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 5655 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 5661 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOparamInstMap = - ({-# LINE 101 "src-ag/GenerateCode.ag" #-} - _lhsIparamInstMap - {-# LINE 5667 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 5673 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 5679 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOsyn = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIsyn - {-# LINE 5685 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOterminals = - ({-# LINE 90 "src-ag/GenerateCode.ag" #-} - _lhsIterminals - {-# LINE 5691 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _intraOunfoldSemDom = - ({-# LINE 747 "src-ag/GenerateCode.ag" #-} - _lhsIunfoldSemDom - {-# LINE 5697 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (chain) - _intraOvisitedSet = - ({-# LINE 145 "src-ag/GenerateCode.ag" #-} - _vssIvisitedSet - {-# LINE 5703 "src-ag/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, Maybe (Maybe Type))] - 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 - 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, Maybe (Maybe Type))]) -> - 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 -> - ( ([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, Maybe (Maybe Type))])),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)} -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 ) = - (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 - 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 -> - (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, Maybe (Maybe Type))]) - _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 - _tlOallNts :: (Set NontermIdent) - _tlOallPragmas :: PragmaMap - _tlOaroundMap :: (Set Identifier) - _tlOchildren :: ([(Identifier,Type, Maybe (Maybe Type))]) - _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 - _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 280, column 11) - _tlOnr = - ({-# LINE 280 "src-ag/GenerateCode.ag" #-} - _lhsInr + 1 - {-# LINE 5959 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 293, column 12) - _lhsOisNil = - ({-# LINE 293 "src-ag/GenerateCode.ag" #-} - False - {-# LINE 5965 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 294, column 12) - _hdOisLast = - ({-# LINE 294 "src-ag/GenerateCode.ag" #-} - _tlIisNil - {-# LINE 5971 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 311, column 12) - _hdOnextIntra = - ({-# LINE 311 "src-ag/GenerateCode.ag" #-} - _tlIintra - {-# LINE 5977 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 312, column 12) - _hdOnextIntraVars = - ({-# LINE 312 "src-ag/GenerateCode.ag" #-} - _tlIintraVars - {-# LINE 5983 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 313, column 12) - _lhsOintra = - ({-# LINE 313 "src-ag/GenerateCode.ag" #-} - _hdIintra - {-# LINE 5989 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 314, column 12) - _lhsOintraVars = - ({-# LINE 314 "src-ag/GenerateCode.ag" #-} - _hdIintraVars - {-# LINE 5995 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 438, column 11) - _lhsOdecls = - ({-# LINE 438 "src-ag/GenerateCode.ag" #-} - _hdIdecls - {-# LINE 6001 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 439, column 11) - _hdOdecls = - ({-# LINE 439 "src-ag/GenerateCode.ag" #-} - _tlIdecls - {-# LINE 6007 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 866, column 52) - _lhsOcomments = - ({-# LINE 866 "src-ag/GenerateCode.ag" #-} - _hdIcomments ++ _tlIcomments - {-# LINE 6013 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 558, column 44) - _lhsOgatherInstVisitNrs = - ({-# LINE 558 "src-ag/GenerateCode.ag" #-} - _hdIgatherInstVisitNrs `Map.union` _tlIgatherInstVisitNrs - {-# LINE 6019 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 1131, column 61) - _lhsOsemNames = - ({-# LINE 1131 "src-ag/GenerateCode.ag" #-} - _hdIsemNames ++ _tlIsemNames - {-# LINE 6025 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (up) - _lhsOvisitedSet = - ({-# LINE 145 "src-ag/GenerateCode.ag" #-} - _tlIvisitedSet - {-# LINE 6031 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOallNts = - ({-# LINE 132 "src-ag/GenerateCode.ag" #-} - _lhsIallNts - {-# LINE 6037 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOallPragmas = - ({-# LINE 73 "src-ag/GenerateCode.ag" #-} - _lhsIallPragmas - {-# LINE 6043 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOaroundMap = - ({-# LINE 577 "src-ag/GenerateCode.ag" #-} - _lhsIaroundMap - {-# LINE 6049 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOchildren = - ({-# LINE 417 "src-ag/GenerateCode.ag" #-} - _lhsIchildren - {-# LINE 6055 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOcon = - ({-# LINE 89 "src-ag/GenerateCode.ag" #-} - _lhsIcon - {-# LINE 6061 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOcontextMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIcontextMap - {-# LINE 6067 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOinh = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIinh - {-# LINE 6073 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOinstVisitNrs = - ({-# LINE 557 "src-ag/GenerateCode.ag" #-} - _lhsIinstVisitNrs - {-# LINE 6079 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOmergeMap = - ({-# LINE 593 "src-ag/GenerateCode.ag" #-} - _lhsImergeMap - {-# LINE 6085 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOnr = - ({-# LINE 276 "src-ag/GenerateCode.ag" #-} - _lhsInr - {-# LINE 6091 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsInt - {-# LINE 6097 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_case - {-# LINE 6103 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 6109 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 6115 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 6121 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 6127 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 6133 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 6139 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 6145 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 6151 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 6157 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 6163 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_splitsems - {-# LINE 6169 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 6175 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 6181 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 6187 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 6193 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOparamInstMap = - ({-# LINE 101 "src-ag/GenerateCode.ag" #-} - _lhsIparamInstMap - {-# LINE 6199 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 6205 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 6211 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOquantMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIquantMap - {-# LINE 6217 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOsyn = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIsyn - {-# LINE 6223 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOterminals = - ({-# LINE 90 "src-ag/GenerateCode.ag" #-} - _lhsIterminals - {-# LINE 6229 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOunfoldSemDom = - ({-# LINE 747 "src-ag/GenerateCode.ag" #-} - _lhsIunfoldSemDom - {-# LINE 6235 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOvisitedSet = - ({-# LINE 145 "src-ag/GenerateCode.ag" #-} - _lhsIvisitedSet - {-# LINE 6241 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOwith_sig = - ({-# LINE 849 "src-ag/GenerateCode.ag" #-} - _lhsIwith_sig - {-# LINE 6247 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOallNts = - ({-# LINE 132 "src-ag/GenerateCode.ag" #-} - _lhsIallNts - {-# LINE 6253 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOallPragmas = - ({-# LINE 73 "src-ag/GenerateCode.ag" #-} - _lhsIallPragmas - {-# LINE 6259 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOaroundMap = - ({-# LINE 577 "src-ag/GenerateCode.ag" #-} - _lhsIaroundMap - {-# LINE 6265 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOchildren = - ({-# LINE 417 "src-ag/GenerateCode.ag" #-} - _lhsIchildren - {-# LINE 6271 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOcon = - ({-# LINE 89 "src-ag/GenerateCode.ag" #-} - _lhsIcon - {-# LINE 6277 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOcontextMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIcontextMap - {-# LINE 6283 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOinh = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIinh - {-# LINE 6289 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOinstVisitNrs = - ({-# LINE 557 "src-ag/GenerateCode.ag" #-} - _lhsIinstVisitNrs - {-# LINE 6295 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOmergeMap = - ({-# LINE 593 "src-ag/GenerateCode.ag" #-} - _lhsImergeMap - {-# LINE 6301 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsInt - {-# LINE 6307 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_case - {-# LINE 6313 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 6319 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 6325 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 6331 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 6337 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 6343 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 6349 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 6355 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 6361 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 6367 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 6373 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_splitsems - {-# LINE 6379 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 6385 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 6391 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 6397 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 6403 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOparamInstMap = - ({-# LINE 101 "src-ag/GenerateCode.ag" #-} - _lhsIparamInstMap - {-# LINE 6409 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 6415 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 6421 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOquantMap = - ({-# LINE 115 "src-ag/GenerateCode.ag" #-} - _lhsIquantMap - {-# LINE 6427 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOsyn = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIsyn - {-# LINE 6433 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOterminals = - ({-# LINE 90 "src-ag/GenerateCode.ag" #-} - _lhsIterminals - {-# LINE 6439 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOunfoldSemDom = - ({-# LINE 747 "src-ag/GenerateCode.ag" #-} - _lhsIunfoldSemDom - {-# LINE 6445 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (chain) - _tlOvisitedSet = - ({-# LINE 145 "src-ag/GenerateCode.ag" #-} - _hdIvisitedSet - {-# LINE 6451 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOwith_sig = - ({-# LINE 849 "src-ag/GenerateCode.ag" #-} - _lhsIwith_sig - {-# LINE 6457 "src-ag/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 - ( _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 - 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 -> - (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 295, column 10) - _lhsOisNil = - ({-# LINE 295 "src-ag/GenerateCode.ag" #-} - True - {-# LINE 6514 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 315, column 10) - _lhsOintra = - ({-# LINE 315 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 6520 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 316, column 10) - _lhsOintraVars = - ({-# LINE 316 "src-ag/GenerateCode.ag" #-} - Set.empty - {-# LINE 6526 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 437, column 11) - _lhsOdecls = - ({-# LINE 437 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 6532 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 866, column 52) - _lhsOcomments = - ({-# LINE 866 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 6538 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 558, column 44) - _lhsOgatherInstVisitNrs = - ({-# LINE 558 "src-ag/GenerateCode.ag" #-} - Map.empty - {-# LINE 6544 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 1131, column 61) - _lhsOsemNames = - ({-# LINE 1131 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 6550 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (chain) - _lhsOvisitedSet = - ({-# LINE 145 "src-ag/GenerateCode.ag" #-} - _lhsIvisitedSet - {-# LINE 6556 "src-ag/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 659, column 7) - _nextOblockNr = - ({-# LINE 659 "src-ag/GenerateCode.ag" #-} - _lhsIblockNr + 1 - {-# LINE 6637 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 664, column 7) - _lambdaName = - ({-# LINE 664 "src-ag/GenerateCode.ag" #-} - _lhsIprefix ++ "_block" ++ show _lhsIblockNr - {-# LINE 6643 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 665, column 7) - _pragmaDecl = - ({-# LINE 665 "src-ag/GenerateCode.ag" #-} - PragmaDecl ("NOINLINE " ++ _lambdaName ) - {-# LINE 6649 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 666, column 7) - _lhsOcallExpr = - ({-# LINE 666 "src-ag/GenerateCode.ag" #-} - App _lambdaName (map SimpleExpr _freeVars ) - {-# LINE 6655 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 670, column 7) - _freeVars = - ({-# LINE 670 "src-ag/GenerateCode.ag" #-} - freevars _nextIfreeVars (visit_ : defs_) - {-# LINE 6661 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 677, column 7) - _decl = - ({-# LINE 677 "src-ag/GenerateCode.ag" #-} - mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ [visit_]) _nextIcallExpr - {-# LINE 6667 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 678, column 7) - _lhsOdecls = - ({-# LINE 678 "src-ag/GenerateCode.ag" #-} - (if _lhsIblockNr > 1 then [_pragmaDecl ] else []) ++ [_decl ] ++ _nextIdecls - {-# LINE 6673 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _lhsOfreeVars = - ({-# LINE 661 "src-ag/GenerateCode.ag" #-} - _freeVars - {-# LINE 6679 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _nextOlastExprVars = - ({-# LINE 645 "src-ag/GenerateCode.ag" #-} - _lhsIlastExprVars - {-# LINE 6685 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _nextOnextVisitDecls = - ({-# LINE 645 "src-ag/GenerateCode.ag" #-} - _lhsInextVisitDecls - {-# LINE 6691 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _nextOoptCase = - ({-# LINE 645 "src-ag/GenerateCode.ag" #-} - _lhsIoptCase - {-# LINE 6697 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _nextOprefix = - ({-# LINE 645 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 6703 "src-ag/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 664, column 7) - _lambdaName = - ({-# LINE 664 "src-ag/GenerateCode.ag" #-} - _lhsIprefix ++ "_block" ++ show _lhsIblockNr - {-# LINE 6724 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 665, column 7) - _pragmaDecl = - ({-# LINE 665 "src-ag/GenerateCode.ag" #-} - PragmaDecl ("NOINLINE " ++ _lambdaName ) - {-# LINE 6730 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 666, column 7) - _lhsOcallExpr = - ({-# LINE 666 "src-ag/GenerateCode.ag" #-} - App _lambdaName (map SimpleExpr _freeVars ) - {-# LINE 6736 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 668, column 7) - _freeVars = - ({-# LINE 668 "src-ag/GenerateCode.ag" #-} - freevars _lhsIlastExprVars (defs_ ++ _lhsInextVisitDecls) - {-# LINE 6742 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 675, column 7) - _lhsOdecls = - ({-# LINE 675 "src-ag/GenerateCode.ag" #-} - [ mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ _lhsInextVisitDecls) result_ ] - {-# LINE 6748 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (from local) - _lhsOfreeVars = - ({-# LINE 661 "src-ag/GenerateCode.ag" #-} - _freeVars - {-# LINE 6754 "src-ag/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 650, column 7) - _lhsOlambdas = - ({-# LINE 650 "src-ag/GenerateCode.ag" #-} - _blocksIdecls - {-# LINE 6812 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 651, column 7) - _lhsOfirstCall = - ({-# LINE 651 "src-ag/GenerateCode.ag" #-} - _blocksIcallExpr - {-# LINE 6818 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 656, column 7) - _blocksOblockNr = - ({-# LINE 656 "src-ag/GenerateCode.ag" #-} - 1 - {-# LINE 6824 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _blocksOlastExprVars = - ({-# LINE 645 "src-ag/GenerateCode.ag" #-} - _lhsIlastExprVars - {-# LINE 6830 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _blocksOnextVisitDecls = - ({-# LINE 645 "src-ag/GenerateCode.ag" #-} - _lhsInextVisitDecls - {-# LINE 6836 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _blocksOoptCase = - ({-# LINE 645 "src-ag/GenerateCode.ag" #-} - _lhsIoptCase - {-# LINE 6842 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _blocksOprefix = - ({-# LINE 645 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 6848 "src-ag/GenerateCode.hs" #-} - ) - ( _blocksIcallExpr,_blocksIdecls,_blocksIfreeVars) = - blocks_ _blocksOblockNr _blocksOlastExprVars _blocksOnextVisitDecls _blocksOoptCase _blocksOprefix - in ( _lhsOfirstCall,_lhsOlambdas))) ) --- Pattern ----------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - definedInsts : [Identifier] - patternAttributes : [(Identifier, Identifier)] - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern (Alias _field _attr _pat _parts ) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) -sem_Pattern (Constr _name _pats ) = - (sem_Pattern_Constr _name (sem_Patterns _pats ) ) -sem_Pattern (Irrefutable _pat ) = - (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) -sem_Pattern (Product _pos _pats ) = - (sem_Pattern_Product _pos (sem_Patterns _pats ) ) -sem_Pattern (Underscore _pos ) = - (sem_Pattern_Underscore _pos ) --- semantic domain -newtype T_Pattern = T_Pattern (( Pattern ,([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_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = - (T_Pattern (let _lhsOdefinedInsts :: ([Identifier]) - _lhsOpatternAttributes :: ([(Identifier, Identifier)]) - _lhsOcopy :: Pattern - _patIcopy :: Pattern - _patIdefinedInsts :: ([Identifier]) - _patIpatternAttributes :: ([(Identifier, Identifier)]) - _partsIcopy :: Patterns - _partsIdefinedInsts :: ([Identifier]) - _partsIpatternAttributes :: ([(Identifier, Identifier)]) - -- "src-ag/GenerateCode.ag"(line 261, column 11) - _lhsOdefinedInsts = - ({-# LINE 261 "src-ag/GenerateCode.ag" #-} - (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts - {-# LINE 6929 "src-ag/GenerateCode.hs" #-} - ) - -- "src-ag/GenerateCode.ag"(line 269, column 7) - _lhsOpatternAttributes = - ({-# LINE 269 "src-ag/GenerateCode.ag" #-} - (field_,attr_) : (_patIpatternAttributes ++ _partsIpatternAttributes) - {-# LINE 6935 "src-ag/GenerateCode.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 6941 "src-ag/GenerateCode.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 6947 "src-ag/GenerateCode.hs" #-} - ) - ( _patIcopy,_patIdefinedInsts,_patIpatternAttributes) = - pat_ - ( _partsIcopy,_partsIdefinedInsts,_partsIpatternAttributes) = - parts_ - in ( _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 259, column 55) - _lhsOdefinedInsts = - ({-# LINE 259 "src-ag/GenerateCode.ag" #-} - _patsIdefinedInsts - {-# LINE 6968 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 266, column 47) - _lhsOpatternAttributes = - ({-# LINE 266 "src-ag/GenerateCode.ag" #-} - _patsIpatternAttributes - {-# LINE 6974 "src-ag/GenerateCode.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 6980 "src-ag/GenerateCode.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 6986 "src-ag/GenerateCode.hs" #-} - ) - ( _patsIcopy,_patsIdefinedInsts,_patsIpatternAttributes) = - pats_ - 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 259, column 55) - _lhsOdefinedInsts = - ({-# LINE 259 "src-ag/GenerateCode.ag" #-} - _patIdefinedInsts - {-# LINE 7004 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 266, column 47) - _lhsOpatternAttributes = - ({-# LINE 266 "src-ag/GenerateCode.ag" #-} - _patIpatternAttributes - {-# LINE 7010 "src-ag/GenerateCode.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 7016 "src-ag/GenerateCode.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 7022 "src-ag/GenerateCode.hs" #-} - ) - ( _patIcopy,_patIdefinedInsts,_patIpatternAttributes) = - pat_ - 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 259, column 55) - _lhsOdefinedInsts = - ({-# LINE 259 "src-ag/GenerateCode.ag" #-} - _patsIdefinedInsts - {-# LINE 7041 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 266, column 47) - _lhsOpatternAttributes = - ({-# LINE 266 "src-ag/GenerateCode.ag" #-} - _patsIpatternAttributes - {-# LINE 7047 "src-ag/GenerateCode.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 7053 "src-ag/GenerateCode.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 7059 "src-ag/GenerateCode.hs" #-} - ) - ( _patsIcopy,_patsIdefinedInsts,_patsIpatternAttributes) = - pats_ - 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 259, column 55) - _lhsOdefinedInsts = - ({-# LINE 259 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 7074 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 266, column 47) - _lhsOpatternAttributes = - ({-# LINE 266 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 7080 "src-ag/GenerateCode.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Underscore pos_ - {-# LINE 7086 "src-ag/GenerateCode.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 7092 "src-ag/GenerateCode.hs" #-} - ) - in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - 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 259, column 55) - _lhsOdefinedInsts = - ({-# LINE 259 "src-ag/GenerateCode.ag" #-} - _hdIdefinedInsts ++ _tlIdefinedInsts - {-# LINE 7144 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 266, column 47) - _lhsOpatternAttributes = - ({-# LINE 266 "src-ag/GenerateCode.ag" #-} - _hdIpatternAttributes ++ _tlIpatternAttributes - {-# LINE 7150 "src-ag/GenerateCode.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 7156 "src-ag/GenerateCode.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 7162 "src-ag/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 259, column 55) - _lhsOdefinedInsts = - ({-# LINE 259 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 7178 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 266, column 47) - _lhsOpatternAttributes = - ({-# LINE 266 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 7184 "src-ag/GenerateCode.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - [] - {-# LINE 7190 "src-ag/GenerateCode.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 7196 "src-ag/GenerateCode.hs" #-} - ) - in ( _lhsOcopy,_lhsOdefinedInsts,_lhsOpatternAttributes)) ) --- Sequence ---------------------------------------------------- -{- - visit 0: - inherited attributes: - allNts : Set NontermIdent - aroundMap : Set Identifier - children : [(Identifier,Type,Maybe (Maybe Type))] - 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,Maybe (Maybe Type))]) -> - 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,Maybe (Maybe Type))])),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,Maybe (Maybe Type))]) - _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,Maybe (Maybe Type))]) - _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 619, column 7) - _lhsOblockDecls = - ({-# LINE 619 "src-ag/GenerateCode.ag" #-} - _hdIbldBlocksFun _tlIblockDecls - {-# LINE 7450 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 423, column 39) - _lhsOallTpsFound = - ({-# LINE 423 "src-ag/GenerateCode.ag" #-} - _hdIallTpsFound && _tlIallTpsFound - {-# LINE 7456 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 866, column 52) - _lhsOcomments = - ({-# LINE 866 "src-ag/GenerateCode.ag" #-} - _hdIcomments ++ _tlIcomments - {-# LINE 7462 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 155, column 34) - _lhsOdecls = - ({-# LINE 155 "src-ag/GenerateCode.ag" #-} - _hdIdecls ++ _tlIdecls - {-# LINE 7468 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 259, column 55) - _lhsOdefinedInsts = - ({-# LINE 259 "src-ag/GenerateCode.ag" #-} - _hdIdefinedInsts ++ _tlIdefinedInsts - {-# LINE 7474 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 332, column 34) - _lhsOexprs = - ({-# LINE 332 "src-ag/GenerateCode.ag" #-} - _hdIexprs ++ _tlIexprs - {-# LINE 7480 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 361, column 33) - _lhsOtSigs = - ({-# LINE 361 "src-ag/GenerateCode.ag" #-} - _hdItSigs ++ _tlItSigs - {-# LINE 7486 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 422, column 31) - _lhsOtps = - ({-# LINE 422 "src-ag/GenerateCode.ag" #-} - _hdItps ++ _tlItps - {-# LINE 7492 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 350, column 37) - _lhsOusedVars = - ({-# LINE 350 "src-ag/GenerateCode.ag" #-} - _hdIusedVars `Set.union` _tlIusedVars - {-# LINE 7498 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (up) - _lhsOdeclsAbove = - ({-# LINE 605 "src-ag/GenerateCode.ag" #-} - _tlIdeclsAbove - {-# LINE 7504 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (up) - _lhsOvisitedSet = - ({-# LINE 145 "src-ag/GenerateCode.ag" #-} - _tlIvisitedSet - {-# LINE 7510 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOallNts = - ({-# LINE 132 "src-ag/GenerateCode.ag" #-} - _lhsIallNts - {-# LINE 7516 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOaroundMap = - ({-# LINE 577 "src-ag/GenerateCode.ag" #-} - _lhsIaroundMap - {-# LINE 7522 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOchildren = - ({-# LINE 257 "src-ag/GenerateCode.ag" #-} - _lhsIchildren - {-# LINE 7528 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOcon = - ({-# LINE 89 "src-ag/GenerateCode.ag" #-} - _lhsIcon - {-# LINE 7534 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOdeclsAbove = - ({-# LINE 605 "src-ag/GenerateCode.ag" #-} - _lhsIdeclsAbove - {-# LINE 7540 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOinh = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIinh - {-# LINE 7546 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOinstVisitNrs = - ({-# LINE 557 "src-ag/GenerateCode.ag" #-} - _lhsIinstVisitNrs - {-# LINE 7552 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOmergeMap = - ({-# LINE 593 "src-ag/GenerateCode.ag" #-} - _lhsImergeMap - {-# LINE 7558 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOnr = - ({-# LINE 276 "src-ag/GenerateCode.ag" #-} - _lhsInr - {-# LINE 7564 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsInt - {-# LINE 7570 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_case - {-# LINE 7576 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 7582 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 7588 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 7594 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 7600 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 7606 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 7612 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 7618 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 7624 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 7630 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 7636 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_splitsems - {-# LINE 7642 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 7648 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 7654 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 7660 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 7666 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOparamInstMap = - ({-# LINE 101 "src-ag/GenerateCode.ag" #-} - _lhsIparamInstMap - {-# LINE 7672 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 7678 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 7684 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOsyn = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIsyn - {-# LINE 7690 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOterminals = - ({-# LINE 90 "src-ag/GenerateCode.ag" #-} - _lhsIterminals - {-# LINE 7696 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOunfoldSemDom = - ({-# LINE 747 "src-ag/GenerateCode.ag" #-} - _lhsIunfoldSemDom - {-# LINE 7702 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOvisitedSet = - ({-# LINE 145 "src-ag/GenerateCode.ag" #-} - _lhsIvisitedSet - {-# LINE 7708 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _hdOwhat = - ({-# LINE 868 "src-ag/GenerateCode.ag" #-} - _lhsIwhat - {-# LINE 7714 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOallNts = - ({-# LINE 132 "src-ag/GenerateCode.ag" #-} - _lhsIallNts - {-# LINE 7720 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOaroundMap = - ({-# LINE 577 "src-ag/GenerateCode.ag" #-} - _lhsIaroundMap - {-# LINE 7726 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOchildren = - ({-# LINE 257 "src-ag/GenerateCode.ag" #-} - _lhsIchildren - {-# LINE 7732 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOcon = - ({-# LINE 89 "src-ag/GenerateCode.ag" #-} - _lhsIcon - {-# LINE 7738 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (chain) - _tlOdeclsAbove = - ({-# LINE 605 "src-ag/GenerateCode.ag" #-} - _hdIdeclsAbove - {-# LINE 7744 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOinh = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIinh - {-# LINE 7750 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOinstVisitNrs = - ({-# LINE 557 "src-ag/GenerateCode.ag" #-} - _lhsIinstVisitNrs - {-# LINE 7756 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOlastExpr = - ({-# LINE 603 "src-ag/GenerateCode.ag" #-} - _lhsIlastExpr - {-# LINE 7762 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOmergeMap = - ({-# LINE 593 "src-ag/GenerateCode.ag" #-} - _lhsImergeMap - {-# LINE 7768 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOnr = - ({-# LINE 276 "src-ag/GenerateCode.ag" #-} - _lhsInr - {-# LINE 7774 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsInt - {-# LINE 7780 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_case = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_case - {-# LINE 7786 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_cata = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_cata - {-# LINE 7792 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_costcentre = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_costcentre - {-# LINE 7798 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_data = - ({-# LINE 48 "src-ag/GenerateCode.ag" #-} - _lhsIo_data - {-# LINE 7804 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_linePragmas = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_linePragmas - {-# LINE 7810 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_monadic = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_monadic - {-# LINE 7816 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_newtypes = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_newtypes - {-# LINE 7822 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_pretty = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_pretty - {-# LINE 7828 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_rename = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_rename - {-# LINE 7834 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_sem = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sem - {-# LINE 7840 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_sig = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_sig - {-# LINE 7846 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_splitsems = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_splitsems - {-# LINE 7852 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_strictwrap = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_strictwrap - {-# LINE 7858 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_traces = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_traces - {-# LINE 7864 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOo_unbox = - ({-# LINE 47 "src-ag/GenerateCode.ag" #-} - _lhsIo_unbox - {-# LINE 7870 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 50 "src-ag/GenerateCode.ag" #-} - _lhsIoptions - {-# LINE 7876 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOparamInstMap = - ({-# LINE 101 "src-ag/GenerateCode.ag" #-} - _lhsIparamInstMap - {-# LINE 7882 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOparamMap = - ({-# LINE 95 "src-ag/GenerateCode.ag" #-} - _lhsIparamMap - {-# LINE 7888 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOprefix = - ({-# LINE 49 "src-ag/GenerateCode.ag" #-} - _lhsIprefix - {-# LINE 7894 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOsyn = - ({-# LINE 84 "src-ag/GenerateCode.ag" #-} - _lhsIsyn - {-# LINE 7900 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOterminals = - ({-# LINE 90 "src-ag/GenerateCode.ag" #-} - _lhsIterminals - {-# LINE 7906 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOunfoldSemDom = - ({-# LINE 747 "src-ag/GenerateCode.ag" #-} - _lhsIunfoldSemDom - {-# LINE 7912 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (chain) - _tlOvisitedSet = - ({-# LINE 145 "src-ag/GenerateCode.ag" #-} - _hdIvisitedSet - {-# LINE 7918 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (down) - _tlOwhat = - ({-# LINE 868 "src-ag/GenerateCode.ag" #-} - _lhsIwhat - {-# LINE 7924 "src-ag/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 621, column 7) - _lhsOblockDecls = - ({-# LINE 621 "src-ag/GenerateCode.ag" #-} - DeclTerminator _lhsIdeclsAbove _lhsIlastExpr - {-# LINE 7983 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 423, column 39) - _lhsOallTpsFound = - ({-# LINE 423 "src-ag/GenerateCode.ag" #-} - True - {-# LINE 7989 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 866, column 52) - _lhsOcomments = - ({-# LINE 866 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 7995 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 155, column 34) - _lhsOdecls = - ({-# LINE 155 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 8001 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 259, column 55) - _lhsOdefinedInsts = - ({-# LINE 259 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 8007 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 332, column 34) - _lhsOexprs = - ({-# LINE 332 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 8013 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 361, column 33) - _lhsOtSigs = - ({-# LINE 361 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 8019 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 422, column 31) - _lhsOtps = - ({-# LINE 422 "src-ag/GenerateCode.ag" #-} - [] - {-# LINE 8025 "src-ag/GenerateCode.hs" #-} - ) - -- use rule "src-ag/GenerateCode.ag"(line 350, column 37) - _lhsOusedVars = - ({-# LINE 350 "src-ag/GenerateCode.ag" #-} - Set.empty - {-# LINE 8031 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (chain) - _lhsOdeclsAbove = - ({-# LINE 605 "src-ag/GenerateCode.ag" #-} - _lhsIdeclsAbove - {-# LINE 8037 "src-ag/GenerateCode.hs" #-} - ) - -- copy rule (chain) - _lhsOvisitedSet = - ({-# LINE 145 "src-ag/GenerateCode.ag" #-} - _lhsIvisitedSet - {-# LINE 8043 "src-ag/GenerateCode.hs" #-} - ) - in ( _lhsOallTpsFound,_lhsOblockDecls,_lhsOcomments,_lhsOdecls,_lhsOdeclsAbove,_lhsOdefinedInsts,_lhsOexprs,_lhsOtSigs,_lhsOtps,_lhsOusedVars,_lhsOvisitedSet))) ) diff --git a/dist/build/uuagc/uuagc-tmp/HsToken.hs b/dist/build/uuagc/uuagc-tmp/HsToken.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/HsToken.hs +++ /dev/null @@ -1,57 +0,0 @@ - - --- UUAGC 0.9.39.0.0 (src-ag/HsToken.ag) -module HsToken where -{-# LINE 2 "src-ag/HsToken.ag" #-} - -import CommonTypes -import UU.Scanner.Position(Pos) -{-# LINE 10 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/HsToken.hs" #-} --- HsToken ----------------------------------------------------- -{- - alternatives: - alternative AGField: - child field : {Identifier} - child attr : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - alternative AGLocal: - child var : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - alternative CharToken: - child value : {String} - child pos : {Pos} - alternative Err: - child mesg : {String} - child pos : {Pos} - alternative HsToken: - child value : {String} - child pos : {Pos} - alternative StrToken: - child value : {String} - child pos : {Pos} --} -data HsToken = AGField (Identifier) (Identifier) (Pos) ((Maybe String)) - | AGLocal (Identifier) (Pos) ((Maybe String)) - | CharToken (String) (Pos) - | Err (String) (Pos) - | HsToken (String) (Pos) - | StrToken (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/uuagc/uuagc-tmp/Interfaces.hs b/dist/build/uuagc/uuagc-tmp/Interfaces.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/Interfaces.hs +++ /dev/null @@ -1,51 +0,0 @@ - - --- UUAGC 0.9.39.0.0 (src-ag/Interfaces.ag) -module Interfaces where -{-# LINE 2 "src-ag/Interfaces.ag" #-} - -import CommonTypes -import SequentialTypes -{-# LINE 10 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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/uuagc/uuagc-tmp/InterfacesRules.hs b/dist/build/uuagc/uuagc-tmp/InterfacesRules.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/InterfacesRules.hs +++ /dev/null @@ -1,1376 +0,0 @@ -{-# OPTIONS_GHC -XBangPatterns #-} - --- UUAGC 0.9.39.0.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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/InterfacesRules.hs" #-} - -{-# LINE 2 "src-ag/Interfaces.ag" #-} - -import CommonTypes -import SequentialTypes -{-# LINE 33 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/InterfacesRules.hs" #-} -{-# LINE 58 "src-ag/InterfacesRules.lag" #-} - -type VisitSS = [Vertex] -{-# LINE 37 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/InterfacesRules.hs" #-} - -{-# LINE 323 "src-ag/InterfacesRules.lag" #-} - -type IntraVisit = [Vertex] -{-# LINE 73 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/InterfacesRules.hs" #-} - -{-# LINE 345 "src-ag/InterfacesRules.lag" #-} - -swap (a,b) = (b,a) -{-# LINE 78 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_intersOinfo -> - (case (({-# LINE 85 "src-ag/InterfacesRules.lag" #-} - snd (bounds _lhsItdp) + 1 - {-# LINE 140 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_intersOprev -> - (case (({-# LINE 71 "src-ag/InterfacesRules.lag" #-} - toList _intersInewedges - {-# LINE 153 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_visitssGraph -> - (case (({-# LINE 218 "src-ag/InterfacesRules.lag" #-} - _visitssGraph - {-# LINE 165 "src-ag/InterfacesRules.hs" #-} - )) of - { !_intersOvssGraph -> - (case (({-# LINE 147 "src-ag/InterfacesRules.lag" #-} - toList _intersIdescr - {-# LINE 170 "src-ag/InterfacesRules.hs" #-} - )) of - { !_descr -> - (case (({-# LINE 127 "src-ag/InterfacesRules.lag" #-} - Map.fromList _descr - {-# LINE 175 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_intersOallInters -> - (case (({-# LINE 343 "src-ag/InterfacesRules.lag" #-} - buildG (0,_intersIv-1) (map swap (_lhsIdpr ++ _newedges)) - {-# LINE 187 "src-ag/InterfacesRules.hs" #-} - )) of - { !_intersOddp -> - (case (inters_2 _intersOallInters _intersOddp ) of - { ( !_intersIedp,!_intersIvisits) -> - (case (({-# LINE 442 "src-ag/InterfacesRules.lag" #-} - toList _intersIedp - {-# LINE 194 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOedp -> - (case (({-# LINE 382 "src-ag/InterfacesRules.lag" #-} - _intersIinters - {-# LINE 199 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOinters -> - (case (({-# LINE 383 "src-ag/InterfacesRules.lag" #-} - _intersIvisits - {-# LINE 204 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_segOinfo -> - (case (({-# LINE 205 "src-ag/InterfacesRules.lag" #-} - 0 - {-# LINE 286 "src-ag/InterfacesRules.hs" #-} - )) of - { !_segOn -> - (case (({-# LINE 195 "src-ag/InterfacesRules.lag" #-} - \a -> ruleTable _lhsIinfo ! a - {-# LINE 291 "src-ag/InterfacesRules.hs" #-} - )) of - { !_look -> - (case (({-# LINE 187 "src-ag/InterfacesRules.lag" #-} - _lhsIv - {-# LINE 296 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_v -> - (case (({-# LINE 190 "src-ag/InterfacesRules.lag" #-} - [_segIv .. _v-1] - {-# LINE 308 "src-ag/InterfacesRules.hs" #-} - )) of - { !_firstvisitvertices -> - (case (({-# LINE 196 "src-ag/InterfacesRules.lag" #-} - zipWith (cv _look (-1)) _firstvisitvertices _segIgroups - {-# LINE 313 "src-ag/InterfacesRules.hs" #-} - )) of - { !_descr -> - (case (({-# LINE 197 "src-ag/InterfacesRules.lag" #-} - _segIdescr Seq.>< Seq.fromList _descr - {-# LINE 318 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOdescr -> - (case (({-# LINE 258 "src-ag/InterfacesRules.lag" #-} - _firstvisitvertices - {-# LINE 323 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOfirstvisitvertices -> - (case (({-# LINE 191 "src-ag/InterfacesRules.lag" #-} - zip _firstvisitvertices _segInewvertices - {-# LINE 328 "src-ag/InterfacesRules.hs" #-} - )) of - { !_newedges -> - (case (({-# LINE 192 "src-ag/InterfacesRules.lag" #-} - _segInewedges Seq.>< Seq.fromList _newedges - {-# LINE 333 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOnewedges -> - (case (({-# LINE 189 "src-ag/InterfacesRules.lag" #-} - _v - {-# LINE 338 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_segOvssGraph -> - (case (({-# LINE 125 "src-ag/InterfacesRules.lag" #-} - _lhsIvisitDescr - {-# LINE 353 "src-ag/InterfacesRules.hs" #-} - )) of - { !_segOvisitDescr -> - (case (({-# LINE 263 "src-ag/InterfacesRules.lag" #-} - _lhsIprev - {-# LINE 358 "src-ag/InterfacesRules.hs" #-} - )) of - { !_segOprev -> - (case (({-# LINE 237 "src-ag/InterfacesRules.lag" #-} - cons_ - {-# LINE 363 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOinter -> - (case (({-# LINE 391 "src-ag/InterfacesRules.lag" #-} - nt_ - {-# LINE 375 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_segOddp -> - (case (({-# LINE 378 "src-ag/InterfacesRules.lag" #-} - _lhsIallInters - {-# LINE 389 "src-ag/InterfacesRules.hs" #-} - )) of - { !_segOallInters -> - (case (({-# LINE 351 "src-ag/InterfacesRules.lag" #-} - _lhsIprev - {-# LINE 394 "src-ag/InterfacesRules.hs" #-} - )) of - { !_segOfromLhs -> - (case (({-# LINE 314 "src-ag/InterfacesRules.lag" #-} - True - {-# LINE 399 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOedp -> - (case (({-# LINE 396 "src-ag/InterfacesRules.lag" #-} - Map.fromList (zip cons_ (transpose _segIcvisits)) - {-# LINE 411 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_hdOv -> - (case (({-# LINE 83 "src-ag/InterfacesRules.lag" #-} - _lhsIinfo - {-# LINE 491 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_tlOv -> - (case (({-# LINE 83 "src-ag/InterfacesRules.lag" #-} - _lhsIinfo - {-# LINE 503 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOdescr -> - (case (({-# LINE 258 "src-ag/InterfacesRules.lag" #-} - _hdIfirstvisitvertices ++ _tlIfirstvisitvertices - {-# LINE 515 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOfirstvisitvertices -> - (case (({-# LINE 129 "src-ag/InterfacesRules.lag" #-} - _hdInewedges Seq.>< _tlInewedges - {-# LINE 520 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOnewedges -> - (case (({-# LINE 82 "src-ag/InterfacesRules.lag" #-} - _tlIv - {-# LINE 525 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_tlOvssGraph -> - (case (({-# LINE 125 "src-ag/InterfacesRules.lag" #-} - _lhsIvisitDescr - {-# LINE 540 "src-ag/InterfacesRules.hs" #-} - )) of - { !_tlOvisitDescr -> - (case (({-# LINE 258 "src-ag/InterfacesRules.lag" #-} - _lhsIprev - {-# LINE 545 "src-ag/InterfacesRules.hs" #-} - )) of - { !_tlOprev -> - (case (({-# LINE 216 "src-ag/InterfacesRules.lag" #-} - _lhsIvssGraph - {-# LINE 550 "src-ag/InterfacesRules.hs" #-} - )) of - { !_hdOvssGraph -> - (case (({-# LINE 125 "src-ag/InterfacesRules.lag" #-} - _lhsIvisitDescr - {-# LINE 555 "src-ag/InterfacesRules.hs" #-} - )) of - { !_hdOvisitDescr -> - (case (({-# LINE 258 "src-ag/InterfacesRules.lag" #-} - _lhsIprev - {-# LINE 560 "src-ag/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 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_tlOddp -> - (case (({-# LINE 378 "src-ag/InterfacesRules.lag" #-} - _lhsIallInters - {-# LINE 583 "src-ag/InterfacesRules.hs" #-} - )) of - { !_tlOallInters -> - (case (tl_2 _tlOallInters _tlOddp ) of - { ( !_tlIedp,!_tlIvisits) -> - (case (({-# LINE 341 "src-ag/InterfacesRules.lag" #-} - _lhsIddp - {-# LINE 590 "src-ag/InterfacesRules.hs" #-} - )) of - { !_hdOddp -> - (case (({-# LINE 378 "src-ag/InterfacesRules.lag" #-} - _lhsIallInters - {-# LINE 595 "src-ag/InterfacesRules.hs" #-} - )) of - { !_hdOallInters -> - (case (hd_2 _hdOallInters _hdOddp ) of - { ( !_hdIedp,!_hdIvisits) -> - (case (({-# LINE 437 "src-ag/InterfacesRules.lag" #-} - _hdIedp Seq.>< _tlIedp - {-# LINE 602 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOedp -> - (case (({-# LINE 386 "src-ag/InterfacesRules.lag" #-} - Map.insert _hdInt _hdIvisits _tlIvisits - {-# LINE 607 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOdescr -> - (case (({-# LINE 258 "src-ag/InterfacesRules.lag" #-} - [] - {-# LINE 628 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOfirstvisitvertices -> - (case (({-# LINE 129 "src-ag/InterfacesRules.lag" #-} - Seq.empty - {-# LINE 633 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOnewedges -> - (case (({-# LINE 82 "src-ag/InterfacesRules.lag" #-} - _lhsIv - {-# LINE 638 "src-ag/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 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOedp -> - (case (({-# LINE 388 "src-ag/InterfacesRules.lag" #-} - Map.empty - {-# LINE 662 "src-ag/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 : {(Map Identifier Type,Map Identifier Type)} - local synmap : {Map Identifier Type} - local inhmap : {Map Identifier Type} - intra occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]} - visit 3: - local computed : _ - local fromLhs : _ - local iv : _ - local intravisits : _ - intra visitss : {[[Vertex]]} - intra occurAs : {(CRule -> Bool) -> [Vertex] -> [Vertex]} - intra synmap : {Map Identifier Type} - intra inhmap : {Map Identifier Type} --} --- cata -sem_Segment :: Segment -> - T_Segment -sem_Segment !(Segment _inh _syn ) = - (sem_Segment_Segment _inh _syn ) --- semantic domain -newtype T_Segment = T_Segment (Info -> - Vertex -> - ( Vertex,T_Segment_1 )) -newtype T_Segment_1 = T_Segment_1 (Int -> - ([Vertex]) -> - ( (Seq (Vertex,ChildVisit)),([([Vertex],[Vertex])]),(Seq Edge ),([Vertex]),T_Segment_2 )) -newtype T_Segment_2 = T_Segment_2 (([ConstructorIdent]) -> - ([Vertex]) -> - (Map Vertex ChildVisit) -> - Graph -> - ( ([Vertex]),CSegment,T_Segment_3 )) -newtype T_Segment_3 = T_Segment_3 (CInterfaceMap -> - Graph -> - ([Vertex]) -> - Bool -> - ([Vertex]) -> - ([IntraVisit]) -> - ( ([CVisit]),(Seq Edge),([Vertex]),([IntraVisit]),([VisitSS]))) -data Inh_Segment = Inh_Segment {allInters_Inh_Segment :: !(CInterfaceMap),cons_Inh_Segment :: !(([ConstructorIdent])),ddp_Inh_Segment :: !(Graph),fromLhs_Inh_Segment :: !(([Vertex])),info_Inh_Segment :: !(Info),isFirst_Inh_Segment :: !(Bool),n_Inh_Segment :: !(Int),nextInh_Inh_Segment :: !(([Vertex])),nextIntravisits_Inh_Segment :: !(([IntraVisit])),nextNewvertices_Inh_Segment :: !(([Vertex])),prev_Inh_Segment :: !(([Vertex])),v_Inh_Segment :: !(Vertex),visitDescr_Inh_Segment :: !((Map Vertex ChildVisit)),vssGraph_Inh_Segment :: !(Graph)} -data Syn_Segment = Syn_Segment {cvisits_Syn_Segment :: !(([CVisit])),descr_Syn_Segment :: !((Seq (Vertex,ChildVisit))),edp_Syn_Segment :: !((Seq Edge)),groups_Syn_Segment :: !(([([Vertex],[Vertex])])),inh_Syn_Segment :: !(([Vertex])),intravisits_Syn_Segment :: !(([IntraVisit])),newedges_Syn_Segment :: !((Seq Edge )),newvertices_Syn_Segment :: !(([Vertex])),prev_Syn_Segment :: !(([Vertex])),seg_Syn_Segment :: !(CSegment),v_Syn_Segment :: !(Vertex),visitss_Syn_Segment :: !(([VisitSS]))} -wrap_Segment :: T_Segment -> - 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 "src-ag/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 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_groups -> - (case (({-# LINE 116 "src-ag/InterfacesRules.lag" #-} - _lhsIv + length _groups - {-# LINE 809 "src-ag/InterfacesRules.hs" #-} - )) of - { !_v -> - (case (({-# LINE 82 "src-ag/InterfacesRules.lag" #-} - _v - {-# LINE 814 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_newvertices -> - (case (({-# LINE 132 "src-ag/InterfacesRules.lag" #-} - Seq.fromList $ zipWith (cv _look _lhsIn) _newvertices _groups - {-# LINE 828 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOdescr -> - (case (({-# LINE 182 "src-ag/InterfacesRules.lag" #-} - _groups - {-# LINE 833 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOgroups -> - (case (({-# LINE 174 "src-ag/InterfacesRules.lag" #-} - zip _newvertices _lhsInextNewvertices - {-# LINE 838 "src-ag/InterfacesRules.hs" #-} - )) of - { !_visitedges -> - (case (({-# LINE 155 "src-ag/InterfacesRules.lag" #-} - concat (zipWith ed _newvertices _groups) - {-# LINE 843 "src-ag/InterfacesRules.hs" #-} - )) of - { !_attredges -> - (case (({-# LINE 175 "src-ag/InterfacesRules.lag" #-} - Seq.fromList _attredges Seq.>< Seq.fromList _visitedges - {-# LINE 848 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOnewedges -> - (case (({-# LINE 166 "src-ag/InterfacesRules.lag" #-} - _newvertices - {-# LINE 853 "src-ag/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 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_vss -> - (case (({-# LINE 270 "src-ag/InterfacesRules.lag" #-} - map (\\ _lhsIprev) _vss - {-# LINE 878 "src-ag/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 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_defined -> - (case (({-# LINE 275 "src-ag/InterfacesRules.lag" #-} - _lhsIprev ++ _defined - {-# LINE 911 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !__tup1 -> - (case (({-# LINE 409 "src-ag/InterfacesRules.lag" #-} - __tup1 - {-# LINE 923 "src-ag/InterfacesRules.hs" #-} - )) of - { !(_,!_synmap) -> - (case (({-# LINE 409 "src-ag/InterfacesRules.lag" #-} - __tup1 - {-# LINE 928 "src-ag/InterfacesRules.hs" #-} - )) of - { !(!_inhmap,_) -> - (case (({-# LINE 405 "src-ag/InterfacesRules.lag" #-} - if False then undefined _lhsIvssGraph _lhsIvisitDescr _lhsIprev else CSegment _inhmap _synmap - {-# LINE 933 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_computed -> - (case (({-# LINE 356 "src-ag/InterfacesRules.lag" #-} - _occurAs isLhs inh_ ++ _lhsIfromLhs - {-# LINE 954 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_iv -> - (case (({-# LINE 361 "src-ag/InterfacesRules.lag" #-} - zipWith _iv _visitss _lhsInextIntravisits - {-# LINE 966 "src-ag/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 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOedp -> - (case (({-# LINE 444 "src-ag/InterfacesRules.lag" #-} - inh_ - {-# LINE 987 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOinh -> - (case (({-# LINE 327 "src-ag/InterfacesRules.lag" #-} - _intravisits - {-# LINE 992 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOintravisits -> - (case (({-# LINE 269 "src-ag/InterfacesRules.lag" #-} - _visitss - {-# LINE 997 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_hdOv -> - (case (({-# LINE 83 "src-ag/InterfacesRules.lag" #-} - _lhsIinfo - {-# LINE 1093 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_tlOv -> - (case (({-# LINE 83 "src-ag/InterfacesRules.lag" #-} - _lhsIinfo - {-# LINE 1105 "src-ag/InterfacesRules.hs" #-} - )) of - { !_tlOinfo -> - (case (({-# LINE 203 "src-ag/InterfacesRules.lag" #-} - _lhsIn - {-# LINE 1110 "src-ag/InterfacesRules.hs" #-} - )) of - { !_hdOn -> - (case (({-# LINE 207 "src-ag/InterfacesRules.lag" #-} - _lhsIn + 1 - {-# LINE 1115 "src-ag/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 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOdescr -> - (case (({-# LINE 184 "src-ag/InterfacesRules.lag" #-} - _hdIgroups - {-# LINE 1134 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOgroups -> - (case (({-# LINE 129 "src-ag/InterfacesRules.lag" #-} - _hdInewedges Seq.>< _tlInewedges - {-# LINE 1139 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOnewedges -> - (case (({-# LINE 170 "src-ag/InterfacesRules.lag" #-} - _hdInewvertices - {-# LINE 1144 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOnewvertices -> - (case (({-# LINE 82 "src-ag/InterfacesRules.lag" #-} - _tlIv - {-# LINE 1149 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_tlOvssGraph -> - (case (({-# LINE 125 "src-ag/InterfacesRules.lag" #-} - _lhsIvisitDescr - {-# LINE 1165 "src-ag/InterfacesRules.hs" #-} - )) of - { !_tlOvisitDescr -> - (case (({-# LINE 216 "src-ag/InterfacesRules.lag" #-} - _lhsIvssGraph - {-# LINE 1170 "src-ag/InterfacesRules.hs" #-} - )) of - { !_hdOvssGraph -> - (case (({-# LINE 125 "src-ag/InterfacesRules.lag" #-} - _lhsIvisitDescr - {-# LINE 1175 "src-ag/InterfacesRules.hs" #-} - )) of - { !_hdOvisitDescr -> - (case (({-# LINE 263 "src-ag/InterfacesRules.lag" #-} - _lhsIprev - {-# LINE 1180 "src-ag/InterfacesRules.hs" #-} - )) of - { !_hdOprev -> - (case (({-# LINE 235 "src-ag/InterfacesRules.lag" #-} - _lhsIcons - {-# LINE 1185 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_tlOprev -> - (case (({-# LINE 235 "src-ag/InterfacesRules.lag" #-} - _lhsIcons - {-# LINE 1197 "src-ag/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 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_tlOddp -> - (case (({-# LINE 378 "src-ag/InterfacesRules.lag" #-} - _lhsIallInters - {-# LINE 1220 "src-ag/InterfacesRules.hs" #-} - )) of - { !_tlOallInters -> - (case (({-# LINE 341 "src-ag/InterfacesRules.lag" #-} - _lhsIddp - {-# LINE 1225 "src-ag/InterfacesRules.hs" #-} - )) of - { !_hdOddp -> - (case (({-# LINE 378 "src-ag/InterfacesRules.lag" #-} - _lhsIallInters - {-# LINE 1230 "src-ag/InterfacesRules.hs" #-} - )) of - { !_hdOallInters -> - (case (({-# LINE 354 "src-ag/InterfacesRules.lag" #-} - [] - {-# LINE 1235 "src-ag/InterfacesRules.hs" #-} - )) of - { !_tlOfromLhs -> - (case (({-# LINE 353 "src-ag/InterfacesRules.lag" #-} - _lhsIfromLhs - {-# LINE 1240 "src-ag/InterfacesRules.hs" #-} - )) of - { !_hdOfromLhs -> - (case (({-# LINE 316 "src-ag/InterfacesRules.lag" #-} - False - {-# LINE 1245 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_hdOnextIntravisits -> - (case (({-# LINE 312 "src-ag/InterfacesRules.lag" #-} - _lhsIisFirst - {-# LINE 1257 "src-ag/InterfacesRules.hs" #-} - )) of - { !_hdOisFirst -> - (case (({-# LINE 446 "src-ag/InterfacesRules.lag" #-} - _tlIfirstInh - {-# LINE 1262 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOcvisits -> - (case (({-# LINE 437 "src-ag/InterfacesRules.lag" #-} - _hdIedp Seq.>< _tlIedp - {-# LINE 1274 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOedp -> - (case (({-# LINE 447 "src-ag/InterfacesRules.lag" #-} - _hdIinh - {-# LINE 1279 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOfirstInh -> - (case (({-# LINE 330 "src-ag/InterfacesRules.lag" #-} - _hdIintravisits - {-# LINE 1284 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOhdIntravisits -> - (case (({-# LINE 263 "src-ag/InterfacesRules.lag" #-} - _tlIprev - {-# LINE 1289 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOdescr -> - (case (({-# LINE 185 "src-ag/InterfacesRules.lag" #-} - [] - {-# LINE 1311 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOgroups -> - (case (({-# LINE 129 "src-ag/InterfacesRules.lag" #-} - Seq.empty - {-# LINE 1316 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOnewedges -> - (case (({-# LINE 171 "src-ag/InterfacesRules.lag" #-} - [] - {-# LINE 1321 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOnewvertices -> - (case (({-# LINE 82 "src-ag/InterfacesRules.lag" #-} - _lhsIv - {-# LINE 1326 "src-ag/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 "src-ag/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 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOcvisits -> - (case (({-# LINE 437 "src-ag/InterfacesRules.lag" #-} - Seq.empty - {-# LINE 1353 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOedp -> - (case (({-# LINE 448 "src-ag/InterfacesRules.lag" #-} - [] - {-# LINE 1358 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOfirstInh -> - (case (({-# LINE 331 "src-ag/InterfacesRules.lag" #-} - repeat [] - {-# LINE 1363 "src-ag/InterfacesRules.hs" #-} - )) of - { !_lhsOhdIntravisits -> - (case (({-# LINE 263 "src-ag/InterfacesRules.lag" #-} - _lhsIprev - {-# LINE 1368 "src-ag/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/uuagc/uuagc-tmp/KWOrder.hs b/dist/build/uuagc/uuagc-tmp/KWOrder.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/KWOrder.hs +++ /dev/null @@ -1,1620 +0,0 @@ - - --- UUAGC 0.9.39.0.0 (src-ag/KWOrder.ag) -module KWOrder where -{-# LINE 6 "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 qualified Data.Set as Set -import qualified Data.Map as Map -{-# LINE 22 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 CommonTypes -{-# LINE 32 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/KWOrder.hs" #-} - -{-# LINE 2 "src-ag/HsToken.ag" #-} - -import CommonTypes -import UU.Scanner.Position(Pos) -{-# LINE 38 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/KWOrder.hs" #-} - -{-# LINE 2 "src-ag/Expression.ag" #-} - -import UU.Scanner.Position(Pos) -import HsToken -{-# LINE 44 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/KWOrder.hs" #-} - -{-# LINE 2 "src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 51 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/KWOrder.hs" #-} --- Child ------------------------------------------------------- -{- - visit 0: - synthesized attributes: - echilds : EChild - edges : Set.Set Edge - nontnames : [(Identifier, Identifier)] - vertices : Set.Set Vertex - alternatives: - alternative Child: - child name : {Identifier} - child tp : {Type} - child inh : {Attributes} - child syn : {Attributes} - child virtual : {Maybe (Maybe Type)} - visit 0: - local vertex : _ - local synvertices : _ - local inhvertices : _ - local edgesout : _ - local edgesin : _ --} --- cata -sem_Child :: Child -> - T_Child -sem_Child (Child _name _tp _inh _syn _virtual ) = - (sem_Child_Child _name _tp _inh _syn _virtual ) --- semantic domain -newtype T_Child = T_Child (( EChild,(Set.Set Edge),([(Identifier, Identifier)]),(Set.Set Vertex))) -data Inh_Child = Inh_Child {} -data Syn_Child = Syn_Child {echilds_Syn_Child :: EChild,edges_Syn_Child :: (Set.Set Edge),nontnames_Syn_Child :: ([(Identifier, Identifier)]),vertices_Syn_Child :: (Set.Set Vertex)} -wrap_Child :: T_Child -> - Inh_Child -> - Syn_Child -wrap_Child (T_Child sem ) (Inh_Child ) = - (let ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOvertices) = sem - in (Syn_Child _lhsOechilds _lhsOedges _lhsOnontnames _lhsOvertices )) -sem_Child_Child :: Identifier -> - Type -> - Attributes -> - Attributes -> - (Maybe (Maybe Type)) -> - T_Child -sem_Child_Child name_ tp_ inh_ syn_ virtual_ = - (T_Child (let _lhsOechilds :: EChild - _lhsOvertices :: (Set.Set Vertex) - _lhsOedges :: (Set.Set Edge) - _lhsOnontnames :: ([(Identifier, Identifier)]) - -- "src-ag/KWOrder.ag"(line 67, column 11) - _lhsOechilds = - ({-# LINE 67 "src-ag/KWOrder.ag" #-} - EChild name_ tp_ virtual_ - {-# LINE 104 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 100, column 12) - _vertex = - ({-# LINE 100 "src-ag/KWOrder.ag" #-} - VChild name_ - {-# LINE 110 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 101, column 12) - _synvertices = - ({-# LINE 101 "src-ag/KWOrder.ag" #-} - map (VAttr Syn name_) . Map.keys $ syn_ - {-# LINE 116 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 102, column 12) - _inhvertices = - ({-# LINE 102 "src-ag/KWOrder.ag" #-} - map (VAttr Inh name_) . Map.keys $ inh_ - {-# LINE 122 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 103, column 12) - _lhsOvertices = - ({-# LINE 103 "src-ag/KWOrder.ag" #-} - case tp_ of - NT _ _ -> Set.insert _vertex (Set.fromList $ _synvertices ++ _inhvertices ) - _ -> Set.empty - {-# LINE 130 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 128, column 12) - _edgesout = - ({-# LINE 128 "src-ag/KWOrder.ag" #-} - [] - {-# LINE 136 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 129, column 12) - _edgesin = - ({-# LINE 129 "src-ag/KWOrder.ag" #-} - map (flip (,) _vertex ) _synvertices - {-# LINE 142 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 130, column 12) - _lhsOedges = - ({-# LINE 130 "src-ag/KWOrder.ag" #-} - Set.fromList $ _edgesout ++ _edgesin - {-# LINE 148 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 140, column 12) - _lhsOnontnames = - ({-# LINE 140 "src-ag/KWOrder.ag" #-} - case tp_ of - NT nont _ -> [(name_, nont)] - _ -> [] - {-# LINE 156 "src-ag/KWOrder.hs" #-} - ) - in ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOvertices)) ) --- Children ---------------------------------------------------- -{- - visit 0: - synthesized attributes: - echilds : EChildren - edges : Set.Set Edge - nontnames : [(Identifier, Identifier)] - 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 (( EChildren,(Set.Set Edge),([(Identifier, Identifier)]),(Set.Set Vertex))) -data Inh_Children = Inh_Children {} -data Syn_Children = Syn_Children {echilds_Syn_Children :: EChildren,edges_Syn_Children :: (Set.Set Edge),nontnames_Syn_Children :: ([(Identifier, Identifier)]),vertices_Syn_Children :: (Set.Set Vertex)} -wrap_Children :: T_Children -> - Inh_Children -> - Syn_Children -wrap_Children (T_Children sem ) (Inh_Children ) = - (let ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOvertices) = sem - in (Syn_Children _lhsOechilds _lhsOedges _lhsOnontnames _lhsOvertices )) -sem_Children_Cons :: T_Child -> - T_Children -> - T_Children -sem_Children_Cons (T_Child hd_ ) (T_Children tl_ ) = - (T_Children (let _lhsOechilds :: EChildren - _lhsOedges :: (Set.Set Edge) - _lhsOnontnames :: ([(Identifier, Identifier)]) - _lhsOvertices :: (Set.Set Vertex) - _hdIechilds :: EChild - _hdIedges :: (Set.Set Edge) - _hdInontnames :: ([(Identifier, Identifier)]) - _hdIvertices :: (Set.Set Vertex) - _tlIechilds :: EChildren - _tlIedges :: (Set.Set Edge) - _tlInontnames :: ([(Identifier, Identifier)]) - _tlIvertices :: (Set.Set Vertex) - -- use rule "src-ag/KWOrder.ag"(line 64, column 29) - _lhsOechilds = - ({-# LINE 64 "src-ag/KWOrder.ag" #-} - _hdIechilds : _tlIechilds - {-# LINE 208 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 118, column 33) - _lhsOedges = - ({-# LINE 118 "src-ag/KWOrder.ag" #-} - _hdIedges `Set.union` _tlIedges - {-# LINE 214 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 137, column 37) - _lhsOnontnames = - ({-# LINE 137 "src-ag/KWOrder.ag" #-} - _hdInontnames ++ _tlInontnames - {-# LINE 220 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 76, column 36) - _lhsOvertices = - ({-# LINE 76 "src-ag/KWOrder.ag" #-} - _hdIvertices `Set.union` _tlIvertices - {-# LINE 226 "src-ag/KWOrder.hs" #-} - ) - ( _hdIechilds,_hdIedges,_hdInontnames,_hdIvertices) = - hd_ - ( _tlIechilds,_tlIedges,_tlInontnames,_tlIvertices) = - tl_ - in ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOvertices)) ) -sem_Children_Nil :: T_Children -sem_Children_Nil = - (T_Children (let _lhsOechilds :: EChildren - _lhsOedges :: (Set.Set Edge) - _lhsOnontnames :: ([(Identifier, Identifier)]) - _lhsOvertices :: (Set.Set Vertex) - -- use rule "src-ag/KWOrder.ag"(line 64, column 29) - _lhsOechilds = - ({-# LINE 64 "src-ag/KWOrder.ag" #-} - [] - {-# LINE 243 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 118, column 33) - _lhsOedges = - ({-# LINE 118 "src-ag/KWOrder.ag" #-} - Set.empty - {-# LINE 249 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 137, column 37) - _lhsOnontnames = - ({-# LINE 137 "src-ag/KWOrder.ag" #-} - [] - {-# LINE 255 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 76, column 36) - _lhsOvertices = - ({-# LINE 76 "src-ag/KWOrder.ag" #-} - Set.empty - {-# LINE 261 "src-ag/KWOrder.hs" #-} - ) - in ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOvertices)) ) --- Expression -------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - 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 87, column 17) - _lhsOvertices = - ({-# LINE 87 "src-ag/KWOrder.ag" #-} - Set.unions $ map (\tok -> vertices_Syn_HsToken - (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_ - {-# LINE 303 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 45 "src-ag/KWOrder.ag" #-} - Expression pos_ tks_ - {-# LINE 309 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 45 "src-ag/KWOrder.ag" #-} - _copy - {-# LINE 315 "src-ag/KWOrder.hs" #-} - ) - in ( _lhsOcopy,_lhsOvertices)) ) --- Grammar ----------------------------------------------------- -{- - visit 0: - inherited attribute: - options : Options - synthesized attributes: - depgraphs : PP_Doc - inhmap : Map.Map NontermIdent Attributes - 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)))} --} --- 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,(Map.Map NontermIdent Attributes),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,inhmap_Syn_Grammar :: (Map.Map NontermIdent Attributes),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,_lhsOinhmap,_lhsOoutput,_lhsOsynmap,_lhsOvisitgraph) = sem _lhsIoptions - in (Syn_Grammar _lhsOdepgraphs _lhsOinhmap _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 - _lhsOoutput :: ExecutionPlan - _lhsOdepgraphs :: PP_Doc - _lhsOvisitgraph :: PP_Doc - _lhsOinhmap :: (Map.Map NontermIdent Attributes) - _lhsOsynmap :: (Map.Map NontermIdent Attributes) - _nontsIdepinfo :: ([NontDependencyInformation]) - _nontsIinhmap :: (Map.Map NontermIdent Attributes) - _nontsIrulenumber :: Int - _nontsIsynmap :: (Map.Map NontermIdent Attributes) - -- "src-ag/KWOrder.ag"(line 36, column 14) - _nontsOrulenumber = - ({-# LINE 36 "src-ag/KWOrder.ag" #-} - 0 - {-# LINE 393 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 191, column 15) - (Just (_lhsOoutput,_lhsOdepgraphs,_lhsOvisitgraph) ) = - ({-# LINE 191 "src-ag/KWOrder.ag" #-} - kennedyWarrenOrder wrappers_ _nontsIdepinfo typeSyns_ derivings_ - {-# LINE 399 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 198, column 33) - _lhsOinhmap = - ({-# LINE 198 "src-ag/KWOrder.ag" #-} - _nontsIinhmap - {-# LINE 405 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 199, column 33) - _lhsOsynmap = - ({-# LINE 199 "src-ag/KWOrder.ag" #-} - _nontsIsynmap - {-# LINE 411 "src-ag/KWOrder.hs" #-} - ) - ( _nontsIdepinfo,_nontsIinhmap,_nontsIrulenumber,_nontsIsynmap) = - nonts_ _nontsOrulenumber - in ( _lhsOdepgraphs,_lhsOinhmap,_lhsOoutput,_lhsOsynmap,_lhsOvisitgraph))) ) --- HsToken ----------------------------------------------------- -{- - visit 0: - synthesized attribute: - vertices : Set.Set Vertex - alternatives: - alternative AGField: - child field : {Identifier} - child attr : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - alternative AGLocal: - child var : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - alternative CharToken: - child value : {String} - child pos : {Pos} - alternative Err: - child mesg : {String} - child pos : {Pos} - alternative HsToken: - child value : {String} - child pos : {Pos} - alternative StrToken: - child value : {String} - child pos : {Pos} --} --- cata -sem_HsToken :: HsToken -> - T_HsToken -sem_HsToken (AGField _field _attr _pos _rdesc ) = - (sem_HsToken_AGField _field _attr _pos _rdesc ) -sem_HsToken (AGLocal _var _pos _rdesc ) = - (sem_HsToken_AGLocal _var _pos _rdesc ) -sem_HsToken (CharToken _value _pos ) = - (sem_HsToken_CharToken _value _pos ) -sem_HsToken (Err _mesg _pos ) = - (sem_HsToken_Err _mesg _pos ) -sem_HsToken (HsToken _value _pos ) = - (sem_HsToken_HsToken _value _pos ) -sem_HsToken (StrToken _value _pos ) = - (sem_HsToken_StrToken _value _pos ) --- semantic domain -newtype T_HsToken = T_HsToken (( (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_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 81, column 14) - _lhsOvertices = - ({-# LINE 81 "src-ag/KWOrder.ag" #-} - Set.singleton $ VAttr (if field_ == _LHS then Inh - else if field_ == _LOC then Loc - else Syn) field_ attr_ - {-# LINE 482 "src-ag/KWOrder.hs" #-} - ) - in ( _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 80, column 14) - _lhsOvertices = - ({-# LINE 80 "src-ag/KWOrder.ag" #-} - Set.singleton $ VAttr Loc _LOC var_ - {-# LINE 495 "src-ag/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 76, column 36) - _lhsOvertices = - ({-# LINE 76 "src-ag/KWOrder.ag" #-} - Set.empty - {-# LINE 507 "src-ag/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 76, column 36) - _lhsOvertices = - ({-# LINE 76 "src-ag/KWOrder.ag" #-} - Set.empty - {-# LINE 519 "src-ag/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 76, column 36) - _lhsOvertices = - ({-# LINE 76 "src-ag/KWOrder.ag" #-} - Set.empty - {-# LINE 531 "src-ag/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 76, column 36) - _lhsOvertices = - ({-# LINE 76 "src-ag/KWOrder.ag" #-} - Set.empty - {-# LINE 543 "src-ag/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: - chained attribute: - rulenumber : Int - synthesized attributes: - depinfo : NontDependencyInformation - inhmap : Map.Map NontermIdent 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 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 (Int -> - ( NontDependencyInformation,(Map.Map NontermIdent Attributes),Int,(Map.Map NontermIdent Attributes))) -data Inh_Nonterminal = Inh_Nonterminal {rulenumber_Inh_Nonterminal :: Int} -data Syn_Nonterminal = Syn_Nonterminal {depinfo_Syn_Nonterminal :: NontDependencyInformation,inhmap_Syn_Nonterminal :: (Map.Map NontermIdent Attributes),rulenumber_Syn_Nonterminal :: Int,synmap_Syn_Nonterminal :: (Map.Map NontermIdent Attributes)} -wrap_Nonterminal :: T_Nonterminal -> - Inh_Nonterminal -> - Syn_Nonterminal -wrap_Nonterminal (T_Nonterminal sem ) (Inh_Nonterminal _lhsIrulenumber ) = - (let ( _lhsOdepinfo,_lhsOinhmap,_lhsOrulenumber,_lhsOsynmap) = sem _lhsIrulenumber - in (Syn_Nonterminal _lhsOdepinfo _lhsOinhmap _lhsOrulenumber _lhsOsynmap )) -sem_Nonterminal_Nonterminal :: NontermIdent -> - ([Identifier]) -> - Attributes -> - Attributes -> - T_Productions -> - T_Nonterminal -sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_ ) = - (T_Nonterminal (\ _lhsIrulenumber -> - (let _lhsOdepinfo :: NontDependencyInformation - _lhsOinhmap :: (Map.Map NontermIdent Attributes) - _lhsOsynmap :: (Map.Map NontermIdent Attributes) - _lhsOrulenumber :: Int - _prodsOrulenumber :: Int - _prodsIdepgraph :: ([ProdDependencyGraph]) - _prodsIrulenumber :: Int - -- "src-ag/KWOrder.ag"(line 162, column 18) - _synvertices = - ({-# LINE 162 "src-ag/KWOrder.ag" #-} - map (VAttr Syn nt_) . Map.keys $ syn_ - {-# LINE 664 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 163, column 18) - _inhvertices = - ({-# LINE 163 "src-ag/KWOrder.ag" #-} - map (VAttr Inh nt_) . Map.keys $ inh_ - {-# LINE 670 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 164, column 18) - _vertices = - ({-# LINE 164 "src-ag/KWOrder.ag" #-} - _synvertices ++ _inhvertices - {-# LINE 676 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 168, column 18) - _nontgraph = - ({-# LINE 168 "src-ag/KWOrder.ag" #-} - NontDependencyGraph { ndgVertices = _vertices - , ndgEdges = [] } - {-# LINE 683 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 176, column 18) - _lhsOdepinfo = - ({-# LINE 176 "src-ag/KWOrder.ag" #-} - NontDependencyInformation { ndiNonterminal = nt_ - , ndiParams = params_ - , ndiInh = Map.keys inh_ - , ndiSyn = Map.keys syn_ - , ndiDepGraph = _nontgraph - , ndiProds = _prodsIdepgraph } - {-# LINE 694 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 204, column 17) - _lhsOinhmap = - ({-# LINE 204 "src-ag/KWOrder.ag" #-} - Map.singleton nt_ inh_ - {-# LINE 700 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 205, column 17) - _lhsOsynmap = - ({-# LINE 205 "src-ag/KWOrder.ag" #-} - Map.singleton nt_ syn_ - {-# LINE 706 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (up) - _lhsOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _prodsIrulenumber - {-# LINE 712 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (down) - _prodsOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _lhsIrulenumber - {-# LINE 718 "src-ag/KWOrder.hs" #-} - ) - ( _prodsIdepgraph,_prodsIrulenumber) = - prods_ _prodsOrulenumber - in ( _lhsOdepinfo,_lhsOinhmap,_lhsOrulenumber,_lhsOsynmap))) ) --- Nonterminals ------------------------------------------------ -{- - visit 0: - chained attribute: - rulenumber : Int - synthesized attributes: - depinfo : [NontDependencyInformation] - inhmap : Map.Map NontermIdent 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 (Int -> - ( ([NontDependencyInformation]),(Map.Map NontermIdent Attributes),Int,(Map.Map NontermIdent Attributes))) -data Inh_Nonterminals = Inh_Nonterminals {rulenumber_Inh_Nonterminals :: Int} -data Syn_Nonterminals = Syn_Nonterminals {depinfo_Syn_Nonterminals :: ([NontDependencyInformation]),inhmap_Syn_Nonterminals :: (Map.Map NontermIdent Attributes),rulenumber_Syn_Nonterminals :: Int,synmap_Syn_Nonterminals :: (Map.Map NontermIdent Attributes)} -wrap_Nonterminals :: T_Nonterminals -> - Inh_Nonterminals -> - Syn_Nonterminals -wrap_Nonterminals (T_Nonterminals sem ) (Inh_Nonterminals _lhsIrulenumber ) = - (let ( _lhsOdepinfo,_lhsOinhmap,_lhsOrulenumber,_lhsOsynmap) = sem _lhsIrulenumber - in (Syn_Nonterminals _lhsOdepinfo _lhsOinhmap _lhsOrulenumber _lhsOsynmap )) -sem_Nonterminals_Cons :: T_Nonterminal -> - T_Nonterminals -> - T_Nonterminals -sem_Nonterminals_Cons (T_Nonterminal hd_ ) (T_Nonterminals tl_ ) = - (T_Nonterminals (\ _lhsIrulenumber -> - (let _lhsOdepinfo :: ([NontDependencyInformation]) - _lhsOinhmap :: (Map.Map NontermIdent Attributes) - _lhsOsynmap :: (Map.Map NontermIdent Attributes) - _lhsOrulenumber :: Int - _hdOrulenumber :: Int - _tlOrulenumber :: Int - _hdIdepinfo :: NontDependencyInformation - _hdIinhmap :: (Map.Map NontermIdent Attributes) - _hdIrulenumber :: Int - _hdIsynmap :: (Map.Map NontermIdent Attributes) - _tlIdepinfo :: ([NontDependencyInformation]) - _tlIinhmap :: (Map.Map NontermIdent Attributes) - _tlIrulenumber :: Int - _tlIsynmap :: (Map.Map NontermIdent Attributes) - -- use rule "src-ag/KWOrder.ag"(line 173, column 33) - _lhsOdepinfo = - ({-# LINE 173 "src-ag/KWOrder.ag" #-} - _hdIdepinfo : _tlIdepinfo - {-# LINE 777 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 198, column 33) - _lhsOinhmap = - ({-# LINE 198 "src-ag/KWOrder.ag" #-} - _hdIinhmap `Map.union` _tlIinhmap - {-# LINE 783 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 199, column 33) - _lhsOsynmap = - ({-# LINE 199 "src-ag/KWOrder.ag" #-} - _hdIsynmap `Map.union` _tlIsynmap - {-# LINE 789 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (up) - _lhsOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _tlIrulenumber - {-# LINE 795 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (down) - _hdOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _lhsIrulenumber - {-# LINE 801 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (chain) - _tlOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _hdIrulenumber - {-# LINE 807 "src-ag/KWOrder.hs" #-} - ) - ( _hdIdepinfo,_hdIinhmap,_hdIrulenumber,_hdIsynmap) = - hd_ _hdOrulenumber - ( _tlIdepinfo,_tlIinhmap,_tlIrulenumber,_tlIsynmap) = - tl_ _tlOrulenumber - in ( _lhsOdepinfo,_lhsOinhmap,_lhsOrulenumber,_lhsOsynmap))) ) -sem_Nonterminals_Nil :: T_Nonterminals -sem_Nonterminals_Nil = - (T_Nonterminals (\ _lhsIrulenumber -> - (let _lhsOdepinfo :: ([NontDependencyInformation]) - _lhsOinhmap :: (Map.Map NontermIdent Attributes) - _lhsOsynmap :: (Map.Map NontermIdent Attributes) - _lhsOrulenumber :: Int - -- use rule "src-ag/KWOrder.ag"(line 173, column 33) - _lhsOdepinfo = - ({-# LINE 173 "src-ag/KWOrder.ag" #-} - [] - {-# LINE 825 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 198, column 33) - _lhsOinhmap = - ({-# LINE 198 "src-ag/KWOrder.ag" #-} - Map.empty - {-# LINE 831 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 199, column 33) - _lhsOsynmap = - ({-# LINE 199 "src-ag/KWOrder.ag" #-} - Map.empty - {-# LINE 837 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (chain) - _lhsOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _lhsIrulenumber - {-# LINE 843 "src-ag/KWOrder.hs" #-} - ) - in ( _lhsOdepinfo,_lhsOinhmap,_lhsOrulenumber,_lhsOsynmap))) ) --- Pattern ----------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - vertices : Set.Set Vertex - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local vertex : _ - local copy : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern (Alias _field _attr _pat _parts ) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) -sem_Pattern (Constr _name _pats ) = - (sem_Pattern_Constr _name (sem_Patterns _pats ) ) -sem_Pattern (Irrefutable _pat ) = - (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) -sem_Pattern (Product _pos _pats ) = - (sem_Pattern_Product _pos (sem_Patterns _pats ) ) -sem_Pattern (Underscore _pos ) = - (sem_Pattern_Underscore _pos ) --- semantic domain -newtype T_Pattern = T_Pattern (( Pattern ,(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_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = - (T_Pattern (let _lhsOvertices :: (Set.Set Vertex) - _lhsOcopy :: Pattern - _patIcopy :: Pattern - _patIvertices :: (Set.Set Vertex) - _partsIcopy :: Patterns - _partsIvertices :: (Set.Set Vertex) - -- "src-ag/KWOrder.ag"(line 92, column 12) - _vertex = - ({-# LINE 92 "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 922 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 96, column 12) - _lhsOvertices = - ({-# LINE 96 "src-ag/KWOrder.ag" #-} - Set.insert _vertex $ _partsIvertices `Set.union` _patIvertices - {-# LINE 928 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 934 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 940 "src-ag/KWOrder.hs" #-} - ) - ( _patIcopy,_patIvertices) = - pat_ - ( _partsIcopy,_partsIvertices) = - parts_ - in ( _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 76, column 36) - _lhsOvertices = - ({-# LINE 76 "src-ag/KWOrder.ag" #-} - _patsIvertices - {-# LINE 959 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 965 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 971 "src-ag/KWOrder.hs" #-} - ) - ( _patsIcopy,_patsIvertices) = - pats_ - 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 76, column 36) - _lhsOvertices = - ({-# LINE 76 "src-ag/KWOrder.ag" #-} - _patIvertices - {-# LINE 987 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 993 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 999 "src-ag/KWOrder.hs" #-} - ) - ( _patIcopy,_patIvertices) = - pat_ - 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 76, column 36) - _lhsOvertices = - ({-# LINE 76 "src-ag/KWOrder.ag" #-} - _patsIvertices - {-# LINE 1016 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 1022 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1028 "src-ag/KWOrder.hs" #-} - ) - ( _patsIcopy,_patsIvertices) = - pats_ - 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 76, column 36) - _lhsOvertices = - ({-# LINE 76 "src-ag/KWOrder.ag" #-} - Set.empty - {-# LINE 1042 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Underscore pos_ - {-# LINE 1048 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1054 "src-ag/KWOrder.hs" #-} - ) - in ( _lhsOcopy,_lhsOvertices)) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - 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 76, column 36) - _lhsOvertices = - ({-# LINE 76 "src-ag/KWOrder.ag" #-} - _hdIvertices `Set.union` _tlIvertices - {-# LINE 1102 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 1108 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1114 "src-ag/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 76, column 36) - _lhsOvertices = - ({-# LINE 76 "src-ag/KWOrder.ag" #-} - Set.empty - {-# LINE 1129 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - [] - {-# LINE 1135 "src-ag/KWOrder.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1141 "src-ag/KWOrder.hs" #-} - ) - in ( _lhsOcopy,_lhsOvertices)) ) --- Production -------------------------------------------------- -{- - visit 0: - chained attribute: - rulenumber : Int - synthesized attribute: - depgraph : ProdDependencyGraph - alternatives: - alternative Production: - child con : {ConstructorIdent} - child children : Children - child rules : Rules - child typeSigs : TypeSigs - visit 0: - local vertices : _ - local edges : _ --} --- cata -sem_Production :: Production -> - T_Production -sem_Production (Production _con _children _rules _typeSigs ) = - (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) --- semantic domain -newtype T_Production = T_Production (Int -> - ( ProdDependencyGraph,Int)) -data Inh_Production = Inh_Production {rulenumber_Inh_Production :: Int} -data Syn_Production = Syn_Production {depgraph_Syn_Production :: ProdDependencyGraph,rulenumber_Syn_Production :: Int} -wrap_Production :: T_Production -> - Inh_Production -> - Syn_Production -wrap_Production (T_Production sem ) (Inh_Production _lhsIrulenumber ) = - (let ( _lhsOdepgraph,_lhsOrulenumber) = sem _lhsIrulenumber - in (Syn_Production _lhsOdepgraph _lhsOrulenumber )) -sem_Production_Production :: ConstructorIdent -> - T_Children -> - T_Rules -> - T_TypeSigs -> - T_Production -sem_Production_Production con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) = - (T_Production (\ _lhsIrulenumber -> - (let _lhsOdepgraph :: ProdDependencyGraph - _lhsOrulenumber :: Int - _rulesOrulenumber :: Int - _childrenIechilds :: EChildren - _childrenIedges :: (Set.Set Edge) - _childrenInontnames :: ([(Identifier, Identifier)]) - _childrenIvertices :: (Set.Set Vertex) - _rulesIedges :: (Set.Set Edge) - _rulesIerules :: ERules - _rulesIrulenumber :: Int - _rulesIvertices :: (Set.Set Vertex) - -- "src-ag/KWOrder.ag"(line 114, column 17) - _vertices = - ({-# LINE 114 "src-ag/KWOrder.ag" #-} - _rulesIvertices `Set.union` _childrenIvertices - {-# LINE 1199 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 134, column 17) - _edges = - ({-# LINE 134 "src-ag/KWOrder.ag" #-} - _rulesIedges `Set.union` _childrenIedges - {-# LINE 1205 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 149, column 17) - _lhsOdepgraph = - ({-# LINE 149 "src-ag/KWOrder.ag" #-} - ProdDependencyGraph { pdgVertices = Set.toList _vertices - , pdgEdges = Set.toList _edges - , pdgRules = _rulesIerules - , pdgChilds = _childrenIechilds - , pdgProduction = con_ - , pdgChildMap = _childrenInontnames } - {-# LINE 1216 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (up) - _lhsOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _rulesIrulenumber - {-# LINE 1222 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (down) - _rulesOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _lhsIrulenumber - {-# LINE 1228 "src-ag/KWOrder.hs" #-} - ) - ( _childrenIechilds,_childrenIedges,_childrenInontnames,_childrenIvertices) = - children_ - ( _rulesIedges,_rulesIerules,_rulesIrulenumber,_rulesIvertices) = - rules_ _rulesOrulenumber - in ( _lhsOdepgraph,_lhsOrulenumber))) ) --- Productions ------------------------------------------------- -{- - visit 0: - chained attribute: - rulenumber : Int - synthesized attribute: - depgraph : [ProdDependencyGraph] - 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 (Int -> - ( ([ProdDependencyGraph]),Int)) -data Inh_Productions = Inh_Productions {rulenumber_Inh_Productions :: Int} -data Syn_Productions = Syn_Productions {depgraph_Syn_Productions :: ([ProdDependencyGraph]),rulenumber_Syn_Productions :: Int} -wrap_Productions :: T_Productions -> - Inh_Productions -> - Syn_Productions -wrap_Productions (T_Productions sem ) (Inh_Productions _lhsIrulenumber ) = - (let ( _lhsOdepgraph,_lhsOrulenumber) = sem _lhsIrulenumber - in (Syn_Productions _lhsOdepgraph _lhsOrulenumber )) -sem_Productions_Cons :: T_Production -> - T_Productions -> - T_Productions -sem_Productions_Cons (T_Production hd_ ) (T_Productions tl_ ) = - (T_Productions (\ _lhsIrulenumber -> - (let _lhsOdepgraph :: ([ProdDependencyGraph]) - _lhsOrulenumber :: Int - _hdOrulenumber :: Int - _tlOrulenumber :: Int - _hdIdepgraph :: ProdDependencyGraph - _hdIrulenumber :: Int - _tlIdepgraph :: ([ProdDependencyGraph]) - _tlIrulenumber :: Int - -- use rule "src-ag/KWOrder.ag"(line 146, column 33) - _lhsOdepgraph = - ({-# LINE 146 "src-ag/KWOrder.ag" #-} - _hdIdepgraph : _tlIdepgraph - {-# LINE 1281 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (up) - _lhsOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _tlIrulenumber - {-# LINE 1287 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (down) - _hdOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _lhsIrulenumber - {-# LINE 1293 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (chain) - _tlOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _hdIrulenumber - {-# LINE 1299 "src-ag/KWOrder.hs" #-} - ) - ( _hdIdepgraph,_hdIrulenumber) = - hd_ _hdOrulenumber - ( _tlIdepgraph,_tlIrulenumber) = - tl_ _tlOrulenumber - in ( _lhsOdepgraph,_lhsOrulenumber))) ) -sem_Productions_Nil :: T_Productions -sem_Productions_Nil = - (T_Productions (\ _lhsIrulenumber -> - (let _lhsOdepgraph :: ([ProdDependencyGraph]) - _lhsOrulenumber :: Int - -- use rule "src-ag/KWOrder.ag"(line 146, column 33) - _lhsOdepgraph = - ({-# LINE 146 "src-ag/KWOrder.ag" #-} - [] - {-# LINE 1315 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (chain) - _lhsOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _lhsIrulenumber - {-# LINE 1321 "src-ag/KWOrder.hs" #-} - ) - in ( _lhsOdepgraph,_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} - 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 ) = - (sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) --- 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 -> - T_Rule -sem_Rule_Rule mbName_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ = - (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 39, column 11) - _lhsOrulenumber = - ({-# LINE 39 "src-ag/KWOrder.ag" #-} - _lhsIrulenumber + 1 - {-# LINE 1384 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 40, column 11) - _rulename = - ({-# LINE 40 "src-ag/KWOrder.ag" #-} - maybe (identifier $ "rule" ++ show _lhsIrulenumber) id mbName_ - {-# LINE 1390 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 51, column 10) - _lhsOerules = - ({-# LINE 51 "src-ag/KWOrder.ag" #-} - ERule _rulename - _patternIcopy - _rhsIcopy - owrt_ - origin_ - explicit_ - {-# LINE 1401 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 109, column 11) - _vertex = - ({-# LINE 109 "src-ag/KWOrder.ag" #-} - VRule _rulename - {-# LINE 1407 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 110, column 11) - _lhsOvertices = - ({-# LINE 110 "src-ag/KWOrder.ag" #-} - Set.insert _vertex $ _patternIvertices `Set.union` _rhsIvertices - {-# LINE 1413 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 122, column 11) - _edgesout = - ({-# LINE 122 "src-ag/KWOrder.ag" #-} - map ((,) _vertex ) (Set.toList _rhsIvertices) - {-# LINE 1419 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 123, column 11) - _edgesin = - ({-# LINE 123 "src-ag/KWOrder.ag" #-} - map (flip (,) _vertex ) (Set.toList _patternIvertices) - {-# LINE 1425 "src-ag/KWOrder.hs" #-} - ) - -- "src-ag/KWOrder.ag"(line 124, column 11) - _lhsOedges = - ({-# LINE 124 "src-ag/KWOrder.ag" #-} - Set.fromList $ _edgesout ++ _edgesin - {-# LINE 1431 "src-ag/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 118, column 33) - _lhsOedges = - ({-# LINE 118 "src-ag/KWOrder.ag" #-} - _hdIedges `Set.union` _tlIedges - {-# LINE 1492 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 48, column 25) - _lhsOerules = - ({-# LINE 48 "src-ag/KWOrder.ag" #-} - _hdIerules : _tlIerules - {-# LINE 1498 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 76, column 36) - _lhsOvertices = - ({-# LINE 76 "src-ag/KWOrder.ag" #-} - _hdIvertices `Set.union` _tlIvertices - {-# LINE 1504 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (up) - _lhsOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _tlIrulenumber - {-# LINE 1510 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (down) - _hdOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _lhsIrulenumber - {-# LINE 1516 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (chain) - _tlOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _hdIrulenumber - {-# LINE 1522 "src-ag/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 118, column 33) - _lhsOedges = - ({-# LINE 118 "src-ag/KWOrder.ag" #-} - Set.empty - {-# LINE 1540 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 48, column 25) - _lhsOerules = - ({-# LINE 48 "src-ag/KWOrder.ag" #-} - [] - {-# LINE 1546 "src-ag/KWOrder.hs" #-} - ) - -- use rule "src-ag/KWOrder.ag"(line 76, column 36) - _lhsOvertices = - ({-# LINE 76 "src-ag/KWOrder.ag" #-} - Set.empty - {-# LINE 1552 "src-ag/KWOrder.hs" #-} - ) - -- copy rule (chain) - _lhsOrulenumber = - ({-# LINE 33 "src-ag/KWOrder.ag" #-} - _lhsIrulenumber - {-# LINE 1558 "src-ag/KWOrder.hs" #-} - ) - in ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices))) ) --- 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/uuagc/uuagc-tmp/Order.hs b/dist/build/uuagc/uuagc-tmp/Order.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/Order.hs +++ /dev/null @@ -1,5526 +0,0 @@ - - --- UUAGC 0.9.39.0.0 (src-ag/Order.ag) -module Order where -{-# LINE 9 "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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Order.hs" #-} - -{-# LINE 2 "src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 49 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Order.hs" #-} - -{-# LINE 2 "src-ag/Expression.ag" #-} - -import UU.Scanner.Position(Pos) -import HsToken -{-# LINE 55 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 CommonTypes -{-# LINE 65 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Order.hs" #-} -{-# LINE 46 "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 76 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Order.hs" #-} - -{-# LINE 71 "src-ag/Order.ag" #-} - -startsWith :: String -> String -> Bool -startsWith k h = k == take (length k) h -{-# LINE 82 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Order.hs" #-} - -{-# LINE 138 "src-ag/Order.ag" #-} - -getNtName :: Type -> NontermIdent -getNtName (NT nt _) = maybe nt id (deforestedNt nt) -getNtName _ = nullIdent -{-# LINE 89 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Order.hs" #-} - -{-# LINE 166 "src-ag/Order.ag" #-} - -data AltAttr = AltAttr Identifier Identifier Bool - deriving (Eq, Ord, Show) -{-# LINE 95 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Order.hs" #-} - -{-# LINE 238 "src-ag/Order.ag" #-} - -substSelf nt tp - = case tp of - NT n tps | n == _SELF -> NT nt tps - _ -> tp - -haskellTupel :: [Type] -> Maybe Type -haskellTupel ts = Just ( Haskell ( '(' : (concat (intersperse "," (map show ts))) ++ ")" )) -{-# LINE 106 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Order.hs" #-} - -{-# LINE 689 "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 226 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Order.hs" #-} --- Child ------------------------------------------------------- -{- - visit 0: - inherited attributes: - allfields : [(Identifier,Type,Maybe (Maybe Type))] - allnts : [Identifier] - attrs : [(Identifier,Identifier)] - con : Identifier - inh : Attributes - mergeMap : Map Identifier (Identifier,[Identifier]) - nt : Identifier - o_unbox : Bool - syn : Attributes - synthesized attributes: - attributes : [(Identifier,Attributes,Attributes)] - collectChildrenInhs : Map Identifier Attributes - collectChildrenSyns : Map Identifier Attributes - errors : Seq Error - field : (Identifier,Type,Maybe (Maybe Type)) - 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 inh : {Attributes} - child syn : {Attributes} - child virtual : {Maybe (Maybe Type)} - visit 0: - local maptolocal : _ - local gathRules : _ --} --- cata -sem_Child :: Child -> - T_Child -sem_Child (Child _name _tp _inh _syn _virtual ) = - (sem_Child_Child _name _tp _inh _syn _virtual ) --- semantic domain -newtype T_Child = T_Child (([(Identifier,Type,Maybe (Maybe Type))]) -> - ([Identifier]) -> - ([(Identifier,Identifier)]) -> - Identifier -> - Attributes -> - (Map Identifier (Identifier,[Identifier])) -> - Identifier -> - Bool -> - Attributes -> - ( ([(Identifier,Attributes,Attributes)]),(Map Identifier Attributes ),(Map Identifier Attributes ),(Seq Error),((Identifier,Type,Maybe (Maybe Type))),([AltAttr]),(Seq CRule),(Seq (Identifier,Attributes)),(Seq (Identifier,NontermIdent)),([CRule]),([Identifier]))) -data Inh_Child = Inh_Child {allfields_Inh_Child :: !(([(Identifier,Type,Maybe (Maybe Type))])),allnts_Inh_Child :: !(([Identifier])),attrs_Inh_Child :: !(([(Identifier,Identifier)])),con_Inh_Child :: !(Identifier),inh_Inh_Child :: !(Attributes),mergeMap_Inh_Child :: !((Map Identifier (Identifier,[Identifier]))),nt_Inh_Child :: !(Identifier),o_unbox_Inh_Child :: !(Bool),syn_Inh_Child :: !(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,Maybe (Maybe Type)))),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 _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn ) = - (let ( _lhsOattributes,_lhsOcollectChildrenInhs,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfield,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn - in (Syn_Child _lhsOattributes _lhsOcollectChildrenInhs _lhsOcollectChildrenSyns _lhsOerrors _lhsOfield _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals )) -sem_Child_Child :: Identifier -> - Type -> - Attributes -> - Attributes -> - (Maybe (Maybe Type)) -> - T_Child -sem_Child_Child name_ tp_ inh_ syn_ virtual_ = - (T_Child (\ _lhsIallfields - _lhsIallnts - _lhsIattrs - _lhsIcon - _lhsIinh - _lhsImergeMap - _lhsInt - _lhsIo_unbox - _lhsIsyn -> - (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,Maybe (Maybe Type))) - _lhsOerrors :: (Seq Error) - _lhsOgathRules :: (Seq CRule) - -- "src-ag/Order.ag"(line 177, column 13) - _maptolocal = - ({-# LINE 177 "src-ag/Order.ag" #-} - case tp_ of - NT nt _ -> Map.null syn_ - _ -> True - {-# LINE 320 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 180, column 13) - _lhsOgathAltAttrs = - ({-# LINE 180 "src-ag/Order.ag" #-} - if _maptolocal - then [ AltAttr _LOC name_ True ] - else [ AltAttr name_ syn True | syn <- Map.keys syn_ ] - {-# LINE 328 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 195, column 13) - _lhsOnts = - ({-# LINE 195 "src-ag/Order.ag" #-} - Seq.singleton (name_,getNtName tp_) - {-# LINE 334 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 196, column 13) - _lhsOinhs = - ({-# LINE 196 "src-ag/Order.ag" #-} - Seq.singleton (name_,inh_) - {-# LINE 340 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 212, column 13) - _gathRules = - ({-# LINE 212 "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 348 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 346, column 12) - _lhsOcollectChildrenSyns = - ({-# LINE 346 "src-ag/Order.ag" #-} - Map.singleton name_ syn_ - {-# LINE 354 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 347, column 12) - _lhsOcollectChildrenInhs = - ({-# LINE 347 "src-ag/Order.ag" #-} - Map.singleton name_ inh_ - {-# LINE 360 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 615, column 11) - _lhsOsinglevisits = - ({-# LINE 615 "src-ag/Order.ag" #-} - if _maptolocal - then [] - else [CChildVisit name_ (getNtName tp_) 0 inh_ syn_ True] - {-# LINE 368 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 640, column 11) - _lhsOterminals = - ({-# LINE 640 "src-ag/Order.ag" #-} - if _maptolocal - then [name_] - else [] - {-# LINE 376 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 669, column 11) - _lhsOattributes = - ({-# LINE 669 "src-ag/Order.ag" #-} - [(name_, inh_, syn_)] - {-# LINE 382 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 673, column 11) - _lhsOfield = - ({-# LINE 673 "src-ag/Order.ag" #-} - (name_, tp_, virtual_) - {-# LINE 388 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 394 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 206, column 23) - _lhsOgathRules = - ({-# LINE 206 "src-ag/Order.ag" #-} - _gathRules - {-# LINE 400 "src-ag/Order.hs" #-} - ) - in ( _lhsOattributes,_lhsOcollectChildrenInhs,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfield,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals))) ) --- Children ---------------------------------------------------- -{- - visit 0: - inherited attributes: - allfields : [(Identifier,Type,Maybe (Maybe Type))] - allnts : [Identifier] - attrs : [(Identifier,Identifier)] - con : Identifier - inh : Attributes - mergeMap : Map Identifier (Identifier,[Identifier]) - nt : Identifier - o_unbox : Bool - syn : Attributes - synthesized attributes: - attributes : [(Identifier,Attributes,Attributes)] - collectChildrenInhs : Map Identifier Attributes - collectChildrenSyns : Map Identifier Attributes - errors : Seq Error - fields : [(Identifier,Type,Maybe (Maybe Type))] - 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,Maybe (Maybe Type))]) -> - ([Identifier]) -> - ([(Identifier,Identifier)]) -> - Identifier -> - Attributes -> - (Map Identifier (Identifier,[Identifier])) -> - Identifier -> - Bool -> - Attributes -> - ( ([(Identifier,Attributes,Attributes)]),(Map Identifier Attributes ),(Map Identifier Attributes ),(Seq Error),([(Identifier,Type,Maybe (Maybe Type))]),([AltAttr]),(Seq CRule),(Seq (Identifier,Attributes)),(Seq (Identifier,NontermIdent)),([CRule]),([Identifier]))) -data Inh_Children = Inh_Children {allfields_Inh_Children :: !(([(Identifier,Type,Maybe (Maybe Type))])),allnts_Inh_Children :: !(([Identifier])),attrs_Inh_Children :: !(([(Identifier,Identifier)])),con_Inh_Children :: !(Identifier),inh_Inh_Children :: !(Attributes),mergeMap_Inh_Children :: !((Map Identifier (Identifier,[Identifier]))),nt_Inh_Children :: !(Identifier),o_unbox_Inh_Children :: !(Bool),syn_Inh_Children :: !(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,Maybe (Maybe Type))])),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 _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn ) = - (let ( _lhsOattributes,_lhsOcollectChildrenInhs,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn - 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 - _lhsImergeMap - _lhsInt - _lhsIo_unbox - _lhsIsyn -> - (let _lhsOfields :: ([(Identifier,Type,Maybe (Maybe Type))]) - _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,Maybe (Maybe Type))]) - _hdOallnts :: ([Identifier]) - _hdOattrs :: ([(Identifier,Identifier)]) - _hdOcon :: Identifier - _hdOinh :: Attributes - _hdOmergeMap :: (Map Identifier (Identifier,[Identifier])) - _hdOnt :: Identifier - _hdOo_unbox :: Bool - _hdOsyn :: Attributes - _tlOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) - _tlOallnts :: ([Identifier]) - _tlOattrs :: ([(Identifier,Identifier)]) - _tlOcon :: Identifier - _tlOinh :: Attributes - _tlOmergeMap :: (Map Identifier (Identifier,[Identifier])) - _tlOnt :: Identifier - _tlOo_unbox :: Bool - _tlOsyn :: Attributes - _hdIattributes :: ([(Identifier,Attributes,Attributes)]) - _hdIcollectChildrenInhs :: (Map Identifier Attributes ) - _hdIcollectChildrenSyns :: (Map Identifier Attributes ) - _hdIerrors :: (Seq Error) - _hdIfield :: ((Identifier,Type,Maybe (Maybe Type))) - _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,Maybe (Maybe Type))]) - _tlIgathAltAttrs :: ([AltAttr]) - _tlIgathRules :: (Seq CRule) - _tlIinhs :: (Seq (Identifier,Attributes)) - _tlInts :: (Seq (Identifier,NontermIdent)) - _tlIsinglevisits :: ([CRule]) - _tlIterminals :: ([Identifier]) - -- "src-ag/Order.ag"(line 676, column 11) - _lhsOfields = - ({-# LINE 676 "src-ag/Order.ag" #-} - _hdIfield : _tlIfields - {-# LINE 526 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 667, column 32) - _lhsOattributes = - ({-# LINE 667 "src-ag/Order.ag" #-} - _hdIattributes ++ _tlIattributes - {-# LINE 532 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 344, column 68) - _lhsOcollectChildrenInhs = - ({-# LINE 344 "src-ag/Order.ag" #-} - _hdIcollectChildrenInhs `Map.union` _tlIcollectChildrenInhs - {-# LINE 538 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 344, column 68) - _lhsOcollectChildrenSyns = - ({-# LINE 344 "src-ag/Order.ag" #-} - _hdIcollectChildrenSyns `Map.union` _tlIcollectChildrenSyns - {-# LINE 544 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 550 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 170, column 68) - _lhsOgathAltAttrs = - ({-# LINE 170 "src-ag/Order.ag" #-} - _hdIgathAltAttrs ++ _tlIgathAltAttrs - {-# LINE 556 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 206, column 23) - _lhsOgathRules = - ({-# LINE 206 "src-ag/Order.ag" #-} - _hdIgathRules Seq.>< _tlIgathRules - {-# LINE 562 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 193, column 20) - _lhsOinhs = - ({-# LINE 193 "src-ag/Order.ag" #-} - _hdIinhs Seq.>< _tlIinhs - {-# LINE 568 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 192, column 19) - _lhsOnts = - ({-# LINE 192 "src-ag/Order.ag" #-} - _hdInts Seq.>< _tlInts - {-# LINE 574 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 613, column 40) - _lhsOsinglevisits = - ({-# LINE 613 "src-ag/Order.ag" #-} - _hdIsinglevisits ++ _tlIsinglevisits - {-# LINE 580 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 638, column 38) - _lhsOterminals = - ({-# LINE 638 "src-ag/Order.ag" #-} - _hdIterminals ++ _tlIterminals - {-# LINE 586 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOallfields = - ({-# LINE 656 "src-ag/Order.ag" #-} - _lhsIallfields - {-# LINE 592 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOallnts = - ({-# LINE 649 "src-ag/Order.ag" #-} - _lhsIallnts - {-# LINE 598 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOattrs = - ({-# LINE 656 "src-ag/Order.ag" #-} - _lhsIattrs - {-# LINE 604 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOcon = - ({-# LINE 90 "src-ag/Order.ag" #-} - _lhsIcon - {-# LINE 610 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 616 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOmergeMap = - ({-# LINE 362 "src-ag/Order.ag" #-} - _lhsImergeMap - {-# LINE 622 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 628 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_unbox = - ({-# LINE 119 "src-ag/Order.ag" #-} - _lhsIo_unbox - {-# LINE 634 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 640 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOallfields = - ({-# LINE 656 "src-ag/Order.ag" #-} - _lhsIallfields - {-# LINE 646 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOallnts = - ({-# LINE 649 "src-ag/Order.ag" #-} - _lhsIallnts - {-# LINE 652 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOattrs = - ({-# LINE 656 "src-ag/Order.ag" #-} - _lhsIattrs - {-# LINE 658 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOcon = - ({-# LINE 90 "src-ag/Order.ag" #-} - _lhsIcon - {-# LINE 664 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 670 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOmergeMap = - ({-# LINE 362 "src-ag/Order.ag" #-} - _lhsImergeMap - {-# LINE 676 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 682 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_unbox = - ({-# LINE 119 "src-ag/Order.ag" #-} - _lhsIo_unbox - {-# LINE 688 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 694 "src-ag/Order.hs" #-} - ) - ( _hdIattributes,_hdIcollectChildrenInhs,_hdIcollectChildrenSyns,_hdIerrors,_hdIfield,_hdIgathAltAttrs,_hdIgathRules,_hdIinhs,_hdInts,_hdIsinglevisits,_hdIterminals) = - hd_ _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOinh _hdOmergeMap _hdOnt _hdOo_unbox _hdOsyn - ( _tlIattributes,_tlIcollectChildrenInhs,_tlIcollectChildrenSyns,_tlIerrors,_tlIfields,_tlIgathAltAttrs,_tlIgathRules,_tlIinhs,_tlInts,_tlIsinglevisits,_tlIterminals) = - tl_ _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOinh _tlOmergeMap _tlOnt _tlOo_unbox _tlOsyn - 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 - _lhsImergeMap - _lhsInt - _lhsIo_unbox - _lhsIsyn -> - (let _lhsOfields :: ([(Identifier,Type,Maybe (Maybe Type))]) - _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 677, column 11) - _lhsOfields = - ({-# LINE 677 "src-ag/Order.ag" #-} - [] - {-# LINE 727 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 667, column 32) - _lhsOattributes = - ({-# LINE 667 "src-ag/Order.ag" #-} - [] - {-# LINE 733 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 344, column 68) - _lhsOcollectChildrenInhs = - ({-# LINE 344 "src-ag/Order.ag" #-} - Map.empty - {-# LINE 739 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 344, column 68) - _lhsOcollectChildrenSyns = - ({-# LINE 344 "src-ag/Order.ag" #-} - Map.empty - {-# LINE 745 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 751 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 170, column 68) - _lhsOgathAltAttrs = - ({-# LINE 170 "src-ag/Order.ag" #-} - [] - {-# LINE 757 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 206, column 23) - _lhsOgathRules = - ({-# LINE 206 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 763 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 193, column 20) - _lhsOinhs = - ({-# LINE 193 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 769 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 192, column 19) - _lhsOnts = - ({-# LINE 192 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 775 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 613, column 40) - _lhsOsinglevisits = - ({-# LINE 613 "src-ag/Order.ag" #-} - [] - {-# LINE 781 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 638, column 38) - _lhsOterminals = - ({-# LINE 638 "src-ag/Order.ag" #-} - [] - {-# LINE 787 "src-ag/Order.hs" #-} - ) - in ( _lhsOattributes,_lhsOcollectChildrenInhs,_lhsOcollectChildrenSyns,_lhsOerrors,_lhsOfields,_lhsOgathAltAttrs,_lhsOgathRules,_lhsOinhs,_lhsOnts,_lhsOsinglevisits,_lhsOterminals))) ) --- Expression -------------------------------------------------- -{- - visit 0: - inherited attributes: - allfields : [(Identifier,Type,Maybe (Maybe Type))] - allnts : [Identifier] - attrs : [(Identifier,Identifier)] - con : Identifier - mergeMap : Map Identifier (Identifier,[Identifier]) - nt : Identifier - synthesized attributes: - allRhsVars : Set (Identifier,Identifier) - copy : SELF - errors : Seq Error - textLines : [String] - usedAttrs : [(Identifier,Identifier)] - usedFields : [Identifier] - usedLocals : [Identifier] - alternatives: - alternative Expression: - child pos : {Pos} - child tks : {[HsToken]} - visit 0: - local _tup1 : _ - 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,Maybe (Maybe Type))]) -> - ([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,Maybe (Maybe Type))])),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 466, column 21) - __tup1 = - ({-# LINE 466 "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 882 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 466, column 21) - (_textLines,_,_,_) = - ({-# LINE 466 "src-ag/Order.ag" #-} - __tup1 - {-# LINE 888 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 466, column 21) - (_,_usedAttrs,_,_) = - ({-# LINE 466 "src-ag/Order.ag" #-} - __tup1 - {-# LINE 894 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 466, column 21) - (_,_,_usedLocals,_) = - ({-# LINE 466 "src-ag/Order.ag" #-} - __tup1 - {-# LINE 900 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 466, column 21) - (_,_,_,_usedFields) = - ({-# LINE 466 "src-ag/Order.ag" #-} - __tup1 - {-# LINE 906 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 489, column 17) - _lhsOerrors = - ({-# LINE 489 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 912 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 490, column 17) - _lhsOallRhsVars = - ({-# LINE 490 "src-ag/Order.ag" #-} - Set.fromList _usedAttrs - `Set.union` - Set.fromList [ (_LOC, l) | l <- _usedLocals ] - `Set.union` - Set.fromList [ (_FIELD, fld) | fld <- _usedFields ] - {-# LINE 922 "src-ag/Order.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 457 "src-ag/Order.ag" #-} - Expression pos_ tks_ - {-# LINE 928 "src-ag/Order.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 457 "src-ag/Order.ag" #-} - _copy - {-# LINE 934 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _lhsOtextLines = - ({-# LINE 456 "src-ag/Order.ag" #-} - _textLines - {-# LINE 940 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _lhsOusedAttrs = - ({-# LINE 454 "src-ag/Order.ag" #-} - _usedAttrs - {-# LINE 946 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _lhsOusedFields = - ({-# LINE 455 "src-ag/Order.ag" #-} - _usedFields - {-# LINE 952 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _lhsOusedLocals = - ({-# LINE 453 "src-ag/Order.ag" #-} - _usedLocals - {-# LINE 958 "src-ag/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 _tup2 : _ - 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]) - _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) - _nontsIinstDep :: (Seq Edge) - _nontsImergeDep :: (Seq Edge) - _nontsInAutoRules :: Int - _nontsInExplicitRules :: Int - _nontsInonts :: ([(NontermIdent,[ConstructorIdent])]) - _nontsIntattrs :: (Seq (Vertex,NTAttr)) - _nontsIrules :: (Seq (Vertex,CRule)) - _nontsIvcount :: Int - -- "src-ag/Order.ag"(line 123, column 17) - _o_dovisit = - ({-# LINE 123 "src-ag/Order.ag" #-} - visit _lhsIoptions && null _cyclesErrors - {-# LINE 1081 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 124, column 17) - _nontsOo_cata = - ({-# LINE 124 "src-ag/Order.ag" #-} - folds _lhsIoptions - {-# LINE 1087 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 124, column 17) - _nontsOo_data = - ({-# LINE 125 "src-ag/Order.ag" #-} - dataTypes _lhsIoptions - {-# LINE 1093 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 124, column 17) - _nontsOo_sig = - ({-# LINE 126 "src-ag/Order.ag" #-} - typeSigs _lhsIoptions - {-# LINE 1099 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 124, column 17) - _nontsOo_sem = - ({-# LINE 127 "src-ag/Order.ag" #-} - semfuns _lhsIoptions - {-# LINE 1105 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 124, column 17) - _nontsOo_rename = - ({-# LINE 128 "src-ag/Order.ag" #-} - rename _lhsIoptions - {-# LINE 1111 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 124, column 17) - _nontsOo_newtypes = - ({-# LINE 129 "src-ag/Order.ag" #-} - newtypes _lhsIoptions - {-# LINE 1117 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 124, column 17) - _nontsOo_wantvisit = - ({-# LINE 130 "src-ag/Order.ag" #-} - visit _lhsIoptions - {-# LINE 1123 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 124, column 17) - _nontsOo_unbox = - ({-# LINE 131 "src-ag/Order.ag" #-} - unbox _lhsIoptions - {-# LINE 1129 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 124, column 17) - _nontsOo_case = - ({-# LINE 132 "src-ag/Order.ag" #-} - cases _lhsIoptions - {-# LINE 1135 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 124, column 17) - _nontsOprefix = - ({-# LINE 133 "src-ag/Order.ag" #-} - prefix _lhsIoptions - {-# LINE 1141 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 261, column 15) - _nontsOvcount = - ({-# LINE 261 "src-ag/Order.ag" #-} - 0 - {-# LINE 1147 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 287, column 7) - _nontsOmanualAttrDepMap = - ({-# LINE 287 "src-ag/Order.ag" #-} - manualAttrOrderMap_ - {-# LINE 1153 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 416, column 14) - _nontsOaroundMap = - ({-# LINE 416 "src-ag/Order.ag" #-} - aroundsMap_ - {-# LINE 1159 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 505, column 13) - _nontsOacount = - ({-# LINE 505 "src-ag/Order.ag" #-} - 0 - {-# LINE 1165 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 543, column 13) - _ruleTable = - ({-# LINE 543 "src-ag/Order.ag" #-} - Array.array (0,_nontsIvcount-1) (toList _nontsIrules) - {-# LINE 1171 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 544, column 13) - _attrTable = - ({-# LINE 544 "src-ag/Order.ag" #-} - Array.array (0,_nontsIacount-1) (toList _nontsIntattrs) - {-# LINE 1177 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 545, column 13) - _attrVertex = - ({-# LINE 545 "src-ag/Order.ag" #-} - Map.fromList (map swap (toList _nontsIntattrs)) - {-# LINE 1183 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 546, column 13) - _tdpToTds = - ({-# LINE 546 "src-ag/Order.ag" #-} - [ (s, maybe (-1) (\v -> findWithErr1 "Grammar.tdpToTds" v _attrVertex) (ntattr cr)) - | (s,cr) <- toList _nontsIrules] - {-# LINE 1190 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 548, column 13) - _tdsToTdp = - ({-# LINE 548 "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 1199 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 552, column 13) - _directDep = - ({-# LINE 552 "src-ag/Order.ag" #-} - toList (_nontsIdirectDep Seq.>< _nontsIadditionalDep) - {-# LINE 1205 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 553, column 13) - _instDep = - ({-# LINE 553 "src-ag/Order.ag" #-} - toList _nontsIinstDep - {-# LINE 1211 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 554, column 13) - _aroundDep = - ({-# LINE 554 "src-ag/Order.ag" #-} - toList _nontsIaroundDep - {-# LINE 1217 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 555, column 13) - _mergeDep = - ({-# LINE 555 "src-ag/Order.ag" #-} - toList _nontsImergeDep - {-# LINE 1223 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 556, column 13) - _info = - ({-# LINE 556 "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 1238 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 567, column 17) - __tup2 = - ({-# LINE 567 "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 1264 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 567, column 17) - (_cInterfaceMap,_,_) = - ({-# LINE 567 "src-ag/Order.ag" #-} - __tup2 - {-# LINE 1270 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 567, column 17) - (_,_cVisitsMap,_) = - ({-# LINE 567 "src-ag/Order.ag" #-} - __tup2 - {-# LINE 1276 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 567, column 17) - (_,_,_cyclesErrors) = - ({-# LINE 567 "src-ag/Order.ag" #-} - __tup2 - {-# LINE 1282 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 589, column 13) - _lhsOerrors = - ({-# LINE 589 "src-ag/Order.ag" #-} - (if withCycle _lhsIoptions then Seq.fromList _cyclesErrors else Seq.empty) - Seq.>< _nontsIerrors - {-# LINE 1289 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 621, column 15) - _lhsOoutput = - ({-# LINE 621 "src-ag/Order.ag" #-} - CGrammar typeSyns_ derivings_ wrappers_ _nontsIcNonterminals pragmas_ paramMap_ contextMap_ quantMap_ _aroundMap _mergeMap _o_dovisit - {-# LINE 1295 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 634, column 14) - _aroundMap = - ({-# LINE 634 "src-ag/Order.ag" #-} - Map.map (Map.map Map.keysSet) aroundsMap_ - {-# LINE 1301 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 635, column 14) - _mergeMap = - ({-# LINE 635 "src-ag/Order.ag" #-} - Map.map (Map.map (Map.map (\(nt,srcs,_) -> (nt,srcs)))) mergeMap_ - {-# LINE 1307 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 652, column 13) - _nontsOallnts = - ({-# LINE 652 "src-ag/Order.ag" #-} - map fst (_nontsInonts) - {-# LINE 1313 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnAutoRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - _nontsInAutoRules - {-# LINE 1319 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnExplicitRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - _nontsInExplicitRules - {-# LINE 1325 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _nontsOcInterfaceMap = - ({-# LINE 596 "src-ag/Order.ag" #-} - _cInterfaceMap - {-# LINE 1331 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _nontsOcVisitsMap = - ({-# LINE 603 "src-ag/Order.ag" #-} - _cVisitsMap - {-# LINE 1337 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _nontsOmergeMap = - ({-# LINE 354 "src-ag/Order.ag" #-} - _mergeMap - {-# LINE 1343 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _nontsOo_dovisit = - ({-# LINE 116 "src-ag/Order.ag" #-} - _o_dovisit - {-# LINE 1349 "src-ag/Order.hs" #-} - ) - ( _nontsIacount,_nontsIadditionalDep,_nontsIaranges,_nontsIaroundDep,_nontsIcNonterminals,_nontsIdirectDep,_nontsIerrors,_nontsIinstDep,_nontsImergeDep,_nontsInAutoRules,_nontsInExplicitRules,_nontsInonts,_nontsIntattrs,_nontsIrules,_nontsIvcount) = - nonts_ _nontsOacount _nontsOallnts _nontsOaroundMap _nontsOcInterfaceMap _nontsOcVisitsMap _nontsOmanualAttrDepMap _nontsOmergeMap _nontsOo_case _nontsOo_cata _nontsOo_data _nontsOo_dovisit _nontsOo_newtypes _nontsOo_rename _nontsOo_sem _nontsOo_sig _nontsOo_unbox _nontsOo_wantvisit _nontsOprefix _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 - 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 - 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 - instDep : Seq Edge - mergeDep : Seq Edge - nAutoRules : Int - nExplicitRules : Int - nonts : [(NontermIdent,[ConstructorIdent])] - ntattrs : Seq (Vertex,NTAttr) - rules : Seq (Vertex,CRule) - 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 -> - AttrOrderMap -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - String -> - Int -> - ( Int,(Seq Edge),(Seq (Int,Int,Int)),(Seq Edge),CNonterminal,(Seq Edge),(Seq Error),(Seq Edge),(Seq Edge),Int,Int,([(NontermIdent,[ConstructorIdent])]),(Seq (Vertex,NTAttr)),(Seq (Vertex,CRule)),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),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),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)),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))),vcount_Syn_Nonterminal :: !(Int)} -wrap_Nonterminal :: T_Nonterminal -> - Inh_Nonterminal -> - Syn_Nonterminal -wrap_Nonterminal (T_Nonterminal sem ) (Inh_Nonterminal _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount ) = - (let ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOaroundDep,_lhsOcNonterminal,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount) = sem _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount - in (Syn_Nonterminal _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOaroundDep _lhsOcNonterminal _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOnonts _lhsOntattrs _lhsOrules _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 - _lhsImanualAttrDepMap - _lhsImergeMap - _lhsIo_case - _lhsIo_cata - _lhsIo_data - _lhsIo_dovisit - _lhsIo_newtypes - _lhsIo_rename - _lhsIo_sem - _lhsIo_sig - _lhsIo_unbox - _lhsIo_wantvisit - _lhsIprefix - _lhsIvcount -> - (let _prodsOnt :: Identifier - _prodsOinh :: Attributes - _prodsOsyn :: Attributes - _lhsOntattrs :: (Seq (Vertex,NTAttr)) - _lhsOacount :: Int - _lhsOaranges :: (Seq (Int,Int,Int)) - _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])]) - _lhsOcNonterminal :: CNonterminal - _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 - _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 - _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 97, column 17) - _prodsOnt = - ({-# LINE 97 "src-ag/Order.ag" #-} - nt_ - {-# LINE 1515 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 100, column 17) - _prodsOinh = - ({-# LINE 100 "src-ag/Order.ag" #-} - inh_ - {-# LINE 1521 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 101, column 17) - _prodsOsyn = - ({-# LINE 101 "src-ag/Order.ag" #-} - syn_ - {-# LINE 1527 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 359, column 32) - _mergeMap = - ({-# LINE 359 "src-ag/Order.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsImergeMap - {-# LINE 1533 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 412, column 32) - _aroundMap = - ({-# LINE 412 "src-ag/Order.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsIaroundMap - {-# LINE 1539 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 508, column 17) - _ntattrs = - ({-# LINE 508 "src-ag/Order.ag" #-} - [ NTAInh nt_ inh tp | (inh,tp) <- Map.assocs inh_ ] - ++ [NTASyn nt_ syn tp | (syn,tp) <- Map.assocs syn_ ] - {-# LINE 1546 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 510, column 17) - _lhsOntattrs = - ({-# LINE 510 "src-ag/Order.ag" #-} - Seq.fromList (zip [_lhsIacount ..] _ntattrs) - {-# LINE 1552 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 511, column 17) - _lhsOacount = - ({-# LINE 511 "src-ag/Order.ag" #-} - _lhsIacount + Map.size inh_ + Map.size syn_ - {-# LINE 1558 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 512, column 17) - _lhsOaranges = - ({-# LINE 512 "src-ag/Order.ag" #-} - Seq.singleton - (_lhsIacount - ,_lhsIacount + Map.size inh_ - ,_lhsIacount + Map.size syn_ + Map.size inh_ - 1) - {-# LINE 1567 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 521, column 19) - _lhsOnonts = - ({-# LINE 521 "src-ag/Order.ag" #-} - [(nt_,_prodsIcons)] - {-# LINE 1573 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 598, column 19) - _cInter = - ({-# LINE 598 "src-ag/Order.ag" #-} - if _lhsIo_dovisit - then findWithErr1 "Nonterminal.cInter" nt_ _lhsIcInterfaceMap - else CInterface [CSegment inh_ syn_] - {-# LINE 1581 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 626, column 19) - _lhsOcNonterminal = - ({-# LINE 626 "src-ag/Order.ag" #-} - CNonterminal nt_ params_ inh_ syn_ _prodsIcProductions _cInter - {-# LINE 1587 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 283, column 60) - _lhsOadditionalDep = - ({-# LINE 283 "src-ag/Order.ag" #-} - _prodsIadditionalDep - {-# LINE 1593 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 404, column 24) - _lhsOaroundDep = - ({-# LINE 404 "src-ag/Order.ag" #-} - _prodsIaroundDep - {-# LINE 1599 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 269, column 33) - _lhsOdirectDep = - ({-# LINE 269 "src-ag/Order.ag" #-} - _prodsIdirectDep - {-# LINE 1605 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - _prodsIerrors - {-# LINE 1611 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 312, column 31) - _lhsOinstDep = - ({-# LINE 312 "src-ag/Order.ag" #-} - _prodsIinstDep - {-# LINE 1617 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 367, column 18) - _lhsOmergeDep = - ({-# LINE 367 "src-ag/Order.ag" #-} - _prodsImergeDep - {-# LINE 1623 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnAutoRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - _prodsInAutoRules - {-# LINE 1629 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnExplicitRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - _prodsInExplicitRules - {-# LINE 1635 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 259, column 18) - _lhsOrules = - ({-# LINE 259 "src-ag/Order.ag" #-} - _prodsIrules - {-# LINE 1641 "src-ag/Order.hs" #-} - ) - -- copy rule (up) - _lhsOvcount = - ({-# LINE 258 "src-ag/Order.ag" #-} - _prodsIvcount - {-# LINE 1647 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _prodsOallnts = - ({-# LINE 649 "src-ag/Order.ag" #-} - _lhsIallnts - {-# LINE 1653 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _prodsOaroundMap = - ({-# LINE 410 "src-ag/Order.ag" #-} - _aroundMap - {-# LINE 1659 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _prodsOcVisitsMap = - ({-# LINE 603 "src-ag/Order.ag" #-} - _lhsIcVisitsMap - {-# LINE 1665 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _prodsOmanualAttrDepMap = - ({-# LINE 283 "src-ag/Order.ag" #-} - _lhsImanualAttrDepMap - {-# LINE 1671 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _prodsOmergeMap = - ({-# LINE 357 "src-ag/Order.ag" #-} - _mergeMap - {-# LINE 1677 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _prodsOo_case = - ({-# LINE 117 "src-ag/Order.ag" #-} - _lhsIo_case - {-# LINE 1683 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _prodsOo_cata = - ({-# LINE 111 "src-ag/Order.ag" #-} - _lhsIo_cata - {-# LINE 1689 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _prodsOo_dovisit = - ({-# LINE 116 "src-ag/Order.ag" #-} - _lhsIo_dovisit - {-# LINE 1695 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _prodsOo_newtypes = - ({-# LINE 110 "src-ag/Order.ag" #-} - _lhsIo_newtypes - {-# LINE 1701 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _prodsOo_rename = - ({-# LINE 114 "src-ag/Order.ag" #-} - _lhsIo_rename - {-# LINE 1707 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _prodsOo_sem = - ({-# LINE 113 "src-ag/Order.ag" #-} - _lhsIo_sem - {-# LINE 1713 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _prodsOo_sig = - ({-# LINE 112 "src-ag/Order.ag" #-} - _lhsIo_sig - {-# LINE 1719 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _prodsOo_unbox = - ({-# LINE 119 "src-ag/Order.ag" #-} - _lhsIo_unbox - {-# LINE 1725 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _prodsOo_wantvisit = - ({-# LINE 115 "src-ag/Order.ag" #-} - _lhsIo_wantvisit - {-# LINE 1731 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _prodsOprefix = - ({-# LINE 118 "src-ag/Order.ag" #-} - _lhsIprefix - {-# LINE 1737 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _prodsOvcount = - ({-# LINE 258 "src-ag/Order.ag" #-} - _lhsIvcount - {-# LINE 1743 "src-ag/Order.hs" #-} - ) - ( _prodsIadditionalDep,_prodsIaroundDep,_prodsIcProductions,_prodsIcons,_prodsIdirectDep,_prodsIerrors,_prodsIinstDep,_prodsImergeDep,_prodsInAutoRules,_prodsInExplicitRules,_prodsIrules,_prodsIvcount) = - prods_ _prodsOallnts _prodsOaroundMap _prodsOcVisitsMap _prodsOinh _prodsOmanualAttrDepMap _prodsOmergeMap _prodsOnt _prodsOo_case _prodsOo_cata _prodsOo_dovisit _prodsOo_newtypes _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_unbox _prodsOo_wantvisit _prodsOprefix _prodsOsyn _prodsOvcount - in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOaroundDep,_lhsOcNonterminal,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount))) ) --- Nonterminals ------------------------------------------------ -{- - visit 0: - inherited attributes: - allnts : [Identifier] - aroundMap : Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - cInterfaceMap : CInterfaceMap - cVisitsMap : CVisitsMap - 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 - 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 - instDep : Seq Edge - mergeDep : Seq Edge - nAutoRules : Int - nExplicitRules : Int - nonts : [(NontermIdent,[ConstructorIdent])] - ntattrs : Seq (Vertex,NTAttr) - rules : Seq (Vertex,CRule) - 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 -> - AttrOrderMap -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - String -> - Int -> - ( Int,(Seq Edge),(Seq (Int,Int,Int)),(Seq Edge),CNonterminals,(Seq Edge),(Seq Error),(Seq Edge),(Seq Edge),Int,Int,([(NontermIdent,[ConstructorIdent])]),(Seq (Vertex,NTAttr)),(Seq (Vertex,CRule)),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),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),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)),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))),vcount_Syn_Nonterminals :: !(Int)} -wrap_Nonterminals :: T_Nonterminals -> - Inh_Nonterminals -> - Syn_Nonterminals -wrap_Nonterminals (T_Nonterminals sem ) (Inh_Nonterminals _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount ) = - (let ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOaroundDep,_lhsOcNonterminals,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount) = sem _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIvcount - in (Syn_Nonterminals _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOaroundDep _lhsOcNonterminals _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOnonts _lhsOntattrs _lhsOrules _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 - _lhsImanualAttrDepMap - _lhsImergeMap - _lhsIo_case - _lhsIo_cata - _lhsIo_data - _lhsIo_dovisit - _lhsIo_newtypes - _lhsIo_rename - _lhsIo_sem - _lhsIo_sig - _lhsIo_unbox - _lhsIo_wantvisit - _lhsIprefix - _lhsIvcount -> - (let _lhsOcNonterminals :: CNonterminals - _lhsOadditionalDep :: (Seq Edge) - _lhsOaranges :: (Seq (Int,Int,Int)) - _lhsOaroundDep :: (Seq Edge) - _lhsOdirectDep :: (Seq Edge) - _lhsOerrors :: (Seq Error) - _lhsOinstDep :: (Seq Edge) - _lhsOmergeDep :: (Seq Edge) - _lhsOnAutoRules :: Int - _lhsOnExplicitRules :: Int - _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])]) - _lhsOntattrs :: (Seq (Vertex,NTAttr)) - _lhsOrules :: (Seq (Vertex,CRule)) - _lhsOacount :: Int - _lhsOvcount :: Int - _hdOacount :: Int - _hdOallnts :: ([Identifier]) - _hdOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) - _hdOcInterfaceMap :: CInterfaceMap - _hdOcVisitsMap :: CVisitsMap - _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 - _hdOvcount :: Int - _tlOacount :: Int - _tlOallnts :: ([Identifier]) - _tlOaroundMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) - _tlOcInterfaceMap :: CInterfaceMap - _tlOcVisitsMap :: CVisitsMap - _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 - _tlOvcount :: Int - _hdIacount :: Int - _hdIadditionalDep :: (Seq Edge) - _hdIaranges :: (Seq (Int,Int,Int)) - _hdIaroundDep :: (Seq Edge) - _hdIcNonterminal :: CNonterminal - _hdIdirectDep :: (Seq Edge) - _hdIerrors :: (Seq Error) - _hdIinstDep :: (Seq Edge) - _hdImergeDep :: (Seq Edge) - _hdInAutoRules :: Int - _hdInExplicitRules :: Int - _hdInonts :: ([(NontermIdent,[ConstructorIdent])]) - _hdIntattrs :: (Seq (Vertex,NTAttr)) - _hdIrules :: (Seq (Vertex,CRule)) - _hdIvcount :: Int - _tlIacount :: Int - _tlIadditionalDep :: (Seq Edge) - _tlIaranges :: (Seq (Int,Int,Int)) - _tlIaroundDep :: (Seq Edge) - _tlIcNonterminals :: CNonterminals - _tlIdirectDep :: (Seq Edge) - _tlIerrors :: (Seq Error) - _tlIinstDep :: (Seq Edge) - _tlImergeDep :: (Seq Edge) - _tlInAutoRules :: Int - _tlInExplicitRules :: Int - _tlInonts :: ([(NontermIdent,[ConstructorIdent])]) - _tlIntattrs :: (Seq (Vertex,NTAttr)) - _tlIrules :: (Seq (Vertex,CRule)) - _tlIvcount :: Int - -- "src-ag/Order.ag"(line 623, column 12) - _lhsOcNonterminals = - ({-# LINE 623 "src-ag/Order.ag" #-} - _hdIcNonterminal : _tlIcNonterminals - {-# LINE 1936 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 283, column 60) - _lhsOadditionalDep = - ({-# LINE 283 "src-ag/Order.ag" #-} - _hdIadditionalDep Seq.>< _tlIadditionalDep - {-# LINE 1942 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 502, column 36) - _lhsOaranges = - ({-# LINE 502 "src-ag/Order.ag" #-} - _hdIaranges Seq.>< _tlIaranges - {-# LINE 1948 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 404, column 24) - _lhsOaroundDep = - ({-# LINE 404 "src-ag/Order.ag" #-} - _hdIaroundDep Seq.>< _tlIaroundDep - {-# LINE 1954 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 269, column 33) - _lhsOdirectDep = - ({-# LINE 269 "src-ag/Order.ag" #-} - _hdIdirectDep Seq.>< _tlIdirectDep - {-# LINE 1960 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 1966 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 312, column 31) - _lhsOinstDep = - ({-# LINE 312 "src-ag/Order.ag" #-} - _hdIinstDep Seq.>< _tlIinstDep - {-# LINE 1972 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 367, column 18) - _lhsOmergeDep = - ({-# LINE 367 "src-ag/Order.ag" #-} - _hdImergeDep Seq.>< _tlImergeDep - {-# LINE 1978 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnAutoRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - _hdInAutoRules + _tlInAutoRules - {-# LINE 1984 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnExplicitRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - _hdInExplicitRules + _tlInExplicitRules - {-# LINE 1990 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 519, column 43) - _lhsOnonts = - ({-# LINE 519 "src-ag/Order.ag" #-} - _hdInonts ++ _tlInonts - {-# LINE 1996 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 501, column 35) - _lhsOntattrs = - ({-# LINE 501 "src-ag/Order.ag" #-} - _hdIntattrs Seq.>< _tlIntattrs - {-# LINE 2002 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 259, column 18) - _lhsOrules = - ({-# LINE 259 "src-ag/Order.ag" #-} - _hdIrules Seq.>< _tlIrules - {-# LINE 2008 "src-ag/Order.hs" #-} - ) - -- copy rule (up) - _lhsOacount = - ({-# LINE 501 "src-ag/Order.ag" #-} - _tlIacount - {-# LINE 2014 "src-ag/Order.hs" #-} - ) - -- copy rule (up) - _lhsOvcount = - ({-# LINE 258 "src-ag/Order.ag" #-} - _tlIvcount - {-# LINE 2020 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOacount = - ({-# LINE 501 "src-ag/Order.ag" #-} - _lhsIacount - {-# LINE 2026 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOallnts = - ({-# LINE 649 "src-ag/Order.ag" #-} - _lhsIallnts - {-# LINE 2032 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOaroundMap = - ({-# LINE 407 "src-ag/Order.ag" #-} - _lhsIaroundMap - {-# LINE 2038 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOcInterfaceMap = - ({-# LINE 596 "src-ag/Order.ag" #-} - _lhsIcInterfaceMap - {-# LINE 2044 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOcVisitsMap = - ({-# LINE 603 "src-ag/Order.ag" #-} - _lhsIcVisitsMap - {-# LINE 2050 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOmanualAttrDepMap = - ({-# LINE 283 "src-ag/Order.ag" #-} - _lhsImanualAttrDepMap - {-# LINE 2056 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOmergeMap = - ({-# LINE 354 "src-ag/Order.ag" #-} - _lhsImergeMap - {-# LINE 2062 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_case = - ({-# LINE 117 "src-ag/Order.ag" #-} - _lhsIo_case - {-# LINE 2068 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_cata = - ({-# LINE 111 "src-ag/Order.ag" #-} - _lhsIo_cata - {-# LINE 2074 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_data = - ({-# LINE 120 "src-ag/Order.ag" #-} - _lhsIo_data - {-# LINE 2080 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_dovisit = - ({-# LINE 116 "src-ag/Order.ag" #-} - _lhsIo_dovisit - {-# LINE 2086 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_newtypes = - ({-# LINE 110 "src-ag/Order.ag" #-} - _lhsIo_newtypes - {-# LINE 2092 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_rename = - ({-# LINE 114 "src-ag/Order.ag" #-} - _lhsIo_rename - {-# LINE 2098 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_sem = - ({-# LINE 113 "src-ag/Order.ag" #-} - _lhsIo_sem - {-# LINE 2104 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_sig = - ({-# LINE 112 "src-ag/Order.ag" #-} - _lhsIo_sig - {-# LINE 2110 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_unbox = - ({-# LINE 119 "src-ag/Order.ag" #-} - _lhsIo_unbox - {-# LINE 2116 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_wantvisit = - ({-# LINE 115 "src-ag/Order.ag" #-} - _lhsIo_wantvisit - {-# LINE 2122 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOprefix = - ({-# LINE 118 "src-ag/Order.ag" #-} - _lhsIprefix - {-# LINE 2128 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOvcount = - ({-# LINE 258 "src-ag/Order.ag" #-} - _lhsIvcount - {-# LINE 2134 "src-ag/Order.hs" #-} - ) - -- copy rule (chain) - _tlOacount = - ({-# LINE 501 "src-ag/Order.ag" #-} - _hdIacount - {-# LINE 2140 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOallnts = - ({-# LINE 649 "src-ag/Order.ag" #-} - _lhsIallnts - {-# LINE 2146 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOaroundMap = - ({-# LINE 407 "src-ag/Order.ag" #-} - _lhsIaroundMap - {-# LINE 2152 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOcInterfaceMap = - ({-# LINE 596 "src-ag/Order.ag" #-} - _lhsIcInterfaceMap - {-# LINE 2158 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOcVisitsMap = - ({-# LINE 603 "src-ag/Order.ag" #-} - _lhsIcVisitsMap - {-# LINE 2164 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOmanualAttrDepMap = - ({-# LINE 283 "src-ag/Order.ag" #-} - _lhsImanualAttrDepMap - {-# LINE 2170 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOmergeMap = - ({-# LINE 354 "src-ag/Order.ag" #-} - _lhsImergeMap - {-# LINE 2176 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_case = - ({-# LINE 117 "src-ag/Order.ag" #-} - _lhsIo_case - {-# LINE 2182 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_cata = - ({-# LINE 111 "src-ag/Order.ag" #-} - _lhsIo_cata - {-# LINE 2188 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_data = - ({-# LINE 120 "src-ag/Order.ag" #-} - _lhsIo_data - {-# LINE 2194 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_dovisit = - ({-# LINE 116 "src-ag/Order.ag" #-} - _lhsIo_dovisit - {-# LINE 2200 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_newtypes = - ({-# LINE 110 "src-ag/Order.ag" #-} - _lhsIo_newtypes - {-# LINE 2206 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_rename = - ({-# LINE 114 "src-ag/Order.ag" #-} - _lhsIo_rename - {-# LINE 2212 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_sem = - ({-# LINE 113 "src-ag/Order.ag" #-} - _lhsIo_sem - {-# LINE 2218 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_sig = - ({-# LINE 112 "src-ag/Order.ag" #-} - _lhsIo_sig - {-# LINE 2224 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_unbox = - ({-# LINE 119 "src-ag/Order.ag" #-} - _lhsIo_unbox - {-# LINE 2230 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_wantvisit = - ({-# LINE 115 "src-ag/Order.ag" #-} - _lhsIo_wantvisit - {-# LINE 2236 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOprefix = - ({-# LINE 118 "src-ag/Order.ag" #-} - _lhsIprefix - {-# LINE 2242 "src-ag/Order.hs" #-} - ) - -- copy rule (chain) - _tlOvcount = - ({-# LINE 258 "src-ag/Order.ag" #-} - _hdIvcount - {-# LINE 2248 "src-ag/Order.hs" #-} - ) - ( _hdIacount,_hdIadditionalDep,_hdIaranges,_hdIaroundDep,_hdIcNonterminal,_hdIdirectDep,_hdIerrors,_hdIinstDep,_hdImergeDep,_hdInAutoRules,_hdInExplicitRules,_hdInonts,_hdIntattrs,_hdIrules,_hdIvcount) = - hd_ _hdOacount _hdOallnts _hdOaroundMap _hdOcInterfaceMap _hdOcVisitsMap _hdOmanualAttrDepMap _hdOmergeMap _hdOo_case _hdOo_cata _hdOo_data _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_unbox _hdOo_wantvisit _hdOprefix _hdOvcount - ( _tlIacount,_tlIadditionalDep,_tlIaranges,_tlIaroundDep,_tlIcNonterminals,_tlIdirectDep,_tlIerrors,_tlIinstDep,_tlImergeDep,_tlInAutoRules,_tlInExplicitRules,_tlInonts,_tlIntattrs,_tlIrules,_tlIvcount) = - tl_ _tlOacount _tlOallnts _tlOaroundMap _tlOcInterfaceMap _tlOcVisitsMap _tlOmanualAttrDepMap _tlOmergeMap _tlOo_case _tlOo_cata _tlOo_data _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_unbox _tlOo_wantvisit _tlOprefix _tlOvcount - in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOaroundDep,_lhsOcNonterminals,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOnonts,_lhsOntattrs,_lhsOrules,_lhsOvcount))) ) -sem_Nonterminals_Nil :: T_Nonterminals -sem_Nonterminals_Nil = - (T_Nonterminals (\ _lhsIacount - _lhsIallnts - _lhsIaroundMap - _lhsIcInterfaceMap - _lhsIcVisitsMap - _lhsImanualAttrDepMap - _lhsImergeMap - _lhsIo_case - _lhsIo_cata - _lhsIo_data - _lhsIo_dovisit - _lhsIo_newtypes - _lhsIo_rename - _lhsIo_sem - _lhsIo_sig - _lhsIo_unbox - _lhsIo_wantvisit - _lhsIprefix - _lhsIvcount -> - (let _lhsOcNonterminals :: CNonterminals - _lhsOadditionalDep :: (Seq Edge) - _lhsOaranges :: (Seq (Int,Int,Int)) - _lhsOaroundDep :: (Seq Edge) - _lhsOdirectDep :: (Seq Edge) - _lhsOerrors :: (Seq Error) - _lhsOinstDep :: (Seq Edge) - _lhsOmergeDep :: (Seq Edge) - _lhsOnAutoRules :: Int - _lhsOnExplicitRules :: Int - _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])]) - _lhsOntattrs :: (Seq (Vertex,NTAttr)) - _lhsOrules :: (Seq (Vertex,CRule)) - _lhsOacount :: Int - _lhsOvcount :: Int - -- "src-ag/Order.ag"(line 624, column 12) - _lhsOcNonterminals = - ({-# LINE 624 "src-ag/Order.ag" #-} - [] - {-# LINE 2295 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 283, column 60) - _lhsOadditionalDep = - ({-# LINE 283 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 2301 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 502, column 36) - _lhsOaranges = - ({-# LINE 502 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 2307 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 404, column 24) - _lhsOaroundDep = - ({-# LINE 404 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 2313 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 269, column 33) - _lhsOdirectDep = - ({-# LINE 269 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 2319 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 2325 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 312, column 31) - _lhsOinstDep = - ({-# LINE 312 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 2331 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 367, column 18) - _lhsOmergeDep = - ({-# LINE 367 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 2337 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnAutoRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - 0 - {-# LINE 2343 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnExplicitRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - 0 - {-# LINE 2349 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 519, column 43) - _lhsOnonts = - ({-# LINE 519 "src-ag/Order.ag" #-} - [] - {-# LINE 2355 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 501, column 35) - _lhsOntattrs = - ({-# LINE 501 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 2361 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 259, column 18) - _lhsOrules = - ({-# LINE 259 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 2367 "src-ag/Order.hs" #-} - ) - -- copy rule (chain) - _lhsOacount = - ({-# LINE 501 "src-ag/Order.ag" #-} - _lhsIacount - {-# LINE 2373 "src-ag/Order.hs" #-} - ) - -- copy rule (chain) - _lhsOvcount = - ({-# LINE 258 "src-ag/Order.ag" #-} - _lhsIvcount - {-# LINE 2379 "src-ag/Order.hs" #-} - ) - in ( _lhsOacount,_lhsOadditionalDep,_lhsOaranges,_lhsOaroundDep,_lhsOcNonterminals,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOnonts,_lhsOntattrs,_lhsOrules,_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 : SELF - errors : Seq Error - gathAltAttrs : [AltAttr] - instVars : [Identifier] - locVars : [Identifier] - patternAttrs : [(Identifier,Identifier,Bool,Patterns)] - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern (Alias _field _attr _pat _parts ) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) -sem_Pattern (Constr _name _pats ) = - (sem_Pattern_Constr _name (sem_Patterns _pats ) ) -sem_Pattern (Irrefutable _pat ) = - (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) -sem_Pattern (Product _pos _pats ) = - (sem_Pattern_Product _pos (sem_Patterns _pats ) ) -sem_Pattern (Underscore _pos ) = - (sem_Pattern_Underscore _pos ) --- semantic domain -newtype T_Pattern = T_Pattern ((Map Identifier Type) -> - (Map AltAttr Vertex) -> - Identifier -> - Attributes -> - Identifier -> - Attributes -> - ( Pattern ,(Seq Error),([AltAttr]),([Identifier]),([Identifier]),([(Identifier,Identifier,Bool,Patterns)]))) -data Inh_Pattern = Inh_Pattern {allTypeSigs_Inh_Pattern :: !((Map Identifier Type)),altAttrs_Inh_Pattern :: !((Map AltAttr Vertex)),con_Inh_Pattern :: !(Identifier),inh_Inh_Pattern :: !(Attributes),nt_Inh_Pattern :: !(Identifier),syn_Inh_Pattern :: !(Attributes)} -data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern ),errors_Syn_Pattern :: !((Seq Error)),gathAltAttrs_Syn_Pattern :: !(([AltAttr])),instVars_Syn_Pattern :: !(([Identifier])),locVars_Syn_Pattern :: !(([Identifier])),patternAttrs_Syn_Pattern :: !(([(Identifier,Identifier,Bool,Patterns)]))} -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_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = - (T_Pattern (\ _lhsIallTypeSigs - _lhsIaltAttrs - _lhsIcon - _lhsIinh - _lhsInt - _lhsIsyn -> - (let _lhsOgathAltAttrs :: ([AltAttr]) - _lhsOpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) - _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 - _partsOallTypeSigs :: (Map Identifier Type) - _partsOaltAttrs :: (Map AltAttr Vertex) - _partsOcon :: Identifier - _partsOinh :: Attributes - _partsOnt :: Identifier - _partsOsyn :: Attributes - _patIcopy :: Pattern - _patIerrors :: (Seq Error) - _patIgathAltAttrs :: ([AltAttr]) - _patIinstVars :: ([Identifier]) - _patIlocVars :: ([Identifier]) - _patIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) - _partsIcopy :: Patterns - _partsIerrors :: (Seq Error) - _partsIgathAltAttrs :: ([AltAttr]) - _partsIinstVars :: ([Identifier]) - _partsIlocVars :: ([Identifier]) - _partsIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) - -- "src-ag/Order.ag"(line 184, column 12) - _lhsOgathAltAttrs = - ({-# LINE 184 "src-ag/Order.ag" #-} - [AltAttr field_ attr_ (field_ == _LOC || field_ == _INST)] - {-# LINE 2501 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 252, column 12) - _lhsOpatternAttrs = - ({-# LINE 252 "src-ag/Order.ag" #-} - [(field_,attr_,(field_ == _LOC || field_ == _INST),_partsIcopy)] - {-# LINE 2507 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 682, column 14) - _lhsOlocVars = - ({-# LINE 682 "src-ag/Order.ag" #-} - if field_ == _LOC - then [attr_] - else [] - {-# LINE 2515 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 685, column 14) - _lhsOinstVars = - ({-# LINE 685 "src-ag/Order.ag" #-} - if field_ == _INST - then [attr_] - else [] - {-# LINE 2523 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - _patIerrors Seq.>< _partsIerrors - {-# LINE 2529 "src-ag/Order.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 2535 "src-ag/Order.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 2541 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patOallTypeSigs = - ({-# LINE 535 "src-ag/Order.ag" #-} - _lhsIallTypeSigs - {-# LINE 2547 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patOaltAttrs = - ({-# LINE 186 "src-ag/Order.ag" #-} - _lhsIaltAttrs - {-# LINE 2553 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patOcon = - ({-# LINE 90 "src-ag/Order.ag" #-} - _lhsIcon - {-# LINE 2559 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 2565 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 2571 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 2577 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _partsOallTypeSigs = - ({-# LINE 535 "src-ag/Order.ag" #-} - _lhsIallTypeSigs - {-# LINE 2583 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _partsOaltAttrs = - ({-# LINE 186 "src-ag/Order.ag" #-} - _lhsIaltAttrs - {-# LINE 2589 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _partsOcon = - ({-# LINE 90 "src-ag/Order.ag" #-} - _lhsIcon - {-# LINE 2595 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _partsOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 2601 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _partsOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 2607 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _partsOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 2613 "src-ag/Order.hs" #-} - ) - ( _patIcopy,_patIerrors,_patIgathAltAttrs,_patIinstVars,_patIlocVars,_patIpatternAttrs) = - pat_ _patOallTypeSigs _patOaltAttrs _patOcon _patOinh _patOnt _patOsyn - ( _partsIcopy,_partsIerrors,_partsIgathAltAttrs,_partsIinstVars,_partsIlocVars,_partsIpatternAttrs) = - parts_ _partsOallTypeSigs _partsOaltAttrs _partsOcon _partsOinh _partsOnt _partsOsyn - in ( _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,Patterns)]) - _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,Patterns)]) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - _patsIerrors - {-# LINE 2652 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 170, column 68) - _lhsOgathAltAttrs = - ({-# LINE 170 "src-ag/Order.ag" #-} - _patsIgathAltAttrs - {-# LINE 2658 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 86) - _lhsOinstVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - _patsIinstVars - {-# LINE 2664 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 48) - _lhsOlocVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - _patsIlocVars - {-# LINE 2670 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 249, column 42) - _lhsOpatternAttrs = - ({-# LINE 249 "src-ag/Order.ag" #-} - _patsIpatternAttrs - {-# LINE 2676 "src-ag/Order.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 2682 "src-ag/Order.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 2688 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patsOallTypeSigs = - ({-# LINE 535 "src-ag/Order.ag" #-} - _lhsIallTypeSigs - {-# LINE 2694 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patsOaltAttrs = - ({-# LINE 186 "src-ag/Order.ag" #-} - _lhsIaltAttrs - {-# LINE 2700 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patsOcon = - ({-# LINE 90 "src-ag/Order.ag" #-} - _lhsIcon - {-# LINE 2706 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patsOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 2712 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patsOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 2718 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patsOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 2724 "src-ag/Order.hs" #-} - ) - ( _patsIcopy,_patsIerrors,_patsIgathAltAttrs,_patsIinstVars,_patsIlocVars,_patsIpatternAttrs) = - pats_ _patsOallTypeSigs _patsOaltAttrs _patsOcon _patsOinh _patsOnt _patsOsyn - 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,Patterns)]) - _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,Patterns)]) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - _patIerrors - {-# LINE 2760 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 170, column 68) - _lhsOgathAltAttrs = - ({-# LINE 170 "src-ag/Order.ag" #-} - _patIgathAltAttrs - {-# LINE 2766 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 86) - _lhsOinstVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - _patIinstVars - {-# LINE 2772 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 48) - _lhsOlocVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - _patIlocVars - {-# LINE 2778 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 249, column 42) - _lhsOpatternAttrs = - ({-# LINE 249 "src-ag/Order.ag" #-} - _patIpatternAttrs - {-# LINE 2784 "src-ag/Order.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 2790 "src-ag/Order.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 2796 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patOallTypeSigs = - ({-# LINE 535 "src-ag/Order.ag" #-} - _lhsIallTypeSigs - {-# LINE 2802 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patOaltAttrs = - ({-# LINE 186 "src-ag/Order.ag" #-} - _lhsIaltAttrs - {-# LINE 2808 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patOcon = - ({-# LINE 90 "src-ag/Order.ag" #-} - _lhsIcon - {-# LINE 2814 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 2820 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 2826 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 2832 "src-ag/Order.hs" #-} - ) - ( _patIcopy,_patIerrors,_patIgathAltAttrs,_patIinstVars,_patIlocVars,_patIpatternAttrs) = - pat_ _patOallTypeSigs _patOaltAttrs _patOcon _patOinh _patOnt _patOsyn - 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,Patterns)]) - _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,Patterns)]) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - _patsIerrors - {-# LINE 2869 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 170, column 68) - _lhsOgathAltAttrs = - ({-# LINE 170 "src-ag/Order.ag" #-} - _patsIgathAltAttrs - {-# LINE 2875 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 86) - _lhsOinstVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - _patsIinstVars - {-# LINE 2881 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 48) - _lhsOlocVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - _patsIlocVars - {-# LINE 2887 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 249, column 42) - _lhsOpatternAttrs = - ({-# LINE 249 "src-ag/Order.ag" #-} - _patsIpatternAttrs - {-# LINE 2893 "src-ag/Order.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 2899 "src-ag/Order.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 2905 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patsOallTypeSigs = - ({-# LINE 535 "src-ag/Order.ag" #-} - _lhsIallTypeSigs - {-# LINE 2911 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patsOaltAttrs = - ({-# LINE 186 "src-ag/Order.ag" #-} - _lhsIaltAttrs - {-# LINE 2917 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patsOcon = - ({-# LINE 90 "src-ag/Order.ag" #-} - _lhsIcon - {-# LINE 2923 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patsOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 2929 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patsOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 2935 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patsOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 2941 "src-ag/Order.hs" #-} - ) - ( _patsIcopy,_patsIerrors,_patsIgathAltAttrs,_patsIinstVars,_patsIlocVars,_patsIpatternAttrs) = - pats_ _patsOallTypeSigs _patsOaltAttrs _patsOcon _patsOinh _patsOnt _patsOsyn - 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,Patterns)]) - _lhsOcopy :: Pattern - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 2965 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 170, column 68) - _lhsOgathAltAttrs = - ({-# LINE 170 "src-ag/Order.ag" #-} - [] - {-# LINE 2971 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 86) - _lhsOinstVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - [] - {-# LINE 2977 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 48) - _lhsOlocVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - [] - {-# LINE 2983 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 249, column 42) - _lhsOpatternAttrs = - ({-# LINE 249 "src-ag/Order.ag" #-} - [] - {-# LINE 2989 "src-ag/Order.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Underscore pos_ - {-# LINE 2995 "src-ag/Order.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3001 "src-ag/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 : SELF - errors : Seq Error - gathAltAttrs : [AltAttr] - instVars : [Identifier] - locVars : [Identifier] - patternAttrs : [(Identifier,Identifier,Bool,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 ((Map Identifier Type) -> - (Map AltAttr Vertex) -> - Identifier -> - Attributes -> - Identifier -> - Attributes -> - ( Patterns ,(Seq Error),([AltAttr]),([Identifier]),([Identifier]),([(Identifier,Identifier,Bool,Patterns)]))) -data Inh_Patterns = Inh_Patterns {allTypeSigs_Inh_Patterns :: !((Map Identifier Type)),altAttrs_Inh_Patterns :: !((Map AltAttr Vertex)),con_Inh_Patterns :: !(Identifier),inh_Inh_Patterns :: !(Attributes),nt_Inh_Patterns :: !(Identifier),syn_Inh_Patterns :: !(Attributes)} -data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns ),errors_Syn_Patterns :: !((Seq Error)),gathAltAttrs_Syn_Patterns :: !(([AltAttr])),instVars_Syn_Patterns :: !(([Identifier])),locVars_Syn_Patterns :: !(([Identifier])),patternAttrs_Syn_Patterns :: !(([(Identifier,Identifier,Bool,Patterns)]))} -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,Patterns)]) - _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,Patterns)]) - _tlIcopy :: Patterns - _tlIerrors :: (Seq Error) - _tlIgathAltAttrs :: ([AltAttr]) - _tlIinstVars :: ([Identifier]) - _tlIlocVars :: ([Identifier]) - _tlIpatternAttrs :: ([(Identifier,Identifier,Bool,Patterns)]) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 3096 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 170, column 68) - _lhsOgathAltAttrs = - ({-# LINE 170 "src-ag/Order.ag" #-} - _hdIgathAltAttrs ++ _tlIgathAltAttrs - {-# LINE 3102 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 86) - _lhsOinstVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - _hdIinstVars ++ _tlIinstVars - {-# LINE 3108 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 48) - _lhsOlocVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - _hdIlocVars ++ _tlIlocVars - {-# LINE 3114 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 249, column 42) - _lhsOpatternAttrs = - ({-# LINE 249 "src-ag/Order.ag" #-} - _hdIpatternAttrs ++ _tlIpatternAttrs - {-# LINE 3120 "src-ag/Order.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 3126 "src-ag/Order.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3132 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOallTypeSigs = - ({-# LINE 535 "src-ag/Order.ag" #-} - _lhsIallTypeSigs - {-# LINE 3138 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOaltAttrs = - ({-# LINE 186 "src-ag/Order.ag" #-} - _lhsIaltAttrs - {-# LINE 3144 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOcon = - ({-# LINE 90 "src-ag/Order.ag" #-} - _lhsIcon - {-# LINE 3150 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 3156 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 3162 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 3168 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOallTypeSigs = - ({-# LINE 535 "src-ag/Order.ag" #-} - _lhsIallTypeSigs - {-# LINE 3174 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOaltAttrs = - ({-# LINE 186 "src-ag/Order.ag" #-} - _lhsIaltAttrs - {-# LINE 3180 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOcon = - ({-# LINE 90 "src-ag/Order.ag" #-} - _lhsIcon - {-# LINE 3186 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 3192 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 3198 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 3204 "src-ag/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,Patterns)]) - _lhsOcopy :: Patterns - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 3229 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 170, column 68) - _lhsOgathAltAttrs = - ({-# LINE 170 "src-ag/Order.ag" #-} - [] - {-# LINE 3235 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 86) - _lhsOinstVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - [] - {-# LINE 3241 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 48) - _lhsOlocVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - [] - {-# LINE 3247 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 249, column 42) - _lhsOpatternAttrs = - ({-# LINE 249 "src-ag/Order.ag" #-} - [] - {-# LINE 3253 "src-ag/Order.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - [] - {-# LINE 3259 "src-ag/Order.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3265 "src-ag/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 - 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 - 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 children : Children - child rules : Rules - child typeSigs : TypeSigs - 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 _children _rules _typeSigs ) = - (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) --- semantic domain -newtype T_Production = T_Production (([Identifier]) -> - (Map ConstructorIdent (Map Identifier [Expression])) -> - CVisitsMap -> - Attributes -> - AttrOrderMap -> - (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) -> - Identifier -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - String -> - 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),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),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 _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount ) = - (let ( _lhsOadditionalDep,_lhsOaroundDep,_lhsOcProduction,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOrules,_lhsOvcount) = sem _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount - in (Syn_Production _lhsOadditionalDep _lhsOaroundDep _lhsOcProduction _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOrules _lhsOvcount )) -sem_Production_Production :: ConstructorIdent -> - T_Children -> - T_Rules -> - T_TypeSigs -> - T_Production -sem_Production_Production con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) = - (T_Production (\ _lhsIallnts - _lhsIaroundMap - _lhsIcVisitsMap - _lhsIinh - _lhsImanualAttrDepMap - _lhsImergeMap - _lhsInt - _lhsIo_case - _lhsIo_cata - _lhsIo_dovisit - _lhsIo_newtypes - _lhsIo_rename - _lhsIo_sem - _lhsIo_sig - _lhsIo_unbox - _lhsIo_wantvisit - _lhsIprefix - _lhsIsyn - _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,Maybe (Maybe Type))]) - _childrenOallnts :: ([Identifier]) - _childrenOattrs :: ([(Identifier,Identifier)]) - _childrenOinh :: Attributes - _childrenOmergeMap :: (Map Identifier (Identifier,[Identifier])) - _childrenOnt :: Identifier - _childrenOo_unbox :: Bool - _childrenOsyn :: Attributes - _rulesOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) - _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,Maybe (Maybe Type))]) - _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 93, column 16) - _childrenOcon = - ({-# LINE 93 "src-ag/Order.ag" #-} - con_ - {-# LINE 3457 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 95, column 16) - _rulesOcon = - ({-# LINE 95 "src-ag/Order.ag" #-} - con_ - {-# LINE 3463 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 172, column 18) - _gathAltAttrs = - ({-# LINE 172 "src-ag/Order.ag" #-} - [ AltAttr _LHS inh True | inh <- Map.keys _lhsIinh ] - ++ _childrenIgathAltAttrs - ++ _rulesIgathAltAttrs - {-# LINE 3471 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 188, column 17) - _altAttrs = - ({-# LINE 188 "src-ag/Order.ag" #-} - Map.fromList (zip _gathAltAttrs [_lhsIvcount..]) - {-# LINE 3477 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 201, column 18) - _rulesOchildNts = - ({-# LINE 201 "src-ag/Order.ag" #-} - Map.fromList (toList _childrenInts) - {-# LINE 3483 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 202, column 19) - _rulesOchildInhs = - ({-# LINE 202 "src-ag/Order.ag" #-} - Map.fromList (toList _childrenIinhs) - {-# LINE 3489 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 208, column 18) - _inhRules = - ({-# LINE 208 "src-ag/Order.ag" #-} - [ cRuleLhsInh inh _lhsInt con_ tp | (inh,tp) <- Map.assocs _lhsIinh ] - {-# LINE 3495 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 209, column 19) - _gathRules = - ({-# LINE 209 "src-ag/Order.ag" #-} - _inhRules ++ toList (_childrenIgathRules Seq.>< _rulesIgathRules) - {-# LINE 3501 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 263, column 18) - _lhsOrules = - ({-# LINE 263 "src-ag/Order.ag" #-} - Seq.fromList (zip [_lhsIvcount..] _gathRules) - {-# LINE 3507 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 264, column 19) - _lhsOvcount = - ({-# LINE 264 "src-ag/Order.ag" #-} - _lhsIvcount + length _gathRules - {-# LINE 3513 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 291, column 7) - _manualDeps = - ({-# LINE 291 "src-ag/Order.ag" #-} - Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrDepMap - {-# LINE 3519 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 294, column 7) - _lhsOadditionalDep = - ({-# LINE 294 "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 3532 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 341, column 17) - _rulesOsynsOfChildren = - ({-# LINE 341 "src-ag/Order.ag" #-} - _childrenIcollectChildrenSyns - {-# LINE 3538 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 342, column 17) - _rulesOinhsOfChildren = - ({-# LINE 342 "src-ag/Order.ag" #-} - _childrenIcollectChildrenInhs - {-# LINE 3544 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 360, column 32) - _mergeMap = - ({-# LINE 360 "src-ag/Order.ag" #-} - Map.findWithDefault Map.empty con_ _lhsImergeMap - {-# LINE 3550 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 371, column 7) - _lhsOmergeDep = - ({-# LINE 371 "src-ag/Order.ag" #-} - _mergeDep1 Seq.>< _mergeDep2 - {-# LINE 3556 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 372, column 7) - _mergeDep1 = - ({-# LINE 372 "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 3571 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 383, column 7) - _mergeDep2 = - ({-# LINE 383 "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 3586 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 413, column 32) - _aroundMap = - ({-# LINE 413 "src-ag/Order.ag" #-} - Map.findWithDefault Map.empty con_ _lhsIaroundMap - {-# LINE 3592 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 420, column 6) - _aroundDep1 = - ({-# LINE 420 "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 3607 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 431, column 6) - _aroundDep2 = - ({-# LINE 431 "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 3622 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 442, column 6) - _lhsOaroundDep = - ({-# LINE 442 "src-ag/Order.ag" #-} - _aroundDep1 Seq.>< _aroundDep2 - {-# LINE 3628 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 524, column 18) - _lhsOcons = - ({-# LINE 524 "src-ag/Order.ag" #-} - [con_] - {-# LINE 3634 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 531, column 16) - _typeSigsOtypeSigs = - ({-# LINE 531 "src-ag/Order.ag" #-} - Map.empty - {-# LINE 3640 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 537, column 17) - _rulesOallTypeSigs = - ({-# LINE 537 "src-ag/Order.ag" #-} - _typeSigsItypeSigs - {-# LINE 3646 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 605, column 17) - _cVisits = - ({-# LINE 605 "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 3657 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 631, column 18) - _lhsOcProduction = - ({-# LINE 631 "src-ag/Order.ag" #-} - CProduction con_ _cVisits _childrenIfields _childrenIterminals - {-# LINE 3663 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 659, column 16) - _allfields = - ({-# LINE 659 "src-ag/Order.ag" #-} - _childrenIfields - {-# LINE 3669 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 659, column 16) - _attrs = - ({-# LINE 660 "src-ag/Order.ag" #-} - map ((,) _LOC) _rulesIlocVars ++ - map ((,) _INST) _rulesIinstVars ++ - map ((,) _LHS) _inhnames ++ - concat [map ((,) nm) (Map.keys as) | (nm,_,as) <- _childrenIattributes] - {-# LINE 3678 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 659, column 16) - _inhnames = - ({-# LINE 664 "src-ag/Order.ag" #-} - Map.keys _lhsIinh - {-# LINE 3684 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 659, column 16) - _synnames = - ({-# LINE 665 "src-ag/Order.ag" #-} - Map.keys _lhsIsyn - {-# LINE 3690 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 269, column 33) - _lhsOdirectDep = - ({-# LINE 269 "src-ag/Order.ag" #-} - _rulesIdirectDep - {-# LINE 3696 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - _childrenIerrors Seq.>< _rulesIerrors - {-# LINE 3702 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 312, column 31) - _lhsOinstDep = - ({-# LINE 312 "src-ag/Order.ag" #-} - _rulesIinstDep - {-# LINE 3708 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnAutoRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - _rulesInAutoRules - {-# LINE 3714 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnExplicitRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - _rulesInExplicitRules - {-# LINE 3720 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _childrenOallfields = - ({-# LINE 656 "src-ag/Order.ag" #-} - _allfields - {-# LINE 3726 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _childrenOallnts = - ({-# LINE 649 "src-ag/Order.ag" #-} - _lhsIallnts - {-# LINE 3732 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _childrenOattrs = - ({-# LINE 656 "src-ag/Order.ag" #-} - _attrs - {-# LINE 3738 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _childrenOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 3744 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _childrenOmergeMap = - ({-# LINE 362 "src-ag/Order.ag" #-} - _mergeMap - {-# LINE 3750 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _childrenOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 3756 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _childrenOo_unbox = - ({-# LINE 119 "src-ag/Order.ag" #-} - _lhsIo_unbox - {-# LINE 3762 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _childrenOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 3768 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _rulesOallfields = - ({-# LINE 656 "src-ag/Order.ag" #-} - _allfields - {-# LINE 3774 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rulesOallnts = - ({-# LINE 649 "src-ag/Order.ag" #-} - _lhsIallnts - {-# LINE 3780 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _rulesOaltAttrs = - ({-# LINE 186 "src-ag/Order.ag" #-} - _altAttrs - {-# LINE 3786 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _rulesOattrs = - ({-# LINE 656 "src-ag/Order.ag" #-} - _attrs - {-# LINE 3792 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rulesOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 3798 "src-ag/Order.hs" #-} - ) - -- copy rule (from local) - _rulesOmergeMap = - ({-# LINE 362 "src-ag/Order.ag" #-} - _mergeMap - {-# LINE 3804 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rulesOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 3810 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rulesOo_case = - ({-# LINE 117 "src-ag/Order.ag" #-} - _lhsIo_case - {-# LINE 3816 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rulesOo_cata = - ({-# LINE 111 "src-ag/Order.ag" #-} - _lhsIo_cata - {-# LINE 3822 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rulesOo_dovisit = - ({-# LINE 116 "src-ag/Order.ag" #-} - _lhsIo_dovisit - {-# LINE 3828 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rulesOo_newtypes = - ({-# LINE 110 "src-ag/Order.ag" #-} - _lhsIo_newtypes - {-# LINE 3834 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rulesOo_rename = - ({-# LINE 114 "src-ag/Order.ag" #-} - _lhsIo_rename - {-# LINE 3840 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rulesOo_sem = - ({-# LINE 113 "src-ag/Order.ag" #-} - _lhsIo_sem - {-# LINE 3846 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rulesOo_sig = - ({-# LINE 112 "src-ag/Order.ag" #-} - _lhsIo_sig - {-# LINE 3852 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rulesOo_wantvisit = - ({-# LINE 115 "src-ag/Order.ag" #-} - _lhsIo_wantvisit - {-# LINE 3858 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rulesOprefix = - ({-# LINE 118 "src-ag/Order.ag" #-} - _lhsIprefix - {-# LINE 3864 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rulesOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 3870 "src-ag/Order.hs" #-} - ) - ( _childrenIattributes,_childrenIcollectChildrenInhs,_childrenIcollectChildrenSyns,_childrenIerrors,_childrenIfields,_childrenIgathAltAttrs,_childrenIgathRules,_childrenIinhs,_childrenInts,_childrenIsinglevisits,_childrenIterminals) = - children_ _childrenOallfields _childrenOallnts _childrenOattrs _childrenOcon _childrenOinh _childrenOmergeMap _childrenOnt _childrenOo_unbox _childrenOsyn - ( _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 - 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 - 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 -> - AttrOrderMap -> - (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) -> - Identifier -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - Bool -> - String -> - 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),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),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 _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _lhsIvcount ) = - (let ( _lhsOadditionalDep,_lhsOaroundDep,_lhsOcProductions,_lhsOcons,_lhsOdirectDep,_lhsOerrors,_lhsOinstDep,_lhsOmergeDep,_lhsOnAutoRules,_lhsOnExplicitRules,_lhsOrules,_lhsOvcount) = sem _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsyn _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 - _lhsImanualAttrDepMap - _lhsImergeMap - _lhsInt - _lhsIo_case - _lhsIo_cata - _lhsIo_dovisit - _lhsIo_newtypes - _lhsIo_rename - _lhsIo_sem - _lhsIo_sig - _lhsIo_unbox - _lhsIo_wantvisit - _lhsIprefix - _lhsIsyn - _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 - _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 - _hdOvcount :: Int - _tlOallnts :: ([Identifier]) - _tlOaroundMap :: (Map ConstructorIdent (Map Identifier [Expression])) - _tlOcVisitsMap :: CVisitsMap - _tlOinh :: 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 - _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 628, column 12) - _lhsOcProductions = - ({-# LINE 628 "src-ag/Order.ag" #-} - _hdIcProduction : _tlIcProductions - {-# LINE 4056 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 283, column 60) - _lhsOadditionalDep = - ({-# LINE 283 "src-ag/Order.ag" #-} - _hdIadditionalDep Seq.>< _tlIadditionalDep - {-# LINE 4062 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 404, column 24) - _lhsOaroundDep = - ({-# LINE 404 "src-ag/Order.ag" #-} - _hdIaroundDep Seq.>< _tlIaroundDep - {-# LINE 4068 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 522, column 40) - _lhsOcons = - ({-# LINE 522 "src-ag/Order.ag" #-} - _hdIcons ++ _tlIcons - {-# LINE 4074 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 269, column 33) - _lhsOdirectDep = - ({-# LINE 269 "src-ag/Order.ag" #-} - _hdIdirectDep Seq.>< _tlIdirectDep - {-# LINE 4080 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 4086 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 312, column 31) - _lhsOinstDep = - ({-# LINE 312 "src-ag/Order.ag" #-} - _hdIinstDep Seq.>< _tlIinstDep - {-# LINE 4092 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 367, column 18) - _lhsOmergeDep = - ({-# LINE 367 "src-ag/Order.ag" #-} - _hdImergeDep Seq.>< _tlImergeDep - {-# LINE 4098 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnAutoRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - _hdInAutoRules + _tlInAutoRules - {-# LINE 4104 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnExplicitRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - _hdInExplicitRules + _tlInExplicitRules - {-# LINE 4110 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 259, column 18) - _lhsOrules = - ({-# LINE 259 "src-ag/Order.ag" #-} - _hdIrules Seq.>< _tlIrules - {-# LINE 4116 "src-ag/Order.hs" #-} - ) - -- copy rule (up) - _lhsOvcount = - ({-# LINE 258 "src-ag/Order.ag" #-} - _tlIvcount - {-# LINE 4122 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOallnts = - ({-# LINE 649 "src-ag/Order.ag" #-} - _lhsIallnts - {-# LINE 4128 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOaroundMap = - ({-# LINE 410 "src-ag/Order.ag" #-} - _lhsIaroundMap - {-# LINE 4134 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOcVisitsMap = - ({-# LINE 603 "src-ag/Order.ag" #-} - _lhsIcVisitsMap - {-# LINE 4140 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 4146 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOmanualAttrDepMap = - ({-# LINE 283 "src-ag/Order.ag" #-} - _lhsImanualAttrDepMap - {-# LINE 4152 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOmergeMap = - ({-# LINE 357 "src-ag/Order.ag" #-} - _lhsImergeMap - {-# LINE 4158 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 4164 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_case = - ({-# LINE 117 "src-ag/Order.ag" #-} - _lhsIo_case - {-# LINE 4170 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_cata = - ({-# LINE 111 "src-ag/Order.ag" #-} - _lhsIo_cata - {-# LINE 4176 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_dovisit = - ({-# LINE 116 "src-ag/Order.ag" #-} - _lhsIo_dovisit - {-# LINE 4182 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_newtypes = - ({-# LINE 110 "src-ag/Order.ag" #-} - _lhsIo_newtypes - {-# LINE 4188 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_rename = - ({-# LINE 114 "src-ag/Order.ag" #-} - _lhsIo_rename - {-# LINE 4194 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_sem = - ({-# LINE 113 "src-ag/Order.ag" #-} - _lhsIo_sem - {-# LINE 4200 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_sig = - ({-# LINE 112 "src-ag/Order.ag" #-} - _lhsIo_sig - {-# LINE 4206 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_unbox = - ({-# LINE 119 "src-ag/Order.ag" #-} - _lhsIo_unbox - {-# LINE 4212 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_wantvisit = - ({-# LINE 115 "src-ag/Order.ag" #-} - _lhsIo_wantvisit - {-# LINE 4218 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOprefix = - ({-# LINE 118 "src-ag/Order.ag" #-} - _lhsIprefix - {-# LINE 4224 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 4230 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOvcount = - ({-# LINE 258 "src-ag/Order.ag" #-} - _lhsIvcount - {-# LINE 4236 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOallnts = - ({-# LINE 649 "src-ag/Order.ag" #-} - _lhsIallnts - {-# LINE 4242 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOaroundMap = - ({-# LINE 410 "src-ag/Order.ag" #-} - _lhsIaroundMap - {-# LINE 4248 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOcVisitsMap = - ({-# LINE 603 "src-ag/Order.ag" #-} - _lhsIcVisitsMap - {-# LINE 4254 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 4260 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOmanualAttrDepMap = - ({-# LINE 283 "src-ag/Order.ag" #-} - _lhsImanualAttrDepMap - {-# LINE 4266 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOmergeMap = - ({-# LINE 357 "src-ag/Order.ag" #-} - _lhsImergeMap - {-# LINE 4272 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 4278 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_case = - ({-# LINE 117 "src-ag/Order.ag" #-} - _lhsIo_case - {-# LINE 4284 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_cata = - ({-# LINE 111 "src-ag/Order.ag" #-} - _lhsIo_cata - {-# LINE 4290 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_dovisit = - ({-# LINE 116 "src-ag/Order.ag" #-} - _lhsIo_dovisit - {-# LINE 4296 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_newtypes = - ({-# LINE 110 "src-ag/Order.ag" #-} - _lhsIo_newtypes - {-# LINE 4302 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_rename = - ({-# LINE 114 "src-ag/Order.ag" #-} - _lhsIo_rename - {-# LINE 4308 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_sem = - ({-# LINE 113 "src-ag/Order.ag" #-} - _lhsIo_sem - {-# LINE 4314 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_sig = - ({-# LINE 112 "src-ag/Order.ag" #-} - _lhsIo_sig - {-# LINE 4320 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_unbox = - ({-# LINE 119 "src-ag/Order.ag" #-} - _lhsIo_unbox - {-# LINE 4326 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_wantvisit = - ({-# LINE 115 "src-ag/Order.ag" #-} - _lhsIo_wantvisit - {-# LINE 4332 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOprefix = - ({-# LINE 118 "src-ag/Order.ag" #-} - _lhsIprefix - {-# LINE 4338 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 4344 "src-ag/Order.hs" #-} - ) - -- copy rule (chain) - _tlOvcount = - ({-# LINE 258 "src-ag/Order.ag" #-} - _hdIvcount - {-# LINE 4350 "src-ag/Order.hs" #-} - ) - ( _hdIadditionalDep,_hdIaroundDep,_hdIcProduction,_hdIcons,_hdIdirectDep,_hdIerrors,_hdIinstDep,_hdImergeDep,_hdInAutoRules,_hdInExplicitRules,_hdIrules,_hdIvcount) = - hd_ _hdOallnts _hdOaroundMap _hdOcVisitsMap _hdOinh _hdOmanualAttrDepMap _hdOmergeMap _hdOnt _hdOo_case _hdOo_cata _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_unbox _hdOo_wantvisit _hdOprefix _hdOsyn _hdOvcount - ( _tlIadditionalDep,_tlIaroundDep,_tlIcProductions,_tlIcons,_tlIdirectDep,_tlIerrors,_tlIinstDep,_tlImergeDep,_tlInAutoRules,_tlInExplicitRules,_tlIrules,_tlIvcount) = - tl_ _tlOallnts _tlOaroundMap _tlOcVisitsMap _tlOinh _tlOmanualAttrDepMap _tlOmergeMap _tlOnt _tlOo_case _tlOo_cata _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_unbox _tlOo_wantvisit _tlOprefix _tlOsyn _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 - _lhsImanualAttrDepMap - _lhsImergeMap - _lhsInt - _lhsIo_case - _lhsIo_cata - _lhsIo_dovisit - _lhsIo_newtypes - _lhsIo_rename - _lhsIo_sem - _lhsIo_sig - _lhsIo_unbox - _lhsIo_wantvisit - _lhsIprefix - _lhsIsyn - _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 629, column 12) - _lhsOcProductions = - ({-# LINE 629 "src-ag/Order.ag" #-} - [] - {-# LINE 4394 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 283, column 60) - _lhsOadditionalDep = - ({-# LINE 283 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 4400 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 404, column 24) - _lhsOaroundDep = - ({-# LINE 404 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 4406 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 522, column 40) - _lhsOcons = - ({-# LINE 522 "src-ag/Order.ag" #-} - [] - {-# LINE 4412 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 269, column 33) - _lhsOdirectDep = - ({-# LINE 269 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 4418 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 4424 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 312, column 31) - _lhsOinstDep = - ({-# LINE 312 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 4430 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 367, column 18) - _lhsOmergeDep = - ({-# LINE 367 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 4436 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnAutoRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - 0 - {-# LINE 4442 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnExplicitRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - 0 - {-# LINE 4448 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 259, column 18) - _lhsOrules = - ({-# LINE 259 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 4454 "src-ag/Order.hs" #-} - ) - -- copy rule (chain) - _lhsOvcount = - ({-# LINE 258 "src-ag/Order.ag" #-} - _lhsIvcount - {-# LINE 4460 "src-ag/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,Maybe (Maybe Type))] - 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} - 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 ) = - (sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) --- semantic domain -newtype T_Rule = T_Rule ((Map Identifier Type) -> - ([(Identifier,Type,Maybe (Maybe Type))]) -> - ([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,Maybe (Maybe Type))])),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 -> - T_Rule -sem_Rule_Rule mbName_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ = - (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,Maybe (Maybe Type))]) - _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,Patterns)]) - _rhsIallRhsVars :: (Set (Identifier,Identifier)) - _rhsIcopy :: Expression - _rhsIerrors :: (Seq Error) - _rhsItextLines :: ([String]) - _rhsIusedAttrs :: ([(Identifier,Identifier)]) - _rhsIusedFields :: ([Identifier]) - _rhsIusedLocals :: ([Identifier]) - -- "src-ag/Order.ag"(line 64, column 11) - _lhsOnExplicitRules = - ({-# LINE 64 "src-ag/Order.ag" #-} - if explicit_ - then 1 - else 0 - {-# LINE 4623 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 67, column 11) - _lhsOnAutoRules = - ({-# LINE 67 "src-ag/Order.ag" #-} - if startsWith "use rule" origin_ || startsWith "copy rule" origin_ - then 1 - else 0 - {-# LINE 4631 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 217, column 12) - _defines = - ({-# LINE 217 "src-ag/Order.ag" #-} - let tp field attr parts | field == _LOC || field == _INST - = case parts of - [] -> Map.lookup attr _lhsIallTypeSigs - _ -> (sequence (map typ parts)) >>= (haskellTupel . map (substSelf _lhsInt)) - | field == _LHS = Map.lookup attr _lhsIsyn - | otherwise = Map.lookup attr (findWithErr1 "Rule.defines.tp" field _lhsIchildInhs) - typ :: Pattern -> Maybe Type - typ (Alias field attr _ parts) = tp field attr parts - typ (Underscore _) = Nothing - typ _ = Nothing - in Map.fromList [ (findWithErr1 "Rule.defines" aa _lhsIaltAttrs, (field,attr,(tp field attr parts))) - | (field,attr,isLocalOrInst,parts) <- _patternIpatternAttrs - , let aa = AltAttr field attr isLocalOrInst - ] - {-# LINE 4650 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 233, column 12) - _gathRules = - ({-# LINE 233 "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 4659 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 271, column 12) - _lhsOdirectDep = - ({-# LINE 271 "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 4668 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 315, column 6) - _instDep1 = - ({-# LINE 315 "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 4683 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 326, column 6) - _instDep2 = - ({-# LINE 326 "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 4698 "src-ag/Order.hs" #-} - ) - -- "src-ag/Order.ag"(line 337, column 6) - _lhsOinstDep = - ({-# LINE 337 "src-ag/Order.ag" #-} - _instDep1 Seq.>< _instDep2 - {-# LINE 4704 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - _patternIerrors Seq.>< _rhsIerrors - {-# LINE 4710 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 170, column 68) - _lhsOgathAltAttrs = - ({-# LINE 170 "src-ag/Order.ag" #-} - _patternIgathAltAttrs - {-# LINE 4716 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 206, column 23) - _lhsOgathRules = - ({-# LINE 206 "src-ag/Order.ag" #-} - _gathRules - {-# LINE 4722 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 86) - _lhsOinstVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - _patternIinstVars - {-# LINE 4728 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 48) - _lhsOlocVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - _patternIlocVars - {-# LINE 4734 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patternOallTypeSigs = - ({-# LINE 535 "src-ag/Order.ag" #-} - _lhsIallTypeSigs - {-# LINE 4740 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patternOaltAttrs = - ({-# LINE 186 "src-ag/Order.ag" #-} - _lhsIaltAttrs - {-# LINE 4746 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patternOcon = - ({-# LINE 90 "src-ag/Order.ag" #-} - _lhsIcon - {-# LINE 4752 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patternOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 4758 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patternOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 4764 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _patternOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 4770 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rhsOallfields = - ({-# LINE 448 "src-ag/Order.ag" #-} - _lhsIallfields - {-# LINE 4776 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rhsOallnts = - ({-# LINE 449 "src-ag/Order.ag" #-} - _lhsIallnts - {-# LINE 4782 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rhsOattrs = - ({-# LINE 450 "src-ag/Order.ag" #-} - _lhsIattrs - {-# LINE 4788 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rhsOcon = - ({-# LINE 447 "src-ag/Order.ag" #-} - _lhsIcon - {-# LINE 4794 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rhsOmergeMap = - ({-# LINE 362 "src-ag/Order.ag" #-} - _lhsImergeMap - {-# LINE 4800 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _rhsOnt = - ({-# LINE 447 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 4806 "src-ag/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,Maybe (Maybe Type))] - 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,Maybe (Maybe Type))]) -> - ([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,Maybe (Maybe Type))])),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,Maybe (Maybe Type))]) - _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,Maybe (Maybe Type))]) - _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 269, column 33) - _lhsOdirectDep = - ({-# LINE 269 "src-ag/Order.ag" #-} - _hdIdirectDep Seq.>< _tlIdirectDep - {-# LINE 4998 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 5004 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 170, column 68) - _lhsOgathAltAttrs = - ({-# LINE 170 "src-ag/Order.ag" #-} - _hdIgathAltAttrs ++ _tlIgathAltAttrs - {-# LINE 5010 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 206, column 23) - _lhsOgathRules = - ({-# LINE 206 "src-ag/Order.ag" #-} - _hdIgathRules Seq.>< _tlIgathRules - {-# LINE 5016 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 312, column 31) - _lhsOinstDep = - ({-# LINE 312 "src-ag/Order.ag" #-} - _hdIinstDep Seq.>< _tlIinstDep - {-# LINE 5022 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 86) - _lhsOinstVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - _hdIinstVars ++ _tlIinstVars - {-# LINE 5028 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 48) - _lhsOlocVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - _hdIlocVars ++ _tlIlocVars - {-# LINE 5034 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnAutoRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - _hdInAutoRules + _tlInAutoRules - {-# LINE 5040 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnExplicitRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - _hdInExplicitRules + _tlInExplicitRules - {-# LINE 5046 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOallTypeSigs = - ({-# LINE 535 "src-ag/Order.ag" #-} - _lhsIallTypeSigs - {-# LINE 5052 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOallfields = - ({-# LINE 656 "src-ag/Order.ag" #-} - _lhsIallfields - {-# LINE 5058 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOallnts = - ({-# LINE 649 "src-ag/Order.ag" #-} - _lhsIallnts - {-# LINE 5064 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOaltAttrs = - ({-# LINE 186 "src-ag/Order.ag" #-} - _lhsIaltAttrs - {-# LINE 5070 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOattrs = - ({-# LINE 656 "src-ag/Order.ag" #-} - _lhsIattrs - {-# LINE 5076 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOchildInhs = - ({-# LINE 199 "src-ag/Order.ag" #-} - _lhsIchildInhs - {-# LINE 5082 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOchildNts = - ({-# LINE 198 "src-ag/Order.ag" #-} - _lhsIchildNts - {-# LINE 5088 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOcon = - ({-# LINE 90 "src-ag/Order.ag" #-} - _lhsIcon - {-# LINE 5094 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 5100 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOinhsOfChildren = - ({-# LINE 339 "src-ag/Order.ag" #-} - _lhsIinhsOfChildren - {-# LINE 5106 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOmergeMap = - ({-# LINE 362 "src-ag/Order.ag" #-} - _lhsImergeMap - {-# LINE 5112 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 5118 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_case = - ({-# LINE 117 "src-ag/Order.ag" #-} - _lhsIo_case - {-# LINE 5124 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_cata = - ({-# LINE 111 "src-ag/Order.ag" #-} - _lhsIo_cata - {-# LINE 5130 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_dovisit = - ({-# LINE 116 "src-ag/Order.ag" #-} - _lhsIo_dovisit - {-# LINE 5136 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_newtypes = - ({-# LINE 110 "src-ag/Order.ag" #-} - _lhsIo_newtypes - {-# LINE 5142 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_rename = - ({-# LINE 114 "src-ag/Order.ag" #-} - _lhsIo_rename - {-# LINE 5148 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_sem = - ({-# LINE 113 "src-ag/Order.ag" #-} - _lhsIo_sem - {-# LINE 5154 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_sig = - ({-# LINE 112 "src-ag/Order.ag" #-} - _lhsIo_sig - {-# LINE 5160 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOo_wantvisit = - ({-# LINE 115 "src-ag/Order.ag" #-} - _lhsIo_wantvisit - {-# LINE 5166 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOprefix = - ({-# LINE 118 "src-ag/Order.ag" #-} - _lhsIprefix - {-# LINE 5172 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 5178 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOsynsOfChildren = - ({-# LINE 339 "src-ag/Order.ag" #-} - _lhsIsynsOfChildren - {-# LINE 5184 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOallTypeSigs = - ({-# LINE 535 "src-ag/Order.ag" #-} - _lhsIallTypeSigs - {-# LINE 5190 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOallfields = - ({-# LINE 656 "src-ag/Order.ag" #-} - _lhsIallfields - {-# LINE 5196 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOallnts = - ({-# LINE 649 "src-ag/Order.ag" #-} - _lhsIallnts - {-# LINE 5202 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOaltAttrs = - ({-# LINE 186 "src-ag/Order.ag" #-} - _lhsIaltAttrs - {-# LINE 5208 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOattrs = - ({-# LINE 656 "src-ag/Order.ag" #-} - _lhsIattrs - {-# LINE 5214 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOchildInhs = - ({-# LINE 199 "src-ag/Order.ag" #-} - _lhsIchildInhs - {-# LINE 5220 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOchildNts = - ({-# LINE 198 "src-ag/Order.ag" #-} - _lhsIchildNts - {-# LINE 5226 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOcon = - ({-# LINE 90 "src-ag/Order.ag" #-} - _lhsIcon - {-# LINE 5232 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOinh = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIinh - {-# LINE 5238 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOinhsOfChildren = - ({-# LINE 339 "src-ag/Order.ag" #-} - _lhsIinhsOfChildren - {-# LINE 5244 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOmergeMap = - ({-# LINE 362 "src-ag/Order.ag" #-} - _lhsImergeMap - {-# LINE 5250 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsInt - {-# LINE 5256 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_case = - ({-# LINE 117 "src-ag/Order.ag" #-} - _lhsIo_case - {-# LINE 5262 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_cata = - ({-# LINE 111 "src-ag/Order.ag" #-} - _lhsIo_cata - {-# LINE 5268 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_dovisit = - ({-# LINE 116 "src-ag/Order.ag" #-} - _lhsIo_dovisit - {-# LINE 5274 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_newtypes = - ({-# LINE 110 "src-ag/Order.ag" #-} - _lhsIo_newtypes - {-# LINE 5280 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_rename = - ({-# LINE 114 "src-ag/Order.ag" #-} - _lhsIo_rename - {-# LINE 5286 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_sem = - ({-# LINE 113 "src-ag/Order.ag" #-} - _lhsIo_sem - {-# LINE 5292 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_sig = - ({-# LINE 112 "src-ag/Order.ag" #-} - _lhsIo_sig - {-# LINE 5298 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOo_wantvisit = - ({-# LINE 115 "src-ag/Order.ag" #-} - _lhsIo_wantvisit - {-# LINE 5304 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOprefix = - ({-# LINE 118 "src-ag/Order.ag" #-} - _lhsIprefix - {-# LINE 5310 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOsyn = - ({-# LINE 89 "src-ag/Order.ag" #-} - _lhsIsyn - {-# LINE 5316 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _tlOsynsOfChildren = - ({-# LINE 339 "src-ag/Order.ag" #-} - _lhsIsynsOfChildren - {-# LINE 5322 "src-ag/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 269, column 33) - _lhsOdirectDep = - ({-# LINE 269 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 5367 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 84, column 70) - _lhsOerrors = - ({-# LINE 84 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 5373 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 170, column 68) - _lhsOgathAltAttrs = - ({-# LINE 170 "src-ag/Order.ag" #-} - [] - {-# LINE 5379 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 206, column 23) - _lhsOgathRules = - ({-# LINE 206 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 5385 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 312, column 31) - _lhsOinstDep = - ({-# LINE 312 "src-ag/Order.ag" #-} - Seq.empty - {-# LINE 5391 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 86) - _lhsOinstVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - [] - {-# LINE 5397 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 679, column 48) - _lhsOlocVars = - ({-# LINE 679 "src-ag/Order.ag" #-} - [] - {-# LINE 5403 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnAutoRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - 0 - {-# LINE 5409 "src-ag/Order.hs" #-} - ) - -- use rule "src-ag/Order.ag"(line 61, column 105) - _lhsOnExplicitRules = - ({-# LINE 61 "src-ag/Order.ag" #-} - 0 - {-# LINE 5415 "src-ag/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 533, column 13) - _lhsOtypeSigs = - ({-# LINE 533 "src-ag/Order.ag" #-} - Map.insert name_ tp_ _lhsItypeSigs - {-# LINE 5454 "src-ag/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 529 "src-ag/Order.ag" #-} - _tlItypeSigs - {-# LINE 5498 "src-ag/Order.hs" #-} - ) - -- copy rule (down) - _hdOtypeSigs = - ({-# LINE 529 "src-ag/Order.ag" #-} - _lhsItypeSigs - {-# LINE 5504 "src-ag/Order.hs" #-} - ) - -- copy rule (chain) - _tlOtypeSigs = - ({-# LINE 529 "src-ag/Order.ag" #-} - _hdItypeSigs - {-# LINE 5510 "src-ag/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 529 "src-ag/Order.ag" #-} - _lhsItypeSigs - {-# LINE 5525 "src-ag/Order.hs" #-} - ) - in ( _lhsOtypeSigs))) ) diff --git a/dist/build/uuagc/uuagc-tmp/Patterns.hs b/dist/build/uuagc/uuagc-tmp/Patterns.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/Patterns.hs +++ /dev/null @@ -1,64 +0,0 @@ - - --- UUAGC 0.9.39.0.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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Patterns.hs" #-} --- Pattern ----------------------------------------------------- -{- - visit 0: - synthesized attribute: - copy : SELF - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ --} -data Pattern = Alias (Identifier) (Identifier) (Pattern ) (Patterns ) - | Constr (ConstructorIdent) (Patterns ) - | Irrefutable (Pattern ) - | Product (Pos) (Patterns ) - | Underscore (Pos) - deriving ( Show) --- Patterns ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - copy : SELF - 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/uuagc/uuagc-tmp/PrintCode.hs b/dist/build/uuagc/uuagc-tmp/PrintCode.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/PrintCode.hs +++ /dev/null @@ -1,4121 +0,0 @@ -{-# OPTIONS_GHC -XBangPatterns #-} - --- UUAGC 0.9.39.0.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 CommonTypes(BlockInfo, BlockType(..), identifier) -{-# LINE 18 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 29 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintCode.hs" #-} - -{-# LINE 2 "src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 36 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintCode.hs" #-} -{-# LINE 23 "src-ag/PrintCode.ag" #-} - -type PP_Docs = [PP_Doc] -{-# LINE 40 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintCode.hs" #-} - -{-# LINE 27 "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 53 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintCode.hs" #-} - -{-# LINE 296 "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 66 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintCode.hs" #-} - -{-# LINE 395 "src-ag/PrintCode.ag" #-} - -locname' n = "_loc_" ++ getName n -{-# LINE 71 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintCode.hs" #-} - -{-# LINE 468 "src-ag/PrintCode.ag" #-} - -renderDocs :: [PP_Doc] -> String -renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) "" -{-# LINE 77 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintCode.hs" #-} - -{-# LINE 515 "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 94 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintCode.hs" #-} - -{-# LINE 145 "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 113 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 155 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 160 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 165 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 170 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 175 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 180 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOnested -> - (case (({-# LINE 418 "src-ag/PrintCode.ag" #-} - False - {-# LINE 185 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOisDeclOfLet -> - (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of - { ( !_exprIpp) -> - (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile ) of - { ( !_leftIpp) -> - (case (({-# LINE 218 "src-ag/PrintCode.ag" #-} - ["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"] - {-# LINE 194 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 240 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 245 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOoptions -> - (case (({-# LINE 55 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 250 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 255 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 260 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOoptions -> - (case (({-# LINE 55 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 265 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOnested -> - (case (tl_ _tlOnested _tlOoptions _tlOoutputfile ) of - { ( !_tlIpps) -> - (case (hd_ _hdOnested _hdOoptions _hdOoutputfile ) of - { ( !_hdIpps) -> - (case (({-# LINE 68 "src-ag/PrintCode.ag" #-} - _hdIpps ++ _tlIpps - {-# LINE 274 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) }) }) }) }) }) }) }) }) })) ) -sem_CaseAlts_Nil :: T_CaseAlts -sem_CaseAlts_Nil = - (T_CaseAlts (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (({-# LINE 69 "src-ag/PrintCode.ag" #-} - [] - {-# LINE 285 "src-ag/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 43 "src-ag/PrintCode.ag" #-} - if sepSemMods _lhsIoptions - then _lhsImainFile ++ "_" ++ name_ ++ ".hs" - else _lhsImainFile ++ ".hs" - {-# LINE 377 "src-ag/PrintCode.hs" #-} - )) of - { !_outputfile -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _outputfile - {-# LINE 382 "src-ag/PrintCode.hs" #-} - )) of - { !_semDomOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 387 "src-ag/PrintCode.hs" #-} - )) of - { !_semDomOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 392 "src-ag/PrintCode.hs" #-} - )) of - { !_semDomOnested -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 397 "src-ag/PrintCode.hs" #-} - )) of - { !_semDomOisDeclOfLet -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _outputfile - {-# LINE 402 "src-ag/PrintCode.hs" #-} - )) of - { !_dataDefOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 407 "src-ag/PrintCode.hs" #-} - )) of - { !_dataDefOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 412 "src-ag/PrintCode.hs" #-} - )) of - { !_dataDefOnested -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 417 "src-ag/PrintCode.hs" #-} - )) of - { !_dataDefOisDeclOfLet -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _outputfile - {-# LINE 422 "src-ag/PrintCode.hs" #-} - )) of - { !_commentOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 427 "src-ag/PrintCode.hs" #-} - )) of - { !_commentOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 432 "src-ag/PrintCode.hs" #-} - )) of - { !_commentOnested -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 437 "src-ag/PrintCode.hs" #-} - )) of - { !_commentOisDeclOfLet -> - (case (semDom_ _semDomOisDeclOfLet _semDomOnested _semDomOoptions _semDomOoutputfile ) of - { ( !_semDomIpps) -> - (case (dataDef_ _dataDefOisDeclOfLet _dataDefOnested _dataDefOoptions _dataDefOoutputfile ) of - { ( !_dataDefIpps) -> - (case (comment_ _commentOisDeclOfLet _commentOnested _commentOoptions _commentOoutputfile ) of - { ( !_commentIpp) -> - (case (({-# LINE 482 "src-ag/PrintCode.ag" #-} - [ [_commentIpp] - , _dataDefIpps - , _semDomIpps - ] - {-# LINE 451 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOappendCommon -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _outputfile - {-# LINE 456 "src-ag/PrintCode.hs" #-} - )) of - { !_semWrapperOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 461 "src-ag/PrintCode.hs" #-} - )) of - { !_semWrapperOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 466 "src-ag/PrintCode.hs" #-} - )) of - { !_semWrapperOnested -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 471 "src-ag/PrintCode.hs" #-} - )) of - { !_semWrapperOisDeclOfLet -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _outputfile - {-# LINE 476 "src-ag/PrintCode.hs" #-} - )) of - { !_cataFunOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 481 "src-ag/PrintCode.hs" #-} - )) of - { !_cataFunOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 486 "src-ag/PrintCode.hs" #-} - )) of - { !_cataFunOnested -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 491 "src-ag/PrintCode.hs" #-} - )) of - { !_cataFunOisDeclOfLet -> - (case (semWrapper_ _semWrapperOisDeclOfLet _semWrapperOnested _semWrapperOoptions _semWrapperOoutputfile ) of - { ( !_semWrapperIpps) -> - (case (cataFun_ _cataFunOisDeclOfLet _cataFunOnested _cataFunOoptions _cataFunOoutputfile ) of - { ( !_cataFunIpps) -> - (case (({-# LINE 487 "src-ag/PrintCode.ag" #-} - [ [_commentIpp] - , _cataFunIpps - , _semWrapperIpps - ] - {-# LINE 503 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOappendMain -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _outputfile - {-# LINE 508 "src-ag/PrintCode.hs" #-} - )) of - { !_semFunctionsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 513 "src-ag/PrintCode.hs" #-} - )) of - { !_semFunctionsOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 518 "src-ag/PrintCode.hs" #-} - )) of - { !_semFunctionsOnested -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 523 "src-ag/PrintCode.hs" #-} - )) of - { !_semFunctionsOisDeclOfLet -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _outputfile - {-# LINE 528 "src-ag/PrintCode.hs" #-} - )) of - { !_infoOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 533 "src-ag/PrintCode.hs" #-} - )) of - { !_infoOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 538 "src-ag/PrintCode.hs" #-} - )) of - { !_infoOnested -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 543 "src-ag/PrintCode.hs" #-} - )) of - { !_infoOisDeclOfLet -> - (case (({-# LINE 513 "src-ag/PrintCode.ag" #-} - concat $ intersperse "," semNames_ - {-# LINE 548 "src-ag/PrintCode.hs" #-} - )) of - { !_exports -> - (case (semFunctions_ _semFunctionsOisDeclOfLet _semFunctionsOnested _semFunctionsOoptions _semFunctionsOoutputfile ) of - { ( !_semFunctionsIpps) -> - (case (info_ _infoOisDeclOfLet _infoOnested _infoOoptions _infoOoutputfile ) of - { ( !_infoIpps) -> - (case (({-# LINE 497 "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 568 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOgenSems -> - (case (({-# LINE 476 "src-ag/PrintCode.ag" #-} - ["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"] - {-# LINE 573 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOimports -> - (case (({-# LINE 96 "src-ag/PrintCode.ag" #-} - _commentIpp - : _infoIpps - ++ _dataDefIpps - ++ _cataFunIpps - ++ _semDomIpps - ++ _semWrapperIpps - ++ _semFunctionsIpps - ++ [Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap] - {-# LINE 585 "src-ag/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 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 659 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 664 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOnested -> - (case (({-# LINE 433 "src-ag/PrintCode.ag" #-} - _lhsImainFile - {-# LINE 669 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOmainFile -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 674 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOisDeclOfLet -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 679 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 684 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOnested -> - (case (({-# LINE 433 "src-ag/PrintCode.ag" #-} - _lhsImainFile - {-# LINE 689 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOmainFile -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 694 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOisDeclOfLet -> - (case (({-# LINE 430 "src-ag/PrintCode.ag" #-} - _lhsItextBlocks - {-# LINE 699 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOtextBlocks -> - (case (({-# LINE 431 "src-ag/PrintCode.ag" #-} - _lhsItextBlockMap - {-# LINE 704 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOtextBlockMap -> - (case (({-# LINE 429 "src-ag/PrintCode.ag" #-} - _lhsIpragmaBlocks - {-# LINE 709 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOpragmaBlocks -> - (case (({-# LINE 432 "src-ag/PrintCode.ag" #-} - _lhsIoptionsLine - {-# LINE 714 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOoptionsLine -> - (case (({-# LINE 435 "src-ag/PrintCode.ag" #-} - _lhsImoduleHeader - {-# LINE 719 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOmoduleHeader -> - (case (({-# LINE 434 "src-ag/PrintCode.ag" #-} - _lhsImainName - {-# LINE 724 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOmainName -> - (case (({-# LINE 428 "src-ag/PrintCode.ag" #-} - _lhsIimportBlocks - {-# LINE 729 "src-ag/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 430 "src-ag/PrintCode.ag" #-} - _lhsItextBlocks - {-# LINE 736 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOtextBlocks -> - (case (({-# LINE 431 "src-ag/PrintCode.ag" #-} - _lhsItextBlockMap - {-# LINE 741 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOtextBlockMap -> - (case (({-# LINE 429 "src-ag/PrintCode.ag" #-} - _lhsIpragmaBlocks - {-# LINE 746 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOpragmaBlocks -> - (case (({-# LINE 432 "src-ag/PrintCode.ag" #-} - _lhsIoptionsLine - {-# LINE 751 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOoptionsLine -> - (case (({-# LINE 435 "src-ag/PrintCode.ag" #-} - _lhsImoduleHeader - {-# LINE 756 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOmoduleHeader -> - (case (({-# LINE 434 "src-ag/PrintCode.ag" #-} - _lhsImainName - {-# LINE 761 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOmainName -> - (case (({-# LINE 428 "src-ag/PrintCode.ag" #-} - _lhsIimportBlocks - {-# LINE 766 "src-ag/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 478 "src-ag/PrintCode.ag" #-} - _hdIappendCommon ++ _tlIappendCommon - {-# LINE 773 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOappendCommon -> - (case (({-# LINE 478 "src-ag/PrintCode.ag" #-} - _hdIappendMain ++ _tlIappendMain - {-# LINE 778 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOappendMain -> - (case (({-# LINE 493 "src-ag/PrintCode.ag" #-} - _hdIgenSems >> _tlIgenSems - {-# LINE 783 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOgenSems -> - (case (({-# LINE 473 "src-ag/PrintCode.ag" #-} - _hdIimports ++ _tlIimports - {-# LINE 788 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOimports -> - (case (({-# LINE 88 "src-ag/PrintCode.ag" #-} - _hdIpps ++ _tlIpps - {-# LINE 793 "src-ag/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 478 "src-ag/PrintCode.ag" #-} - [] - {-# LINE 812 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOappendCommon -> - (case (({-# LINE 478 "src-ag/PrintCode.ag" #-} - [] - {-# LINE 817 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOappendMain -> - (case (({-# LINE 493 "src-ag/PrintCode.ag" #-} - return () - {-# LINE 822 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOgenSems -> - (case (({-# LINE 473 "src-ag/PrintCode.ag" #-} - [] - {-# LINE 827 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOimports -> - (case (({-# LINE 89 "src-ag/PrintCode.ag" #-} - [] - {-# LINE 832 "src-ag/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 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 879 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOnested -> - (case (args_ _argsOnested ) of - { ( !_argsIpps) -> - (case (({-# LINE 221 "src-ag/PrintCode.ag" #-} - name_ >#< hv_sp (map ((_lhsIstrictPre >|<) . pp_parens) _argsIpps) - {-# LINE 886 "src-ag/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 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 898 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOnested -> - (case (args_ _argsOnested ) of - { ( !_argsIpps) -> - (case (({-# LINE 222 "src-ag/PrintCode.ag" #-} - name_ >#< pp_block "{" "}" "," _argsIpps - {-# LINE 905 "src-ag/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 313 "src-ag/PrintCode.ag" #-} - _lhsIstrictPre - {-# LINE 948 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOstrictPre -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 953 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOnested -> - (case (({-# LINE 313 "src-ag/PrintCode.ag" #-} - _lhsIstrictPre - {-# LINE 958 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOstrictPre -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 963 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOnested -> - (case (tl_ _tlOnested _tlOstrictPre ) of - { ( !_tlIpps) -> - (case (hd_ _hdOnested _hdOstrictPre ) of - { ( !_hdIpp) -> - (case (({-# LINE 72 "src-ag/PrintCode.ag" #-} - _hdIpp : _tlIpps - {-# LINE 972 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) }) }) }) }) }) }) })) ) -sem_DataAlts_Nil :: T_DataAlts -sem_DataAlts_Nil = - (T_DataAlts (\ (!_lhsInested) - (!_lhsIstrictPre) -> - (case (({-# LINE 73 "src-ag/PrintCode.ag" #-} - [] - {-# LINE 982 "src-ag/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 Bind: - child left : Lhs - child rhs : Expr - alternative BindLet: - child left : Lhs - child rhs : Expr - alternative Comment: - child txt : {String} - alternative Data: - child name : {String} - child params : {[String]} - child alts : DataAlts - child strict : {Bool} - child derivings : {[String]} - alternative Decl: - child left : Lhs - child rhs : Expr - child binds : {Set String} - child uses : {Set String} - alternative EvalDecl: - child nt : {String} - child left : Lhs - child rhs : Expr - visit 0: - local strat : _ - alternative NewType: - child name : {String} - child params : {[String]} - child con : {String} - child tp : Type - alternative PragmaDecl: - child txt : {String} - alternative Resume: - child monadic : {Bool} - child nt : {String} - child left : Lhs - child rhs : Expr - alternative TSig: - child name : {String} - child tp : Type - alternative Type: - child name : {String} - child params : {[String]} - child tp : Type --} --- cata -sem_Decl :: Decl -> - T_Decl -sem_Decl !(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 !(Comment _txt ) = - (sem_Decl_Comment _txt ) -sem_Decl !(Data _name _params _alts _strict _derivings ) = - (sem_Decl_Data _name _params (sem_DataAlts _alts ) _strict _derivings ) -sem_Decl !(Decl _left _rhs _binds _uses ) = - (sem_Decl_Decl (sem_Lhs _left ) (sem_Expr _rhs ) _binds _uses ) -sem_Decl !(EvalDecl _nt _left _rhs ) = - (sem_Decl_EvalDecl _nt (sem_Lhs _left ) (sem_Expr _rhs ) ) -sem_Decl !(NewType _name _params _con _tp ) = - (sem_Decl_NewType _name _params _con (sem_Type _tp ) ) -sem_Decl !(PragmaDecl _txt ) = - (sem_Decl_PragmaDecl _txt ) -sem_Decl !(Resume _monadic _nt _left _rhs ) = - (sem_Decl_Resume _monadic _nt (sem_Lhs _left ) (sem_Expr _rhs ) ) -sem_Decl !(TSig _name _tp ) = - (sem_Decl_TSig _name (sem_Type _tp ) ) -sem_Decl !(Type _name _params _tp ) = - (sem_Decl_Type _name _params (sem_Type _tp ) ) --- semantic domain -newtype T_Decl = T_Decl (Bool -> - Bool -> - Options -> - String -> - ( PP_Doc)) -data Inh_Decl = Inh_Decl {isDeclOfLet_Inh_Decl :: !(Bool),nested_Inh_Decl :: !(Bool),options_Inh_Decl :: !(Options),outputfile_Inh_Decl :: !(String)} -data Syn_Decl = Syn_Decl {pp_Syn_Decl :: !(PP_Doc)} -wrap_Decl :: T_Decl -> - 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_Bind :: T_Lhs -> - T_Expr -> - T_Decl -sem_Decl_Bind !(T_Lhs left_ ) !(T_Expr rhs_ ) = - (T_Decl (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1091 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1096 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1101 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1106 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1111 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1116 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOnested -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 1121 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOisDeclOfLet -> - (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile ) of - { ( !_rhsIpp) -> - (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile ) of - { ( !_leftIpp) -> - (case (({-# LINE 108 "src-ag/PrintCode.ag" #-} - _leftIpp >#< "<-" >#< _rhsIpp - {-# LINE 1130 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1144 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1149 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1154 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1159 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1164 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1169 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOnested -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 1174 "src-ag/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" #-} - "let" >#< _leftIpp >#< "=" >#< _rhsIpp - {-# LINE 1183 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) }) }) }) }) }) })) ) -sem_Decl_Comment :: String -> - T_Decl -sem_Decl_Comment !txt_ = - (T_Decl (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (({-# LINE 122 "src-ag/PrintCode.ag" #-} - if '\n' `elem` txt_ - then "{-" >-< vlist (lines txt_) >-< "-}" - else "--" >#< txt_ - {-# LINE 1198 "src-ag/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 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1215 "src-ag/PrintCode.hs" #-} - )) of - { !_altsOnested -> - (case (({-# LINE 316 "src-ag/PrintCode.ag" #-} - if strict_ then pp "!" else empty - {-# LINE 1220 "src-ag/PrintCode.hs" #-} - )) of - { !_altsOstrictPre -> - (case (alts_ _altsOnested _altsOstrictPre ) of - { ( !_altsIpps) -> - (case (({-# LINE 110 "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 1235 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) })) ) -sem_Decl_Decl :: T_Lhs -> - T_Expr -> - (Set String) -> - (Set String) -> - T_Decl -sem_Decl_Decl !(T_Lhs left_ ) !(T_Expr rhs_ ) !binds_ !uses_ = - (T_Decl (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1251 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1256 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1261 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1266 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1271 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1276 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOnested -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 1281 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOisDeclOfLet -> - (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile ) of - { ( !_rhsIpp) -> - (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile ) of - { ( !_leftIpp) -> - (case (({-# LINE 106 "src-ag/PrintCode.ag" #-} - _leftIpp >#< "=" - >-< indent 4 _rhsIpp - {-# LINE 1291 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1306 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1311 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1316 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1321 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1326 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1331 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOnested -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 1336 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOisDeclOfLet -> - (case (({-# LINE 129 "src-ag/PrintCode.ag" #-} - if breadthFirstStrict _lhsIoptions - then "stepwiseEval" - else "lazyEval" - {-# LINE 1343 "src-ag/PrintCode.hs" #-} - )) of - { !_strat -> - (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile ) of - { ( !_rhsIpp) -> - (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile ) of - { ( !_leftIpp) -> - (case (({-# LINE 132 "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 1357 "src-ag/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 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1373 "src-ag/PrintCode.hs" #-} - )) of - { !_tpOnested -> - (case (tp_ _tpOnested ) of - { ( !_tpIpp,!_tpIprec) -> - (case (({-# LINE 119 "src-ag/PrintCode.ag" #-} - "newtype" >#< hv_sp (name_ : params_) >#< "=" >#< con_ >#< pp_parens _tpIpp - {-# LINE 1380 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - ( _lhsOpp) }) }) })) ) -sem_Decl_PragmaDecl :: String -> - T_Decl -sem_Decl_PragmaDecl !txt_ = - (T_Decl (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (({-# LINE 125 "src-ag/PrintCode.ag" #-} - "{-#" >#< text txt_ >#< "#-}" - {-# LINE 1393 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1409 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1414 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1419 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1424 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1429 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1434 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOnested -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 1439 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOisDeclOfLet -> - (case (rhs_ _rhsOnested _rhsOoptions _rhsOoutputfile ) of - { ( !_rhsIpp) -> - (case (left_ _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile ) of - { ( !_leftIpp) -> - (case (({-# LINE 126 "src-ag/PrintCode.ag" #-} - if monadic_ - then _leftIpp >#< "<-" >#< _rhsIpp - else _leftIpp >#< "=" >-< indent 4 _rhsIpp - {-# LINE 1450 "src-ag/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 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1464 "src-ag/PrintCode.hs" #-} - )) of - { !_tpOnested -> - (case (tp_ _tpOnested ) of - { ( !_tpIpp,!_tpIprec) -> - (case (({-# LINE 121 "src-ag/PrintCode.ag" #-} - name_ >#< "::" >#< _tpIpp - {-# LINE 1471 "src-ag/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 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1486 "src-ag/PrintCode.hs" #-} - )) of - { !_tpOnested -> - (case (tp_ _tpOnested ) of - { ( !_tpIpp,!_tpIprec) -> - (case (({-# LINE 120 "src-ag/PrintCode.ag" #-} - "type" >#< hv_sp (name_ : params_) >#< "=" >#< _tpIpp - {-# LINE 1493 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1542 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1547 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1552 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOnested -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 1557 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOisDeclOfLet -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1562 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1567 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1572 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOnested -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 1577 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOisDeclOfLet -> - (case (tl_ _tlOisDeclOfLet _tlOnested _tlOoptions _tlOoutputfile ) of - { ( !_tlIpps) -> - (case (hd_ _hdOisDeclOfLet _hdOnested _hdOoptions _hdOoutputfile ) of - { ( !_hdIpp) -> - (case (({-# LINE 84 "src-ag/PrintCode.ag" #-} - _hdIpp : _tlIpps - {-# LINE 1586 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Decls_Nil :: T_Decls -sem_Decls_Nil = - (T_Decls (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (({-# LINE 85 "src-ag/PrintCode.ag" #-} - [] - {-# LINE 1598 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) })) ) --- Expr -------------------------------------------------------- -{- - visit 0: - inherited attributes: - nested : Bool - options : Options - outputfile : String - synthesized attribute: - pp : PP_Doc - alternatives: - alternative App: - child name : {String} - child args : Exprs - alternative Case: - child expr : Expr - child alts : CaseAlts - alternative Do: - child stmts : Decls - child body : Expr - alternative InvokeExpr: - child nt : {String} - child expr : Expr - child args : Exprs - alternative Lambda: - child args : Exprs - child body : Expr - visit 0: - local addBang : _ - local strictParams : _ - alternative Let: - child decls : Decls - child body : Expr - alternative LineExpr: - child expr : Expr - alternative PragmaExpr: - child onLeftSide : {Bool} - child onNewLine : {Bool} - child txt : {String} - child expr : Expr - alternative ResultExpr: - child nt : {String} - child expr : Expr - 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 : _ - alternative SimpleExpr: - child txt : {String} - alternative TextExpr: - child lns : {[String]} - alternative Trace: - child txt : {String} - child expr : Expr - alternative TupleExpr: - child exprs : Exprs - alternative TypedExpr: - child expr : Expr - child tp : Type - alternative UnboxedTupleExpr: - child exprs : Exprs --} --- cata -sem_Expr :: Expr -> - T_Expr -sem_Expr !(App _name _args ) = - (sem_Expr_App _name (sem_Exprs _args ) ) -sem_Expr !(Case _expr _alts ) = - (sem_Expr_Case (sem_Expr _expr ) (sem_CaseAlts _alts ) ) -sem_Expr !(Do _stmts _body ) = - (sem_Expr_Do (sem_Decls _stmts ) (sem_Expr _body ) ) -sem_Expr !(InvokeExpr _nt _expr _args ) = - (sem_Expr_InvokeExpr _nt (sem_Expr _expr ) (sem_Exprs _args ) ) -sem_Expr !(Lambda _args _body ) = - (sem_Expr_Lambda (sem_Exprs _args ) (sem_Expr _body ) ) -sem_Expr !(Let _decls _body ) = - (sem_Expr_Let (sem_Decls _decls ) (sem_Expr _body ) ) -sem_Expr !(LineExpr _expr ) = - (sem_Expr_LineExpr (sem_Expr _expr ) ) -sem_Expr !(PragmaExpr _onLeftSide _onNewLine _txt _expr ) = - (sem_Expr_PragmaExpr _onLeftSide _onNewLine _txt (sem_Expr _expr ) ) -sem_Expr !(ResultExpr _nt _expr ) = - (sem_Expr_ResultExpr _nt (sem_Expr _expr ) ) -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 ) ) -sem_Expr !(SimpleExpr _txt ) = - (sem_Expr_SimpleExpr _txt ) -sem_Expr !(TextExpr _lns ) = - (sem_Expr_TextExpr _lns ) -sem_Expr !(Trace _txt _expr ) = - (sem_Expr_Trace _txt (sem_Expr _expr ) ) -sem_Expr !(TupleExpr _exprs ) = - (sem_Expr_TupleExpr (sem_Exprs _exprs ) ) -sem_Expr !(TypedExpr _expr _tp ) = - (sem_Expr_TypedExpr (sem_Expr _expr ) (sem_Type _tp ) ) -sem_Expr !(UnboxedTupleExpr _exprs ) = - (sem_Expr_UnboxedTupleExpr (sem_Exprs _exprs ) ) --- semantic domain -newtype T_Expr = T_Expr (Bool -> - Options -> - String -> - ( PP_Doc)) -data Inh_Expr = Inh_Expr {nested_Inh_Expr :: !(Bool),options_Inh_Expr :: !(Options),outputfile_Inh_Expr :: !(String)} -data Syn_Expr = Syn_Expr {pp_Syn_Expr :: !(PP_Doc)} -wrap_Expr :: T_Expr -> - 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_App :: String -> - T_Exprs -> - T_Expr -sem_Expr_App !name_ !(T_Exprs args_ ) = - (T_Expr (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1730 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1735 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1740 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOnested -> - (case (args_ _argsOnested _argsOoptions _argsOoutputfile ) of - { ( !_argsIpps) -> - (case (({-# LINE 160 "src-ag/PrintCode.ag" #-} - pp_parens $ name_ >#< hv_sp _argsIpps - {-# LINE 1747 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1760 "src-ag/PrintCode.hs" #-} - )) of - { !_altsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1765 "src-ag/PrintCode.hs" #-} - )) of - { !_altsOoptions -> - (case (({-# LINE 55 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1770 "src-ag/PrintCode.hs" #-} - )) of - { !_altsOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1775 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1780 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1785 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOnested -> - (case (alts_ _altsOnested _altsOoptions _altsOoutputfile ) of - { ( !_altsIpps) -> - (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of - { ( !_exprIpp) -> - (case (({-# LINE 143 "src-ag/PrintCode.ag" #-} - pp_parens ( "case" >#< pp_parens _exprIpp >#< "of" - >-< (vlist _altsIpps) - ) - {-# LINE 1796 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1809 "src-ag/PrintCode.hs" #-} - )) of - { !_bodyOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1814 "src-ag/PrintCode.hs" #-} - )) of - { !_bodyOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1819 "src-ag/PrintCode.hs" #-} - )) of - { !_bodyOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1824 "src-ag/PrintCode.hs" #-} - )) of - { !_stmtsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1829 "src-ag/PrintCode.hs" #-} - )) of - { !_stmtsOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1834 "src-ag/PrintCode.hs" #-} - )) of - { !_stmtsOnested -> - (case (({-# LINE 412 "src-ag/PrintCode.ag" #-} - False - {-# LINE 1839 "src-ag/PrintCode.hs" #-} - )) of - { !_stmtsOisDeclOfLet -> - (case (body_ _bodyOnested _bodyOoptions _bodyOoutputfile ) of - { ( !_bodyIpp) -> - (case (stmts_ _stmtsOisDeclOfLet _stmtsOnested _stmtsOoptions _stmtsOoutputfile ) of - { ( !_stmtsIpps) -> - (case (({-# LINE 146 "src-ag/PrintCode.ag" #-} - pp_parens ( "do" >#< ( vlist _stmtsIpps - >-< ("return" >#< _bodyIpp)) - ) - {-# LINE 1850 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1864 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1869 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1874 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1879 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1884 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1889 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOnested -> - (case (args_ _argsOnested _argsOoptions _argsOoutputfile ) of - { ( !_argsIpps) -> - (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of - { ( !_exprIpp) -> - (case (({-# LINE 184 "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 1901 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1914 "src-ag/PrintCode.hs" #-} - )) of - { !_bodyOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1919 "src-ag/PrintCode.hs" #-} - )) of - { !_bodyOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1924 "src-ag/PrintCode.hs" #-} - )) of - { !_bodyOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1929 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1934 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1939 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOnested -> - (case (({-# LINE 152 "src-ag/PrintCode.ag" #-} - if bangpats _lhsIoptions - then \p -> pp_parens ("!" >|< p) - else id - {-# LINE 1946 "src-ag/PrintCode.hs" #-} - )) of - { !_addBang -> - (case (args_ _argsOnested _argsOoptions _argsOoutputfile ) of - { ( !_argsIpps) -> - (case (({-# LINE 149 "src-ag/PrintCode.ag" #-} - if strictSems _lhsIoptions - then _argsIpps - else [] - {-# LINE 1955 "src-ag/PrintCode.hs" #-} - )) of - { !_strictParams -> - (case (body_ _bodyOnested _bodyOoptions _bodyOoutputfile ) of - { ( !_bodyIpp) -> - (case (({-# LINE 155 "src-ag/PrintCode.ag" #-} - pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->" - >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp) - ) - {-# LINE 1964 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Expr_Let :: T_Decls -> - T_Expr -> - T_Expr -sem_Expr_Let !(T_Decls decls_ ) !(T_Expr body_ ) = - (T_Expr (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1977 "src-ag/PrintCode.hs" #-} - )) of - { !_bodyOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1982 "src-ag/PrintCode.hs" #-} - )) of - { !_bodyOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 1987 "src-ag/PrintCode.hs" #-} - )) of - { !_bodyOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 1992 "src-ag/PrintCode.hs" #-} - )) of - { !_declsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 1997 "src-ag/PrintCode.hs" #-} - )) of - { !_declsOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2002 "src-ag/PrintCode.hs" #-} - )) of - { !_declsOnested -> - (case (({-# LINE 410 "src-ag/PrintCode.ag" #-} - True - {-# LINE 2007 "src-ag/PrintCode.hs" #-} - )) of - { !_declsOisDeclOfLet -> - (case (body_ _bodyOnested _bodyOoptions _bodyOoutputfile ) of - { ( !_bodyIpp) -> - (case (decls_ _declsOisDeclOfLet _declsOnested _declsOoptions _declsOoutputfile ) of - { ( !_declsIpps) -> - (case (({-# LINE 140 "src-ag/PrintCode.ag" #-} - pp_parens ( "let" >#< (vlist _declsIpps) - >-< "in " >#< _bodyIpp - ) - {-# LINE 2018 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2030 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2035 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2040 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOnested -> - (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of - { ( !_exprIpp) -> - (case (({-# LINE 177 "src-ag/PrintCode.ag" #-} - _exprIpp >-< "{-# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show _lhsIoutputfile >#< "#-}" - >-< "" - {-# LINE 2048 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2063 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2068 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2073 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOnested -> - (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of - { ( !_exprIpp) -> - (case (({-# LINE 166 "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 2090 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2103 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2108 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2113 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOnested -> - (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of - { ( !_exprIpp) -> - (case (({-# LINE 180 "src-ag/PrintCode.ag" #-} - if breadthFirst _lhsIoptions - then "final" >#< - pp_parens (nt_ >|< "_Syn" >#< pp_parens _exprIpp) - else _exprIpp - {-# LINE 2123 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2138 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2143 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2148 "src-ag/PrintCode.hs" #-} - )) of - { !_rhsOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2153 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2158 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2163 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2168 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2173 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2178 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOnested -> - (case (({-# LINE 414 "src-ag/PrintCode.ag" #-} - False - {-# LINE 2183 "src-ag/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 188 "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 2205 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2219 "src-ag/PrintCode.hs" #-} - )) of - { !_bodyOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2224 "src-ag/PrintCode.hs" #-} - )) of - { !_bodyOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2229 "src-ag/PrintCode.hs" #-} - )) of - { !_bodyOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2234 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2239 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2244 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOnested -> - (case (({-# LINE 203 "src-ag/PrintCode.ag" #-} - if bangpats _lhsIoptions - then \p -> pp_parens ("!" >|< p) - else id - {-# LINE 2251 "src-ag/PrintCode.hs" #-} - )) of - { !_addBang -> - (case (args_ _argsOnested _argsOoptions _argsOoutputfile ) of - { ( !_argsIpps) -> - (case (({-# LINE 200 "src-ag/PrintCode.ag" #-} - if strictSems _lhsIoptions - then _argsIpps - else [] - {-# LINE 2260 "src-ag/PrintCode.hs" #-} - )) of - { !_strictParams -> - (case (body_ _bodyOnested _bodyOoptions _bodyOoutputfile ) of - { ( !_bodyIpp) -> - (case (({-# LINE 206 "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 2276 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Expr_SimpleExpr :: String -> - T_Expr -sem_Expr_SimpleExpr !txt_ = - (T_Expr (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (({-# LINE 161 "src-ag/PrintCode.ag" #-} - text txt_ - {-# LINE 2288 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - ( _lhsOpp) })) ) -sem_Expr_TextExpr :: ([String]) -> - T_Expr -sem_Expr_TextExpr !lns_ = - (T_Expr (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (({-# LINE 162 "src-ag/PrintCode.ag" #-} - vlist (map text lns_) - {-# LINE 2300 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2313 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2318 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2323 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOnested -> - (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of - { ( !_exprIpp) -> - (case (({-# LINE 163 "src-ag/PrintCode.ag" #-} - "trace" >#< ( pp_parens ("\"" >|< text txt_ >|< "\"") - >-< pp_parens _exprIpp - ) - {-# LINE 2332 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2344 "src-ag/PrintCode.hs" #-} - )) of - { !_exprsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2349 "src-ag/PrintCode.hs" #-} - )) of - { !_exprsOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2354 "src-ag/PrintCode.hs" #-} - )) of - { !_exprsOnested -> - (case (exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile ) of - { ( !_exprsIpps) -> - (case (({-# LINE 158 "src-ag/PrintCode.ag" #-} - ppTuple _lhsInested _exprsIpps - {-# LINE 2361 "src-ag/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 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2374 "src-ag/PrintCode.hs" #-} - )) of - { !_tpOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2379 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2384 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2389 "src-ag/PrintCode.hs" #-} - )) of - { !_exprOnested -> - (case (tp_ _tpOnested ) of - { ( !_tpIpp,!_tpIprec) -> - (case (expr_ _exprOnested _exprOoptions _exprOoutputfile ) of - { ( !_exprIpp) -> - (case (({-# LINE 179 "src-ag/PrintCode.ag" #-} - pp_parens (_exprIpp >#< "::" >#< _tpIpp) - {-# LINE 2398 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2410 "src-ag/PrintCode.hs" #-} - )) of - { !_exprsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2415 "src-ag/PrintCode.hs" #-} - )) of - { !_exprsOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2420 "src-ag/PrintCode.hs" #-} - )) of - { !_exprsOnested -> - (case (exprs_ _exprsOnested _exprsOoptions _exprsOoutputfile ) of - { ( !_exprsIpps) -> - (case (({-# LINE 159 "src-ag/PrintCode.ag" #-} - ppUnboxedTuple _lhsInested _exprsIpps - {-# LINE 2427 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2473 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2478 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2483 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOnested -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2488 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2493 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2498 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOnested -> - (case (tl_ _tlOnested _tlOoptions _tlOoutputfile ) of - { ( !_tlIpps) -> - (case (hd_ _hdOnested _hdOoptions _hdOoutputfile ) of - { ( !_hdIpp) -> - (case (({-# LINE 64 "src-ag/PrintCode.ag" #-} - _hdIpp : _tlIpps - {-# LINE 2507 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) }) }) }) }) }) }) }) }) })) ) -sem_Exprs_Nil :: T_Exprs -sem_Exprs_Nil = - (T_Exprs (\ (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (({-# LINE 65 "src-ag/PrintCode.ag" #-} - [] - {-# LINE 2518 "src-ag/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 Fun: - child name : {String} - child args : Exprs - visit 0: - local addBang : _ - local strictGuard : _ - local hasStrictVars : _ - local addStrictGuard : _ - alternative Pattern3: - child pat3 : Pattern - visit 0: - local hasStrictVars : _ - local strictGuard : _ - local addStrictGuard : _ - alternative Pattern3SM: - child pat3 : Pattern - alternative TupleLhs: - child comps : {[String]} - visit 0: - local addBang : _ - local hasStrictVars : _ - local strictGuard : _ - local addStrictGuard : _ - alternative UnboxedTupleLhs: - child comps : {[String]} - visit 0: - local addBang : _ - local hasStrictVars : _ - local strictGuard : _ - local addStrictGuard : _ - alternative Unwrap: - child name : {String} - child sub : Lhs --} --- cata -sem_Lhs :: Lhs -> - T_Lhs -sem_Lhs !(Fun _name _args ) = - (sem_Lhs_Fun _name (sem_Exprs _args ) ) -sem_Lhs !(Pattern3 _pat3 ) = - (sem_Lhs_Pattern3 (sem_Pattern _pat3 ) ) -sem_Lhs !(Pattern3SM _pat3 ) = - (sem_Lhs_Pattern3SM (sem_Pattern _pat3 ) ) -sem_Lhs !(TupleLhs _comps ) = - (sem_Lhs_TupleLhs _comps ) -sem_Lhs !(UnboxedTupleLhs _comps ) = - (sem_Lhs_UnboxedTupleLhs _comps ) -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_Fun :: String -> - T_Exprs -> - T_Lhs -sem_Lhs_Fun !name_ !(T_Exprs args_ ) = - (T_Lhs (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (({-# LINE 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2606 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2611 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOoptions -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2616 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOnested -> - (case (({-# LINE 247 "src-ag/PrintCode.ag" #-} - if bangpats _lhsIoptions - then \p -> "!" >|< p - else id - {-# LINE 2623 "src-ag/PrintCode.hs" #-} - )) of - { !_addBang -> - (case (args_ _argsOnested _argsOoptions _argsOoutputfile ) of - { ( !_argsIpps) -> - (case (({-# LINE 244 "src-ag/PrintCode.ag" #-} - _argsIpps `ppMultiSeqH` (pp "True") - {-# LINE 2630 "src-ag/PrintCode.hs" #-} - )) of - { !_strictGuard -> - (case (({-# LINE 243 "src-ag/PrintCode.ag" #-} - not (null _argsIpps) - {-# LINE 2635 "src-ag/PrintCode.hs" #-} - )) of - { !_hasStrictVars -> - (case (({-# LINE 242 "src-ag/PrintCode.ag" #-} - if strictSems _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id - {-# LINE 2640 "src-ag/PrintCode.hs" #-} - )) of - { !_addStrictGuard -> - (case (({-# LINE 255 "src-ag/PrintCode.ag" #-} - _addStrictGuard (name_ >#< hv_sp (map _addBang _argsIpps)) - {-# LINE 2645 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) }) }) }) }) })) ) -sem_Lhs_Pattern3 :: T_Pattern -> - T_Lhs -sem_Lhs_Pattern3 !(T_Pattern pat3_ ) = - (T_Lhs (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2658 "src-ag/PrintCode.hs" #-} - )) of - { !_pat3Ooptions -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 2663 "src-ag/PrintCode.hs" #-} - )) of - { !_pat3OisDeclOfLet -> - (case (({-# LINE 376 "src-ag/PrintCode.ag" #-} - False - {-# LINE 2668 "src-ag/PrintCode.hs" #-} - )) of - { !_pat3ObelowIrrefutable -> - (case (pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions ) of - { ( !_pat3Icopy,!_pat3IisUnderscore,!_pat3Ipp,!_pat3Ipp',!_pat3IstrictVars) -> - (case (({-# LINE 234 "src-ag/PrintCode.ag" #-} - not (null _pat3IstrictVars) - {-# LINE 2675 "src-ag/PrintCode.hs" #-} - )) of - { !_hasStrictVars -> - (case (({-# LINE 233 "src-ag/PrintCode.ag" #-} - _pat3IstrictVars `ppMultiSeqH` (pp "True") - {-# LINE 2680 "src-ag/PrintCode.hs" #-} - )) of - { !_strictGuard -> - (case (({-# LINE 231 "src-ag/PrintCode.ag" #-} - if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id - {-# LINE 2685 "src-ag/PrintCode.hs" #-} - )) of - { !_addStrictGuard -> - (case (({-# LINE 251 "src-ag/PrintCode.ag" #-} - _addStrictGuard _pat3Ipp - {-# LINE 2690 "src-ag/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 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2703 "src-ag/PrintCode.hs" #-} - )) of - { !_pat3Ooptions -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 2708 "src-ag/PrintCode.hs" #-} - )) of - { !_pat3OisDeclOfLet -> - (case (({-# LINE 376 "src-ag/PrintCode.ag" #-} - False - {-# LINE 2713 "src-ag/PrintCode.hs" #-} - )) of - { !_pat3ObelowIrrefutable -> - (case (pat3_ _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions ) of - { ( !_pat3Icopy,!_pat3IisUnderscore,!_pat3Ipp,!_pat3Ipp',!_pat3IstrictVars) -> - (case (({-# LINE 252 "src-ag/PrintCode.ag" #-} - _pat3Ipp' - {-# LINE 2720 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) })) ) -sem_Lhs_TupleLhs :: ([String]) -> - T_Lhs -sem_Lhs_TupleLhs !comps_ = - (T_Lhs (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (({-# LINE 247 "src-ag/PrintCode.ag" #-} - if bangpats _lhsIoptions - then \p -> "!" >|< p - else id - {-# LINE 2735 "src-ag/PrintCode.hs" #-} - )) of - { !_addBang -> - (case (({-# LINE 239 "src-ag/PrintCode.ag" #-} - not (null comps_) - {-# LINE 2740 "src-ag/PrintCode.hs" #-} - )) of - { !_hasStrictVars -> - (case (({-# LINE 236 "src-ag/PrintCode.ag" #-} - if stricterCases _lhsIoptions && not _lhsIisDeclOfLet - then map text comps_ `ppMultiSeqH` (pp "True") - else pp "True" - {-# LINE 2747 "src-ag/PrintCode.hs" #-} - )) of - { !_strictGuard -> - (case (({-# LINE 231 "src-ag/PrintCode.ag" #-} - if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id - {-# LINE 2752 "src-ag/PrintCode.hs" #-} - )) of - { !_addStrictGuard -> - (case (({-# LINE 253 "src-ag/PrintCode.ag" #-} - _addStrictGuard $ ppTuple _lhsInested (map (_addBang . text) comps_) - {-# LINE 2757 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - ( _lhsOpp) }) }) }) }) })) ) -sem_Lhs_UnboxedTupleLhs :: ([String]) -> - T_Lhs -sem_Lhs_UnboxedTupleLhs !comps_ = - (T_Lhs (\ (!_lhsIisDeclOfLet) - (!_lhsInested) - (!_lhsIoptions) - (!_lhsIoutputfile) -> - (case (({-# LINE 247 "src-ag/PrintCode.ag" #-} - if bangpats _lhsIoptions - then \p -> "!" >|< p - else id - {-# LINE 2772 "src-ag/PrintCode.hs" #-} - )) of - { !_addBang -> - (case (({-# LINE 239 "src-ag/PrintCode.ag" #-} - not (null comps_) - {-# LINE 2777 "src-ag/PrintCode.hs" #-} - )) of - { !_hasStrictVars -> - (case (({-# LINE 236 "src-ag/PrintCode.ag" #-} - if stricterCases _lhsIoptions && not _lhsIisDeclOfLet - then map text comps_ `ppMultiSeqH` (pp "True") - else pp "True" - {-# LINE 2784 "src-ag/PrintCode.hs" #-} - )) of - { !_strictGuard -> - (case (({-# LINE 231 "src-ag/PrintCode.ag" #-} - if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id - {-# LINE 2789 "src-ag/PrintCode.hs" #-} - )) of - { !_addStrictGuard -> - (case (({-# LINE 254 "src-ag/PrintCode.ag" #-} - _addStrictGuard $ ppUnboxedTuple _lhsInested (map (_addBang . text) comps_) - {-# LINE 2794 "src-ag/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 39 "src-ag/PrintCode.ag" #-} - _lhsIoutputfile - {-# LINE 2808 "src-ag/PrintCode.hs" #-} - )) of - { !_subOoutputfile -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 2813 "src-ag/PrintCode.hs" #-} - )) of - { !_subOoptions -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2818 "src-ag/PrintCode.hs" #-} - )) of - { !_subOnested -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 2823 "src-ag/PrintCode.hs" #-} - )) of - { !_subOisDeclOfLet -> - (case (sub_ _subOisDeclOfLet _subOnested _subOoptions _subOoutputfile ) of - { ( !_subIpp) -> - (case (({-# LINE 256 "src-ag/PrintCode.ag" #-} - pp_parens (name_ >#< _subIpp) - {-# LINE 2830 "src-ag/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 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2871 "src-ag/PrintCode.hs" #-} - )) of - { !_tpOnested -> - (case (tp_ _tpOnested ) of - { ( !_tpIpp,!_tpIprec) -> - (case (({-# LINE 225 "src-ag/PrintCode.ag" #-} - if strict_ - then name_ >#< "::" >#< "!" >|< pp_parens _tpIpp - else name_ >#< "::" >#< _tpIpp - {-# LINE 2880 "src-ag/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 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2920 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOnested -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 2925 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOnested -> - (case (tl_ _tlOnested ) of - { ( !_tlIpps) -> - (case (hd_ _hdOnested ) of - { ( !_hdIpp) -> - (case (({-# LINE 80 "src-ag/PrintCode.ag" #-} - _hdIpp : _tlIpps - {-# LINE 2934 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) }) }) }) }) })) ) -sem_NamedTypes_Nil :: T_NamedTypes -sem_NamedTypes_Nil = - (T_NamedTypes (\ (!_lhsInested) -> - (case (({-# LINE 81 "src-ag/PrintCode.ag" #-} - [] - {-# LINE 2943 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) })) ) --- Pattern ----------------------------------------------------- -{- - visit 0: - inherited attributes: - belowIrrefutable : Bool - isDeclOfLet : Bool - options : Options - synthesized attributes: - copy : SELF - isUnderscore : Bool - pp : PP_Doc - pp' : PP_Doc - strictVars : [PP_Doc] - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - local ppVar : _ - local addBang : _ - local ppVarBang : _ - local strictPatVars : _ - local strictVar : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - local addBang : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - local addBang : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern !(Alias _field _attr _pat _parts ) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) -sem_Pattern !(Constr _name _pats ) = - (sem_Pattern_Constr _name (sem_Patterns _pats ) ) -sem_Pattern !(Irrefutable _pat ) = - (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) -sem_Pattern !(Product _pos _pats ) = - (sem_Pattern_Product _pos (sem_Patterns _pats ) ) -sem_Pattern !(Underscore _pos ) = - (sem_Pattern_Underscore _pos ) --- semantic domain -newtype T_Pattern = T_Pattern (Bool -> - Bool -> - Options -> - ( Pattern ,Bool,PP_Doc,PP_Doc,([PP_Doc]))) -data Inh_Pattern = Inh_Pattern {belowIrrefutable_Inh_Pattern :: !(Bool),isDeclOfLet_Inh_Pattern :: !(Bool),options_Inh_Pattern :: !(Options)} -data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern ),isUnderscore_Syn_Pattern :: !(Bool),pp_Syn_Pattern :: !(PP_Doc),pp'_Syn_Pattern :: !(PP_Doc),strictVars_Syn_Pattern :: !(([PP_Doc]))} -wrap_Pattern :: T_Pattern -> - 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_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_ ) !(T_Patterns parts_ ) = - (T_Pattern (\ (!_lhsIbelowIrrefutable) - (!_lhsIisDeclOfLet) - (!_lhsIoptions) -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 3031 "src-ag/PrintCode.hs" #-} - )) of - { !_partsOoptions -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 3036 "src-ag/PrintCode.hs" #-} - )) of - { !_partsOisDeclOfLet -> - (case (({-# LINE 369 "src-ag/PrintCode.ag" #-} - _lhsIbelowIrrefutable - {-# LINE 3041 "src-ag/PrintCode.hs" #-} - )) of - { !_partsObelowIrrefutable -> - (case (parts_ _partsObelowIrrefutable _partsOisDeclOfLet _partsOoptions ) of - { ( !_partsIcopy,!_partsIpps,!_partsIpps',!_partsIstrictVars) -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 3048 "src-ag/PrintCode.hs" #-} - )) of - { !_patOoptions -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 3053 "src-ag/PrintCode.hs" #-} - )) of - { !_patOisDeclOfLet -> - (case (({-# LINE 369 "src-ag/PrintCode.ag" #-} - _lhsIbelowIrrefutable - {-# LINE 3058 "src-ag/PrintCode.hs" #-} - )) of - { !_patObelowIrrefutable -> - (case (pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions ) of - { ( !_patIcopy,!_patIisUnderscore,!_patIpp,!_patIpp',!_patIstrictVars) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 3065 "src-ag/PrintCode.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3070 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 366 "src-ag/PrintCode.ag" #-} - False - {-# LINE 3075 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOisUnderscore -> - (case (({-# LINE 355 "src-ag/PrintCode.ag" #-} - pp (attrname False field_ attr_) - {-# LINE 3080 "src-ag/PrintCode.hs" #-} - )) of - { !_ppVar -> - (case (({-# LINE 348 "src-ag/PrintCode.ag" #-} - if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable - then \p -> "!" >|< p - else id - {-# LINE 3087 "src-ag/PrintCode.hs" #-} - )) of - { !_addBang -> - (case (({-# LINE 356 "src-ag/PrintCode.ag" #-} - _addBang $ _ppVar - {-# LINE 3092 "src-ag/PrintCode.hs" #-} - )) of - { !_ppVarBang -> - (case (({-# LINE 357 "src-ag/PrintCode.ag" #-} - if _patIisUnderscore - then _ppVarBang - else _ppVarBang >|< "@" >|< _patIpp - {-# LINE 3099 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 389 "src-ag/PrintCode.ag" #-} - let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_ - | otherwise = attrname False field_ attr_ - in attribute >|< "@" >|< _patIpp' - {-# LINE 3106 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp' -> - (case (({-# LINE 329 "src-ag/PrintCode.ag" #-} - if stricterCases _lhsIoptions && not _lhsIisDeclOfLet - then _patIstrictVars - else [] - {-# LINE 3113 "src-ag/PrintCode.hs" #-} - )) of - { !_strictPatVars -> - (case (({-# LINE 325 "src-ag/PrintCode.ag" #-} - if strictCases _lhsIoptions && not _lhsIisDeclOfLet - then [_ppVar ] - else [] - {-# LINE 3120 "src-ag/PrintCode.hs" #-} - )) of - { !_strictVar -> - (case (({-# LINE 333 "src-ag/PrintCode.ag" #-} - _strictVar ++ _strictPatVars - {-# LINE 3125 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOstrictVars -> - ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Pattern_Constr :: ConstructorIdent -> - T_Patterns -> - T_Pattern -sem_Pattern_Constr !name_ !(T_Patterns pats_ ) = - (T_Pattern (\ (!_lhsIbelowIrrefutable) - (!_lhsIisDeclOfLet) - (!_lhsIoptions) -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 3138 "src-ag/PrintCode.hs" #-} - )) of - { !_patsOoptions -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 3143 "src-ag/PrintCode.hs" #-} - )) of - { !_patsOisDeclOfLet -> - (case (({-# LINE 369 "src-ag/PrintCode.ag" #-} - _lhsIbelowIrrefutable - {-# LINE 3148 "src-ag/PrintCode.hs" #-} - )) of - { !_patsObelowIrrefutable -> - (case (pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions ) of - { ( !_patsIcopy,!_patsIpps,!_patsIpps',!_patsIstrictVars) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 3155 "src-ag/PrintCode.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3160 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 364 "src-ag/PrintCode.ag" #-} - False - {-# LINE 3165 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOisUnderscore -> - (case (({-# LINE 348 "src-ag/PrintCode.ag" #-} - if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable - then \p -> "!" >|< p - else id - {-# LINE 3172 "src-ag/PrintCode.hs" #-} - )) of - { !_addBang -> - (case (({-# LINE 353 "src-ag/PrintCode.ag" #-} - _addBang $ pp_parens $ name_ >#< hv_sp _patsIpps - {-# LINE 3177 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 387 "src-ag/PrintCode.ag" #-} - pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps') - {-# LINE 3182 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp' -> - (case (({-# LINE 322 "src-ag/PrintCode.ag" #-} - _patsIstrictVars - {-# LINE 3187 "src-ag/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 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 3199 "src-ag/PrintCode.hs" #-} - )) of - { !_patOoptions -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 3204 "src-ag/PrintCode.hs" #-} - )) of - { !_patOisDeclOfLet -> - (case (({-# LINE 372 "src-ag/PrintCode.ag" #-} - True - {-# LINE 3209 "src-ag/PrintCode.hs" #-} - )) of - { !_patObelowIrrefutable -> - (case (pat_ _patObelowIrrefutable _patOisDeclOfLet _patOoptions ) of - { ( !_patIcopy,!_patIisUnderscore,!_patIpp,!_patIpp',!_patIstrictVars) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 3216 "src-ag/PrintCode.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3221 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 363 "src-ag/PrintCode.ag" #-} - _patIisUnderscore - {-# LINE 3226 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOisUnderscore -> - (case (({-# LINE 360 "src-ag/PrintCode.ag" #-} - text "~" >|< pp_parens _patIpp - {-# LINE 3231 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 392 "src-ag/PrintCode.ag" #-} - text "~" >|< pp_parens _patIpp - {-# LINE 3236 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp' -> - (case (({-# LINE 336 "src-ag/PrintCode.ag" #-} - [] - {-# LINE 3241 "src-ag/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 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 3254 "src-ag/PrintCode.hs" #-} - )) of - { !_patsOoptions -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 3259 "src-ag/PrintCode.hs" #-} - )) of - { !_patsOisDeclOfLet -> - (case (({-# LINE 369 "src-ag/PrintCode.ag" #-} - _lhsIbelowIrrefutable - {-# LINE 3264 "src-ag/PrintCode.hs" #-} - )) of - { !_patsObelowIrrefutable -> - (case (pats_ _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions ) of - { ( !_patsIcopy,!_patsIpps,!_patsIpps',!_patsIstrictVars) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 3271 "src-ag/PrintCode.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3276 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 365 "src-ag/PrintCode.ag" #-} - False - {-# LINE 3281 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOisUnderscore -> - (case (({-# LINE 348 "src-ag/PrintCode.ag" #-} - if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable - then \p -> "!" >|< p - else id - {-# LINE 3288 "src-ag/PrintCode.hs" #-} - )) of - { !_addBang -> - (case (({-# LINE 354 "src-ag/PrintCode.ag" #-} - _addBang $ pp_block "(" ")" "," _patsIpps - {-# LINE 3293 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 388 "src-ag/PrintCode.ag" #-} - pp_block "(" ")" "," _patsIpps' - {-# LINE 3298 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp' -> - (case (({-# LINE 322 "src-ag/PrintCode.ag" #-} - _patsIstrictVars - {-# LINE 3303 "src-ag/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 23 "src-ag/Patterns.ag" #-} - Underscore pos_ - {-# LINE 3315 "src-ag/PrintCode.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3320 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 367 "src-ag/PrintCode.ag" #-} - True - {-# LINE 3325 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOisUnderscore -> - (case (({-# LINE 361 "src-ag/PrintCode.ag" #-} - text "_" - {-# LINE 3330 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 393 "src-ag/PrintCode.ag" #-} - text "_" - {-# LINE 3335 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp' -> - (case (({-# LINE 322 "src-ag/PrintCode.ag" #-} - [] - {-# LINE 3340 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOstrictVars -> - ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp,_lhsOpp',_lhsOstrictVars) }) }) }) }) }) })) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - inherited attributes: - belowIrrefutable : Bool - isDeclOfLet : Bool - options : Options - synthesized attributes: - copy : SELF - pps : [PP_Doc] - pps' : [PP_Doc] - strictVars : [PP_Doc] - alternatives: - alternative Cons: - child hd : Pattern - child tl : Patterns - visit 0: - local copy : _ - alternative Nil: - visit 0: - local copy : _ --} --- cata -sem_Patterns :: Patterns -> - T_Patterns -sem_Patterns !list = - (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) ) --- semantic domain -newtype T_Patterns = T_Patterns (Bool -> - Bool -> - Options -> - ( Patterns ,([PP_Doc]),([PP_Doc]),([PP_Doc]))) -data Inh_Patterns = Inh_Patterns {belowIrrefutable_Inh_Patterns :: !(Bool),isDeclOfLet_Inh_Patterns :: !(Bool),options_Inh_Patterns :: !(Options)} -data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns ),pps_Syn_Patterns :: !(([PP_Doc])),pps'_Syn_Patterns :: !(([PP_Doc])),strictVars_Syn_Patterns :: !(([PP_Doc]))} -wrap_Patterns :: T_Patterns -> - 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 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 3393 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOoptions -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 3398 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOisDeclOfLet -> - (case (({-# LINE 369 "src-ag/PrintCode.ag" #-} - _lhsIbelowIrrefutable - {-# LINE 3403 "src-ag/PrintCode.hs" #-} - )) of - { !_tlObelowIrrefutable -> - (case (tl_ _tlObelowIrrefutable _tlOisDeclOfLet _tlOoptions ) of - { ( !_tlIcopy,!_tlIpps,!_tlIpps',!_tlIstrictVars) -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _lhsIoptions - {-# LINE 3410 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOoptions -> - (case (({-# LINE 403 "src-ag/PrintCode.ag" #-} - _lhsIisDeclOfLet - {-# LINE 3415 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOisDeclOfLet -> - (case (({-# LINE 369 "src-ag/PrintCode.ag" #-} - _lhsIbelowIrrefutable - {-# LINE 3420 "src-ag/PrintCode.hs" #-} - )) of - { !_hdObelowIrrefutable -> - (case (hd_ _hdObelowIrrefutable _hdOisDeclOfLet _hdOoptions ) of - { ( !_hdIcopy,!_hdIisUnderscore,!_hdIpp,!_hdIpp',!_hdIstrictVars) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 3427 "src-ag/PrintCode.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3432 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 343 "src-ag/PrintCode.ag" #-} - _hdIpp : _tlIpps - {-# LINE 3437 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpps -> - (case (({-# LINE 383 "src-ag/PrintCode.ag" #-} - _hdIpp' : _tlIpps' - {-# LINE 3442 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpps' -> - (case (({-# LINE 322 "src-ag/PrintCode.ag" #-} - _hdIstrictVars ++ _tlIstrictVars - {-# LINE 3447 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOstrictVars -> - ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars) }) }) }) }) }) }) }) }) }) }) }) }) })) ) -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = - (T_Patterns (\ (!_lhsIbelowIrrefutable) - (!_lhsIisDeclOfLet) - (!_lhsIoptions) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - [] - {-# LINE 3458 "src-ag/PrintCode.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 3463 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 344 "src-ag/PrintCode.ag" #-} - [] - {-# LINE 3468 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpps -> - (case (({-# LINE 384 "src-ag/PrintCode.ag" #-} - [] - {-# LINE 3473 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpps' -> - (case (({-# LINE 322 "src-ag/PrintCode.ag" #-} - [] - {-# LINE 3478 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOstrictVars -> - ( _lhsOcopy,_lhsOpps,_lhsOpps',_lhsOstrictVars) }) }) }) }) })) ) --- Program ----------------------------------------------------- -{- - visit 0: - inherited attributes: - importBlocks : PP_Doc - mainFile : String - mainName : String - moduleHeader : String -> String -> String -> Bool -> String - options : Options - optionsLine : String - pragmaBlocks : String - textBlockMap : Map BlockInfo PP_Doc - textBlocks : PP_Doc - synthesized attributes: - genIO : IO () - output : PP_Docs - alternatives: - alternative Program: - child chunks : Chunks - 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 -> - String -> - String -> - (String -> String -> String -> Bool -> String) -> - Options -> - String -> - String -> - (Map BlockInfo PP_Doc) -> - PP_Doc -> - ( (IO ()),PP_Docs)) -data Inh_Program = Inh_Program {importBlocks_Inh_Program :: !(PP_Doc),mainFile_Inh_Program :: !(String),mainName_Inh_Program :: !(String),moduleHeader_Inh_Program :: !((String -> String -> String -> Bool -> String)),options_Inh_Program :: !(Options),optionsLine_Inh_Program :: !(String),pragmaBlocks_Inh_Program :: !(String),textBlockMap_Inh_Program :: !((Map BlockInfo PP_Doc)),textBlocks_Inh_Program :: !(PP_Doc)} -data Syn_Program = Syn_Program {genIO_Syn_Program :: !((IO ())),output_Syn_Program :: !(PP_Docs)} -wrap_Program :: T_Program -> - Inh_Program -> - Syn_Program -wrap_Program !(T_Program sem ) !(Inh_Program _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks ) = - (let ( !_lhsOgenIO,!_lhsOoutput) = sem _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks - in (Syn_Program _lhsOgenIO _lhsOoutput )) -sem_Program_Program :: T_Chunks -> - Bool -> - T_Program -sem_Program_Program !(T_Chunks chunks_ ) !ordered_ = - (T_Program (\ (!_lhsIimportBlocks) - (!_lhsImainFile) - (!_lhsImainName) - (!_lhsImoduleHeader) - (!_lhsIoptions) - (!_lhsIoptionsLine) - (!_lhsIpragmaBlocks) - (!_lhsItextBlockMap) - (!_lhsItextBlocks) -> - (case (({-# LINE 431 "src-ag/PrintCode.ag" #-} - _lhsItextBlockMap - {-# LINE 3548 "src-ag/PrintCode.hs" #-} - )) of - { !_chunksOtextBlockMap -> - (case (({-# LINE 429 "src-ag/PrintCode.ag" #-} - _lhsIpragmaBlocks - {-# LINE 3553 "src-ag/PrintCode.hs" #-} - )) of - { !_chunksOpragmaBlocks -> - (case (({-# LINE 432 "src-ag/PrintCode.ag" #-} - _lhsIoptionsLine - {-# LINE 3558 "src-ag/PrintCode.hs" #-} - )) of - { !_chunksOoptionsLine -> - (case (({-# LINE 58 "src-ag/PrintCode.ag" #-} - _lhsIoptions { breadthFirst = breadthFirst _lhsIoptions && visit _lhsIoptions && cases _lhsIoptions && ordered_ } - {-# LINE 3563 "src-ag/PrintCode.hs" #-} - )) of - { !_options -> - (case (({-# LINE 49 "src-ag/PrintCode.ag" #-} - _options - {-# LINE 3568 "src-ag/PrintCode.hs" #-} - )) of - { !_chunksOoptions -> - (case (({-# LINE 435 "src-ag/PrintCode.ag" #-} - _lhsImoduleHeader - {-# LINE 3573 "src-ag/PrintCode.hs" #-} - )) of - { !_chunksOmoduleHeader -> - (case (({-# LINE 434 "src-ag/PrintCode.ag" #-} - _lhsImainName - {-# LINE 3578 "src-ag/PrintCode.hs" #-} - )) of - { !_chunksOmainName -> - (case (({-# LINE 433 "src-ag/PrintCode.ag" #-} - _lhsImainFile - {-# LINE 3583 "src-ag/PrintCode.hs" #-} - )) of - { !_chunksOmainFile -> - (case (({-# LINE 452 "src-ag/PrintCode.ag" #-} - _lhsImainFile ++ "_common.hs" - {-# LINE 3588 "src-ag/PrintCode.hs" #-} - )) of - { !_commonFile -> - (case (({-# LINE 406 "src-ag/PrintCode.ag" #-} - False - {-# LINE 3593 "src-ag/PrintCode.hs" #-} - )) of - { !_chunksOisDeclOfLet -> - (case (({-# LINE 61 "src-ag/PrintCode.ag" #-} - nest _lhsIoptions - {-# LINE 3598 "src-ag/PrintCode.hs" #-} - )) of - { !_chunksOnested -> - (case (({-# LINE 430 "src-ag/PrintCode.ag" #-} - _lhsItextBlocks - {-# LINE 3603 "src-ag/PrintCode.hs" #-} - )) of - { !_chunksOtextBlocks -> - (case (({-# LINE 428 "src-ag/PrintCode.ag" #-} - _lhsIimportBlocks - {-# LINE 3608 "src-ag/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 453 "src-ag/PrintCode.ag" #-} - writeModule _commonFile - ( [ pp $ _lhsIpragmaBlocks - , pp $ _lhsIoptionsLine - , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True - , _lhsIimportBlocks - , _lhsItextBlocks - ] - ++ map vlist _chunksIappendCommon - ) - {-# LINE 3623 "src-ag/PrintCode.hs" #-} - )) of - { !_genCommonModule -> - (case (({-# LINE 440 "src-ag/PrintCode.ag" #-} - _lhsImainFile ++ ".hs" - {-# LINE 3628 "src-ag/PrintCode.hs" #-} - )) of - { !_mainModuleFile -> - (case (({-# LINE 441 "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 - ) - {-# LINE 3641 "src-ag/PrintCode.hs" #-} - )) of - { !_genMainModule -> - (case (({-# LINE 464 "src-ag/PrintCode.ag" #-} - do _genMainModule - _genCommonModule - _chunksIgenSems - {-# LINE 3648 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOgenIO -> - (case (({-# LINE 93 "src-ag/PrintCode.ag" #-} - _chunksIpps - {-# LINE 3653 "src-ag/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 List: - child tp : Type - alternative NontermType: - child name : {String} - child params : {[String]} - alternative QuantApp: - child left : {String} - child right : Type - alternative SimpleType: - child txt : {String} - alternative TEither: - child left : Type - child right : Type - alternative TIntMap: - child value : Type - alternative TMap: - child key : Type - child value : Type - alternative TMaybe: - child tp : Type - alternative TupleType: - child tps : Types - alternative TypeApp: - child func : Type - child args : Types - alternative UnboxedTupleType: - child tps : Types --} --- cata -sem_Type :: Type -> - T_Type -sem_Type !(Arr _left _right ) = - (sem_Type_Arr (sem_Type _left ) (sem_Type _right ) ) -sem_Type !(CtxApp _left _right ) = - (sem_Type_CtxApp _left (sem_Type _right ) ) -sem_Type !(List _tp ) = - (sem_Type_List (sem_Type _tp ) ) -sem_Type !(NontermType _name _params ) = - (sem_Type_NontermType _name _params ) -sem_Type !(QuantApp _left _right ) = - (sem_Type_QuantApp _left (sem_Type _right ) ) -sem_Type !(SimpleType _txt ) = - (sem_Type_SimpleType _txt ) -sem_Type !(TEither _left _right ) = - (sem_Type_TEither (sem_Type _left ) (sem_Type _right ) ) -sem_Type !(TIntMap _value ) = - (sem_Type_TIntMap (sem_Type _value ) ) -sem_Type !(TMap _key _value ) = - (sem_Type_TMap (sem_Type _key ) (sem_Type _value ) ) -sem_Type !(TMaybe _tp ) = - (sem_Type_TMaybe (sem_Type _tp ) ) -sem_Type !(TupleType _tps ) = - (sem_Type_TupleType (sem_Types _tps ) ) -sem_Type !(TypeApp _func _args ) = - (sem_Type_TypeApp (sem_Type _func ) (sem_Types _args ) ) -sem_Type !(UnboxedTupleType _tps ) = - (sem_Type_UnboxedTupleType (sem_Types _tps ) ) --- semantic domain -newtype T_Type = T_Type (Bool -> - ( PP_Doc,Int)) -data Inh_Type = Inh_Type {nested_Inh_Type :: !(Bool)} -data Syn_Type = Syn_Type {pp_Syn_Type :: !(PP_Doc),prec_Syn_Type :: !(Int)} -wrap_Type :: T_Type -> - 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 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 3750 "src-ag/PrintCode.hs" #-} - )) of - { !_rightOnested -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 3755 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOnested -> - (case (right_ _rightOnested ) of - { ( !_rightIpp,!_rightIprec) -> - (case (({-# LINE 262 "src-ag/PrintCode.ag" #-} - if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp - {-# LINE 3762 "src-ag/PrintCode.hs" #-} - )) of - { !_r -> - (case (left_ _leftOnested ) of - { ( !_leftIpp,!_leftIprec) -> - (case (({-# LINE 261 "src-ag/PrintCode.ag" #-} - if _leftIprec <= 2 then pp_parens _leftIpp else _leftIpp - {-# LINE 3769 "src-ag/PrintCode.hs" #-} - )) of - { !_l -> - (case (({-# LINE 260 "src-ag/PrintCode.ag" #-} - _l >#< "->" >-< _r - {-# LINE 3774 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 259 "src-ag/PrintCode.ag" #-} - 2 - {-# LINE 3779 "src-ag/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 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 3790 "src-ag/PrintCode.hs" #-} - )) of - { !_rightOnested -> - (case (right_ _rightOnested ) of - { ( !_rightIpp,!_rightIprec) -> - (case (({-# LINE 268 "src-ag/PrintCode.ag" #-} - (pp_block "(" ")" "," $ map (\(n,ns) -> hv_sp $ map pp (n:ns)) left_) >#< "=>" >#< _rightIpp - {-# LINE 3797 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 258 "src-ag/PrintCode.ag" #-} - _rightIprec - {-# LINE 3802 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOprec -> - ( _lhsOpp,_lhsOprec) }) }) }) })) ) -sem_Type_List :: T_Type -> - T_Type -sem_Type_List !(T_Type tp_ ) = - (T_Type (\ (!_lhsInested) -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 3812 "src-ag/PrintCode.hs" #-} - )) of - { !_tpOnested -> - (case (tp_ _tpOnested ) of - { ( !_tpIpp,!_tpIprec) -> - (case (({-# LINE 279 "src-ag/PrintCode.ag" #-} - "[" >|< _tpIpp >|< "]" - {-# LINE 3819 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 278 "src-ag/PrintCode.ag" #-} - 5 - {-# LINE 3824 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOprec -> - ( _lhsOpp,_lhsOprec) }) }) }) })) ) -sem_Type_NontermType :: String -> - ([String]) -> - T_Type -sem_Type_NontermType !name_ !params_ = - (T_Type (\ (!_lhsInested) -> - (case (({-# LINE 285 "src-ag/PrintCode.ag" #-} - text name_ >#< hv_sp params_ - {-# LINE 3835 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 284 "src-ag/PrintCode.ag" #-} - 5 - {-# LINE 3840 "src-ag/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 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 3851 "src-ag/PrintCode.hs" #-} - )) of - { !_rightOnested -> - (case (right_ _rightOnested ) of - { ( !_rightIpp,!_rightIprec) -> - (case (({-# LINE 270 "src-ag/PrintCode.ag" #-} - left_ >#< _rightIpp - {-# LINE 3858 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 258 "src-ag/PrintCode.ag" #-} - _rightIprec - {-# LINE 3863 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOprec -> - ( _lhsOpp,_lhsOprec) }) }) }) })) ) -sem_Type_SimpleType :: String -> - T_Type -sem_Type_SimpleType !txt_ = - (T_Type (\ (!_lhsInested) -> - (case (({-# LINE 282 "src-ag/PrintCode.ag" #-} - if reallySimple txt_ then text txt_ else pp_parens (text txt_) - {-# LINE 3873 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 281 "src-ag/PrintCode.ag" #-} - 5 - {-# LINE 3878 "src-ag/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 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 3889 "src-ag/PrintCode.hs" #-} - )) of - { !_rightOnested -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 3894 "src-ag/PrintCode.hs" #-} - )) of - { !_leftOnested -> - (case (right_ _rightOnested ) of - { ( !_rightIpp,!_rightIprec) -> - (case (left_ _leftOnested ) of - { ( !_leftIpp,!_leftIprec) -> - (case (({-# LINE 289 "src-ag/PrintCode.ag" #-} - text "Either" >#< pp_parens _leftIpp >#< pp_parens _rightIpp - {-# LINE 3903 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 288 "src-ag/PrintCode.ag" #-} - 5 - {-# LINE 3908 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOprec -> - ( _lhsOpp,_lhsOprec) }) }) }) }) }) })) ) -sem_Type_TIntMap :: T_Type -> - T_Type -sem_Type_TIntMap !(T_Type value_ ) = - (T_Type (\ (!_lhsInested) -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 3918 "src-ag/PrintCode.hs" #-} - )) of - { !_valueOnested -> - (case (value_ _valueOnested ) of - { ( !_valueIpp,!_valueIprec) -> - (case (({-# LINE 293 "src-ag/PrintCode.ag" #-} - text "Data.IntMap.IntMap" >#< pp_parens _valueIpp - {-# LINE 3925 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 292 "src-ag/PrintCode.ag" #-} - 5 - {-# LINE 3930 "src-ag/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 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 3941 "src-ag/PrintCode.hs" #-} - )) of - { !_valueOnested -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 3946 "src-ag/PrintCode.hs" #-} - )) of - { !_keyOnested -> - (case (value_ _valueOnested ) of - { ( !_valueIpp,!_valueIprec) -> - (case (key_ _keyOnested ) of - { ( !_keyIpp,!_keyIprec) -> - (case (({-# LINE 291 "src-ag/PrintCode.ag" #-} - text "Data.Map.Map" >#< pp_parens _keyIpp >#< pp_parens _valueIpp - {-# LINE 3955 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 290 "src-ag/PrintCode.ag" #-} - 5 - {-# LINE 3960 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOprec -> - ( _lhsOpp,_lhsOprec) }) }) }) }) }) })) ) -sem_Type_TMaybe :: T_Type -> - T_Type -sem_Type_TMaybe !(T_Type tp_ ) = - (T_Type (\ (!_lhsInested) -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 3970 "src-ag/PrintCode.hs" #-} - )) of - { !_tpOnested -> - (case (tp_ _tpOnested ) of - { ( !_tpIpp,!_tpIprec) -> - (case (({-# LINE 287 "src-ag/PrintCode.ag" #-} - text "Maybe" >#< _tpIpp - {-# LINE 3977 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 286 "src-ag/PrintCode.ag" #-} - 5 - {-# LINE 3982 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOprec -> - ( _lhsOpp,_lhsOprec) }) }) }) })) ) -sem_Type_TupleType :: T_Types -> - T_Type -sem_Type_TupleType !(T_Types tps_ ) = - (T_Type (\ (!_lhsInested) -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 3992 "src-ag/PrintCode.hs" #-} - )) of - { !_tpsOnested -> - (case (tps_ _tpsOnested ) of - { ( !_tpsIpps) -> - (case (({-# LINE 273 "src-ag/PrintCode.ag" #-} - ppTuple _lhsInested _tpsIpps - {-# LINE 3999 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 272 "src-ag/PrintCode.ag" #-} - 5 - {-# LINE 4004 "src-ag/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 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 4015 "src-ag/PrintCode.hs" #-} - )) of - { !_argsOnested -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 4020 "src-ag/PrintCode.hs" #-} - )) of - { !_funcOnested -> - (case (args_ _argsOnested ) of - { ( !_argsIpps) -> - (case (func_ _funcOnested ) of - { ( !_funcIpp,!_funcIprec) -> - (case (({-# LINE 265 "src-ag/PrintCode.ag" #-} - hv_sp (_funcIpp : _argsIpps) - {-# LINE 4029 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 258 "src-ag/PrintCode.ag" #-} - _funcIprec - {-# LINE 4034 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOprec -> - ( _lhsOpp,_lhsOprec) }) }) }) }) }) })) ) -sem_Type_UnboxedTupleType :: T_Types -> - T_Type -sem_Type_UnboxedTupleType !(T_Types tps_ ) = - (T_Type (\ (!_lhsInested) -> - (case (({-# LINE 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 4044 "src-ag/PrintCode.hs" #-} - )) of - { !_tpsOnested -> - (case (tps_ _tpsOnested ) of - { ( !_tpsIpps) -> - (case (({-# LINE 276 "src-ag/PrintCode.ag" #-} - ppUnboxedTuple _lhsInested _tpsIpps - {-# LINE 4051 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpp -> - (case (({-# LINE 275 "src-ag/PrintCode.ag" #-} - 5 - {-# LINE 4056 "src-ag/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 53 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 4096 "src-ag/PrintCode.hs" #-} - )) of - { !_tlOnested -> - (case (({-# LINE 51 "src-ag/PrintCode.ag" #-} - _lhsInested - {-# LINE 4101 "src-ag/PrintCode.hs" #-} - )) of - { !_hdOnested -> - (case (tl_ _tlOnested ) of - { ( !_tlIpps) -> - (case (hd_ _hdOnested ) of - { ( !_hdIpp,!_hdIprec) -> - (case (({-# LINE 76 "src-ag/PrintCode.ag" #-} - _hdIpp : _tlIpps - {-# LINE 4110 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) }) }) }) }) })) ) -sem_Types_Nil :: T_Types -sem_Types_Nil = - (T_Types (\ (!_lhsInested) -> - (case (({-# LINE 77 "src-ag/PrintCode.ag" #-} - [] - {-# LINE 4119 "src-ag/PrintCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) })) ) diff --git a/dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs b/dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs +++ /dev/null @@ -1,1772 +0,0 @@ - - --- UUAGC 0.9.39.0.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 DepTypes -import Options -import Data.List(mapAccumL,intersect,(\\)) -import GrammarInfo -{-# LINE 15 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs" #-} - -{-# LINE 2 "src-ag/ErrorMessages.ag" #-} - -import UU.Scanner.Position(Pos) -import Pretty -import DepTypes(Trace) -import CodeSyntax -import CommonTypes -{-# LINE 24 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs" #-} -{-# LINE 16 "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 - -cycleIsDangerous :: Options -> Bool -cycleIsDangerous opts - = any ($ opts) [ wignore, bangpats, cases, strictCases, stricterCases, strictSems, withCycle ] -{-# LINE 63 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs" #-} - -{-# LINE 506 "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 - - -ppTrace :: Trace -> PP_Doc -ppTrace (tr:rest) = wfill [showLineNr (lineNr tr) ++ ":", "SEM", getName (nt tr), "|", getName (prod tr) - , lhsFld tr +.+ lhsAttr tr, "=", "..." +#+ showRhs tr +#+ "..."] - >-< ppTrace rest -ppTrace [] = empty - -showRhs :: TraceElem -> String -showRhs tr = if null (getName field) - then "@" ++ getName attr - else "@" ++ (field +.+ attr) - where field = rhsFld tr - attr = rhsAttr tr - -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 115 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs" #-} - -{-# LINE 558 "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 176 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs" #-} --- Error ------------------------------------------------------- -{- - visit 0: - inherited attributes: - options : Options - verbose : Bool - synthesized attributes: - me : SELF - pp : PP_Doc - alternatives: - alternative ChildAsLocal: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child var : {Identifier} - visit 0: - local me : _ - alternative CustomError: - child isWarning : {Bool} - child pos : {Pos} - child mesg : {PP_Doc} - visit 0: - local me : _ - alternative CyclicSet: - child name : {Identifier} - visit 0: - local me : _ - alternative DirectCirc: - child nt : {NontermIdent} - child o_visit : {Bool} - child cyclic : {[((Identifier,Identifier),[String],[String])]} - visit 0: - local me : _ - alternative DupAlt: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child occ1 : {ConstructorIdent} - visit 0: - local me : _ - alternative DupChild: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child name : {Identifier} - child occ1 : {Identifier} - visit 0: - local me : _ - alternative DupInhAttr: - child nt : {NontermIdent} - child attr : {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 DupSet: - child name : {NontermIdent} - child occ1 : {NontermIdent} - visit 0: - local me : _ - alternative DupSig: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - visit 0: - local me : _ - alternative DupSynAttr: - child nt : {NontermIdent} - child attr : {Identifier} - child occ1 : {Identifier} - visit 0: - local me : _ - alternative DupSynonym: - child nt : {NontermIdent} - child occ1 : {NontermIdent} - visit 0: - local me : _ - alternative DupUnique: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - visit 0: - local me : _ - alternative HsParseError: - child pos : {Pos} - child msg : {String} - visit 0: - local me : _ - alternative InducedCirc: - child nt : {NontermIdent} - child cinter : {CInterface} - child cyclic : {[((Identifier,Identifier),[String],[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 LocalCirc: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - child o_visit : {Bool} - child path : {[String]} - visit 0: - local me : _ - alternative MissingInstSig: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child attr : {Identifier} - visit 0: - local me : _ - alternative MissingNamedRule: - child nt : {NontermIdent} - child con : {Identifier} - 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 MissingSyn: - child nt : {NontermIdent} - child attr : {Identifier} - visit 0: - local me : _ - alternative MissingTypeSig: - 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 ParserError: - child pos : {Pos} - child problem : {String} - child action : {String} - visit 0: - local me : _ - alternative SuperfluousRule: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child field : {Identifier} - child attr : {Identifier} - visit 0: - local me : _ - alternative UndefAlt: - child nt : {NontermIdent} - child con : {ConstructorIdent} - 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 UndefChild: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child name : {Identifier} - visit 0: - local me : _ - alternative UndefLocal: - child nt : {NontermIdent} - child con : {ConstructorIdent} - child var : {Identifier} - visit 0: - local me : _ - alternative UndefNont: - child nt : {NontermIdent} - visit 0: - local me : _ --} --- cata -sem_Error :: Error -> - T_Error -sem_Error (ChildAsLocal _nt _con _var ) = - (sem_Error_ChildAsLocal _nt _con _var ) -sem_Error (CustomError _isWarning _pos _mesg ) = - (sem_Error_CustomError _isWarning _pos _mesg ) -sem_Error (CyclicSet _name ) = - (sem_Error_CyclicSet _name ) -sem_Error (DirectCirc _nt _o_visit _cyclic ) = - (sem_Error_DirectCirc _nt _o_visit _cyclic ) -sem_Error (DupAlt _nt _con _occ1 ) = - (sem_Error_DupAlt _nt _con _occ1 ) -sem_Error (DupChild _nt _con _name _occ1 ) = - (sem_Error_DupChild _nt _con _name _occ1 ) -sem_Error (DupInhAttr _nt _attr _occ1 ) = - (sem_Error_DupInhAttr _nt _attr _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 (DupSet _name _occ1 ) = - (sem_Error_DupSet _name _occ1 ) -sem_Error (DupSig _nt _con _attr ) = - (sem_Error_DupSig _nt _con _attr ) -sem_Error (DupSynAttr _nt _attr _occ1 ) = - (sem_Error_DupSynAttr _nt _attr _occ1 ) -sem_Error (DupSynonym _nt _occ1 ) = - (sem_Error_DupSynonym _nt _occ1 ) -sem_Error (DupUnique _nt _con _attr ) = - (sem_Error_DupUnique _nt _con _attr ) -sem_Error (HsParseError _pos _msg ) = - (sem_Error_HsParseError _pos _msg ) -sem_Error (InducedCirc _nt _cinter _cyclic ) = - (sem_Error_InducedCirc _nt _cinter _cyclic ) -sem_Error (InstCirc _nt _con _attr _o_visit _path ) = - (sem_Error_InstCirc _nt _con _attr _o_visit _path ) -sem_Error (LocalCirc _nt _con _attr _o_visit _path ) = - (sem_Error_LocalCirc _nt _con _attr _o_visit _path ) -sem_Error (MissingInstSig _nt _con _attr ) = - (sem_Error_MissingInstSig _nt _con _attr ) -sem_Error (MissingNamedRule _nt _con _name ) = - (sem_Error_MissingNamedRule _nt _con _name ) -sem_Error (MissingRule _nt _con _field _attr ) = - (sem_Error_MissingRule _nt _con _field _attr ) -sem_Error (MissingSyn _nt _attr ) = - (sem_Error_MissingSyn _nt _attr ) -sem_Error (MissingTypeSig _nt _con _attr ) = - (sem_Error_MissingTypeSig _nt _con _attr ) -sem_Error (MissingUnique _nt _attr ) = - (sem_Error_MissingUnique _nt _attr ) -sem_Error (ParserError _pos _problem _action ) = - (sem_Error_ParserError _pos _problem _action ) -sem_Error (SuperfluousRule _nt _con _field _attr ) = - (sem_Error_SuperfluousRule _nt _con _field _attr ) -sem_Error (UndefAlt _nt _con ) = - (sem_Error_UndefAlt _nt _con ) -sem_Error (UndefAttr _nt _con _field _attr _isOut ) = - (sem_Error_UndefAttr _nt _con _field _attr _isOut ) -sem_Error (UndefChild _nt _con _name ) = - (sem_Error_UndefChild _nt _con _name ) -sem_Error (UndefLocal _nt _con _var ) = - (sem_Error_UndefLocal _nt _con _var ) -sem_Error (UndefNont _nt ) = - (sem_Error_UndefNont _nt ) --- 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_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 341, column 21) - _lhsOpp = - ({-# LINE 341 "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 476 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - ChildAsLocal nt_ con_ var_ - {-# LINE 482 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 488 "src-ag/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 383, column 21) - _lhsOpp = - ({-# LINE 383 "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 507 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - CustomError isWarning_ pos_ mesg_ - {-# LINE 513 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 519 "src-ag/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 374, column 21) - _lhsOpp = - ({-# LINE 374 "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 540 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - CyclicSet name_ - {-# LINE 546 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 552 "src-ag/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 412, column 21) - _lhsOpp = - ({-# LINE 412 "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 574 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - DirectCirc nt_ o_visit_ cyclic_ - {-# LINE 580 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 586 "src-ag/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 87, column 21) - _lhsOpp = - ({-# LINE 87 "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 619 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - DupAlt nt_ con_ occ1_ - {-# LINE 625 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 631 "src-ag/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 180, column 21) - _lhsOpp = - ({-# LINE 180 "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 664 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - DupChild nt_ con_ name_ occ1_ - {-# LINE 670 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 676 "src-ag/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 142, column 21) - _lhsOpp = - ({-# LINE 142 "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 707 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - DupInhAttr nt_ attr_ occ1_ - {-# LINE 713 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 719 "src-ag/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 200, column 21) - _lhsOpp = - ({-# LINE 200 "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 751 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - DupRule nt_ con_ field_ attr_ occ1_ - {-# LINE 757 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 763 "src-ag/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 218, column 21) - _lhsOpp = - ({-# LINE 218 "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 790 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - DupRuleName nt_ con_ nm_ - {-# LINE 796 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 802 "src-ag/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 126, column 21) - _lhsOpp = - ({-# LINE 126 "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 831 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - DupSet name_ occ1_ - {-# LINE 837 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 843 "src-ag/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 233, column 21) - _lhsOpp = - ({-# LINE 233 "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 872 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - DupSig nt_ con_ attr_ - {-# LINE 878 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 884 "src-ag/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 161, column 21) - _lhsOpp = - ({-# LINE 161 "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 915 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - DupSynAttr nt_ attr_ occ1_ - {-# LINE 921 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 927 "src-ag/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 109, column 21) - _lhsOpp = - ({-# LINE 109 "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 957 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - DupSynonym nt_ occ1_ - {-# LINE 963 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 969 "src-ag/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 473, column 21) - _lhsOpp = - ({-# LINE 473 "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 998 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - DupUnique nt_ con_ attr_ - {-# LINE 1004 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1010 "src-ag/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 85, column 21) - _lhsOpp = - ({-# LINE 85 "src-ag/PrintErrorMessages.ag" #-} - ppError True pos_ (text msg_) (text "") (text "") (text "Correct the syntax of the Haskell code.") _lhsIverbose - {-# LINE 1025 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - HsParseError pos_ msg_ - {-# LINE 1031 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1037 "src-ag/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 420, column 21) - _lhsOpp = - ({-# LINE 420 "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 1060 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - InducedCirc nt_ cinter_ cyclic_ - {-# LINE 1066 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1072 "src-ag/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 400, column 21) - _lhsOpp = - ({-# LINE 400 "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 1100 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - InstCirc nt_ con_ attr_ o_visit_ path_ - {-# LINE 1106 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1112 "src-ag/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 388, column 21) - _lhsOpp = - ({-# LINE 388 "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 1140 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - LocalCirc nt_ con_ attr_ o_visit_ path_ - {-# LINE 1146 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1152 "src-ag/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 443, column 21) - _lhsOpp = - ({-# LINE 443 "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 1180 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - MissingInstSig nt_ con_ attr_ - {-# LINE 1186 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1192 "src-ag/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 300, column 23) - _lhsOpp = - ({-# LINE 300 "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 1217 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - MissingNamedRule nt_ con_ name_ - {-# LINE 1223 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1229 "src-ag/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 287, column 21) - _lhsOpp = - ({-# LINE 287 "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 1256 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - MissingRule nt_ con_ field_ attr_ - {-# LINE 1262 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1268 "src-ag/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 490, column 20) - _lhsOpp = - ({-# LINE 490 "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 1296 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - MissingSyn nt_ attr_ - {-# LINE 1302 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1308 "src-ag/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 429, column 21) - _lhsOpp = - ({-# LINE 429 "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 1336 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - MissingTypeSig nt_ con_ attr_ - {-# LINE 1342 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1348 "src-ag/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 457, column 21) - _lhsOpp = - ({-# LINE 457 "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 1376 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - MissingUnique nt_ attr_ - {-# LINE 1382 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1388 "src-ag/PrintErrorMessages.hs" #-} - ) - in ( _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 79, column 21) - _lhsOpp = - ({-# LINE 79 "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 1408 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - ParserError pos_ problem_ action_ - {-# LINE 1414 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1420 "src-ag/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 312, column 21) - _lhsOpp = - ({-# LINE 312 "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 1447 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - SuperfluousRule nt_ con_ field_ attr_ - {-# LINE 1453 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1459 "src-ag/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 260, column 21) - _lhsOpp = - ({-# LINE 260 "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 1483 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - UndefAlt nt_ con_ - {-# LINE 1489 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1495 "src-ag/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 355, column 21) - _lhsOpp = - ({-# LINE 355 "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 1529 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - UndefAttr nt_ con_ field_ attr_ isOut_ - {-# LINE 1535 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1541 "src-ag/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 272, column 21) - _lhsOpp = - ({-# LINE 272 "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 1569 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - UndefChild nt_ con_ name_ - {-# LINE 1575 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1581 "src-ag/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 326, column 21) - _lhsOpp = - ({-# LINE 326 "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 1609 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - UndefLocal nt_ con_ var_ - {-# LINE 1615 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1621 "src-ag/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 250, column 21) - _lhsOpp = - ({-# LINE 250 "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 1642 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - UndefNont nt_ - {-# LINE 1648 "src-ag/PrintErrorMessages.hs" #-} - ) - -- self rule - _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} - _me - {-# LINE 1654 "src-ag/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 68, column 8) - _verbose = - ({-# LINE 68 "src-ag/PrintErrorMessages.ag" #-} - verbose _lhsIoptions - {-# LINE 1711 "src-ag/PrintErrorMessages.hs" #-} - ) - -- "src-ag/PrintErrorMessages.ag"(line 69, column 11) - _str = - ({-# LINE 69 "src-ag/PrintErrorMessages.ag" #-} - disp _hdIpp 5000 "" - {-# LINE 1717 "src-ag/PrintErrorMessages.hs" #-} - ) - -- "src-ag/PrintErrorMessages.ag"(line 71, column 11) - _lhsOpp = - ({-# LINE 71 "src-ag/PrintErrorMessages.ag" #-} - if _str `elem` _lhsIdups - then _tlIpp - else _hdIpp >-< _tlIpp - {-# LINE 1725 "src-ag/PrintErrorMessages.hs" #-} - ) - -- "src-ag/PrintErrorMessages.ag"(line 74, column 11) - _tlOdups = - ({-# LINE 74 "src-ag/PrintErrorMessages.ag" #-} - _str : _lhsIdups - {-# LINE 1731 "src-ag/PrintErrorMessages.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} - _lhsIoptions - {-# LINE 1737 "src-ag/PrintErrorMessages.hs" #-} - ) - -- copy rule (from local) - _hdOverbose = - ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} - _verbose - {-# LINE 1743 "src-ag/PrintErrorMessages.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 64 "src-ag/PrintErrorMessages.ag" #-} - _lhsIoptions - {-# LINE 1749 "src-ag/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 68, column 8) - _verbose = - ({-# LINE 68 "src-ag/PrintErrorMessages.ag" #-} - verbose _lhsIoptions - {-# LINE 1765 "src-ag/PrintErrorMessages.hs" #-} - ) - -- "src-ag/PrintErrorMessages.ag"(line 75, column 11) - _lhsOpp = - ({-# LINE 75 "src-ag/PrintErrorMessages.ag" #-} - text "" - {-# LINE 1771 "src-ag/PrintErrorMessages.hs" #-} - ) - in ( _lhsOpp))) ) diff --git a/dist/build/uuagc/uuagc-tmp/PrintOcamlCode.hs b/dist/build/uuagc/uuagc-tmp/PrintOcamlCode.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/PrintOcamlCode.hs +++ /dev/null @@ -1,2230 +0,0 @@ -{-# OPTIONS_GHC -XBangPatterns #-} - --- UUAGC 0.9.39.0.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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintOcamlCode.hs" #-} - -{-# LINE 2 "src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 33 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintOcamlCode.hs" #-} - -{-# LINE 174 "src-ag/PrintOcamlCode.ag" #-} - -toOcamlTC (c:cs) = toLower c : cs -toOcamlTC xs = xs -{-# LINE 56 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintOcamlCode.hs" #-} - -{-# LINE 145 "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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_exprOoptions -> - (case (expr_ _exprOoptions ) of - { ( !_exprIpp) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 118 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_leftOoptions -> - (case (left_ _leftOoptions ) of - { ( !_leftIpp) -> - (case (({-# LINE 180 "src-ag/PrintOcamlCode.ag" #-} - _leftIpp >#< "->" >#< _exprIpp - {-# LINE 125 "src-ag/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 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_tlOoptions -> - (case (tl_ _tlOoptions ) of - { ( !_tlIpps) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 172 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_hdOoptions -> - (case (hd_ _hdOoptions ) of - { ( !_hdIpp) -> - (case (({-# LINE 64 "src-ag/PrintOcamlCode.ag" #-} - _hdIpp : _tlIpps - {-# LINE 179 "src-ag/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 "src-ag/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 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_semFunctionsOisToplevel -> - (case (({-# LINE 209 "src-ag/PrintOcamlCode.ag" #-} - _lhsIisToplevel - {-# LINE 252 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_semWrapperOisToplevel -> - (case (({-# LINE 209 "src-ag/PrintOcamlCode.ag" #-} - _lhsIisToplevel - {-# LINE 257 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_semDomOisToplevel -> - (case (({-# LINE 209 "src-ag/PrintOcamlCode.ag" #-} - _lhsIisToplevel - {-# LINE 262 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_cataFunOisToplevel -> - (case (({-# LINE 209 "src-ag/PrintOcamlCode.ag" #-} - _lhsIisToplevel - {-# LINE 267 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_dataDefOisToplevel -> - (case (({-# LINE 209 "src-ag/PrintOcamlCode.ag" #-} - _lhsIisToplevel - {-# LINE 272 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_infoOisToplevel -> - (case (({-# LINE 209 "src-ag/PrintOcamlCode.ag" #-} - _lhsIisToplevel - {-# LINE 277 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_commentOisToplevel -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 282 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_semFunctionsOoptions -> - (case (semFunctions_ _semFunctionsOisToplevel _semFunctionsOoptions ) of - { ( !_semFunctionsIpps) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 289 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_semWrapperOoptions -> - (case (semWrapper_ _semWrapperOisToplevel _semWrapperOoptions ) of - { ( !_semWrapperIpps) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 296 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_semDomOoptions -> - (case (semDom_ _semDomOisToplevel _semDomOoptions ) of - { ( !_semDomIpps) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 303 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_cataFunOoptions -> - (case (cataFun_ _cataFunOisToplevel _cataFunOoptions ) of - { ( !_cataFunIpps) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 310 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_dataDefOoptions -> - (case (dataDef_ _dataDefOisToplevel _dataDefOoptions ) of - { ( !_dataDefIpps) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 317 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_infoOoptions -> - (case (info_ _infoOisToplevel _infoOoptions ) of - { ( !_infoIpps) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 324 "src-ag/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 "src-ag/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 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_tlOtextBlockMap -> - (case (({-# LINE 209 "src-ag/PrintOcamlCode.ag" #-} - _lhsIisToplevel - {-# LINE 389 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_tlOisToplevel -> - (case (({-# LINE 45 "src-ag/PrintOcamlCode.ag" #-} - _lhsItextBlockMap - {-# LINE 394 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_hdOtextBlockMap -> - (case (({-# LINE 209 "src-ag/PrintOcamlCode.ag" #-} - _lhsIisToplevel - {-# LINE 399 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_hdOisToplevel -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 404 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_tlOoptions -> - (case (tl_ _tlOisToplevel _tlOoptions _tlOtextBlockMap ) of - { ( !_tlIpps) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 411 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_hdOoptions -> - (case (hd_ _hdOisToplevel _hdOoptions _hdOtextBlockMap ) of - { ( !_hdIpps) -> - (case (({-# LINE 84 "src-ag/PrintOcamlCode.ag" #-} - _hdIpps ++ _tlIpps - {-# LINE 418 "src-ag/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 "src-ag/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 "src-ag/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 "src-ag/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 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) }) }) }) ) -sem_DataAlts_Nil :: T_DataAlts -sem_DataAlts_Nil = - (T_DataAlts (case (({-# LINE 69 "src-ag/PrintOcamlCode.ag" #-} - [] - {-# LINE 531 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) }) ) --- Decl -------------------------------------------------------- -{- - visit 0: - inherited attributes: - isToplevel : Bool - options : Options - synthesized attribute: - pp : PP_Doc - alternatives: - alternative Bind: - child left : Lhs - child rhs : Expr - alternative BindLet: - child left : Lhs - child rhs : Expr - alternative Comment: - child txt : {String} - alternative Data: - child name : {String} - child params : {[String]} - child alts : DataAlts - child strict : {Bool} - child derivings : {[String]} - alternative Decl: - child left : Lhs - child rhs : Expr - child binds : {Set String} - child uses : {Set String} - alternative EvalDecl: - child nt : {String} - child left : Lhs - child rhs : Expr - alternative NewType: - child name : {String} - child params : {[String]} - child con : {String} - child tp : Type - alternative PragmaDecl: - child txt : {String} - alternative Resume: - child monadic : {Bool} - child nt : {String} - child left : Lhs - child rhs : Expr - alternative TSig: - child name : {String} - child tp : Type - alternative Type: - child name : {String} - child params : {[String]} - child tp : Type --} --- cata -sem_Decl :: Decl -> - T_Decl -sem_Decl !(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 !(Comment _txt ) = - (sem_Decl_Comment _txt ) -sem_Decl !(Data _name _params _alts _strict _derivings ) = - (sem_Decl_Data _name _params (sem_DataAlts _alts ) _strict _derivings ) -sem_Decl !(Decl _left _rhs _binds _uses ) = - (sem_Decl_Decl (sem_Lhs _left ) (sem_Expr _rhs ) _binds _uses ) -sem_Decl !(EvalDecl _nt _left _rhs ) = - (sem_Decl_EvalDecl _nt (sem_Lhs _left ) (sem_Expr _rhs ) ) -sem_Decl !(NewType _name _params _con _tp ) = - (sem_Decl_NewType _name _params _con (sem_Type _tp ) ) -sem_Decl !(PragmaDecl _txt ) = - (sem_Decl_PragmaDecl _txt ) -sem_Decl !(Resume _monadic _nt _left _rhs ) = - (sem_Decl_Resume _monadic _nt (sem_Lhs _left ) (sem_Expr _rhs ) ) -sem_Decl !(TSig _name _tp ) = - (sem_Decl_TSig _name (sem_Type _tp ) ) -sem_Decl !(Type _name _params _tp ) = - (sem_Decl_Type _name _params (sem_Type _tp ) ) --- semantic domain -newtype T_Decl = T_Decl (Bool -> - 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_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 632 "src-ag/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 644 "src-ag/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 657 "src-ag/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 680 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpp -> - ( _lhsOpp) }) })) ) -sem_Decl_Decl :: T_Lhs -> - T_Expr -> - (Set String) -> - (Set String) -> - T_Decl -sem_Decl_Decl !(T_Lhs left_ ) !(T_Expr rhs_ ) !binds_ !uses_ = - (T_Decl (\ (!_lhsIisToplevel) - (!_lhsIoptions) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 694 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_rhsOoptions -> - (case (rhs_ _rhsOoptions ) of - { ( !_rhsIpp) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 701 "src-ag/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 712 "src-ag/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 725 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_rhsOoptions -> - (case (rhs_ _rhsOoptions ) of - { ( !_rhsIpp) -> - (case (({-# LINE 53 "src-ag/PrintOcamlCode.ag" #-} - _rhsIpp - {-# LINE 732 "src-ag/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 746 "src-ag/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 757 "src-ag/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 771 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_rhsOoptions -> - (case (rhs_ _rhsOoptions ) of - { ( !_rhsIpp) -> - (case (({-# LINE 53 "src-ag/PrintOcamlCode.ag" #-} - _rhsIpp - {-# LINE 778 "src-ag/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 792 "src-ag/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 807 "src-ag/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 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_tlOisToplevel -> - (case (({-# LINE 209 "src-ag/PrintOcamlCode.ag" #-} - _lhsIisToplevel - {-# LINE 855 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_hdOisToplevel -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 860 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_tlOoptions -> - (case (tl_ _tlOisToplevel _tlOoptions ) of - { ( !_tlIpps) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 867 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_hdOoptions -> - (case (hd_ _hdOisToplevel _hdOoptions ) of - { ( !_hdIpp) -> - (case (({-# LINE 80 "src-ag/PrintOcamlCode.ag" #-} - _hdIpp : _tlIpps - {-# LINE 874 "src-ag/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 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) })) ) --- Expr -------------------------------------------------------- -{- - visit 0: - inherited attribute: - options : Options - synthesized attribute: - pp : PP_Doc - alternatives: - alternative App: - child name : {String} - child args : Exprs - alternative Case: - child expr : Expr - child alts : CaseAlts - alternative Do: - child stmts : Decls - child body : Expr - alternative InvokeExpr: - child nt : {String} - child expr : Expr - child args : Exprs - alternative Lambda: - child args : Exprs - child body : Expr - alternative Let: - child decls : Decls - child body : Expr - alternative LineExpr: - child expr : Expr - alternative PragmaExpr: - child onLeftSide : {Bool} - child onNewLine : {Bool} - child txt : {String} - child expr : Expr - alternative ResultExpr: - child nt : {String} - child expr : Expr - 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 - alternative SimpleExpr: - child txt : {String} - alternative TextExpr: - child lns : {[String]} - alternative Trace: - child txt : {String} - child expr : Expr - alternative TupleExpr: - child exprs : Exprs - alternative TypedExpr: - child expr : Expr - child tp : Type - alternative UnboxedTupleExpr: - child exprs : Exprs --} --- cata -sem_Expr :: Expr -> - T_Expr -sem_Expr !(App _name _args ) = - (sem_Expr_App _name (sem_Exprs _args ) ) -sem_Expr !(Case _expr _alts ) = - (sem_Expr_Case (sem_Expr _expr ) (sem_CaseAlts _alts ) ) -sem_Expr !(Do _stmts _body ) = - (sem_Expr_Do (sem_Decls _stmts ) (sem_Expr _body ) ) -sem_Expr !(InvokeExpr _nt _expr _args ) = - (sem_Expr_InvokeExpr _nt (sem_Expr _expr ) (sem_Exprs _args ) ) -sem_Expr !(Lambda _args _body ) = - (sem_Expr_Lambda (sem_Exprs _args ) (sem_Expr _body ) ) -sem_Expr !(Let _decls _body ) = - (sem_Expr_Let (sem_Decls _decls ) (sem_Expr _body ) ) -sem_Expr !(LineExpr _expr ) = - (sem_Expr_LineExpr (sem_Expr _expr ) ) -sem_Expr !(PragmaExpr _onLeftSide _onNewLine _txt _expr ) = - (sem_Expr_PragmaExpr _onLeftSide _onNewLine _txt (sem_Expr _expr ) ) -sem_Expr !(ResultExpr _nt _expr ) = - (sem_Expr_ResultExpr _nt (sem_Expr _expr ) ) -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 ) ) -sem_Expr !(SimpleExpr _txt ) = - (sem_Expr_SimpleExpr _txt ) -sem_Expr !(TextExpr _lns ) = - (sem_Expr_TextExpr _lns ) -sem_Expr !(Trace _txt _expr ) = - (sem_Expr_Trace _txt (sem_Expr _expr ) ) -sem_Expr !(TupleExpr _exprs ) = - (sem_Expr_TupleExpr (sem_Exprs _exprs ) ) -sem_Expr !(TypedExpr _expr _tp ) = - (sem_Expr_TypedExpr (sem_Expr _expr ) (sem_Type _tp ) ) -sem_Expr !(UnboxedTupleExpr _exprs ) = - (sem_Expr_UnboxedTupleExpr (sem_Exprs _exprs ) ) --- semantic domain -newtype T_Expr = T_Expr (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_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 1004 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_argsOoptions -> - (case (args_ _argsOoptions ) of - { ( !_argsIpps) -> - (case (({-# LINE 143 "src-ag/PrintOcamlCode.ag" #-} - pp_parens $ name_ >#< hv_sp _argsIpps - {-# LINE 1011 "src-ag/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 1022 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_altsOoptions -> - (case (alts_ _altsOoptions ) of - { ( !_altsIpps) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 1029 "src-ag/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 1042 "src-ag/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 1053 "src-ag/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 1065 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_exprOoptions -> - (case (expr_ _exprOoptions ) of - { ( !_exprIpp) -> - (case (({-# LINE 53 "src-ag/PrintOcamlCode.ag" #-} - _exprIpp - {-# LINE 1072 "src-ag/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 1083 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_bodyOoptions -> - (case (body_ _bodyOoptions ) of - { ( !_bodyIpp) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 1090 "src-ag/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 1098 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpp -> - ( _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 1109 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_declsOisToplevel -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 1114 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_bodyOoptions -> - (case (body_ _bodyOoptions ) of - { ( !_bodyIpp) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 1121 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_declsOoptions -> - (case (decls_ _declsOisToplevel _declsOoptions ) of - { ( !_declsIpps) -> - (case (({-# LINE 130 "src-ag/PrintOcamlCode.ag" #-} - pp_parens $ vlist (_declsIpps ++ [_bodyIpp]) - {-# LINE 1128 "src-ag/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 1138 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_exprOoptions -> - (case (expr_ _exprOoptions ) of - { ( !_exprIpp) -> - (case (({-# LINE 148 "src-ag/PrintOcamlCode.ag" #-} - _exprIpp - {-# LINE 1145 "src-ag/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 1158 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_exprOoptions -> - (case (expr_ _exprOoptions ) of - { ( !_exprIpp) -> - (case (({-# LINE 147 "src-ag/PrintOcamlCode.ag" #-} - _exprIpp - {-# LINE 1165 "src-ag/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 1176 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_exprOoptions -> - (case (expr_ _exprOoptions ) of - { ( !_exprIpp) -> - (case (({-# LINE 53 "src-ag/PrintOcamlCode.ag" #-} - _exprIpp - {-# LINE 1183 "src-ag/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 1196 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_rhsOoptions -> - (case (rhs_ _rhsOoptions ) of - { ( !_rhsIpp) -> - (case (({-# LINE 53 "src-ag/PrintOcamlCode.ag" #-} - _rhsIpp - {-# LINE 1203 "src-ag/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 1215 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_bodyOoptions -> - (case (body_ _bodyOoptions ) of - { ( !_bodyIpp) -> - (case (({-# LINE 53 "src-ag/PrintOcamlCode.ag" #-} - _bodyIpp - {-# LINE 1222 "src-ag/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 1232 "src-ag/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 1242 "src-ag/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 1253 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_exprOoptions -> - (case (expr_ _exprOoptions ) of - { ( !_exprIpp) -> - (case (({-# LINE 146 "src-ag/PrintOcamlCode.ag" #-} - _exprIpp - {-# LINE 1260 "src-ag/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 1270 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_exprsOoptions -> - (case (exprs_ _exprsOoptions ) of - { ( !_exprsIpps) -> - (case (({-# LINE 141 "src-ag/PrintOcamlCode.ag" #-} - ppTuple False _exprsIpps - {-# LINE 1277 "src-ag/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 1288 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_exprOoptions -> - (case (expr_ _exprOoptions ) of - { ( !_exprIpp) -> - (case (({-# LINE 149 "src-ag/PrintOcamlCode.ag" #-} - _exprIpp - {-# LINE 1295 "src-ag/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 1305 "src-ag/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 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_tlOoptions -> - (case (tl_ _tlOoptions ) of - { ( !_tlIpps) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 1352 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_hdOoptions -> - (case (hd_ _hdOoptions ) of - { ( !_hdIpp) -> - (case (({-# LINE 60 "src-ag/PrintOcamlCode.ag" #-} - _hdIpp : _tlIpps - {-# LINE 1359 "src-ag/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 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) })) ) --- Lhs --------------------------------------------------------- -{- - visit 0: - inherited attribute: - options : Options - synthesized attribute: - pp : PP_Doc - alternatives: - alternative Fun: - child name : {String} - child args : Exprs - alternative Pattern3: - child pat3 : Pattern - alternative Pattern3SM: - child pat3 : Pattern - alternative TupleLhs: - child comps : {[String]} - alternative UnboxedTupleLhs: - child comps : {[String]} - alternative Unwrap: - child name : {String} - child sub : Lhs --} --- cata -sem_Lhs :: Lhs -> - T_Lhs -sem_Lhs !(Fun _name _args ) = - (sem_Lhs_Fun _name (sem_Exprs _args ) ) -sem_Lhs !(Pattern3 _pat3 ) = - (sem_Lhs_Pattern3 (sem_Pattern _pat3 ) ) -sem_Lhs !(Pattern3SM _pat3 ) = - (sem_Lhs_Pattern3SM (sem_Pattern _pat3 ) ) -sem_Lhs !(TupleLhs _comps ) = - (sem_Lhs_TupleLhs _comps ) -sem_Lhs !(UnboxedTupleLhs _comps ) = - (sem_Lhs_UnboxedTupleLhs _comps ) -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_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 1428 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_argsOoptions -> - (case (args_ _argsOoptions ) of - { ( !_argsIpps) -> - (case (({-# LINE 156 "src-ag/PrintOcamlCode.ag" #-} - name_ >#< hv_sp _argsIpps - {-# LINE 1435 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpp -> - ( _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 1445 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_pat3Ooptions -> - (case (pat3_ _pat3Ooptions ) of - { ( !_pat3Icopy,!_pat3IisUnderscore,!_pat3Ipp) -> - (case (({-# LINE 152 "src-ag/PrintOcamlCode.ag" #-} - _pat3Ipp - {-# LINE 1452 "src-ag/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 1462 "src-ag/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 1472 "src-ag/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 1482 "src-ag/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 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_subOoptions -> - (case (sub_ _subOoptions ) of - { ( !_subIpp) -> - (case (({-# LINE 157 "src-ag/PrintOcamlCode.ag" #-} - pp_parens (name_ >#< _subIpp) - {-# LINE 1500 "src-ag/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 "src-ag/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 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) }) }) }) ) -sem_NamedTypes_Nil :: T_NamedTypes -sem_NamedTypes_Nil = - (T_NamedTypes (case (({-# LINE 77 "src-ag/PrintOcamlCode.ag" #-} - [] - {-# LINE 1587 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) }) ) --- Pattern ----------------------------------------------------- -{- - visit 0: - inherited attribute: - options : Options - synthesized attributes: - copy : SELF - isUnderscore : Bool - pp : PP_Doc - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern !(Alias _field _attr _pat _parts ) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) -sem_Pattern !(Constr _name _pats ) = - (sem_Pattern_Constr _name (sem_Patterns _pats ) ) -sem_Pattern !(Irrefutable _pat ) = - (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) -sem_Pattern !(Product _pos _pats ) = - (sem_Pattern_Product _pos (sem_Patterns _pats ) ) -sem_Pattern !(Underscore _pos ) = - (sem_Pattern_Underscore _pos ) --- semantic domain -newtype T_Pattern = T_Pattern (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_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_ ) !(T_Patterns parts_ ) = - (T_Pattern (\ (!_lhsIoptions) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 1660 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_partsOoptions -> - (case (parts_ _partsOoptions ) of - { ( !_partsIcopy,!_partsIpps) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 1667 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_patOoptions -> - (case (pat_ _patOoptions ) of - { ( !_patIcopy,!_patIisUnderscore,!_patIpp) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 1674 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1679 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 202 "src-ag/PrintOcamlCode.ag" #-} - False - {-# LINE 1684 "src-ag/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 1691 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpp -> - ( _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 1702 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_patsOoptions -> - (case (pats_ _patsOoptions ) of - { ( !_patsIcopy,!_patsIpps) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 1709 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1714 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 200 "src-ag/PrintOcamlCode.ag" #-} - False - {-# LINE 1719 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOisUnderscore -> - (case (({-# LINE 190 "src-ag/PrintOcamlCode.ag" #-} - pp_parens $ name_ >#< hv_sp _patsIpps - {-# LINE 1724 "src-ag/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 1734 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_patOoptions -> - (case (pat_ _patOoptions ) of - { ( !_patIcopy,!_patIisUnderscore,!_patIpp) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 1741 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1746 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 199 "src-ag/PrintOcamlCode.ag" #-} - _patIisUnderscore - {-# LINE 1751 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOisUnderscore -> - (case (({-# LINE 196 "src-ag/PrintOcamlCode.ag" #-} - error "pp of Pattern.Irrefutable not supported" - {-# LINE 1756 "src-ag/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 1767 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_patsOoptions -> - (case (pats_ _patsOoptions ) of - { ( !_patsIcopy,!_patsIpps) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 1774 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1779 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 201 "src-ag/PrintOcamlCode.ag" #-} - False - {-# LINE 1784 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOisUnderscore -> - (case (({-# LINE 191 "src-ag/PrintOcamlCode.ag" #-} - pp_block "(" ")" "," _patsIpps - {-# LINE 1789 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpp -> - ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp) }) }) }) }) }) })) ) -sem_Pattern_Underscore :: Pos -> - T_Pattern -sem_Pattern_Underscore !pos_ = - (T_Pattern (\ (!_lhsIoptions) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Underscore pos_ - {-# LINE 1799 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1804 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 203 "src-ag/PrintOcamlCode.ag" #-} - True - {-# LINE 1809 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOisUnderscore -> - (case (({-# LINE 197 "src-ag/PrintOcamlCode.ag" #-} - text "_" - {-# LINE 1814 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpp -> - ( _lhsOcopy,_lhsOisUnderscore,_lhsOpp) }) }) }) })) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - inherited attribute: - options : Options - synthesized attributes: - copy : SELF - 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 1859 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_tlOoptions -> - (case (tl_ _tlOoptions ) of - { ( !_tlIcopy,!_tlIpps) -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 1866 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_hdOoptions -> - (case (hd_ _hdOoptions ) of - { ( !_hdIcopy,!_hdIisUnderscore,!_hdIpp) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 1873 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1878 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 88 "src-ag/PrintOcamlCode.ag" #-} - _hdIpp : _tlIpps - {-# LINE 1883 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOcopy,_lhsOpps) }) }) }) }) }) }) })) ) -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = - (T_Patterns (\ (!_lhsIoptions) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - [] - {-# LINE 1892 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1897 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOcopy -> - (case (({-# LINE 89 "src-ag/PrintOcamlCode.ag" #-} - [] - {-# LINE 1902 "src-ag/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 1944 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_chunksOtextBlockMap -> - (case (({-# LINE 212 "src-ag/PrintOcamlCode.ag" #-} - True - {-# LINE 1949 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_chunksOisToplevel -> - (case (({-# LINE 43 "src-ag/PrintOcamlCode.ag" #-} - _lhsIoptions - {-# LINE 1954 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_chunksOoptions -> - (case (chunks_ _chunksOisToplevel _chunksOoptions _chunksOtextBlockMap ) of - { ( !_chunksIpps) -> - (case (({-# LINE 57 "src-ag/PrintOcamlCode.ag" #-} - _chunksIpps - {-# LINE 1961 "src-ag/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 List: - child tp : Type - alternative NontermType: - child name : {String} - child params : {[String]} - alternative QuantApp: - child left : {String} - child right : Type - alternative SimpleType: - child txt : {String} - alternative TEither: - child left : Type - child right : Type - alternative TIntMap: - child value : Type - alternative TMap: - child key : Type - child value : Type - alternative TMaybe: - child tp : Type - alternative TupleType: - child tps : Types - alternative TypeApp: - child func : Type - child args : Types - alternative UnboxedTupleType: - child tps : Types --} --- cata -sem_Type :: Type -> - T_Type -sem_Type !(Arr _left _right ) = - (sem_Type_Arr (sem_Type _left ) (sem_Type _right ) ) -sem_Type !(CtxApp _left _right ) = - (sem_Type_CtxApp _left (sem_Type _right ) ) -sem_Type !(List _tp ) = - (sem_Type_List (sem_Type _tp ) ) -sem_Type !(NontermType _name _params ) = - (sem_Type_NontermType _name _params ) -sem_Type !(QuantApp _left _right ) = - (sem_Type_QuantApp _left (sem_Type _right ) ) -sem_Type !(SimpleType _txt ) = - (sem_Type_SimpleType _txt ) -sem_Type !(TEither _left _right ) = - (sem_Type_TEither (sem_Type _left ) (sem_Type _right ) ) -sem_Type !(TIntMap _value ) = - (sem_Type_TIntMap (sem_Type _value ) ) -sem_Type !(TMap _key _value ) = - (sem_Type_TMap (sem_Type _key ) (sem_Type _value ) ) -sem_Type !(TMaybe _tp ) = - (sem_Type_TMaybe (sem_Type _tp ) ) -sem_Type !(TupleType _tps ) = - (sem_Type_TupleType (sem_Types _tps ) ) -sem_Type !(TypeApp _func _args ) = - (sem_Type_TypeApp (sem_Type _func ) (sem_Types _args ) ) -sem_Type !(UnboxedTupleType _tps ) = - (sem_Type_UnboxedTupleType (sem_Types _tps ) ) --- semantic domain -newtype T_Type = T_Type (( 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 2054 "src-ag/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 2064 "src-ag/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 2075 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpp -> - ( _lhsOpp) }) }) ) -sem_Type_NontermType :: String -> - ([String]) -> - T_Type -sem_Type_NontermType !name_ !params_ = - (T_Type (case (({-# LINE 168 "src-ag/PrintOcamlCode.ag" #-} - pp_block "(" ")" " " (map text params_ ++ [text $ toOcamlTC name_]) - {-# LINE 2085 "src-ag/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 2097 "src-ag/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 2106 "src-ag/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 2116 "src-ag/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 2125 "src-ag/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 2135 "src-ag/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 2146 "src-ag/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 2157 "src-ag/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 2171 "src-ag/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 2180 "src-ag/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 2220 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) }) }) }) ) -sem_Types_Nil :: T_Types -sem_Types_Nil = - (T_Types (case (({-# LINE 73 "src-ag/PrintOcamlCode.ag" #-} - [] - {-# LINE 2228 "src-ag/PrintOcamlCode.hs" #-} - )) of - { !_lhsOpps -> - ( _lhsOpps) }) ) diff --git a/dist/build/uuagc/uuagc-tmp/PrintVisitCode.hs b/dist/build/uuagc/uuagc-tmp/PrintVisitCode.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/PrintVisitCode.hs +++ /dev/null @@ -1,762 +0,0 @@ - - --- UUAGC 0.9.39.0.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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintVisitCode.hs" #-} - -{-# LINE 2 "src-ag/CodeSyntax.ag" #-} - -import Patterns -import CommonTypes -import Data.Map(Map) -import Data.Set(Set) -{-# LINE 35 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintVisitCode.hs" #-} - -{-# LINE 2 "src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 42 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/PrintVisitCode.hs" #-} - -{-# LINE 2 "src-ag/DeclBlocks.ag" #-} - -import Code (Decl,Expr) -{-# LINE 47 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 "src-ag/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,Maybe (Maybe Type))]} - 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,Maybe (Maybe Type))]) -> - ([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 CChildVisit: - child name : {Identifier} - child nt : {NontermIdent} - child nr : {Int} - child inh : {Attributes} - child syn : {Attributes} - child isLast : {Bool} - 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} --} --- cata -sem_CRule :: CRule -> - T_CRule -sem_CRule (CChildVisit _name _nt _nr _inh _syn _isLast ) = - (sem_CRule_CChildVisit _name _nt _nr _inh _syn _isLast ) -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 ) --- 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_CChildVisit :: Identifier -> - NontermIdent -> - Int -> - Attributes -> - Attributes -> - Bool -> - T_CRule -sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ = - (T_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 ( ) ) --- 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 : SELF - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern (Alias _field _attr _pat _parts ) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) -sem_Pattern (Constr _name _pats ) = - (sem_Pattern_Constr _name (sem_Patterns _pats ) ) -sem_Pattern (Irrefutable _pat ) = - (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) -sem_Pattern (Product _pos _pats ) = - (sem_Pattern_Product _pos (sem_Patterns _pats ) ) -sem_Pattern (Underscore _pos ) = - (sem_Pattern_Underscore _pos ) --- semantic domain -newtype T_Pattern = T_Pattern (( Pattern )) -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_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = - (T_Pattern (case (parts_ ) of - { ( _partsIcopy) -> - (case (pat_ ) of - { ( _patIcopy) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 598 "src-ag/PrintVisitCode.hs" #-} - )) of - { _copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 603 "src-ag/PrintVisitCode.hs" #-} - )) of - { _lhsOcopy -> - ( _lhsOcopy) }) }) }) }) ) -sem_Pattern_Constr :: ConstructorIdent -> - T_Patterns -> - T_Pattern -sem_Pattern_Constr name_ (T_Patterns pats_ ) = - (T_Pattern (case (pats_ ) of - { ( _patsIcopy) -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 615 "src-ag/PrintVisitCode.hs" #-} - )) of - { _copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 620 "src-ag/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 23 "src-ag/Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 631 "src-ag/PrintVisitCode.hs" #-} - )) of - { _copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 636 "src-ag/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 23 "src-ag/Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 648 "src-ag/PrintVisitCode.hs" #-} - )) of - { _copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 653 "src-ag/PrintVisitCode.hs" #-} - )) of - { _lhsOcopy -> - ( _lhsOcopy) }) }) }) ) -sem_Pattern_Underscore :: Pos -> - T_Pattern -sem_Pattern_Underscore pos_ = - (T_Pattern (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - Underscore pos_ - {-# LINE 662 "src-ag/PrintVisitCode.hs" #-} - )) of - { _copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 667 "src-ag/PrintVisitCode.hs" #-} - )) of - { _lhsOcopy -> - ( _lhsOcopy) }) }) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - copy : SELF - 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 23 "src-ag/Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 711 "src-ag/PrintVisitCode.hs" #-} - )) of - { _copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 716 "src-ag/PrintVisitCode.hs" #-} - )) of - { _lhsOcopy -> - ( _lhsOcopy) }) }) }) }) ) -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = - (T_Patterns (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - [] - {-# LINE 724 "src-ag/PrintVisitCode.hs" #-} - )) of - { _copy -> - (case (({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 729 "src-ag/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/uuagc/uuagc-tmp/ResolveLocals.hs b/dist/build/uuagc/uuagc-tmp/ResolveLocals.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/ResolveLocals.hs +++ /dev/null @@ -1,2706 +0,0 @@ - - --- UUAGC 0.9.39.0.0 (src-ag/ResolveLocals.ag) -module ResolveLocals where -{-# LINE 7 "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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 CommonTypes -{-# LINE 33 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/ResolveLocals.hs" #-} - -{-# LINE 2 "src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 40 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/ResolveLocals.hs" #-} - -{-# LINE 2 "src-ag/Expression.ag" #-} - -import UU.Scanner.Position(Pos) -import HsToken -{-# LINE 46 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/ResolveLocals.hs" #-} --- Child ------------------------------------------------------- -{- - visit 0: - inherited attributes: - allfields : [(Identifier,Type,Maybe (Maybe Type))] - allnts : [Identifier] - attrs : [(Identifier,Identifier)] - con : Identifier - inh : Attributes - mergeMap : Map Identifier (Identifier,[Identifier]) - nt : Identifier - syn : Attributes - synthesized attributes: - attributes : [(Identifier,Attributes,Attributes)] - field : (Identifier,Type,Maybe (Maybe Type)) - output : SELF - alternatives: - alternative Child: - child name : {Identifier} - child tp : {Type} - child inh : {Attributes} - child syn : {Attributes} - child virtual : {Maybe (Maybe Type)} - visit 0: - local output : _ --} --- cata -sem_Child :: Child -> - T_Child -sem_Child (Child _name _tp _inh _syn _virtual ) = - (sem_Child_Child _name _tp _inh _syn _virtual ) --- semantic domain -newtype T_Child = T_Child (([(Identifier,Type,Maybe (Maybe Type))]) -> - ([Identifier]) -> - ([(Identifier,Identifier)]) -> - Identifier -> - Attributes -> - (Map Identifier (Identifier,[Identifier])) -> - Identifier -> - Attributes -> - ( ([(Identifier,Attributes,Attributes)]),((Identifier,Type,Maybe (Maybe Type))),Child )) -data Inh_Child = Inh_Child {allfields_Inh_Child :: ([(Identifier,Type,Maybe (Maybe Type))]),allnts_Inh_Child :: ([Identifier]),attrs_Inh_Child :: ([(Identifier,Identifier)]),con_Inh_Child :: Identifier,inh_Inh_Child :: Attributes,mergeMap_Inh_Child :: (Map Identifier (Identifier,[Identifier])),nt_Inh_Child :: Identifier,syn_Inh_Child :: Attributes} -data Syn_Child = Syn_Child {attributes_Syn_Child :: ([(Identifier,Attributes,Attributes)]),field_Syn_Child :: ((Identifier,Type,Maybe (Maybe Type))),output_Syn_Child :: Child } -wrap_Child :: T_Child -> - Inh_Child -> - Syn_Child -wrap_Child (T_Child sem ) (Inh_Child _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIsyn ) = - (let ( _lhsOattributes,_lhsOfield,_lhsOoutput) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIsyn - in (Syn_Child _lhsOattributes _lhsOfield _lhsOoutput )) -sem_Child_Child :: Identifier -> - Type -> - Attributes -> - Attributes -> - (Maybe (Maybe Type)) -> - T_Child -sem_Child_Child name_ tp_ inh_ syn_ virtual_ = - (T_Child (\ _lhsIallfields - _lhsIallnts - _lhsIattrs - _lhsIcon - _lhsIinh - _lhsImergeMap - _lhsInt - _lhsIsyn -> - (let _lhsOattributes :: ([(Identifier,Attributes,Attributes)]) - _lhsOfield :: ((Identifier,Type,Maybe (Maybe Type))) - _lhsOoutput :: Child - -- "src-ag/ResolveLocals.ag"(line 76, column 11) - _lhsOattributes = - ({-# LINE 76 "src-ag/ResolveLocals.ag" #-} - [(name_, inh_, syn_)] - {-# LINE 118 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 79, column 11) - _lhsOfield = - ({-# LINE 79 "src-ag/ResolveLocals.ag" #-} - (name_, tp_, virtual_) - {-# LINE 124 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - Child name_ tp_ inh_ syn_ virtual_ - {-# LINE 130 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 136 "src-ag/ResolveLocals.hs" #-} - ) - in ( _lhsOattributes,_lhsOfield,_lhsOoutput))) ) --- Children ---------------------------------------------------- -{- - visit 0: - inherited attributes: - allfields : [(Identifier,Type,Maybe (Maybe Type))] - allnts : [Identifier] - attrs : [(Identifier,Identifier)] - con : Identifier - inh : Attributes - mergeMap : Map Identifier (Identifier,[Identifier]) - nt : Identifier - syn : Attributes - synthesized attributes: - attributes : [(Identifier,Attributes,Attributes)] - fields : [(Identifier,Type,Maybe (Maybe Type))] - output : SELF - alternatives: - alternative Cons: - child hd : Child - child tl : Children - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Children :: Children -> - T_Children -sem_Children list = - (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) ) --- semantic domain -newtype T_Children = T_Children (([(Identifier,Type,Maybe (Maybe Type))]) -> - ([Identifier]) -> - ([(Identifier,Identifier)]) -> - Identifier -> - Attributes -> - (Map Identifier (Identifier,[Identifier])) -> - Identifier -> - Attributes -> - ( ([(Identifier,Attributes,Attributes)]),([(Identifier,Type,Maybe (Maybe Type))]),Children )) -data Inh_Children = Inh_Children {allfields_Inh_Children :: ([(Identifier,Type,Maybe (Maybe Type))]),allnts_Inh_Children :: ([Identifier]),attrs_Inh_Children :: ([(Identifier,Identifier)]),con_Inh_Children :: Identifier,inh_Inh_Children :: Attributes,mergeMap_Inh_Children :: (Map Identifier (Identifier,[Identifier])),nt_Inh_Children :: Identifier,syn_Inh_Children :: Attributes} -data Syn_Children = Syn_Children {attributes_Syn_Children :: ([(Identifier,Attributes,Attributes)]),fields_Syn_Children :: ([(Identifier,Type,Maybe (Maybe Type))]),output_Syn_Children :: Children } -wrap_Children :: T_Children -> - Inh_Children -> - Syn_Children -wrap_Children (T_Children sem ) (Inh_Children _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIsyn ) = - (let ( _lhsOattributes,_lhsOfields,_lhsOoutput) = sem _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIsyn - 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 - _lhsImergeMap - _lhsInt - _lhsIsyn -> - (let _lhsOfields :: ([(Identifier,Type,Maybe (Maybe Type))]) - _lhsOattributes :: ([(Identifier,Attributes,Attributes)]) - _lhsOoutput :: Children - _hdOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) - _hdOallnts :: ([Identifier]) - _hdOattrs :: ([(Identifier,Identifier)]) - _hdOcon :: Identifier - _hdOinh :: Attributes - _hdOmergeMap :: (Map Identifier (Identifier,[Identifier])) - _hdOnt :: Identifier - _hdOsyn :: Attributes - _tlOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) - _tlOallnts :: ([Identifier]) - _tlOattrs :: ([(Identifier,Identifier)]) - _tlOcon :: Identifier - _tlOinh :: Attributes - _tlOmergeMap :: (Map Identifier (Identifier,[Identifier])) - _tlOnt :: Identifier - _tlOsyn :: Attributes - _hdIattributes :: ([(Identifier,Attributes,Attributes)]) - _hdIfield :: ((Identifier,Type,Maybe (Maybe Type))) - _hdIoutput :: Child - _tlIattributes :: ([(Identifier,Attributes,Attributes)]) - _tlIfields :: ([(Identifier,Type,Maybe (Maybe Type))]) - _tlIoutput :: Children - -- "src-ag/ResolveLocals.ag"(line 82, column 11) - _lhsOfields = - ({-# LINE 82 "src-ag/ResolveLocals.ag" #-} - _hdIfield : _tlIfields - {-# LINE 229 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 74, column 32) - _lhsOattributes = - ({-# LINE 74 "src-ag/ResolveLocals.ag" #-} - _hdIattributes ++ _tlIattributes - {-# LINE 235 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 241 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 247 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOallfields = - ({-# LINE 63 "src-ag/ResolveLocals.ag" #-} - _lhsIallfields - {-# LINE 253 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOallnts = - ({-# LINE 49 "src-ag/ResolveLocals.ag" #-} - _lhsIallnts - {-# LINE 259 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOattrs = - ({-# LINE 63 "src-ag/ResolveLocals.ag" #-} - _lhsIattrs - {-# LINE 265 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOcon = - ({-# LINE 97 "src-ag/ResolveLocals.ag" #-} - _lhsIcon - {-# LINE 271 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 277 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOmergeMap = - ({-# LINE 123 "src-ag/ResolveLocals.ag" #-} - _lhsImergeMap - {-# LINE 283 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 289 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 295 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOallfields = - ({-# LINE 63 "src-ag/ResolveLocals.ag" #-} - _lhsIallfields - {-# LINE 301 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOallnts = - ({-# LINE 49 "src-ag/ResolveLocals.ag" #-} - _lhsIallnts - {-# LINE 307 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOattrs = - ({-# LINE 63 "src-ag/ResolveLocals.ag" #-} - _lhsIattrs - {-# LINE 313 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOcon = - ({-# LINE 97 "src-ag/ResolveLocals.ag" #-} - _lhsIcon - {-# LINE 319 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 325 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOmergeMap = - ({-# LINE 123 "src-ag/ResolveLocals.ag" #-} - _lhsImergeMap - {-# LINE 331 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 337 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 343 "src-ag/ResolveLocals.hs" #-} - ) - ( _hdIattributes,_hdIfield,_hdIoutput) = - hd_ _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOinh _hdOmergeMap _hdOnt _hdOsyn - ( _tlIattributes,_tlIfields,_tlIoutput) = - tl_ _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOinh _tlOmergeMap _tlOnt _tlOsyn - in ( _lhsOattributes,_lhsOfields,_lhsOoutput))) ) -sem_Children_Nil :: T_Children -sem_Children_Nil = - (T_Children (\ _lhsIallfields - _lhsIallnts - _lhsIattrs - _lhsIcon - _lhsIinh - _lhsImergeMap - _lhsInt - _lhsIsyn -> - (let _lhsOfields :: ([(Identifier,Type,Maybe (Maybe Type))]) - _lhsOattributes :: ([(Identifier,Attributes,Attributes)]) - _lhsOoutput :: Children - -- "src-ag/ResolveLocals.ag"(line 83, column 11) - _lhsOfields = - ({-# LINE 83 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 367 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 74, column 32) - _lhsOattributes = - ({-# LINE 74 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 373 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 379 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 385 "src-ag/ResolveLocals.hs" #-} - ) - in ( _lhsOattributes,_lhsOfields,_lhsOoutput))) ) --- Expression -------------------------------------------------- -{- - visit 0: - inherited attributes: - allfields : [(Identifier,Type,Maybe (Maybe Type))] - allnts : [Identifier] - attrs : [(Identifier,Identifier)] - con : Identifier - mergeMap : Map Identifier (Identifier,[Identifier]) - nt : Identifier - options : Options - synthesized attributes: - errors : Seq Error - output : SELF - alternatives: - alternative Expression: - child pos : {Pos} - child tks : {[HsToken]} - visit 0: - local _tup1 : _ - 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,Maybe (Maybe Type))]) -> - ([Identifier]) -> - ([(Identifier,Identifier)]) -> - Identifier -> - (Map Identifier (Identifier,[Identifier])) -> - Identifier -> - Options -> - ( (Seq Error),Expression )) -data Inh_Expression = Inh_Expression {allfields_Inh_Expression :: ([(Identifier,Type,Maybe (Maybe Type))]),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 137, column 21) - __tup1 = - ({-# LINE 137 "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 461 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 137, column 21) - (_errors,_) = - ({-# LINE 137 "src-ag/ResolveLocals.ag" #-} - __tup1 - {-# LINE 467 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 137, column 21) - (_,_newTks) = - ({-# LINE 137 "src-ag/ResolveLocals.ag" #-} - __tup1 - {-# LINE 473 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 149, column 17) - _lhsOoutput = - ({-# LINE 149 "src-ag/ResolveLocals.ag" #-} - Expression pos_ _newTks - {-# LINE 479 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - _errors - {-# LINE 485 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - Expression pos_ tks_ - {-# LINE 491 "src-ag/ResolveLocals.hs" #-} - ) - in ( _lhsOerrors,_lhsOoutput))) ) --- Grammar ----------------------------------------------------- -{- - visit 0: - inherited attribute: - options : Options - synthesized attributes: - errors : Seq Error - output : SELF - alternatives: - alternative Grammar: - child typeSyns : {TypeSyns} - child useMap : {UseMap} - child derivings : {Derivings} - child wrappers : {Set 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])))) - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Grammar - _nontsOoptions :: Options - _nontsIerrors :: (Seq Error) - _nontsInonts :: ([(NontermIdent,[ConstructorIdent])]) - _nontsIoutput :: Nonterminals - -- "src-ag/ResolveLocals.ag"(line 52, column 13) - _nontsOallnts = - ({-# LINE 52 "src-ag/ResolveLocals.ag" #-} - map fst (_nontsInonts) - {-# LINE 566 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 112, column 14) - _nontsOmergeMap = - ({-# LINE 112 "src-ag/ResolveLocals.ag" #-} - Map.map (Map.map (Map.map (\(nt,srcs,_) -> (nt,srcs)))) mergeMap_ - {-# LINE 572 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - _nontsIerrors - {-# LINE 578 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ - {-# LINE 584 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 590 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _nontsOoptions = - ({-# LINE 33 "src-ag/ResolveLocals.ag" #-} - _lhsIoptions - {-# LINE 596 "src-ag/ResolveLocals.hs" #-} - ) - ( _nontsIerrors,_nontsInonts,_nontsIoutput) = - nonts_ _nontsOallnts _nontsOmergeMap _nontsOoptions - in ( _lhsOerrors,_lhsOoutput))) ) --- Nonterminal ------------------------------------------------- -{- - visit 0: - inherited attributes: - allnts : [Identifier] - mergeMap : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) - options : Options - synthesized attributes: - errors : Seq Error - nonts : [(NontermIdent,[ConstructorIdent])] - output : SELF - 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 NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> - Options -> - ( (Seq Error),([(NontermIdent,[ConstructorIdent])]),Nonterminal )) -data Inh_Nonterminal = Inh_Nonterminal {allnts_Inh_Nonterminal :: ([Identifier]),mergeMap_Inh_Nonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))),options_Inh_Nonterminal :: Options} -data Syn_Nonterminal = Syn_Nonterminal {errors_Syn_Nonterminal :: (Seq Error),nonts_Syn_Nonterminal :: ([(NontermIdent,[ConstructorIdent])]),output_Syn_Nonterminal :: Nonterminal } -wrap_Nonterminal :: T_Nonterminal -> - Inh_Nonterminal -> - Syn_Nonterminal -wrap_Nonterminal (T_Nonterminal sem ) (Inh_Nonterminal _lhsIallnts _lhsImergeMap _lhsIoptions ) = - (let ( _lhsOerrors,_lhsOnonts,_lhsOoutput) = sem _lhsIallnts _lhsImergeMap _lhsIoptions - in (Syn_Nonterminal _lhsOerrors _lhsOnonts _lhsOoutput )) -sem_Nonterminal_Nonterminal :: NontermIdent -> - ([Identifier]) -> - Attributes -> - Attributes -> - T_Productions -> - T_Nonterminal -sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_ ) = - (T_Nonterminal (\ _lhsIallnts - _lhsImergeMap - _lhsIoptions -> - (let _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])]) - _prodsOnt :: Identifier - _prodsOinh :: Attributes - _prodsOsyn :: Attributes - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Nonterminal - _prodsOallnts :: ([Identifier]) - _prodsOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) - _prodsOoptions :: Options - _prodsIcons :: ([ConstructorIdent]) - _prodsIerrors :: (Seq Error) - _prodsIoutput :: Productions - -- "src-ag/ResolveLocals.ag"(line 56, column 19) - _lhsOnonts = - ({-# LINE 56 "src-ag/ResolveLocals.ag" #-} - [(nt_,_prodsIcons)] - {-# LINE 667 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 104, column 17) - _prodsOnt = - ({-# LINE 104 "src-ag/ResolveLocals.ag" #-} - nt_ - {-# LINE 673 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 107, column 17) - _prodsOinh = - ({-# LINE 107 "src-ag/ResolveLocals.ag" #-} - inh_ - {-# LINE 679 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 108, column 17) - _prodsOsyn = - ({-# LINE 108 "src-ag/ResolveLocals.ag" #-} - syn_ - {-# LINE 685 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 120, column 32) - _mergeMap = - ({-# LINE 120 "src-ag/ResolveLocals.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsImergeMap - {-# LINE 691 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - _prodsIerrors - {-# LINE 697 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - Nonterminal nt_ params_ inh_ syn_ _prodsIoutput - {-# LINE 703 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 709 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _prodsOallnts = - ({-# LINE 49 "src-ag/ResolveLocals.ag" #-} - _lhsIallnts - {-# LINE 715 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (from local) - _prodsOmergeMap = - ({-# LINE 118 "src-ag/ResolveLocals.ag" #-} - _mergeMap - {-# LINE 721 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _prodsOoptions = - ({-# LINE 33 "src-ag/ResolveLocals.ag" #-} - _lhsIoptions - {-# LINE 727 "src-ag/ResolveLocals.hs" #-} - ) - ( _prodsIcons,_prodsIerrors,_prodsIoutput) = - prods_ _prodsOallnts _prodsOinh _prodsOmergeMap _prodsOnt _prodsOoptions _prodsOsyn - in ( _lhsOerrors,_lhsOnonts,_lhsOoutput))) ) --- Nonterminals ------------------------------------------------ -{- - visit 0: - inherited attributes: - allnts : [Identifier] - mergeMap : Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) - options : Options - synthesized attributes: - errors : Seq Error - nonts : [(NontermIdent,[ConstructorIdent])] - output : SELF - alternatives: - alternative Cons: - child hd : Nonterminal - child tl : Nonterminals - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Nonterminals :: Nonterminals -> - T_Nonterminals -sem_Nonterminals list = - (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) ) --- semantic domain -newtype T_Nonterminals = T_Nonterminals (([Identifier]) -> - (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> - Options -> - ( (Seq Error),([(NontermIdent,[ConstructorIdent])]),Nonterminals )) -data Inh_Nonterminals = Inh_Nonterminals {allnts_Inh_Nonterminals :: ([Identifier]),mergeMap_Inh_Nonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))),options_Inh_Nonterminals :: Options} -data Syn_Nonterminals = Syn_Nonterminals {errors_Syn_Nonterminals :: (Seq Error),nonts_Syn_Nonterminals :: ([(NontermIdent,[ConstructorIdent])]),output_Syn_Nonterminals :: Nonterminals } -wrap_Nonterminals :: T_Nonterminals -> - Inh_Nonterminals -> - Syn_Nonterminals -wrap_Nonterminals (T_Nonterminals sem ) (Inh_Nonterminals _lhsIallnts _lhsImergeMap _lhsIoptions ) = - (let ( _lhsOerrors,_lhsOnonts,_lhsOoutput) = sem _lhsIallnts _lhsImergeMap _lhsIoptions - in (Syn_Nonterminals _lhsOerrors _lhsOnonts _lhsOoutput )) -sem_Nonterminals_Cons :: T_Nonterminal -> - T_Nonterminals -> - T_Nonterminals -sem_Nonterminals_Cons (T_Nonterminal hd_ ) (T_Nonterminals tl_ ) = - (T_Nonterminals (\ _lhsIallnts - _lhsImergeMap - _lhsIoptions -> - (let _lhsOerrors :: (Seq Error) - _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])]) - _lhsOoutput :: Nonterminals - _hdOallnts :: ([Identifier]) - _hdOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) - _hdOoptions :: Options - _tlOallnts :: ([Identifier]) - _tlOmergeMap :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) - _tlOoptions :: Options - _hdIerrors :: (Seq Error) - _hdInonts :: ([(NontermIdent,[ConstructorIdent])]) - _hdIoutput :: Nonterminal - _tlIerrors :: (Seq Error) - _tlInonts :: ([(NontermIdent,[ConstructorIdent])]) - _tlIoutput :: Nonterminals - -- use rule "src-ag/ResolveLocals.ag"(line 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 797 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 54, column 43) - _lhsOnonts = - ({-# LINE 54 "src-ag/ResolveLocals.ag" #-} - _hdInonts ++ _tlInonts - {-# LINE 803 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 809 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 815 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOallnts = - ({-# LINE 49 "src-ag/ResolveLocals.ag" #-} - _lhsIallnts - {-# LINE 821 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOmergeMap = - ({-# LINE 115 "src-ag/ResolveLocals.ag" #-} - _lhsImergeMap - {-# LINE 827 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 33 "src-ag/ResolveLocals.ag" #-} - _lhsIoptions - {-# LINE 833 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOallnts = - ({-# LINE 49 "src-ag/ResolveLocals.ag" #-} - _lhsIallnts - {-# LINE 839 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOmergeMap = - ({-# LINE 115 "src-ag/ResolveLocals.ag" #-} - _lhsImergeMap - {-# LINE 845 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 33 "src-ag/ResolveLocals.ag" #-} - _lhsIoptions - {-# LINE 851 "src-ag/ResolveLocals.hs" #-} - ) - ( _hdIerrors,_hdInonts,_hdIoutput) = - hd_ _hdOallnts _hdOmergeMap _hdOoptions - ( _tlIerrors,_tlInonts,_tlIoutput) = - tl_ _tlOallnts _tlOmergeMap _tlOoptions - in ( _lhsOerrors,_lhsOnonts,_lhsOoutput))) ) -sem_Nonterminals_Nil :: T_Nonterminals -sem_Nonterminals_Nil = - (T_Nonterminals (\ _lhsIallnts - _lhsImergeMap - _lhsIoptions -> - (let _lhsOerrors :: (Seq Error) - _lhsOnonts :: ([(NontermIdent,[ConstructorIdent])]) - _lhsOoutput :: Nonterminals - -- use rule "src-ag/ResolveLocals.ag"(line 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - Seq.empty - {-# LINE 870 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 54, column 43) - _lhsOnonts = - ({-# LINE 54 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 876 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 882 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 888 "src-ag/ResolveLocals.hs" #-} - ) - in ( _lhsOerrors,_lhsOnonts,_lhsOoutput))) ) --- Pattern ----------------------------------------------------- -{- - visit 0: - inherited attributes: - con : Identifier - inh : Attributes - nt : Identifier - syn : Attributes - synthesized attributes: - copy : SELF - errors : Seq Error - instVars : [Identifier] - locVars : [Identifier] - output : SELF - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - local output : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - local output : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - local output : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - local output : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ - local output : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern (Alias _field _attr _pat _parts ) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) -sem_Pattern (Constr _name _pats ) = - (sem_Pattern_Constr _name (sem_Patterns _pats ) ) -sem_Pattern (Irrefutable _pat ) = - (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) -sem_Pattern (Product _pos _pats ) = - (sem_Pattern_Product _pos (sem_Patterns _pats ) ) -sem_Pattern (Underscore _pos ) = - (sem_Pattern_Underscore _pos ) --- semantic domain -newtype T_Pattern = T_Pattern (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_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = - (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 - _partsOcon :: Identifier - _partsOinh :: Attributes - _partsOnt :: Identifier - _partsOsyn :: Attributes - _patIcopy :: Pattern - _patIerrors :: (Seq Error) - _patIinstVars :: ([Identifier]) - _patIlocVars :: ([Identifier]) - _patIoutput :: Pattern - _partsIcopy :: Patterns - _partsIerrors :: (Seq Error) - _partsIinstVars :: ([Identifier]) - _partsIlocVars :: ([Identifier]) - _partsIoutput :: Patterns - -- "src-ag/ResolveLocals.ag"(line 88, column 14) - _lhsOlocVars = - ({-# LINE 88 "src-ag/ResolveLocals.ag" #-} - if field_ == _LOC - then [attr_] - else [] - {-# LINE 1003 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 91, column 14) - _lhsOinstVars = - ({-# LINE 91 "src-ag/ResolveLocals.ag" #-} - if field_ == _INST - then [attr_] - else [] - {-# LINE 1011 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - _patIerrors Seq.>< _partsIerrors - {-# LINE 1017 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 1023 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - Alias field_ attr_ _patIoutput _partsIoutput - {-# LINE 1029 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1035 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 1041 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patOcon = - ({-# LINE 97 "src-ag/ResolveLocals.ag" #-} - _lhsIcon - {-# LINE 1047 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 1053 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 1059 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 1065 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _partsOcon = - ({-# LINE 97 "src-ag/ResolveLocals.ag" #-} - _lhsIcon - {-# LINE 1071 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _partsOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 1077 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _partsOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 1083 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _partsOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 1089 "src-ag/ResolveLocals.hs" #-} - ) - ( _patIcopy,_patIerrors,_patIinstVars,_patIlocVars,_patIoutput) = - pat_ _patOcon _patOinh _patOnt _patOsyn - ( _partsIcopy,_partsIerrors,_partsIinstVars,_partsIlocVars,_partsIoutput) = - parts_ _partsOcon _partsOinh _partsOnt _partsOsyn - in ( _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 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - _patsIerrors - {-# LINE 1122 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 86) - _lhsOinstVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - _patsIinstVars - {-# LINE 1128 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 48) - _lhsOlocVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - _patsIlocVars - {-# LINE 1134 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 1140 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - Constr name_ _patsIoutput - {-# LINE 1146 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1152 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 1158 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patsOcon = - ({-# LINE 97 "src-ag/ResolveLocals.ag" #-} - _lhsIcon - {-# LINE 1164 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patsOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 1170 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patsOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 1176 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patsOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 1182 "src-ag/ResolveLocals.hs" #-} - ) - ( _patsIcopy,_patsIerrors,_patsIinstVars,_patsIlocVars,_patsIoutput) = - pats_ _patsOcon _patsOinh _patsOnt _patsOsyn - 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 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - _patIerrors - {-# LINE 1212 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 86) - _lhsOinstVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - _patIinstVars - {-# LINE 1218 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 48) - _lhsOlocVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - _patIlocVars - {-# LINE 1224 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 1230 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - Irrefutable _patIoutput - {-# LINE 1236 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1242 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 1248 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patOcon = - ({-# LINE 97 "src-ag/ResolveLocals.ag" #-} - _lhsIcon - {-# LINE 1254 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 1260 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 1266 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 1272 "src-ag/ResolveLocals.hs" #-} - ) - ( _patIcopy,_patIerrors,_patIinstVars,_patIlocVars,_patIoutput) = - pat_ _patOcon _patOinh _patOnt _patOsyn - 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 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - _patsIerrors - {-# LINE 1303 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 86) - _lhsOinstVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - _patsIinstVars - {-# LINE 1309 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 48) - _lhsOlocVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - _patsIlocVars - {-# LINE 1315 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 1321 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - Product pos_ _patsIoutput - {-# LINE 1327 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1333 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 1339 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patsOcon = - ({-# LINE 97 "src-ag/ResolveLocals.ag" #-} - _lhsIcon - {-# LINE 1345 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patsOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 1351 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patsOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 1357 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patsOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 1363 "src-ag/ResolveLocals.hs" #-} - ) - ( _patsIcopy,_patsIerrors,_patsIinstVars,_patsIlocVars,_patsIoutput) = - pats_ _patsOcon _patsOinh _patsOnt _patsOsyn - 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 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - Seq.empty - {-# LINE 1384 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 86) - _lhsOinstVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 1390 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 48) - _lhsOlocVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 1396 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Underscore pos_ - {-# LINE 1402 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - Underscore pos_ - {-# LINE 1408 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1414 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 1420 "src-ag/ResolveLocals.hs" #-} - ) - in ( _lhsOcopy,_lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput))) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - inherited attributes: - con : Identifier - inh : Attributes - nt : Identifier - syn : Attributes - synthesized attributes: - copy : SELF - errors : Seq Error - instVars : [Identifier] - locVars : [Identifier] - output : SELF - alternatives: - alternative Cons: - child hd : Pattern - child tl : Patterns - visit 0: - local copy : _ - local output : _ - alternative Nil: - visit 0: - local copy : _ - local output : _ --} --- cata -sem_Patterns :: Patterns -> - T_Patterns -sem_Patterns list = - (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) ) --- semantic domain -newtype T_Patterns = T_Patterns (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 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 1503 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 86) - _lhsOinstVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - _hdIinstVars ++ _tlIinstVars - {-# LINE 1509 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 48) - _lhsOlocVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - _hdIlocVars ++ _tlIlocVars - {-# LINE 1515 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 1521 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 1527 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1533 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 1539 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOcon = - ({-# LINE 97 "src-ag/ResolveLocals.ag" #-} - _lhsIcon - {-# LINE 1545 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 1551 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 1557 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 1563 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOcon = - ({-# LINE 97 "src-ag/ResolveLocals.ag" #-} - _lhsIcon - {-# LINE 1569 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 1575 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 1581 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 1587 "src-ag/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 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - Seq.empty - {-# LINE 1609 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 86) - _lhsOinstVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 1615 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 48) - _lhsOlocVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 1621 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - [] - {-# LINE 1627 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 1633 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 1639 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 1645 "src-ag/ResolveLocals.hs" #-} - ) - in ( _lhsOcopy,_lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput))) ) --- Production -------------------------------------------------- -{- - visit 0: - inherited attributes: - allnts : [Identifier] - inh : Attributes - mergeMap : Map ConstructorIdent (Map Identifier (Identifier,[Identifier])) - nt : Identifier - options : Options - syn : Attributes - synthesized attributes: - cons : [ConstructorIdent] - errors : Seq Error - output : SELF - alternatives: - alternative Production: - child con : {ConstructorIdent} - child children : Children - child rules : Rules - child typeSigs : TypeSigs - visit 0: - local allfields : _ - local attrs : _ - local inhnames : _ - local synnames : _ - local mergeMap : _ - local output : _ --} --- cata -sem_Production :: Production -> - T_Production -sem_Production (Production _con _children _rules _typeSigs ) = - (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) --- semantic domain -newtype T_Production = T_Production (([Identifier]) -> - Attributes -> - (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) -> - Identifier -> - Options -> - Attributes -> - ( ([ConstructorIdent]),(Seq Error),Production )) -data Inh_Production = Inh_Production {allnts_Inh_Production :: ([Identifier]),inh_Inh_Production :: Attributes,mergeMap_Inh_Production :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))),nt_Inh_Production :: Identifier,options_Inh_Production :: Options,syn_Inh_Production :: 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 _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn ) = - (let ( _lhsOcons,_lhsOerrors,_lhsOoutput) = sem _lhsIallnts _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn - in (Syn_Production _lhsOcons _lhsOerrors _lhsOoutput )) -sem_Production_Production :: ConstructorIdent -> - T_Children -> - T_Rules -> - T_TypeSigs -> - T_Production -sem_Production_Production con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) = - (T_Production (\ _lhsIallnts - _lhsIinh - _lhsImergeMap - _lhsInt - _lhsIoptions - _lhsIsyn -> - (let _lhsOcons :: ([ConstructorIdent]) - _childrenOcon :: Identifier - _rulesOcon :: Identifier - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Production - _childrenOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) - _childrenOallnts :: ([Identifier]) - _childrenOattrs :: ([(Identifier,Identifier)]) - _childrenOinh :: Attributes - _childrenOmergeMap :: (Map Identifier (Identifier,[Identifier])) - _childrenOnt :: Identifier - _childrenOsyn :: Attributes - _rulesOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) - _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,Maybe (Maybe Type))]) - _childrenIoutput :: Children - _rulesIerrors :: (Seq Error) - _rulesIinstVars :: ([Identifier]) - _rulesIlocVars :: ([Identifier]) - _rulesIoutput :: Rules - _typeSigsIoutput :: TypeSigs - -- "src-ag/ResolveLocals.ag"(line 59, column 18) - _lhsOcons = - ({-# LINE 59 "src-ag/ResolveLocals.ag" #-} - [con_] - {-# LINE 1741 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 66, column 16) - _allfields = - ({-# LINE 66 "src-ag/ResolveLocals.ag" #-} - _childrenIfields - {-# LINE 1747 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 66, column 16) - _attrs = - ({-# LINE 67 "src-ag/ResolveLocals.ag" #-} - map ((,) _LOC) _rulesIlocVars ++ - map ((,) _INST) _rulesIinstVars ++ - map ((,) _LHS) _inhnames ++ - concat [map ((,) nm) (Map.keys as) | (nm,_,as) <- _childrenIattributes] - {-# LINE 1756 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 66, column 16) - _inhnames = - ({-# LINE 71 "src-ag/ResolveLocals.ag" #-} - Map.keys _lhsIinh - {-# LINE 1762 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 66, column 16) - _synnames = - ({-# LINE 72 "src-ag/ResolveLocals.ag" #-} - Map.keys _lhsIsyn - {-# LINE 1768 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 100, column 16) - _childrenOcon = - ({-# LINE 100 "src-ag/ResolveLocals.ag" #-} - con_ - {-# LINE 1774 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 102, column 16) - _rulesOcon = - ({-# LINE 102 "src-ag/ResolveLocals.ag" #-} - con_ - {-# LINE 1780 "src-ag/ResolveLocals.hs" #-} - ) - -- "src-ag/ResolveLocals.ag"(line 121, column 32) - _mergeMap = - ({-# LINE 121 "src-ag/ResolveLocals.ag" #-} - Map.findWithDefault Map.empty con_ _lhsImergeMap - {-# LINE 1786 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - _rulesIerrors - {-# LINE 1792 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - Production con_ _childrenIoutput _rulesIoutput _typeSigsIoutput - {-# LINE 1798 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 1804 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (from local) - _childrenOallfields = - ({-# LINE 63 "src-ag/ResolveLocals.ag" #-} - _allfields - {-# LINE 1810 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _childrenOallnts = - ({-# LINE 49 "src-ag/ResolveLocals.ag" #-} - _lhsIallnts - {-# LINE 1816 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (from local) - _childrenOattrs = - ({-# LINE 63 "src-ag/ResolveLocals.ag" #-} - _attrs - {-# LINE 1822 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _childrenOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 1828 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (from local) - _childrenOmergeMap = - ({-# LINE 123 "src-ag/ResolveLocals.ag" #-} - _mergeMap - {-# LINE 1834 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _childrenOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 1840 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _childrenOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 1846 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (from local) - _rulesOallfields = - ({-# LINE 63 "src-ag/ResolveLocals.ag" #-} - _allfields - {-# LINE 1852 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _rulesOallnts = - ({-# LINE 49 "src-ag/ResolveLocals.ag" #-} - _lhsIallnts - {-# LINE 1858 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (from local) - _rulesOattrs = - ({-# LINE 63 "src-ag/ResolveLocals.ag" #-} - _attrs - {-# LINE 1864 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _rulesOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 1870 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (from local) - _rulesOmergeMap = - ({-# LINE 123 "src-ag/ResolveLocals.ag" #-} - _mergeMap - {-# LINE 1876 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _rulesOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 1882 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _rulesOoptions = - ({-# LINE 33 "src-ag/ResolveLocals.ag" #-} - _lhsIoptions - {-# LINE 1888 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _rulesOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 1894 "src-ag/ResolveLocals.hs" #-} - ) - ( _childrenIattributes,_childrenIfields,_childrenIoutput) = - children_ _childrenOallfields _childrenOallnts _childrenOattrs _childrenOcon _childrenOinh _childrenOmergeMap _childrenOnt _childrenOsyn - ( _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 - mergeMap : Map ConstructorIdent (Map Identifier (Identifier,[Identifier])) - nt : Identifier - options : Options - syn : Attributes - synthesized attributes: - cons : [ConstructorIdent] - errors : Seq Error - output : SELF - alternatives: - alternative Cons: - child hd : Production - child tl : Productions - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Productions :: Productions -> - T_Productions -sem_Productions list = - (Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) ) --- semantic domain -newtype T_Productions = T_Productions (([Identifier]) -> - Attributes -> - (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) -> - Identifier -> - Options -> - Attributes -> - ( ([ConstructorIdent]),(Seq Error),Productions )) -data Inh_Productions = Inh_Productions {allnts_Inh_Productions :: ([Identifier]),inh_Inh_Productions :: Attributes,mergeMap_Inh_Productions :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))),nt_Inh_Productions :: Identifier,options_Inh_Productions :: Options,syn_Inh_Productions :: 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 _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn ) = - (let ( _lhsOcons,_lhsOerrors,_lhsOoutput) = sem _lhsIallnts _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn - 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 - _lhsImergeMap - _lhsInt - _lhsIoptions - _lhsIsyn -> - (let _lhsOcons :: ([ConstructorIdent]) - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Productions - _hdOallnts :: ([Identifier]) - _hdOinh :: Attributes - _hdOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) - _hdOnt :: Identifier - _hdOoptions :: Options - _hdOsyn :: Attributes - _tlOallnts :: ([Identifier]) - _tlOinh :: Attributes - _tlOmergeMap :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) - _tlOnt :: Identifier - _tlOoptions :: Options - _tlOsyn :: Attributes - _hdIcons :: ([ConstructorIdent]) - _hdIerrors :: (Seq Error) - _hdIoutput :: Production - _tlIcons :: ([ConstructorIdent]) - _tlIerrors :: (Seq Error) - _tlIoutput :: Productions - -- use rule "src-ag/ResolveLocals.ag"(line 57, column 40) - _lhsOcons = - ({-# LINE 57 "src-ag/ResolveLocals.ag" #-} - _hdIcons ++ _tlIcons - {-# LINE 1983 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 1989 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 1995 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 2001 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOallnts = - ({-# LINE 49 "src-ag/ResolveLocals.ag" #-} - _lhsIallnts - {-# LINE 2007 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 2013 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOmergeMap = - ({-# LINE 118 "src-ag/ResolveLocals.ag" #-} - _lhsImergeMap - {-# LINE 2019 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 2025 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 33 "src-ag/ResolveLocals.ag" #-} - _lhsIoptions - {-# LINE 2031 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 2037 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOallnts = - ({-# LINE 49 "src-ag/ResolveLocals.ag" #-} - _lhsIallnts - {-# LINE 2043 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 2049 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOmergeMap = - ({-# LINE 118 "src-ag/ResolveLocals.ag" #-} - _lhsImergeMap - {-# LINE 2055 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 2061 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 33 "src-ag/ResolveLocals.ag" #-} - _lhsIoptions - {-# LINE 2067 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 2073 "src-ag/ResolveLocals.hs" #-} - ) - ( _hdIcons,_hdIerrors,_hdIoutput) = - hd_ _hdOallnts _hdOinh _hdOmergeMap _hdOnt _hdOoptions _hdOsyn - ( _tlIcons,_tlIerrors,_tlIoutput) = - tl_ _tlOallnts _tlOinh _tlOmergeMap _tlOnt _tlOoptions _tlOsyn - in ( _lhsOcons,_lhsOerrors,_lhsOoutput))) ) -sem_Productions_Nil :: T_Productions -sem_Productions_Nil = - (T_Productions (\ _lhsIallnts - _lhsIinh - _lhsImergeMap - _lhsInt - _lhsIoptions - _lhsIsyn -> - (let _lhsOcons :: ([ConstructorIdent]) - _lhsOerrors :: (Seq Error) - _lhsOoutput :: Productions - -- use rule "src-ag/ResolveLocals.ag"(line 57, column 40) - _lhsOcons = - ({-# LINE 57 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 2095 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - Seq.empty - {-# LINE 2101 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 2107 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 2113 "src-ag/ResolveLocals.hs" #-} - ) - in ( _lhsOcons,_lhsOerrors,_lhsOoutput))) ) --- Rule -------------------------------------------------------- -{- - visit 0: - inherited attributes: - allfields : [(Identifier,Type,Maybe (Maybe Type))] - 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 : SELF - alternatives: - alternative Rule: - child mbName : {Maybe Identifier} - child pattern : Pattern - child rhs : Expression - child owrt : {Bool} - child origin : {String} - child explicit : {Bool} - visit 0: - local output : _ --} --- cata -sem_Rule :: Rule -> - T_Rule -sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit ) = - (sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) --- semantic domain -newtype T_Rule = T_Rule (([(Identifier,Type,Maybe (Maybe Type))]) -> - ([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,Maybe (Maybe Type))]),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 -> - T_Rule -sem_Rule_Rule mbName_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ = - (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,Maybe (Maybe Type))]) - _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 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - _patternIerrors Seq.>< _rhsIerrors - {-# LINE 2212 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 86) - _lhsOinstVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - _patternIinstVars - {-# LINE 2218 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 48) - _lhsOlocVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - _patternIlocVars - {-# LINE 2224 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - Rule mbName_ _patternIoutput _rhsIoutput owrt_ origin_ explicit_ - {-# LINE 2230 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 2236 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patternOcon = - ({-# LINE 97 "src-ag/ResolveLocals.ag" #-} - _lhsIcon - {-# LINE 2242 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patternOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 2248 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patternOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 2254 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _patternOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 2260 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _rhsOallfields = - ({-# LINE 131 "src-ag/ResolveLocals.ag" #-} - _lhsIallfields - {-# LINE 2266 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _rhsOallnts = - ({-# LINE 132 "src-ag/ResolveLocals.ag" #-} - _lhsIallnts - {-# LINE 2272 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _rhsOattrs = - ({-# LINE 133 "src-ag/ResolveLocals.ag" #-} - _lhsIattrs - {-# LINE 2278 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _rhsOcon = - ({-# LINE 130 "src-ag/ResolveLocals.ag" #-} - _lhsIcon - {-# LINE 2284 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _rhsOmergeMap = - ({-# LINE 123 "src-ag/ResolveLocals.ag" #-} - _lhsImergeMap - {-# LINE 2290 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _rhsOnt = - ({-# LINE 130 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 2296 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _rhsOoptions = - ({-# LINE 33 "src-ag/ResolveLocals.ag" #-} - _lhsIoptions - {-# LINE 2302 "src-ag/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,Maybe (Maybe Type))] - 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 : SELF - alternatives: - alternative Cons: - child hd : Rule - child tl : Rules - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_Rules :: Rules -> - T_Rules -sem_Rules list = - (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) ) --- semantic domain -newtype T_Rules = T_Rules (([(Identifier,Type,Maybe (Maybe Type))]) -> - ([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,Maybe (Maybe Type))]),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,Maybe (Maybe Type))]) - _hdOallnts :: ([Identifier]) - _hdOattrs :: ([(Identifier,Identifier)]) - _hdOcon :: Identifier - _hdOinh :: Attributes - _hdOmergeMap :: (Map Identifier (Identifier,[Identifier])) - _hdOnt :: Identifier - _hdOoptions :: Options - _hdOsyn :: Attributes - _tlOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) - _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 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 2408 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 86) - _lhsOinstVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - _hdIinstVars ++ _tlIinstVars - {-# LINE 2414 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 48) - _lhsOlocVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - _hdIlocVars ++ _tlIlocVars - {-# LINE 2420 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 2426 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 2432 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOallfields = - ({-# LINE 63 "src-ag/ResolveLocals.ag" #-} - _lhsIallfields - {-# LINE 2438 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOallnts = - ({-# LINE 49 "src-ag/ResolveLocals.ag" #-} - _lhsIallnts - {-# LINE 2444 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOattrs = - ({-# LINE 63 "src-ag/ResolveLocals.ag" #-} - _lhsIattrs - {-# LINE 2450 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOcon = - ({-# LINE 97 "src-ag/ResolveLocals.ag" #-} - _lhsIcon - {-# LINE 2456 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 2462 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOmergeMap = - ({-# LINE 123 "src-ag/ResolveLocals.ag" #-} - _lhsImergeMap - {-# LINE 2468 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 2474 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 33 "src-ag/ResolveLocals.ag" #-} - _lhsIoptions - {-# LINE 2480 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _hdOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 2486 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOallfields = - ({-# LINE 63 "src-ag/ResolveLocals.ag" #-} - _lhsIallfields - {-# LINE 2492 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOallnts = - ({-# LINE 49 "src-ag/ResolveLocals.ag" #-} - _lhsIallnts - {-# LINE 2498 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOattrs = - ({-# LINE 63 "src-ag/ResolveLocals.ag" #-} - _lhsIattrs - {-# LINE 2504 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOcon = - ({-# LINE 97 "src-ag/ResolveLocals.ag" #-} - _lhsIcon - {-# LINE 2510 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOinh = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIinh - {-# LINE 2516 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOmergeMap = - ({-# LINE 123 "src-ag/ResolveLocals.ag" #-} - _lhsImergeMap - {-# LINE 2522 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsInt - {-# LINE 2528 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 33 "src-ag/ResolveLocals.ag" #-} - _lhsIoptions - {-# LINE 2534 "src-ag/ResolveLocals.hs" #-} - ) - -- copy rule (down) - _tlOsyn = - ({-# LINE 96 "src-ag/ResolveLocals.ag" #-} - _lhsIsyn - {-# LINE 2540 "src-ag/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 36, column 16) - _lhsOerrors = - ({-# LINE 36 "src-ag/ResolveLocals.ag" #-} - Seq.empty - {-# LINE 2566 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 86) - _lhsOinstVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 2572 "src-ag/ResolveLocals.hs" #-} - ) - -- use rule "src-ag/ResolveLocals.ag"(line 85, column 48) - _lhsOlocVars = - ({-# LINE 85 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 2578 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _output = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 2584 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 2590 "src-ag/ResolveLocals.hs" #-} - ) - in ( _lhsOerrors,_lhsOinstVars,_lhsOlocVars,_lhsOoutput))) ) --- TypeSig ----------------------------------------------------- -{- - visit 0: - synthesized attribute: - output : SELF - alternatives: - alternative TypeSig: - child name : {Identifier} - child tp : {Type} - visit 0: - local output : _ --} --- cata -sem_TypeSig :: TypeSig -> - T_TypeSig -sem_TypeSig (TypeSig _name _tp ) = - (sem_TypeSig_TypeSig _name _tp ) --- semantic domain -newtype T_TypeSig = T_TypeSig (( TypeSig )) -data Inh_TypeSig = Inh_TypeSig {} -data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: TypeSig } -wrap_TypeSig :: T_TypeSig -> - 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 39 "src-ag/ResolveLocals.ag" #-} - TypeSig name_ tp_ - {-# LINE 2629 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 2635 "src-ag/ResolveLocals.hs" #-} - ) - in ( _lhsOoutput)) ) --- TypeSigs ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - output : SELF - alternatives: - alternative Cons: - child hd : TypeSig - child tl : TypeSigs - visit 0: - local output : _ - alternative Nil: - visit 0: - local output : _ --} --- cata -sem_TypeSigs :: TypeSigs -> - T_TypeSigs -sem_TypeSigs list = - (Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) ) --- semantic domain -newtype T_TypeSigs = T_TypeSigs (( TypeSigs )) -data Inh_TypeSigs = Inh_TypeSigs {} -data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: TypeSigs } -wrap_TypeSigs :: T_TypeSigs -> - 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 39 "src-ag/ResolveLocals.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 2679 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 2685 "src-ag/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 39 "src-ag/ResolveLocals.ag" #-} - [] - {-# LINE 2699 "src-ag/ResolveLocals.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 39 "src-ag/ResolveLocals.ag" #-} - _output - {-# LINE 2705 "src-ag/ResolveLocals.hs" #-} - ) - in ( _lhsOoutput)) ) diff --git a/dist/build/uuagc/uuagc-tmp/SemHsTokens.hs b/dist/build/uuagc/uuagc-tmp/SemHsTokens.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/SemHsTokens.hs +++ /dev/null @@ -1,938 +0,0 @@ - - --- UUAGC 0.9.39.0.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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/SemHsTokens.hs" #-} - -{-# LINE 2 "src-ag/HsToken.ag" #-} - -import CommonTypes -import UU.Scanner.Position(Pos) -{-# LINE 22 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/SemHsTokens.hs" #-} -{-# LINE 57 "src-ag/SemHsTokens.ag" #-} - -isNTname allnts (Just (NT nt _)) = nt `elem` allnts -isNTname allnts _ = False -{-# LINE 27 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/SemHsTokens.hs" #-} --- HsToken ----------------------------------------------------- -{- - visit 0: - inherited attributes: - allfields : [(Identifier,Type,Maybe (Maybe Type))] - allnts : [Identifier] - attrs : [(Identifier,Identifier)] - con : Identifier - fieldnames : [Identifier] - nt : Identifier - synthesized attributes: - errors : Seq Error - output : SELF - tok : (Pos,String) - usedAttrs : [(Identifier,Identifier)] - usedFields : Seq Identifier - usedLocals : [Identifier] - alternatives: - alternative AGField: - child field : {Identifier} - child attr : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - visit 0: - local addTrace : _ - local output : _ - alternative AGLocal: - child var : {Identifier} - child pos : {Pos} - child rdesc : {Maybe String} - visit 0: - local tkAsLocal : _ - local tkAsField : _ - local _tup1 : _ - local errors : _ - local output : _ - local tok : _ - local usedLocals : _ - alternative CharToken: - child value : {String} - child pos : {Pos} - visit 0: - local output : _ - alternative Err: - child mesg : {String} - child pos : {Pos} - visit 0: - local output : _ - alternative HsToken: - child value : {String} - child pos : {Pos} - visit 0: - local output : _ - alternative StrToken: - child value : {String} - child pos : {Pos} - visit 0: - local output : _ --} --- cata -sem_HsToken :: HsToken -> - T_HsToken -sem_HsToken (AGField _field _attr _pos _rdesc ) = - (sem_HsToken_AGField _field _attr _pos _rdesc ) -sem_HsToken (AGLocal _var _pos _rdesc ) = - (sem_HsToken_AGLocal _var _pos _rdesc ) -sem_HsToken (CharToken _value _pos ) = - (sem_HsToken_CharToken _value _pos ) -sem_HsToken (Err _mesg _pos ) = - (sem_HsToken_Err _mesg _pos ) -sem_HsToken (HsToken _value _pos ) = - (sem_HsToken_HsToken _value _pos ) -sem_HsToken (StrToken _value _pos ) = - (sem_HsToken_StrToken _value _pos ) --- semantic domain -newtype T_HsToken = T_HsToken (([(Identifier,Type,Maybe (Maybe Type))]) -> - ([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,Maybe (Maybe Type))]),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_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)]) - _lhsOtok :: ((Pos,String)) - _lhsOusedFields :: (Seq Identifier) - _lhsOusedLocals :: ([Identifier]) - _lhsOoutput :: HsToken - -- "src-ag/SemHsTokens.ag"(line 76, column 15) - _lhsOerrors = - ({-# LINE 76 "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 144 "src-ag/SemHsTokens.hs" #-} - ) - -- "src-ag/SemHsTokens.ag"(line 90, column 13) - _lhsOusedAttrs = - ({-# LINE 90 "src-ag/SemHsTokens.ag" #-} - [(field_,attr_)] - {-# LINE 150 "src-ag/SemHsTokens.hs" #-} - ) - -- "src-ag/SemHsTokens.ag"(line 117, column 8) - _addTrace = - ({-# LINE 117 "src-ag/SemHsTokens.ag" #-} - case rdesc_ of - Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))" - Nothing -> id - {-# LINE 158 "src-ag/SemHsTokens.hs" #-} - ) - -- "src-ag/SemHsTokens.ag"(line 120, column 8) - _lhsOtok = - ({-# LINE 120 "src-ag/SemHsTokens.ag" #-} - (pos_, _addTrace $ attrname True field_ attr_) - {-# LINE 164 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 95, column 40) - _lhsOusedFields = - ({-# LINE 95 "src-ag/SemHsTokens.ag" #-} - Seq.empty - {-# LINE 170 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 86, column 40) - _lhsOusedLocals = - ({-# LINE 86 "src-ag/SemHsTokens.ag" #-} - [] - {-# LINE 176 "src-ag/SemHsTokens.hs" #-} - ) - -- self rule - _output = - ({-# LINE 137 "src-ag/SemHsTokens.ag" #-} - AGField field_ attr_ pos_ rdesc_ - {-# LINE 182 "src-ag/SemHsTokens.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 137 "src-ag/SemHsTokens.ag" #-} - _output - {-# LINE 188 "src-ag/SemHsTokens.hs" #-} - ) - in ( _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 64, column 15) - _tkAsLocal = - ({-# LINE 64 "src-ag/SemHsTokens.ag" #-} - AGLocal var_ pos_ rdesc_ - {-# LINE 212 "src-ag/SemHsTokens.hs" #-} - ) - -- "src-ag/SemHsTokens.ag"(line 65, column 15) - _tkAsField = - ({-# LINE 65 "src-ag/SemHsTokens.ag" #-} - AGField _LOC var_ pos_ rdesc_ - {-# LINE 218 "src-ag/SemHsTokens.hs" #-} - ) - -- "src-ag/SemHsTokens.ag"(line 66, column 19) - __tup1 = - ({-# LINE 66 "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 230 "src-ag/SemHsTokens.hs" #-} - ) - -- "src-ag/SemHsTokens.ag"(line 66, column 19) - (_errors,_,_,_) = - ({-# LINE 66 "src-ag/SemHsTokens.ag" #-} - __tup1 - {-# LINE 236 "src-ag/SemHsTokens.hs" #-} - ) - -- "src-ag/SemHsTokens.ag"(line 66, column 19) - (_,_output,_,_) = - ({-# LINE 66 "src-ag/SemHsTokens.ag" #-} - __tup1 - {-# LINE 242 "src-ag/SemHsTokens.hs" #-} - ) - -- "src-ag/SemHsTokens.ag"(line 66, column 19) - (_,_,_tok,_) = - ({-# LINE 66 "src-ag/SemHsTokens.ag" #-} - __tup1 - {-# LINE 248 "src-ag/SemHsTokens.hs" #-} - ) - -- "src-ag/SemHsTokens.ag"(line 66, column 19) - (_,_,_,_usedLocals) = - ({-# LINE 66 "src-ag/SemHsTokens.ag" #-} - __tup1 - {-# LINE 254 "src-ag/SemHsTokens.hs" #-} - ) - -- "src-ag/SemHsTokens.ag"(line 98, column 13) - _lhsOusedFields = - ({-# LINE 98 "src-ag/SemHsTokens.ag" #-} - if var_ `elem` _lhsIfieldnames - then Seq.singleton var_ - else Seq.empty - {-# LINE 262 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 43, column 37) - _lhsOerrors = - ({-# LINE 43 "src-ag/SemHsTokens.ag" #-} - _errors - {-# LINE 268 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 87, column 40) - _lhsOusedAttrs = - ({-# LINE 87 "src-ag/SemHsTokens.ag" #-} - [] - {-# LINE 274 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 86, column 40) - _lhsOusedLocals = - ({-# LINE 86 "src-ag/SemHsTokens.ag" #-} - _usedLocals - {-# LINE 280 "src-ag/SemHsTokens.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 137 "src-ag/SemHsTokens.ag" #-} - _output - {-# LINE 286 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (from local) - _lhsOtok = - ({-# LINE 115 "src-ag/SemHsTokens.ag" #-} - _tok - {-# LINE 292 "src-ag/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 124, column 16) - _lhsOtok = - ({-# LINE 124 "src-ag/SemHsTokens.ag" #-} - (pos_, if null value_ - then "" - else showCharShort (head value_) - ) - {-# LINE 318 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 43, column 37) - _lhsOerrors = - ({-# LINE 43 "src-ag/SemHsTokens.ag" #-} - Seq.empty - {-# LINE 324 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 87, column 40) - _lhsOusedAttrs = - ({-# LINE 87 "src-ag/SemHsTokens.ag" #-} - [] - {-# LINE 330 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 95, column 40) - _lhsOusedFields = - ({-# LINE 95 "src-ag/SemHsTokens.ag" #-} - Seq.empty - {-# LINE 336 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 86, column 40) - _lhsOusedLocals = - ({-# LINE 86 "src-ag/SemHsTokens.ag" #-} - [] - {-# LINE 342 "src-ag/SemHsTokens.hs" #-} - ) - -- self rule - _output = - ({-# LINE 137 "src-ag/SemHsTokens.ag" #-} - CharToken value_ pos_ - {-# LINE 348 "src-ag/SemHsTokens.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 137 "src-ag/SemHsTokens.ag" #-} - _output - {-# LINE 354 "src-ag/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 378 "src-ag/SemHsTokens.hs" #-} - ) - -- "src-ag/SemHsTokens.ag"(line 130, column 16) - _lhsOtok = - ({-# LINE 130 "src-ag/SemHsTokens.ag" #-} - (pos_, "") - {-# LINE 384 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 87, column 40) - _lhsOusedAttrs = - ({-# LINE 87 "src-ag/SemHsTokens.ag" #-} - [] - {-# LINE 390 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 95, column 40) - _lhsOusedFields = - ({-# LINE 95 "src-ag/SemHsTokens.ag" #-} - Seq.empty - {-# LINE 396 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 86, column 40) - _lhsOusedLocals = - ({-# LINE 86 "src-ag/SemHsTokens.ag" #-} - [] - {-# LINE 402 "src-ag/SemHsTokens.hs" #-} - ) - -- self rule - _output = - ({-# LINE 137 "src-ag/SemHsTokens.ag" #-} - Err mesg_ pos_ - {-# LINE 408 "src-ag/SemHsTokens.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 137 "src-ag/SemHsTokens.ag" #-} - _output - {-# LINE 414 "src-ag/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 122, column 14) - _lhsOtok = - ({-# LINE 122 "src-ag/SemHsTokens.ag" #-} - (pos_, value_) - {-# LINE 437 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 43, column 37) - _lhsOerrors = - ({-# LINE 43 "src-ag/SemHsTokens.ag" #-} - Seq.empty - {-# LINE 443 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 87, column 40) - _lhsOusedAttrs = - ({-# LINE 87 "src-ag/SemHsTokens.ag" #-} - [] - {-# LINE 449 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 95, column 40) - _lhsOusedFields = - ({-# LINE 95 "src-ag/SemHsTokens.ag" #-} - Seq.empty - {-# LINE 455 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 86, column 40) - _lhsOusedLocals = - ({-# LINE 86 "src-ag/SemHsTokens.ag" #-} - [] - {-# LINE 461 "src-ag/SemHsTokens.hs" #-} - ) - -- self rule - _output = - ({-# LINE 137 "src-ag/SemHsTokens.ag" #-} - HsToken value_ pos_ - {-# LINE 467 "src-ag/SemHsTokens.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 137 "src-ag/SemHsTokens.ag" #-} - _output - {-# LINE 473 "src-ag/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 129, column 16) - _lhsOtok = - ({-# LINE 129 "src-ag/SemHsTokens.ag" #-} - (pos_, showStrShort value_) - {-# LINE 496 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 43, column 37) - _lhsOerrors = - ({-# LINE 43 "src-ag/SemHsTokens.ag" #-} - Seq.empty - {-# LINE 502 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 87, column 40) - _lhsOusedAttrs = - ({-# LINE 87 "src-ag/SemHsTokens.ag" #-} - [] - {-# LINE 508 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 95, column 40) - _lhsOusedFields = - ({-# LINE 95 "src-ag/SemHsTokens.ag" #-} - Seq.empty - {-# LINE 514 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 86, column 40) - _lhsOusedLocals = - ({-# LINE 86 "src-ag/SemHsTokens.ag" #-} - [] - {-# LINE 520 "src-ag/SemHsTokens.hs" #-} - ) - -- self rule - _output = - ({-# LINE 137 "src-ag/SemHsTokens.ag" #-} - StrToken value_ pos_ - {-# LINE 526 "src-ag/SemHsTokens.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 137 "src-ag/SemHsTokens.ag" #-} - _output - {-# LINE 532 "src-ag/SemHsTokens.hs" #-} - ) - in ( _lhsOerrors,_lhsOoutput,_lhsOtok,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) --- HsTokens ---------------------------------------------------- -{- - visit 0: - inherited attributes: - allfields : [(Identifier,Type,Maybe (Maybe Type))] - allnts : [Identifier] - attrs : [(Identifier,Identifier)] - con : Identifier - fieldnames : [Identifier] - nt : Identifier - synthesized attributes: - errors : Seq Error - output : SELF - 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,Maybe (Maybe Type))]) -> - ([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,Maybe (Maybe Type))]),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,Maybe (Maybe Type))]) - _hdOallnts :: ([Identifier]) - _hdOattrs :: ([(Identifier,Identifier)]) - _hdOcon :: Identifier - _hdOfieldnames :: ([Identifier]) - _hdOnt :: Identifier - _tlOallfields :: ([(Identifier,Type,Maybe (Maybe Type))]) - _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 112, column 10) - _lhsOtks = - ({-# LINE 112 "src-ag/SemHsTokens.ag" #-} - _hdItok : _tlItks - {-# LINE 627 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 43, column 37) - _lhsOerrors = - ({-# LINE 43 "src-ag/SemHsTokens.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 633 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 87, column 40) - _lhsOusedAttrs = - ({-# LINE 87 "src-ag/SemHsTokens.ag" #-} - _hdIusedAttrs ++ _tlIusedAttrs - {-# LINE 639 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 95, column 40) - _lhsOusedFields = - ({-# LINE 95 "src-ag/SemHsTokens.ag" #-} - _hdIusedFields Seq.>< _tlIusedFields - {-# LINE 645 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 86, column 40) - _lhsOusedLocals = - ({-# LINE 86 "src-ag/SemHsTokens.ag" #-} - _hdIusedLocals ++ _tlIusedLocals - {-# LINE 651 "src-ag/SemHsTokens.hs" #-} - ) - -- self rule - _output = - ({-# LINE 137 "src-ag/SemHsTokens.ag" #-} - (:) _hdIoutput _tlIoutput - {-# LINE 657 "src-ag/SemHsTokens.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 137 "src-ag/SemHsTokens.ag" #-} - _output - {-# LINE 663 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _hdOallfields = - ({-# LINE 30 "src-ag/SemHsTokens.ag" #-} - _lhsIallfields - {-# LINE 669 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _hdOallnts = - ({-# LINE 31 "src-ag/SemHsTokens.ag" #-} - _lhsIallnts - {-# LINE 675 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _hdOattrs = - ({-# LINE 32 "src-ag/SemHsTokens.ag" #-} - _lhsIattrs - {-# LINE 681 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _hdOcon = - ({-# LINE 29 "src-ag/SemHsTokens.ag" #-} - _lhsIcon - {-# LINE 687 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _hdOfieldnames = - ({-# LINE 36 "src-ag/SemHsTokens.ag" #-} - _lhsIfieldnames - {-# LINE 693 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _hdOnt = - ({-# LINE 29 "src-ag/SemHsTokens.ag" #-} - _lhsInt - {-# LINE 699 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _tlOallfields = - ({-# LINE 30 "src-ag/SemHsTokens.ag" #-} - _lhsIallfields - {-# LINE 705 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _tlOallnts = - ({-# LINE 31 "src-ag/SemHsTokens.ag" #-} - _lhsIallnts - {-# LINE 711 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _tlOattrs = - ({-# LINE 32 "src-ag/SemHsTokens.ag" #-} - _lhsIattrs - {-# LINE 717 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _tlOcon = - ({-# LINE 29 "src-ag/SemHsTokens.ag" #-} - _lhsIcon - {-# LINE 723 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _tlOfieldnames = - ({-# LINE 36 "src-ag/SemHsTokens.ag" #-} - _lhsIfieldnames - {-# LINE 729 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _tlOnt = - ({-# LINE 29 "src-ag/SemHsTokens.ag" #-} - _lhsInt - {-# LINE 735 "src-ag/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 113, column 10) - _lhsOtks = - ({-# LINE 113 "src-ag/SemHsTokens.ag" #-} - [] - {-# LINE 760 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 43, column 37) - _lhsOerrors = - ({-# LINE 43 "src-ag/SemHsTokens.ag" #-} - Seq.empty - {-# LINE 766 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 87, column 40) - _lhsOusedAttrs = - ({-# LINE 87 "src-ag/SemHsTokens.ag" #-} - [] - {-# LINE 772 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 95, column 40) - _lhsOusedFields = - ({-# LINE 95 "src-ag/SemHsTokens.ag" #-} - Seq.empty - {-# LINE 778 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 86, column 40) - _lhsOusedLocals = - ({-# LINE 86 "src-ag/SemHsTokens.ag" #-} - [] - {-# LINE 784 "src-ag/SemHsTokens.hs" #-} - ) - -- self rule - _output = - ({-# LINE 137 "src-ag/SemHsTokens.ag" #-} - [] - {-# LINE 790 "src-ag/SemHsTokens.hs" #-} - ) - -- self rule - _lhsOoutput = - ({-# LINE 137 "src-ag/SemHsTokens.ag" #-} - _output - {-# LINE 796 "src-ag/SemHsTokens.hs" #-} - ) - in ( _lhsOerrors,_lhsOoutput,_lhsOtks,_lhsOusedAttrs,_lhsOusedFields,_lhsOusedLocals))) ) --- HsTokensRoot ------------------------------------------------ -{- - visit 0: - inherited attributes: - allfields : [(Identifier,Type,Maybe (Maybe Type))] - 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,Maybe (Maybe Type))]) -> - ([Identifier]) -> - ([(Identifier,Identifier)]) -> - Identifier -> - Identifier -> - ( (Seq Error),([HsToken]),([String]),([(Identifier,Identifier)]),([Identifier]),([Identifier]))) -data Inh_HsTokensRoot = Inh_HsTokensRoot {allfields_Inh_HsTokensRoot :: ([(Identifier,Type,Maybe (Maybe Type))]),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,Maybe (Maybe Type))]) - _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 869 "src-ag/SemHsTokens.hs" #-} - ) - -- "src-ag/SemHsTokens.ag"(line 102, column 18) - _lhsOusedFields = - ({-# LINE 102 "src-ag/SemHsTokens.ag" #-} - toList _tokensIusedFields - {-# LINE 875 "src-ag/SemHsTokens.hs" #-} - ) - -- "src-ag/SemHsTokens.ag"(line 109, column 18) - _lhsOtextLines = - ({-# LINE 109 "src-ag/SemHsTokens.ag" #-} - showTokens _tokensItks - {-# LINE 881 "src-ag/SemHsTokens.hs" #-} - ) - -- use rule "src-ag/SemHsTokens.ag"(line 18, column 18) - _lhsOerrors = - ({-# LINE 18 "src-ag/SemHsTokens.ag" #-} - _tokensIerrors - {-# LINE 887 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (up) - _lhsOoutput = - ({-# LINE 136 "src-ag/SemHsTokens.ag" #-} - _tokensIoutput - {-# LINE 893 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (up) - _lhsOusedAttrs = - ({-# LINE 20 "src-ag/SemHsTokens.ag" #-} - _tokensIusedAttrs - {-# LINE 899 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (up) - _lhsOusedLocals = - ({-# LINE 19 "src-ag/SemHsTokens.ag" #-} - _tokensIusedLocals - {-# LINE 905 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _tokensOallfields = - ({-# LINE 30 "src-ag/SemHsTokens.ag" #-} - _lhsIallfields - {-# LINE 911 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _tokensOallnts = - ({-# LINE 31 "src-ag/SemHsTokens.ag" #-} - _lhsIallnts - {-# LINE 917 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _tokensOattrs = - ({-# LINE 32 "src-ag/SemHsTokens.ag" #-} - _lhsIattrs - {-# LINE 923 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _tokensOcon = - ({-# LINE 29 "src-ag/SemHsTokens.ag" #-} - _lhsIcon - {-# LINE 929 "src-ag/SemHsTokens.hs" #-} - ) - -- copy rule (down) - _tokensOnt = - ({-# LINE 29 "src-ag/SemHsTokens.ag" #-} - _lhsInt - {-# LINE 935 "src-ag/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/uuagc/uuagc-tmp/TfmToVisage.hs b/dist/build/uuagc/uuagc-tmp/TfmToVisage.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/TfmToVisage.hs +++ /dev/null @@ -1,1172 +0,0 @@ - - --- UUAGC 0.9.39.0.0 (src-ag/TfmToVisage.ag) -module TfmToVisage where -{-# LINE 8 "src-ag/TfmToVisage.ag" #-} - -import AbstractSyntax -import VisagePatterns -import VisageSyntax -{-# LINE 11 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 CommonTypes -{-# LINE 21 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/TfmToVisage.hs" #-} - -{-# LINE 2 "src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 28 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/TfmToVisage.hs" #-} - -{-# LINE 2 "src-ag/Expression.ag" #-} - -import UU.Scanner.Position(Pos) -import HsToken -{-# LINE 34 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/TfmToVisage.hs" #-} -{-# LINE 14 "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 90 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/TfmToVisage.hs" #-} --- Child ------------------------------------------------------- -{- - visit 0: - inherited attribute: - rulemap : VisageRuleMap - synthesized attribute: - vchild : VisageChild - alternatives: - alternative Child: - child name : {Identifier} - child tp : {Type} - child inh : {Attributes} - child syn : {Attributes} - child virtual : {Maybe (Maybe Type)} --} --- cata -sem_Child :: Child -> - T_Child -sem_Child (Child _name _tp _inh _syn _virtual ) = - (sem_Child_Child _name _tp _inh _syn _virtual ) --- semantic domain -newtype T_Child = T_Child (VisageRuleMap -> - ( VisageChild)) -data Inh_Child = Inh_Child {rulemap_Inh_Child :: VisageRuleMap} -data Syn_Child = Syn_Child {vchild_Syn_Child :: VisageChild} -wrap_Child :: T_Child -> - Inh_Child -> - Syn_Child -wrap_Child (T_Child sem ) (Inh_Child _lhsIrulemap ) = - (let ( _lhsOvchild) = sem _lhsIrulemap - in (Syn_Child _lhsOvchild )) -sem_Child_Child :: Identifier -> - Type -> - Attributes -> - Attributes -> - (Maybe (Maybe Type)) -> - T_Child -sem_Child_Child name_ tp_ inh_ syn_ virtual_ = - (T_Child (\ _lhsIrulemap -> - (let _lhsOvchild :: VisageChild - -- "src-ag/TfmToVisage.ag"(line 118, column 11) - _lhsOvchild = - ({-# LINE 118 "src-ag/TfmToVisage.ag" #-} - VChild name_ tp_ inh_ syn_ (getForField (getName name_) _lhsIrulemap) - {-# LINE 135 "src-ag/TfmToVisage.hs" #-} - ) - in ( _lhsOvchild))) ) --- Children ---------------------------------------------------- -{- - visit 0: - inherited attribute: - rulemap : VisageRuleMap - 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 (VisageRuleMap -> - ( ([VisageChild]))) -data Inh_Children = Inh_Children {rulemap_Inh_Children :: VisageRuleMap} -data Syn_Children = Syn_Children {vchildren_Syn_Children :: ([VisageChild])} -wrap_Children :: T_Children -> - Inh_Children -> - Syn_Children -wrap_Children (T_Children sem ) (Inh_Children _lhsIrulemap ) = - (let ( _lhsOvchildren) = sem _lhsIrulemap - in (Syn_Children _lhsOvchildren )) -sem_Children_Cons :: T_Child -> - T_Children -> - T_Children -sem_Children_Cons (T_Child hd_ ) (T_Children tl_ ) = - (T_Children (\ _lhsIrulemap -> - (let _lhsOvchildren :: ([VisageChild]) - _hdOrulemap :: VisageRuleMap - _tlOrulemap :: VisageRuleMap - _hdIvchild :: VisageChild - _tlIvchildren :: ([VisageChild]) - -- "src-ag/TfmToVisage.ag"(line 114, column 17) - _lhsOvchildren = - ({-# LINE 114 "src-ag/TfmToVisage.ag" #-} - _hdIvchild : _tlIvchildren - {-# LINE 181 "src-ag/TfmToVisage.hs" #-} - ) - -- copy rule (down) - _hdOrulemap = - ({-# LINE 80 "src-ag/TfmToVisage.ag" #-} - _lhsIrulemap - {-# LINE 187 "src-ag/TfmToVisage.hs" #-} - ) - -- copy rule (down) - _tlOrulemap = - ({-# LINE 81 "src-ag/TfmToVisage.ag" #-} - _lhsIrulemap - {-# LINE 193 "src-ag/TfmToVisage.hs" #-} - ) - ( _hdIvchild) = - hd_ _hdOrulemap - ( _tlIvchildren) = - tl_ _tlOrulemap - in ( _lhsOvchildren))) ) -sem_Children_Nil :: T_Children -sem_Children_Nil = - (T_Children (\ _lhsIrulemap -> - (let _lhsOvchildren :: ([VisageChild]) - -- "src-ag/TfmToVisage.ag"(line 115, column 17) - _lhsOvchildren = - ({-# LINE 115 "src-ag/TfmToVisage.ag" #-} - [] - {-# LINE 208 "src-ag/TfmToVisage.hs" #-} - ) - in ( _lhsOvchildren))) ) --- Expression -------------------------------------------------- -{- - visit 0: - synthesized attribute: - self : SELF - 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 71 "src-ag/TfmToVisage.ag" #-} - Expression pos_ tks_ - {-# LINE 247 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _lhsOself = - ({-# LINE 71 "src-ag/TfmToVisage.ag" #-} - _self - {-# LINE 253 "src-ag/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 - _nontsIvnonts :: ([VisageNonterminal]) - -- "src-ag/TfmToVisage.ag"(line 87, column 7) - _lhsOvisage = - ({-# LINE 87 "src-ag/TfmToVisage.ag" #-} - VGrammar _nontsIvnonts - {-# LINE 315 "src-ag/TfmToVisage.hs" #-} - ) - ( _nontsIvnonts) = - nonts_ - in ( _lhsOvisage)) ) --- Nonterminal ------------------------------------------------- -{- - visit 0: - synthesized attribute: - 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 (( VisageNonterminal)) -data Inh_Nonterminal = Inh_Nonterminal {} -data Syn_Nonterminal = Syn_Nonterminal {vnont_Syn_Nonterminal :: VisageNonterminal} -wrap_Nonterminal :: T_Nonterminal -> - Inh_Nonterminal -> - Syn_Nonterminal -wrap_Nonterminal (T_Nonterminal sem ) (Inh_Nonterminal ) = - (let ( _lhsOvnont) = sem - in (Syn_Nonterminal _lhsOvnont )) -sem_Nonterminal_Nonterminal :: NontermIdent -> - ([Identifier]) -> - Attributes -> - Attributes -> - T_Productions -> - T_Nonterminal -sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_ ) = - (T_Nonterminal (let _lhsOvnont :: VisageNonterminal - _prodsIvprods :: ([VisageProduction]) - -- "src-ag/TfmToVisage.ag"(line 97, column 7) - _lhsOvnont = - ({-# LINE 97 "src-ag/TfmToVisage.ag" #-} - VNonterminal nt_ inh_ syn_ _prodsIvprods - {-# LINE 361 "src-ag/TfmToVisage.hs" #-} - ) - ( _prodsIvprods) = - prods_ - in ( _lhsOvnont)) ) --- Nonterminals ------------------------------------------------ -{- - visit 0: - synthesized attribute: - 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 (( ([VisageNonterminal]))) -data Inh_Nonterminals = Inh_Nonterminals {} -data Syn_Nonterminals = Syn_Nonterminals {vnonts_Syn_Nonterminals :: ([VisageNonterminal])} -wrap_Nonterminals :: T_Nonterminals -> - Inh_Nonterminals -> - Syn_Nonterminals -wrap_Nonterminals (T_Nonterminals sem ) (Inh_Nonterminals ) = - (let ( _lhsOvnonts) = sem - in (Syn_Nonterminals _lhsOvnonts )) -sem_Nonterminals_Cons :: T_Nonterminal -> - T_Nonterminals -> - T_Nonterminals -sem_Nonterminals_Cons (T_Nonterminal hd_ ) (T_Nonterminals tl_ ) = - (T_Nonterminals (let _lhsOvnonts :: ([VisageNonterminal]) - _hdIvnont :: VisageNonterminal - _tlIvnonts :: ([VisageNonterminal]) - -- "src-ag/TfmToVisage.ag"(line 91, column 7) - _lhsOvnonts = - ({-# LINE 91 "src-ag/TfmToVisage.ag" #-} - _hdIvnont : _tlIvnonts - {-# LINE 403 "src-ag/TfmToVisage.hs" #-} - ) - ( _hdIvnont) = - hd_ - ( _tlIvnonts) = - tl_ - in ( _lhsOvnonts)) ) -sem_Nonterminals_Nil :: T_Nonterminals -sem_Nonterminals_Nil = - (T_Nonterminals (let _lhsOvnonts :: ([VisageNonterminal]) - -- "src-ag/TfmToVisage.ag"(line 93, column 7) - _lhsOvnonts = - ({-# LINE 93 "src-ag/TfmToVisage.ag" #-} - [] - {-# LINE 417 "src-ag/TfmToVisage.hs" #-} - ) - in ( _lhsOvnonts)) ) --- Pattern ----------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - fieldattrs : [(Identifier,Identifier)] - self : SELF - vpat : VisagePattern - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - local self : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - local self : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - local self : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - 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 (Alias _field _attr _pat _parts ) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) -sem_Pattern (Constr _name _pats ) = - (sem_Pattern_Constr _name (sem_Patterns _pats ) ) -sem_Pattern (Irrefutable _pat ) = - (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) -sem_Pattern (Product _pos _pats ) = - (sem_Pattern_Product _pos (sem_Patterns _pats ) ) -sem_Pattern (Underscore _pos ) = - (sem_Pattern_Underscore _pos ) --- semantic domain -newtype T_Pattern = T_Pattern (( Pattern ,( [(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_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = - (T_Pattern (let _lhsOvpat :: VisagePattern - _lhsOfieldattrs :: ( [(Identifier,Identifier)] ) - _lhsOcopy :: Pattern - _lhsOself :: Pattern - _patIcopy :: Pattern - _patIfieldattrs :: ( [(Identifier,Identifier)] ) - _patIself :: Pattern - _patIvpat :: VisagePattern - _partsIcopy :: Patterns - _partsIfieldattrs :: ( [(Identifier,Identifier)] ) - _partsIself :: Patterns - _partsIvpats :: ([VisagePattern]) - -- "src-ag/TfmToVisage.ag"(line 135, column 17) - _lhsOvpat = - ({-# LINE 135 "src-ag/TfmToVisage.ag" #-} - if (isVar _self) - then VVar field_ attr_ - else VAlias field_ attr_ _patIvpat - {-# LINE 507 "src-ag/TfmToVisage.hs" #-} - ) - -- "src-ag/TfmToVisage.ag"(line 144, column 17) - _lhsOfieldattrs = - ({-# LINE 144 "src-ag/TfmToVisage.ag" #-} - [(field_, attr_)] - {-# LINE 513 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 519 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _self = - ({-# LINE 71 "src-ag/TfmToVisage.ag" #-} - Alias field_ attr_ _patIself _partsIself - {-# LINE 525 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 531 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _lhsOself = - ({-# LINE 71 "src-ag/TfmToVisage.ag" #-} - _self - {-# LINE 537 "src-ag/TfmToVisage.hs" #-} - ) - ( _patIcopy,_patIfieldattrs,_patIself,_patIvpat) = - pat_ - ( _partsIcopy,_partsIfieldattrs,_partsIself,_partsIvpats) = - parts_ - in ( _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 133, column 17) - _lhsOvpat = - ({-# LINE 133 "src-ag/TfmToVisage.ag" #-} - VConstr name_ _patsIvpats - {-# LINE 560 "src-ag/TfmToVisage.hs" #-} - ) - -- use rule "src-ag/TfmToVisage.ag"(line 141, column 43) - _lhsOfieldattrs = - ({-# LINE 141 "src-ag/TfmToVisage.ag" #-} - _patsIfieldattrs - {-# LINE 566 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 572 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _self = - ({-# LINE 71 "src-ag/TfmToVisage.ag" #-} - Constr name_ _patsIself - {-# LINE 578 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 584 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _lhsOself = - ({-# LINE 71 "src-ag/TfmToVisage.ag" #-} - _self - {-# LINE 590 "src-ag/TfmToVisage.hs" #-} - ) - ( _patsIcopy,_patsIfieldattrs,_patsIself,_patsIvpats) = - pats_ - 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 141, column 43) - _lhsOfieldattrs = - ({-# LINE 141 "src-ag/TfmToVisage.ag" #-} - _patIfieldattrs - {-# LINE 610 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 616 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _self = - ({-# LINE 71 "src-ag/TfmToVisage.ag" #-} - Irrefutable _patIself - {-# LINE 622 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 628 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _lhsOself = - ({-# LINE 71 "src-ag/TfmToVisage.ag" #-} - _self - {-# LINE 634 "src-ag/TfmToVisage.hs" #-} - ) - -- copy rule (up) - _lhsOvpat = - ({-# LINE 82 "src-ag/TfmToVisage.ag" #-} - _patIvpat - {-# LINE 640 "src-ag/TfmToVisage.hs" #-} - ) - ( _patIcopy,_patIfieldattrs,_patIself,_patIvpat) = - pat_ - 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 134, column 17) - _lhsOvpat = - ({-# LINE 134 "src-ag/TfmToVisage.ag" #-} - VProduct pos_ _patsIvpats - {-# LINE 661 "src-ag/TfmToVisage.hs" #-} - ) - -- use rule "src-ag/TfmToVisage.ag"(line 141, column 43) - _lhsOfieldattrs = - ({-# LINE 141 "src-ag/TfmToVisage.ag" #-} - _patsIfieldattrs - {-# LINE 667 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 673 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _self = - ({-# LINE 71 "src-ag/TfmToVisage.ag" #-} - Product pos_ _patsIself - {-# LINE 679 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 685 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _lhsOself = - ({-# LINE 71 "src-ag/TfmToVisage.ag" #-} - _self - {-# LINE 691 "src-ag/TfmToVisage.hs" #-} - ) - ( _patsIcopy,_patsIfieldattrs,_patsIself,_patsIvpats) = - pats_ - 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 138, column 17) - _lhsOvpat = - ({-# LINE 138 "src-ag/TfmToVisage.ag" #-} - VUnderscore pos_ - {-# LINE 707 "src-ag/TfmToVisage.hs" #-} - ) - -- use rule "src-ag/TfmToVisage.ag"(line 141, column 43) - _lhsOfieldattrs = - ({-# LINE 141 "src-ag/TfmToVisage.ag" #-} - [] - {-# LINE 713 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Underscore pos_ - {-# LINE 719 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _self = - ({-# LINE 71 "src-ag/TfmToVisage.ag" #-} - Underscore pos_ - {-# LINE 725 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 731 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _lhsOself = - ({-# LINE 71 "src-ag/TfmToVisage.ag" #-} - _self - {-# LINE 737 "src-ag/TfmToVisage.hs" #-} - ) - in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpat)) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - fieldattrs : [(Identifier,Identifier)] - self : SELF - 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 129, column 17) - _lhsOvpats = - ({-# LINE 129 "src-ag/TfmToVisage.ag" #-} - _hdIvpat : _tlIvpats - {-# LINE 795 "src-ag/TfmToVisage.hs" #-} - ) - -- use rule "src-ag/TfmToVisage.ag"(line 141, column 43) - _lhsOfieldattrs = - ({-# LINE 141 "src-ag/TfmToVisage.ag" #-} - _hdIfieldattrs ++ _tlIfieldattrs - {-# LINE 801 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 807 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _self = - ({-# LINE 71 "src-ag/TfmToVisage.ag" #-} - (:) _hdIself _tlIself - {-# LINE 813 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 819 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _lhsOself = - ({-# LINE 71 "src-ag/TfmToVisage.ag" #-} - _self - {-# LINE 825 "src-ag/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 130, column 17) - _lhsOvpats = - ({-# LINE 130 "src-ag/TfmToVisage.ag" #-} - [] - {-# LINE 842 "src-ag/TfmToVisage.hs" #-} - ) - -- use rule "src-ag/TfmToVisage.ag"(line 141, column 43) - _lhsOfieldattrs = - ({-# LINE 141 "src-ag/TfmToVisage.ag" #-} - [] - {-# LINE 848 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - [] - {-# LINE 854 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _self = - ({-# LINE 71 "src-ag/TfmToVisage.ag" #-} - [] - {-# LINE 860 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 866 "src-ag/TfmToVisage.hs" #-} - ) - -- self rule - _lhsOself = - ({-# LINE 71 "src-ag/TfmToVisage.ag" #-} - _self - {-# LINE 872 "src-ag/TfmToVisage.hs" #-} - ) - in ( _lhsOcopy,_lhsOfieldattrs,_lhsOself,_lhsOvpats)) ) --- Production -------------------------------------------------- -{- - visit 0: - synthesized attribute: - vprod : VisageProduction - alternatives: - alternative Production: - child con : {ConstructorIdent} - child children : Children - child rules : Rules - child typeSigs : TypeSigs - visit 0: - local splitVRules : _ - local locrules : _ - local lhsrules : _ --} --- cata -sem_Production :: Production -> - T_Production -sem_Production (Production _con _children _rules _typeSigs ) = - (sem_Production_Production _con (sem_Children _children ) (sem_Rules _rules ) (sem_TypeSigs _typeSigs ) ) --- semantic domain -newtype T_Production = T_Production (( VisageProduction)) -data Inh_Production = Inh_Production {} -data Syn_Production = Syn_Production {vprod_Syn_Production :: VisageProduction} -wrap_Production :: T_Production -> - Inh_Production -> - Syn_Production -wrap_Production (T_Production sem ) (Inh_Production ) = - (let ( _lhsOvprod) = sem - in (Syn_Production _lhsOvprod )) -sem_Production_Production :: ConstructorIdent -> - T_Children -> - T_Rules -> - T_TypeSigs -> - T_Production -sem_Production_Production con_ (T_Children children_ ) (T_Rules rules_ ) (T_TypeSigs typeSigs_ ) = - (T_Production (let _lhsOvprod :: VisageProduction - _childrenOrulemap :: VisageRuleMap - _childrenIvchildren :: ([VisageChild]) - _rulesIvrules :: ([VisageRule]) - -- "src-ag/TfmToVisage.ag"(line 107, column 7) - _lhsOvprod = - ({-# LINE 107 "src-ag/TfmToVisage.ag" #-} - VProduction con_ _childrenIvchildren _lhsrules _locrules - {-# LINE 920 "src-ag/TfmToVisage.hs" #-} - ) - -- "src-ag/TfmToVisage.ag"(line 108, column 7) - _splitVRules = - ({-# LINE 108 "src-ag/TfmToVisage.ag" #-} - splitVRules _rulesIvrules - {-# LINE 926 "src-ag/TfmToVisage.hs" #-} - ) - -- "src-ag/TfmToVisage.ag"(line 109, column 7) - _locrules = - ({-# LINE 109 "src-ag/TfmToVisage.ag" #-} - getForField "loc" _splitVRules - {-# LINE 932 "src-ag/TfmToVisage.hs" #-} - ) - -- "src-ag/TfmToVisage.ag"(line 110, column 7) - _lhsrules = - ({-# LINE 110 "src-ag/TfmToVisage.ag" #-} - getForField "lhs" _splitVRules - {-# LINE 938 "src-ag/TfmToVisage.hs" #-} - ) - -- "src-ag/TfmToVisage.ag"(line 111, column 7) - _childrenOrulemap = - ({-# LINE 111 "src-ag/TfmToVisage.ag" #-} - _splitVRules - {-# LINE 944 "src-ag/TfmToVisage.hs" #-} - ) - ( _childrenIvchildren) = - children_ _childrenOrulemap - ( _rulesIvrules) = - rules_ - in ( _lhsOvprod)) ) --- Productions ------------------------------------------------- -{- - visit 0: - 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 (( ([VisageProduction]))) -data Inh_Productions = Inh_Productions {} -data Syn_Productions = Syn_Productions {vprods_Syn_Productions :: ([VisageProduction])} -wrap_Productions :: T_Productions -> - Inh_Productions -> - Syn_Productions -wrap_Productions (T_Productions sem ) (Inh_Productions ) = - (let ( _lhsOvprods) = sem - in (Syn_Productions _lhsOvprods )) -sem_Productions_Cons :: T_Production -> - T_Productions -> - T_Productions -sem_Productions_Cons (T_Production hd_ ) (T_Productions tl_ ) = - (T_Productions (let _lhsOvprods :: ([VisageProduction]) - _hdIvprod :: VisageProduction - _tlIvprods :: ([VisageProduction]) - -- "src-ag/TfmToVisage.ag"(line 101, column 7) - _lhsOvprods = - ({-# LINE 101 "src-ag/TfmToVisage.ag" #-} - _hdIvprod : _tlIvprods - {-# LINE 988 "src-ag/TfmToVisage.hs" #-} - ) - ( _hdIvprod) = - hd_ - ( _tlIvprods) = - tl_ - in ( _lhsOvprods)) ) -sem_Productions_Nil :: T_Productions -sem_Productions_Nil = - (T_Productions (let _lhsOvprods :: ([VisageProduction]) - -- "src-ag/TfmToVisage.ag"(line 103, column 7) - _lhsOvprods = - ({-# LINE 103 "src-ag/TfmToVisage.ag" #-} - [] - {-# LINE 1002 "src-ag/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} --} --- cata -sem_Rule :: Rule -> - T_Rule -sem_Rule (Rule _mbName _pattern _rhs _owrt _origin _explicit ) = - (sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) --- 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 -> - T_Rule -sem_Rule_Rule mbName_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ = - (T_Rule (let _lhsOvrule :: VisageRule - _patternIcopy :: Pattern - _patternIfieldattrs :: ( [(Identifier,Identifier)] ) - _patternIself :: Pattern - _patternIvpat :: VisagePattern - _rhsIself :: Expression - -- "src-ag/TfmToVisage.ag"(line 126, column 11) - _lhsOvrule = - ({-# LINE 126 "src-ag/TfmToVisage.ag" #-} - VRule _patternIfieldattrs undefined _patternIvpat _rhsIself owrt_ - {-# LINE 1052 "src-ag/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 121, column 17) - _lhsOvrules = - ({-# LINE 121 "src-ag/TfmToVisage.ag" #-} - _hdIvrule : _tlIvrules - {-# LINE 1096 "src-ag/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 122, column 17) - _lhsOvrules = - ({-# LINE 122 "src-ag/TfmToVisage.ag" #-} - [] - {-# LINE 1110 "src-ag/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/uuagc/uuagc-tmp/Transform.hs b/dist/build/uuagc/uuagc-tmp/Transform.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/Transform.hs +++ /dev/null @@ -1,7450 +0,0 @@ - - --- UUAGC 0.9.39.0.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) -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 -{-# LINE 29 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 2 "src-ag/ConcreteSyntax.ag" #-} - -import UU.Scanner.Position (Pos) -import Patterns (Pattern) -import Expression (Expression) -import CommonTypes -{-# LINE 37 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 2 "src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 44 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} -{-# LINE 102 "src-ag/Transform.ag" #-} -type DefinedSets = Map Identifier (Set NontermIdent) -{-# LINE 47 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 122 "src-ag/Transform.ag" #-} -type FieldMap = [(Identifier, Type)] -{-# LINE 51 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 123 "src-ag/Transform.ag" #-} -type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap) -{-# LINE 55 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 143 "src-ag/Transform.ag" #-} -type AttrName = (Identifier,Identifier) -{-# LINE 59 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 144 "src-ag/Transform.ag" #-} -type RuleInfo = (Maybe Identifier, [AttrName]->Pattern, Expression, [AttrName], Bool, String) -{-# LINE 63 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 145 "src-ag/Transform.ag" #-} -type SigInfo = (Identifier,Type) -{-# LINE 67 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 146 "src-ag/Transform.ag" #-} -type UniqueInfo = (Identifier,Identifier) -{-# LINE 71 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 147 "src-ag/Transform.ag" #-} -type AugmentInfo = (Identifier,Expression) -{-# LINE 75 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 148 "src-ag/Transform.ag" #-} -type AroundInfo = (Identifier,Expression) -{-# LINE 79 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 149 "src-ag/Transform.ag" #-} -type MergeInfo = (Identifier, Identifier, [Identifier], Expression) -{-# LINE 83 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 203 "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 114 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 339 "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) -> Map NontermIdent (Map ConstructorIdent FieldMap) -> - 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 undefined) : (_LOC,NT undefined undefined) : (_INST, NT undefined undefined) : (_FIRST, NT undefined undefined) : (_LAST, NT undefined undefined) - : Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fields) - ++ mapMaybe (\instNm -> lookup instNm sigs >>= \tp -> return (instNm, tp)) (Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allinsts)) - -- 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) ((r1,e1),m1) - = let (e2,m2,u2,b2) = foldr (checkDefi owrt) (e1,m1,[],[]) as - in ( (Rule mbNm (pat u2) exp owrt str True : 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]) -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> 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 _) -> - 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) - 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 :: Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> 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]) -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> 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 269 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 494 "src-ag/Transform.ag" #-} - -mkUniqueRules :: Options -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> Map NontermIdent (Attributes,Attributes) -> NontermIdent -> ConstructorIdent -> Map Identifier Identifier -> [Rule] -mkUniqueRules opts 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 - - 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 pat = Product noPos (attr outFld ref : [attr _LOC u | u <- locAttrs ]) - rhs = Expression noPos $ wrap ref $ foldr gencase (finalout locAttrs) locAttrs - -- [HsToken ("mkUniques" ++ show (length locAttrs) ++ " ") noPos, AGField _LHS ref noPos Nothing] - in Rule Nothing pat rhs False "-- generated by the unique rule mechanism." False - attr fld a = Alias fld a (Underscore noPos) [] - gencase nm outp - = h ("case " ++ uniqueDispenser opts ++ " __cont of { (__cont, " ++ getName nm ++ ") -> ") ++ outp ++ h "}" - h s = [HsToken s noPos] - finalout us = h ("(__cont, " ++ concat (intersperse "," (map getName us)) ++ ")") - wrap ref inp = h "let __cont = " ++ [AGField _LHS ref noPos Nothing] ++ h " in seq __cont ( " ++ inp ++ h " )" -{-# LINE 298 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 692 "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 323 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 812 "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 332 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 844 "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 341 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 870 "src-ag/Transform.ag" #-} - -mergeParams :: ParamMap -> ParamMap -> ParamMap -mergeParams = Map.unionWith (++) -{-# LINE 347 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 893 "src-ag/Transform.ag" #-} - -mergeCtx :: ContextMap -> ContextMap -> ContextMap -mergeCtx - = Map.unionWith nubconcat - where nubconcat a b = nub (a ++ b) -{-# LINE 355 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 912 "src-ag/Transform.ag" #-} - -mergeQuant :: QuantMap -> QuantMap -> QuantMap -mergeQuant = Map.unionWith (++) -{-# LINE 361 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 923 "src-ag/Transform.ag" #-} - -mergeDerivings m1 m2 = foldr (\(n,cs) m -> Map.insertWith Set.union n cs m) m2 (Map.toList m1) -{-# LINE 366 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 934 "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 372 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 976 "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 382 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 987 "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) (NT _SELF []) eSyn)atMap -{-# LINE 388 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 1128 "src-ag/Transform.ag" #-} - -makeType :: Set NontermIdent -> Type -> Type -makeType nts tp@(NT x _) | x == _SELF = tp - | Set.member x nts = tp - | otherwise = Haskell (typeToHaskellString Nothing [] tp) -makeType _ tp = tp -{-# LINE 397 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 1135 "src-ag/Transform.ag" #-} - -constructGrammar :: Set NontermIdent - -> ParamMap - -> DataTypes - -> Map NontermIdent (Attributes, Attributes) - -> Map NontermIdent (Map Identifier (String, String, String)) - -> Derivings - -> Set NontermIdent - -> Map NontermIdent (Map ConstructorIdent [Rule]) - -> Map NontermIdent (Map ConstructorIdent [TypeSig]) - -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) - -> TypeSyns - -> PragmaMap - -> AttrOrderMap - -> ContextMap - -> 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))) - -> Grammar - -constructGrammar nts ntParams gram attrs uses derivings wrappers allrules tsigs allinsts tsyns pragmaMap orderMap contextMap quantMap uniqueMap augmentsMap aroundsMap mergeMap = - let gr = [ (nt,Map.toList alts) | (nt,alts) <- Map.toList gram] - nonts = map nont gr - nont (nt,alts) = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt attrs - rmap = Map.findWithDefault Map.empty nt allrules - tsmap = Map.findWithDefault Map.empty nt tsigs - instsmap = Map.findWithDefault Map.empty nt allinsts - params = Map.findWithDefault [] nt ntParams - mergemap = Map.findWithDefault Map.empty nt mergeMap - alt (con,flds) = - let rules = maybe [] id (Map.lookup con rmap) - tsigs = maybe [] id (Map.lookup con tsmap) - insts = maybe [] id (Map.lookup con instsmap) - merges = [ (n, NT t []) | (n, (t, _, _)) <- Map.assocs $ maybe Map.empty id (Map.lookup con mergemap) ] - - -- 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 - (inh,syn) = case tpI of - NT nt _ -> let nt' = maybe nt id (deforestedNt nt) - in Map.findWithDefault (Map.empty,Map.empty) nt' attrs - _ -> (Map.empty,Map.empty) - virt = if existsAsInst nm - then case lookup nm flds of - Just tp' -> Just (Just tp') - Nothing -> Just Nothing - else if existsAsMerge nm - then (Just Nothing) - else Nothing - in Child nm tpI inh syn 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 cldrn rules tsigs - in Nonterminal nt params inh syn (map alt alts) - in Grammar tsyns uses derivings wrappers nonts pragmaMap orderMap ntParams contextMap quantMap uniqueMap augmentsMap aroundsMap mergeMap -{-# LINE 461 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Transform.hs" #-} - -{-# LINE 1198 "src-ag/Transform.ag" #-} - -mapUnionWithSetUnion = Map.unionWith Set.union -mapUnionWithPlusPlus = Map.unionWith (++) -{-# LINE 467 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 allFields : _ - 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 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]) ]) - _elemsIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _elemsIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _elemsIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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 52, column 8) - _lhsOoutput = - ({-# LINE 52 "src-ag/Transform.ag" #-} - constructGrammar _allNonterminals - _elemsIparamsCollect - _allFields - _allAttrDecls - _elemsIuseMap - _elemsIderivings - (if wrappers _lhsIoptions then _allNonterminals else _elemsIwrappers) - _checkedRules - _checkedSigs - _checkedInsts - _elemsItypeSyns - _elemsIsemPragmasCollect - _elemsIattrOrderCollect - _elemsIctxCollect - _elemsIquantCollect - _checkedUniques - _checkedAugments - _checkedArounds - _checkedMerges - {-# LINE 610 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 254, column 10) - _allFields = - ({-# LINE 254 "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 617 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 257, column 10) - _allConstrs = - ({-# LINE 257 "src-ag/Transform.ag" #-} - let f (nt,con,_) = Map.insertWith (++) nt [con] - in foldr f (Map.empty) _elemsIcollectedFields - {-# LINE 624 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 260, column 10) - _allRules = - ({-# LINE 260 "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 631 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 263, column 10) - _allSigs = - ({-# LINE 263 "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 641 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 269, column 10) - _allInsts = - ({-# LINE 269 "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 648 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 272, column 10) - _allUniques = - ({-# LINE 272 "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 655 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 274, column 10) - _allAugments = - ({-# LINE 274 "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 662 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 276, column 10) - _allArounds = - ({-# LINE 276 "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 669 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 278, column 10) - _allMerges = - ({-# LINE 278 "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 676 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 281, column 10) - _augmentSigs = - ({-# LINE 281 "src-ag/Transform.ag" #-} - let gen mp = [] - in Map.map (Map.map gen) _allAugments - {-# LINE 683 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 284, column 10) - _allRulesErrs = - ({-# LINE 284 "src-ag/Transform.ag" #-} - Map.mapWithKey (Map.mapWithKey . (checkRules _allAttrDecls _allFields _allInsts _allSigs _allMerges )) _allRules - {-# LINE 689 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 285, column 10) - _allNamesErrs = - ({-# LINE 285 "src-ag/Transform.ag" #-} - Map.mapWithKey (Map.mapWithKey . checkRuleNames) _allRules - {-# LINE 695 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 286, column 10) - _allSigsErrs = - ({-# LINE 286 "src-ag/Transform.ag" #-} - Map.mapWithKey (Map.mapWithKey . (checkSigs )) _allSigs - {-# LINE 701 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 287, column 10) - _allInstsErrs = - ({-# LINE 287 "src-ag/Transform.ag" #-} - Map.mapWithKey (Map.mapWithKey . (checkInsts _allNonterminals _allSigs _allFields )) _allInsts - {-# LINE 707 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 288, column 10) - _allUniquesErrs = - ({-# LINE 288 "src-ag/Transform.ag" #-} - Map.mapWithKey (Map.mapWithKey . (checkUniques _allAttrDecls )) _allUniques - {-# LINE 713 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 289, column 10) - _allAugmentErrs = - ({-# LINE 289 "src-ag/Transform.ag" #-} - Map.mapWithKey (Map.mapWithKey . (checkAugments _allAttrDecls )) _allAugments - {-# LINE 719 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 290, column 10) - _allAroundsErrs = - ({-# LINE 290 "src-ag/Transform.ag" #-} - Map.mapWithKey (Map.mapWithKey . (checkArounds _allFields )) _allArounds - {-# LINE 725 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 291, column 10) - _allMergesErrs = - ({-# LINE 291 "src-ag/Transform.ag" #-} - Map.mapWithKey (Map.mapWithKey . (checkMerges _allNonterminals _allInsts _allFields )) _allMerges - {-# LINE 731 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 293, column 10) - _checkedRulesPre = - ({-# LINE 293 "src-ag/Transform.ag" #-} - Map.map (Map.map fst) _allRulesErrs - {-# LINE 737 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 294, column 10) - _checkedSigs = - ({-# LINE 294 "src-ag/Transform.ag" #-} - Map.map (Map.map fst) _allSigsErrs `unionunionplusplus` _augmentSigs - {-# LINE 743 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 295, column 10) - _checkedInsts = - ({-# LINE 295 "src-ag/Transform.ag" #-} - Map.map (Map.map fst) _allInstsErrs - {-# LINE 749 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 296, column 10) - _checkedUniques = - ({-# LINE 296 "src-ag/Transform.ag" #-} - Map.map (Map.map fst) _allUniquesErrs - {-# LINE 755 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 297, column 10) - _checkedAugments = - ({-# LINE 297 "src-ag/Transform.ag" #-} - Map.map (Map.map fst) _allAugmentErrs - {-# LINE 761 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 298, column 10) - _checkedArounds = - ({-# LINE 298 "src-ag/Transform.ag" #-} - Map.map (Map.map fst) _allAroundsErrs - {-# LINE 767 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 299, column 10) - _checkedRules = - ({-# LINE 299 "src-ag/Transform.ag" #-} - Map.unionWith (Map.unionWith (++)) _checkedRulesPre (Map.mapWithKey (Map.mapWithKey . (mkUniqueRules _lhsIoptions _allFields _checkedInsts _allAttrDecls )) _checkedUniques ) - {-# LINE 773 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 300, column 10) - _checkedMerges = - ({-# LINE 300 "src-ag/Transform.ag" #-} - Map.map (Map.map fst) _allMergesErrs - {-# LINE 779 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 302, column 10) - _errs1 = - ({-# LINE 302 "src-ag/Transform.ag" #-} - let f = checkForDuplicates (DupSynonym) - in Seq.fromList . f . map fst $ _elemsItypeSyns - {-# LINE 786 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 305, column 10) - _errs2 = - ({-# LINE 305 "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 794 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 309, column 10) - _errs3 = - ({-# LINE 309 "src-ag/Transform.ag" #-} - let f (nt,cons) = checkForDuplicates (DupAlt nt) cons - in Seq.empty - {-# LINE 801 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 313, column 10) - _errs4 = - ({-# LINE 313 "src-ag/Transform.ag" #-} - let f m s = Map.fold ((><) . snd) s m - in Map.fold f Seq.empty _allRulesErrs - {-# LINE 808 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 316, column 10) - _errs5 = - ({-# LINE 316 "src-ag/Transform.ag" #-} - let f m s = Map.fold ((><) . snd) s m - in Map.fold f Seq.empty _allSigsErrs - {-# LINE 815 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 319, column 10) - _errs6 = - ({-# LINE 319 "src-ag/Transform.ag" #-} - let f m s = Map.fold ((><) . snd) s m - in Map.fold f Seq.empty _allInstsErrs - {-# LINE 822 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 322, column 10) - _errs7 = - ({-# LINE 322 "src-ag/Transform.ag" #-} - let f m s = Map.fold ((><) . snd) s m - in Map.fold f Seq.empty _allUniquesErrs - {-# LINE 829 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 325, column 10) - _errs8 = - ({-# LINE 325 "src-ag/Transform.ag" #-} - let f m s = Map.fold ((><) . snd) s m - in Map.fold f Seq.empty _allAugmentErrs - {-# LINE 836 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 328, column 10) - _errs9 = - ({-# LINE 328 "src-ag/Transform.ag" #-} - let f m s = Map.fold ((><) . snd) s m - in Map.fold f Seq.empty _allAroundsErrs - {-# LINE 843 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 331, column 10) - _errs10 = - ({-# LINE 331 "src-ag/Transform.ag" #-} - let f m s = Map.fold ((><)) s m - in Map.fold f Seq.empty _allNamesErrs - {-# LINE 850 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 334, column 10) - _errs11 = - ({-# LINE 334 "src-ag/Transform.ag" #-} - let f m s = Map.fold ((><) . snd) s m - in Map.fold f Seq.empty _allMergesErrs - {-# LINE 857 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 337, column 10) - _lhsOerrors = - ({-# LINE 337 "src-ag/Transform.ag" #-} - _elemsIerrors >< _errs1 >< _errs2 >< _errs3 >< _errs4 >< _errs5 >< _errs6 >< _errs7 >< _errs8 >< _errs9 >< _errs10 >< _errs11 - {-# LINE 863 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 561, column 10) - _allNonterminals = - ({-# LINE 561 "src-ag/Transform.ag" #-} - _elemsIcollectedNames `Set.difference` _elemsIcollectedSetNames - {-# LINE 869 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 581, column 8) - _elemsOallConstructors = - ({-# LINE 581 "src-ag/Transform.ag" #-} - _elemsIcollectedConstructorsMap - {-# LINE 875 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 654, column 8) - _elemsOdefSets = - ({-# LINE 654 "src-ag/Transform.ag" #-} - Map.fromList (map (\x->(x,(Set.singleton x, Set.empty))) (Set.toList _allNonterminals )) - {-# LINE 881 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 655, column 8) - _elemsOdefinedSets = - ({-# LINE 655 "src-ag/Transform.ag" #-} - Map.map fst _elemsIdefSets - {-# LINE 887 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 940, column 8) - _elemsOattrDecls = - ({-# LINE 940 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 893 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 994, column 9) - _allAttrDecls = - ({-# LINE 994 "src-ag/Transform.ag" #-} - if withSelf _lhsIoptions - then foldr addSelf _elemsIattrDecls (Set.toList _allNonterminals ) - else _elemsIattrDecls - {-# LINE 901 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1213, column 8) - _lhsOagi = - ({-# LINE 1213 "src-ag/Transform.ag" #-} - (_allNonterminals ,_allFields ,_allAttrs ) - {-# LINE 907 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1215, column 8) - _allAttrs = - ({-# LINE 1215 "src-ag/Transform.ag" #-} - if withSelf _lhsIoptions - then foldr addSelf _elemsIattrs (Set.toList _allNonterminals ) - else _elemsIattrs - {-# LINE 915 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1223, column 9) - _elemsOattrs = - ({-# LINE 1223 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 921 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 45, column 19) - _lhsOblocks = - ({-# LINE 45 "src-ag/Transform.ag" #-} - _elemsIblocks - {-# LINE 927 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1118, column 37) - _lhsOmoduleDecl = - ({-# LINE 1118 "src-ag/Transform.ag" #-} - _elemsImoduleDecl - {-# LINE 933 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 747, column 34) - _lhsOpragmas = - ({-# LINE 747 "src-ag/Transform.ag" #-} - _elemsIpragmas - {-# LINE 939 "src-ag/Transform.hs" #-} - ) - -- copy rule (from local) - _elemsOallAttrDecls = - ({-# LINE 825 "src-ag/Transform.ag" #-} - _allAttrDecls - {-# LINE 945 "src-ag/Transform.hs" #-} - ) - -- copy rule (from local) - _elemsOallAttrs = - ({-# LINE 1210 "src-ag/Transform.ag" #-} - _allAttrs - {-# LINE 951 "src-ag/Transform.hs" #-} - ) - -- copy rule (from local) - _elemsOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _allFields - {-# LINE 957 "src-ag/Transform.hs" #-} - ) - -- copy rule (from local) - _elemsOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _allNonterminals - {-# LINE 963 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _elemsOoptions = - ({-# LINE 39 "src-ag/Transform.ag" #-} - _lhsIoptions - {-# LINE 969 "src-ag/Transform.hs" #-} - ) - ( _elemsIattrDecls,_elemsIattrOrderCollect,_elemsIattrs,_elemsIblocks,_elemsIcollectedArounds,_elemsIcollectedAugments,_elemsIcollectedConstructorsMap,_elemsIcollectedFields,_elemsIcollectedInsts,_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: - collectedConstructorNames : Set ConstructorIdent - collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] - alternatives: - alternative Alt: - child pos : {Pos} - child names : ConstructorSet - child fields : {Fields} --} --- cata -sem_Alt :: Alt -> - T_Alt -sem_Alt (Alt _pos _names _fields ) = - (sem_Alt_Alt _pos (sem_ConstructorSet _names ) _fields ) --- semantic domain -newtype T_Alt = T_Alt ((Map NontermIdent (Set ConstructorIdent)) -> - (Set NontermIdent) -> - (Set NontermIdent) -> - ( (Set ConstructorIdent),([(NontermIdent, ConstructorIdent, FieldMap)]))) -data Inh_Alt = Inh_Alt {allConstructors_Inh_Alt :: !((Map NontermIdent (Set ConstructorIdent))),allNonterminals_Inh_Alt :: !((Set NontermIdent)),nts_Inh_Alt :: !((Set NontermIdent))} -data Syn_Alt = Syn_Alt {collectedConstructorNames_Syn_Alt :: !((Set ConstructorIdent)),collectedFields_Syn_Alt :: !(([(NontermIdent, ConstructorIdent, FieldMap)]))} -wrap_Alt :: T_Alt -> - Inh_Alt -> - Syn_Alt -wrap_Alt (T_Alt sem ) (Inh_Alt _lhsIallConstructors _lhsIallNonterminals _lhsInts ) = - (let ( _lhsOcollectedConstructorNames,_lhsOcollectedFields) = sem _lhsIallConstructors _lhsIallNonterminals _lhsInts - in (Syn_Alt _lhsOcollectedConstructorNames _lhsOcollectedFields )) -sem_Alt_Alt :: Pos -> - T_ConstructorSet -> - Fields -> - T_Alt -sem_Alt_Alt pos_ (T_ConstructorSet names_ ) fields_ = - (T_Alt (\ _lhsIallConstructors - _lhsIallNonterminals - _lhsInts -> - (let _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedConstructorNames :: (Set ConstructorIdent) - _namesIcollectedConstructorNames :: (Set ConstructorIdent) - _namesIconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) - _namesIerrors :: (Seq Error) - -- "src-ag/Transform.ag"(line 239, column 10) - _lhsOcollectedFields = - ({-# LINE 239 "src-ag/Transform.ag" #-} - let fieldTable = - [ (attr, makeType _lhsIallNonterminals tp) - | (attr, tp) <- fields_ - ] - in [ (nt, con, fieldTable) - | nt <- Set.toList _lhsInts - , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) - ] - {-# LINE 1032 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 94, column 62) - _lhsOcollectedConstructorNames = - ({-# LINE 94 "src-ag/Transform.ag" #-} - _namesIcollectedConstructorNames - {-# LINE 1038 "src-ag/Transform.hs" #-} - ) - ( _namesIcollectedConstructorNames,_namesIconstructors,_namesIerrors) = - names_ - in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields))) ) --- Alts -------------------------------------------------------- -{- - visit 0: - inherited attributes: - allConstructors : Map NontermIdent (Set ConstructorIdent) - allNonterminals : Set NontermIdent - nts : Set NontermIdent - synthesized attributes: - collectedConstructorNames : Set ConstructorIdent - collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] - alternatives: - alternative Cons: - child hd : Alt - child tl : Alts - alternative Nil: --} --- cata -sem_Alts :: Alts -> - T_Alts -sem_Alts list = - (Prelude.foldr sem_Alts_Cons sem_Alts_Nil (Prelude.map sem_Alt list) ) --- semantic domain -newtype T_Alts = T_Alts ((Map NontermIdent (Set ConstructorIdent)) -> - (Set NontermIdent) -> - (Set NontermIdent) -> - ( (Set ConstructorIdent),([(NontermIdent, ConstructorIdent, FieldMap)]))) -data Inh_Alts = Inh_Alts {allConstructors_Inh_Alts :: !((Map NontermIdent (Set ConstructorIdent))),allNonterminals_Inh_Alts :: !((Set NontermIdent)),nts_Inh_Alts :: !((Set NontermIdent))} -data Syn_Alts = Syn_Alts {collectedConstructorNames_Syn_Alts :: !((Set ConstructorIdent)),collectedFields_Syn_Alts :: !(([(NontermIdent, ConstructorIdent, FieldMap)]))} -wrap_Alts :: T_Alts -> - Inh_Alts -> - Syn_Alts -wrap_Alts (T_Alts sem ) (Inh_Alts _lhsIallConstructors _lhsIallNonterminals _lhsInts ) = - (let ( _lhsOcollectedConstructorNames,_lhsOcollectedFields) = sem _lhsIallConstructors _lhsIallNonterminals _lhsInts - in (Syn_Alts _lhsOcollectedConstructorNames _lhsOcollectedFields )) -sem_Alts_Cons :: T_Alt -> - T_Alts -> - T_Alts -sem_Alts_Cons (T_Alt hd_ ) (T_Alts tl_ ) = - (T_Alts (\ _lhsIallConstructors - _lhsIallNonterminals - _lhsInts -> - (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _hdOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) - _hdOallNonterminals :: (Set NontermIdent) - _hdOnts :: (Set NontermIdent) - _tlOallConstructors :: (Map NontermIdent (Set ConstructorIdent)) - _tlOallNonterminals :: (Set NontermIdent) - _tlOnts :: (Set NontermIdent) - _hdIcollectedConstructorNames :: (Set ConstructorIdent) - _hdIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _tlIcollectedConstructorNames :: (Set ConstructorIdent) - _tlIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - -- use rule "src-ag/Transform.ag"(line 94, column 62) - _lhsOcollectedConstructorNames = - ({-# LINE 94 "src-ag/Transform.ag" #-} - _hdIcollectedConstructorNames `Set.union` _tlIcollectedConstructorNames - {-# LINE 1100 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 126, column 28) - _lhsOcollectedFields = - ({-# LINE 126 "src-ag/Transform.ag" #-} - _hdIcollectedFields ++ _tlIcollectedFields - {-# LINE 1106 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOallConstructors = - ({-# LINE 97 "src-ag/Transform.ag" #-} - _lhsIallConstructors - {-# LINE 1112 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 1118 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOnts = - ({-# LINE 168 "src-ag/Transform.ag" #-} - _lhsInts - {-# LINE 1124 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOallConstructors = - ({-# LINE 97 "src-ag/Transform.ag" #-} - _lhsIallConstructors - {-# LINE 1130 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 1136 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOnts = - ({-# LINE 168 "src-ag/Transform.ag" #-} - _lhsInts - {-# LINE 1142 "src-ag/Transform.hs" #-} - ) - ( _hdIcollectedConstructorNames,_hdIcollectedFields) = - hd_ _hdOallConstructors _hdOallNonterminals _hdOnts - ( _tlIcollectedConstructorNames,_tlIcollectedFields) = - tl_ _tlOallConstructors _tlOallNonterminals _tlOnts - in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields))) ) -sem_Alts_Nil :: T_Alts -sem_Alts_Nil = - (T_Alts (\ _lhsIallConstructors - _lhsIallNonterminals - _lhsInts -> - (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - -- use rule "src-ag/Transform.ag"(line 94, column 62) - _lhsOcollectedConstructorNames = - ({-# LINE 94 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 1160 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 126, column 28) - _lhsOcollectedFields = - ({-# LINE 126 "src-ag/Transform.ag" #-} - [] - {-# LINE 1166 "src-ag/Transform.hs" #-} - ) - in ( _lhsOcollectedConstructorNames,_lhsOcollectedFields))) ) --- 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 _tup1 : _ - local attrDecls : _ - local errors : _ - local _tup2 : _ - 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 949, column 15) - __tup1 = - ({-# LINE 949 "src-ag/Transform.ag" #-} - checkAttrs _lhsIallFields (Set.toList _lhsInts) _inherited _synthesized _lhsIattrDecls - {-# LINE 1240 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 949, column 15) - (_attrDecls,_) = - ({-# LINE 949 "src-ag/Transform.ag" #-} - __tup1 - {-# LINE 1246 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 949, column 15) - (_,_errors) = - ({-# LINE 949 "src-ag/Transform.ag" #-} - __tup1 - {-# LINE 1252 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 951, column 15) - __tup2 = - ({-# LINE 951 "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 1265 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 951, column 15) - (_inherited,_,_) = - ({-# LINE 951 "src-ag/Transform.ag" #-} - __tup2 - {-# LINE 1271 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 951, column 15) - (_,_synthesized,_) = - ({-# LINE 951 "src-ag/Transform.ag" #-} - __tup2 - {-# LINE 1277 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 951, column 15) - (_,_,_useMap) = - ({-# LINE 951 "src-ag/Transform.ag" #-} - __tup2 - {-# LINE 1283 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 959, column 11) - _lhsOuseMap = - ({-# LINE 959 "src-ag/Transform.ag" #-} - Map.fromList (zip (Set.toList _lhsInts) (repeat _useMap)) - {-# LINE 1289 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 961, column 11) - _errors1 = - ({-# LINE 961 "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 1306 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 973, column 11) - _lhsOerrors = - ({-# LINE 973 "src-ag/Transform.ag" #-} - _errors Seq.>< _errors1 - {-# LINE 1312 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1227, column 11) - _lhsOattrs = - ({-# LINE 1227 "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 1322 "src-ag/Transform.hs" #-} - ) - -- copy rule (from local) - _lhsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _attrDecls - {-# LINE 1328 "src-ag/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 CAll: - alternative CDifference: - child set1 : ConstructorSet - child set2 : ConstructorSet - alternative CName: - child name : {ConstructorIdent} - alternative CUnion: - child set1 : ConstructorSet - child set2 : ConstructorSet --} --- cata -sem_ConstructorSet :: ConstructorSet -> - T_ConstructorSet -sem_ConstructorSet (CAll ) = - (sem_ConstructorSet_CAll ) -sem_ConstructorSet (CDifference _set1 _set2 ) = - (sem_ConstructorSet_CDifference (sem_ConstructorSet _set1 ) (sem_ConstructorSet _set2 ) ) -sem_ConstructorSet (CName _name ) = - (sem_ConstructorSet_CName _name ) -sem_ConstructorSet (CUnion _set1 _set2 ) = - (sem_ConstructorSet_CUnion (sem_ConstructorSet _set1 ) (sem_ConstructorSet _set2 ) ) --- semantic domain -newtype T_ConstructorSet = T_ConstructorSet (( (Set ConstructorIdent),((Set ConstructorIdent->Set ConstructorIdent)),(Seq Error))) -data Inh_ConstructorSet = Inh_ConstructorSet {} -data Syn_ConstructorSet = Syn_ConstructorSet {collectedConstructorNames_Syn_ConstructorSet :: !((Set ConstructorIdent)),constructors_Syn_ConstructorSet :: !(((Set ConstructorIdent->Set ConstructorIdent))),errors_Syn_ConstructorSet :: !((Seq Error))} -wrap_ConstructorSet :: T_ConstructorSet -> - Inh_ConstructorSet -> - Syn_ConstructorSet -wrap_ConstructorSet (T_ConstructorSet sem ) (Inh_ConstructorSet ) = - (let ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors) = sem - in (Syn_ConstructorSet _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors )) -sem_ConstructorSet_CAll :: T_ConstructorSet -sem_ConstructorSet_CAll = - (T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) - _lhsOcollectedConstructorNames :: (Set ConstructorIdent) - _lhsOerrors :: (Seq Error) - -- "src-ag/Transform.ag"(line 725, column 17) - _lhsOconstructors = - ({-# LINE 725 "src-ag/Transform.ag" #-} - \ds -> ds - {-# LINE 1379 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 94, column 62) - _lhsOcollectedConstructorNames = - ({-# LINE 94 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 1385 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - Seq.empty - {-# LINE 1391 "src-ag/Transform.hs" #-} - ) - 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 724, column 17) - _lhsOconstructors = - ({-# LINE 724 "src-ag/Transform.ag" #-} - \ds -> _set1Iconstructors ds `Set.difference` _set2Iconstructors ds - {-# LINE 1411 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 94, column 62) - _lhsOcollectedConstructorNames = - ({-# LINE 94 "src-ag/Transform.ag" #-} - _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames - {-# LINE 1417 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - _set1Ierrors Seq.>< _set2Ierrors - {-# LINE 1423 "src-ag/Transform.hs" #-} - ) - ( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) = - set1_ - ( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) = - set2_ - in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)) ) -sem_ConstructorSet_CName :: ConstructorIdent -> - T_ConstructorSet -sem_ConstructorSet_CName name_ = - (T_ConstructorSet (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent) - _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent)) - _lhsOerrors :: (Seq Error) - -- "src-ag/Transform.ag"(line 569, column 11) - _lhsOcollectedConstructorNames = - ({-# LINE 569 "src-ag/Transform.ag" #-} - Set.singleton name_ - {-# LINE 1440 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 722, column 17) - _lhsOconstructors = - ({-# LINE 722 "src-ag/Transform.ag" #-} - \ds -> Set.singleton name_ - {-# LINE 1446 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - Seq.empty - {-# LINE 1452 "src-ag/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 723, column 17) - _lhsOconstructors = - ({-# LINE 723 "src-ag/Transform.ag" #-} - \ds -> _set1Iconstructors ds `Set.union` _set2Iconstructors ds - {-# LINE 1472 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 94, column 62) - _lhsOcollectedConstructorNames = - ({-# LINE 94 "src-ag/Transform.ag" #-} - _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames - {-# LINE 1478 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - _set1Ierrors Seq.>< _set2Ierrors - {-# LINE 1484 "src-ag/Transform.hs" #-} - ) - ( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) = - set1_ - ( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) = - set2_ - 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]) ] - collectedConstructorsMap : Map NontermIdent (Set ConstructorIdent) - collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] - collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] - 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 Attr: - child pos : {Pos} - child ctx : {ClassContext} - child names : NontSet - child quants : {[String]} - child attrs : Attrs - alternative Data: - child pos : {Pos} - child ctx : {ClassContext} - child names : NontSet - child params : {[Identifier]} - child attrs : Attrs - child alts : Alts - child ext : {Bool} - alternative Deriving: - child pos : {Pos} - child set : NontSet - child classes : {[NontermIdent]} - alternative Module: - child pos : {Pos} - child name : {String} - child exports : {String} - child imports : {String} - alternative Nocatas: - child pos : {Pos} - child set : NontSet - alternative Pragma: - child pos : {Pos} - child names : {[NontermIdent]} - alternative Sem: - child pos : {Pos} - child ctx : {ClassContext} - child names : NontSet - child attrs : Attrs - child quants : {[String]} - child alts : SemAlts - alternative Set: - child pos : {Pos} - child name : {NontermIdent} - child merge : {Bool} - child set : NontSet - visit 0: - local _tup3 : _ - local defSets2 : _ - local errs : _ - alternative Txt: - child pos : {Pos} - child name : {Identifier} - child mbNt : {Maybe NontermIdent} - child lines : {[String]} - visit 0: - local blockInfo : _ - local blockValue : _ - alternative Type: - child pos : {Pos} - child ctx : {ClassContext} - child name : {NontermIdent} - child params : {[Identifier]} - child type : {ComplexType} - visit 0: - local expanded : _ - local argType : _ - alternative Wrapper: - child pos : {Pos} - child set : NontSet --} --- cata -sem_Elem :: Elem -> - T_Elem -sem_Elem (Attr _pos _ctx _names _quants _attrs ) = - (sem_Elem_Attr _pos _ctx (sem_NontSet _names ) _quants (sem_Attrs _attrs ) ) -sem_Elem (Data _pos _ctx _names _params _attrs _alts _ext ) = - (sem_Elem_Data _pos _ctx (sem_NontSet _names ) _params (sem_Attrs _attrs ) (sem_Alts _alts ) _ext ) -sem_Elem (Deriving _pos _set _classes ) = - (sem_Elem_Deriving _pos (sem_NontSet _set ) _classes ) -sem_Elem (Module _pos _name _exports _imports ) = - (sem_Elem_Module _pos _name _exports _imports ) -sem_Elem (Nocatas _pos _set ) = - (sem_Elem_Nocatas _pos (sem_NontSet _set ) ) -sem_Elem (Pragma _pos _names ) = - (sem_Elem_Pragma _pos _names ) -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 (Set _pos _name _merge _set ) = - (sem_Elem_Set _pos _name _merge (sem_NontSet _set ) ) -sem_Elem (Txt _pos _name _mbNt _lines ) = - (sem_Elem_Txt _pos _name _mbNt _lines ) -sem_Elem (Type _pos _ctx _name _params _type ) = - (sem_Elem_Type _pos _ctx _name _params _type ) -sem_Elem (Wrapper _pos _set ) = - (sem_Elem_Wrapper _pos (sem_NontSet _set ) ) --- semantic domain -newtype T_Elem = T_Elem ((Map NontermIdent (Attributes, Attributes)) -> - (Map NontermIdent (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]) ]),(Map NontermIdent (Set ConstructorIdent)),([(NontermIdent, ConstructorIdent, FieldMap)]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (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]) ])),collectedConstructorsMap_Syn_Elem :: !((Map NontermIdent (Set ConstructorIdent))),collectedFields_Syn_Elem :: !(([(NontermIdent, ConstructorIdent, FieldMap)])),collectedInsts_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, [Identifier]) ])),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,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_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 _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _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]) ]) - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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 883, column 7) - _lhsOctxCollect = - ({-# LINE 883 "src-ag/Transform.ag" #-} - if null ctx_ - then Map.empty - else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] - {-# LINE 1709 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 908, column 7) - _lhsOquantCollect = - ({-# LINE 908 "src-ag/Transform.ag" #-} - if null quants_ - then Map.empty - else Map.fromList [(nt, quants_) | nt <- Set.toList _namesInontSet] - {-# LINE 1717 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 944, column 10) - _attrsOnts = - ({-# LINE 944 "src-ag/Transform.ag" #-} - _namesInontSet - {-# LINE 1723 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 824, column 55) - _lhsOattrOrderCollect = - ({-# LINE 824 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 1729 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 45, column 19) - _lhsOblocks = - ({-# LINE 45 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 1735 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 157, column 32) - _lhsOcollectedArounds = - ({-# LINE 157 "src-ag/Transform.ag" #-} - [] - {-# LINE 1741 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 156, column 32) - _lhsOcollectedAugments = - ({-# LINE 156 "src-ag/Transform.ag" #-} - [] - {-# LINE 1747 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 95, column 48) - _lhsOcollectedConstructorsMap = - ({-# LINE 95 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 1753 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 126, column 28) - _lhsOcollectedFields = - ({-# LINE 126 "src-ag/Transform.ag" #-} - [] - {-# LINE 1759 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 154, column 32) - _lhsOcollectedInsts = - ({-# LINE 154 "src-ag/Transform.ag" #-} - [] - {-# LINE 1765 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 158, column 32) - _lhsOcollectedMerges = - ({-# LINE 158 "src-ag/Transform.ag" #-} - [] - {-# LINE 1771 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - _namesIcollectedNames - {-# LINE 1777 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 152, column 32) - _lhsOcollectedRules = - ({-# LINE 152 "src-ag/Transform.ag" #-} - [] - {-# LINE 1783 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 86, column 50) - _lhsOcollectedSetNames = - ({-# LINE 86 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 1789 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 153, column 32) - _lhsOcollectedSigs = - ({-# LINE 153 "src-ag/Transform.ag" #-} - [] - {-# LINE 1795 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 155, column 32) - _lhsOcollectedUniques = - ({-# LINE 155 "src-ag/Transform.ag" #-} - [] - {-# LINE 1801 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 921, column 33) - _lhsOderivings = - ({-# LINE 921 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 1807 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - _namesIerrors Seq.>< _attrsIerrors - {-# LINE 1813 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1118, column 37) - _lhsOmoduleDecl = - ({-# LINE 1118 "src-ag/Transform.ag" #-} - mzero - {-# LINE 1819 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 856, column 37) - _lhsOparamsCollect = - ({-# LINE 856 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 1825 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 747, column 34) - _lhsOpragmas = - ({-# LINE 747 "src-ag/Transform.ag" #-} - id - {-# LINE 1831 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 796, column 56) - _lhsOsemPragmasCollect = - ({-# LINE 796 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 1837 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 596, column 32) - _lhsOtypeSyns = - ({-# LINE 596 "src-ag/Transform.ag" #-} - [] - {-# LINE 1843 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 138, column 15) - _lhsOuseMap = - ({-# LINE 138 "src-ag/Transform.ag" #-} - _attrsIuseMap - {-# LINE 1849 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 731, column 32) - _lhsOwrappers = - ({-# LINE 731 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 1855 "src-ag/Transform.hs" #-} - ) - -- copy rule (up) - _lhsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _attrsIattrDecls - {-# LINE 1861 "src-ag/Transform.hs" #-} - ) - -- copy rule (up) - _lhsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _attrsIattrs - {-# LINE 1867 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOdefSets = - ({-# LINE 105 "src-ag/Transform.ag" #-} - _lhsIdefSets - {-# LINE 1873 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _namesOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 1879 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _namesOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 1885 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _namesOdefinedSets = - ({-# LINE 108 "src-ag/Transform.ag" #-} - _lhsIdefinedSets - {-# LINE 1891 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _attrsOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 1897 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _attrsOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 1903 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _attrsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _lhsIattrDecls - {-# LINE 1909 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _attrsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _lhsIattrs - {-# LINE 1915 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _attrsOoptions = - ({-# LINE 39 "src-ag/Transform.ag" #-} - _lhsIoptions - {-# LINE 1921 "src-ag/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,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_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]) ]) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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))) - _altsIcollectedConstructorNames :: (Set ConstructorIdent) - _altsIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - -- "src-ag/Transform.ag"(line 171, column 10) - _altsOnts = - ({-# LINE 171 "src-ag/Transform.ag" #-} - _namesInontSet - {-# LINE 1999 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 575, column 11) - _lhsOcollectedConstructorsMap = - ({-# LINE 575 "src-ag/Transform.ag" #-} - Map.fromList - [ (n, _altsIcollectedConstructorNames) - | n <- Set.toList _namesInontSet - ] - {-# LINE 2008 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 860, column 7) - _lhsOparamsCollect = - ({-# LINE 860 "src-ag/Transform.ag" #-} - if null params_ - then Map.empty - else Map.fromList [(nt, params_) | nt <- Set.toList _namesInontSet] - {-# LINE 2016 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 883, column 7) - _lhsOctxCollect = - ({-# LINE 883 "src-ag/Transform.ag" #-} - if null ctx_ - then Map.empty - else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] - {-# LINE 2024 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 943, column 10) - _attrsOnts = - ({-# LINE 943 "src-ag/Transform.ag" #-} - _namesInontSet - {-# LINE 2030 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 824, column 55) - _lhsOattrOrderCollect = - ({-# LINE 824 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2036 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 45, column 19) - _lhsOblocks = - ({-# LINE 45 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2042 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 157, column 32) - _lhsOcollectedArounds = - ({-# LINE 157 "src-ag/Transform.ag" #-} - [] - {-# LINE 2048 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 156, column 32) - _lhsOcollectedAugments = - ({-# LINE 156 "src-ag/Transform.ag" #-} - [] - {-# LINE 2054 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 126, column 28) - _lhsOcollectedFields = - ({-# LINE 126 "src-ag/Transform.ag" #-} - _altsIcollectedFields - {-# LINE 2060 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 154, column 32) - _lhsOcollectedInsts = - ({-# LINE 154 "src-ag/Transform.ag" #-} - [] - {-# LINE 2066 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 158, column 32) - _lhsOcollectedMerges = - ({-# LINE 158 "src-ag/Transform.ag" #-} - [] - {-# LINE 2072 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - _namesIcollectedNames - {-# LINE 2078 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 152, column 32) - _lhsOcollectedRules = - ({-# LINE 152 "src-ag/Transform.ag" #-} - [] - {-# LINE 2084 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 86, column 50) - _lhsOcollectedSetNames = - ({-# LINE 86 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 2090 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 153, column 32) - _lhsOcollectedSigs = - ({-# LINE 153 "src-ag/Transform.ag" #-} - [] - {-# LINE 2096 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 155, column 32) - _lhsOcollectedUniques = - ({-# LINE 155 "src-ag/Transform.ag" #-} - [] - {-# LINE 2102 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 921, column 33) - _lhsOderivings = - ({-# LINE 921 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2108 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - _namesIerrors Seq.>< _attrsIerrors - {-# LINE 2114 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1118, column 37) - _lhsOmoduleDecl = - ({-# LINE 1118 "src-ag/Transform.ag" #-} - mzero - {-# LINE 2120 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 747, column 34) - _lhsOpragmas = - ({-# LINE 747 "src-ag/Transform.ag" #-} - id - {-# LINE 2126 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 904, column 36) - _lhsOquantCollect = - ({-# LINE 904 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2132 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 796, column 56) - _lhsOsemPragmasCollect = - ({-# LINE 796 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2138 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 596, column 32) - _lhsOtypeSyns = - ({-# LINE 596 "src-ag/Transform.ag" #-} - [] - {-# LINE 2144 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 138, column 15) - _lhsOuseMap = - ({-# LINE 138 "src-ag/Transform.ag" #-} - _attrsIuseMap - {-# LINE 2150 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 731, column 32) - _lhsOwrappers = - ({-# LINE 731 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 2156 "src-ag/Transform.hs" #-} - ) - -- copy rule (up) - _lhsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _attrsIattrDecls - {-# LINE 2162 "src-ag/Transform.hs" #-} - ) - -- copy rule (up) - _lhsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _attrsIattrs - {-# LINE 2168 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOdefSets = - ({-# LINE 105 "src-ag/Transform.ag" #-} - _lhsIdefSets - {-# LINE 2174 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _namesOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 2180 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _namesOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 2186 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _namesOdefinedSets = - ({-# LINE 108 "src-ag/Transform.ag" #-} - _lhsIdefinedSets - {-# LINE 2192 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _attrsOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 2198 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _attrsOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 2204 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _attrsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _lhsIattrDecls - {-# LINE 2210 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _attrsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _lhsIattrs - {-# LINE 2216 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _attrsOoptions = - ({-# LINE 39 "src-ag/Transform.ag" #-} - _lhsIoptions - {-# LINE 2222 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _altsOallConstructors = - ({-# LINE 97 "src-ag/Transform.ag" #-} - _lhsIallConstructors - {-# LINE 2228 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _altsOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 2234 "src-ag/Transform.hs" #-} - ) - ( _namesIcollectedNames,_namesIerrors,_namesInontSet) = - names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets - ( _attrsIattrDecls,_attrsIattrs,_attrsIerrors,_attrsIuseMap) = - attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOattrs _attrsOnts _attrsOoptions - ( _altsIcollectedConstructorNames,_altsIcollectedFields) = - alts_ _altsOallConstructors _altsOallNonterminals _altsOnts - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_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]) ]) - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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 928, column 14) - _lhsOderivings = - ({-# LINE 928 "src-ag/Transform.ag" #-} - Map.fromList [(nt,Set.fromList classes_) | nt <- Set.toList _setInontSet] - {-# LINE 2295 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 824, column 55) - _lhsOattrOrderCollect = - ({-# LINE 824 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2301 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 45, column 19) - _lhsOblocks = - ({-# LINE 45 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2307 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 157, column 32) - _lhsOcollectedArounds = - ({-# LINE 157 "src-ag/Transform.ag" #-} - [] - {-# LINE 2313 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 156, column 32) - _lhsOcollectedAugments = - ({-# LINE 156 "src-ag/Transform.ag" #-} - [] - {-# LINE 2319 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 95, column 48) - _lhsOcollectedConstructorsMap = - ({-# LINE 95 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2325 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 126, column 28) - _lhsOcollectedFields = - ({-# LINE 126 "src-ag/Transform.ag" #-} - [] - {-# LINE 2331 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 154, column 32) - _lhsOcollectedInsts = - ({-# LINE 154 "src-ag/Transform.ag" #-} - [] - {-# LINE 2337 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 158, column 32) - _lhsOcollectedMerges = - ({-# LINE 158 "src-ag/Transform.ag" #-} - [] - {-# LINE 2343 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - _setIcollectedNames - {-# LINE 2349 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 152, column 32) - _lhsOcollectedRules = - ({-# LINE 152 "src-ag/Transform.ag" #-} - [] - {-# LINE 2355 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 86, column 50) - _lhsOcollectedSetNames = - ({-# LINE 86 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 2361 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 153, column 32) - _lhsOcollectedSigs = - ({-# LINE 153 "src-ag/Transform.ag" #-} - [] - {-# LINE 2367 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 155, column 32) - _lhsOcollectedUniques = - ({-# LINE 155 "src-ag/Transform.ag" #-} - [] - {-# LINE 2373 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 879, column 34) - _lhsOctxCollect = - ({-# LINE 879 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2379 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - _setIerrors - {-# LINE 2385 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1118, column 37) - _lhsOmoduleDecl = - ({-# LINE 1118 "src-ag/Transform.ag" #-} - mzero - {-# LINE 2391 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 856, column 37) - _lhsOparamsCollect = - ({-# LINE 856 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2397 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 747, column 34) - _lhsOpragmas = - ({-# LINE 747 "src-ag/Transform.ag" #-} - id - {-# LINE 2403 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 904, column 36) - _lhsOquantCollect = - ({-# LINE 904 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2409 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 796, column 56) - _lhsOsemPragmasCollect = - ({-# LINE 796 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2415 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 596, column 32) - _lhsOtypeSyns = - ({-# LINE 596 "src-ag/Transform.ag" #-} - [] - {-# LINE 2421 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 138, column 15) - _lhsOuseMap = - ({-# LINE 138 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2427 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 731, column 32) - _lhsOwrappers = - ({-# LINE 731 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 2433 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _lhsIattrDecls - {-# LINE 2439 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _lhsIattrs - {-# LINE 2445 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOdefSets = - ({-# LINE 105 "src-ag/Transform.ag" #-} - _lhsIdefSets - {-# LINE 2451 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _setOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 2457 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _setOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 2463 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _setOdefinedSets = - ({-# LINE 108 "src-ag/Transform.ag" #-} - _lhsIdefinedSets - {-# LINE 2469 "src-ag/Transform.hs" #-} - ) - ( _setIcollectedNames,_setIerrors,_setInontSet) = - set_ _setOallFields _setOallNonterminals _setOdefinedSets - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_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]) ]) - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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 1122, column 7) - _lhsOmoduleDecl = - ({-# LINE 1122 "src-ag/Transform.ag" #-} - Just (name_, exports_, imports_) - {-# LINE 2521 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 824, column 55) - _lhsOattrOrderCollect = - ({-# LINE 824 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2527 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 45, column 19) - _lhsOblocks = - ({-# LINE 45 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2533 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 157, column 32) - _lhsOcollectedArounds = - ({-# LINE 157 "src-ag/Transform.ag" #-} - [] - {-# LINE 2539 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 156, column 32) - _lhsOcollectedAugments = - ({-# LINE 156 "src-ag/Transform.ag" #-} - [] - {-# LINE 2545 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 95, column 48) - _lhsOcollectedConstructorsMap = - ({-# LINE 95 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2551 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 126, column 28) - _lhsOcollectedFields = - ({-# LINE 126 "src-ag/Transform.ag" #-} - [] - {-# LINE 2557 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 154, column 32) - _lhsOcollectedInsts = - ({-# LINE 154 "src-ag/Transform.ag" #-} - [] - {-# LINE 2563 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 158, column 32) - _lhsOcollectedMerges = - ({-# LINE 158 "src-ag/Transform.ag" #-} - [] - {-# LINE 2569 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 2575 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 152, column 32) - _lhsOcollectedRules = - ({-# LINE 152 "src-ag/Transform.ag" #-} - [] - {-# LINE 2581 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 86, column 50) - _lhsOcollectedSetNames = - ({-# LINE 86 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 2587 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 153, column 32) - _lhsOcollectedSigs = - ({-# LINE 153 "src-ag/Transform.ag" #-} - [] - {-# LINE 2593 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 155, column 32) - _lhsOcollectedUniques = - ({-# LINE 155 "src-ag/Transform.ag" #-} - [] - {-# LINE 2599 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 879, column 34) - _lhsOctxCollect = - ({-# LINE 879 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2605 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 921, column 33) - _lhsOderivings = - ({-# LINE 921 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2611 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - Seq.empty - {-# LINE 2617 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 856, column 37) - _lhsOparamsCollect = - ({-# LINE 856 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2623 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 747, column 34) - _lhsOpragmas = - ({-# LINE 747 "src-ag/Transform.ag" #-} - id - {-# LINE 2629 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 904, column 36) - _lhsOquantCollect = - ({-# LINE 904 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2635 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 796, column 56) - _lhsOsemPragmasCollect = - ({-# LINE 796 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2641 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 596, column 32) - _lhsOtypeSyns = - ({-# LINE 596 "src-ag/Transform.ag" #-} - [] - {-# LINE 2647 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 138, column 15) - _lhsOuseMap = - ({-# LINE 138 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2653 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 731, column 32) - _lhsOwrappers = - ({-# LINE 731 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 2659 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _lhsIattrDecls - {-# LINE 2665 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _lhsIattrs - {-# LINE 2671 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOdefSets = - ({-# LINE 105 "src-ag/Transform.ag" #-} - _lhsIdefSets - {-# LINE 2677 "src-ag/Transform.hs" #-} - ) - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_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]) ]) - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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 741, column 14) - _lhsOpragmas = - ({-# LINE 741 "src-ag/Transform.ag" #-} - \o -> o { nocatas = _setInontSet `Set.union` nocatas o } - {-# LINE 2731 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 824, column 55) - _lhsOattrOrderCollect = - ({-# LINE 824 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2737 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 45, column 19) - _lhsOblocks = - ({-# LINE 45 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2743 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 157, column 32) - _lhsOcollectedArounds = - ({-# LINE 157 "src-ag/Transform.ag" #-} - [] - {-# LINE 2749 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 156, column 32) - _lhsOcollectedAugments = - ({-# LINE 156 "src-ag/Transform.ag" #-} - [] - {-# LINE 2755 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 95, column 48) - _lhsOcollectedConstructorsMap = - ({-# LINE 95 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2761 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 126, column 28) - _lhsOcollectedFields = - ({-# LINE 126 "src-ag/Transform.ag" #-} - [] - {-# LINE 2767 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 154, column 32) - _lhsOcollectedInsts = - ({-# LINE 154 "src-ag/Transform.ag" #-} - [] - {-# LINE 2773 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 158, column 32) - _lhsOcollectedMerges = - ({-# LINE 158 "src-ag/Transform.ag" #-} - [] - {-# LINE 2779 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - _setIcollectedNames - {-# LINE 2785 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 152, column 32) - _lhsOcollectedRules = - ({-# LINE 152 "src-ag/Transform.ag" #-} - [] - {-# LINE 2791 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 86, column 50) - _lhsOcollectedSetNames = - ({-# LINE 86 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 2797 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 153, column 32) - _lhsOcollectedSigs = - ({-# LINE 153 "src-ag/Transform.ag" #-} - [] - {-# LINE 2803 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 155, column 32) - _lhsOcollectedUniques = - ({-# LINE 155 "src-ag/Transform.ag" #-} - [] - {-# LINE 2809 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 879, column 34) - _lhsOctxCollect = - ({-# LINE 879 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2815 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 921, column 33) - _lhsOderivings = - ({-# LINE 921 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2821 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - _setIerrors - {-# LINE 2827 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1118, column 37) - _lhsOmoduleDecl = - ({-# LINE 1118 "src-ag/Transform.ag" #-} - mzero - {-# LINE 2833 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 856, column 37) - _lhsOparamsCollect = - ({-# LINE 856 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2839 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 904, column 36) - _lhsOquantCollect = - ({-# LINE 904 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2845 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 796, column 56) - _lhsOsemPragmasCollect = - ({-# LINE 796 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2851 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 596, column 32) - _lhsOtypeSyns = - ({-# LINE 596 "src-ag/Transform.ag" #-} - [] - {-# LINE 2857 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 138, column 15) - _lhsOuseMap = - ({-# LINE 138 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 2863 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 731, column 32) - _lhsOwrappers = - ({-# LINE 731 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 2869 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _lhsIattrDecls - {-# LINE 2875 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _lhsIattrs - {-# LINE 2881 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOdefSets = - ({-# LINE 105 "src-ag/Transform.ag" #-} - _lhsIdefSets - {-# LINE 2887 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _setOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 2893 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _setOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 2899 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _setOdefinedSets = - ({-# LINE 108 "src-ag/Transform.ag" #-} - _lhsIdefinedSets - {-# LINE 2905 "src-ag/Transform.hs" #-} - ) - ( _setIcollectedNames,_setIerrors,_setInontSet) = - set_ _setOallFields _setOallNonterminals _setOdefinedSets - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_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]) ]) - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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 750, column 13) - _lhsOpragmas = - ({-# LINE 750 "src-ag/Transform.ag" #-} - let mk n o = case getName n of - "gencatas" -> o { folds = True } - "nogencatas" -> o { folds = False } - "gendatas" -> o { dataTypes = 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" -> o { sepSemMods = True } - "genlinepragmas" -> o { genLinePragmas = True } - "newtypes" -> o { newtypes = True } - "nonewtypes" -> o { newtypes = False } - "nooptimizations" -> o { noOptimizations = True } - "kennedywarren" -> o { kennedyWarren = True } - "rename" -> o { rename = True } - _ -> o - in \o -> foldr mk o names_ - {-# LINE 2999 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 824, column 55) - _lhsOattrOrderCollect = - ({-# LINE 824 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3005 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 45, column 19) - _lhsOblocks = - ({-# LINE 45 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3011 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 157, column 32) - _lhsOcollectedArounds = - ({-# LINE 157 "src-ag/Transform.ag" #-} - [] - {-# LINE 3017 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 156, column 32) - _lhsOcollectedAugments = - ({-# LINE 156 "src-ag/Transform.ag" #-} - [] - {-# LINE 3023 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 95, column 48) - _lhsOcollectedConstructorsMap = - ({-# LINE 95 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3029 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 126, column 28) - _lhsOcollectedFields = - ({-# LINE 126 "src-ag/Transform.ag" #-} - [] - {-# LINE 3035 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 154, column 32) - _lhsOcollectedInsts = - ({-# LINE 154 "src-ag/Transform.ag" #-} - [] - {-# LINE 3041 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 158, column 32) - _lhsOcollectedMerges = - ({-# LINE 158 "src-ag/Transform.ag" #-} - [] - {-# LINE 3047 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 3053 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 152, column 32) - _lhsOcollectedRules = - ({-# LINE 152 "src-ag/Transform.ag" #-} - [] - {-# LINE 3059 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 86, column 50) - _lhsOcollectedSetNames = - ({-# LINE 86 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 3065 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 153, column 32) - _lhsOcollectedSigs = - ({-# LINE 153 "src-ag/Transform.ag" #-} - [] - {-# LINE 3071 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 155, column 32) - _lhsOcollectedUniques = - ({-# LINE 155 "src-ag/Transform.ag" #-} - [] - {-# LINE 3077 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 879, column 34) - _lhsOctxCollect = - ({-# LINE 879 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3083 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 921, column 33) - _lhsOderivings = - ({-# LINE 921 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3089 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - Seq.empty - {-# LINE 3095 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1118, column 37) - _lhsOmoduleDecl = - ({-# LINE 1118 "src-ag/Transform.ag" #-} - mzero - {-# LINE 3101 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 856, column 37) - _lhsOparamsCollect = - ({-# LINE 856 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3107 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 904, column 36) - _lhsOquantCollect = - ({-# LINE 904 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3113 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 796, column 56) - _lhsOsemPragmasCollect = - ({-# LINE 796 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3119 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 596, column 32) - _lhsOtypeSyns = - ({-# LINE 596 "src-ag/Transform.ag" #-} - [] - {-# LINE 3125 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 138, column 15) - _lhsOuseMap = - ({-# LINE 138 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3131 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 731, column 32) - _lhsOwrappers = - ({-# LINE 731 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 3137 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _lhsIattrDecls - {-# LINE 3143 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _lhsIattrs - {-# LINE 3149 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOdefSets = - ({-# LINE 105 "src-ag/Transform.ag" #-} - _lhsIdefSets - {-# LINE 3155 "src-ag/Transform.hs" #-} - ) - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_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]) ]) - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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 172, column 10) - _altsOnts = - ({-# LINE 172 "src-ag/Transform.ag" #-} - _namesInontSet - {-# LINE 3238 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 883, column 7) - _lhsOctxCollect = - ({-# LINE 883 "src-ag/Transform.ag" #-} - if null ctx_ - then Map.empty - else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] - {-# LINE 3246 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 908, column 7) - _lhsOquantCollect = - ({-# LINE 908 "src-ag/Transform.ag" #-} - if null quants_ - then Map.empty - else Map.fromList [(nt, quants_) | nt <- Set.toList _namesInontSet] - {-# LINE 3254 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 945, column 10) - _attrsOnts = - ({-# LINE 945 "src-ag/Transform.ag" #-} - _namesInontSet - {-# LINE 3260 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 824, column 55) - _lhsOattrOrderCollect = - ({-# LINE 824 "src-ag/Transform.ag" #-} - _altsIattrOrderCollect - {-# LINE 3266 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 45, column 19) - _lhsOblocks = - ({-# LINE 45 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3272 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 157, column 32) - _lhsOcollectedArounds = - ({-# LINE 157 "src-ag/Transform.ag" #-} - _altsIcollectedArounds - {-# LINE 3278 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 156, column 32) - _lhsOcollectedAugments = - ({-# LINE 156 "src-ag/Transform.ag" #-} - _altsIcollectedAugments - {-# LINE 3284 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 95, column 48) - _lhsOcollectedConstructorsMap = - ({-# LINE 95 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3290 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 126, column 28) - _lhsOcollectedFields = - ({-# LINE 126 "src-ag/Transform.ag" #-} - [] - {-# LINE 3296 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 154, column 32) - _lhsOcollectedInsts = - ({-# LINE 154 "src-ag/Transform.ag" #-} - _altsIcollectedInsts - {-# LINE 3302 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 158, column 32) - _lhsOcollectedMerges = - ({-# LINE 158 "src-ag/Transform.ag" #-} - _altsIcollectedMerges - {-# LINE 3308 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - _namesIcollectedNames - {-# LINE 3314 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 152, column 32) - _lhsOcollectedRules = - ({-# LINE 152 "src-ag/Transform.ag" #-} - _altsIcollectedRules - {-# LINE 3320 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 86, column 50) - _lhsOcollectedSetNames = - ({-# LINE 86 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 3326 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 153, column 32) - _lhsOcollectedSigs = - ({-# LINE 153 "src-ag/Transform.ag" #-} - _altsIcollectedSigs - {-# LINE 3332 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 155, column 32) - _lhsOcollectedUniques = - ({-# LINE 155 "src-ag/Transform.ag" #-} - _altsIcollectedUniques - {-# LINE 3338 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 921, column 33) - _lhsOderivings = - ({-# LINE 921 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3344 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - _namesIerrors Seq.>< _attrsIerrors Seq.>< _altsIerrors - {-# LINE 3350 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1118, column 37) - _lhsOmoduleDecl = - ({-# LINE 1118 "src-ag/Transform.ag" #-} - mzero - {-# LINE 3356 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 856, column 37) - _lhsOparamsCollect = - ({-# LINE 856 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3362 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 747, column 34) - _lhsOpragmas = - ({-# LINE 747 "src-ag/Transform.ag" #-} - id - {-# LINE 3368 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 796, column 56) - _lhsOsemPragmasCollect = - ({-# LINE 796 "src-ag/Transform.ag" #-} - _altsIsemPragmasCollect - {-# LINE 3374 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 596, column 32) - _lhsOtypeSyns = - ({-# LINE 596 "src-ag/Transform.ag" #-} - [] - {-# LINE 3380 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 138, column 15) - _lhsOuseMap = - ({-# LINE 138 "src-ag/Transform.ag" #-} - _attrsIuseMap - {-# LINE 3386 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 731, column 32) - _lhsOwrappers = - ({-# LINE 731 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 3392 "src-ag/Transform.hs" #-} - ) - -- copy rule (up) - _lhsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _attrsIattrDecls - {-# LINE 3398 "src-ag/Transform.hs" #-} - ) - -- copy rule (up) - _lhsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _attrsIattrs - {-# LINE 3404 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOdefSets = - ({-# LINE 105 "src-ag/Transform.ag" #-} - _lhsIdefSets - {-# LINE 3410 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _namesOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 3416 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _namesOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 3422 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _namesOdefinedSets = - ({-# LINE 108 "src-ag/Transform.ag" #-} - _lhsIdefinedSets - {-# LINE 3428 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _attrsOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 3434 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _attrsOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 3440 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _attrsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _lhsIattrDecls - {-# LINE 3446 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _attrsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _lhsIattrs - {-# LINE 3452 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _attrsOoptions = - ({-# LINE 39 "src-ag/Transform.ag" #-} - _lhsIoptions - {-# LINE 3458 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _altsOallAttrDecls = - ({-# LINE 825 "src-ag/Transform.ag" #-} - _lhsIallAttrDecls - {-# LINE 3464 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _altsOallAttrs = - ({-# LINE 1210 "src-ag/Transform.ag" #-} - _lhsIallAttrs - {-# LINE 3470 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _altsOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 3476 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _altsOoptions = - ({-# LINE 39 "src-ag/Transform.ag" #-} - _lhsIoptions - {-# LINE 3482 "src-ag/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,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_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]) ]) - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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 552, column 10) - _lhsOcollectedSetNames = - ({-# LINE 552 "src-ag/Transform.ag" #-} - Set.singleton name_ - {-# LINE 3544 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 659, column 13) - __tup3 = - ({-# LINE 659 "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 3563 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 659, column 13) - (_defSets2,_) = - ({-# LINE 659 "src-ag/Transform.ag" #-} - __tup3 - {-# LINE 3569 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 659, column 13) - (_,_errs) = - ({-# LINE 659 "src-ag/Transform.ag" #-} - __tup3 - {-# LINE 3575 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 673, column 9) - _lhsOdefSets = - ({-# LINE 673 "src-ag/Transform.ag" #-} - _defSets2 - {-# LINE 3581 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 673, column 9) - _lhsOerrors = - ({-# LINE 674 "src-ag/Transform.ag" #-} - _errs >< _setIerrors - {-# LINE 3587 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 824, column 55) - _lhsOattrOrderCollect = - ({-# LINE 824 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3593 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 45, column 19) - _lhsOblocks = - ({-# LINE 45 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3599 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 157, column 32) - _lhsOcollectedArounds = - ({-# LINE 157 "src-ag/Transform.ag" #-} - [] - {-# LINE 3605 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 156, column 32) - _lhsOcollectedAugments = - ({-# LINE 156 "src-ag/Transform.ag" #-} - [] - {-# LINE 3611 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 95, column 48) - _lhsOcollectedConstructorsMap = - ({-# LINE 95 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3617 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 126, column 28) - _lhsOcollectedFields = - ({-# LINE 126 "src-ag/Transform.ag" #-} - [] - {-# LINE 3623 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 154, column 32) - _lhsOcollectedInsts = - ({-# LINE 154 "src-ag/Transform.ag" #-} - [] - {-# LINE 3629 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 158, column 32) - _lhsOcollectedMerges = - ({-# LINE 158 "src-ag/Transform.ag" #-} - [] - {-# LINE 3635 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - _setIcollectedNames - {-# LINE 3641 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 152, column 32) - _lhsOcollectedRules = - ({-# LINE 152 "src-ag/Transform.ag" #-} - [] - {-# LINE 3647 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 153, column 32) - _lhsOcollectedSigs = - ({-# LINE 153 "src-ag/Transform.ag" #-} - [] - {-# LINE 3653 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 155, column 32) - _lhsOcollectedUniques = - ({-# LINE 155 "src-ag/Transform.ag" #-} - [] - {-# LINE 3659 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 879, column 34) - _lhsOctxCollect = - ({-# LINE 879 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3665 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 921, column 33) - _lhsOderivings = - ({-# LINE 921 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3671 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1118, column 37) - _lhsOmoduleDecl = - ({-# LINE 1118 "src-ag/Transform.ag" #-} - mzero - {-# LINE 3677 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 856, column 37) - _lhsOparamsCollect = - ({-# LINE 856 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3683 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 747, column 34) - _lhsOpragmas = - ({-# LINE 747 "src-ag/Transform.ag" #-} - id - {-# LINE 3689 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 904, column 36) - _lhsOquantCollect = - ({-# LINE 904 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3695 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 796, column 56) - _lhsOsemPragmasCollect = - ({-# LINE 796 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3701 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 596, column 32) - _lhsOtypeSyns = - ({-# LINE 596 "src-ag/Transform.ag" #-} - [] - {-# LINE 3707 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 138, column 15) - _lhsOuseMap = - ({-# LINE 138 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3713 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 731, column 32) - _lhsOwrappers = - ({-# LINE 731 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 3719 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _lhsIattrDecls - {-# LINE 3725 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _lhsIattrs - {-# LINE 3731 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _setOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 3737 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _setOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 3743 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _setOdefinedSets = - ({-# LINE 108 "src-ag/Transform.ag" #-} - _lhsIdefinedSets - {-# LINE 3749 "src-ag/Transform.hs" #-} - ) - ( _setIcollectedNames,_setIerrors,_setInontSet) = - set_ _setOallFields _setOallNonterminals _setOdefinedSets - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) -sem_Elem_Txt :: Pos -> - Identifier -> - (Maybe NontermIdent) -> - ([String]) -> - T_Elem -sem_Elem_Txt pos_ name_ 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]) ]) - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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 181, column 10) - _blockInfo = - ({-# LINE 181 "src-ag/Transform.ag" #-} - ( let nm = getName name_ - in if nm == "imports" - then BlockImport - else if nm == "optpragmas" - then BlockPragma - else BlockOther - , mbNt_ - ) - {-# LINE 3808 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 189, column 10) - _blockValue = - ({-# LINE 189 "src-ag/Transform.ag" #-} - [(lines_, pos_)] - {-# LINE 3814 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 190, column 10) - _lhsOblocks = - ({-# LINE 190 "src-ag/Transform.ag" #-} - Map.singleton _blockInfo _blockValue - {-# LINE 3820 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 191, column 10) - _lhsOerrors = - ({-# LINE 191 "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 3831 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 824, column 55) - _lhsOattrOrderCollect = - ({-# LINE 824 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3837 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 157, column 32) - _lhsOcollectedArounds = - ({-# LINE 157 "src-ag/Transform.ag" #-} - [] - {-# LINE 3843 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 156, column 32) - _lhsOcollectedAugments = - ({-# LINE 156 "src-ag/Transform.ag" #-} - [] - {-# LINE 3849 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 95, column 48) - _lhsOcollectedConstructorsMap = - ({-# LINE 95 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3855 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 126, column 28) - _lhsOcollectedFields = - ({-# LINE 126 "src-ag/Transform.ag" #-} - [] - {-# LINE 3861 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 154, column 32) - _lhsOcollectedInsts = - ({-# LINE 154 "src-ag/Transform.ag" #-} - [] - {-# LINE 3867 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 158, column 32) - _lhsOcollectedMerges = - ({-# LINE 158 "src-ag/Transform.ag" #-} - [] - {-# LINE 3873 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 3879 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 152, column 32) - _lhsOcollectedRules = - ({-# LINE 152 "src-ag/Transform.ag" #-} - [] - {-# LINE 3885 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 86, column 50) - _lhsOcollectedSetNames = - ({-# LINE 86 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 3891 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 153, column 32) - _lhsOcollectedSigs = - ({-# LINE 153 "src-ag/Transform.ag" #-} - [] - {-# LINE 3897 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 155, column 32) - _lhsOcollectedUniques = - ({-# LINE 155 "src-ag/Transform.ag" #-} - [] - {-# LINE 3903 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 879, column 34) - _lhsOctxCollect = - ({-# LINE 879 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3909 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 921, column 33) - _lhsOderivings = - ({-# LINE 921 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3915 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1118, column 37) - _lhsOmoduleDecl = - ({-# LINE 1118 "src-ag/Transform.ag" #-} - mzero - {-# LINE 3921 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 856, column 37) - _lhsOparamsCollect = - ({-# LINE 856 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3927 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 747, column 34) - _lhsOpragmas = - ({-# LINE 747 "src-ag/Transform.ag" #-} - id - {-# LINE 3933 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 904, column 36) - _lhsOquantCollect = - ({-# LINE 904 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3939 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 796, column 56) - _lhsOsemPragmasCollect = - ({-# LINE 796 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3945 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 596, column 32) - _lhsOtypeSyns = - ({-# LINE 596 "src-ag/Transform.ag" #-} - [] - {-# LINE 3951 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 138, column 15) - _lhsOuseMap = - ({-# LINE 138 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 3957 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 731, column 32) - _lhsOwrappers = - ({-# LINE 731 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 3963 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _lhsIattrDecls - {-# LINE 3969 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _lhsIattrs - {-# LINE 3975 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOdefSets = - ({-# LINE 105 "src-ag/Transform.ag" #-} - _lhsIdefSets - {-# LINE 3981 "src-ag/Transform.hs" #-} - ) - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_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]) ]) - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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 249, column 10) - _lhsOcollectedFields = - ({-# LINE 249 "src-ag/Transform.ag" #-} - map (\(x,y)->(name_, x, y)) _expanded - {-# LINE 4032 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 555, column 11) - _lhsOcollectedNames = - ({-# LINE 555 "src-ag/Transform.ag" #-} - Set.singleton name_ - {-# LINE 4038 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 609, column 11) - _expanded = - ({-# LINE 609 "src-ag/Transform.ag" #-} - case _argType of - List tp -> [(Ident "Cons" pos_, [(Ident "hd" pos_, tp) - ,(Ident "tl" pos_, NT name_ (map getName params_)) - ] - ) - ,(Ident "Nil" pos_, []) - ] - Maybe tp -> [(Ident "Just" pos_, [(Ident "just" pos_, tp) - ] - ) - ,(Ident "Nothing" pos_, []) - ] - Either tp1 tp2 -> [ - (Ident "Left" pos_, [(Ident "left" pos_, tp1) ]) - , (Ident "Right" pos_, [(Ident "right" pos_, tp2) ]) - ] - Map tp1 tp2 -> [ (Ident "Entry" pos_, [ (Ident "key" pos_, tp1) - , (Ident "val" pos_, tp2) - , (Ident "tl" pos_, NT name_ (map getName params_)) - ]) - , (Ident "Nil" pos_, []) - ] - IntMap tp -> [ (Ident "Entry" pos_, [ (Ident "key" pos_, Haskell "Int") - , (Ident "val" pos_, tp) - , (Ident "tl" pos_, NT name_ (map getName params_)) - ]) - , (Ident "Nil" pos_, []) - ] - Tuple xs -> [(Ident "Tuple" pos_, xs)] - {-# LINE 4072 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 638, column 11) - _argType = - ({-# LINE 638 "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) - {-# LINE 4084 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 645, column 11) - _lhsOtypeSyns = - ({-# LINE 645 "src-ag/Transform.ag" #-} - [(name_,_argType)] - {-# LINE 4090 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 866, column 7) - _lhsOparamsCollect = - ({-# LINE 866 "src-ag/Transform.ag" #-} - if null params_ - then Map.empty - else Map.singleton name_ params_ - {-# LINE 4098 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 889, column 7) - _lhsOctxCollect = - ({-# LINE 889 "src-ag/Transform.ag" #-} - if null ctx_ - then Map.empty - else Map.singleton name_ ctx_ - {-# LINE 4106 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 824, column 55) - _lhsOattrOrderCollect = - ({-# LINE 824 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4112 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 45, column 19) - _lhsOblocks = - ({-# LINE 45 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4118 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 157, column 32) - _lhsOcollectedArounds = - ({-# LINE 157 "src-ag/Transform.ag" #-} - [] - {-# LINE 4124 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 156, column 32) - _lhsOcollectedAugments = - ({-# LINE 156 "src-ag/Transform.ag" #-} - [] - {-# LINE 4130 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 95, column 48) - _lhsOcollectedConstructorsMap = - ({-# LINE 95 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4136 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 154, column 32) - _lhsOcollectedInsts = - ({-# LINE 154 "src-ag/Transform.ag" #-} - [] - {-# LINE 4142 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 158, column 32) - _lhsOcollectedMerges = - ({-# LINE 158 "src-ag/Transform.ag" #-} - [] - {-# LINE 4148 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 152, column 32) - _lhsOcollectedRules = - ({-# LINE 152 "src-ag/Transform.ag" #-} - [] - {-# LINE 4154 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 86, column 50) - _lhsOcollectedSetNames = - ({-# LINE 86 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 4160 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 153, column 32) - _lhsOcollectedSigs = - ({-# LINE 153 "src-ag/Transform.ag" #-} - [] - {-# LINE 4166 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 155, column 32) - _lhsOcollectedUniques = - ({-# LINE 155 "src-ag/Transform.ag" #-} - [] - {-# LINE 4172 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 921, column 33) - _lhsOderivings = - ({-# LINE 921 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4178 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - Seq.empty - {-# LINE 4184 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1118, column 37) - _lhsOmoduleDecl = - ({-# LINE 1118 "src-ag/Transform.ag" #-} - mzero - {-# LINE 4190 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 747, column 34) - _lhsOpragmas = - ({-# LINE 747 "src-ag/Transform.ag" #-} - id - {-# LINE 4196 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 904, column 36) - _lhsOquantCollect = - ({-# LINE 904 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4202 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 796, column 56) - _lhsOsemPragmasCollect = - ({-# LINE 796 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4208 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 138, column 15) - _lhsOuseMap = - ({-# LINE 138 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4214 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 731, column 32) - _lhsOwrappers = - ({-# LINE 731 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 4220 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _lhsIattrDecls - {-# LINE 4226 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _lhsIattrs - {-# LINE 4232 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOdefSets = - ({-# LINE 105 "src-ag/Transform.ag" #-} - _lhsIdefSets - {-# LINE 4238 "src-ag/Transform.hs" #-} - ) - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_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]) ]) - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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 734, column 13) - _lhsOwrappers = - ({-# LINE 734 "src-ag/Transform.ag" #-} - _setInontSet - {-# LINE 4292 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 824, column 55) - _lhsOattrOrderCollect = - ({-# LINE 824 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4298 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 45, column 19) - _lhsOblocks = - ({-# LINE 45 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4304 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 157, column 32) - _lhsOcollectedArounds = - ({-# LINE 157 "src-ag/Transform.ag" #-} - [] - {-# LINE 4310 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 156, column 32) - _lhsOcollectedAugments = - ({-# LINE 156 "src-ag/Transform.ag" #-} - [] - {-# LINE 4316 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 95, column 48) - _lhsOcollectedConstructorsMap = - ({-# LINE 95 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4322 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 126, column 28) - _lhsOcollectedFields = - ({-# LINE 126 "src-ag/Transform.ag" #-} - [] - {-# LINE 4328 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 154, column 32) - _lhsOcollectedInsts = - ({-# LINE 154 "src-ag/Transform.ag" #-} - [] - {-# LINE 4334 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 158, column 32) - _lhsOcollectedMerges = - ({-# LINE 158 "src-ag/Transform.ag" #-} - [] - {-# LINE 4340 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - _setIcollectedNames - {-# LINE 4346 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 152, column 32) - _lhsOcollectedRules = - ({-# LINE 152 "src-ag/Transform.ag" #-} - [] - {-# LINE 4352 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 86, column 50) - _lhsOcollectedSetNames = - ({-# LINE 86 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 4358 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 153, column 32) - _lhsOcollectedSigs = - ({-# LINE 153 "src-ag/Transform.ag" #-} - [] - {-# LINE 4364 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 155, column 32) - _lhsOcollectedUniques = - ({-# LINE 155 "src-ag/Transform.ag" #-} - [] - {-# LINE 4370 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 879, column 34) - _lhsOctxCollect = - ({-# LINE 879 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4376 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 921, column 33) - _lhsOderivings = - ({-# LINE 921 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4382 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - _setIerrors - {-# LINE 4388 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1118, column 37) - _lhsOmoduleDecl = - ({-# LINE 1118 "src-ag/Transform.ag" #-} - mzero - {-# LINE 4394 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 856, column 37) - _lhsOparamsCollect = - ({-# LINE 856 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4400 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 747, column 34) - _lhsOpragmas = - ({-# LINE 747 "src-ag/Transform.ag" #-} - id - {-# LINE 4406 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 904, column 36) - _lhsOquantCollect = - ({-# LINE 904 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4412 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 796, column 56) - _lhsOsemPragmasCollect = - ({-# LINE 796 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4418 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 596, column 32) - _lhsOtypeSyns = - ({-# LINE 596 "src-ag/Transform.ag" #-} - [] - {-# LINE 4424 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 138, column 15) - _lhsOuseMap = - ({-# LINE 138 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4430 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _lhsIattrDecls - {-# LINE 4436 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _lhsIattrs - {-# LINE 4442 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOdefSets = - ({-# LINE 105 "src-ag/Transform.ag" #-} - _lhsIdefSets - {-# LINE 4448 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _setOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 4454 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _setOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 4460 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _setOdefinedSets = - ({-# LINE 108 "src-ag/Transform.ag" #-} - _lhsIdefinedSets - {-# LINE 4466 "src-ag/Transform.hs" #-} - ) - ( _setIcollectedNames,_setIerrors,_setInontSet) = - set_ _setOallFields _setOallNonterminals _setOdefinedSets - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_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]) ] - collectedConstructorsMap : Map NontermIdent (Set ConstructorIdent) - collectedFields : [(NontermIdent, ConstructorIdent, FieldMap)] - collectedInsts : [ (NontermIdent, ConstructorIdent, [Identifier]) ] - 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]) ]),(Map NontermIdent (Set ConstructorIdent)),([(NontermIdent, ConstructorIdent, FieldMap)]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (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]) ])),collectedConstructorsMap_Syn_Elems :: !((Map NontermIdent (Set ConstructorIdent))),collectedFields_Syn_Elems :: !(([(NontermIdent, ConstructorIdent, FieldMap)])),collectedInsts_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, [Identifier]) ])),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,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_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 _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _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]) ]) - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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]) ]) - _hdIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _hdIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _hdIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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]) ]) - _tlIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _tlIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _tlIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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 824, column 55) - _lhsOattrOrderCollect = - ({-# LINE 824 "src-ag/Transform.ag" #-} - _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect - {-# LINE 4661 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 45, column 19) - _lhsOblocks = - ({-# LINE 45 "src-ag/Transform.ag" #-} - _hdIblocks `mapUnionWithPlusPlus` _tlIblocks - {-# LINE 4667 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 157, column 32) - _lhsOcollectedArounds = - ({-# LINE 157 "src-ag/Transform.ag" #-} - _hdIcollectedArounds ++ _tlIcollectedArounds - {-# LINE 4673 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 156, column 32) - _lhsOcollectedAugments = - ({-# LINE 156 "src-ag/Transform.ag" #-} - _hdIcollectedAugments ++ _tlIcollectedAugments - {-# LINE 4679 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 95, column 48) - _lhsOcollectedConstructorsMap = - ({-# LINE 95 "src-ag/Transform.ag" #-} - _hdIcollectedConstructorsMap `mapUnionWithSetUnion` _tlIcollectedConstructorsMap - {-# LINE 4685 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 126, column 28) - _lhsOcollectedFields = - ({-# LINE 126 "src-ag/Transform.ag" #-} - _hdIcollectedFields ++ _tlIcollectedFields - {-# LINE 4691 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 154, column 32) - _lhsOcollectedInsts = - ({-# LINE 154 "src-ag/Transform.ag" #-} - _hdIcollectedInsts ++ _tlIcollectedInsts - {-# LINE 4697 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 158, column 32) - _lhsOcollectedMerges = - ({-# LINE 158 "src-ag/Transform.ag" #-} - _hdIcollectedMerges ++ _tlIcollectedMerges - {-# LINE 4703 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - _hdIcollectedNames `Set.union` _tlIcollectedNames - {-# LINE 4709 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 152, column 32) - _lhsOcollectedRules = - ({-# LINE 152 "src-ag/Transform.ag" #-} - _hdIcollectedRules ++ _tlIcollectedRules - {-# LINE 4715 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 86, column 50) - _lhsOcollectedSetNames = - ({-# LINE 86 "src-ag/Transform.ag" #-} - _hdIcollectedSetNames `Set.union` _tlIcollectedSetNames - {-# LINE 4721 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 153, column 32) - _lhsOcollectedSigs = - ({-# LINE 153 "src-ag/Transform.ag" #-} - _hdIcollectedSigs ++ _tlIcollectedSigs - {-# LINE 4727 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 155, column 32) - _lhsOcollectedUniques = - ({-# LINE 155 "src-ag/Transform.ag" #-} - _hdIcollectedUniques ++ _tlIcollectedUniques - {-# LINE 4733 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 879, column 34) - _lhsOctxCollect = - ({-# LINE 879 "src-ag/Transform.ag" #-} - _hdIctxCollect `mergeCtx` _tlIctxCollect - {-# LINE 4739 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 921, column 33) - _lhsOderivings = - ({-# LINE 921 "src-ag/Transform.ag" #-} - _hdIderivings `mergeDerivings` _tlIderivings - {-# LINE 4745 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 4751 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1118, column 37) - _lhsOmoduleDecl = - ({-# LINE 1118 "src-ag/Transform.ag" #-} - _hdImoduleDecl `mplus` _tlImoduleDecl - {-# LINE 4757 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 856, column 37) - _lhsOparamsCollect = - ({-# LINE 856 "src-ag/Transform.ag" #-} - _hdIparamsCollect `mergeParams` _tlIparamsCollect - {-# LINE 4763 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 747, column 34) - _lhsOpragmas = - ({-# LINE 747 "src-ag/Transform.ag" #-} - _hdIpragmas . _tlIpragmas - {-# LINE 4769 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 904, column 36) - _lhsOquantCollect = - ({-# LINE 904 "src-ag/Transform.ag" #-} - _hdIquantCollect `mergeQuant` _tlIquantCollect - {-# LINE 4775 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 796, column 56) - _lhsOsemPragmasCollect = - ({-# LINE 796 "src-ag/Transform.ag" #-} - _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect - {-# LINE 4781 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 596, column 32) - _lhsOtypeSyns = - ({-# LINE 596 "src-ag/Transform.ag" #-} - _hdItypeSyns ++ _tlItypeSyns - {-# LINE 4787 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 138, column 15) - _lhsOuseMap = - ({-# LINE 138 "src-ag/Transform.ag" #-} - _hdIuseMap `merge` _tlIuseMap - {-# LINE 4793 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 731, column 32) - _lhsOwrappers = - ({-# LINE 731 "src-ag/Transform.ag" #-} - _hdIwrappers `Set.union` _tlIwrappers - {-# LINE 4799 "src-ag/Transform.hs" #-} - ) - -- copy rule (up) - _lhsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _tlIattrDecls - {-# LINE 4805 "src-ag/Transform.hs" #-} - ) - -- copy rule (up) - _lhsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _tlIattrs - {-# LINE 4811 "src-ag/Transform.hs" #-} - ) - -- copy rule (up) - _lhsOdefSets = - ({-# LINE 105 "src-ag/Transform.ag" #-} - _tlIdefSets - {-# LINE 4817 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOallAttrDecls = - ({-# LINE 825 "src-ag/Transform.ag" #-} - _lhsIallAttrDecls - {-# LINE 4823 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOallAttrs = - ({-# LINE 1210 "src-ag/Transform.ag" #-} - _lhsIallAttrs - {-# LINE 4829 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOallConstructors = - ({-# LINE 97 "src-ag/Transform.ag" #-} - _lhsIallConstructors - {-# LINE 4835 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 4841 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 4847 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _lhsIattrDecls - {-# LINE 4853 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _lhsIattrs - {-# LINE 4859 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOdefSets = - ({-# LINE 105 "src-ag/Transform.ag" #-} - _lhsIdefSets - {-# LINE 4865 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOdefinedSets = - ({-# LINE 108 "src-ag/Transform.ag" #-} - _lhsIdefinedSets - {-# LINE 4871 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 39 "src-ag/Transform.ag" #-} - _lhsIoptions - {-# LINE 4877 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOallAttrDecls = - ({-# LINE 825 "src-ag/Transform.ag" #-} - _lhsIallAttrDecls - {-# LINE 4883 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOallAttrs = - ({-# LINE 1210 "src-ag/Transform.ag" #-} - _lhsIallAttrs - {-# LINE 4889 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOallConstructors = - ({-# LINE 97 "src-ag/Transform.ag" #-} - _lhsIallConstructors - {-# LINE 4895 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 4901 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 4907 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _tlOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _hdIattrDecls - {-# LINE 4913 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _tlOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _hdIattrs - {-# LINE 4919 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _tlOdefSets = - ({-# LINE 105 "src-ag/Transform.ag" #-} - _hdIdefSets - {-# LINE 4925 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOdefinedSets = - ({-# LINE 108 "src-ag/Transform.ag" #-} - _lhsIdefinedSets - {-# LINE 4931 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 39 "src-ag/Transform.ag" #-} - _lhsIoptions - {-# LINE 4937 "src-ag/Transform.hs" #-} - ) - ( _hdIattrDecls,_hdIattrOrderCollect,_hdIattrs,_hdIblocks,_hdIcollectedArounds,_hdIcollectedAugments,_hdIcollectedConstructorsMap,_hdIcollectedFields,_hdIcollectedInsts,_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,_tlIcollectedConstructorsMap,_tlIcollectedFields,_tlIcollectedInsts,_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,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_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]) ]) - _lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent)) - _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)]) - _lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) - _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 824, column 55) - _lhsOattrOrderCollect = - ({-# LINE 824 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4987 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 45, column 19) - _lhsOblocks = - ({-# LINE 45 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 4993 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 157, column 32) - _lhsOcollectedArounds = - ({-# LINE 157 "src-ag/Transform.ag" #-} - [] - {-# LINE 4999 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 156, column 32) - _lhsOcollectedAugments = - ({-# LINE 156 "src-ag/Transform.ag" #-} - [] - {-# LINE 5005 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 95, column 48) - _lhsOcollectedConstructorsMap = - ({-# LINE 95 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 5011 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 126, column 28) - _lhsOcollectedFields = - ({-# LINE 126 "src-ag/Transform.ag" #-} - [] - {-# LINE 5017 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 154, column 32) - _lhsOcollectedInsts = - ({-# LINE 154 "src-ag/Transform.ag" #-} - [] - {-# LINE 5023 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 158, column 32) - _lhsOcollectedMerges = - ({-# LINE 158 "src-ag/Transform.ag" #-} - [] - {-# LINE 5029 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 5035 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 152, column 32) - _lhsOcollectedRules = - ({-# LINE 152 "src-ag/Transform.ag" #-} - [] - {-# LINE 5041 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 86, column 50) - _lhsOcollectedSetNames = - ({-# LINE 86 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 5047 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 153, column 32) - _lhsOcollectedSigs = - ({-# LINE 153 "src-ag/Transform.ag" #-} - [] - {-# LINE 5053 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 155, column 32) - _lhsOcollectedUniques = - ({-# LINE 155 "src-ag/Transform.ag" #-} - [] - {-# LINE 5059 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 879, column 34) - _lhsOctxCollect = - ({-# LINE 879 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 5065 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 921, column 33) - _lhsOderivings = - ({-# LINE 921 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 5071 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - Seq.empty - {-# LINE 5077 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1118, column 37) - _lhsOmoduleDecl = - ({-# LINE 1118 "src-ag/Transform.ag" #-} - mzero - {-# LINE 5083 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 856, column 37) - _lhsOparamsCollect = - ({-# LINE 856 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 5089 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 747, column 34) - _lhsOpragmas = - ({-# LINE 747 "src-ag/Transform.ag" #-} - id - {-# LINE 5095 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 904, column 36) - _lhsOquantCollect = - ({-# LINE 904 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 5101 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 796, column 56) - _lhsOsemPragmasCollect = - ({-# LINE 796 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 5107 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 596, column 32) - _lhsOtypeSyns = - ({-# LINE 596 "src-ag/Transform.ag" #-} - [] - {-# LINE 5113 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 138, column 15) - _lhsOuseMap = - ({-# LINE 138 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 5119 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 731, column 32) - _lhsOwrappers = - ({-# LINE 731 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 5125 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrDecls = - ({-# LINE 137 "src-ag/Transform.ag" #-} - _lhsIattrDecls - {-# LINE 5131 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOattrs = - ({-# LINE 1220 "src-ag/Transform.ag" #-} - _lhsIattrs - {-# LINE 5137 "src-ag/Transform.hs" #-} - ) - -- copy rule (chain) - _lhsOdefSets = - ({-# LINE 105 "src-ag/Transform.ag" #-} - _lhsIdefSets - {-# LINE 5143 "src-ag/Transform.hs" #-} - ) - in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))) ) --- NontSet ----------------------------------------------------- -{- - visit 0: - inherited attributes: - allFields : DataTypes - allNonterminals : Set NontermIdent - definedSets : DefinedSets - synthesized attributes: - collectedNames : Set Identifier - errors : Seq Error - nontSet : Set NontermIdent - alternatives: - alternative All: - alternative Difference: - child set1 : NontSet - child set2 : NontSet - alternative Intersect: - child set1 : NontSet - child set2 : NontSet - alternative NamedSet: - child name : {NontermIdent} - visit 0: - local _tup4 : _ - local nontSet : _ - local errors : _ - alternative Path: - child from : {NontermIdent} - child to : {NontermIdent} - alternative Union: - child set1 : NontSet - child set2 : NontSet --} --- cata -sem_NontSet :: NontSet -> - T_NontSet -sem_NontSet (All ) = - (sem_NontSet_All ) -sem_NontSet (Difference _set1 _set2 ) = - (sem_NontSet_Difference (sem_NontSet _set1 ) (sem_NontSet _set2 ) ) -sem_NontSet (Intersect _set1 _set2 ) = - (sem_NontSet_Intersect (sem_NontSet _set1 ) (sem_NontSet _set2 ) ) -sem_NontSet (NamedSet _name ) = - (sem_NontSet_NamedSet _name ) -sem_NontSet (Path _from _to ) = - (sem_NontSet_Path _from _to ) -sem_NontSet (Union _set1 _set2 ) = - (sem_NontSet_Union (sem_NontSet _set1 ) (sem_NontSet _set2 ) ) --- semantic domain -newtype T_NontSet = T_NontSet (DataTypes -> - (Set NontermIdent) -> - DefinedSets -> - ( (Set Identifier),(Seq Error),(Set NontermIdent))) -data Inh_NontSet = Inh_NontSet {allFields_Inh_NontSet :: !(DataTypes),allNonterminals_Inh_NontSet :: !((Set NontermIdent)),definedSets_Inh_NontSet :: !(DefinedSets)} -data Syn_NontSet = Syn_NontSet {collectedNames_Syn_NontSet :: !((Set Identifier)),errors_Syn_NontSet :: !((Seq Error)),nontSet_Syn_NontSet :: !((Set NontermIdent))} -wrap_NontSet :: T_NontSet -> - 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_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 677, column 16) - _lhsOnontSet = - ({-# LINE 677 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 5218 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 5224 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - Seq.empty - {-# LINE 5230 "src-ag/Transform.hs" #-} - ) - 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 683, column 16) - _lhsOnontSet = - ({-# LINE 683 "src-ag/Transform.ag" #-} - Set.difference _set1InontSet _set2InontSet - {-# LINE 5259 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - _set1IcollectedNames `Set.union` _set2IcollectedNames - {-# LINE 5265 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - _set1Ierrors Seq.>< _set2Ierrors - {-# LINE 5271 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set1OallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 5277 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set1OallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 5283 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set1OdefinedSets = - ({-# LINE 108 "src-ag/Transform.ag" #-} - _lhsIdefinedSets - {-# LINE 5289 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set2OallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 5295 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set2OallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 5301 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set2OdefinedSets = - ({-# LINE 108 "src-ag/Transform.ag" #-} - _lhsIdefinedSets - {-# LINE 5307 "src-ag/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 682, column 16) - _lhsOnontSet = - ({-# LINE 682 "src-ag/Transform.ag" #-} - Set.intersection _set1InontSet _set2InontSet - {-# LINE 5340 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - _set1IcollectedNames `Set.union` _set2IcollectedNames - {-# LINE 5346 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - _set1Ierrors Seq.>< _set2Ierrors - {-# LINE 5352 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set1OallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 5358 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set1OallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 5364 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set1OdefinedSets = - ({-# LINE 108 "src-ag/Transform.ag" #-} - _lhsIdefinedSets - {-# LINE 5370 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set2OallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 5376 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set2OallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 5382 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set2OdefinedSets = - ({-# LINE 108 "src-ag/Transform.ag" #-} - _lhsIdefinedSets - {-# LINE 5388 "src-ag/Transform.hs" #-} - ) - ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) = - set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets - ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) = - set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets - in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))) ) -sem_NontSet_NamedSet :: NontermIdent -> - T_NontSet -sem_NontSet_NamedSet name_ = - (T_NontSet (\ _lhsIallFields - _lhsIallNonterminals - _lhsIdefinedSets -> - (let _lhsOcollectedNames :: (Set Identifier) - _lhsOerrors :: (Seq Error) - _lhsOnontSet :: (Set NontermIdent) - -- "src-ag/Transform.ag"(line 558, column 14) - _lhsOcollectedNames = - ({-# LINE 558 "src-ag/Transform.ag" #-} - Set.singleton name_ - {-# LINE 5408 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 678, column 20) - __tup4 = - ({-# LINE 678 "src-ag/Transform.ag" #-} - case Map.lookup name_ _lhsIdefinedSets of - Nothing -> (Set.empty, Seq.singleton (UndefNont name_)) - Just set -> (set, Seq.empty) - {-# LINE 5416 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 678, column 20) - (_nontSet,_) = - ({-# LINE 678 "src-ag/Transform.ag" #-} - __tup4 - {-# LINE 5422 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 678, column 20) - (_,_errors) = - ({-# LINE 678 "src-ag/Transform.ag" #-} - __tup4 - {-# LINE 5428 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - _errors - {-# LINE 5434 "src-ag/Transform.hs" #-} - ) - -- copy rule (from local) - _lhsOnontSet = - ({-# LINE 113 "src-ag/Transform.ag" #-} - _nontSet - {-# LINE 5440 "src-ag/Transform.hs" #-} - ) - 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 684, column 16) - _lhsOnontSet = - ({-# LINE 684 "src-ag/Transform.ag" #-} - let table = flattenDatas _lhsIallFields - in path table from_ to_ - {-# LINE 5458 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 686, column 16) - _lhsOerrors = - ({-# LINE 686 "src-ag/Transform.ag" #-} - let check name | Set.member name _lhsIallNonterminals - = Seq.empty - | otherwise = Seq.singleton (UndefNont name) - in check from_ >< check to_ - {-# LINE 5467 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 5473 "src-ag/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 681, column 16) - _lhsOnontSet = - ({-# LINE 681 "src-ag/Transform.ag" #-} - Set.union _set1InontSet _set2InontSet - {-# LINE 5502 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 87, column 50) - _lhsOcollectedNames = - ({-# LINE 87 "src-ag/Transform.ag" #-} - _set1IcollectedNames `Set.union` _set2IcollectedNames - {-# LINE 5508 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - _set1Ierrors Seq.>< _set2Ierrors - {-# LINE 5514 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set1OallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 5520 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set1OallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 5526 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set1OdefinedSets = - ({-# LINE 108 "src-ag/Transform.ag" #-} - _lhsIdefinedSets - {-# LINE 5532 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set2OallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 5538 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set2OallNonterminals = - ({-# LINE 89 "src-ag/Transform.ag" #-} - _lhsIallNonterminals - {-# LINE 5544 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _set2OdefinedSets = - ({-# LINE 108 "src-ag/Transform.ag" #-} - _lhsIdefinedSets - {-# LINE 5550 "src-ag/Transform.hs" #-} - ) - ( _set1IcollectedNames,_set1Ierrors,_set1InontSet) = - set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets - ( _set2IcollectedNames,_set2Ierrors,_set2InontSet) = - set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets - in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))) ) --- Pattern ----------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - definedAttrs : [AttrName] - definedInsts : [Identifier] - patunder : [AttrName]->Pattern - stpos : Pos - alternatives: - alternative Alias: - child field : {Identifier} - child attr : {Identifier} - child pat : Pattern - child parts : Patterns - visit 0: - local copy : _ - alternative Constr: - child name : {ConstructorIdent} - child pats : Patterns - visit 0: - local copy : _ - alternative Irrefutable: - child pat : Pattern - visit 0: - local copy : _ - alternative Product: - child pos : {Pos} - child pats : Patterns - visit 0: - local copy : _ - alternative Underscore: - child pos : {Pos} - visit 0: - local copy : _ --} --- cata -sem_Pattern :: Pattern -> - T_Pattern -sem_Pattern (Alias _field _attr _pat _parts ) = - (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) -sem_Pattern (Constr _name _pats ) = - (sem_Pattern_Constr _name (sem_Patterns _pats ) ) -sem_Pattern (Irrefutable _pat ) = - (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) -sem_Pattern (Product _pos _pats ) = - (sem_Pattern_Product _pos (sem_Patterns _pats ) ) -sem_Pattern (Underscore _pos ) = - (sem_Pattern_Underscore _pos ) --- semantic domain -newtype T_Pattern = T_Pattern (( Pattern ,([AttrName]),([Identifier]),([AttrName]->Pattern),Pos)) -data Inh_Pattern = Inh_Pattern {} -data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern ),definedAttrs_Syn_Pattern :: !(([AttrName])),definedInsts_Syn_Pattern :: !(([Identifier])),patunder_Syn_Pattern :: !(([AttrName]->Pattern)),stpos_Syn_Pattern :: !(Pos)} -wrap_Pattern :: T_Pattern -> - 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_Alias :: Identifier -> - Identifier -> - T_Pattern -> - T_Patterns -> - T_Pattern -sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = - (T_Pattern (let _lhsOdefinedAttrs :: ([AttrName]) - _lhsOpatunder :: ([AttrName]->Pattern) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOstpos :: Pos - _lhsOcopy :: Pattern - _patIcopy :: Pattern - _patIdefinedAttrs :: ([AttrName]) - _patIdefinedInsts :: ([Identifier]) - _patIpatunder :: ([AttrName]->Pattern) - _patIstpos :: Pos - _partsIcopy :: Patterns - _partsIdefinedAttrs :: ([AttrName]) - _partsIdefinedInsts :: ([Identifier]) - _partsIpatunder :: ([AttrName]->Patterns) - -- "src-ag/Transform.ag"(line 1094, column 11) - _lhsOdefinedAttrs = - ({-# LINE 1094 "src-ag/Transform.ag" #-} - (field_, attr_) : _patIdefinedAttrs - {-# LINE 5640 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1095, column 11) - _lhsOpatunder = - ({-# LINE 1095 "src-ag/Transform.ag" #-} - \us -> if ((field_,attr_) `elem` us) then Underscore noPos else _copy - {-# LINE 5646 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1096, column 11) - _lhsOdefinedInsts = - ({-# LINE 1096 "src-ag/Transform.ag" #-} - (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts - {-# LINE 5652 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1111, column 16) - _lhsOstpos = - ({-# LINE 1111 "src-ag/Transform.ag" #-} - getPos field_ - {-# LINE 5658 "src-ag/Transform.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 5664 "src-ag/Transform.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 5670 "src-ag/Transform.hs" #-} - ) - ( _patIcopy,_patIdefinedAttrs,_patIdefinedInsts,_patIpatunder,_patIstpos) = - pat_ - ( _partsIcopy,_partsIdefinedAttrs,_partsIdefinedInsts,_partsIpatunder) = - parts_ - in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)) ) -sem_Pattern_Constr :: ConstructorIdent -> - T_Patterns -> - T_Pattern -sem_Pattern_Constr name_ (T_Patterns pats_ ) = - (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) - _lhsOstpos :: Pos - _lhsOdefinedAttrs :: ([AttrName]) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOcopy :: Pattern - _patsIcopy :: Patterns - _patsIdefinedAttrs :: ([AttrName]) - _patsIdefinedInsts :: ([Identifier]) - _patsIpatunder :: ([AttrName]->Patterns) - -- "src-ag/Transform.ag"(line 1098, column 12) - _lhsOpatunder = - ({-# LINE 1098 "src-ag/Transform.ag" #-} - \us -> Constr name_ (_patsIpatunder us) - {-# LINE 5694 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1109, column 16) - _lhsOstpos = - ({-# LINE 1109 "src-ag/Transform.ag" #-} - getPos name_ - {-# LINE 5700 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1089, column 42) - _lhsOdefinedAttrs = - ({-# LINE 1089 "src-ag/Transform.ag" #-} - _patsIdefinedAttrs - {-# LINE 5706 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - _patsIdefinedInsts - {-# LINE 5712 "src-ag/Transform.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Constr name_ _patsIcopy - {-# LINE 5718 "src-ag/Transform.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 5724 "src-ag/Transform.hs" #-} - ) - ( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) = - pats_ - in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)) ) -sem_Pattern_Irrefutable :: T_Pattern -> - T_Pattern -sem_Pattern_Irrefutable (T_Pattern pat_ ) = - (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) - _lhsOdefinedAttrs :: ([AttrName]) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOcopy :: Pattern - _lhsOstpos :: Pos - _patIcopy :: Pattern - _patIdefinedAttrs :: ([AttrName]) - _patIdefinedInsts :: ([Identifier]) - _patIpatunder :: ([AttrName]->Pattern) - _patIstpos :: Pos - -- "src-ag/Transform.ag"(line 1100, column 17) - _lhsOpatunder = - ({-# LINE 1100 "src-ag/Transform.ag" #-} - \us -> Irrefutable (_patIpatunder us) - {-# LINE 5746 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1089, column 42) - _lhsOdefinedAttrs = - ({-# LINE 1089 "src-ag/Transform.ag" #-} - _patIdefinedAttrs - {-# LINE 5752 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - _patIdefinedInsts - {-# LINE 5758 "src-ag/Transform.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Irrefutable _patIcopy - {-# LINE 5764 "src-ag/Transform.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 5770 "src-ag/Transform.hs" #-} - ) - -- copy rule (up) - _lhsOstpos = - ({-# LINE 1106 "src-ag/Transform.ag" #-} - _patIstpos - {-# LINE 5776 "src-ag/Transform.hs" #-} - ) - ( _patIcopy,_patIdefinedAttrs,_patIdefinedInsts,_patIpatunder,_patIstpos) = - pat_ - in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)) ) -sem_Pattern_Product :: Pos -> - T_Patterns -> - T_Pattern -sem_Pattern_Product pos_ (T_Patterns pats_ ) = - (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) - _lhsOstpos :: Pos - _lhsOdefinedAttrs :: ([AttrName]) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOcopy :: Pattern - _patsIcopy :: Patterns - _patsIdefinedAttrs :: ([AttrName]) - _patsIdefinedInsts :: ([Identifier]) - _patsIpatunder :: ([AttrName]->Patterns) - -- "src-ag/Transform.ag"(line 1099, column 13) - _lhsOpatunder = - ({-# LINE 1099 "src-ag/Transform.ag" #-} - \us -> Product pos_ (_patsIpatunder us) - {-# LINE 5798 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1110, column 16) - _lhsOstpos = - ({-# LINE 1110 "src-ag/Transform.ag" #-} - pos_ - {-# LINE 5804 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1089, column 42) - _lhsOdefinedAttrs = - ({-# LINE 1089 "src-ag/Transform.ag" #-} - _patsIdefinedAttrs - {-# LINE 5810 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - _patsIdefinedInsts - {-# LINE 5816 "src-ag/Transform.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Product pos_ _patsIcopy - {-# LINE 5822 "src-ag/Transform.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 5828 "src-ag/Transform.hs" #-} - ) - ( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) = - pats_ - in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)) ) -sem_Pattern_Underscore :: Pos -> - T_Pattern -sem_Pattern_Underscore pos_ = - (T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern) - _lhsOstpos :: Pos - _lhsOdefinedAttrs :: ([AttrName]) - _lhsOdefinedInsts :: ([Identifier]) - _lhsOcopy :: Pattern - -- "src-ag/Transform.ag"(line 1097, column 16) - _lhsOpatunder = - ({-# LINE 1097 "src-ag/Transform.ag" #-} - \us -> _copy - {-# LINE 5845 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1112, column 16) - _lhsOstpos = - ({-# LINE 1112 "src-ag/Transform.ag" #-} - pos_ - {-# LINE 5851 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1089, column 42) - _lhsOdefinedAttrs = - ({-# LINE 1089 "src-ag/Transform.ag" #-} - [] - {-# LINE 5857 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - [] - {-# LINE 5863 "src-ag/Transform.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - Underscore pos_ - {-# LINE 5869 "src-ag/Transform.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 5875 "src-ag/Transform.hs" #-} - ) - in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)) ) --- Patterns ---------------------------------------------------- -{- - visit 0: - synthesized attributes: - copy : SELF - definedAttrs : [AttrName] - definedInsts : [Identifier] - patunder : [AttrName]->Patterns - alternatives: - alternative Cons: - child hd : Pattern - child tl : Patterns - visit 0: - local copy : _ - alternative Nil: - visit 0: - local copy : _ --} --- cata -sem_Patterns :: Patterns -> - T_Patterns -sem_Patterns list = - (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) ) --- semantic domain -newtype T_Patterns = T_Patterns (( Patterns ,([AttrName]),([Identifier]),([AttrName]->Patterns))) -data Inh_Patterns = Inh_Patterns {} -data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns ),definedAttrs_Syn_Patterns :: !(([AttrName])),definedInsts_Syn_Patterns :: !(([Identifier])),patunder_Syn_Patterns :: !(([AttrName]->Patterns))} -wrap_Patterns :: T_Patterns -> - 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 1104, column 10) - _lhsOpatunder = - ({-# LINE 1104 "src-ag/Transform.ag" #-} - \us -> (_hdIpatunder us) : (_tlIpatunder us) - {-# LINE 5932 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1089, column 42) - _lhsOdefinedAttrs = - ({-# LINE 1089 "src-ag/Transform.ag" #-} - _hdIdefinedAttrs ++ _tlIdefinedAttrs - {-# LINE 5938 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - _hdIdefinedInsts ++ _tlIdefinedInsts - {-# LINE 5944 "src-ag/Transform.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - (:) _hdIcopy _tlIcopy - {-# LINE 5950 "src-ag/Transform.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 5956 "src-ag/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 1103, column 9) - _lhsOpatunder = - ({-# LINE 1103 "src-ag/Transform.ag" #-} - \us -> [] - {-# LINE 5973 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1089, column 42) - _lhsOdefinedAttrs = - ({-# LINE 1089 "src-ag/Transform.ag" #-} - [] - {-# LINE 5979 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - [] - {-# LINE 5985 "src-ag/Transform.hs" #-} - ) - -- self rule - _copy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - [] - {-# LINE 5991 "src-ag/Transform.hs" #-} - ) - -- self rule - _lhsOcopy = - ({-# LINE 23 "src-ag/Patterns.ag" #-} - _copy - {-# LINE 5997 "src-ag/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 800, column 7) - _pragmaNames = - ({-# LINE 800 "src-ag/Transform.ag" #-} - Set.fromList _rulesIpragmaNamesCollect - {-# LINE 6088 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 801, column 7) - _lhsOsemPragmasCollect = - ({-# LINE 801 "src-ag/Transform.ag" #-} - foldr pragmaMapUnion Map.empty [ pragmaMapSingle nt con _pragmaNames - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - ] - {-# LINE 6097 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 829, column 7) - _attrOrders = - ({-# LINE 829 "src-ag/Transform.ag" #-} - [ orderMapSingle nt con _rulesIorderDepsCollect - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - ] - {-# LINE 6106 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 835, column 7) - _lhsOattrOrderCollect = - ({-# LINE 835 "src-ag/Transform.ag" #-} - foldr orderMapUnion Map.empty _attrOrders - {-# LINE 6112 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1013, column 12) - _coninfo = - ({-# LINE 1013 "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 6123 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1020, column 12) - _lhsOerrors = - ({-# LINE 1020 "src-ag/Transform.ag" #-} - Seq.fromList - [ UndefAlt nt con - | (nt, conset, conkeys) <- _coninfo - , con <- Set.toList (Set.difference conset conkeys) - ] - Seq.>< _rulesIerrors - {-# LINE 6134 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1026, column 12) - _lhsOcollectedRules = - ({-# LINE 1026 "src-ag/Transform.ag" #-} - [ (nt,con,r) - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - , r <- _rulesIruleInfos - ] - {-# LINE 6144 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1032, column 12) - _lhsOcollectedSigs = - ({-# LINE 1032 "src-ag/Transform.ag" #-} - [ (nt,con,ts) - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - , ts <- _rulesIsigInfos - ] - {-# LINE 6154 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1039, column 12) - _lhsOcollectedInsts = - ({-# LINE 1039 "src-ag/Transform.ag" #-} - [ (nt,con,_rulesIdefinedInsts) - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - ] - {-# LINE 6163 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1045, column 12) - _lhsOcollectedUniques = - ({-# LINE 1045 "src-ag/Transform.ag" #-} - [ (nt,con,_rulesIuniqueInfos) - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - ] - {-# LINE 6172 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1051, column 12) - _lhsOcollectedAugments = - ({-# LINE 1051 "src-ag/Transform.ag" #-} - [ (nt, con, _rulesIaugmentInfos) - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - ] - {-# LINE 6181 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1057, column 12) - _lhsOcollectedArounds = - ({-# LINE 1057 "src-ag/Transform.ag" #-} - [ (nt, con, _rulesIaroundInfos) - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - ] - {-# LINE 6190 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1063, column 12) - _lhsOcollectedMerges = - ({-# LINE 1063 "src-ag/Transform.ag" #-} - [ (nt, con, _rulesImergeInfos) - | (nt, conset, _) <- _coninfo - , con <- Set.toList conset - ] - {-# LINE 6199 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _rulesOoptions = - ({-# LINE 39 "src-ag/Transform.ag" #-} - _lhsIoptions - {-# LINE 6205 "src-ag/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 824, column 55) - _lhsOattrOrderCollect = - ({-# LINE 824 "src-ag/Transform.ag" #-} - _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect - {-# LINE 6311 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 157, column 32) - _lhsOcollectedArounds = - ({-# LINE 157 "src-ag/Transform.ag" #-} - _hdIcollectedArounds ++ _tlIcollectedArounds - {-# LINE 6317 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 156, column 32) - _lhsOcollectedAugments = - ({-# LINE 156 "src-ag/Transform.ag" #-} - _hdIcollectedAugments ++ _tlIcollectedAugments - {-# LINE 6323 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 154, column 32) - _lhsOcollectedInsts = - ({-# LINE 154 "src-ag/Transform.ag" #-} - _hdIcollectedInsts ++ _tlIcollectedInsts - {-# LINE 6329 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 158, column 32) - _lhsOcollectedMerges = - ({-# LINE 158 "src-ag/Transform.ag" #-} - _hdIcollectedMerges ++ _tlIcollectedMerges - {-# LINE 6335 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 152, column 32) - _lhsOcollectedRules = - ({-# LINE 152 "src-ag/Transform.ag" #-} - _hdIcollectedRules ++ _tlIcollectedRules - {-# LINE 6341 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 153, column 32) - _lhsOcollectedSigs = - ({-# LINE 153 "src-ag/Transform.ag" #-} - _hdIcollectedSigs ++ _tlIcollectedSigs - {-# LINE 6347 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 155, column 32) - _lhsOcollectedUniques = - ({-# LINE 155 "src-ag/Transform.ag" #-} - _hdIcollectedUniques ++ _tlIcollectedUniques - {-# LINE 6353 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 6359 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 796, column 56) - _lhsOsemPragmasCollect = - ({-# LINE 796 "src-ag/Transform.ag" #-} - _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect - {-# LINE 6365 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOallAttrDecls = - ({-# LINE 825 "src-ag/Transform.ag" #-} - _lhsIallAttrDecls - {-# LINE 6371 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOallAttrs = - ({-# LINE 1210 "src-ag/Transform.ag" #-} - _lhsIallAttrs - {-# LINE 6377 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 6383 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOnts = - ({-# LINE 168 "src-ag/Transform.ag" #-} - _lhsInts - {-# LINE 6389 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 39 "src-ag/Transform.ag" #-} - _lhsIoptions - {-# LINE 6395 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOallAttrDecls = - ({-# LINE 825 "src-ag/Transform.ag" #-} - _lhsIallAttrDecls - {-# LINE 6401 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOallAttrs = - ({-# LINE 1210 "src-ag/Transform.ag" #-} - _lhsIallAttrs - {-# LINE 6407 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOallFields = - ({-# LINE 129 "src-ag/Transform.ag" #-} - _lhsIallFields - {-# LINE 6413 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOnts = - ({-# LINE 168 "src-ag/Transform.ag" #-} - _lhsInts - {-# LINE 6419 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 39 "src-ag/Transform.ag" #-} - _lhsIoptions - {-# LINE 6425 "src-ag/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 824, column 55) - _lhsOattrOrderCollect = - ({-# LINE 824 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 6453 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 157, column 32) - _lhsOcollectedArounds = - ({-# LINE 157 "src-ag/Transform.ag" #-} - [] - {-# LINE 6459 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 156, column 32) - _lhsOcollectedAugments = - ({-# LINE 156 "src-ag/Transform.ag" #-} - [] - {-# LINE 6465 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 154, column 32) - _lhsOcollectedInsts = - ({-# LINE 154 "src-ag/Transform.ag" #-} - [] - {-# LINE 6471 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 158, column 32) - _lhsOcollectedMerges = - ({-# LINE 158 "src-ag/Transform.ag" #-} - [] - {-# LINE 6477 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 152, column 32) - _lhsOcollectedRules = - ({-# LINE 152 "src-ag/Transform.ag" #-} - [] - {-# LINE 6483 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 153, column 32) - _lhsOcollectedSigs = - ({-# LINE 153 "src-ag/Transform.ag" #-} - [] - {-# LINE 6489 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 155, column 32) - _lhsOcollectedUniques = - ({-# LINE 155 "src-ag/Transform.ag" #-} - [] - {-# LINE 6495 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - Seq.empty - {-# LINE 6501 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 796, column 56) - _lhsOsemPragmasCollect = - ({-# LINE 796 "src-ag/Transform.ag" #-} - Map.empty - {-# LINE 6507 "src-ag/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 AroundDef: - child ident : {Identifier} - child rhs : {Expression} - alternative AttrOrderBefore: - child before : {[Occurrence]} - child after : {[Occurrence]} - visit 0: - local dependency : _ - alternative AugmentDef: - child ident : {Identifier} - child rhs : {Expression} - alternative Def: - child pos : {Pos} - child mbName : {Maybe Identifier} - child pattern : Pattern - child rhs : {Expression} - child owrt : {Bool} - alternative MergeDef: - child target : {Identifier} - child nt : {Identifier} - child sources : {[Identifier]} - child rhs : {Expression} - alternative SemPragma: - child names : {[NontermIdent]} - alternative TypeDef: - child pos : {Pos} - child ident : {Identifier} - child tp : {Type} - alternative UniqueDef: - child ident : {Identifier} - child ref : {Identifier} --} --- cata -sem_SemDef :: SemDef -> - T_SemDef -sem_SemDef (AroundDef _ident _rhs ) = - (sem_SemDef_AroundDef _ident _rhs ) -sem_SemDef (AttrOrderBefore _before _after ) = - (sem_SemDef_AttrOrderBefore _before _after ) -sem_SemDef (AugmentDef _ident _rhs ) = - (sem_SemDef_AugmentDef _ident _rhs ) -sem_SemDef (Def _pos _mbName _pattern _rhs _owrt ) = - (sem_SemDef_Def _pos _mbName (sem_Pattern _pattern ) _rhs _owrt ) -sem_SemDef (MergeDef _target _nt _sources _rhs ) = - (sem_SemDef_MergeDef _target _nt _sources _rhs ) -sem_SemDef (SemPragma _names ) = - (sem_SemDef_SemPragma _names ) -sem_SemDef (TypeDef _pos _ident _tp ) = - (sem_SemDef_TypeDef _pos _ident _tp ) -sem_SemDef (UniqueDef _ident _ref ) = - (sem_SemDef_UniqueDef _ident _ref ) --- 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_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 1082, column 17) - _lhsOaroundInfos = - ({-# LINE 1082 "src-ag/Transform.ag" #-} - [ (ident_, rhs_) ] - {-# LINE 6608 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1006, column 40) - _lhsOaugmentInfos = - ({-# LINE 1006 "src-ag/Transform.ag" #-} - [] - {-# LINE 6614 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - [] - {-# LINE 6620 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - Seq.empty - {-# LINE 6626 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1008, column 40) - _lhsOmergeInfos = - ({-# LINE 1008 "src-ag/Transform.ag" #-} - [] - {-# LINE 6632 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 837, column 44) - _lhsOorderDepsCollect = - ({-# LINE 837 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 6638 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 806, column 46) - _lhsOpragmaNamesCollect = - ({-# LINE 806 "src-ag/Transform.ag" #-} - [] - {-# LINE 6644 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1003, column 40) - _lhsOruleInfos = - ({-# LINE 1003 "src-ag/Transform.ag" #-} - [] - {-# LINE 6650 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1004, column 40) - _lhsOsigInfos = - ({-# LINE 1004 "src-ag/Transform.ag" #-} - [] - {-# LINE 6656 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1005, column 40) - _lhsOuniqueInfos = - ({-# LINE 1005 "src-ag/Transform.ag" #-} - [] - {-# LINE 6662 "src-ag/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 841, column 7) - _dependency = - ({-# LINE 841 "src-ag/Transform.ag" #-} - [ Dependency b a | b <- before_, a <- after_ ] - {-# LINE 6684 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 842, column 7) - _lhsOorderDepsCollect = - ({-# LINE 842 "src-ag/Transform.ag" #-} - Set.fromList _dependency - {-# LINE 6690 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1007, column 40) - _lhsOaroundInfos = - ({-# LINE 1007 "src-ag/Transform.ag" #-} - [] - {-# LINE 6696 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1006, column 40) - _lhsOaugmentInfos = - ({-# LINE 1006 "src-ag/Transform.ag" #-} - [] - {-# LINE 6702 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - [] - {-# LINE 6708 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - Seq.empty - {-# LINE 6714 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1008, column 40) - _lhsOmergeInfos = - ({-# LINE 1008 "src-ag/Transform.ag" #-} - [] - {-# LINE 6720 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 806, column 46) - _lhsOpragmaNamesCollect = - ({-# LINE 806 "src-ag/Transform.ag" #-} - [] - {-# LINE 6726 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1003, column 40) - _lhsOruleInfos = - ({-# LINE 1003 "src-ag/Transform.ag" #-} - [] - {-# LINE 6732 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1004, column 40) - _lhsOsigInfos = - ({-# LINE 1004 "src-ag/Transform.ag" #-} - [] - {-# LINE 6738 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1005, column 40) - _lhsOuniqueInfos = - ({-# LINE 1005 "src-ag/Transform.ag" #-} - [] - {-# LINE 6744 "src-ag/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 1079, column 17) - _lhsOaugmentInfos = - ({-# LINE 1079 "src-ag/Transform.ag" #-} - [ (ident_, rhs_) ] - {-# LINE 6766 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1007, column 40) - _lhsOaroundInfos = - ({-# LINE 1007 "src-ag/Transform.ag" #-} - [] - {-# LINE 6772 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - [] - {-# LINE 6778 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - Seq.empty - {-# LINE 6784 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1008, column 40) - _lhsOmergeInfos = - ({-# LINE 1008 "src-ag/Transform.ag" #-} - [] - {-# LINE 6790 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 837, column 44) - _lhsOorderDepsCollect = - ({-# LINE 837 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 6796 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 806, column 46) - _lhsOpragmaNamesCollect = - ({-# LINE 806 "src-ag/Transform.ag" #-} - [] - {-# LINE 6802 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1003, column 40) - _lhsOruleInfos = - ({-# LINE 1003 "src-ag/Transform.ag" #-} - [] - {-# LINE 6808 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1004, column 40) - _lhsOsigInfos = - ({-# LINE 1004 "src-ag/Transform.ag" #-} - [] - {-# LINE 6814 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1005, column 40) - _lhsOuniqueInfos = - ({-# LINE 1005 "src-ag/Transform.ag" #-} - [] - {-# LINE 6820 "src-ag/Transform.hs" #-} - ) - in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) ) -sem_SemDef_Def :: Pos -> - (Maybe Identifier) -> - T_Pattern -> - Expression -> - Bool -> - T_SemDef -sem_SemDef_Def pos_ mbName_ (T_Pattern pattern_ ) rhs_ owrt_ = - (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 528, column 3) - _lhsOerrors = - ({-# LINE 528 "src-ag/Transform.ag" #-} - if checkParseRhs _lhsIoptions - then Seq.fromList $ checkRhs rhs_ - else Seq.empty - {-# LINE 6852 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1070, column 10) - _lhsOruleInfos = - ({-# LINE 1070 "src-ag/Transform.ag" #-} - [ (mbName_, _patternIpatunder, rhs_, _patternIdefinedAttrs, owrt_, show _patternIstpos) ] - {-# LINE 6858 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1007, column 40) - _lhsOaroundInfos = - ({-# LINE 1007 "src-ag/Transform.ag" #-} - [] - {-# LINE 6864 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1006, column 40) - _lhsOaugmentInfos = - ({-# LINE 1006 "src-ag/Transform.ag" #-} - [] - {-# LINE 6870 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - _patternIdefinedInsts - {-# LINE 6876 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1008, column 40) - _lhsOmergeInfos = - ({-# LINE 1008 "src-ag/Transform.ag" #-} - [] - {-# LINE 6882 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 837, column 44) - _lhsOorderDepsCollect = - ({-# LINE 837 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 6888 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 806, column 46) - _lhsOpragmaNamesCollect = - ({-# LINE 806 "src-ag/Transform.ag" #-} - [] - {-# LINE 6894 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1004, column 40) - _lhsOsigInfos = - ({-# LINE 1004 "src-ag/Transform.ag" #-} - [] - {-# LINE 6900 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1005, column 40) - _lhsOuniqueInfos = - ({-# LINE 1005 "src-ag/Transform.ag" #-} - [] - {-# LINE 6906 "src-ag/Transform.hs" #-} - ) - ( _patternIcopy,_patternIdefinedAttrs,_patternIdefinedInsts,_patternIpatunder,_patternIstpos) = - pattern_ - 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 528, column 3) - _lhsOerrors = - ({-# LINE 528 "src-ag/Transform.ag" #-} - if checkParseRhs _lhsIoptions - then Seq.fromList $ checkRhs rhs_ - else Seq.empty - {-# LINE 6934 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1085, column 17) - _lhsOmergeInfos = - ({-# LINE 1085 "src-ag/Transform.ag" #-} - [ (target_, nt_, sources_, rhs_) ] - {-# LINE 6940 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1007, column 40) - _lhsOaroundInfos = - ({-# LINE 1007 "src-ag/Transform.ag" #-} - [] - {-# LINE 6946 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1006, column 40) - _lhsOaugmentInfos = - ({-# LINE 1006 "src-ag/Transform.ag" #-} - [] - {-# LINE 6952 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - [] - {-# LINE 6958 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 837, column 44) - _lhsOorderDepsCollect = - ({-# LINE 837 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 6964 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 806, column 46) - _lhsOpragmaNamesCollect = - ({-# LINE 806 "src-ag/Transform.ag" #-} - [] - {-# LINE 6970 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1003, column 40) - _lhsOruleInfos = - ({-# LINE 1003 "src-ag/Transform.ag" #-} - [] - {-# LINE 6976 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1004, column 40) - _lhsOsigInfos = - ({-# LINE 1004 "src-ag/Transform.ag" #-} - [] - {-# LINE 6982 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1005, column 40) - _lhsOuniqueInfos = - ({-# LINE 1005 "src-ag/Transform.ag" #-} - [] - {-# LINE 6988 "src-ag/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 810, column 7) - _lhsOpragmaNamesCollect = - ({-# LINE 810 "src-ag/Transform.ag" #-} - names_ - {-# LINE 7009 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1007, column 40) - _lhsOaroundInfos = - ({-# LINE 1007 "src-ag/Transform.ag" #-} - [] - {-# LINE 7015 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1006, column 40) - _lhsOaugmentInfos = - ({-# LINE 1006 "src-ag/Transform.ag" #-} - [] - {-# LINE 7021 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - [] - {-# LINE 7027 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - Seq.empty - {-# LINE 7033 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1008, column 40) - _lhsOmergeInfos = - ({-# LINE 1008 "src-ag/Transform.ag" #-} - [] - {-# LINE 7039 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 837, column 44) - _lhsOorderDepsCollect = - ({-# LINE 837 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 7045 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1003, column 40) - _lhsOruleInfos = - ({-# LINE 1003 "src-ag/Transform.ag" #-} - [] - {-# LINE 7051 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1004, column 40) - _lhsOsigInfos = - ({-# LINE 1004 "src-ag/Transform.ag" #-} - [] - {-# LINE 7057 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1005, column 40) - _lhsOuniqueInfos = - ({-# LINE 1005 "src-ag/Transform.ag" #-} - [] - {-# LINE 7063 "src-ag/Transform.hs" #-} - ) - 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 535, column 3) - _lhsOerrors = - ({-# LINE 535 "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 7093 "src-ag/Transform.hs" #-} - ) - -- "src-ag/Transform.ag"(line 1073, column 14) - _lhsOsigInfos = - ({-# LINE 1073 "src-ag/Transform.ag" #-} - [ (ident_, tp_) ] - {-# LINE 7099 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1007, column 40) - _lhsOaroundInfos = - ({-# LINE 1007 "src-ag/Transform.ag" #-} - [] - {-# LINE 7105 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1006, column 40) - _lhsOaugmentInfos = - ({-# LINE 1006 "src-ag/Transform.ag" #-} - [] - {-# LINE 7111 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - [] - {-# LINE 7117 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1008, column 40) - _lhsOmergeInfos = - ({-# LINE 1008 "src-ag/Transform.ag" #-} - [] - {-# LINE 7123 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 837, column 44) - _lhsOorderDepsCollect = - ({-# LINE 837 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 7129 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 806, column 46) - _lhsOpragmaNamesCollect = - ({-# LINE 806 "src-ag/Transform.ag" #-} - [] - {-# LINE 7135 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1003, column 40) - _lhsOruleInfos = - ({-# LINE 1003 "src-ag/Transform.ag" #-} - [] - {-# LINE 7141 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1005, column 40) - _lhsOuniqueInfos = - ({-# LINE 1005 "src-ag/Transform.ag" #-} - [] - {-# LINE 7147 "src-ag/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 1076, column 16) - _lhsOuniqueInfos = - ({-# LINE 1076 "src-ag/Transform.ag" #-} - [ (ident_, ref_) ] - {-# LINE 7169 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1007, column 40) - _lhsOaroundInfos = - ({-# LINE 1007 "src-ag/Transform.ag" #-} - [] - {-# LINE 7175 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1006, column 40) - _lhsOaugmentInfos = - ({-# LINE 1006 "src-ag/Transform.ag" #-} - [] - {-# LINE 7181 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - [] - {-# LINE 7187 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - Seq.empty - {-# LINE 7193 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1008, column 40) - _lhsOmergeInfos = - ({-# LINE 1008 "src-ag/Transform.ag" #-} - [] - {-# LINE 7199 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 837, column 44) - _lhsOorderDepsCollect = - ({-# LINE 837 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 7205 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 806, column 46) - _lhsOpragmaNamesCollect = - ({-# LINE 806 "src-ag/Transform.ag" #-} - [] - {-# LINE 7211 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1003, column 40) - _lhsOruleInfos = - ({-# LINE 1003 "src-ag/Transform.ag" #-} - [] - {-# LINE 7217 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1004, column 40) - _lhsOsigInfos = - ({-# LINE 1004 "src-ag/Transform.ag" #-} - [] - {-# LINE 7223 "src-ag/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 1007, column 40) - _lhsOaroundInfos = - ({-# LINE 1007 "src-ag/Transform.ag" #-} - _hdIaroundInfos ++ _tlIaroundInfos - {-# LINE 7305 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1006, column 40) - _lhsOaugmentInfos = - ({-# LINE 1006 "src-ag/Transform.ag" #-} - _hdIaugmentInfos ++ _tlIaugmentInfos - {-# LINE 7311 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - _hdIdefinedInsts ++ _tlIdefinedInsts - {-# LINE 7317 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - _hdIerrors Seq.>< _tlIerrors - {-# LINE 7323 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1008, column 40) - _lhsOmergeInfos = - ({-# LINE 1008 "src-ag/Transform.ag" #-} - _hdImergeInfos ++ _tlImergeInfos - {-# LINE 7329 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 837, column 44) - _lhsOorderDepsCollect = - ({-# LINE 837 "src-ag/Transform.ag" #-} - _hdIorderDepsCollect `Set.union` _tlIorderDepsCollect - {-# LINE 7335 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 806, column 46) - _lhsOpragmaNamesCollect = - ({-# LINE 806 "src-ag/Transform.ag" #-} - _hdIpragmaNamesCollect ++ _tlIpragmaNamesCollect - {-# LINE 7341 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1003, column 40) - _lhsOruleInfos = - ({-# LINE 1003 "src-ag/Transform.ag" #-} - _hdIruleInfos ++ _tlIruleInfos - {-# LINE 7347 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1004, column 40) - _lhsOsigInfos = - ({-# LINE 1004 "src-ag/Transform.ag" #-} - _hdIsigInfos ++ _tlIsigInfos - {-# LINE 7353 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1005, column 40) - _lhsOuniqueInfos = - ({-# LINE 1005 "src-ag/Transform.ag" #-} - _hdIuniqueInfos ++ _tlIuniqueInfos - {-# LINE 7359 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _hdOoptions = - ({-# LINE 39 "src-ag/Transform.ag" #-} - _lhsIoptions - {-# LINE 7365 "src-ag/Transform.hs" #-} - ) - -- copy rule (down) - _tlOoptions = - ({-# LINE 39 "src-ag/Transform.ag" #-} - _lhsIoptions - {-# LINE 7371 "src-ag/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 1007, column 40) - _lhsOaroundInfos = - ({-# LINE 1007 "src-ag/Transform.ag" #-} - [] - {-# LINE 7395 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1006, column 40) - _lhsOaugmentInfos = - ({-# LINE 1006 "src-ag/Transform.ag" #-} - [] - {-# LINE 7401 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1088, column 55) - _lhsOdefinedInsts = - ({-# LINE 1088 "src-ag/Transform.ag" #-} - [] - {-# LINE 7407 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 43, column 19) - _lhsOerrors = - ({-# LINE 43 "src-ag/Transform.ag" #-} - Seq.empty - {-# LINE 7413 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1008, column 40) - _lhsOmergeInfos = - ({-# LINE 1008 "src-ag/Transform.ag" #-} - [] - {-# LINE 7419 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 837, column 44) - _lhsOorderDepsCollect = - ({-# LINE 837 "src-ag/Transform.ag" #-} - Set.empty - {-# LINE 7425 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 806, column 46) - _lhsOpragmaNamesCollect = - ({-# LINE 806 "src-ag/Transform.ag" #-} - [] - {-# LINE 7431 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1003, column 40) - _lhsOruleInfos = - ({-# LINE 1003 "src-ag/Transform.ag" #-} - [] - {-# LINE 7437 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1004, column 40) - _lhsOsigInfos = - ({-# LINE 1004 "src-ag/Transform.ag" #-} - [] - {-# LINE 7443 "src-ag/Transform.hs" #-} - ) - -- use rule "src-ag/Transform.ag"(line 1005, column 40) - _lhsOuniqueInfos = - ({-# LINE 1005 "src-ag/Transform.ag" #-} - [] - {-# LINE 7449 "src-ag/Transform.hs" #-} - ) - in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))) ) diff --git a/dist/build/uuagc/uuagc-tmp/Visage.hs b/dist/build/uuagc/uuagc-tmp/Visage.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/Visage.hs +++ /dev/null @@ -1,768 +0,0 @@ - - --- UUAGC 0.9.39.0.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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Visage.hs" #-} - -{-# LINE 2 "src-ag/VisageSyntax.ag" #-} - -import CommonTypes -import UU.Pretty -import AbstractSyntax -import VisagePatterns -import Expression -{-# LINE 27 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Visage.hs" #-} - -{-# LINE 2 "src-ag/VisagePatterns.ag" #-} - -import UU.Scanner.Position(Pos) -import CommonTypes -{-# LINE 33 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/Visage.hs" #-} - -{-# LINE 2 "src-ag/Expression.ag" #-} - -import UU.Scanner.Position(Pos) -import HsToken -{-# LINE 39 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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 "src-ag/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 "src-ag/Visage.hs" #-} - ) - -- "src-ag/Visage.ag"(line 89, column 18) - _rulesOisLoc = - ({-# LINE 89 "src-ag/Visage.ag" #-} - False - {-# LINE 154 "src-ag/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 "src-ag/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 "src-ag/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 "src-ag/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 "src-ag/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 "src-ag/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 "src-ag/Visage.hs" #-} - ) - in ( _lhsOaterms)) ) --- VisagePattern ----------------------------------------------- -{- - visit 0: - synthesized attribute: - aterm : ATerm - alternatives: - alternative VAlias: - child field : {Identifier} - child attr : {Identifier} - child pat : VisagePattern - alternative VConstr: - child name : {ConstructorIdent} - child pats : VisagePatterns - alternative VProduct: - child pos : {Pos} - child pats : VisagePatterns - alternative VUnderscore: - child pos : {Pos} - alternative VVar: - child field : {Identifier} - child attr : {Identifier} --} --- cata -sem_VisagePattern :: VisagePattern -> - T_VisagePattern -sem_VisagePattern (VAlias _field _attr _pat ) = - (sem_VisagePattern_VAlias _field _attr (sem_VisagePattern _pat ) ) -sem_VisagePattern (VConstr _name _pats ) = - (sem_VisagePattern_VConstr _name (sem_VisagePatterns _pats ) ) -sem_VisagePattern (VProduct _pos _pats ) = - (sem_VisagePattern_VProduct _pos (sem_VisagePatterns _pats ) ) -sem_VisagePattern (VUnderscore _pos ) = - (sem_VisagePattern_VUnderscore _pos ) -sem_VisagePattern (VVar _field _attr ) = - (sem_VisagePattern_VVar _field _attr ) --- 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_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 407 "src-ag/Visage.hs" #-} - ) - ( _patIaterm) = - pat_ - in ( _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 424 "src-ag/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 440 "src-ag/Visage.hs" #-} - ) - ( _patsIaterms) = - pats_ - 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 453 "src-ag/Visage.hs" #-} - ) - 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 466 "src-ag/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 "src-ag/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 "src-ag/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 "src-ag/Visage.hs" #-} - ) - -- "src-ag/Visage.ag"(line 76, column 18) - _locrulesOisLoc = - ({-# LINE 76 "src-ag/Visage.ag" #-} - True - {-# LINE 574 "src-ag/Visage.hs" #-} - ) - -- "src-ag/Visage.ag"(line 77, column 18) - _rulesOisLoc = - ({-# LINE 77 "src-ag/Visage.ag" #-} - False - {-# LINE 580 "src-ag/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 "src-ag/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 "src-ag/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 "src-ag/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 "src-ag/Visage.hs" #-} - ) - -- copy rule (down) - _hdOisLoc = - ({-# LINE 51 "src-ag/Visage.ag" #-} - _lhsIisLoc - {-# LINE 746 "src-ag/Visage.hs" #-} - ) - -- copy rule (down) - _tlOisLoc = - ({-# LINE 51 "src-ag/Visage.ag" #-} - _lhsIisLoc - {-# LINE 752 "src-ag/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 "src-ag/Visage.hs" #-} - ) - in ( _lhsOaterms))) ) diff --git a/dist/build/uuagc/uuagc-tmp/VisagePatterns.hs b/dist/build/uuagc/uuagc-tmp/VisagePatterns.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/VisagePatterns.hs +++ /dev/null @@ -1,42 +0,0 @@ - - --- UUAGC 0.9.39.0.0 (src-ag/VisagePatterns.ag) -module VisagePatterns where -{-# LINE 2 "src-ag/VisagePatterns.ag" #-} - -import UU.Scanner.Position(Pos) -import CommonTypes -{-# LINE 10 "dist/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/VisagePatterns.hs" #-} --- VisagePattern ----------------------------------------------- -{- - alternatives: - alternative VAlias: - child field : {Identifier} - child attr : {Identifier} - child pat : VisagePattern - alternative VConstr: - child name : {ConstructorIdent} - child pats : VisagePatterns - alternative VProduct: - child pos : {Pos} - child pats : VisagePatterns - alternative VUnderscore: - child pos : {Pos} - alternative VVar: - child field : {Identifier} - child attr : {Identifier} --} -data VisagePattern = VAlias (Identifier) (Identifier) (VisagePattern ) - | VConstr (ConstructorIdent) (VisagePatterns ) - | VProduct (Pos) (VisagePatterns ) - | VUnderscore (Pos) - | VVar (Identifier) (Identifier) --- VisagePatterns ---------------------------------------------- -{- - alternatives: - alternative Cons: - child hd : VisagePattern - child tl : VisagePatterns - alternative Nil: --} -type VisagePatterns = [VisagePattern ] diff --git a/dist/build/uuagc/uuagc-tmp/VisageSyntax.hs b/dist/build/uuagc/uuagc-tmp/VisageSyntax.hs deleted file mode 100644 --- a/dist/build/uuagc/uuagc-tmp/VisageSyntax.hs +++ /dev/null @@ -1,97 +0,0 @@ - - --- UUAGC 0.9.39.0.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/src/sdist.29452/uuagc-0.9.39.0/dist/build/uuagc/uuagc-tmp/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/ErrorMessages.ag b/src-ag/ErrorMessages.ag --- a/src-ag/ErrorMessages.ag +++ b/src-ag/ErrorMessages.ag @@ -2,7 +2,6 @@ { import UU.Scanner.Position(Pos) import Pretty -import DepTypes(Trace) import CodeSyntax import CommonTypes } @@ -12,7 +11,7 @@ DATA Error | ParserError pos : {Pos} problem : {String} action : {String} - + | HsParseError pos : {Pos} msg : {String} @@ -37,7 +36,7 @@ con : {ConstructorIdent} field : {Identifier} attr,occ1 : {Identifier} - + | DupRuleName nt : {NontermIdent} con : {ConstructorIdent} nm : {Identifier} @@ -60,7 +59,7 @@ con : {ConstructorIdent} field : {Identifier} attr : {Identifier} - + | MissingNamedRule nt : {NontermIdent} con : {Identifier} name : {Identifier} @@ -99,7 +98,7 @@ attr : {Identifier} o_visit : {Bool} path : {[String]} - + | InstCirc nt : {NontermIdent} con : {ConstructorIdent} attr : {Identifier} @@ -117,17 +116,17 @@ | MissingTypeSig nt : {NontermIdent} con : {ConstructorIdent} attr : {Identifier} - + | MissingInstSig nt : {NontermIdent} con : {ConstructorIdent} attr : {Identifier} - + | DupUnique nt : {NontermIdent} con : {ConstructorIdent} attr : {Identifier} - + | MissingUnique nt : {NontermIdent} attr : {Identifier} - + | MissingSyn nt : {NontermIdent} attr : {Identifier} diff --git a/src-ag/PrintErrorMessages.ag b/src-ag/PrintErrorMessages.ag --- a/src-ag/PrintErrorMessages.ag +++ b/src-ag/PrintErrorMessages.ag @@ -5,7 +5,6 @@ import Pretty import UU.Scanner.Position(Pos(..), noPos) import ErrorMessages -import DepTypes import Options import Data.List(mapAccumL,intersect,(\\)) import GrammarInfo @@ -57,7 +56,7 @@ -ATTR Error [ options:{Options} verbose:{Bool} | | pp :{PP_Doc} +ATTR Error [ options:{Options} verbose:{Bool} | | pp :{PP_Doc} me :SELF ] @@ -65,9 +64,9 @@ ] SEM Errors - | * loc.verbose = verbose @lhs.options + | * loc.verbose = verbose @lhs.options | Cons loc.str = disp @hd.pp 5000 "" - + lhs.pp = if @loc.str `elem` @lhs.dups then @tl.pp else @hd.pp >-< @tl.pp @@ -81,7 +80,7 @@ help = text "" act = text @action in ppError (isError @lhs.options @me) @pos mesg pat help act @lhs.verbose - + | HsParseError lhs.pp = ppError True @pos (text @msg) (text "") (text "") (text "Correct the syntax of the Haskell code.") @lhs.verbose | DupAlt lhs.pp = let mesg = wfill ["Repeated definition for alternative", getName @con @@ -97,7 +96,7 @@ ,"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 @@ -138,7 +137,7 @@ act = wfill [ "The clashing nonterminal set will be ignored." ] in ppError (isError @lhs.options @me) (getPos @name) mesg pat help act @lhs.verbose - + | DupInhAttr lhs.pp = let mesg = wfill ["Repeated declaration of inherited attribute", getName @attr , "of nonterminal", getName @nt, "." ] >-< @@ -157,7 +156,7 @@ ] in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose - + | DupSynAttr lhs.pp = let mesg = wfill ["Repeated declaration of synthesized attribute", getName @attr , "of nonterminal", getName @nt, "." ] >-< @@ -176,7 +175,7 @@ ] in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose - + | DupChild lhs.pp = let mesg = wfill ["Repeated declaration for field", getName @name, "of alternative" ,getName @con, "of nonterminal", getName @nt, "." ] >-< @@ -248,7 +247,7 @@ in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose | UndefNont lhs.pp = 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" @@ -258,7 +257,7 @@ in ppError (isError @lhs.options @me) (getPos @nt) mesg pat help act @lhs.verbose | UndefAlt lhs.pp = let mesg = wfill ["Constructor", getName @con, "of nonterminal" ,getName @nt, "is not defined." - ] + ] pat = "DATA" >#< getName @nt >-< indent 2 ("|" >#< getName @con >#< "...") @@ -271,7 +270,7 @@ | UndefChild lhs.pp = 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 "") >#< "= ...") @@ -296,7 +295,7 @@ ] act = wfill ["The value of the attribute has been set to undefined."] in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose - + | MissingNamedRule lhs.pp = let mesg = wfill ["Missing rule name ", show @name , "in alternative" , getName @con , "of nonterminal",getName @nt ,"." ] @@ -325,7 +324,7 @@ | UndefLocal lhs.pp = 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 >#< "..." ) @@ -340,7 +339,7 @@ | ChildAsLocal lhs.pp = 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 >#< "..." ) @@ -358,7 +357,7 @@ else showAttrUse @field @attr , "at constructor" , getName @con , "of nonterminal",getName @nt, "." - ] + ] pat = "SEM" >#< getName @nt >-< indent 2 ("|" >#< getName @con >#< ". = " >#< "..." >#< ppAttrUse @field @attr >#< "...") @@ -371,15 +370,15 @@ act = wfill ["The generated program will not run."] in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose - | CyclicSet lhs.pp = 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 + | CyclicSet lhs.pp = 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 @lhs.options @me) (getPos @name) mesg pat help act @lhs.verbose - + | CustomError lhs.pp = let pat = text "unknown" help = wfill ["not available."] act = wfill ["unknown"] @@ -396,7 +395,7 @@ 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 @lhs.options @me) (getPos (@attr)) mesg pat help act @lhs.verbose - + | InstCirc lhs.pp = let mesg = wfill ["Circular dependency for inst attribute", getName @attr , "of alternative", getName @con, "of nonterminal", getName @nt] pat = "SEM" >#< getName @nt @@ -439,7 +438,7 @@ ] act = wfill ["The type signatures of semantic functions are not generated."] in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose - + | MissingInstSig lhs.pp = let mesg = wfill ["Type signature needed, but not found for", showAttrDef _INST @attr , "in alternative" , getName @con , "of nonterminal",getName @nt ,"." ]>-< @@ -458,7 +457,7 @@ , 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 @@ -491,7 +490,7 @@ , getName @attr , "at nonterminal" , getName @nt, "." - ] + ] pat = "ATTR" >#< getName @nt >#< "[ | | " >#< getName @attr >#< " : ... ]" help = wfill ["An augment rule for a constructor for nonterminal" , getName @nt @@ -507,35 +506,21 @@ 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 + = if inh == syn then "threaded attribute " ++ getName inh - else "inherited attribute " ++ getName inh ++ " and synthesized attribute " ++getName syn - - -ppTrace :: Trace -> PP_Doc -ppTrace (tr:rest) = wfill [showLineNr (lineNr tr) ++ ":", "SEM", getName (nt tr), "|", getName (prod tr) - , lhsFld tr +.+ lhsAttr tr, "=", "..." +#+ showRhs tr +#+ "..."] - >-< ppTrace rest -ppTrace [] = empty + else "inherited attribute " ++ getName inh ++ " and synthesized attribute " ++getName syn -showRhs :: TraceElem -> String -showRhs tr = if null (getName field) - then "@" ++ getName attr - else "@" ++ (field +.+ attr) - where field = rhsFld tr - attr = rhsAttr tr - showLineNr :: Int -> String showLineNr i | i==(-1) = "CR" | otherwise = show i @@ -546,7 +531,7 @@ | 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 == _LOC = "local attribute " ++ getName a | f == _INST = "inst attribute " ++ getName a | otherwise = "synthesized attribute " ++ getName a ++ " of field " ++ getName f @@ -593,7 +578,7 @@ {- -- old error reporting code - = let + = 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 diff --git a/src-ag/ResolveLocals.ag b/src-ag/ResolveLocals.ag --- a/src-ag/ResolveLocals.ag +++ b/src-ag/ResolveLocals.ag @@ -3,6 +3,13 @@ INCLUDE "Expression.ag" +-- +-- Checks right-hand sides for missing attributes. +-- Attribute references @xxx are now explicitly mapped to @loc.xxx if there is such +-- an attribute in scope. +-- + + imports { import qualified Data.Set as Set diff --git a/src/DepTypes.hs b/src/DepTypes.hs deleted file mode 100644 --- a/src/DepTypes.hs +++ /dev/null @@ -1,141 +0,0 @@ -module DepTypes where - -import CommonTypes - -------------------------------------------------------------------------------- --- Class definitions -------------------------------------------------------------------------------- - -class HasAttrAndField a where - getField :: a -> Identifier - getAttr :: a -> Identifier - -class ContainsTrace a where - addTraceElem :: TraceElem -> a -> a - addTrace :: Trace -> a -> a - -------------------------------------------------------------------------------- --- Vertices -------------------------------------------------------------------------------- - --- kan helaas niet met named fields, want dat levert een conflict op in de uniekheid vd naamgeving. --- ERROR "CommonTypes.hs" (line 44): Repeated definition for selector "nt" - -data Vertex = Local Identifier Identifier Identifier -- lhs nt, constructor, attribute - | LHSInh Identifier Identifier Identifier -- lhs nt, constructor, attribute - | LHSSyn Identifier Identifier Identifier -- lhs nt, constructor, attribute - | ShRHSInh Identifier Identifier Identifier Identifier -- lhs nt, constructor, field, attribute !!rhs nt not known, equal to RHSInh!! - | ShRHSSyn Identifier Identifier Identifier Identifier -- lhs nt, constructor, field, attribute !!rhs nt not known, equal to RHSSyn!! - | RHSInh Identifier Identifier Identifier Identifier Identifier -- rhs nt, lhs nt, constructor, field, attribute - | RHSSyn Identifier Identifier Identifier Identifier Identifier -- rhs nt, lhs nt, constructor, field, attribute - | NTInh Identifier Identifier -- nt, attribute - | NTSyn Identifier Identifier -- nt, attribute - -instance Eq Vertex where - Local lhs1 con1 attr1 == Local lhs2 con2 attr2 = lhs1==lhs2 && con1==con2 && attr1==attr2 - LHSInh lhs1 con1 attr1 == LHSInh lhs2 con2 attr2 = lhs1==lhs2 && con1==con2 && attr1==attr2 - LHSSyn lhs1 con1 attr1 == LHSSyn lhs2 con2 attr2 = lhs1==lhs2 && con1==con2 && attr1==attr2 - ShRHSInh lhs1 con1 name1 attr1 == ShRHSInh lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - ShRHSSyn lhs1 con1 name1 attr1 == ShRHSSyn lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - RHSInh rhs1 lhs1 con1 name1 attr1 == RHSInh rhs2 lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - RHSSyn rhs1 lhs1 con1 name1 attr1 == RHSSyn rhs2 lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - ShRHSInh lhs1 con1 name1 attr1 == RHSInh _ lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - ShRHSSyn lhs1 con1 name1 attr1 == RHSSyn _ lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - RHSInh _ lhs1 con1 name1 attr1 == ShRHSInh lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - RHSSyn _ lhs1 con1 name1 attr1 == ShRHSSyn lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - NTInh nt1 attr1 == NTInh nt2 attr2 = nt1==nt2 && attr1==attr2 - NTSyn nt1 attr1 == NTSyn nt2 attr2 = nt1==nt2 && attr1==attr2 - _ == _ = False - -instance HasAttrAndField Vertex where - getAttr (Local _ _ attr) = attr - getAttr (LHSInh _ _ attr) = attr - getAttr (LHSSyn _ _ attr) = attr - getAttr (ShRHSInh _ _ _ attr) = attr - getAttr (ShRHSSyn _ _ _ attr) = attr - getAttr (RHSInh _ _ _ _ attr) = attr - getAttr (RHSSyn _ _ _ _ attr) = attr - getAttr (NTInh _ attr) = attr - getAttr (NTSyn _ attr) = attr - getField (Local _ _ _) = nullIdent - getField (LHSInh _ _ _) = _LHS - getField (LHSSyn _ _ _) = _LHS - getField (ShRHSInh _ _ fld _) = fld - getField (ShRHSSyn _ _ fld _) = fld - getField (RHSInh _ _ _ fld _) = fld - getField (RHSSyn _ _ _ fld _) = fld - getField (NTInh _ _) = nullIdent - getField (NTSyn _ _) = nullIdent - -instance Show Vertex where - show (Local lhs con attr) = show lhs ++ "." ++ show attr ++ "(L," ++ show lhs ++ "." ++ show con ++ ")" - show (LHSInh lhs con attr) = show lhs ++ "." ++ show attr ++ "(I," ++ show lhs ++ "." ++ show con ++ ".lhs)" - show (LHSSyn lhs con attr) = show lhs ++ "." ++ show attr ++ "(S," ++ show lhs ++ "." ++ show con ++ ".lhs)" - show (ShRHSInh lhs con name attr) = "" - show (ShRHSSyn lhs con name attr) = "" - show (RHSInh rhs lhs con name attr) = show rhs ++ "." ++ show attr ++ "(I," ++ show lhs ++ "." ++ show con ++ "." ++ show name ++ ")" - show (RHSSyn rhs lhs con name attr) = show rhs ++ "." ++ show attr ++ "(S," ++ show lhs ++ "." ++ show con ++ "." ++ show name ++ ")" - show (NTInh nt attr) = "" - show (NTSyn nt attr) = "" - - -------------------------------------------------------------------------------- --- Streams, results -------------------------------------------------------------------------------- - -type UseStream = (Vertex,Stream) -type Stream = [Result] -type Result = ([UsedAttr],[UsedAttr]) -data UsedAttr = Loc Identifier Identifier Trace -- field name and attribute name - | Glo Identifier Trace -- attribute name - --- lhs en rhs slaan op de lhs en rhs van een attribute equation en niet van de productie!! -data TraceElem = TE { lineNr :: Int - , nt :: NontermIdent - , prod :: Identifier - , lhsNt :: NontermIdent - , lhsFld :: Identifier - , lhsAttr :: Identifier - , rhsFld :: Identifier - , rhsAttr :: Identifier } deriving Show - -type Trace = [TraceElem] - -getTrace :: UsedAttr -> Trace -getTrace (Loc _ _ trace) = trace -getTrace (Glo _ trace) = trace - -toPair :: UsedAttr -> (Identifier,Trace) -toPair (Loc _ attr trace) = (attr,trace) -toPair (Glo attr trace) = (attr,trace) - --- de Eq op Res negeert de trace, want dit is geen onderdeel van het resultaat, maar een oorzaak ervan. --- hierdoor kan gewoon de elem functie op sets van resultaten gebruikt worden. -instance Eq UsedAttr where - Loc fld1 attr1 _ == Loc fld2 attr2 _ = fld1==fld2 && attr1==attr2 - Glo attr1 _ == Glo attr2 _ = attr1==attr2 - _ == _ = False - -instance Show UsedAttr where - show (Loc fld attr trace) = "(" ++ show fld ++ "," ++ show attr ++ ")" - show (Glo attr trace) = show attr - -instance HasAttrAndField UsedAttr where - getAttr (Loc _ attr _) = attr - getAttr (Glo attr _) = attr - getField (Loc fld attr _) = fld - getField _ = nullIdent - -instance ContainsTrace UsedAttr where - addTraceElem newtre (Loc fld attr oldtr) = Loc fld attr (newtre:oldtr) - addTraceElem newtre (Glo attr oldtr) = Glo attr (newtre:oldtr) - addTrace newtr (Loc fld attr oldtr) = Loc fld attr (newtr++oldtr) - addTrace newtr (Glo attr oldtr) = Glo attr (newtr++oldtr) - -instance ContainsTrace Result where - addTraceElem newcs (set,upd) = (map (addTraceElem newcs) set,map (addTraceElem newcs) upd) - addTrace newcss (set,upd) = (map (addTrace newcss) set,map (addTrace newcss) upd) - -instance ContainsTrace Stream where - addTraceElem newcs stream = map (addTraceElem newcs) stream - addTrace newcss stream = map (addTrace newcss) stream diff --git a/src/Scanner.hs b/src/Scanner.hs --- a/src/Scanner.hs +++ b/src/Scanner.hs @@ -1,5 +1,5 @@ {-# LANGUAGE MagicHash, - UnboxedTuples #-} + UnboxedTuples, FlexibleInstances #-} module Scanner where import GHC.Prim import TokenDef diff --git a/src/Streaming.hs b/src/Streaming.hs deleted file mode 100644 --- a/src/Streaming.hs +++ /dev/null @@ -1,107 +0,0 @@ -module Streaming where - -import CommonTypes(Name) -import DepTypes -import List(partition) -import Data.Maybe(fromMaybe,fromJust) - -mapp :: (a -> b) -> (a,a) -> (b,b) -mapp f (l,r) = (f l,f r) - --- vervangt nub, bepaald wel de nub maar accumuleert tevens de causes -reduce :: [UsedAttr] -> [UsedAttr] -reduce set = red set [] where - red (res:rest) set' = red rest (r res set') - red [] set' = set' - r res [] = [res] - r (r1@(Loc f1 a1 c1)) ((r2@(Loc f2 a2 c2)):rest) = if f1==f2 && a1==a2 - then if length c1 < length c2 - then (Loc f2 a2 c1):rest - else r2:rest - else r2:(r r1 rest) - r (r1@(Glo a1 c1)) ((r2@(Glo a2 c2)):rest) = if a1==a2 - then if length c1 < length c2 - then (Glo a2 c1):rest - else r2:rest - else r2:(r r1 rest) - r (r1@(Loc f1 a1 c1)) ((r2@(Glo a2 c2)):rest) = r2:(r r1 rest) - r (r1@(Glo a1 c1)) ((r2@(Loc f2 a2 c2)):rest) = r2:(r r1 rest) - --- NB: de rechter (update-) zijde van een streamelement is nooit bevat in de linker (set-) zijde!! --- nieuwe update set (nu) is de concat van linker en rechter (lu & ru), maar met de al gevonden resultaten (ls' & rs') eruit gefilterd (lu' & ru'). --- deze al gevonden resultaten kunnen onbekende causes bevatten, zijn worden daarom meegenomen in de reductie van de al gevonden resltaten (ls & rs). --- deze resultaten zijn dus 100% zeker dubbel, maar worden meegenomen voor bepaling van de causes in het nieuwe resultaat -stUnion :: Stream -> Stream -> Stream -stUnion [] _ = [] -stUnion _ [] = [] -stUnion ((ls,lu):lr) ((rs,ru):rr) = (ns,nu):nr where - (lu',ls') = partition (flip notElem rs) lu - (ru',rs') = partition (flip notElem ls) ru - nu = lu' ++ ru' - ns = reduce (ls++ls'++rs++rs') - nr = stUnion lr rr - -{- --- oude versie, met nub ipv reduce -stUnion :: Stream -> Stream -> Stream -stUnion [] _ = [] -stUnion _ [] = [] -stUnion ((xset,xupd):xrest) ((yset,yupd):yrest) = (nub (xset++yset),new):(stUnion xrest yrest) where - new = (filter (flip notElem yset) xupd) ++ (filter (flip notElem xset) yupd) --} - -{- --- de x wordt gebruikt om te kijken of de poort open staat, de y wordt doorgegeven als de poort openstaat --- ouder versie, zonder kortste cause -stPort :: Name -> Stream -> Stream -> Stream -stPort attr ((xset,xupd):xrest) ((yset,yupd):yrest) = case lookup attr (map toPair xupd) of - Just causes -> addTrace causes (([],yset++yupd):yrest) - Nothing -> ([],[]):(stPort attr xrest yrest) --} --- de x wordt gebruikt om te kijken of de poort open staat, de y wordt doorgegeven als de poort openstaat --- de recursieve aanroep van stPortRest wordt gedaan om in het uiteindelijke resultaat de kortste cause te krijgen --- waarom de cause niet initiëel de kortste is, weet ik niet. Maar er worden wel kortere causes gevonden later in het proces -{- -stPort :: Name -> Stream -> Stream -> Stream -stPort attr ((xset,xupd):xrest) ((yset,yupd):yrest) = case lookup attr (map toPair xupd) of - Just causes -> (addTrace causes ([],yset++yupd)):(stPortRest attr xrest yrest) - Nothing -> ([],[]):(stPort attr xrest yrest) - where - stPortRest attr ((xset,xupd):xrest) (y:yrest) = case lookup attr (map toPair xset) of - Just causes -> (addTrace causes y):(stPortRest attr xrest yrest) - Nothing -> (error "Dit mag nooit gebeuren!" ([],[])):(stPortRest attr xrest yrest) --} - - --- 20 januari: herschrijving van bovenstaande versie in 1 functie (zonder where)... -stPort :: Name -> Stream -> Stream -> Stream -stPort attr ((xset,xupd):xrest) ((yset,yupd):yrest) = case lookup attr (map toPair xupd) of - Just causes -> (addTrace causes ([],yset++yupd)):(zipWith (\(xset,xupd) y -> addTrace (fromJust . lookup attr . map toPair $ xset) y) xrest yrest) - Nothing -> ([],[]):(stPort attr xrest yrest) - --- stStart biedt geen functionaliteit voor een initiële cause, want er zijn geen initiële causes: --- het begin van een stream is namelijk altijd een attribuut dat zichzelf bepaalt. Dat heeft geen oorzaak nodig. -stStart :: Name -> Name -> Stream -stStart field attr = first:(repeat other) where - first = ([],[Loc field attr []]) - other = ([Loc field attr []],[]) - -stEmpty :: Stream -stEmpty = repeat ([],[]) - -getStream :: Vertex -> [UseStream] -> Stream -getStream vertex streams = fromMaybe stEmpty (lookup vertex streams) - -stLocal2global :: Stream -> Stream -stLocal2global = map (mapp (map (\res -> Glo (getAttr res) (getTrace res)))) --- de nub hoeft niet, want het filter op fieldname van een lokaal resultaat filtert doublures er al uit ---stLocal2global = map (mapp (nub . (map (\res -> Glo (getAttr res))))) - -stFilterInclSide :: UseStream -> Stream -stFilterInclSide (vertex,stream) = stFilterOnField ((getField vertex)==) stream - -stFilterExclSide :: UseStream -> Stream -stFilterExclSide (vertex,stream) = stFilterOnField ((getField vertex)/=) stream - -stFilterOnField :: (Name -> Bool) -> Stream -> Stream -stFilterOnField f = map (mapp (filter (f . getField))) diff --git a/src/TokenDef.hs b/src/TokenDef.hs --- a/src/TokenDef.hs +++ b/src/TokenDef.hs @@ -1,5 +1,5 @@ {-# LANGUAGE MagicHash, - UnboxedTuples #-} + UnboxedTuples, FlexibleInstances #-} module TokenDef where @@ -22,7 +22,6 @@ - instance Symbol Token where deleteCost (Reserved key _) = case key of @@ -44,7 +43,6 @@ TkError -> 0# _ -> 5# - tokensToStrings :: [HsToken] -> [(Pos,String)] diff --git a/uuagc.cabal b/uuagc.cabal --- a/uuagc.cabal +++ b/uuagc.cabal @@ -2,9 +2,9 @@ build-type: Custom x-bootstrap-build-type: Simple name: uuagc -version: 0.9.39.0 x-bootstrap-name: uuagc-bootstrap -x-bootstrap-version: 0.9.39.0.0 +version: 0.9.39.1 +x-bootstrap-version: 0.9.39.1.0 license: BSD3 license-file: LICENSE maintainer: Arie Middelkoop @@ -21,8 +21,8 @@ extra-source-files: uuagc_options executable uuagc - build-depends: uuagc-bootstrap >= 0.9.39.0.0 - build-depends: uuagc-cabal >= 1.0.0.2 + build-depends: uuagc-bootstrap >= 0.9.39.1.0 + build-depends: uuagc-cabal >= 1.0.0.4 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 @@ -31,7 +31,6 @@ main-is: Ag.hs other-modules: Ag , CommonTypes - , DepTypes , GrammarInfo , HsTokenScanner , Options @@ -41,7 +40,6 @@ , Scanner , SequentialComputation , SequentialTypes - , Streaming , TokenDef , Version , AbstractSyntax @@ -90,4 +88,6 @@ hs-source-dirs: src x-bootstrap-hs-source-dirs: src exposed-modules: UU.UUAGC.Version + other-modules: Paths_uuagc + x-bootstrap-other-modules: Paths_uuagc_bootstrap x-bootstrap-exposed-modules: UU.UUAGC.BootstrapVersion