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

Merge branch 'heap-frames' of https://github.com/github/semantic into heap-frames

Browse Source
This commit is contained in:
joshvera 2018-12-06 12:17:15 -05:00
commit 15c85f4b42
14 changed files with 176 additions and 150 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/Analysis/Abstract/Graph.hs
View File

@ -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

209
src/Control/Abstract/Heap.hs
View File

@ -17,6 +17,7 @@ module Control.Abstract.Heap
, deref
, assign
, newFrame
, CurrentFrame(..)
, currentFrame
, withScopeAndFrame
, withLexicalScopeAndFrame
@ -62,37 +63,37 @@ 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
, Member (Reader ModuleInfo) sig
, Member (Reader Span) sig
, Member (Resumable (BaseError (HeapError address))) sig
, Member (Reader (address, address)) sig
, Member (State (Heap address address value)) sig
, Carrier sig m
)
withScopeAndFrame :: ( Ord address
, Member (Reader ModuleInfo) sig
, Member (Reader Span) sig
, Member (Resumable (BaseError (HeapError address))) sig
, Member (Reader (CurrentFrame address)) sig
, Member (Reader (CurrentScope address)) sig
, Member (State (Heap address address value)) sig
, Carrier sig m
)
=> address
-> 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
, 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 (Allocator address) sig
, Member Fresh sig
, Carrier sig m
)
=> Evaluator term address value m a
-> Evaluator term address value m a
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 (CurrentFrame address)) sig
, Member (Reader (CurrentScope address)) sig
, Member (Allocator address) sig
, Member Fresh sig
, Carrier sig m
)
=> Evaluator term address value m a
-> Evaluator term address value m a
withLexicalScopeAndFrame action = do
currentScope' <- currentScope
currentFrame' <- currentFrame
@ -102,17 +103,16 @@ withLexicalScopeAndFrame action = do
withScopeAndFrame frame action
-- | Lookup a scope address for a given frame address.
scopeLookup :: forall address value sig m term. (
Ord address
, Member (Reader ModuleInfo) sig
, Member (Reader Span) sig
, Member (Resumable (BaseError (HeapError address))) sig
, Member (State (Heap address address value)) sig
, Carrier sig m
)
scopeLookup :: ( Ord address
, Member (Reader ModuleInfo) sig
, Member (Reader Span) sig
, Member (Resumable (BaseError (HeapError address))) sig
, Member (State (Heap address address value)) sig
, Carrier sig m
)
=> 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,47 +125,48 @@ 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
, Member (Allocator address) sig
, Member Fresh sig
, Carrier sig m
)
newFrame :: ( Carrier sig m
, Member (Allocator address) sig
, Member Fresh sig
, Member (State (Heap address address value)) sig
, Ord address
)
=> address
-> Map EdgeLabel (Map address address)
-> Evaluator term address value m address
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,37 +232,39 @@ 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
, Member (Reader ModuleInfo) sig
, Member (Reader Span) sig
, Ord address
, Carrier sig m
)
=> Declaration
-> Evaluator term address value m (Maybe (Slot address))
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
)
=> Declaration
-> Evaluator term address value m (Maybe (Slot address))
maybeLookupDeclaration decl = do
path <- maybeLookupScopePath decl
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)
=> 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 =<< 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
, Ord address
, Carrier sig m
)
=> Slot address
-> Evaluator term address value m ()
dealloc addr = modify @(Heap address address value) (Heap.deleteSlot addr)
dealloc :: ( Carrier sig m
, Member (State (Heap address address value)) sig
, Ord address
)
=> Slot address
-> Evaluator term address value m ()
dealloc addr = modifyHeap (Heap.deleteSlot addr)
-- Garbage collection

9
src/Control/Abstract/Primitive.hs
View File

@ -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

40
src/Control/Abstract/ScopeGraph.hs
View File

@ -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

5
src/Control/Abstract/Value.hs
View File

@ -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

9
src/Data/Abstract/Evaluatable.hs
View File

@ -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 ()

3
src/Data/Abstract/Value/Abstract.hs
View File

@ -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

5
src/Data/Abstract/Value/Concrete.hs
View File

@ -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

3
src/Data/Abstract/Value/Type.hs
View File

@ -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

2
src/Data/Syntax/Declaration.hs
View File

@ -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
)

3
src/Language/PHP/Syntax.hs
View File

@ -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

3
src/Language/Ruby/Syntax.hs
View File

@ -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

24
src/Semantic/Analysis.hs
View File

@ -15,13 +15,14 @@ import Prologue
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
( DerefC address value (Eff
( AllocatorC address (Eff
( ReaderC ModuleInfo (Eff
m)))))))))))
= ErrorC (LoopControl address value) (Eff
( ErrorC (Return address value) (Eff
( ReaderC (CurrentScope address) (Eff
( ReaderC (CurrentFrame address) (Eff
( DerefC address value (Eff
( AllocatorC address (Eff
( ReaderC ModuleInfo (Eff
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

8
test/Control/Abstract/Evaluator/Spec.hs
View File

@ -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)
}