mirror of
https://github.com/github/semantic.git
synced 2024-11-24 08:54:07 +03:00
Move the Heap accessors into their own module.
This commit is contained in:
parent
920ddd893f
commit
57ddf31ec5
@ -35,6 +35,7 @@ library
|
||||
, Control.Abstract.Addressable
|
||||
, Control.Abstract.Configuration
|
||||
, Control.Abstract.Evaluator
|
||||
, Control.Abstract.Heap
|
||||
, Control.Abstract.Matching
|
||||
, Control.Abstract.Value
|
||||
-- Control flow
|
||||
|
@ -7,6 +7,7 @@ module Analysis.Abstract.Caching
|
||||
|
||||
import Control.Abstract.Evaluator
|
||||
import Control.Abstract.Configuration
|
||||
import Control.Abstract.Heap
|
||||
import Control.Monad.Effect
|
||||
import Data.Abstract.Cache
|
||||
import Data.Abstract.Module
|
||||
|
@ -5,6 +5,7 @@ module Analysis.Abstract.Collecting
|
||||
) where
|
||||
|
||||
import Control.Abstract.Evaluator
|
||||
import Control.Abstract.Heap
|
||||
import Control.Abstract.Value
|
||||
import Data.Abstract.Address
|
||||
import Data.Abstract.Heap
|
||||
|
@ -5,6 +5,7 @@ module Analysis.Abstract.Evaluating
|
||||
) where
|
||||
|
||||
import Control.Abstract.Evaluator
|
||||
import Control.Abstract.Heap
|
||||
import Data.Abstract.Address
|
||||
import Data.Semilattice.Lower
|
||||
|
||||
|
@ -7,6 +7,7 @@ module Analysis.Abstract.Tracing
|
||||
import Control.Abstract.Evaluator
|
||||
import Control.Abstract.Configuration
|
||||
import Control.Monad.Effect.Writer
|
||||
import Data.Abstract.Heap
|
||||
import Data.Semigroup.Reducer as Reducer
|
||||
import Prologue hiding (trace)
|
||||
|
||||
|
@ -2,6 +2,7 @@
|
||||
module Control.Abstract.Addressable where
|
||||
|
||||
import Control.Abstract.Evaluator
|
||||
import Control.Abstract.Heap
|
||||
import Control.Monad.Effect.Resumable as Eff
|
||||
import Data.Abstract.Address
|
||||
import Data.Abstract.Environment (insert)
|
||||
|
@ -3,7 +3,6 @@ module Control.Abstract.Evaluator
|
||||
( Evaluator(..)
|
||||
-- * State
|
||||
, Environment
|
||||
, Heap
|
||||
, ModuleTable
|
||||
, Exports
|
||||
, JumpTable
|
||||
@ -26,12 +25,6 @@ module Control.Abstract.Evaluator
|
||||
, addExport
|
||||
, withExports
|
||||
, isolate
|
||||
-- * Heap
|
||||
, getHeap
|
||||
, putHeap
|
||||
, modifyHeap
|
||||
, lookupHeap
|
||||
, assign
|
||||
-- * Roots
|
||||
, askRoots
|
||||
, extraRoots
|
||||
@ -83,13 +76,11 @@ import Data.Abstract.Address
|
||||
import Data.Abstract.Environment as Env
|
||||
import Data.Abstract.Exports as Export
|
||||
import Data.Abstract.FreeVariables
|
||||
import Data.Abstract.Heap
|
||||
import Data.Abstract.Live
|
||||
import Data.Abstract.Module
|
||||
import Data.Abstract.ModuleTable
|
||||
import Data.Abstract.Package
|
||||
import qualified Data.IntMap as IntMap
|
||||
import Data.Semigroup.Reducer
|
||||
import Data.Semilattice.Lower
|
||||
import Prelude hiding (fail)
|
||||
import Prologue
|
||||
@ -184,34 +175,6 @@ isolate :: Members '[State (Environment location value), State (Exports location
|
||||
isolate = withEnv lowerBound . withExports lowerBound
|
||||
|
||||
|
||||
-- Heap
|
||||
|
||||
-- | Retrieve the heap.
|
||||
getHeap :: Member (State (Heap location value)) effects => Evaluator location term value effects (Heap location value)
|
||||
getHeap = raise get
|
||||
|
||||
-- | Set the heap.
|
||||
putHeap :: Member (State (Heap location value)) effects => Heap location value -> Evaluator location term value effects ()
|
||||
putHeap = raise . put
|
||||
|
||||
-- | Update the heap.
|
||||
modifyHeap :: Member (State (Heap location value)) effects => (Heap location value -> Heap location value) -> Evaluator location term value effects ()
|
||||
modifyHeap = raise . modify'
|
||||
|
||||
-- | Look up the cell for the given 'Address' in the 'Heap'.
|
||||
lookupHeap :: (Member (State (Heap location value)) effects, Ord location) => Address location value -> Evaluator location term value effects (Maybe (Cell location value))
|
||||
lookupHeap = flip fmap getHeap . heapLookup
|
||||
|
||||
-- | Write a value to the given 'Address' in the 'Store'.
|
||||
assign :: ( Member (State (Heap location value)) effects
|
||||
, Ord location
|
||||
, Reducer value (Cell location value)
|
||||
)
|
||||
=> Address location value
|
||||
-> value
|
||||
-> Evaluator location term value effects ()
|
||||
assign address = modifyHeap . heapInsert address
|
||||
|
||||
|
||||
-- Roots
|
||||
|
||||
@ -224,13 +187,6 @@ extraRoots :: (Member (Reader (Live location value)) effects, Ord location) => L
|
||||
extraRoots roots = raiseHandler (local (<> roots))
|
||||
|
||||
|
||||
-- Configuration
|
||||
|
||||
-- | Get the current 'Configuration' with a passed-in term.
|
||||
getConfiguration :: Members '[Reader (Live location value), State (Environment location value), State (Heap location value)] effects => term -> Evaluator location term value effects (Configuration location term value)
|
||||
getConfiguration term = Configuration term <$> askRoots <*> getEnv <*> getHeap
|
||||
|
||||
|
||||
-- Module table
|
||||
|
||||
-- | Retrieve the table of evaluated modules.
|
||||
|
40
src/Control/Abstract/Heap.hs
Normal file
40
src/Control/Abstract/Heap.hs
Normal file
@ -0,0 +1,40 @@
|
||||
module Control.Abstract.Heap
|
||||
( Heap
|
||||
, getHeap
|
||||
, putHeap
|
||||
, modifyHeap
|
||||
, lookupHeap
|
||||
, assign
|
||||
) where
|
||||
|
||||
import Control.Abstract.Evaluator
|
||||
import Data.Abstract.Address
|
||||
import Data.Abstract.Heap
|
||||
import Data.Semigroup.Reducer
|
||||
import Prologue
|
||||
|
||||
-- | Retrieve the heap.
|
||||
getHeap :: Member (State (Heap location value)) effects => Evaluator location term value effects (Heap location value)
|
||||
getHeap = raise get
|
||||
|
||||
-- | Set the heap.
|
||||
putHeap :: Member (State (Heap location value)) effects => Heap location value -> Evaluator location term value effects ()
|
||||
putHeap = raise . put
|
||||
|
||||
-- | Update the heap.
|
||||
modifyHeap :: Member (State (Heap location value)) effects => (Heap location value -> Heap location value) -> Evaluator location term value effects ()
|
||||
modifyHeap = raise . modify'
|
||||
|
||||
-- | Look up the cell for the given 'Address' in the 'Heap'.
|
||||
lookupHeap :: (Member (State (Heap location value)) effects, Ord location) => Address location value -> Evaluator location term value effects (Maybe (Cell location value))
|
||||
lookupHeap = flip fmap getHeap . heapLookup
|
||||
|
||||
-- | Write a value to the given 'Address' in the 'Store'.
|
||||
assign :: ( Member (State (Heap location value)) effects
|
||||
, Ord location
|
||||
, Reducer value (Cell location value)
|
||||
)
|
||||
=> Address location value
|
||||
-> value
|
||||
-> Evaluator location term value effects ()
|
||||
assign address = modifyHeap . heapInsert address
|
@ -11,6 +11,7 @@ module Control.Abstract.Value
|
||||
) where
|
||||
|
||||
import Control.Abstract.Evaluator
|
||||
import Control.Abstract.Heap
|
||||
import Data.Abstract.Address (Address, Cell)
|
||||
import Data.Abstract.Environment as Env
|
||||
import Data.Abstract.FreeVariables
|
||||
|
@ -30,6 +30,7 @@ module Data.Abstract.Evaluatable
|
||||
import Control.Abstract.Addressable as X
|
||||
import Control.Abstract.Configuration as X
|
||||
import Control.Abstract.Evaluator as X hiding (LoopControl(..), Return(..))
|
||||
import Control.Abstract.Heap as X
|
||||
import Control.Abstract.Evaluator (LoopControl, Return(..))
|
||||
import Control.Abstract.Value as X
|
||||
import Control.Monad.Effect as Eff
|
||||
|
@ -8,6 +8,7 @@ module Data.Abstract.Type
|
||||
|
||||
import Control.Abstract.Addressable
|
||||
import Control.Abstract.Evaluator
|
||||
import Control.Abstract.Heap
|
||||
import Control.Abstract.Value
|
||||
import Control.Effect (Effectful(..), throwResumable)
|
||||
import Data.Abstract.Address
|
||||
|
@ -3,6 +3,7 @@ module Data.Abstract.Value where
|
||||
|
||||
import Control.Abstract.Addressable
|
||||
import Control.Abstract.Evaluator
|
||||
import Control.Abstract.Heap
|
||||
import Control.Abstract.Value
|
||||
import Data.Abstract.Address
|
||||
import Data.Abstract.Environment (Environment, emptyEnv, mergeEnvs)
|
||||
|
Loading…
Reference in New Issue
Block a user