1
1
mirror of https://github.com/github/semantic.git synced 2024-11-28 01:47:01 +03:00

Generalize addressStyle over the term type.

This commit is contained in:
Rob Rix 2019-07-29 12:38:10 -04:00
parent bd8f0ca4c1
commit d8175305da
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7

View File

@ -177,7 +177,7 @@ heapValueGraph h = heapGraph (const id) (const fromAddr) h
heapAddressGraph :: Heap term -> G.Graph (EdgeType term, Precise)
heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,) . either Edge Slot)
addressStyle :: Heap (Term (Core.Ann :+: Core.Core) User) -> G.Style (EdgeType (Term (Core.Ann :+: Core.Core) User), Precise) Text
addressStyle :: Heap term -> G.Style (EdgeType term, Precise) Text
addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
where vertex (_, addr) = pack (show addr) <> " = " <> maybe "?" fromConcrete (IntMap.lookup addr heap)
edgeAttributes _ (Slot name, _) = ["label" G.:= name]