From 74ca31af5358e749a7e108ea6d5795740344d584 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 6 Dec 2018 11:45:13 -0500 Subject: [PATCH 1/3] :fire: a bunch of uses of scoped type variables. --- src/Control/Abstract/Heap.hs | 179 ++++++++++++++-------------- src/Data/Abstract/Value/Concrete.hs | 2 +- 2 files changed, 90 insertions(+), 91 deletions(-) diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 19f90a181..92b3779cc 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -62,37 +62,35 @@ 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 (address, 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 (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 action = do currentScope' <- currentScope currentFrame' <- currentFrame @@ -102,17 +100,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 @@ -126,28 +123,32 @@ modifyHeap :: (Member (State (Heap address address value)) sig, Carrier sig m) = modifyHeap = modify -- | Retrieve the heap. -currentFrame :: forall value address sig term m. ( - Member (Reader (address, address)) sig - , Carrier sig m +currentFrame :: ( Carrier sig m + , Member (Reader (address, address)) sig ) => Evaluator term address value m address -currentFrame = asks @(address, address) snd +currentFrame = snd <$> currentScopeAndFrame + +currentScopeAndFrame :: ( Carrier sig m + , Member (Reader (address, address)) sig + ) + => Evaluator term address value m (address, address) +currentScopeAndFrame = ask -- | 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. @@ -161,7 +162,7 @@ withFrame :: forall term address value sig m a. ( withFrame address = local @(address, address) (second (const 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 @@ -217,7 +218,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 +231,37 @@ 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 (address, 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 +lookupDeclaration :: ( Carrier sig m , Member (Reader (address, address)) sig - , Member (Resumable (BaseError (ScopeError address))) sig - , Member (Resumable (BaseError (HeapError 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) @@ -308,36 +309,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 +insertFrameLink :: ( Carrier sig m , Member (Reader (address, address)) sig - , Member (Resumable (BaseError (HeapError 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 +355,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 diff --git a/src/Data/Abstract/Value/Concrete.hs b/src/Data/Abstract/Value/Concrete.hs index 50dd74ae3..e2f744f7a 100644 --- a/src/Data/Abstract/Value/Concrete.hs +++ b/src/Data/Abstract/Value/Concrete.hs @@ -92,7 +92,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 From 04e2ca5321d51e8a22e0095b0af15fae24c03555 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 6 Dec 2018 11:46:34 -0500 Subject: [PATCH 2/3] Define CurrentFrame/Scope newtypes. --- src/Control/Abstract/Heap.hs | 3 +++ src/Control/Abstract/ScopeGraph.hs | 3 +++ 2 files changed, 6 insertions(+) diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 92b3779cc..9641c47fe 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -17,6 +17,7 @@ module Control.Abstract.Heap , deref , assign , newFrame +, CurrentFrame(..) , currentFrame , withScopeAndFrame , withLexicalScopeAndFrame @@ -122,6 +123,8 @@ 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 :: ( Carrier sig m , Member (Reader (address, address)) sig diff --git a/src/Control/Abstract/ScopeGraph.hs b/src/Control/Abstract/ScopeGraph.hs index 51fd32806..9a97bc939 100644 --- a/src/Control/Abstract/ScopeGraph.hs +++ b/src/Control/Abstract/ScopeGraph.hs @@ -10,6 +10,7 @@ module Control.Abstract.ScopeGraph , ScopeError(..) , Reference(..) , EdgeLabel(..) + , CurrentScope(..) , currentScope , insertExportEdge , insertImportEdge @@ -126,6 +127,8 @@ newScope edges = do address <- alloc name address <$ modify (ScopeGraph.newScope address edges) +newtype CurrentScope address = CurrentScope { unCurrentScope :: address } + currentScope :: forall address sig term value m. ( Member (Reader (address, address)) sig , Carrier sig m ) From f9c124f303d7bc395087574f13e8fc5c13df1334 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 6 Dec 2018 12:03:07 -0500 Subject: [PATCH 3/3] Replace the address pair Reader with separate CurrentFrame/Scope Readers. --- src/Analysis/Abstract/Graph.hs | 3 +- src/Control/Abstract/Heap.hs | 47 +++++++++++++------------ src/Control/Abstract/Primitive.hs | 9 +++-- src/Control/Abstract/ScopeGraph.hs | 37 +++++++++---------- src/Control/Abstract/Value.hs | 5 +-- src/Data/Abstract/Evaluatable.hs | 9 +++-- src/Data/Abstract/Value/Abstract.hs | 3 +- src/Data/Abstract/Value/Concrete.hs | 3 +- src/Data/Abstract/Value/Type.hs | 3 +- src/Data/Syntax/Declaration.hs | 2 +- src/Language/PHP/Syntax.hs | 3 +- src/Language/Ruby/Syntax.hs | 3 +- src/Semantic/Analysis.hs | 24 +++++++------ test/Control/Abstract/Evaluator/Spec.hs | 8 +++-- 14 files changed, 90 insertions(+), 69 deletions(-) diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index 3dad3c9dc..395f84341 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -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 diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 9641c47fe..a104c7156 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -67,7 +67,8 @@ 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 ) @@ -85,7 +86,8 @@ withLexicalScopeAndFrame :: ( Ord address , 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 @@ -127,16 +129,11 @@ newtype CurrentFrame address = CurrentFrame { unCurrentFrame :: address } -- | Retrieve the heap. currentFrame :: ( Carrier sig m - , Member (Reader (address, address)) sig + , Member (Reader (CurrentFrame address)) sig ) => Evaluator term address value m address -currentFrame = snd <$> currentScopeAndFrame +currentFrame = asks unCurrentFrame -currentScopeAndFrame :: ( Carrier sig m - , Member (Reader (address, address)) sig - ) - => Evaluator term address value m (address, address) -currentScopeAndFrame = ask -- | Inserts a new frame into the heap with the given scope and links. newFrame :: ( Carrier sig m @@ -155,21 +152,21 @@ newFrame scope links = do 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 :: ( 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 @@ -191,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 @@ -238,7 +236,8 @@ putSlotDeclarationScope Slot{..} assocScope = do maybeLookupDeclaration :: ( Carrier sig m - , 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 (HeapError address))) sig @@ -257,7 +256,8 @@ maybeLookupDeclaration decl = do Nothing -> pure Nothing lookupDeclaration :: ( Carrier sig m - , 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 (HeapError address))) sig @@ -275,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 ) @@ -291,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 @@ -325,7 +326,7 @@ frameLinks address = maybeM (throwHeapError (LookupLinksError address)) . Heap.f insertFrameLink :: ( Carrier sig m - , Member (Reader (address, address)) sig + , Member (Reader (CurrentFrame address)) sig , Member (Reader ModuleInfo) sig , Member (Reader Span) sig , Member (Resumable (BaseError (HeapError address))) sig diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 1ca8cc8f2..93dd8df96 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -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 diff --git a/src/Control/Abstract/ScopeGraph.hs b/src/Control/Abstract/ScopeGraph.hs index 9a97bc939..33dd4db14 100644 --- a/src/Control/Abstract/ScopeGraph.hs +++ b/src/Control/Abstract/ScopeGraph.hs @@ -52,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 @@ -63,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) @@ -74,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 () @@ -84,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 @@ -129,11 +130,11 @@ newScope edges = do newtype CurrentScope address = CurrentScope { unCurrentScope :: address } -currentScope :: forall address sig term value m. ( Member (Reader (address, address)) sig - , Carrier sig m +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 @@ -150,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 ) @@ -176,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 ) @@ -190,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 ) @@ -205,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 @@ -217,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 diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 549e6f5d9..d4b908595 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -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 diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 90ea8d652..175ea4de9 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -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 () diff --git a/src/Data/Abstract/Value/Abstract.hs b/src/Data/Abstract/Value/Abstract.hs index 8056fb892..abc85c900 100644 --- a/src/Data/Abstract/Value/Abstract.hs +++ b/src/Data/Abstract/Value/Abstract.hs @@ -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 diff --git a/src/Data/Abstract/Value/Concrete.hs b/src/Data/Abstract/Value/Concrete.hs index e2f744f7a..9ce302f65 100644 --- a/src/Data/Abstract/Value/Concrete.hs +++ b/src/Data/Abstract/Value/Concrete.hs @@ -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 diff --git a/src/Data/Abstract/Value/Type.hs b/src/Data/Abstract/Value/Type.hs index ebcd5ae3b..5be0daf49 100644 --- a/src/Data/Abstract/Value/Type.hs +++ b/src/Data/Abstract/Value/Type.hs @@ -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 diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 630e6af29..4888413df 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -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 ) diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 97cee800a..bb1dbb414 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -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 diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 9754eb033..de9adad94 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -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 diff --git a/src/Semantic/Analysis.hs b/src/Semantic/Analysis.hs index 2ce17cdaf..3a0ec2b2c 100644 --- a/src/Semantic/Analysis.hs +++ b/src/Semantic/Analysis.hs @@ -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 diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index 2d4ebcb65..996a449fb 100644 --- a/test/Control/Abstract/Evaluator/Spec.hs +++ b/test/Control/Abstract/Evaluator/Spec.hs @@ -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) }