INCLUDE "AbstractSyntax.ag" INCLUDE "HsToken.ag" INCLUDE "Expression.ag" INCLUDE "Patterns.ag" INCLUDE "DistChildAttr.ag" imports { import AbstractSyntax import HsToken import Expression import Patterns import Options import PPUtil import Pretty import Knuth1 import KennedyWarren import ExecutionPlan import Data.Maybe import Debug.Trace import Data.Set(Set) import Data.Map(Map) import Data.Sequence(Seq) import qualified Data.Set as Set import qualified Data.Map as Map import qualified Data.Sequence as Seq import Data.Monoid(mappend,mempty) } ------------------------------------------------------------------------------- -- Distributing options ------------------------------------------------------------------------------- ATTR Grammar Nonterminals Nonterminal Productions Production Children Child [ options : {Options} | | ] ------------------------------------------------------------------------------- -- Give unique names to rules ------------------------------------------------------------------------------- ATTR Nonterminal Nonterminals Production Productions Rule Rules [ | rulenumber : Int | ] SEM Grammar | Grammar nonts.rulenumber = 0 SEM Rule | Rule lhs.rulenumber = @lhs.rulenumber + 1 loc.rulename = maybe (identifier $ "rule" ++ show @lhs.rulenumber) id @mbName ------------------------------------------------------------------------------- -- Find out which nonterminals are recursive ------------------------------------------------------------------------------- ATTR Nonterminals Nonterminal [ | | ntDeps, ntHoDeps USE {`mappend`} {mempty} : {Map NontermIdent (Set NontermIdent)} ] ATTR Nonterminals Nonterminal [ closedNtDeps, closedHoNtDeps, closedHoNtRevDeps : {Map NontermIdent (Set NontermIdent)} | | ] ATTR Productions Production Children Child [ | | refNts, refHoNts USE {`mappend`} {mempty} : {Set NontermIdent} ] SEM Nonterminal | Nonterminal lhs.ntDeps = Map.singleton @nt @prods.refNts lhs.ntHoDeps = Map.singleton @nt @prods.refHoNts loc.closedNtDeps = Map.findWithDefault Set.empty @nt @lhs.closedNtDeps loc.closedHoNtDeps = Map.findWithDefault Set.empty @nt @lhs.closedHoNtDeps loc.closedHoNtRevDeps = Map.findWithDefault Set.empty @nt @lhs.closedHoNtRevDeps loc.recursive = @nt `Set.member` @loc.closedNtDeps loc.nontrivAcyc = @nt `Set.member` @loc.closedHoNtDeps loc.hoInfo = HigherOrderInfo { hoNtDeps = @loc.closedHoNtDeps , hoNtRevDeps = @loc.closedHoNtRevDeps , hoAcyclic = @loc.nontrivAcyc } SEM Child | Child loc.refNts = case @tp of NT nt _ _ -> Set.singleton nt _ -> mempty loc.refHoNts = if @loc.isHigherOrder then @loc.refNts else mempty loc.isHigherOrder = case @kind of ChildSyntax -> False _ -> True SEM Grammar | Grammar loc.closedNtDeps = closeMap @nonts.ntDeps loc.closedHoNtDeps = closeMap @nonts.ntHoDeps loc.closedHoNtRevDeps = revDeps @loc.closedHoNtDeps ------------------------------------------------------------------------------- -- Determine which children have an around-rule ------------------------------------------------------------------------------- -- Propagate the around-map downward ATTR Nonterminals Nonterminal [ aroundMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} || ] ATTR Productions Production [ aroundMap : {Map ConstructorIdent (Map Identifier [Expression])} || ] ATTR Children Child [ aroundMap : {Map Identifier [Expression]} | | ] SEM Nonterminal | Nonterminal loc.aroundMap = Map.findWithDefault Map.empty @nt @lhs.aroundMap SEM Production | Production loc.aroundMap = Map.findWithDefault Map.empty @con @lhs.aroundMap SEM Grammar | Grammar nonts.aroundMap = @aroundsMap SEM Child | Child loc.hasArounds = case Map.lookup @name @lhs.aroundMap of Nothing -> False Just as -> not (null as) ------------------------------------------------------------------------------- -- Determine which children are used by merges ------------------------------------------------------------------------------- -- Propagate the around-map downward ATTR Nonterminals Nonterminal [ mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} || ] ATTR Productions Production [ mergeMap : {Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))} || ] ATTR Children Child [ mergeMap : {Map Identifier (Identifier, [Identifier], Expression)} mergedChildren : {Set Identifier} | | ] SEM Nonterminal | Nonterminal loc.mergeMap = Map.findWithDefault Map.empty @nt @lhs.mergeMap SEM Production | Production loc.mergeMap = Map.findWithDefault Map.empty @con @lhs.mergeMap SEM Grammar | Grammar nonts.mergeMap = @mergeMap SEM Production | Production loc.mergedChildren = Set.unions [ Set.fromList ms | (_,ms,_) <- Map.elems @loc.mergeMap ] SEM Child | Child loc.merges = maybe Nothing (\(_,ms,_) -> Just ms) $ Map.lookup @name @lhs.mergeMap loc.isMerged = @name `Set.member` @lhs.mergedChildren ------------------------------------------------------------------------------- -- Distribute the ContextMap to nonterminals ------------------------------------------------------------------------------- ATTR Nonterminals Nonterminal [ classContexts : ContextMap | | ] SEM Grammar | Grammar nonts.classContexts = @contextMap SEM Nonterminal | Nonterminal loc.classContexts = Map.findWithDefault [] @nt @lhs.classContexts ------------------------------------------------------------------------------- -- Gather all rules per production for the execution plan ------------------------------------------------------------------------------- ATTR Expression [ | | copy : SELF ] ATTR Rule [ | | erules : ERule ] ATTR Rules [ | | erules USE {:} {[]} : ERules ] SEM Rule | Rule lhs.erules = ERule @loc.rulename @pattern.copy @rhs.copy @owrt @origin @explicit @pure @mbError ------------------------------------------------------------------------------- -- Gather all childs per production for the execution plan ------------------------------------------------------------------------------- ATTR Child [ | | echilds : EChild ] ATTR Children [ | | echilds USE {:} {[]} : EChildren ] SEM Child | Child lhs.echilds = case @tp of NT _ _ _ -> EChild @name @tp @kind @loc.hasArounds @loc.merges @loc.isMerged _ -> ETerm @name @tp ------------------------------------------------------------------------------- -- Dependency graph per production ------------------------------------------------------------------------------- -- Gather vertices ATTR HsToken Expression Rule Rules Pattern Patterns Child Children [ | | vertices USE {`Set.union`} {Set.empty} : {Set.Set Vertex} ] -- All vertices from the righthandside of a rule SEM HsToken | AGLocal lhs.vertices = Set.singleton $ VChild @var | AGField lhs.vertices = Set.singleton $ VAttr (if @field == _LHS then Inh else if @field == _LOC then Loc else Syn) @field @attr -- Gather vertices for an expression (make a higher order child) SEM Expression | Expression lhs.vertices = Set.unions $ map (\tok -> vertices_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) @tks -- Gather vertices at patterns SEM Pattern | Alias loc.vertex = if @field == _INST then VChild @attr else VAttr (if @field == _LHS then Syn else if @field == _LOC then Loc else Inh) @field @attr lhs.vertices = Set.insert @loc.vertex @pat.vertices -- Gather vertices for children -- -- The behavior for merged children is a bit more complicated (and ignored for now) SEM Child | Child loc.vertex = VChild @name loc.synvertices = map (VAttr Syn @name) . Map.keys $ @loc.syn loc.inhvertices = map (VAttr Inh @name) . Map.keys $ @loc.inh lhs.vertices = case @tp of -- only Nonterminal children need to be in dependency graph NT _ _ _ -> Set.insert @loc.vertex $ Set.fromList (@loc.synvertices ++ @loc.inhvertices) _ -> Set.empty -- Add extra vertex for a rule SEM Rule | Rule loc.vertex = VRule @loc.rulename lhs.vertices = Set.insert @loc.vertex $ @pattern.vertices `Set.union` @rhs.vertices -- Combine all vertices for a production SEM Production | Production loc.vertices = @rules.vertices `Set.union` @children.vertices -- Gather edges ATTR Rule Rules Child Children [ | | edges USE {`Set.union`} {Set.empty} : {Set.Set Edge} ] -- Gather edges for a rule SEM Rule | Rule loc.edgesout = map ((,) @loc.vertex) (Set.toList @rhs.vertices) loc.edgesin = map (flip (,) @loc.vertex) (Set.toList @pattern.vertices) lhs.edges = Set.fromList $ @loc.edgesout ++ @loc.edgesin -- When a child is defined by a higher order attribute and the late binding option -- is enabled, we refer to the additional inherited attribute under the hood, hence -- we need to tell the dependency analysis about this in order to actually have the -- attribute available when we attach the child. -- Note that the dependencies on the rule that creates the semantics of the child -- is handled elsewhere by mapping an "inst"-attribute to the right child vertex. SEM Child | Child loc.childIsDeforested = case @tp of NT _ _ defor -> defor _ -> False loc.higherOrderEdges = case @kind of ChildAttr | lateHigherOrderBinding @lhs.options && not @loc.childIsDeforested -> [(@loc.vertex, VAttr Inh _LHS idLateBindingAttr)] _ -> [] -- attribute is not referenced implicitly loc.aroundEdges = if @loc.hasArounds then [(@loc.vertex, VAttr Syn _LOC (Ident (getName @name ++ "_around") (getPos @name)))] else [] -- Gather edges for a child SEM Child | Child loc.edgesout = @loc.higherOrderEdges loc.edgesin = map (flip (,) @loc.vertex) @loc.synvertices lhs.edges = Set.fromList (@loc.edgesout ++ @loc.edgesin) -- Add manual attribute dependencies ATTR Nonterminals Nonterminal [ manualDeps : AttrOrderMap | | ] ATTR Productions Production [ manualDeps : {Map ConstructorIdent (Set Dependency)} | | ] SEM Grammar | Grammar nonts.manualDeps = @manualAttrOrderMap SEM Nonterminal | Nonterminal prods.manualDeps = Map.findWithDefault Map.empty @nt @lhs.manualDeps SEM Production | Production loc.manualDeps = Map.findWithDefault Set.empty @con @lhs.manualDeps loc.manualEdges = Set.map depToEdge @loc.manualDeps { -- a depends on b, thus a is a successor of b depToEdge :: Dependency -> Edge depToEdge (Dependency a b) = (occToVertex False b, occToVertex True a) occToVertex :: Bool -> Occurrence -> Vertex occToVertex _ (OccRule nm) = VRule nm occToVertex isDependency (OccAttr c a) | c == _LOC = VAttr Syn c a -- local attributes are treated as synthesized attrs of 'loc' | c == _INST = VChild a -- higher-order attributes are treated as children | otherwise = VAttr kind c a where kind | isDependency && c == _LHS = Inh -- these dependencies have the property that | isDependency && c /= _LHS = Syn -- they can all be faked by writing a 'const' rule | not isDependency && c == _LHS = Syn -- Perhaps we should also allow other forms of dependencies | not isDependency && c /= _LHS = Inh -- as well, such as two inherited attributes, which would -- force them in different visits } -- Combine all edges for a production SEM Production | Production loc.edges = @rules.edges `Set.union` @children.edges -- Find all child nonterminal names for a production ATTR Child Children [ | | nontnames USE {++} {[]} : {[(Identifier, Identifier)]}] SEM Child | Child lhs.nontnames = case @tp of NT nont _ _ -> [(@name, nont)] _ -> [] -- Return a dependency graph for each production ATTR Production [ | | depgraph : {ProdDependencyGraph} ] ATTR Productions [ | | depgraph USE {:} {[]} : {[ProdDependencyGraph]} ] SEM Production | Production lhs.depgraph = ProdDependencyGraph { pdgVertices = Set.toList @loc.vertices , pdgEdges = Set.toList @loc.edges , pdgRules = @rules.erules , pdgChilds = @children.echilds , pdgProduction = @con , pdgChildMap = @children.nontnames , pdgConstraints = @constraints , pdgParams = @params } ------------------------------------------------------------------------------- -- Dependency graph per nonterminal ------------------------------------------------------------------------------- -- Vertices are just all inherited and syntesized attributes SEM Nonterminal | Nonterminal loc.synvertices = map (VAttr Syn @nt) . Map.keys $ @syn loc.inhvertices = map (VAttr Inh @nt) . Map.keys $ @inh loc.vertices = @loc.synvertices ++ @loc.inhvertices -- Construct nonterminal dependency graph for production SEM Nonterminal | Nonterminal loc.nontgraph = NontDependencyGraph { ndgVertices = @loc.vertices , ndgEdges = [] } -- Create dependency information for nonterminal and pass it upwards ATTR Nonterminal [ | | depinfo : {NontDependencyInformation} ] ATTR Nonterminals [ | | depinfo USE {:} {[]} : {[NontDependencyInformation]} ] SEM Nonterminal | Nonterminal lhs.depinfo = NontDependencyInformation { ndiNonterminal = @nt , ndiParams = @params , ndiInh = Map.keys @inh , ndiSyn = Map.keys @syn , ndiDepGraph = @loc.nontgraph , ndiProds = @prods.depgraph , ndiRecursive = @loc.recursive , ndiHoInfo = @loc.hoInfo , ndiClassCtxs = @loc.classContexts } ------------------------------------------------------------------------------- -- Call the kennedy-warren algorithm ------------------------------------------------------------------------------- ATTR Grammar [ | | output : {ExecutionPlan} depgraphs : {PP_Doc} visitgraph : {PP_Doc} errors : {Seq Error} ] SEM Grammar | Grammar (lhs.output, lhs.depgraphs, lhs.visitgraph, lhs.errors) = let lazyPlan = kennedyWarrenLazy @lhs.options @wrappers @nonts.depinfo @typeSyns @derivings in if visit @lhs.options && withCycle @lhs.options then case kennedyWarrenOrder @lhs.options @wrappers @nonts.depinfo @typeSyns @derivings of Left e -> (lazyPlan,empty,empty,Seq.singleton e) Right (o,d,v) -> (o,d,v,Seq.empty) else (lazyPlan,empty,empty,Seq.empty) ------------------------------------------------------------------------------- -- Output nonterminal type mappings ------------------------------------------------------------------------------- ATTR Grammar Nonterminals [ | | inhmap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent Attributes} synmap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent Attributes} ] ATTR Nonterminal [ | | inhmap : {Map.Map NontermIdent Attributes} synmap : {Map.Map NontermIdent Attributes} ] SEM Nonterminal | Nonterminal lhs.inhmap = Map.singleton @nt @inh lhs.synmap = Map.singleton @nt @syn ------------------------------------------------------------------------------- -- Output nonterminal type mappings ------------------------------------------------------------------------------- ATTR Grammar Nonterminals Nonterminal [ | | localSigMap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))} ] ATTR Productions Production [ | | localSigMap USE {`Map.union`} {Map.empty} : {Map.Map ConstructorIdent (Map.Map Identifier Type)} ] ATTR TypeSigs TypeSig [ | | localSigMap USE {`Map.union`} {Map.empty} : {Map Identifier Type} ] SEM Nonterminal | Nonterminal lhs.localSigMap = Map.singleton @nt @prods.localSigMap SEM Production | Production lhs.localSigMap = Map.singleton @con @typeSigs.localSigMap SEM TypeSig | TypeSig lhs.localSigMap = Map.singleton @name @tp