Better dot rendering of PatternMatch

brat/Brat/Compiler.hs

@@ -66,7 +66,6 @@ printAST printRaw printAST file = do
 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, cs) <- eitherIO env
   writeFile out (toDotString graph cs)
 {-

brat/Brat/Dot.hs

@@ -13,6 +13,7 @@ import qualified Data.GraphViz.Attributes.Complete as GV
 
 import qualified Data.Map as M
 import qualified Data.Set as S
+import Data.List.NonEmpty (NonEmpty(..))
 import Data.Text.Lazy (pack, unpack)
 import Data.Maybe (fromMaybe)
 import Data.Bifunctor (first)
@@ -29,11 +30,12 @@ instance (GV.PrintDot Name') where
   toDot  (Name' name) =  GV.text . pack $ "\"" ++ show name ++ "\""
 
 
-data EdgeType = EvalEdge | SrcEdge | GraphEdge (Val Z)
+data EdgeType = EvalEdge | SrcEdge | CaseEdge | GraphEdge (Val Z)
 
 instance Show EdgeType where
   show EvalEdge = ""
   show SrcEdge = ""
+  show CaseEdge = ""
   show (GraphEdge ty) = show ty
 
 
@@ -54,6 +56,8 @@ toDotString (ns,ws) cs = unpack . GV.printDotGraph $ GV.graphElemsToDot params v
   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 tgt) _ _) = [(x, Name' src, SrcEdge), (x, Name' tgt, SrcEdge)]
+  getRefEdge x (BratNode (PatternMatch (p:|pats)) _ _) =
+    [ (x, Name' innerBox, CaseEdge) | (_, innerBox) <- (p:pats) ]
   getRefEdge _ _ = []
 
   -- Map from node to cluster. Clusters are identified by their containing Box node.
@@ -66,7 +70,11 @@ toDotString (ns,ws) cs = unpack . GV.printDotGraph $ GV.graphElemsToDot params v
       -- 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)
+          nodesReachedInBox = snd3 . toNode <$> (srcReaches ++ reachesTgt)
+          -- Add any Box nodes used by PatternMatch nodes in the cluster
+          matches = M.fromList [(n, p:ps) | n <- nodesReachedInBox,
+                                            Just (BratNode (PatternMatch (p:|ps)) _ _) <- [ns M.!? n]]
+          nodesUsedInBox = nodesReachedInBox ++ map snd (concat (M.elems matches))
           -- 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)
@@ -105,6 +113,7 @@ toDotString (ns,ws) cs = unpack . GV.printDotGraph $ GV.graphElemsToDot params v
   -- Do not repeat the internal links that have been turned into edges
   showNodeType (BratNode (Box _ _) _ _) = "Box"
   showNodeType (BratNode (Eval _) _ _) = "Eval"
+  showNodeType (BratNode (PatternMatch _) _ _) = "PatternMatch"
   showNodeType (BratNode thing _ _) = show thing
   showNodeType (KernelNode thing _ _) = show thing
 

brat/test/compilation/closures.brat

@@ -1,2 +1,17 @@
 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) }