uuagc-0.9.51: src-ag/KWOrder.ag
INCLUDE "AbstractSyntax.ag"
INCLUDE "HsToken.ag"
INCLUDE "Expression.ag"
INCLUDE "Patterns.ag"
INCLUDE "DistChildAttr.ag"
INCLUDE "ExecutionPlanPre.ag"
INCLUDE "ExecutionPlanCommon.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)
}
-------------------------------------------------------------------------------
-- 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)