diff --git a/brat/Brat/Compiler.hs b/brat/Brat/Compiler.hs index 65269346..9fee6a53 100644 --- a/brat/Brat/Compiler.hs +++ b/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) {- diff --git a/brat/Brat/Dot.hs b/brat/Brat/Dot.hs index f5907a77..8c97e767 100644 --- a/brat/Brat/Dot.hs +++ b/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 diff --git a/brat/test/compilation/closures.brat b/brat/test/compilation/closures.brat index 7dd6e747..b8d8228c 100644 --- a/brat/test/compilation/closures.brat +++ b/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) }