From 124c7593f405a8d118323f94c58cbeffa011853f Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 27 Nov 2018 17:17:00 -0800 Subject: [PATCH] Handle scope and frame edges Co-Authored-By: Josh Vera --- src/Data/Abstract/Value/Abstract.hs | 3 ++- src/Data/Abstract/Value/Concrete.hs | 14 +++++++------- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/src/Data/Abstract/Value/Abstract.hs b/src/Data/Abstract/Value/Abstract.hs index 3e596c914..666619d94 100644 --- a/src/Data/Abstract/Value/Abstract.hs +++ b/src/Data/Abstract/Value/Abstract.hs @@ -23,6 +23,7 @@ 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 ModuleInfo) sig , Member (Reader Span) sig , Member (State Span) sig @@ -43,7 +44,7 @@ instance ( Member (Allocator address) sig Function name params body k -> runEvaluator $ do functionSpan <- ask @Span -- TODO: This might be wrong currentScope' <- currentScope - let lexicalEdges = maybe mempty (Map.singleton Lexical . pure) currentScope' + let lexicalEdges = Map.singleton Lexical [ currentScope' ] scope <- newScope lexicalEdges declare (Declaration name) functionSpan (Just scope) diff --git a/src/Data/Abstract/Value/Concrete.hs b/src/Data/Abstract/Value/Concrete.hs index fcbd48f85..c01994fff 100644 --- a/src/Data/Abstract/Value/Concrete.hs +++ b/src/Data/Abstract/Value/Concrete.hs @@ -29,7 +29,8 @@ import Prologue import qualified Data.Map.Strict as Map data Value term address - = Closure PackageInfo ModuleInfo (Maybe Name) [Name] (Either BuiltIn term) address (Maybe address) + -- Scope Frame + = Closure PackageInfo ModuleInfo (Maybe Name) [Name] (Either BuiltIn term) address address | Unit | Boolean Bool | Integer (Number.Number Integer) @@ -65,6 +66,7 @@ instance ( FreeVariables term , 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 @@ -88,7 +90,7 @@ instance ( FreeVariables term _ <- fresh -- TODO: Declare all params currentScope' <- currentScope - let lexicalEdges = maybe mempty (Map.singleton Lexical . pure) currentScope' + let lexicalEdges = Map.singleton Lexical [ currentScope' ] associatedScope <- newScope lexicalEdges -- TODO: Fix this if we find a solution to declaring names of functions without throwing a lookupPathError. -- declare (Declaration name) span (Just scope) @@ -109,7 +111,7 @@ instance ( FreeVariables term currentScope' <- currentScope currentFrame' <- currentFrame @(Value term address) - let lexicalEdges = maybe mempty (Map.singleton Lexical . pure) currentScope' + let lexicalEdges = Map.singleton Lexical [ currentScope' ] associatedScope <- newScope lexicalEdges let closure = Closure packageInfo moduleInfo Nothing [] (Left builtIn) associatedScope currentFrame' Evaluator $ runFunctionC (k closure) eval @@ -121,10 +123,8 @@ instance ( FreeVariables term -- Evaluate the bindings and body with the closure’s package/module info in scope in order to -- charge them to the closure's origin. withCurrentPackage packageInfo . withCurrentModule moduleInfo $ do - parentScope <- traverse scopeLookup parentFrame - let frameEdges = case (parentScope, parentFrame) of - (Just scope, Just frame) -> Map.singleton Lexical (Map.singleton scope frame) - _ -> mempty + parentScope <- scopeLookup parentFrame + let frameEdges = Map.singleton Lexical (Map.singleton parentScope parentFrame) frameAddress <- newFrame associatedScope frameEdges withScopeAndFrame frameAddress $ do for_ (zip names params) $ \(name, param) -> do