uuagc 0.9.38.3 → 0.9.38.4
raw patch · 6 files changed
+2037/−3 lines, 6 files
Files
- src-derived/KWOrder.hs +1469/−0
- src/KennedyWarren.hs +117/−0
- src/Knuth1.hs +445/−0
- src/Version.hs +1/−1
- uuagc.cabal +4/−1
- uuagc.cabal-for-ghc-6.6 +1/−1
+ src-derived/KWOrder.hs view
@@ -0,0 +1,1469 @@+++-- UUAGC 0.9.38.1 (KWOrder.ag)+module KWOrder where+{-# LINE 6 "KWOrder.ag" #-}++import AbstractSyntax+import HsToken+import Expression+import Patterns+import Options+import PPUtil+import Pretty+import Knuth1+import KennedyWarren+import Maybe+import qualified Data.Set as Set+import qualified Data.Map as Map+{-# LINE 20 "../src-derived/KWOrder.hs" #-}++{-# LINE 2 "./AbstractSyntax.ag" #-}++-- AbstractSyntax.ag imports+import Data.Set(Set)+import Data.Map(Map)+import Patterns (Pattern(..),Patterns)+import Expression (Expression(..))+import CommonTypes+{-# LINE 30 "../src-derived/KWOrder.hs" #-}++{-# LINE 2 "./HsToken.ag" #-}++import CommonTypes+import UU.Scanner.Position(Pos)+{-# LINE 36 "../src-derived/KWOrder.hs" #-}++{-# LINE 2 "./Expression.ag" #-}++import UU.Scanner.Position(Pos)+import HsToken+{-# LINE 42 "../src-derived/KWOrder.hs" #-}++{-# LINE 2 "./Patterns.ag" #-}++-- Patterns.ag imports+import UU.Scanner.Position(Pos)+import CommonTypes (ConstructorIdent,Identifier)+{-# LINE 49 "../src-derived/KWOrder.hs" #-}+-- Child -------------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ 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 (( (Set.Set Edge),([(Identifier, Identifier)]),(Set.Set Vertex)))+data Inh_Child = Inh_Child {}+data Syn_Child = Syn_Child {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 ( _lhsOedges,_lhsOnontnames,_lhsOvertices) = sem + in (Syn_Child _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 _lhsOvertices :: (Set.Set Vertex)+ _lhsOedges :: (Set.Set Edge)+ _lhsOnontnames :: ([(Identifier, Identifier)])+ -- "KWOrder.ag"(line 76, column 12)+ _vertex =+ ({-# LINE 76 "KWOrder.ag" #-}+ VChild name_+ {-# LINE 100 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 77, column 12)+ _synvertices =+ ({-# LINE 77 "KWOrder.ag" #-}+ map (VAttr Syn name_) . Map.keys $ syn_+ {-# LINE 106 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 78, column 12)+ _inhvertices =+ ({-# LINE 78 "KWOrder.ag" #-}+ map (VAttr Inh name_) . Map.keys $ inh_+ {-# LINE 112 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 79, column 12)+ _lhsOvertices =+ ({-# LINE 79 "KWOrder.ag" #-}+ case tp_ of+ NT _ _ -> Set.insert _vertex (Set.fromList $ _synvertices ++ _inhvertices )+ _ -> Set.empty+ {-# LINE 120 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 104, column 12)+ _edgesout =+ ({-# LINE 104 "KWOrder.ag" #-}+ []+ {-# LINE 126 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 105, column 12)+ _edgesin =+ ({-# LINE 105 "KWOrder.ag" #-}+ map (flip (,) _vertex ) _synvertices+ {-# LINE 132 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 106, column 12)+ _lhsOedges =+ ({-# LINE 106 "KWOrder.ag" #-}+ Set.fromList $ _edgesout ++ _edgesin+ {-# LINE 138 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 116, column 12)+ _lhsOnontnames =+ ({-# LINE 116 "KWOrder.ag" #-}+ case tp_ of+ NT nont _ -> [(name_, nont)]+ _ -> []+ {-# LINE 146 "KWOrder.hs" #-}+ )+ in ( _lhsOedges,_lhsOnontnames,_lhsOvertices)) )+-- Children ----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ 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 (( (Set.Set Edge),([(Identifier, Identifier)]),(Set.Set Vertex)))+data Inh_Children = Inh_Children {}+data Syn_Children = Syn_Children {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 ( _lhsOedges,_lhsOnontnames,_lhsOvertices) = sem + in (Syn_Children _lhsOedges _lhsOnontnames _lhsOvertices ))+sem_Children_Cons :: T_Child ->+ T_Children ->+ T_Children +sem_Children_Cons (T_Child hd_ ) (T_Children tl_ ) =+ (T_Children (let _lhsOedges :: (Set.Set Edge)+ _lhsOnontnames :: ([(Identifier, Identifier)])+ _lhsOvertices :: (Set.Set Vertex)+ _hdIedges :: (Set.Set Edge)+ _hdInontnames :: ([(Identifier, Identifier)])+ _hdIvertices :: (Set.Set Vertex)+ _tlIedges :: (Set.Set Edge)+ _tlInontnames :: ([(Identifier, Identifier)])+ _tlIvertices :: (Set.Set Vertex)+ -- use rule "KWOrder.ag"(line 94, column 33)+ _lhsOedges =+ ({-# LINE 94 "KWOrder.ag" #-}+ _hdIedges `Set.union` _tlIedges+ {-# LINE 194 "KWOrder.hs" #-}+ )+ -- use rule "KWOrder.ag"(line 113, column 37)+ _lhsOnontnames =+ ({-# LINE 113 "KWOrder.ag" #-}+ _hdInontnames ++ _tlInontnames+ {-# LINE 200 "KWOrder.hs" #-}+ )+ -- use rule "KWOrder.ag"(line 52, column 36)+ _lhsOvertices =+ ({-# LINE 52 "KWOrder.ag" #-}+ _hdIvertices `Set.union` _tlIvertices+ {-# LINE 206 "KWOrder.hs" #-}+ )+ ( _hdIedges,_hdInontnames,_hdIvertices) =+ hd_ + ( _tlIedges,_tlInontnames,_tlIvertices) =+ tl_ + in ( _lhsOedges,_lhsOnontnames,_lhsOvertices)) )+sem_Children_Nil :: T_Children +sem_Children_Nil =+ (T_Children (let _lhsOedges :: (Set.Set Edge)+ _lhsOnontnames :: ([(Identifier, Identifier)])+ _lhsOvertices :: (Set.Set Vertex)+ -- use rule "KWOrder.ag"(line 94, column 33)+ _lhsOedges =+ ({-# LINE 94 "KWOrder.ag" #-}+ Set.empty+ {-# LINE 222 "KWOrder.hs" #-}+ )+ -- use rule "KWOrder.ag"(line 113, column 37)+ _lhsOnontnames =+ ({-# LINE 113 "KWOrder.ag" #-}+ []+ {-# LINE 228 "KWOrder.hs" #-}+ )+ -- use rule "KWOrder.ag"(line 52, column 36)+ _lhsOvertices =+ ({-# LINE 52 "KWOrder.ag" #-}+ Set.empty+ {-# LINE 234 "KWOrder.hs" #-}+ )+ in ( _lhsOedges,_lhsOnontnames,_lhsOvertices)) )+-- Expression --------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ vertices : Set.Set Vertex+ 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 Vertex)))+data Inh_Expression = Inh_Expression {}+data Syn_Expression = Syn_Expression {vertices_Syn_Expression :: (Set.Set Vertex)}+wrap_Expression :: T_Expression ->+ Inh_Expression ->+ Syn_Expression +wrap_Expression (T_Expression sem ) (Inh_Expression ) =+ (let ( _lhsOvertices) = sem + in (Syn_Expression _lhsOvertices ))+sem_Expression_Expression :: Pos ->+ ([HsToken]) ->+ T_Expression +sem_Expression_Expression pos_ tks_ =+ (T_Expression (let _lhsOvertices :: (Set.Set Vertex)+ -- "KWOrder.ag"(line 63, column 17)+ _lhsOvertices =+ ({-# LINE 63 "KWOrder.ag" #-}+ Set.unions $ map (\tok -> vertices_Syn_HsToken+ (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_+ {-# LINE 272 "KWOrder.hs" #-}+ )+ in ( _lhsOvertices)) )+-- Grammar -----------------------------------------------------+{-+ visit 0:+ inherited attribute:+ options : Options+ synthesized attribute:+ debugoutput : 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))+data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: Options}+data Syn_Grammar = Syn_Grammar {debugoutput_Syn_Grammar :: PP_Doc}+wrap_Grammar :: T_Grammar ->+ Inh_Grammar ->+ Syn_Grammar +wrap_Grammar (T_Grammar sem ) (Inh_Grammar _lhsIoptions ) =+ (let ( _lhsOdebugoutput) = sem _lhsIoptions + in (Syn_Grammar _lhsOdebugoutput ))+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+ _lhsOdebugoutput :: PP_Doc+ _nontsIdepinfo :: ([NontDependencyInformation])+ _nontsIrulenumber :: Int+ -- "KWOrder.ag"(line 39, column 14)+ _nontsOrulenumber =+ ({-# LINE 39 "KWOrder.ag" #-}+ 0+ {-# LINE 340 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 160, column 14)+ _lhsOdebugoutput =+ ({-# LINE 160 "KWOrder.ag" #-}+ kennedyWarrenIO _nontsIdepinfo+ {-# LINE 346 "KWOrder.hs" #-}+ )+ ( _nontsIdepinfo,_nontsIrulenumber) =+ nonts_ _nontsOrulenumber + in ( _lhsOdebugoutput))) )+-- 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)+ -- "KWOrder.ag"(line 57, column 14)+ _lhsOvertices =+ ({-# LINE 57 "KWOrder.ag" #-}+ Set.singleton $ VAttr (if field_ == _LHS then Inh+ else if field_ == _LOC then Loc+ else Syn) field_ attr_+ {-# LINE 417 "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)+ -- "KWOrder.ag"(line 56, column 14)+ _lhsOvertices =+ ({-# LINE 56 "KWOrder.ag" #-}+ Set.singleton $ VAttr Loc _LOC var_+ {-# LINE 430 "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 "KWOrder.ag"(line 52, column 36)+ _lhsOvertices =+ ({-# LINE 52 "KWOrder.ag" #-}+ Set.empty+ {-# LINE 442 "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 "KWOrder.ag"(line 52, column 36)+ _lhsOvertices =+ ({-# LINE 52 "KWOrder.ag" #-}+ Set.empty+ {-# LINE 454 "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 "KWOrder.ag"(line 52, column 36)+ _lhsOvertices =+ ({-# LINE 52 "KWOrder.ag" #-}+ Set.empty+ {-# LINE 466 "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 "KWOrder.ag"(line 52, column 36)+ _lhsOvertices =+ ({-# LINE 52 "KWOrder.ag" #-}+ Set.empty+ {-# LINE 478 "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 attribute:+ depinfo : NontDependencyInformation+ 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,Int))+data Inh_Nonterminal = Inh_Nonterminal {rulenumber_Inh_Nonterminal :: Int}+data Syn_Nonterminal = Syn_Nonterminal {depinfo_Syn_Nonterminal :: NontDependencyInformation,rulenumber_Syn_Nonterminal :: Int}+wrap_Nonterminal :: T_Nonterminal ->+ Inh_Nonterminal ->+ Syn_Nonterminal +wrap_Nonterminal (T_Nonterminal sem ) (Inh_Nonterminal _lhsIrulenumber ) =+ (let ( _lhsOdepinfo,_lhsOrulenumber) = sem _lhsIrulenumber + in (Syn_Nonterminal _lhsOdepinfo _lhsOrulenumber ))+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+ _lhsOrulenumber :: Int+ _prodsOrulenumber :: Int+ _prodsIdepgraph :: ([ProdDependencyGraph])+ _prodsIrulenumber :: Int+ -- "KWOrder.ag"(line 136, column 18)+ _synvertices =+ ({-# LINE 136 "KWOrder.ag" #-}+ map (VAttr Syn nt_) . Map.keys $ syn_+ {-# LINE 595 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 137, column 18)+ _inhvertices =+ ({-# LINE 137 "KWOrder.ag" #-}+ map (VAttr Inh nt_) . Map.keys $ inh_+ {-# LINE 601 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 138, column 18)+ _vertices =+ ({-# LINE 138 "KWOrder.ag" #-}+ _synvertices ++ _inhvertices+ {-# LINE 607 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 142, column 18)+ _nontgraph =+ ({-# LINE 142 "KWOrder.ag" #-}+ NontDependencyGraph { ndgVertices = _vertices+ , ndgEdges = [] }+ {-# LINE 614 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 150, column 18)+ _lhsOdepinfo =+ ({-# LINE 150 "KWOrder.ag" #-}+ NontDependencyInformation { ndiNonterminal = nt_+ , ndiInh = Map.keys inh_+ , ndiSyn = Map.keys syn_+ , ndiDepGraph = _nontgraph+ , ndiProds = _prodsIdepgraph }+ {-# LINE 624 "KWOrder.hs" #-}+ )+ -- copy rule (up)+ _lhsOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _prodsIrulenumber+ {-# LINE 630 "KWOrder.hs" #-}+ )+ -- copy rule (down)+ _prodsOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _lhsIrulenumber+ {-# LINE 636 "KWOrder.hs" #-}+ )+ ( _prodsIdepgraph,_prodsIrulenumber) =+ prods_ _prodsOrulenumber + in ( _lhsOdepinfo,_lhsOrulenumber))) )+-- Nonterminals ------------------------------------------------+{-+ visit 0:+ chained attribute:+ rulenumber : Int+ synthesized attribute:+ depinfo : [NontDependencyInformation]+ 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]),Int))+data Inh_Nonterminals = Inh_Nonterminals {rulenumber_Inh_Nonterminals :: Int}+data Syn_Nonterminals = Syn_Nonterminals {depinfo_Syn_Nonterminals :: ([NontDependencyInformation]),rulenumber_Syn_Nonterminals :: Int}+wrap_Nonterminals :: T_Nonterminals ->+ Inh_Nonterminals ->+ Syn_Nonterminals +wrap_Nonterminals (T_Nonterminals sem ) (Inh_Nonterminals _lhsIrulenumber ) =+ (let ( _lhsOdepinfo,_lhsOrulenumber) = sem _lhsIrulenumber + in (Syn_Nonterminals _lhsOdepinfo _lhsOrulenumber ))+sem_Nonterminals_Cons :: T_Nonterminal ->+ T_Nonterminals ->+ T_Nonterminals +sem_Nonterminals_Cons (T_Nonterminal hd_ ) (T_Nonterminals tl_ ) =+ (T_Nonterminals (\ _lhsIrulenumber ->+ (let _lhsOdepinfo :: ([NontDependencyInformation])+ _lhsOrulenumber :: Int+ _hdOrulenumber :: Int+ _tlOrulenumber :: Int+ _hdIdepinfo :: NontDependencyInformation+ _hdIrulenumber :: Int+ _tlIdepinfo :: ([NontDependencyInformation])+ _tlIrulenumber :: Int+ -- use rule "KWOrder.ag"(line 147, column 33)+ _lhsOdepinfo =+ ({-# LINE 147 "KWOrder.ag" #-}+ _hdIdepinfo : _tlIdepinfo+ {-# LINE 687 "KWOrder.hs" #-}+ )+ -- copy rule (up)+ _lhsOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _tlIrulenumber+ {-# LINE 693 "KWOrder.hs" #-}+ )+ -- copy rule (down)+ _hdOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _lhsIrulenumber+ {-# LINE 699 "KWOrder.hs" #-}+ )+ -- copy rule (chain)+ _tlOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _hdIrulenumber+ {-# LINE 705 "KWOrder.hs" #-}+ )+ ( _hdIdepinfo,_hdIrulenumber) =+ hd_ _hdOrulenumber + ( _tlIdepinfo,_tlIrulenumber) =+ tl_ _tlOrulenumber + in ( _lhsOdepinfo,_lhsOrulenumber))) )+sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil =+ (T_Nonterminals (\ _lhsIrulenumber ->+ (let _lhsOdepinfo :: ([NontDependencyInformation])+ _lhsOrulenumber :: Int+ -- use rule "KWOrder.ag"(line 147, column 33)+ _lhsOdepinfo =+ ({-# LINE 147 "KWOrder.ag" #-}+ []+ {-# LINE 721 "KWOrder.hs" #-}+ )+ -- copy rule (chain)+ _lhsOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _lhsIrulenumber+ {-# LINE 727 "KWOrder.hs" #-}+ )+ in ( _lhsOdepinfo,_lhsOrulenumber))) )+-- 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)+ -- "KWOrder.ag"(line 68, column 12)+ _vertex =+ ({-# LINE 68 "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 806 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 72, column 12)+ _lhsOvertices =+ ({-# LINE 72 "KWOrder.ag" #-}+ Set.insert _vertex $ _partsIvertices `Set.union` _patIvertices+ {-# LINE 812 "KWOrder.hs" #-}+ )+ -- self rule+ _copy =+ ({-# LINE 23 "./Patterns.ag" #-}+ Alias field_ attr_ _patIcopy _partsIcopy+ {-# LINE 818 "KWOrder.hs" #-}+ )+ -- self rule+ _lhsOcopy =+ ({-# LINE 23 "./Patterns.ag" #-}+ _copy+ {-# LINE 824 "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 "KWOrder.ag"(line 52, column 36)+ _lhsOvertices =+ ({-# LINE 52 "KWOrder.ag" #-}+ _patsIvertices+ {-# LINE 843 "KWOrder.hs" #-}+ )+ -- self rule+ _copy =+ ({-# LINE 23 "./Patterns.ag" #-}+ Constr name_ _patsIcopy+ {-# LINE 849 "KWOrder.hs" #-}+ )+ -- self rule+ _lhsOcopy =+ ({-# LINE 23 "./Patterns.ag" #-}+ _copy+ {-# LINE 855 "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 "KWOrder.ag"(line 52, column 36)+ _lhsOvertices =+ ({-# LINE 52 "KWOrder.ag" #-}+ _patIvertices+ {-# LINE 871 "KWOrder.hs" #-}+ )+ -- self rule+ _copy =+ ({-# LINE 23 "./Patterns.ag" #-}+ Irrefutable _patIcopy+ {-# LINE 877 "KWOrder.hs" #-}+ )+ -- self rule+ _lhsOcopy =+ ({-# LINE 23 "./Patterns.ag" #-}+ _copy+ {-# LINE 883 "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 "KWOrder.ag"(line 52, column 36)+ _lhsOvertices =+ ({-# LINE 52 "KWOrder.ag" #-}+ _patsIvertices+ {-# LINE 900 "KWOrder.hs" #-}+ )+ -- self rule+ _copy =+ ({-# LINE 23 "./Patterns.ag" #-}+ Product pos_ _patsIcopy+ {-# LINE 906 "KWOrder.hs" #-}+ )+ -- self rule+ _lhsOcopy =+ ({-# LINE 23 "./Patterns.ag" #-}+ _copy+ {-# LINE 912 "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 "KWOrder.ag"(line 52, column 36)+ _lhsOvertices =+ ({-# LINE 52 "KWOrder.ag" #-}+ Set.empty+ {-# LINE 926 "KWOrder.hs" #-}+ )+ -- self rule+ _copy =+ ({-# LINE 23 "./Patterns.ag" #-}+ Underscore pos_+ {-# LINE 932 "KWOrder.hs" #-}+ )+ -- self rule+ _lhsOcopy =+ ({-# LINE 23 "./Patterns.ag" #-}+ _copy+ {-# LINE 938 "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 "KWOrder.ag"(line 52, column 36)+ _lhsOvertices =+ ({-# LINE 52 "KWOrder.ag" #-}+ _hdIvertices `Set.union` _tlIvertices+ {-# LINE 986 "KWOrder.hs" #-}+ )+ -- self rule+ _copy =+ ({-# LINE 23 "./Patterns.ag" #-}+ (:) _hdIcopy _tlIcopy+ {-# LINE 992 "KWOrder.hs" #-}+ )+ -- self rule+ _lhsOcopy =+ ({-# LINE 23 "./Patterns.ag" #-}+ _copy+ {-# LINE 998 "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 "KWOrder.ag"(line 52, column 36)+ _lhsOvertices =+ ({-# LINE 52 "KWOrder.ag" #-}+ Set.empty+ {-# LINE 1013 "KWOrder.hs" #-}+ )+ -- self rule+ _copy =+ ({-# LINE 23 "./Patterns.ag" #-}+ []+ {-# LINE 1019 "KWOrder.hs" #-}+ )+ -- self rule+ _lhsOcopy =+ ({-# LINE 23 "./Patterns.ag" #-}+ _copy+ {-# LINE 1025 "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+ _childrenIedges :: (Set.Set Edge)+ _childrenInontnames :: ([(Identifier, Identifier)])+ _childrenIvertices :: (Set.Set Vertex)+ _rulesIedges :: (Set.Set Edge)+ _rulesIrulenumber :: Int+ _rulesIvertices :: (Set.Set Vertex)+ -- "KWOrder.ag"(line 90, column 17)+ _vertices =+ ({-# LINE 90 "KWOrder.ag" #-}+ _rulesIvertices `Set.union` _childrenIvertices+ {-# LINE 1081 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 110, column 17)+ _edges =+ ({-# LINE 110 "KWOrder.ag" #-}+ _rulesIedges `Set.union` _childrenIedges+ {-# LINE 1087 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 125, column 17)+ _lhsOdepgraph =+ ({-# LINE 125 "KWOrder.ag" #-}+ ProdDependencyGraph { pdgVertices = Set.toList _vertices+ , pdgEdges = Set.toList _edges+ , pdgProduction = con_+ , pdgChildMap = _childrenInontnames }+ {-# LINE 1096 "KWOrder.hs" #-}+ )+ -- copy rule (up)+ _lhsOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _rulesIrulenumber+ {-# LINE 1102 "KWOrder.hs" #-}+ )+ -- copy rule (down)+ _rulesOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _lhsIrulenumber+ {-# LINE 1108 "KWOrder.hs" #-}+ )+ ( _childrenIedges,_childrenInontnames,_childrenIvertices) =+ children_ + ( _rulesIedges,_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 "KWOrder.ag"(line 122, column 33)+ _lhsOdepgraph =+ ({-# LINE 122 "KWOrder.ag" #-}+ _hdIdepgraph : _tlIdepgraph+ {-# LINE 1161 "KWOrder.hs" #-}+ )+ -- copy rule (up)+ _lhsOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _tlIrulenumber+ {-# LINE 1167 "KWOrder.hs" #-}+ )+ -- copy rule (down)+ _hdOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _lhsIrulenumber+ {-# LINE 1173 "KWOrder.hs" #-}+ )+ -- copy rule (chain)+ _tlOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _hdIrulenumber+ {-# LINE 1179 "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 "KWOrder.ag"(line 122, column 33)+ _lhsOdepgraph =+ ({-# LINE 122 "KWOrder.ag" #-}+ []+ {-# LINE 1195 "KWOrder.hs" #-}+ )+ -- copy rule (chain)+ _lhsOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _lhsIrulenumber+ {-# LINE 1201 "KWOrder.hs" #-}+ )+ in ( _lhsOdepgraph,_lhsOrulenumber))) )+-- Rule --------------------------------------------------------+{-+ visit 0:+ chained attribute:+ rulenumber : Int+ synthesized attributes:+ edges : Set.Set Edge+ 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),Int,(Set.Set Vertex)))+data Inh_Rule = Inh_Rule {rulenumber_Inh_Rule :: Int}+data Syn_Rule = Syn_Rule {edges_Syn_Rule :: (Set.Set Edge),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,_lhsOrulenumber,_lhsOvertices) = sem _lhsIrulenumber + in (Syn_Rule _lhsOedges _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+ _lhsOvertices :: (Set.Set Vertex)+ _lhsOedges :: (Set.Set Edge)+ _patternIcopy :: Pattern + _patternIvertices :: (Set.Set Vertex)+ _rhsIvertices :: (Set.Set Vertex)+ -- "KWOrder.ag"(line 42, column 11)+ _lhsOrulenumber =+ ({-# LINE 42 "KWOrder.ag" #-}+ _lhsIrulenumber + 1+ {-# LINE 1261 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 43, column 11)+ _rulename =+ ({-# LINE 43 "KWOrder.ag" #-}+ maybe (identifier $ "rule" ++ show _lhsIrulenumber) id mbName_+ {-# LINE 1267 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 85, column 11)+ _vertex =+ ({-# LINE 85 "KWOrder.ag" #-}+ VRule _rulename+ {-# LINE 1273 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 86, column 11)+ _lhsOvertices =+ ({-# LINE 86 "KWOrder.ag" #-}+ Set.insert _vertex $ _patternIvertices `Set.union` _rhsIvertices+ {-# LINE 1279 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 98, column 11)+ _edgesout =+ ({-# LINE 98 "KWOrder.ag" #-}+ map ((,) _vertex ) (Set.toList _rhsIvertices)+ {-# LINE 1285 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 99, column 11)+ _edgesin =+ ({-# LINE 99 "KWOrder.ag" #-}+ map (flip (,) _vertex ) (Set.toList _patternIvertices)+ {-# LINE 1291 "KWOrder.hs" #-}+ )+ -- "KWOrder.ag"(line 100, column 11)+ _lhsOedges =+ ({-# LINE 100 "KWOrder.ag" #-}+ Set.fromList $ _edgesout ++ _edgesin+ {-# LINE 1297 "KWOrder.hs" #-}+ )+ ( _patternIcopy,_patternIvertices) =+ pattern_ + ( _rhsIvertices) =+ rhs_ + in ( _lhsOedges,_lhsOrulenumber,_lhsOvertices))) )+-- Rules -------------------------------------------------------+{-+ visit 0:+ chained attribute:+ rulenumber : Int+ synthesized attributes:+ edges : Set.Set Edge+ 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),Int,(Set.Set Vertex)))+data Inh_Rules = Inh_Rules {rulenumber_Inh_Rules :: Int}+data Syn_Rules = Syn_Rules {edges_Syn_Rules :: (Set.Set Edge),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,_lhsOrulenumber,_lhsOvertices) = sem _lhsIrulenumber + in (Syn_Rules _lhsOedges _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)+ _lhsOvertices :: (Set.Set Vertex)+ _lhsOrulenumber :: Int+ _hdOrulenumber :: Int+ _tlOrulenumber :: Int+ _hdIedges :: (Set.Set Edge)+ _hdIrulenumber :: Int+ _hdIvertices :: (Set.Set Vertex)+ _tlIedges :: (Set.Set Edge)+ _tlIrulenumber :: Int+ _tlIvertices :: (Set.Set Vertex)+ -- use rule "KWOrder.ag"(line 94, column 33)+ _lhsOedges =+ ({-# LINE 94 "KWOrder.ag" #-}+ _hdIedges `Set.union` _tlIedges+ {-# LINE 1354 "KWOrder.hs" #-}+ )+ -- use rule "KWOrder.ag"(line 52, column 36)+ _lhsOvertices =+ ({-# LINE 52 "KWOrder.ag" #-}+ _hdIvertices `Set.union` _tlIvertices+ {-# LINE 1360 "KWOrder.hs" #-}+ )+ -- copy rule (up)+ _lhsOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _tlIrulenumber+ {-# LINE 1366 "KWOrder.hs" #-}+ )+ -- copy rule (down)+ _hdOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _lhsIrulenumber+ {-# LINE 1372 "KWOrder.hs" #-}+ )+ -- copy rule (chain)+ _tlOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _hdIrulenumber+ {-# LINE 1378 "KWOrder.hs" #-}+ )+ ( _hdIedges,_hdIrulenumber,_hdIvertices) =+ hd_ _hdOrulenumber + ( _tlIedges,_tlIrulenumber,_tlIvertices) =+ tl_ _tlOrulenumber + in ( _lhsOedges,_lhsOrulenumber,_lhsOvertices))) )+sem_Rules_Nil :: T_Rules +sem_Rules_Nil =+ (T_Rules (\ _lhsIrulenumber ->+ (let _lhsOedges :: (Set.Set Edge)+ _lhsOvertices :: (Set.Set Vertex)+ _lhsOrulenumber :: Int+ -- use rule "KWOrder.ag"(line 94, column 33)+ _lhsOedges =+ ({-# LINE 94 "KWOrder.ag" #-}+ Set.empty+ {-# LINE 1395 "KWOrder.hs" #-}+ )+ -- use rule "KWOrder.ag"(line 52, column 36)+ _lhsOvertices =+ ({-# LINE 52 "KWOrder.ag" #-}+ Set.empty+ {-# LINE 1401 "KWOrder.hs" #-}+ )+ -- copy rule (chain)+ _lhsOrulenumber =+ ({-# LINE 36 "KWOrder.ag" #-}+ _lhsIrulenumber+ {-# LINE 1407 "KWOrder.hs" #-}+ )+ in ( _lhsOedges,_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 ( )) )
+ src/KennedyWarren.hs view
@@ -0,0 +1,117 @@+module KennedyWarren where++import CommonTypes+import Pretty+import Knuth1+import Debug.Trace+import Control.Monad.ST+import Control.Monad.State+import Control.Monad.Error+import Data.STRef+import Data.Maybe+import Data.List++import qualified Data.Set as Set+import qualified Data.Map as Map+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet++kennedyWarrenIO :: [NontDependencyInformation] -> PP_Doc+kennedyWarrenIO ndis = runST $ do + indi <- mapM mkNontDependencyInformationM ndis+ knuth1 indi+ -- Check all graphs for cyclicity, transitive closure and consistency+ traceST $ "Checking graphs..."+ forM_ indi $ \ndi -> do+ let nont = ndiNonterminal . ndimOrig $ ndi+ let g = ndgmDepGraph . ndimDepGraph $ ndi+ -- Cyclicity check+ c1 <- graphIsCyclic g+ when c1 $ traceST $ "Nonterminal graph " ++ show nont ++ " is cylic!"+ -- Transtive closure check+ trc <- graphIsTRC g+ when (not trc) $ traceST $ "Nonterminal graph " ++ show nont ++ " is not transitively closed!"+ -- Consistency check+ cons <- graphCheckConsistency g+ when (not cons) $ traceST $ "Nonterminal graph " ++ show nont ++ " is not consistent!"+ -- Loop trough all productions+ forM_ (ndimProds ndi) $ \prod -> do+ let pr = pdgProduction $ pdgmOrig prod+ let g = pdgmDepGraph $ prod+ -- Check for cyclicity+ c2 <- graphIsCyclic g + when c2 $ traceST $ "Production graph " ++ show pr ++ " of nonterminal "+ ++ show nont ++ " is cylic!"+ -- Transtive closure check+ trc <- graphIsTRC g+ when (not trc) $ traceST $ "Production graph " ++ show pr ++ " of nonterminal " + ++ show nont ++ " is not transitively closed!"+ -- Check consistency+ cons <- graphCheckConsistency g+ when (not cons) $ traceST $ "Production graph " ++ show pr ++ " of nonterminal " + ++ show nont ++ " is not consistent!"+ -- Recreate non-transitive closed graph for efficiency+ indi <- undoTransitiveClosure indi+ -- Debug output+ traceST $ "Converting to string..."+ rtexts <- mapM toGVNontDependencyInfo indi+ traceST $ "Done."+ return (vlist rtexts)++-------------------------------------------------------------------------------+-- Debugging functionality+-------------------------------------------------------------------------------++-- | Pretty print a vertex in GraphViz format+toGVVertex :: Bool -> Vertex -> ST s PP_Doc+toGVVertex l (VAttr t a b) = return $ (text $ "attr_" ++ show t ++ "_" ++ show a ++ "_" ++ show b) >#< if l+ then text ("[shape=box,label=\"" ++ show t ++ " @" ++ show a ++ "." ++ show b ++ "\"]") else empty+toGVVertex l (VChild c) = return $ (text $ "child_" ++ show c) >#< if l+ then text ("[shape=ellipse,label=\"Child " ++ show c ++ "\"]") else empty+toGVVertex l (VRule r) = return $ (text $ "rule_" ++ show r) >#< if l+ then text ("[shape=diamond,label=\"" ++ show r ++ "\"]") else empty++-- | Pretty print an edge in GraphViz format+toGVEdge :: Edge -> ST s PP_Doc+toGVEdge (v1, v2) = do r1 <- toGVVertex False v1 + r2 <- toGVVertex False v2+ return $ r1 >|< text "->" >#< r2++-- | Pretty print a NontDependencyInformation in GraphViz format+toGVNontDependencyInfo :: NontDependencyInformationM s -> ST s PP_Doc+toGVNontDependencyInfo ndi = do dg <- return $ ndgmDepGraph . ndimDepGraph $ ndi+ verts <- graphVertices dg+ edges <- graphEdges dg+ vtexts <- mapM (toGVVertex True) verts+ etexts <- mapM toGVEdge edges+ ptexts <- mapM toGVProdDependencyGraph (ndimProds ndi)+ return $ (text ("digraph ndg_" ++ show (ndiNonterminal $ ndimOrig ndi) ++ " {")+ >-<+ vlist vtexts+ >-<+ vlist etexts+ >-<+ text "}"+ >-<+ text "" -- empty line+ >-<+ vlist ptexts)++-- | Pretty print a ProdDependencyGraph in GraphViz format+toGVProdDependencyGraph :: ProdDependencyGraphM s -> ST s PP_Doc+toGVProdDependencyGraph pdg = do dg <- return $ pdgmDepGraph pdg+ verts <- graphVertices dg+ edges <- graphEdges dg+ vtexts <- mapM (toGVVertex True) verts+ etexts <- mapM toGVEdge edges+ return $ (text ("digraph pdg_" ++ show (pdgProduction $ pdgmOrig pdg) ++ " {")+ >-<+ (vlist vtexts)+ >-<+ (vlist etexts)+ >-<+ text ("info [shape=box,label=\"" ++ show (pdgChildMap $ pdgmOrig pdg) ++ "\"];")+ >-<+ text "}"+ >-<+ text "")
+ src/Knuth1.hs view
@@ -0,0 +1,445 @@+module Knuth1 where++import Pretty+import CommonTypes+import Control.Monad+import Control.Monad.ST+import Data.Maybe+import Data.List+import Data.STRef+import Debug.Trace++import qualified Data.Array as Array+import qualified Data.Map as Map+import qualified Data.Set as Set++-- | Trace a message in the ST monad+traceST :: String -> ST s ()+traceST s = trace s (return ())++-------------------------------------------------------------------------------+-- Dependency graph representation+-------------------------------------------------------------------------------++-- Vertices+data AttrType = Inh | Syn | Loc deriving (Eq, Ord, Show)+data Vertex = VAttr AttrType Identifier Identifier+ | VChild Identifier+ | VRule Identifier deriving (Eq, Ord)++instance Show Vertex where+ show (VAttr ty ch at) = show ty ++ " @" ++ show ch ++ "." ++ show at+ show (VChild ch) = "Child " ++ show ch+ show (VRule ru) = "Rule " ++ show ru++-- | Check if a vertex is an attribute+isVertexAttr :: Vertex -> Bool+isVertexAttr (VAttr _ _ _) = True+isVertexAttr _ = False++-- | Get the child name of an attribute+getAttrChildName :: Vertex -> Identifier+getAttrChildName (VAttr _ n _) = n++-- | Set the child name of an attribute+setAttrChildName :: Vertex -> Identifier -> Vertex+setAttrChildName (VAttr t _ a) n = VAttr t n a++-- | Get the type of an attribute+getAttrType :: Vertex -> AttrType+getAttrType (VAttr t _ _) = t++-- | Get the name of an attribute+getAttrName :: Vertex -> Identifier+getAttrName (VAttr _ _ a) = a++-- Edges+type Edge = (Vertex, Vertex)++-- Internal representation of a vertex+type IVertex = Int+type IEdge = (IVertex, IVertex)++-- Representation of the graph+data DependencyGraph s = DependencyGraph { vertexIMap :: Map.Map Vertex IVertex+ , vertexOMap :: Array.Array IVertex Vertex + , successors :: Array.Array IVertex (STRef s (Set.Set IVertex))+ , predecessors :: Array.Array IVertex (STRef s (Set.Set IVertex)) }++-------------------------------------------------------------------------------+-- Dependency graph fuctions+-------------------------------------------------------------------------------++-- | Construct a dependency graph+graphConstruct :: [Vertex] -> ST s (DependencyGraph s)+graphConstruct vs = do let nv = length vs+ let ivs = [0..nv-1]+ let ivb = (0,nv-1)+ let vimap = Map.fromList (zip vs ivs)+ let vomap = Array.array ivb (zip ivs vs)+ succs <- replicateM nv (newSTRef Set.empty)+ preds <- replicateM nv (newSTRef Set.empty)+ let su = Array.array ivb (zip ivs succs)+ let pr = Array.array ivb (zip ivs preds)+ let graph = DependencyGraph { vertexIMap = vimap+ , vertexOMap = vomap+ , successors = su+ , predecessors = pr }+ return graph++-- | Construct a transitivelly closed graph+graphConstructTRC :: [Vertex] -> [Edge] -> ST s (DependencyGraph s)+graphConstructTRC vs es = do g <- graphConstruct vs+ -- Insert all initial edges+ graphInsertEdgesTRC g es+ return g+ ++-- | Return all successors of a vertex+graphSuccessors :: DependencyGraph s -> Vertex -> ST s (Set.Set Vertex)+graphSuccessors g v = do sucs <- readSTRef $ (successors g) Array.! (graphGetIVertex g v)+ return $ Set.map (graphGetVertex g) sucs++-- | Check if the graph contains an edge+graphContainsEdge :: DependencyGraph s -> Edge -> ST s Bool+graphContainsEdge g (v1,v2) = do let iv1 = graphGetIVertex g v1+ let iv2 = graphGetIVertex g v2+ sucs <- readSTRef $ (successors g) Array.! iv1+ return $ iv2 `Set.member` sucs++-- | Insert an edge in a transtive closed graph and return all other edges that were+-- added due to transtivity+graphInsert :: DependencyGraph s -> Edge -> ST s ()+graphInsert g (v1,v2) = do let iv1 = graphGetIVertex g v1+ let iv2 = graphGetIVertex g v2+ -- Add v2 to the successors of v1 and v1 to predecessors of v2+ modifySTRef ((successors g) Array.! iv1) $ Set.insert iv2+ modifySTRef ((predecessors g) Array.! iv2) $ Set.insert iv1++-- | Insert an edge in a transtive closed graph and return all other edges that were+-- added due to transtivity+graphInsertTRC :: DependencyGraph s -> Edge -> ST s [(IVertex, Set.Set IVertex)]+graphInsertTRC g (v1,v2) = do let iv1 = graphGetIVertex g v1+ let iv2 = graphGetIVertex g v2+ -- Read predecessors of v1 and successors of v2+ pred1 <- readSTRef $ (predecessors g) Array.! iv1+ succ2 <- readSTRef $ (successors g) Array.! iv2+ -- First insert all edges from v1+ let rsucc1 = (successors g) Array.! iv1+ succ1 <- readSTRef rsucc1+ let add1 = succ2 `Set.difference` succ1+ modifySTRef rsucc1 (Set.union add1 . Set.insert iv2)+ -- All edges to v2+ let rpred2 = (predecessors g) Array.! iv2+ modifySTRef rpred2 (Set.union pred1 . Set.insert iv1)+ -- Connect every predecessor of v1 to every successor of v2+ sucl <- forM (Set.toList pred1) $ \pred -> do+ -- Connect pred to v2 and all successors of v2+ let rsucc = (successors g) Array.! pred+ csucc <- readSTRef rsucc+ let cadd = (Set.insert iv2 succ2) `Set.difference` csucc+ modifySTRef rsucc (Set.union cadd)+ return (pred, cadd)+ -- Connect every successor of v2 to every predecessor of v1+ forM_ (Set.toList succ2) $ \succ -> do+ -- Connect succ to v1 and all predecessors of v1+ let rpred = (predecessors g) Array.! succ+ cpred <- readSTRef rpred+ let cadd = (Set.insert iv1 pred1) `Set.difference` cpred+ modifySTRef rpred (Set.union cadd)+ -- Create return+ return $ (iv1,add1) : sucl++-- | Return all vertices of the graph+graphVertices :: DependencyGraph s -> ST s [Vertex]+graphVertices = return . Array.elems . vertexOMap++-- | Return all edges of the graph+graphEdges :: DependencyGraph s -> ST s [Edge]+graphEdges g = do let vs = Array.indices $ vertexOMap g+ perv <- forM vs $ \v -> do+ let rv = graphGetVertex g v+ sucs <- readSTRef $ (successors g) Array.! v+ let sucl = Set.toList sucs+ return $ map ((,) rv . graphGetVertex g) sucl+ return $ concat perv++-- | Insert a list of edges in the graph and return all other edges that+-- were added due to transitivity+graphInsertEdgesTRC :: DependencyGraph s -> [Edge] -> ST s [Edge]+graphInsertEdgesTRC g ed = do -- rets :: [[(IVertex, Set.Set IVertex)]]+ rets <- mapM (graphInsertTRC g) ed+ -- Combine all successor sets+ let f :: (IVertex, (Set.Set IVertex)) -> [(IVertex, IVertex)]+ f (v,s) = map ((,) v) (Set.toList s)+ let comb :: [(IVertex, IVertex)]+ comb = concatMap (concatMap f) rets+ -- Construct edges from this+ return $ map (graphGetEdge g) $ comb++-- | Check whether the graph is cyclic+graphIsCyclic :: DependencyGraph s -> ST s Bool+graphIsCyclic g = do vs <- return $ Array.indices $ vertexOMap g+ selfcyc <- forM vs $ \v -> do+ sucs <- readSTRef $ (successors g) Array.! v+ return $ v `Set.member` sucs+ return $ or selfcyc++-- | Get internal representation of a vertex+graphGetIVertex :: DependencyGraph s -> Vertex -> IVertex+graphGetIVertex g v = vertexIMap g Map.! v++-- | Get external representation of a vertex+graphGetVertex :: DependencyGraph s -> IVertex -> Vertex+graphGetVertex g v = vertexOMap g Array.! v++-- | Get external representation of an edge+graphGetEdge :: DependencyGraph s -> IEdge -> Edge+graphGetEdge g (v1,v2) = (graphGetVertex g v1, graphGetVertex g v2)++-- | Check if the graph is transitively closed+graphIsTRC :: DependencyGraph s -> ST s Bool+graphIsTRC g = do let vs = Array.indices $ vertexOMap g+ bs <- forM vs $ \v -> do+ succs <- readSTRef $ (successors g) Array.! v+ bs2 <- forM (Set.toList succs) $ \v2 -> do+ succs2 <- readSTRef $ (successors g) Array.! v2+ return $ succs2 `Set.isSubsetOf` succs+ return $ and bs2+ return $ and bs++-- | Check consistency of the graph (successor and predecessor sets)+graphCheckConsistency :: DependencyGraph s -> ST s Bool+graphCheckConsistency g = do let vs = Array.indices $ vertexOMap g+ ret <- forM vs $ \v -> do+ -- V must appear in every predecessor set of its successors+ succs <- readSTRef $ (successors g) Array.! v+ r1 <- forM (Set.toList succs) $ \succ -> do+ preds2 <- readSTRef $ (predecessors g) Array.! succ+ return (v `Set.member` preds2)+ -- V must appear in every successor set of its predecessors+ preds <- readSTRef $ (predecessors g) Array.! v+ r2 <- forM (Set.toList preds) $ \pred -> do+ succs2 <- readSTRef $ (successors g) Array.! pred+ return (v `Set.member` succs2)+ return $ and $ r1 ++ r2+ return $ and $ ret++-------------------------------------------------------------------------------+-- Dependency graph information wrappers+-------------------------------------------------------------------------------++-- | Special wrapper for nonterminal dependency graphs (so that we can easily add other meta-information)+data NontDependencyGraph = NontDependencyGraph { ndgVertices :: [Vertex] + , ndgEdges :: [Edge] }++-- | Special wrapper for production dependency graphs, including mapping between child names and nonterminals+data ProdDependencyGraph = ProdDependencyGraph { pdgVertices :: [Vertex]+ , pdgEdges :: [Edge]+ , pdgProduction :: Identifier+ , pdgChildMap :: [(Identifier, Identifier)] }+++-- | Represent all information from the dependency graphs for a nonterminal+data NontDependencyInformation = NontDependencyInformation { ndiNonterminal :: Identifier+ , ndiInh :: [Identifier]+ , ndiSyn :: [Identifier]+ , ndiDepGraph :: NontDependencyGraph+ , ndiProds :: [ProdDependencyGraph] }++--- Monadic versions of these records, for use with the ST monad++-- | Monadic wrapper of NontDependencyGraph+data NontDependencyGraphM s = NontDependencyGraphM { ndgmDepGraph :: DependencyGraph s + , ndgmOrig :: NontDependencyGraph }++-- | Monadic wrapper of ProdDependencyGraph+data ProdDependencyGraphM s = ProdDependencyGraphM { pdgmDepGraph :: DependencyGraph s+ , pdgmOrig :: ProdDependencyGraph }+++-- | Monadic wrapper of NontDependencyInformation+data NontDependencyInformationM s = NontDependencyInformationM { ndimOrig :: NontDependencyInformation+ , ndimDepGraph :: NontDependencyGraphM s+ , ndimProds :: [ProdDependencyGraphM s] }+++-- | Convert a NontDependencyGraph to the corresponding monadic version+mkNontDependencyGraphM :: NontDependencyGraph -> ST s (NontDependencyGraphM s)+mkNontDependencyGraphM ndg = do g <- graphConstructTRC (ndgVertices ndg) (ndgEdges ndg)+ return $ NontDependencyGraphM { ndgmDepGraph = g + , ndgmOrig = ndg }+++-- | Convert a ProdDependencyGraph to the corresponding monadic version+mkProdDependencyGraphM :: Bool -> ProdDependencyGraph -> ST s (ProdDependencyGraphM s)+mkProdDependencyGraphM trc pdg = do g <- if trc+ then graphConstructTRC (pdgVertices pdg) (pdgEdges pdg)+ else do g <- graphConstruct (pdgVertices pdg)+ mapM_ (graphInsert g) (pdgEdges pdg)+ return g+ return $ ProdDependencyGraphM { pdgmDepGraph = g+ , pdgmOrig = pdg }++-- | Convert a NontDependencyInformation to the corresponding monadic version+mkNontDependencyInformationM :: NontDependencyInformation -> ST s (NontDependencyInformationM s)+mkNontDependencyInformationM ndi = do dg <- mkNontDependencyGraphM (ndiDepGraph ndi)+ prods <- mapM (mkProdDependencyGraphM True) (ndiProds ndi)+ return $ NontDependencyInformationM { ndimOrig = ndi+ , ndimDepGraph = dg+ , ndimProds = prods }++-- | Construct the production graphs from the +undoTransitiveClosure :: [NontDependencyInformationM s] -> ST s [NontDependencyInformationM s]+undoTransitiveClosure ndis = do edgesl <- mapM (\ndi -> graphEdges (ndgmDepGraph $ ndimDepGraph ndi)) ndis+ let edges = concat edgesl+ forM ndis $ \ndi -> do+ prods <- mapM (mkProdDependencyGraphM False) (ndiProds $ ndimOrig ndi)+ let ret = NontDependencyInformationM { ndimOrig = ndimOrig ndi+ , ndimDepGraph = ndimDepGraph ndi+ , ndimProds = prods }+ addNontProd False (edges, ret)+ return ret++-------------------------------------------------------------------------------+-- Knuth-1 algorithm+-------------------------------------------------------------------------------++-- | Combine the dependency and nonterminal graphs using Knuth-1+-- this function assumes that the nonterminal graphs initially contains no edges+knuth1 :: [NontDependencyInformationM s] -> ST s ()+knuth1 ndis = do -- Create initial list of pending edges for each ndi (just all edges of the production graphs)+ let ipending :: NontDependencyInformationM s -> ST s [Edge]+ ipending = liftM concat . mapM (graphEdges . pdgmDepGraph) . ndimProds+-- pndis :: [([Edge], NontDependencyInformation)]+ pndis <- mapM (\ndi -> liftM2 (,) (ipending ndi) (return ndi)) ndis+ knuth1' pndis++-- | Helper function for |knuth1| which repeats the process until we are done+knuth1' :: [([Edge], NontDependencyInformationM s)] -> ST s ()+knuth1' ndis = do -- Add edges from the production graphs to the nonterminal graph+-- ndis' :: [Maybe [Edge]]+ ndis' <- mapM addProdNont ndis+ -- List of all newly added edges+-- ntedge :: [Edge]+ let ntedge = concatMap (\x -> maybe [] id x) ndis'+ if null ntedge+ -- When no new edges have been added we are done+ then return ()+ else do -- Otherwise, the next step is to add edges from nonterminal to production graphs+-- ndis'' :: [Maybe [Edge]]+ ndis'' <- mapM (\(_,x) -> addNontProd True (ntedge, x)) ndis+ -- List of new states (production edges + dependency graphs)+-- nndis' :: [([Edge], NontDependencyInformation)]+ nndis' <- zipWithM (\(_,ndi) me -> return (maybe [] id me, ndi)) ndis ndis''+ if any isJust ndis''+ -- We have added some edges, so continue the process+ then knuth1' nndis'+ -- No new edges added, we are done+ else return ()++-- | Add pending edges from the production graphs to the nonterminal graph, return Nothing if none were added+-- otherwise, return the list of newly added nonterminal edges+addProdNont :: ([Edge], NontDependencyInformationM s) -> ST s (Maybe [Edge])+addProdNont (pending, ndi) = do -- Unwrapping of the records+ let nontDepGraph = ndimDepGraph ndi+ let nontGraph = ndgmDepGraph nontDepGraph+ -- nub the list because multiple productions can result in the same new edges+ let possa = nub $ do (v1,v2) <- pending+ -- Take only edges from syn.lhs to inh.lhs+ guard $ isVertexAttr v1+ guard $ getAttrChildName v1 == _LHS+ guard $ getAttrType v1 == Syn+ guard $ isVertexAttr v2+ guard $ getAttrChildName v2 == _LHS+ guard $ getAttrType v2 == Inh+ -- Construct edge as it should be in nonterminal graph+ let nv1 = setAttrChildName v1 (ndiNonterminal $ ndimOrig ndi)+ let nv2 = setAttrChildName v2 (ndiNonterminal $ ndimOrig ndi)+ return (nv1, nv2)+ -- Edges that are not in the nonterminal graph yet+ toadd <- filterM (\e -> return not `ap` graphContainsEdge nontGraph e) possa+ -- Check whether new edges are to be added and return the added edges+ if null toadd+ then return Nothing+ else do graphInsertEdgesTRC nontGraph toadd+ -- Debug output+ --mapM_ (\edge -> traceST $ "Adding nonterminal edge " ++ show edge) toadd+ return $ Just toadd++-- | Add edges from the nonterminal graphs to the production graphs, return Nothing if none were added+-- otherwise, return the list of newly added production edges and the updated graph+addNontProd :: Bool -> ([Edge], NontDependencyInformationM s) -> ST s (Maybe [Edge])+addNontProd trc (pending, ndi) = do -- Call the helper function for each nonterminal+ prods' <- mapM (addNontProd' trc pending) (ndimProds ndi)+ -- Check if any edges were added+ if any isJust prods'+ then -- Return list of newly created edges+ return $ Just $ concatMap (maybe [] id) prods'+ else return Nothing++-- | Helper function for |addNontProd| for a single production+addNontProd' :: Bool -> [Edge] -> ProdDependencyGraphM s -> ST s (Maybe [Edge])+addNontProd' trc pend pdg = do -- Unwrapping of the records+ prodGraph <- return $ pdgmDepGraph pdg+ -- Construct all possible new edges+ let possa = do (v1,v2) <- pend+ -- Take a child of this nonterminal type+ guard $ isVertexAttr v1+ guard $ isVertexAttr v2+ let tp = getAttrChildName v1+ (ch,chtp) <- pdgChildMap $ pdgmOrig pdg+ guard $ tp == chtp+ -- Construct edge as it should be in the production graph+ let nv1 = setAttrChildName v1 ch+ let nv2 = setAttrChildName v2 ch+ return (nv1, nv2)+ -- Edges that are not in the production graph yet+ toadd <- filterM (\e -> return not `ap` graphContainsEdge prodGraph e) possa+ -- Check whether new edges are to be added and return the result+ if null toadd+ then return Nothing+ else do -- Insert all edges and return transitive edges that are added in this process+ ret <- if trc+ then graphInsertEdgesTRC prodGraph toadd+ else do mapM_ (graphInsert prodGraph) toadd+ return []+ -- Debug output+ --mapM_ (\edge -> traceST $ "Adding production edge " ++ show edge) toadd+ return $ Just ret++-- | Add the "back edges" to the nonterminal graphs for creating a global ordering+addBackEdges :: [NontDependencyInformationM s] -> ST s ()+addBackEdges ndis = do -- gather all back edges+ lBackEdges <- forM ndis $ \ndi -> do+ -- For every production+ bs <- forM (ndimProds ndi) $ \prod -> do+ -- Go through all edges+ edg <- graphEdges . pdgmDepGraph $ prod+ return $ do (v1,v2) <- edg+ -- Backedges are from inh.ch to syn.ch+ guard $ isVertexAttr v1+ guard $ getAttrChildName v1 /= _LHS+ guard $ getAttrType v1 == Inh+ guard $ isVertexAttr v2+ guard $ getAttrChildName v2 /= _LHS+ guard $ getAttrType v2 == Syn+ guard $ getAttrChildName v1 == getAttrChildName v2+ -- Find the correct child name+ (ch,chtp) <- pdgChildMap $ pdgmOrig prod+ let tp = getAttrChildName v1+ guard $ tp == ch+ -- Construct the edge as it should be in the nonterminal graph+ let nv1 = setAttrChildName v1 chtp+ let nv2 = setAttrChildName v2 chtp+ return (nv1, nv2)+ return $ concat bs+ -- Concatenate all lists of backedges+ let backedges = concat lBackEdges+ -- Now add backedges to every nonterminal graph+ forM_ ndis $ \ndi -> do+ -- Find the backedges for this nonterminal+ let nont = ndiNonterminal . ndimOrig $ ndi+ let thisbe = filter ((==) nont . getAttrChildName . fst) backedges+ -- Add them to the graph+ graphInsertEdgesTRC (ndgmDepGraph . ndimDepGraph $ ndi) thisbe
src/Version.hs view
@@ -1,4 +1,4 @@ module Version where banner :: String -banner = "Attribute Grammar compiler / HUT project. Version 0.9.38.3" +banner = "Attribute Grammar compiler / HUT project. Version 0.9.38.4"
uuagc.cabal view
@@ -1,7 +1,7 @@ cabal-version: >=1.2 build-type: Simple name: uuagc-version: 0.9.38.3+version: 0.9.38.4 license: GPL license-file: LICENSE maintainer: Arie Middelkoop <ariem@cs.uu.nl>@@ -77,6 +77,9 @@ , VisagePatterns , AG2AspectAG , RhsCheck+ , Knuth1+ , KennedyWarren+ , KWOrder extensions: TypeSynonymInstances, MultiParamTypeClasses hs-source-dirs: src, src-derived
uuagc.cabal-for-ghc-6.6 view
@@ -1,5 +1,5 @@ name: uuagc-version: 0.9.38.3+version: 0.9.38.4 license: GPL license-file: LICENSE maintainer: Arie Middelkoop <ariem@cs.uu.nl>