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

Bind and look names up in an Env.

This commit is contained in:
Rob Rix 2019-07-22 11:23:59 -04:00
parent fea81ee213
commit 6c5240bfba
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7

View File

@ -83,10 +83,12 @@ runFile :: ( Carrier sig m
runFile file = traverse run file runFile file = traverse run file
where run = runReader (fileLoc file) where run = runReader (fileLoc file)
. runFailWithLoc . runFailWithLoc
. runReader (mempty :: Env)
. fix (eval concreteAnalysis) . fix (eval concreteAnalysis)
concreteAnalysis :: ( Carrier sig m concreteAnalysis :: ( Carrier sig m
, Member Fresh sig , Member Fresh sig
, Member (Reader Env) sig
, Member (Reader Loc) sig , Member (Reader Loc) sig
, Member (Reader FrameId) sig , Member (Reader FrameId) sig
, Member (State Heap) sig , Member (State Heap) sig
@ -95,12 +97,8 @@ concreteAnalysis :: ( Carrier sig m
=> Analysis Precise Concrete m => Analysis Precise Concrete m
concreteAnalysis = Analysis{..} concreteAnalysis = Analysis{..}
where alloc _ = fresh where alloc _ = fresh
bind name addr m = modifyCurrentFrame (updateFrameSlots (Map.insert name addr)) >> m bind name addr m = local (Map.insert name addr) m
lookupEnv n = do lookupEnv n = asks (Map.lookup n)
FrameId frameAddr <- ask
val <- deref frameAddr
heap <- get
pure (val >>= lookupConcrete heap n)
deref = gets . IntMap.lookup deref = gets . IntMap.lookup
assign addr value = modify (IntMap.insert addr value) assign addr value = modify (IntMap.insert addr value)
abstract _ name body = do abstract _ name body = do
@ -136,13 +134,6 @@ concreteAnalysis = Analysis{..}
heap <- get heap <- get
pure (val >>= lookupConcrete heap n) pure (val >>= lookupConcrete heap n)
updateFrameSlots f frame = frame { frameSlots = f (frameSlots frame) }
modifyCurrentFrame f = do
addr <- asks unFrameId
Just (Obj frame) <- deref addr
assign addr (Obj (f frame))
-- FIXME: follow super edges -- FIXME: follow super edges
lookupConcrete :: Heap -> User -> Concrete -> Maybe Precise lookupConcrete :: Heap -> User -> Concrete -> Maybe Precise