From a563b18a800093b2f84d8211effd8ebaac5ee794 Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Fri, 1 May 2026 17:25:51 +0100 Subject: [PATCH 1/7] Add SrcEdge (now misnamed) from Box to its Target too --- brat/Brat/Dot.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/brat/Brat/Dot.hs b/brat/Brat/Dot.hs index 17aed1fc..8e75d5e9 100644 --- a/brat/Brat/Dot.hs +++ b/brat/Brat/Dot.hs @@ -50,7 +50,7 @@ toDotString (ns,ws) = unpack . GV.printDotGraph $ GV.graphElemsToDot params vert getRefEdge :: Name' -> Node -> [(Name', Name', EdgeType)] getRefEdge x (BratNode (Eval (Ex y _)) _ _) = [(Name' y, x, EvalEdge)] getRefEdge x (KernelNode (Splice (Ex y _)) _ _) = [(Name' y, x, EvalEdge)] - getRefEdge x (BratNode (Box src _) _ _) = [(x, Name' src, SrcEdge)] + getRefEdge x (BratNode (Box src tgt) _ _) = [(x, Name' src, SrcEdge), (x, Name' tgt, SrcEdge)] getRefEdge _ _ = [] -- Map all nodes in a box to the src node From c58555221f8192d655265cebaafc23657eb98c99 Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Fri, 1 May 2026 17:31:47 +0100 Subject: [PATCH 2/7] Shorten Box/Eval titles --- brat/Brat/Dot.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/brat/Brat/Dot.hs b/brat/Brat/Dot.hs index 8e75d5e9..e7cb798b 100644 --- a/brat/Brat/Dot.hs +++ b/brat/Brat/Dot.hs @@ -90,6 +90,9 @@ toDotString (ns,ws) = unpack . GV.printDotGraph $ GV.graphElemsToDot params vert } showNodeType :: Node -> String + -- Do not repeat the internal links that have been turned into edges + showNodeType (BratNode (Box _ _) _ _) = "Box" + showNodeType (BratNode (Eval _) _ _) = "Eval" showNodeType (BratNode thing _ _) = show thing showNodeType (KernelNode thing _ _) = show thing From d4cd10202c81de793ba55b54f9de9ce3b24ddcc9 Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Fri, 1 May 2026 17:27:25 +0100 Subject: [PATCH 3/7] Make ClusterType be String not Name', correct comment as to what's in the box --- brat/Brat/Dot.hs | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/brat/Brat/Dot.hs b/brat/Brat/Dot.hs index e7cb798b..44072603 100644 --- a/brat/Brat/Dot.hs +++ b/brat/Brat/Dot.hs @@ -53,23 +53,24 @@ toDotString (ns,ws) = unpack . GV.printDotGraph $ GV.graphElemsToDot params vert getRefEdge x (BratNode (Box src tgt) _ _) = [(x, Name' src, SrcEdge), (x, Name' tgt, SrcEdge)] getRefEdge _ _ = [] - -- Map all nodes in a box to the src node - clusterMap :: M.Map Name' Name' + -- Map from node to cluster. Clusters are named after the Src node of the box. + clusterMap :: M.Map Name' String clusterMap = foldr f M.empty verts where (g, toNode, toVert) = toGraph (ns, ws) f (_, node) m = case node of BratNode (Box src tgt) _ _ -> -- Find all nodes in the box spanned by src and tgt, i.e. all nodes - -- reachable from src that can reach tgt + -- reachable from src *or* that can reach tgt let srcReaches = reachable g (fromJust (toVert src)) reachesTgt = reachable (transposeG g) (fromJust (toVert tgt)) - box = Name' . snd3 . toNode <$> (srcReaches ++ reachesTgt) in - foldr (`M.insert` Name' src) m box + nodesInBox = Name' . snd3 . toNode <$> (srcReaches ++ reachesTgt) + cluster = show src + in foldr (`M.insert` cluster) m nodesInBox _ -> m -- GV.GraphVisParams vertexType vertexLabelType edgeLabelType clusterType clusterLabelType - params :: GV.GraphvizParams Name' Node EdgeType Name' Node + params :: GV.GraphvizParams Name' Node EdgeType String Node params = GV.defaultParams { GV.fmtNode = \(Name' name, node) -> [ GV.textLabel (pack $ show name ++ ":\\n" ++ showNodeType node), @@ -84,9 +85,9 @@ toDotString (ns,ws) = unpack . GV.printDotGraph $ GV.graphElemsToDot params vert GV.arrowTo (arrow label) ], GV.clusterBy = \n@(name, _) -> case clusterMap M.!? name of - Just parent -> GV.C parent $ GV.N n + Just clust -> GV.C clust $ GV.N n Nothing -> GV.N n, - GV.clusterID = \(Name' name) -> GV.Str (pack $ show name) + GV.clusterID = GV.Str . pack } showNodeType :: Node -> String From 399203b19e7f9d8f1727336b6691c6b851414b5a Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Fri, 1 May 2026 17:43:56 +0100 Subject: [PATCH 4/7] Exclude nodes captured by Box from box contents --- brat/Brat/Compiler.hs | 4 ++-- brat/Brat/Dot.hs | 33 ++++++++++++++++++----------- brat/test/compilation/closures.brat | 15 ------------- 3 files changed, 23 insertions(+), 29 deletions(-) diff --git a/brat/Brat/Compiler.hs b/brat/Brat/Compiler.hs index e1bd3534..5a88aa20 100644 --- a/brat/Brat/Compiler.hs +++ b/brat/Brat/Compiler.hs @@ -60,8 +60,8 @@ writeDot :: [FilePath] -> String -> String -> IO () writeDot libDirs file out = do env <- runExceptT $ loadFilename root libDirs file -- Discard captureSets; perhaps we could incorporate into the graph - (_, _, _, graph, _) <- eitherIO env - writeFile out (toDotString graph) + (_, _, _, graph, cs) <- eitherIO env + writeFile out (toDotString graph cs) {- where isMain (PrefixName [] "main", _) = True diff --git a/brat/Brat/Dot.hs b/brat/Brat/Dot.hs index 44072603..a004215e 100644 --- a/brat/Brat/Dot.hs +++ b/brat/Brat/Dot.hs @@ -1,5 +1,6 @@ module Brat.Dot (toDotString) where +import Brat.Checker.Monad (CaptureSets) import Brat.Naming import Brat.Graph import Brat.Syntax.Common @@ -11,7 +12,9 @@ import qualified Data.GraphViz.Printing as GV import qualified Data.GraphViz.Attributes.Complete as GV import qualified Data.Map as M +import qualified Data.Set as S import Data.Text.Lazy (pack, unpack) +import Data.Maybe (fromMaybe) import Data.Bifunctor (first) import Data.Graph (reachable, transposeG) import Data.Maybe (fromJust) @@ -34,9 +37,10 @@ instance Show EdgeType where show (GraphEdge ty) = show ty -toDotString :: Graph -> String -toDotString (ns,ws) = unpack . GV.printDotGraph $ GV.graphElemsToDot params verts edges +toDotString :: Graph -> CaptureSets -> String +toDotString (ns,ws) cs = unpack . GV.printDotGraph $ GV.graphElemsToDot params verts edges where + _ = cs verts :: [(Name', Node)] verts = first Name' <$> M.toList ns @@ -58,16 +62,21 @@ toDotString (ns,ws) = unpack . GV.printDotGraph $ GV.graphElemsToDot params vert clusterMap = foldr f M.empty verts where (g, toNode, toVert) = toGraph (ns, ws) - f (_, node) m = case node of - BratNode (Box src tgt) _ _ -> - -- Find all nodes in the box spanned by src and tgt, i.e. all nodes - -- reachable from src *or* that can reach tgt - let srcReaches = reachable g (fromJust (toVert src)) - reachesTgt = reachable (transposeG g) (fromJust (toVert tgt)) - nodesInBox = Name' . snd3 . toNode <$> (srcReaches ++ reachesTgt) - cluster = show src - in foldr (`M.insert` cluster) m nodesInBox - _ -> m + f (Name' boxNode, BratNode (Box src tgt) _ _) m = + -- Find all nodes in the box spanned by src and tgt, i.e. all nodes + -- reachable from src that can reach tgt + let srcReaches = reachable g (fromJust (toVert src)) + reachesTgt = reachable (transposeG g) (fromJust (toVert tgt)) + nodesUsedInBox = snd3 . toNode <$> (srcReaches ++ reachesTgt) + -- exclude nodes that are captured by the box - these are not in the box + -- (TODO: we might consider adding extra edges from these to the box itself, + -- but for now they'll just have "normal" value edges *entering* the box) + captures = fromMaybe M.empty (M.lookup boxNode cs) + captureNodes = S.fromList [n | vs <- M.elems captures, (NamedPort (Ex n _) _, _) <- vs] + nodesInBox = [Name' n | n <- nodesUsedInBox, S.notMember n captureNodes] + cluster = show src + in foldr (`M.insert` cluster) m nodesInBox + f _ m = m -- GV.GraphVisParams vertexType vertexLabelType edgeLabelType clusterType clusterLabelType params :: GV.GraphvizParams Name' Node EdgeType String Node diff --git a/brat/test/compilation/closures.brat b/brat/test/compilation/closures.brat index b8d8228c..7dd6e747 100644 --- a/brat/test/compilation/closures.brat +++ b/brat/test/compilation/closures.brat @@ -1,17 +1,2 @@ f(Nat) -> { Nat -> Nat } f(x) = { y => x + y } - -g(Nat) -> { Nat -> { Nat -> Nat } } -g(x) = { y => { z => x + y + z } } - - -h(Nat) -> { Nat -> Nat } -h(x) = let y = x in { z => x + y + z } - -ff(Vec(Nat,2)) -> { Nat -> Nat } -ff([a,b]) = { y => a + b*y } - -ext "to_float" i2f :: {Int -> Float} - -fi(Float) -> { Int -> Float } -fi(x) = { y => x + i2f(y) } From aff688d4f3fbce1e99cd80d275523256d477bdc2 Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Fri, 1 May 2026 18:18:04 +0100 Subject: [PATCH 5/7] Refactor: ID clusters by Box --- brat/Brat/Dot.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/brat/Brat/Dot.hs b/brat/Brat/Dot.hs index a004215e..a3dbded2 100644 --- a/brat/Brat/Dot.hs +++ b/brat/Brat/Dot.hs @@ -57,8 +57,8 @@ toDotString (ns,ws) cs = unpack . GV.printDotGraph $ GV.graphElemsToDot params v getRefEdge x (BratNode (Box src tgt) _ _) = [(x, Name' src, SrcEdge), (x, Name' tgt, SrcEdge)] getRefEdge _ _ = [] - -- Map from node to cluster. Clusters are named after the Src node of the box. - clusterMap :: M.Map Name' String + -- Map from node to cluster. Clusters are identified by their containing Box node. + clusterMap :: M.Map Name' Name clusterMap = foldr f M.empty verts where (g, toNode, toVert) = toGraph (ns, ws) @@ -74,12 +74,11 @@ toDotString (ns,ws) cs = unpack . GV.printDotGraph $ GV.graphElemsToDot params v captures = fromMaybe M.empty (M.lookup boxNode cs) captureNodes = S.fromList [n | vs <- M.elems captures, (NamedPort (Ex n _) _, _) <- vs] nodesInBox = [Name' n | n <- nodesUsedInBox, S.notMember n captureNodes] - cluster = show src - in foldr (`M.insert` cluster) m nodesInBox + in foldr (`M.insert` boxNode) m nodesInBox f _ m = m -- GV.GraphVisParams vertexType vertexLabelType edgeLabelType clusterType clusterLabelType - params :: GV.GraphvizParams Name' Node EdgeType String Node + params :: GV.GraphvizParams Name' Node EdgeType Name Node params = GV.defaultParams { GV.fmtNode = \(Name' name, node) -> [ GV.textLabel (pack $ show name ++ ":\\n" ++ showNodeType node), @@ -96,7 +95,7 @@ toDotString (ns,ws) cs = unpack . GV.printDotGraph $ GV.graphElemsToDot params v GV.clusterBy = \n@(name, _) -> case clusterMap M.!? name of Just clust -> GV.C clust $ GV.N n Nothing -> GV.N n, - GV.clusterID = GV.Str . pack + GV.clusterID = GV.Str . pack . show } showNodeType :: Node -> String From 03a9a14e6dda13b8103129401d7446d5d95f41bf Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Fri, 1 May 2026 18:19:42 +0100 Subject: [PATCH 6/7] Nest clusters --- brat/Brat/Dot.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/brat/Brat/Dot.hs b/brat/Brat/Dot.hs index a3dbded2..cceb3c7d 100644 --- a/brat/Brat/Dot.hs +++ b/brat/Brat/Dot.hs @@ -92,12 +92,16 @@ toDotString (ns,ws) cs = unpack . GV.printDotGraph $ GV.graphElemsToDot params v GV.Style [style label], GV.arrowTo (arrow label) ], - GV.clusterBy = \n@(name, _) -> case clusterMap M.!? name of - Just clust -> GV.C clust $ GV.N n - Nothing -> GV.N n, + GV.clusterBy = \n@(name, _) -> nestClusters name (GV.N n), GV.clusterID = GV.Str . pack . show } + nestClusters :: Name' -> GV.NodeCluster Name (Name', Node) -> GV.NodeCluster Name (Name', Node) + nestClusters name n = case clusterMap M.!? name of + Nothing -> n + -- put n in clust, which may itself be in another cluster + Just clust -> nestClusters (Name' clust) (GV.C clust n) + showNodeType :: Node -> String -- Do not repeat the internal links that have been turned into edges showNodeType (BratNode (Box _ _) _ _) = "Box" From 002e0c4cca06a981961d1b914480b423ea5dbc94 Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Sat, 2 May 2026 00:08:53 +0100 Subject: [PATCH 7/7] oops remove defunct _ --- brat/Brat/Dot.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/brat/Brat/Dot.hs b/brat/Brat/Dot.hs index cceb3c7d..f5907a77 100644 --- a/brat/Brat/Dot.hs +++ b/brat/Brat/Dot.hs @@ -40,7 +40,6 @@ instance Show EdgeType where toDotString :: Graph -> CaptureSets -> String toDotString (ns,ws) cs = unpack . GV.printDotGraph $ GV.graphElemsToDot params verts edges where - _ = cs verts :: [(Name', Node)] verts = first Name' <$> M.toList ns