syntactic-1.11: Generic abstract syntax, and utilities for embedded languages

Safe HaskellNone

Language.Syntactic.Sharing.Graph

Contents

Description

Representation and manipulation of abstract syntax graphs

Synopsis

Representation

newtype NodeId Source

Node identifier

Constructors

NodeId 

Fields

nodeInteger :: Integer
 

Instances

data Node a whereSource

Placeholder for a syntax tree

Constructors

Node :: NodeId -> Node (Full a) 

Instances

StringTree Node 
Render Node 
Constrained Node 
(AlphaEq dom dom dom env, NodeEqEnv dom env) => AlphaEq Node Node dom env 

class NodeEqEnv dom a whereSource

Environment for alpha-equivalence

Methods

prjNodeEqEnv :: a -> NodeEnv dom (Sat dom)Source

modNodeEqEnv :: (NodeEnv dom (Sat dom) -> NodeEnv dom (Sat dom)) -> a -> aSource

Instances

~ (* -> Constraint) p (Sat dom) => NodeEqEnv dom (EqEnv dom p) 

type EqEnv dom p = ([(VarId, VarId)], NodeEnv dom p)Source

type NodeEnv dom p = (Array NodeId Hash, Array NodeId (ASTB dom p))Source

data ASG dom a Source

"Abstract Syntax Graph"

A representation of a syntax tree with explicit sharing. An ASG is valid if and only if inlineAll succeeds (and the numNodes field is correct).

Constructors

ASG 

Fields

topExpression :: ASTF (NodeDomain dom) a

Top-level expression

graphNodes :: [(NodeId, ASTSAT (NodeDomain dom))]

Mapping from node id to sub-expression

numNodes :: NodeId

Total number of nodes

type NodeDomain dom = (Node :+: dom) :|| Sat domSource

showASG :: forall dom a. StringTree dom => ASG dom a -> StringSource

Show syntax graph using ASCII art

drawASG :: StringTree dom => ASG dom a -> IO ()Source

Print syntax graph using ASCII art

reindexNodesAST :: (NodeId -> NodeId) -> AST (NodeDomain dom) a -> AST (NodeDomain dom) aSource

Update the node identifiers in an AST using the supplied reindexing function

reindexNodes :: (NodeId -> NodeId) -> ASG dom a -> ASG dom aSource

Reindex the nodes according to the given index mapping. The number of nodes is unchanged, so if the index mapping is not 1:1, the resulting graph will contain duplicates.

reindexNodesFrom0 :: ASG dom a -> ASG dom aSource

Reindex the nodes to be in the range [0 .. l-1], where l is the number of nodes in the graph

nubNodes :: ASG dom a -> ASG dom aSource

Remove duplicate nodes from a graph. The function only looks at the NodeId of each node. The numNodes field is updated accordingly.

Folding

data SyntaxPF dom a whereSource

Pattern functor representation of an AST with Nodes

Constructors

AppPF :: a -> a -> SyntaxPF dom a 
NodePF :: NodeId -> a -> SyntaxPF dom a 
DomPF :: dom b -> SyntaxPF dom a 

Instances

foldGraph :: forall dom a b. (SyntaxPF dom b -> b) -> ASG dom a -> (b, (Array NodeId b, [(NodeId, b)]))Source

Folding over a graph

The user provides a function to fold a single constructor (an "algebra"). The result contains the result of folding the whole graph as well as the result of each internal node, represented both as an array and an association list. Each node is processed exactly once.

Inlining

inlineAll :: forall dom a. ConstrainedBy dom Typeable => ASG dom a -> ASTF dom aSource

Convert an ASG to an AST by inlining all nodes

nodeChildren :: ASG dom a -> [(NodeId, [NodeId])]Source

Find the child nodes of each node in an expression. The child nodes of a node n are the first nodes along all paths from n.

occurrences :: ASG dom a -> Array NodeId IntSource

Count the number of occurrences of each node in an expression

inlineSingle :: forall dom a. ConstrainedBy dom Typeable => ASG dom a -> ASG dom aSource

Inline all nodes that are not shared

Sharing

hashNodes :: Equality dom => ASG dom a -> (Array NodeId Hash, [(NodeId, Hash)])Source

Compute a table (both array and list representation) of hash values for each node

partitionNodes :: forall dom a. (Equality dom, AlphaEq dom dom (NodeDomain dom) (EqEnv (NodeDomain dom) (Sat dom))) => ASG dom a -> [[NodeId]]Source

Partitions the nodes such that two nodes are in the same sub-list if and only if they are alpha-equivalent.

cse :: (Equality dom, AlphaEq dom dom (NodeDomain dom) (EqEnv (NodeDomain dom) (Sat dom))) => ASG dom a -> ASG dom aSource

Common sub-expression elimination based on alpha-equivalence