mirror of
https://github.com/github/semantic.git
synced 2024-12-15 01:51:39 +03:00
Merge branch 'heap-frames' of https://github.com/github/semantic into heap-frames
This commit is contained in:
commit
15c85f4b42
@ -71,7 +71,8 @@ graphingTerms :: ( Member (Reader ModuleInfo) sig
|
||||
, Member (State (ScopeGraph (Hole context (Located address)))) sig
|
||||
, Member (Resumable (BaseError (ScopeError (Hole context (Located address))))) sig
|
||||
, Member (Resumable (BaseError (HeapError (Hole context (Located address))))) sig
|
||||
, Member (Reader (Hole context (Located address), Hole context (Located address))) sig
|
||||
, Member (Reader (CurrentFrame (Hole context (Located address)))) sig
|
||||
, Member (Reader (CurrentScope (Hole context (Located address)))) sig
|
||||
, Member (Reader ControlFlowVertex) sig
|
||||
, VertexDeclaration syntax
|
||||
, Declarations1 syntax
|
||||
|
@ -17,6 +17,7 @@ module Control.Abstract.Heap
|
||||
, deref
|
||||
, assign
|
||||
, newFrame
|
||||
, CurrentFrame(..)
|
||||
, currentFrame
|
||||
, withScopeAndFrame
|
||||
, withLexicalScopeAndFrame
|
||||
@ -62,12 +63,12 @@ import Prologue
|
||||
|
||||
|
||||
-- | Evaluates an action locally the scope and frame of the given frame address.
|
||||
withScopeAndFrame :: forall term address value m a sig. (
|
||||
Ord address
|
||||
withScopeAndFrame :: ( Ord address
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Carrier sig m
|
||||
)
|
||||
@ -75,18 +76,18 @@ withScopeAndFrame :: forall term address value m a sig. (
|
||||
-> Evaluator term address value m a
|
||||
-> Evaluator term address value m a
|
||||
withScopeAndFrame address action = do
|
||||
scope <- scopeLookup @address @value address
|
||||
scope <- scopeLookup address
|
||||
withScope scope (withFrame address action)
|
||||
|
||||
-- | Evaluates an action locally the scope and frame of the given frame address.
|
||||
withLexicalScopeAndFrame :: forall term address value m a sig. (
|
||||
Ord address
|
||||
withLexicalScopeAndFrame :: ( Ord address
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (Allocator address) sig
|
||||
, Member Fresh sig
|
||||
, Carrier sig m
|
||||
@ -102,8 +103,7 @@ withLexicalScopeAndFrame action = do
|
||||
withScopeAndFrame frame action
|
||||
|
||||
-- | Lookup a scope address for a given frame address.
|
||||
scopeLookup :: forall address value sig m term. (
|
||||
Ord address
|
||||
scopeLookup :: ( Ord address
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
@ -112,7 +112,7 @@ scopeLookup :: forall address value sig m term. (
|
||||
)
|
||||
=> address
|
||||
-> Evaluator term address value m address
|
||||
scopeLookup address = maybeM (throwHeapError (LookupAddressError address)) =<< Heap.scopeLookup address <$> get @(Heap address address value)
|
||||
scopeLookup address = maybeM (throwHeapError (LookupAddressError address)) =<< Heap.scopeLookup address <$> getHeap
|
||||
|
||||
getHeap :: (Member (State (Heap address address value)) sig, Carrier sig m) => Evaluator term address value m (Heap address address value)
|
||||
getHeap = get
|
||||
@ -125,21 +125,22 @@ putHeap = put
|
||||
modifyHeap :: (Member (State (Heap address address value)) sig, Carrier sig m) => (Heap address address value -> Heap address address value) -> Evaluator term address value m ()
|
||||
modifyHeap = modify
|
||||
|
||||
newtype CurrentFrame address = CurrentFrame { unCurrentFrame :: address }
|
||||
|
||||
-- | Retrieve the heap.
|
||||
currentFrame :: forall value address sig term m. (
|
||||
Member (Reader (address, address)) sig
|
||||
, Carrier sig m
|
||||
currentFrame :: ( Carrier sig m
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
)
|
||||
=> Evaluator term address value m address
|
||||
currentFrame = asks @(address, address) snd
|
||||
currentFrame = asks unCurrentFrame
|
||||
|
||||
|
||||
-- | Inserts a new frame into the heap with the given scope and links.
|
||||
newFrame :: forall address value sig m term. (
|
||||
Member (State (Heap address address value)) sig
|
||||
, Ord address
|
||||
newFrame :: ( Carrier sig m
|
||||
, Member (Allocator address) sig
|
||||
, Member Fresh sig
|
||||
, Carrier sig m
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Ord address
|
||||
)
|
||||
=> address
|
||||
-> Map EdgeLabel (Map address address)
|
||||
@ -147,25 +148,25 @@ newFrame :: forall address value sig m term. (
|
||||
newFrame scope links = do
|
||||
name <- gensym
|
||||
address <- alloc name
|
||||
modify @(Heap address address value) (Heap.newFrame scope address links)
|
||||
modifyHeap (Heap.newFrame scope address links)
|
||||
pure address
|
||||
|
||||
-- | Evaluates the action within the frame of the given frame address.
|
||||
withFrame :: forall term address value sig m a. (
|
||||
Member (Reader (address, address)) sig
|
||||
, Carrier sig m
|
||||
withFrame :: ( Carrier sig m
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
)
|
||||
=> address
|
||||
-> Evaluator term address value m a -- Not sure about this `sig` here (substituting `sig` for `effects`)
|
||||
-> Evaluator term address value m a
|
||||
withFrame address = local @(address, address) (second (const address))
|
||||
withFrame address = local (const (CurrentFrame address))
|
||||
|
||||
-- | Define a declaration and assign the value of an action in the current frame.
|
||||
define :: forall value sig address m term. ( HasCallStack
|
||||
define :: ( HasCallStack
|
||||
, Member (Deref value) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Resumable (BaseError (ScopeError address))) sig
|
||||
@ -187,7 +188,8 @@ define declaration def = withCurrentCallStack callStack $ do
|
||||
withChildFrame :: ( Member (Allocator address) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member Fresh sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
@ -217,7 +219,7 @@ deref :: ( Member (Deref value) sig
|
||||
-> Evaluator term address value m value
|
||||
deref slot@Slot{..} = gets (Heap.getSlot slot) >>= maybeM (throwAddressError (UnallocatedAddress frameAddress)) >>= send . flip DerefCell ret >>= maybeM (throwAddressError $ UninitializedAddress frameAddress)
|
||||
|
||||
putSlotDeclarationScope :: forall address value sig m term. ( Member (State (Heap address address value)) sig
|
||||
putSlotDeclarationScope :: ( Member (State (Heap address address value)) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
@ -230,17 +232,18 @@ putSlotDeclarationScope :: forall address value sig m term. ( Member (State (Hea
|
||||
-> Evaluator term address value m ()
|
||||
putSlotDeclarationScope Slot{..} assocScope = do
|
||||
scopeAddress <- scopeLookup frameAddress
|
||||
modify @(ScopeGraph address) (putDeclarationScopeAtPosition scopeAddress position assocScope)
|
||||
modify (putDeclarationScopeAtPosition scopeAddress position assocScope)
|
||||
|
||||
|
||||
maybeLookupDeclaration :: forall value address term sig m. ( Member (State (Heap address address value)) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
maybeLookupDeclaration :: ( Carrier sig m
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Ord address
|
||||
, Carrier sig m
|
||||
)
|
||||
=> Declaration
|
||||
-> Evaluator term address value m (Maybe (Slot address))
|
||||
@ -249,18 +252,19 @@ maybeLookupDeclaration decl = do
|
||||
case path of
|
||||
Just path -> do
|
||||
frameAddress <- lookupFrameAddress path
|
||||
pure (Just $ Slot frameAddress (Heap.pathPosition path))
|
||||
pure (Just (Slot frameAddress (Heap.pathPosition path)))
|
||||
Nothing -> pure Nothing
|
||||
|
||||
lookupDeclaration :: forall value address term sig m. ( Member (State (Heap address address value)) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Resumable (BaseError (ScopeError address))) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
lookupDeclaration :: ( Carrier sig m
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
, Member (Resumable (BaseError (ScopeError address))) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Ord address
|
||||
, Carrier sig m
|
||||
)
|
||||
=> Declaration
|
||||
-> Evaluator term address value m (Slot address)
|
||||
@ -271,11 +275,12 @@ lookupDeclaration decl = do
|
||||
|
||||
lookupDeclarationFrame :: ( Member (State (Heap address address value)) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Resumable (BaseError (ScopeError address))) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (Resumable (BaseError (ScopeError address))) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
, Ord address
|
||||
, Carrier sig m
|
||||
)
|
||||
@ -287,7 +292,7 @@ lookupDeclarationFrame decl = do
|
||||
|
||||
-- | Follow a path through the heap and return the frame address associated with the declaration.
|
||||
lookupFrameAddress :: ( Member (State (Heap address address value)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
@ -308,36 +313,35 @@ lookupFrameAddress path = go path =<< currentFrame
|
||||
Map.lookup nextScopeAddress scopeMap
|
||||
maybe (throwHeapError $ LookupLinkError p) (go path') frameAddress
|
||||
|
||||
frameLinks :: forall address value sig m term. (
|
||||
Member (State (Heap address address value)) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
frameLinks :: ( Carrier sig m
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Ord address
|
||||
, Carrier sig m
|
||||
)
|
||||
=> address
|
||||
-> Evaluator term address value m (Map EdgeLabel (Map address address)) -- TODO: Change this to Map scope address
|
||||
frameLinks address = maybeM (throwHeapError $ LookupLinksError address) . Heap.frameLinks address =<< get @(Heap address address value)
|
||||
frameLinks address = maybeM (throwHeapError (LookupLinksError address)) . Heap.frameLinks address =<< getHeap
|
||||
|
||||
|
||||
insertFrameLink :: forall address value sig m term. (
|
||||
Member (State (Heap address address value)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
insertFrameLink :: ( Carrier sig m
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Ord address
|
||||
, Carrier sig m
|
||||
)
|
||||
=> EdgeLabel -> Map address address -> Evaluator term address value m ()
|
||||
=> EdgeLabel
|
||||
-> Map address address
|
||||
-> Evaluator term address value m ()
|
||||
insertFrameLink label linkMap = do
|
||||
frameAddress <- currentFrame
|
||||
heap <- get @(Heap address address value)
|
||||
currentFrame <- maybeM (throwHeapError $ LookupFrameError frameAddress) (Heap.frameLookup frameAddress heap)
|
||||
let newCurrentFrame = currentFrame {
|
||||
Heap.links = Map.alter (\val -> val <> Just linkMap) label (Heap.links currentFrame)
|
||||
}
|
||||
heap <- getHeap
|
||||
currentFrame <- maybeM (throwHeapError (LookupFrameError frameAddress)) (Heap.frameLookup frameAddress heap)
|
||||
let newCurrentFrame = currentFrame
|
||||
{ Heap.links = Map.alter (\val -> val <> Just linkMap) label (Heap.links currentFrame) }
|
||||
modify (Heap.insertFrame frameAddress newCurrentFrame)
|
||||
|
||||
|
||||
@ -355,14 +359,13 @@ assign addr value = do
|
||||
cell <- send (AssignCell value (fromMaybe lowerBound (Heap.getSlot addr heap)) ret)
|
||||
putHeap (Heap.setSlot addr cell heap)
|
||||
|
||||
dealloc :: forall address value sig m term.
|
||||
( Member (State (Heap address address value)) sig
|
||||
dealloc :: ( Carrier sig m
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Ord address
|
||||
, Carrier sig m
|
||||
)
|
||||
=> Slot address
|
||||
-> Evaluator term address value m ()
|
||||
dealloc addr = modify @(Heap address address value) (Heap.deleteSlot addr)
|
||||
dealloc addr = modifyHeap (Heap.deleteSlot addr)
|
||||
|
||||
|
||||
-- Garbage collection
|
||||
|
@ -19,9 +19,10 @@ import Prologue
|
||||
|
||||
defineBuiltIn :: ( HasCallStack
|
||||
, Member (Deref value) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Resumable (BaseError (ScopeError address))) sig
|
||||
@ -58,11 +59,12 @@ defineClass :: ( AbstractValue term address value m
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member Fresh sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
, Member (Resumable (BaseError (ScopeError address))) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Ord address
|
||||
)
|
||||
=> Declaration
|
||||
@ -90,6 +92,8 @@ defineNamespace :: ( AbstractValue term address value m
|
||||
, HasCallStack
|
||||
, Member (Allocator address) sig
|
||||
, Member (Deref value) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
@ -97,7 +101,6 @@ defineNamespace :: ( AbstractValue term address value m
|
||||
, Member (Resumable (BaseError (ScopeError address))) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Ord address
|
||||
)
|
||||
=> Declaration
|
||||
|
@ -10,6 +10,7 @@ module Control.Abstract.ScopeGraph
|
||||
, ScopeError(..)
|
||||
, Reference(..)
|
||||
, EdgeLabel(..)
|
||||
, CurrentScope(..)
|
||||
, currentScope
|
||||
, insertExportEdge
|
||||
, insertImportEdge
|
||||
@ -51,7 +52,7 @@ lookup ref = ScopeGraph.scopeOfRef ref <$> get
|
||||
|
||||
declare :: ( Carrier sig m
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Ord address
|
||||
)
|
||||
=> Declaration
|
||||
@ -62,7 +63,7 @@ declare decl span scope = do
|
||||
currentAddress <- currentScope
|
||||
modify (fst . ScopeGraph.declare decl span scope currentAddress)
|
||||
|
||||
putDeclarationScope :: (Ord address, Member (Reader (address, address)) sig, Member (State (ScopeGraph address)) sig, Carrier sig m) => Declaration -> address -> Evaluator term address value m ()
|
||||
putDeclarationScope :: (Ord address, Member (Reader (CurrentScope address)) sig, Member (State (ScopeGraph address)) sig, Carrier sig m) => Declaration -> address -> Evaluator term address value m ()
|
||||
putDeclarationScope decl assocScope = do
|
||||
currentAddress <- currentScope
|
||||
modify (ScopeGraph.insertDeclarationScope decl assocScope currentAddress)
|
||||
@ -73,8 +74,9 @@ putDeclarationSpan decl = modify @(ScopeGraph address) . ScopeGraph.insertDeclar
|
||||
reference :: forall address sig m term value
|
||||
. ( Ord address
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Carrier sig m)
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Carrier sig m
|
||||
)
|
||||
=> Reference
|
||||
-> Declaration
|
||||
-> Evaluator term address value m ()
|
||||
@ -83,25 +85,25 @@ reference ref decl = do
|
||||
modify @(ScopeGraph address) (ScopeGraph.reference ref decl currentAddress)
|
||||
|
||||
-- | Combinator to insert an export edge from the current scope to the provided scope address.
|
||||
insertExportEdge :: (Member (Reader (scopeAddress, scopeAddress)) sig, Member (State (ScopeGraph scopeAddress)) sig, Carrier sig m, Ord scopeAddress)
|
||||
insertExportEdge :: (Member (Reader (CurrentScope scopeAddress)) sig, Member (State (ScopeGraph scopeAddress)) sig, Carrier sig m, Ord scopeAddress)
|
||||
=> scopeAddress
|
||||
-> Evaluator term scopeAddress value m ()
|
||||
insertExportEdge = insertEdge ScopeGraph.Export
|
||||
|
||||
-- | Combinator to insert an import edge from the current scope to the provided scope address.
|
||||
insertImportEdge :: (Member (Reader (scopeAddress, scopeAddress)) sig, Member (State (ScopeGraph scopeAddress)) sig, Carrier sig m, Ord scopeAddress)
|
||||
insertImportEdge :: (Member (Reader (CurrentScope scopeAddress)) sig, Member (State (ScopeGraph scopeAddress)) sig, Carrier sig m, Ord scopeAddress)
|
||||
=> scopeAddress
|
||||
-> Evaluator term scopeAddress value m ()
|
||||
insertImportEdge = insertEdge ScopeGraph.Import
|
||||
|
||||
-- | Combinator to insert a lexical edge from the current scope to the provided scope address.
|
||||
insertLexicalEdge :: (Member (Reader (scopeAddress, scopeAddress)) sig, Member (State (ScopeGraph scopeAddress)) sig, Carrier sig m, Ord scopeAddress)
|
||||
insertLexicalEdge :: (Member (Reader (CurrentScope scopeAddress)) sig, Member (State (ScopeGraph scopeAddress)) sig, Carrier sig m, Ord scopeAddress)
|
||||
=> scopeAddress
|
||||
-> Evaluator term scopeAddress value m ()
|
||||
insertLexicalEdge = insertEdge ScopeGraph.Lexical
|
||||
|
||||
insertEdge :: ( Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Carrier sig m
|
||||
, Ord address)
|
||||
=> EdgeLabel
|
||||
@ -126,11 +128,13 @@ newScope edges = do
|
||||
address <- alloc name
|
||||
address <$ modify (ScopeGraph.newScope address edges)
|
||||
|
||||
currentScope :: forall address sig term value m. ( Member (Reader (address, address)) sig
|
||||
, Carrier sig m
|
||||
newtype CurrentScope address = CurrentScope { unCurrentScope :: address }
|
||||
|
||||
currentScope :: ( Carrier sig m
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
)
|
||||
=> Evaluator term address value m address
|
||||
currentScope = asks @(address, address) fst
|
||||
currentScope = asks unCurrentScope
|
||||
|
||||
lookupScope :: ( Member (Resumable (BaseError (ScopeError address))) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
@ -147,7 +151,7 @@ insertImportReference :: ( Member (Resumable (BaseError (ScopeError address))) s
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Carrier sig m
|
||||
, Ord address
|
||||
)
|
||||
@ -173,7 +177,7 @@ insertScope scopeAddress scope = modify (ScopeGraph.insertScope scopeAddress sco
|
||||
|
||||
maybeLookupScopePath ::
|
||||
( Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Carrier sig m
|
||||
, Ord address
|
||||
)
|
||||
@ -187,7 +191,7 @@ lookupScopePath :: ( Member (Resumable (BaseError (ScopeError address))) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Carrier sig m
|
||||
, Ord address
|
||||
)
|
||||
@ -202,7 +206,7 @@ lookupDeclarationScope :: ( Member (Resumable (BaseError (ScopeError address)))
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Carrier sig m
|
||||
, Ord address
|
||||
) => Declaration -> Evaluator term address value m address
|
||||
@ -214,13 +218,13 @@ lookupDeclarationScope decl = do
|
||||
associatedScope :: (Ord address, Member (State (ScopeGraph address)) sig, Carrier sig m) => Declaration -> Evaluator term address value m (Maybe address)
|
||||
associatedScope decl = ScopeGraph.associatedScope decl <$> get
|
||||
|
||||
withScope :: forall sig m address term value a. ( Carrier sig m
|
||||
, Member (Reader (address, address)) sig
|
||||
withScope :: ( Carrier sig m
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
)
|
||||
=> address
|
||||
-> Evaluator term address value m a
|
||||
-> Evaluator term address value m a
|
||||
withScope scope = local @(address, address) (first (const scope))
|
||||
withScope scope = local (const (CurrentScope scope))
|
||||
|
||||
throwScopeError :: ( Member (Resumable (BaseError (ScopeError address))) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
|
@ -30,7 +30,7 @@ module Control.Abstract.Value
|
||||
|
||||
import Control.Abstract.Evaluator
|
||||
import Control.Abstract.Heap
|
||||
import Control.Abstract.ScopeGraph (Allocator, Declaration, ScopeGraph)
|
||||
import Control.Abstract.ScopeGraph (Allocator, CurrentScope, Declaration, ScopeGraph)
|
||||
import Control.Effect.Carrier
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Module
|
||||
@ -161,7 +161,8 @@ forLoop :: ( Carrier sig m
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (While address value) sig
|
||||
, Member Fresh sig
|
||||
, Ord address
|
||||
|
@ -57,7 +57,8 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
|
||||
, Member (Reader PackageInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (State Span) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (Resumable (BaseError (ScopeError address))) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
, Member (Resumable (BaseError (AddressError address value))) sig
|
||||
@ -98,7 +99,8 @@ class HasPrelude (language :: Language) where
|
||||
, Member (Reader Span) sig
|
||||
, Member (Resumable (BaseError (AddressError address value))) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member Trace sig
|
||||
, Ord address
|
||||
, Show address
|
||||
@ -143,7 +145,8 @@ defineSelf :: ( AbstractValue term address value m
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Ord address
|
||||
)
|
||||
=> Evaluator term address value m ()
|
||||
|
@ -23,7 +23,8 @@ instance ( Member (Allocator address) sig
|
||||
, Member (Deref Abstract) sig
|
||||
, Member (Error (Return address Abstract)) sig
|
||||
, Member Fresh sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (State Span) sig
|
||||
|
@ -58,12 +58,13 @@ instance ( FreeVariables term
|
||||
, Member (Allocator address) sig
|
||||
, Member (Deref (Value term address)) sig
|
||||
, Member Fresh sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader PackageInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (State Span) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Resumable (BaseError (AddressError address (Value term address)))) sig
|
||||
, Member (Resumable (BaseError (EvalError address (Value term address)))) sig
|
||||
, Member (Resumable (BaseError (ValueError term address))) sig
|
||||
@ -92,7 +93,7 @@ instance ( FreeVariables term
|
||||
packageInfo <- currentPackage
|
||||
moduleInfo <- currentModule
|
||||
|
||||
currentFrame' <- currentFrame @(Value term address)
|
||||
currentFrame' <- currentFrame
|
||||
let closure = Closure packageInfo moduleInfo Nothing [] (Left builtIn) associatedScope currentFrame'
|
||||
Evaluator $ runFunctionC (k closure) eval
|
||||
Abstract.Call op params k -> runEvaluator $ do
|
||||
|
@ -243,7 +243,8 @@ instance ( Member (Allocator address) sig
|
||||
, Member (Deref Type) sig
|
||||
, Member (Error (Return address Type)) sig
|
||||
, Member Fresh sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (State Span) sig
|
||||
|
@ -45,7 +45,7 @@ instance Evaluatable Function where
|
||||
declareFunction :: ( Carrier sig m
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Allocator address) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member Fresh sig
|
||||
, Ord address
|
||||
)
|
||||
|
@ -59,7 +59,8 @@ include :: ( AbstractValue term address value m
|
||||
, Carrier sig m
|
||||
, Member (Deref value) sig
|
||||
, Member (Modules address value) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (Resumable (BaseError (AddressError address value))) sig
|
||||
|
@ -144,13 +144,14 @@ instance Evaluatable Load where
|
||||
|
||||
doLoad :: ( Member (Boolean value) sig
|
||||
, Member (Modules address value) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (Reader ModuleInfo) sig
|
||||
, Member (Reader Span) sig
|
||||
, Member (Resumable (BaseError ResolutionError)) sig
|
||||
, Member (State (ScopeGraph.ScopeGraph address)) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Member (Resumable (BaseError (HeapError address))) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member Trace sig
|
||||
, Ord address
|
||||
, Carrier sig m
|
||||
|
@ -17,11 +17,12 @@ import qualified Data.Map.Strict as Map
|
||||
type ModuleC address value m
|
||||
= ErrorC (LoopControl address value) (Eff
|
||||
( ErrorC (Return address value) (Eff
|
||||
( ReaderC (address, address) (Eff
|
||||
( ReaderC (CurrentScope address) (Eff
|
||||
( ReaderC (CurrentFrame address) (Eff
|
||||
( DerefC address value (Eff
|
||||
( AllocatorC address (Eff
|
||||
( ReaderC ModuleInfo (Eff
|
||||
m)))))))))))
|
||||
m)))))))))))))
|
||||
|
||||
type ValueC term address value m
|
||||
= FunctionC term address value (Eff
|
||||
@ -64,7 +65,8 @@ evaluate :: ( AbstractValue term address value (ValueC term address value inner)
|
||||
, Member (State (ScopeGraph address)) innerSig
|
||||
, Member (State (Heap address address value)) outerSig
|
||||
, Member (State (ScopeGraph address)) outerSig
|
||||
, Member (Reader (address, address)) innerSig
|
||||
, Member (Reader (CurrentFrame address)) innerSig
|
||||
, Member (Reader (CurrentScope address)) innerSig
|
||||
, Member (Resumable (BaseError (HeapError address))) innerSig
|
||||
, Member (Resumable (BaseError (ScopeError address))) innerSig
|
||||
, Member Trace innerSig
|
||||
@ -99,7 +101,8 @@ evaluate lang perModule runTerm modules = do
|
||||
pure ((scopeAddress, frameAddress), val)
|
||||
where runInModule scopeAddress frameAddress
|
||||
= runDeref
|
||||
. raiseHandler (runReader (scopeAddress, frameAddress))
|
||||
. raiseHandler (runReader (CurrentFrame frameAddress))
|
||||
. raiseHandler (runReader (CurrentScope scopeAddress))
|
||||
. runReturn
|
||||
. runLoopControl
|
||||
|
||||
@ -132,7 +135,8 @@ evalTerm :: ( Carrier sig m
|
||||
, Member (Resumable (BaseError ResolutionError)) sig
|
||||
, Member (State (Heap address address value)) sig
|
||||
, Member (State (ScopeGraph address)) sig
|
||||
, Member (Reader (address, address)) sig
|
||||
, Member (Reader (CurrentFrame address)) sig
|
||||
, Member (Reader (CurrentScope address)) sig
|
||||
, Member (State Span) sig
|
||||
, Member (While address value) sig
|
||||
, Member Fresh sig
|
||||
|
@ -64,7 +64,8 @@ evaluate
|
||||
evalModule action = do
|
||||
scopeAddress <- newScope mempty
|
||||
frameAddress <- newFrame scopeAddress mempty
|
||||
val <- raiseHandler (runReader (scopeAddress, frameAddress))
|
||||
val <- raiseHandler (runReader (CurrentScope scopeAddress))
|
||||
. raiseHandler (runReader (CurrentFrame frameAddress))
|
||||
. fmap reassociate
|
||||
. runScopeError
|
||||
. runHeapError
|
||||
@ -96,7 +97,8 @@ newtype SpecEff = SpecEff
|
||||
(Eff (ResumableC (BaseError (ValueError SpecEff Precise))
|
||||
(Eff (ResumableC (BaseError (HeapError Precise))
|
||||
(Eff (ResumableC (BaseError (ScopeError Precise))
|
||||
(Eff (ReaderC (Precise, Precise)
|
||||
(Eff (ReaderC (CurrentFrame Precise)
|
||||
(Eff (ReaderC (CurrentScope Precise)
|
||||
(Eff (AllocatorC Precise
|
||||
(Eff (ReaderC Span
|
||||
(Eff (StateC Span
|
||||
@ -106,7 +108,7 @@ newtype SpecEff = SpecEff
|
||||
(Eff (StateC (Heap Precise Precise Val)
|
||||
(Eff (StateC (ScopeGraph Precise)
|
||||
(Eff (TraceByIgnoringC
|
||||
(Eff (LiftC IO)))))))))))))))))))))))))))))))))))))))))))
|
||||
(Eff (LiftC IO)))))))))))))))))))))))))))))))))))))))))))))
|
||||
(ValueRef Precise Val)
|
||||
}
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user