github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-24 23:42:31 +03:00
Code Issues Projects Releases Wiki Activity

Generalize addressStyle over the name type.

Browse Source
This commit is contained in:
Rob Rix 2019-10-11 11:00:14 -04:00
parent 0eb9edf2ef
commit e7aefb8186
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 2 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
semantic-core/src/Analysis/Concrete.hs
View File

@ -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"]