diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 7dc053109..69acdd442 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -1,7 +1,7 @@ {-# LANGUAGE GADTs, KindSignatures, RankNTypes, TypeOperators, UndecidableInstances, ScopedTypeVariables #-} module Control.Abstract.Heap ( Heap -, HeapError +, HeapError(..) , Address(..) , Position(..) , Configuration(..) @@ -18,6 +18,7 @@ module Control.Abstract.Heap , withChildFrame , define , withFrame +, putCurrentFrame -- * Garbage collection , gc -- * Effects @@ -25,6 +26,7 @@ module Control.Abstract.Heap , AddressError(..) , runAddressError , runAddressErrorWith +, runHeapErrorWith ) where import Control.Abstract.Context (withCurrentCallStack) @@ -85,12 +87,14 @@ currentFrame :: forall address value effects. ( Member (State (Heap address addr => Evaluator address value effects address currentFrame = maybeM (throwHeapError EmptyHeapError) =<< (Heap.currentFrame <$> get @(Heap address address value)) +putCurrentFrame :: forall address value effects. ( Member (State (Heap address address value)) effects ) => address -> Evaluator address value effects () +putCurrentFrame address = modify @(Heap address address value) (\heap -> heap { Heap.currentFrame = Just address }) + -- | Inserts a new frame into the heap with the given scope and links. newFrame :: forall address value effects. ( Member (State (Heap address address value)) effects , Member (Reader ModuleInfo) effects , Member (Reader Span) effects - , Member (Resumable (BaseError (HeapError address))) effects , Ord address , Member (Allocator address) effects , Member (State (ScopeGraph address)) effects @@ -333,6 +337,12 @@ runHeapError :: ( Effectful (m address value) -> m address value effects (Either (SomeExc (BaseError (HeapError address))) a) runHeapError = runResumable +runHeapErrorWith :: (Effectful (m address value), Effects effects) + => (forall resume . BaseError (HeapError address) resume -> m address value effects resume) + -> m address value (Resumable (BaseError (HeapError address)) ': effects) a + -> m address value effects a +runHeapErrorWith = runResumableWith + data AddressError address value resume where UnallocatedAddress :: address -> AddressError address value (Set value) UninitializedAddress :: address -> AddressError address value value diff --git a/src/Control/Abstract/ScopeGraph.hs b/src/Control/Abstract/ScopeGraph.hs index 960632d49..bb582eb64 100644 --- a/src/Control/Abstract/ScopeGraph.hs +++ b/src/Control/Abstract/ScopeGraph.hs @@ -25,6 +25,7 @@ module Control.Abstract.ScopeGraph , Allocator(..) , alloc , Address(..) + , runScopeErrorWith ) where import Control.Abstract.Evaluator hiding (Local) @@ -222,3 +223,9 @@ instance PureEffect (Allocator address) instance Effect (Allocator address) where handleState c dist (Request (Alloc name) k) = Request (Alloc name) (dist . (<$ c) . k) + +runScopeErrorWith :: (Effectful (m address value), Effects effects) + => (forall resume . BaseError (ScopeError address) resume -> m address value effects resume) + -> m address value (Resumable (BaseError (ScopeError address)) ': effects) a + -> m address value effects a +runScopeErrorWith = runResumableWith diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 06a15926e..f1d99ae27 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -30,6 +30,7 @@ import Analysis.Abstract.Caching import Analysis.Abstract.Collecting import Analysis.Abstract.Graph as Graph import Control.Abstract +import Control.Abstract.Heap as Heap import Control.Abstract.PythonPackage as PythonPackage import Data.Abstract.Address.Hole as Hole import Data.Abstract.Address.Located as Located @@ -72,13 +73,6 @@ runGraph :: forall effs. ( Member Distribute effs , Member Resolution effs , Member Task effs , Member Trace effs - , Member (State Span) effs - , Member (Allocator (Address (Hole (Maybe Name) (Located Monovariant)))) effs - , Member (Resumable (BaseError (HeapError (Hole (Maybe Name) (Located Monovariant))))) effs - , Member (Resumable (BaseError (ScopeError (Hole (Maybe Name) (Located Monovariant))))) effs - , Member (Allocator (Address (Hole (Maybe Name) Precise))) effs - , Member (Resumable (BaseError (HeapError (Hole (Maybe Name) Precise)))) effs - , Member (Resumable (BaseError (ScopeError (Hole (Maybe Name) Precise)))) effs , Effects effs ) => GraphType @@ -111,10 +105,6 @@ runCallGraph :: forall fields syntax term lang effs. ( HasField fields Span , HasPrelude lang , HasPostlude lang , Member Trace effs - , Member (State Span) effs - , Member (Allocator (Address (Hole (Maybe Name) (Located Monovariant)))) effs - , Member (Resumable (BaseError (HeapError (Hole (Maybe Name) (Located Monovariant))))) effs - , Member (Resumable (BaseError (ScopeError (Hole (Maybe Name) (Located Monovariant))))) effs , Effects effs ) => Proxy lang @@ -135,6 +125,8 @@ runCallGraph lang includePackages modules package = do . resumingLoadError . resumingUnspecialized -- . resumingEnvironmentError -- TODO: Fix me. Replace with resumingScopeGraphError? + . resumingScopeError + . resumingHeapError . resumingEvalError . resumingResolutionError . resumingAddressError @@ -212,6 +204,8 @@ runImportGraph lang (package :: Package term) f = . resumingLoadError . resumingUnspecialized -- . resumingEnvironmentError -- TODO: Fix me. Replace with `resumingScopeGraphError`? + . resumingScopeError + . resumingHeapError . resumingEvalError . resumingResolutionError . resumingAddressError @@ -237,6 +231,8 @@ type ConcreteEffects address rest ': Resumable (BaseError (AddressError address (Value address (ConcreteEff address rest)))) ': Resumable (BaseError ResolutionError) ': Resumable (BaseError EvalError) + ': Resumable (BaseError (HeapError address)) + ': Resumable (BaseError (ScopeError address)) ': Resumable (BaseError (UnspecializedError (Value address (ConcreteEff address rest)))) ': Resumable (BaseError (LoadError address (Value address (ConcreteEff address rest)))) ': Fresh @@ -281,9 +277,6 @@ parsePythonPackage :: forall syntax fields effs term. , Member Resolution effs , Member Trace effs , Member Task effs - , Member (Allocator (Address (Hole (Maybe Name) Precise))) effs - , Member (Resumable (BaseError (HeapError (Hole (Maybe Name) Precise)))) effs - , Member (Resumable (BaseError (ScopeError (Hole (Maybe Name) Precise)))) effs , (Show (Record fields)) , Effects effs) => Parser term -- ^ A parser. @@ -297,6 +290,9 @@ parsePythonPackage parser project = do . resumingLoadError . resumingUnspecialized -- . resumingEnvironmentError -- TODO: Fix me. Replace with `resumineScopeGraphError`? + . Hole.runAllocator Precise.handleAllocator + . resumingScopeError + . resumingHeapError . resumingEvalError . resumingResolutionError . resumingAddressError @@ -449,6 +445,50 @@ resumingValueError = runValueErrorWith (\ baseError -> traceError "ValueError" b ArrayError{} -> pure lowerBound ArithmeticError{} -> pure hole) +resumingHeapError :: forall m address value effects a. ( Applicative (m address value effects) + , Effectful (m address value) + , Effects effects + , Member Trace effects + , Show address + , Ord address + , Member (Reader ModuleInfo) effects + , Member (State (Heap address address value)) effects + , Member (Allocator address) effects + , Member Fresh effects + , Member (Resumable (BaseError (ScopeError address))) effects + , Member (Reader Span) effects + , Member (State (ScopeGraph address)) effects + ) + => m address value (Resumable (BaseError (HeapError address)) ': effects) a + -> m address value effects a +resumingHeapError = runHeapErrorWith (\ baseError -> traceError "HeapError" baseError *> case baseErrorException baseError of + EmptyHeapError -> raiseEff . lowerEff $ do + currentScope' <- raiseEff (lowerEff currentScope) + frame <- newFrame @_ @value currentScope' mempty + putCurrentFrame frame + pure frame) + +resumingScopeError :: forall m address value effects a. ( Applicative (m address value effects) + , Effectful (m address value) + , Effects effects + , Member Trace effects + , Show address + , Ord address + , Member (Reader ModuleInfo) effects + , Member (Allocator address) effects + , Member Fresh effects + , Member (Reader Span) effects + , Member (State (ScopeGraph address)) effects + ) + => m address value (Resumable (BaseError (ScopeError address)) ': effects) a + -> m address value effects a +resumingScopeError = runScopeErrorWith (\ baseError -> traceError "ScopeError" baseError *> case baseErrorException baseError of + _ -> undefined) + -- LookupError :: address -> HeapError address address + -- LookupLinksError :: address -> HeapError address (Map EdgeLabel (Map address address)) + -- LookupPathError :: Path address -> HeapError address address + + -- TODO: Fix me. -- Replace this with ScopeGraphError? -- resumingEnvironmentError :: ( Monad (m (Hole (Maybe Name) address) value effects) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index c6a04ca98..f5e9c9376 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -129,7 +129,7 @@ evaluateProjectWithCaching proxy parser path = runTaskWithOptions debugOptions $ pure (runReader (packageInfo package) (runState (lowerBound @Span) (runReader (lowerBound @Span) - (runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Monovariant))))) + (runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Monovariant Type))))) (raiseHandler (runModules (ModuleTable.modulePaths (packageModules package))) (evaluate proxy id withTermSpans (Monovariant.runAllocator . Monovariant.runDeref) (Type.runBoolean . Type.runFunction) modules))))))