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

🔥 frameEdges.

Browse Source
This commit is contained in:
Rob Rix 2019-07-22 11:31:47 -04:00
parent d41d7757fe
commit 384c221ef6
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 6 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -27,7 +27,6 @@ import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet import qualified Data.IntSet as IntSet
import Data.Loc import Data.Loc
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Monoid (Alt(..))
import Data.Name import Data.Name
import Data.Term import Data.Term
import Data.Text (Text, pack) import Data.Text (Text, pack)
@ -52,9 +51,8 @@ objectFrame :: Concrete -> Maybe Frame
objectFrame (Obj frame) = Just frame objectFrame (Obj frame) = Just frame
objectFrame _ = Nothing objectFrame _ = Nothing
data Frame = Frame newtype Frame = Frame
{ frameEdges :: [(Core.Edge, Precise)] { frameSlots :: Env
, frameSlots :: Env
} }
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
@ -122,7 +120,7 @@ concreteAnalysis = Analysis{..}
addr <- alloc name addr <- alloc name
assign addr value assign addr value
pure (name, addr) pure (name, addr)
pure (Obj (Frame [] (Map.fromList fields'))) pure (Obj (Frame (Map.fromList fields')))
addr ... n = do addr ... n = do
val <- deref addr val <- deref addr
heap <- get heap <- get
@ -135,9 +133,9 @@ lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
where -- look up the name in a concrete value where -- look up the name in a concrete value
inConcrete = inFrame <=< maybeA . objectFrame inConcrete = inFrame <=< maybeA . objectFrame
-- look up the name in a specific 'Frame', with slots taking precedence over parents -- look up the name in a specific 'Frame', with slots taking precedence over parents
inFrame (Frame ps fs) = maybeA (Map.lookup name fs) <|> getAlt (foldMap (Alt . inAddress . snd) ps) inFrame (Frame fs) = maybeA (Map.lookup name fs)
-- look up the name in the value an address points to, if we haven’t already visited it -- look up the name in the value an address points to, if we haven’t already visited it
inAddress addr = do _inAddress addr = do
visited <- get visited <- get
guard (addr `IntSet.notMember` visited) guard (addr `IntSet.notMember` visited)
-- FIXME: throw an error if we can’t deref @addr@ -- FIXME: throw an error if we can’t deref @addr@
@ -165,7 +163,7 @@ heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
String _ -> G.empty String _ -> G.empty
Closure _ _ _ -> G.empty Closure _ _ _ -> G.empty
Obj frame -> fromFrame frame Obj frame -> fromFrame frame
fromFrame (Frame es ss) = foldr (G.overlay . uncurry (edge . Left)) (foldr (G.overlay . uncurry (edge . Right)) G.empty (Map.toList ss)) es fromFrame (Frame ss) = foldr (G.overlay . uncurry (edge . Right)) G.empty (Map.toList ss)
heapValueGraph :: Heap -> G.Graph Concrete heapValueGraph :: Heap -> G.Graph Concrete
heapValueGraph h = heapGraph (const id) (const fromAddr) h heapValueGraph h = heapGraph (const id) (const fromAddr) h