From e7aefb81869f7c5a68e50d303d8fbf3d53f80d05 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 11 Oct 2019 11:00:14 -0400 Subject: [PATCH] Generalize addressStyle over the name type. --- semantic-core/src/Analysis/Concrete.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs index 00d6025e3..856945692 100644 --- a/semantic-core/src/Analysis/Concrete.hs +++ b/semantic-core/src/Analysis/Concrete.hs @@ -198,8 +198,8 @@ heapValueGraph h = heapGraph (const id) (const fromAddr) h heapAddressGraph :: Heap term name -> G.Graph (EdgeType term name, Precise) heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,) . either Edge Slot) -addressStyle :: Heap term Name -> G.Style (EdgeType term Name, Precise) Text -addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes } +addressStyle :: (name -> Text) -> Heap term name -> G.Style (EdgeType term name, Precise) Text +addressStyle unName heap = (G.defaultStyle vertex) { G.edgeAttributes } where vertex (_, addr) = pack (show addr) <> " = " <> maybe "?" fromConcrete (IntMap.lookup addr heap) edgeAttributes _ (Slot name, _) = ["label" G.:= unName name] edgeAttributes _ (Edge Import, _) = ["color" G.:= "blue"]