mirror of
https://github.com/github/semantic.git
synced 2024-12-27 00:44:57 +03:00
Merge branch 'master' into generate-this
This commit is contained in:
commit
d0bd27b45e
@ -49,6 +49,7 @@ library
|
||||
, Control.Abstract.Value
|
||||
-- Datatypes for abstract interpretation
|
||||
, Data.Abstract.Address
|
||||
, Data.Abstract.BaseError
|
||||
, Data.Abstract.Cache
|
||||
, Data.Abstract.Configuration
|
||||
, Data.Abstract.Declarations
|
||||
|
@ -7,6 +7,7 @@ module Analysis.Abstract.Caching
|
||||
|
||||
import Control.Abstract
|
||||
import Data.Abstract.Cache
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Module
|
||||
import Data.Abstract.Ref
|
||||
import Prologue
|
||||
@ -81,7 +82,9 @@ convergingModules :: ( AbstractValue address value effects
|
||||
, Member NonDet effects
|
||||
, Member (Reader (Cache term address (Cell address) value)) effects
|
||||
, Member (Reader (Live address)) effects
|
||||
, Member (Resumable (EnvironmentError address)) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError address))) effects
|
||||
, Member (State (Cache term address (Cell address) value)) effects
|
||||
, Member (Env address) effects
|
||||
, Member (State (Heap address (Cell address) value)) effects
|
||||
|
@ -19,6 +19,7 @@ module Analysis.Abstract.Graph
|
||||
import Algebra.Graph.Export.Dot hiding (vertexName)
|
||||
import Control.Abstract hiding (Function(..))
|
||||
import Data.Abstract.Address
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Ref
|
||||
import Data.Abstract.Declarations
|
||||
import Data.Abstract.Module (Module (moduleInfo), ModuleInfo (..))
|
||||
@ -60,10 +61,11 @@ style = (defaultStyle (T.encodeUtf8Builder . vertexIdentifier))
|
||||
|
||||
-- | Add vertices to the graph for evaluated identifiers.
|
||||
graphingTerms :: ( Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Env (Hole context (Located address))) effects
|
||||
, Member (State (Graph Vertex)) effects
|
||||
, Member (State (Map (Hole context (Located address)) Vertex)) effects
|
||||
, Member (Resumable (EnvironmentError (Hole context (Located address)))) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError (Hole context (Located address))))) effects
|
||||
, AbstractValue (Hole context (Located address)) value effects
|
||||
, Member (Reader Vertex) effects
|
||||
, HasField fields Span
|
||||
|
@ -23,10 +23,13 @@ module Control.Abstract.Environment
|
||||
) where
|
||||
|
||||
import Control.Abstract.Evaluator
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Environment (Bindings, Environment, EvalContext(..))
|
||||
import qualified Data.Abstract.Environment as Env
|
||||
import Data.Abstract.Exports as Exports
|
||||
import Data.Abstract.Module
|
||||
import Data.Abstract.Name
|
||||
import Data.Span
|
||||
import Prologue
|
||||
|
||||
-- | Retrieve the current execution context
|
||||
@ -114,7 +117,9 @@ runEnv initial = fmap (filterEnv . fmap (first (Env.head . ctxEnvironment))) . r
|
||||
| Exports.null ports = (binds, a)
|
||||
| otherwise = (Exports.toBindings ports <> Env.aliasBindings (Exports.aliases ports) binds, a)
|
||||
|
||||
handleEnv :: forall address value effects a . Effects effects => Env address (Eff (Env address ': effects)) a -> Evaluator address value (State (EvalContext address) ': State (Exports address) ': effects) a
|
||||
handleEnv :: forall address value effects a . Effects effects
|
||||
=> Env address (Eff (Env address ': effects)) a
|
||||
-> Evaluator address value (State (EvalContext address) ': State (Exports address) ': effects) a
|
||||
handleEnv = \case
|
||||
Lookup name -> Env.lookupEnv' name . ctxEnvironment <$> get
|
||||
Bind name addr -> modify (\EvalContext{..} -> EvalContext ctxSelf (Env.insertEnv name addr ctxEnvironment))
|
||||
@ -136,11 +141,29 @@ deriving instance Show (EnvironmentError address return)
|
||||
instance Show1 (EnvironmentError address) where liftShowsPrec _ _ = showsPrec
|
||||
instance Eq1 (EnvironmentError address) where liftEq _ (FreeVariable n1) (FreeVariable n2) = n1 == n2
|
||||
|
||||
freeVariableError :: Member (Resumable (EnvironmentError address)) effects => Name -> Evaluator address value effects address
|
||||
freeVariableError = throwResumable . FreeVariable
|
||||
freeVariableError :: ( Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError address))) effects
|
||||
)
|
||||
=> Name
|
||||
-> Evaluator address value effects address
|
||||
freeVariableError = throwEnvironmentError . FreeVariable
|
||||
|
||||
runEnvironmentError :: (Effectful (m address value), Effects effects) => m address value (Resumable (EnvironmentError address) ': effects) a -> m address value effects (Either (SomeExc (EnvironmentError address)) a)
|
||||
runEnvironmentError :: (Effectful (m address value), Effects effects)
|
||||
=> m address value (Resumable (BaseError (EnvironmentError address)) ': effects) a
|
||||
-> m address value effects (Either (SomeExc (BaseError (EnvironmentError address))) a)
|
||||
runEnvironmentError = runResumable
|
||||
|
||||
runEnvironmentErrorWith :: (Effectful (m address value), Effects effects) => (forall resume . EnvironmentError address resume -> m address value effects resume) -> m address value (Resumable (EnvironmentError address) ': effects) a -> m address value effects a
|
||||
runEnvironmentErrorWith :: (Effectful (m address value), Effects effects)
|
||||
=> (forall resume . BaseError (EnvironmentError address) resume -> m address value effects resume)
|
||||
-> m address value (Resumable (BaseError (EnvironmentError address)) ': effects) a
|
||||
-> m address value effects a
|
||||
runEnvironmentErrorWith = runResumableWith
|
||||
|
||||
throwEnvironmentError :: ( Member (Resumable (BaseError (EnvironmentError address))) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
)
|
||||
=> EnvironmentError address resume
|
||||
-> Evaluator address value effects resume
|
||||
throwEnvironmentError = throwBaseError
|
||||
|
@ -31,10 +31,13 @@ import Control.Abstract.Evaluator
|
||||
import Control.Abstract.Roots
|
||||
import Control.Abstract.TermEvaluator
|
||||
import Data.Abstract.Configuration
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Heap
|
||||
import Data.Abstract.Live
|
||||
import Data.Abstract.Module (ModuleInfo)
|
||||
import Data.Abstract.Name
|
||||
import Data.Semigroup.Reducer
|
||||
import Data.Span (Span)
|
||||
import Prologue
|
||||
|
||||
-- | Get the current 'Configuration' with a passed-in term.
|
||||
@ -117,7 +120,9 @@ letrec' name body = do
|
||||
|
||||
-- | Look up and dereference the given 'Name', throwing an exception for free variables.
|
||||
variable :: ( Member (Env address) effects
|
||||
, Member (Resumable (EnvironmentError address)) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError address))) effects
|
||||
)
|
||||
=> Name
|
||||
-> Evaluator address value effects address
|
||||
@ -177,13 +182,15 @@ runAllocator = interpret $ \ eff -> case eff of
|
||||
|
||||
runDeref :: ( Derefable address effects
|
||||
, PureEffects effects
|
||||
, Member (Resumable (AddressError address value)) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError (AddressError address value))) effects
|
||||
, Member (State (Heap address (Cell address) value)) effects
|
||||
)
|
||||
=> Evaluator address value (Deref address value ': effects) a
|
||||
-> Evaluator address value effects a
|
||||
runDeref = interpret $ \ eff -> case eff of
|
||||
Deref addr -> heapLookup addr <$> get >>= maybeM (throwResumable (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwResumable (UninitializedAddress addr))
|
||||
Deref addr -> heapLookup addr <$> get >>= maybeM (throwAddressError (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwAddressError (UninitializedAddress addr))
|
||||
|
||||
instance PureEffect (Allocator address value)
|
||||
|
||||
@ -210,9 +217,23 @@ instance Eq address => Eq1 (AddressError address value) where
|
||||
liftEq _ (UnallocatedAddress a) (UnallocatedAddress b) = a == b
|
||||
liftEq _ _ _ = False
|
||||
|
||||
throwAddressError :: ( Member (Resumable (BaseError (AddressError address body))) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
)
|
||||
=> AddressError address body resume
|
||||
-> Evaluator address value effects resume
|
||||
throwAddressError = throwBaseError
|
||||
|
||||
runAddressError :: (Effectful (m address value), Effects effects) => m address value (Resumable (AddressError address value) ': effects) a -> m address value effects (Either (SomeExc (AddressError address value)) a)
|
||||
runAddressError :: ( Effectful (m address value)
|
||||
, Effects effects
|
||||
)
|
||||
=> m address value (Resumable (BaseError (AddressError address value)) ': effects) a
|
||||
-> m address value effects (Either (SomeExc (BaseError (AddressError address value))) a)
|
||||
runAddressError = runResumable
|
||||
|
||||
runAddressErrorWith :: (Effectful (m address value), Effects effects) => (forall resume . AddressError address value resume -> m address value effects resume) -> m address value (Resumable (AddressError address value) ': effects) a -> m address value effects a
|
||||
runAddressErrorWith :: (Effectful (m address value), Effects effects)
|
||||
=> (forall resume . (BaseError (AddressError address value)) resume -> m address value effects resume)
|
||||
-> m address value (Resumable (BaseError (AddressError address value)) ': effects) a
|
||||
-> m address value effects a
|
||||
runAddressErrorWith = runResumableWith
|
||||
|
@ -9,22 +9,25 @@ module Control.Abstract.Modules
|
||||
, Modules(..)
|
||||
, runModules
|
||||
, LoadError(..)
|
||||
, moduleNotFound
|
||||
, runLoadError
|
||||
, runLoadErrorWith
|
||||
, throwLoadError
|
||||
, ResolutionError(..)
|
||||
, runResolutionError
|
||||
, runResolutionErrorWith
|
||||
, throwResolutionError
|
||||
, ModuleTable
|
||||
) where
|
||||
|
||||
import Control.Abstract.Evaluator
|
||||
import Data.Abstract.Environment
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Module
|
||||
import Data.Abstract.ModuleTable as ModuleTable
|
||||
import Data.Language
|
||||
import Data.Semigroup.Foldable (foldMap1)
|
||||
import qualified Data.Set as Set
|
||||
import Data.Span
|
||||
import Prologue
|
||||
import System.FilePath.Posix (takeDirectory)
|
||||
|
||||
@ -72,14 +75,14 @@ sendModules :: Member (Modules address) effects => Modules address (Eff effects)
|
||||
sendModules = send
|
||||
|
||||
runModules :: ( Member (Reader (ModuleTable (NonEmpty (Module (ModuleResult address))))) effects
|
||||
, Member (Resumable (LoadError address)) effects
|
||||
, Member (Resumable (BaseError (LoadError address))) effects
|
||||
, PureEffects effects
|
||||
)
|
||||
=> Set ModulePath
|
||||
-> Evaluator address value (Modules address ': effects) a
|
||||
-> Evaluator address value effects a
|
||||
runModules paths = interpret $ \case
|
||||
Load name -> fmap (runMerging . foldMap1 (Merging . moduleBody)) . ModuleTable.lookup name <$> askModuleTable >>= maybeM (moduleNotFound name)
|
||||
Load name -> fmap (runMerging . foldMap1 (Merging . moduleBody)) . ModuleTable.lookup name <$> askModuleTable >>= maybeM (throwLoadError (ModuleNotFoundError name))
|
||||
Lookup path -> fmap (runMerging . foldMap1 (Merging . moduleBody)) . ModuleTable.lookup path <$> askModuleTable
|
||||
Resolve names -> pure (find (`Set.member` paths) names)
|
||||
List dir -> pure (filter ((dir ==) . takeDirectory) (toList paths))
|
||||
@ -96,24 +99,31 @@ instance Semigroup (Merging address) where
|
||||
|
||||
-- | An error thrown when loading a module from the list of provided modules. Indicates we weren't able to find a module with the given name.
|
||||
data LoadError address resume where
|
||||
ModuleNotFound :: ModulePath -> LoadError address (ModuleResult address)
|
||||
ModuleNotFoundError :: ModulePath -> LoadError address (ModuleResult address)
|
||||
|
||||
deriving instance Eq (LoadError address resume)
|
||||
deriving instance Show (LoadError address resume)
|
||||
instance Show1 (LoadError address) where
|
||||
liftShowsPrec _ _ = showsPrec
|
||||
instance Eq1 (LoadError address) where
|
||||
liftEq _ (ModuleNotFound a) (ModuleNotFound b) = a == b
|
||||
liftEq _ (ModuleNotFoundError a) (ModuleNotFoundError b) = a == b
|
||||
|
||||
moduleNotFound :: Member (Resumable (LoadError address)) effects => ModulePath -> Evaluator address value effects (ModuleResult address)
|
||||
moduleNotFound = throwResumable . ModuleNotFound
|
||||
|
||||
runLoadError :: (Effectful (m address value), Effects effects) => m address value (Resumable (LoadError address) ': effects) a -> m address value effects (Either (SomeExc (LoadError address)) a)
|
||||
runLoadError :: (Effectful (m address value), Effects effects)
|
||||
=> m address value (Resumable (BaseError (LoadError address)) ': effects) a
|
||||
-> m address value effects (Either (SomeExc (BaseError (LoadError address))) a)
|
||||
runLoadError = runResumable
|
||||
|
||||
runLoadErrorWith :: (Effectful (m address value), Effects effects) => (forall resume . LoadError address resume -> m address value effects resume) -> m address value (Resumable (LoadError address) ': effects) a -> m address value effects a
|
||||
runLoadErrorWith :: (Effectful (m address value), Effects effects)
|
||||
=> (forall resume . (BaseError (LoadError address)) resume -> m address value effects resume)
|
||||
-> m address value (Resumable (BaseError (LoadError address)) ': effects) a
|
||||
-> m address value effects a
|
||||
runLoadErrorWith = runResumableWith
|
||||
|
||||
throwLoadError :: Member (Resumable (BaseError (LoadError address))) effects
|
||||
=> LoadError address resume
|
||||
-> Evaluator address value effects resume
|
||||
throwLoadError err@(ModuleNotFoundError name) = throwResumable $ BaseError (ModuleInfo name) emptySpan err
|
||||
|
||||
|
||||
-- | An error thrown when we can't resolve a module from a qualified name.
|
||||
data ResolutionError resume where
|
||||
@ -132,8 +142,21 @@ instance Eq1 ResolutionError where
|
||||
liftEq _ (GoImportError a) (GoImportError b) = a == b
|
||||
liftEq _ _ _ = False
|
||||
|
||||
runResolutionError :: (Effectful m, Effects effects) => m (Resumable ResolutionError ': effects) a -> m effects (Either (SomeExc ResolutionError) a)
|
||||
runResolutionError :: (Effectful m, Effects effects)
|
||||
=> m (Resumable (BaseError ResolutionError) ': effects) a
|
||||
-> m effects (Either (SomeExc (BaseError ResolutionError)) a)
|
||||
runResolutionError = runResumable
|
||||
|
||||
runResolutionErrorWith :: (Effectful m, Effects effects) => (forall resume . ResolutionError resume -> m effects resume) -> m (Resumable ResolutionError ': effects) a -> m effects a
|
||||
runResolutionErrorWith :: (Effectful m, Effects effects)
|
||||
=> (forall resume . (BaseError ResolutionError) resume -> m effects resume)
|
||||
-> m (Resumable (BaseError ResolutionError) ': effects) a
|
||||
-> m effects a
|
||||
runResolutionErrorWith = runResumableWith
|
||||
|
||||
throwResolutionError :: ( Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError ResolutionError)) effects
|
||||
)
|
||||
=> ResolutionError resume
|
||||
-> Evaluator address value effects resume
|
||||
throwResolutionError = throwBaseError
|
||||
|
@ -15,6 +15,7 @@ import Control.Abstract.Evaluator
|
||||
import Control.Abstract.Heap
|
||||
import Control.Abstract.Value
|
||||
import qualified Data.Abstract.Environment as Env
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Name
|
||||
import Data.Text (unpack)
|
||||
import Prologue
|
||||
@ -99,7 +100,7 @@ builtInPrint :: ( AbstractValue address value effects
|
||||
, Member (Function address value) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (EnvironmentError address)) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError address))) effects
|
||||
, Member Trace effects
|
||||
)
|
||||
=> Evaluator address value effects value
|
||||
@ -114,7 +115,7 @@ builtInExport :: ( AbstractValue address value effects
|
||||
, Member (Function address value) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (EnvironmentError address)) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError address))) effects
|
||||
)
|
||||
=> Evaluator address value effects value
|
||||
builtInExport = lambda (\ v -> do
|
||||
|
@ -23,10 +23,13 @@ import Control.Abstract.Environment
|
||||
import Control.Abstract.Evaluator
|
||||
import Control.Abstract.Heap
|
||||
import Data.Abstract.Environment as Env
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Module
|
||||
import Data.Abstract.Name
|
||||
import Data.Abstract.Number as Number
|
||||
import Data.Abstract.Ref
|
||||
import Data.Scientific (Scientific)
|
||||
import Data.Span
|
||||
import Prologue hiding (TypeError)
|
||||
|
||||
-- | This datum is passed into liftComparison to handle the fact that Ruby and PHP
|
||||
@ -228,7 +231,9 @@ evaluateInScopedEnv receiver term = do
|
||||
value :: ( AbstractValue address value effects
|
||||
, Member (Deref address value) effects
|
||||
, Member (Env address) effects
|
||||
, Member (Resumable (EnvironmentError address)) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError address))) effects
|
||||
)
|
||||
=> ValueRef address
|
||||
-> Evaluator address value effects value
|
||||
@ -238,7 +243,9 @@ value = deref <=< address
|
||||
subtermValue :: ( AbstractValue address value effects
|
||||
, Member (Deref address value) effects
|
||||
, Member (Env address) effects
|
||||
, Member (Resumable (EnvironmentError address)) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError address))) effects
|
||||
)
|
||||
=> Subterm term (Evaluator address value effects (ValueRef address))
|
||||
-> Evaluator address value effects value
|
||||
@ -247,7 +254,9 @@ subtermValue = value <=< subtermRef
|
||||
-- | Returns the address of a value referenced by a 'ValueRef'
|
||||
address :: ( AbstractValue address value effects
|
||||
, Member (Env address) effects
|
||||
, Member (Resumable (EnvironmentError address)) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError address))) effects
|
||||
)
|
||||
=> ValueRef address
|
||||
-> Evaluator address value effects address
|
||||
@ -258,7 +267,9 @@ address (Rval addr) = pure addr
|
||||
-- | Evaluates a 'Subterm' to the address of its rval
|
||||
subtermAddress :: ( AbstractValue address value effects
|
||||
, Member (Env address) effects
|
||||
, Member (Resumable (EnvironmentError address)) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError address))) effects
|
||||
)
|
||||
=> Subterm term (Evaluator address value effects (ValueRef address))
|
||||
-> Evaluator address value effects address
|
||||
|
41
src/Data/Abstract/BaseError.hs
Normal file
41
src/Data/Abstract/BaseError.hs
Normal file
@ -0,0 +1,41 @@
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
|
||||
module Data.Abstract.BaseError (
|
||||
BaseError(..)
|
||||
, throwBaseError
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Abstract.Context
|
||||
import Control.Abstract.Evaluator
|
||||
import qualified Data.Abstract.Module as M
|
||||
import qualified Data.Span as S
|
||||
import Prologue
|
||||
|
||||
data BaseError (exc :: * -> *) resume = BaseError { baseErrorModuleInfo :: ModuleInfo, baseErrorSpan :: Span, baseErrorException :: exc resume }
|
||||
|
||||
instance (Show (exc resume)) => Show (BaseError exc resume) where
|
||||
showsPrec _ BaseError{..} = shows baseErrorException <> showString " " <> showString errorLocation
|
||||
where errorLocation | startErrorLine == endErrorLine = M.modulePath baseErrorModuleInfo <> " " <> startErrorLine <> ":" <> startErrorCol <> "-" <> endErrorCol
|
||||
| otherwise = M.modulePath baseErrorModuleInfo <> " " <> startErrorLine <> ":" <> startErrorCol <> "-" <> endErrorLine <> ":" <> endErrorCol
|
||||
startErrorLine = show $ S.posLine (S.spanStart baseErrorSpan)
|
||||
endErrorLine = show $ S.posLine (S.spanEnd baseErrorSpan)
|
||||
startErrorCol = show $ S.posColumn (S.spanStart baseErrorSpan)
|
||||
endErrorCol = show $ S.posColumn (S.spanEnd baseErrorSpan)
|
||||
|
||||
instance (Eq1 exc) => Eq1 (BaseError exc) where
|
||||
liftEq f (BaseError _ _ exc1) (BaseError _ _ exc2) = liftEq f exc1 exc2
|
||||
|
||||
instance Show1 exc => Show1 (BaseError exc) where
|
||||
liftShowsPrec sl sp d (BaseError _ _ exc) = liftShowsPrec sl sp d exc
|
||||
|
||||
throwBaseError :: ( Member (Resumable (BaseError exc)) effects
|
||||
, Member (Reader M.ModuleInfo) effects
|
||||
, Member (Reader S.Span) effects
|
||||
)
|
||||
=> exc resume
|
||||
-> Evaluator address value effects resume
|
||||
throwBaseError err = do
|
||||
moduleInfo <- currentModule
|
||||
span <- currentSpan
|
||||
throwResumable $ BaseError moduleInfo span err
|
@ -13,9 +13,10 @@ module Data.Abstract.Evaluatable
|
||||
, throwEvalError
|
||||
, runEvalError
|
||||
, runEvalErrorWith
|
||||
, Unspecialized(..)
|
||||
, UnspecializedError(..)
|
||||
, runUnspecialized
|
||||
, runUnspecializedWith
|
||||
, throwUnspecializedError
|
||||
, Cell
|
||||
) where
|
||||
|
||||
@ -24,10 +25,11 @@ import Control.Abstract.Context as X
|
||||
import Control.Abstract.Environment as X hiding (runEnvironmentError, runEnvironmentErrorWith)
|
||||
import Control.Abstract.Evaluator as X hiding (LoopControl(..), Return(..), catchLoopControl, runLoopControl, catchReturn, runReturn)
|
||||
import Control.Abstract.Heap as X hiding (AddressError(..), runAddressError, runAddressErrorWith)
|
||||
import Control.Abstract.Modules as X (Modules, ResolutionError(..), load, lookupModule, listModulesInDir, require, resolve)
|
||||
import Control.Abstract.Modules as X (Modules, ModuleResult, ResolutionError(..), load, lookupModule, listModulesInDir, require, resolve, throwResolutionError)
|
||||
import Control.Abstract.Value as X hiding (Function(..))
|
||||
import Data.Abstract.Declarations as X
|
||||
import Data.Abstract.Environment as X
|
||||
import Data.Abstract.BaseError as X
|
||||
import Data.Abstract.FreeVariables as X
|
||||
import Data.Abstract.Module
|
||||
import Data.Abstract.ModuleTable as ModuleTable
|
||||
@ -58,17 +60,17 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader PackageInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (EnvironmentError address)) effects
|
||||
, Member (Resumable (Unspecialized value)) effects
|
||||
, Member (Resumable EvalError) effects
|
||||
, Member (Resumable ResolutionError) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError address))) effects
|
||||
, Member (Resumable (BaseError (UnspecializedError value))) effects
|
||||
, Member (Resumable (BaseError EvalError)) effects
|
||||
, Member (Resumable (BaseError ResolutionError)) effects
|
||||
, Member Fresh effects
|
||||
, Member Trace effects
|
||||
)
|
||||
=> SubtermAlgebra constr term (Evaluator address value effects (ValueRef address))
|
||||
eval expr = do
|
||||
traverse_ subtermValue expr
|
||||
v <- throwResumable (Unspecialized ("Eval unspecialized for " <> liftShowsPrec (const (const id)) (const id) 0 expr ""))
|
||||
v <- throwUnspecializedError $ UnspecializedError ("Eval unspecialized for " <> liftShowsPrec (const (const id)) (const id) 0 expr "")
|
||||
rvalBox v
|
||||
|
||||
|
||||
@ -87,11 +89,11 @@ evaluate :: ( AbstractValue address value valueEffects
|
||||
, Member (Reader (ModuleTable (NonEmpty (Module (ModuleResult address))))) effects
|
||||
, Member (Reader PackageInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (AddressError address value)) effects
|
||||
, Member (Resumable (EnvironmentError address)) effects
|
||||
, Member (Resumable EvalError) effects
|
||||
, Member (Resumable ResolutionError) effects
|
||||
, Member (Resumable (Unspecialized value)) effects
|
||||
, Member (Resumable (BaseError (AddressError address value))) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError address))) effects
|
||||
, Member (Resumable (BaseError EvalError)) effects
|
||||
, Member (Resumable (BaseError ResolutionError)) effects
|
||||
, Member (Resumable (BaseError (UnspecializedError value))) effects
|
||||
, Member (State (Heap address (Cell address) value)) effects
|
||||
, Member Trace effects
|
||||
, Recursive term
|
||||
@ -101,7 +103,7 @@ evaluate :: ( AbstractValue address value valueEffects
|
||||
, valueEffects ~ (Function address value ': moduleEffects)
|
||||
)
|
||||
=> proxy lang
|
||||
-> (SubtermAlgebra Module term (TermEvaluator term address value moduleEffects address) -> SubtermAlgebra Module term (TermEvaluator term address value moduleEffects address))
|
||||
-> (SubtermAlgebra Module term (TermEvaluator term address value moduleEffects address) -> SubtermAlgebra Module term (TermEvaluator term address value moduleEffects address))
|
||||
-> (SubtermAlgebra (Base term) term (TermEvaluator term address value valueEffects (ValueRef address)) -> SubtermAlgebra (Base term) term (TermEvaluator term address value valueEffects (ValueRef address)))
|
||||
-> (forall x . Evaluator address value valueEffects x -> Evaluator address value moduleEffects x)
|
||||
-> [Module term]
|
||||
@ -148,7 +150,7 @@ class HasPrelude (language :: Language) where
|
||||
, Member (Function address value) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (EnvironmentError address)) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError address))) effects
|
||||
, Member Trace effects
|
||||
)
|
||||
=> proxy language
|
||||
@ -192,7 +194,7 @@ class HasPostlude (language :: Language) where
|
||||
, Member Fresh effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (EnvironmentError address)) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError address))) effects
|
||||
, Member Trace effects
|
||||
)
|
||||
=> proxy language
|
||||
@ -238,34 +240,52 @@ instance Eq1 EvalError where
|
||||
instance Show1 EvalError where
|
||||
liftShowsPrec _ _ = showsPrec
|
||||
|
||||
throwEvalError :: (Effectful m, Member (Resumable EvalError) effects) => EvalError resume -> m effects resume
|
||||
throwEvalError = throwResumable
|
||||
|
||||
runEvalError :: (Effectful m, Effects effects) => m (Resumable EvalError ': effects) a -> m effects (Either (SomeExc EvalError) a)
|
||||
runEvalError :: (Effectful m, Effects effects) => m (Resumable (BaseError EvalError) ': effects) a -> m effects (Either (SomeExc (BaseError EvalError)) a)
|
||||
runEvalError = runResumable
|
||||
|
||||
runEvalErrorWith :: (Effectful m, Effects effects) => (forall resume . EvalError resume -> m effects resume) -> m (Resumable EvalError ': effects) a -> m effects a
|
||||
runEvalErrorWith :: (Effectful m, Effects effects) => (forall resume . (BaseError EvalError) resume -> m effects resume) -> m (Resumable (BaseError EvalError) ': effects) a -> m effects a
|
||||
runEvalErrorWith = runResumableWith
|
||||
|
||||
throwEvalError :: ( Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError EvalError)) effects
|
||||
)
|
||||
=> EvalError resume
|
||||
-> Evaluator address value effects resume
|
||||
throwEvalError = throwBaseError
|
||||
|
||||
data Unspecialized a b where
|
||||
Unspecialized :: String -> Unspecialized value value
|
||||
|
||||
deriving instance Eq (Unspecialized a b)
|
||||
deriving instance Show (Unspecialized a b)
|
||||
data UnspecializedError a b where
|
||||
UnspecializedError :: String -> UnspecializedError value value
|
||||
|
||||
instance Eq1 (Unspecialized a) where
|
||||
liftEq _ (Unspecialized a) (Unspecialized b) = a == b
|
||||
deriving instance Eq (UnspecializedError a b)
|
||||
deriving instance Show (UnspecializedError a b)
|
||||
|
||||
instance Show1 (Unspecialized a) where
|
||||
instance Eq1 (UnspecializedError a) where
|
||||
liftEq _ (UnspecializedError a) (UnspecializedError b) = a == b
|
||||
|
||||
instance Show1 (UnspecializedError a) where
|
||||
liftShowsPrec _ _ = showsPrec
|
||||
|
||||
runUnspecialized :: (Effectful (m value), Effects effects) => m value (Resumable (Unspecialized value) ': effects) a -> m value effects (Either (SomeExc (Unspecialized value)) a)
|
||||
runUnspecialized :: (Effectful (m value), Effects effects)
|
||||
=> m value (Resumable (BaseError (UnspecializedError value)) ': effects) a
|
||||
-> m value effects (Either (SomeExc (BaseError (UnspecializedError value))) a)
|
||||
runUnspecialized = runResumable
|
||||
|
||||
runUnspecializedWith :: (Effectful (m value), Effects effects) => (forall resume . Unspecialized value resume -> m value effects resume) -> m value (Resumable (Unspecialized value) ': effects) a -> m value effects a
|
||||
runUnspecializedWith :: (Effectful (m value), Effects effects)
|
||||
=> (forall resume . BaseError (UnspecializedError value) resume -> m value effects resume)
|
||||
-> m value (Resumable (BaseError (UnspecializedError value)) ': effects) a
|
||||
-> m value effects a
|
||||
runUnspecializedWith = runResumableWith
|
||||
|
||||
throwUnspecializedError :: ( Member (Resumable (BaseError (UnspecializedError value))) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
)
|
||||
=> UnspecializedError value resume
|
||||
-> Evaluator address value effects resume
|
||||
throwUnspecializedError = throwBaseError
|
||||
|
||||
|
||||
-- Instances
|
||||
|
||||
|
@ -7,11 +7,11 @@ module Data.Abstract.Value.Concrete
|
||||
, materializeEnvironment
|
||||
, runValueError
|
||||
, runValueErrorWith
|
||||
, throwValueError
|
||||
) where
|
||||
|
||||
import qualified Control.Abstract as Abstract
|
||||
import Control.Abstract hiding (Function(..))
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Environment (Environment, Bindings, EvalContext(..))
|
||||
import qualified Data.Abstract.Environment as Env
|
||||
import Data.Abstract.Name
|
||||
@ -67,7 +67,8 @@ runFunction :: ( Member (Allocator address (Value address body)) effects
|
||||
, Member Fresh effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader PackageInfo) effects
|
||||
, Member (Resumable (ValueError address body)) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError (ValueError address body))) effects
|
||||
, PureEffects effects
|
||||
)
|
||||
=> (body address -> Evaluator address (Value address body) (Abstract.Function address (Value address body) ': effects) address)
|
||||
@ -142,7 +143,8 @@ instance ( Coercible body (Eff effects)
|
||||
, Member Fresh effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader PackageInfo) effects
|
||||
, Member (Resumable (ValueError address body)) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError (ValueError address body))) effects
|
||||
, Show address
|
||||
)
|
||||
=> AbstractValue address (Value address body) effects where
|
||||
@ -214,7 +216,13 @@ instance ( Coercible body (Eff effects)
|
||||
tentative x i j = attemptUnsafeArithmetic (x i j)
|
||||
|
||||
-- Dispatch whatever's contained inside a 'Number.SomeNumber' to its appropriate 'MonadValue' ctor
|
||||
specialize :: (AbstractValue address (Value address body) effects, Member (Resumable (ValueError address body)) effects) => Either ArithException Number.SomeNumber -> Evaluator address (Value address body) effects (Value address body)
|
||||
specialize :: ( AbstractValue address (Value address body) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError (ValueError address body))) effects
|
||||
)
|
||||
=> Either ArithException Number.SomeNumber
|
||||
-> Evaluator address (Value address body) effects (Value address body)
|
||||
specialize (Left exc) = throwValueError (ArithmeticError exc)
|
||||
specialize (Right (Number.SomeNumber (Number.Integer i))) = pure $ integer i
|
||||
specialize (Right (Number.SomeNumber (Number.Ratio r))) = pure $ rational r
|
||||
@ -244,7 +252,6 @@ instance ( Coercible body (Eff effects)
|
||||
|
||||
pair = (left, right)
|
||||
|
||||
|
||||
liftBitwise operator target
|
||||
| Integer (Number.Integer i) <- target = pure . integer $ operator i
|
||||
| otherwise = throwValueError (BitwiseError target)
|
||||
@ -297,11 +304,21 @@ deriving instance Show address => Show (ValueError address body resume)
|
||||
instance Show address => Show1 (ValueError address body) where
|
||||
liftShowsPrec _ _ = showsPrec
|
||||
|
||||
throwValueError :: Member (Resumable (ValueError address body)) effects => ValueError address body resume -> Evaluator address (Value address body) effects resume
|
||||
throwValueError = throwResumable
|
||||
|
||||
runValueError :: (Effectful (m address (Value address body)), Effects effects) => m address (Value address body) (Resumable (ValueError address body) ': effects) a -> m address (Value address body) effects (Either (SomeExc (ValueError address body)) a)
|
||||
runValueError :: (Effectful (m address (Value address body)), Effects effects)
|
||||
=> m address (Value address body) (Resumable (BaseError (ValueError address body)) ': effects) a
|
||||
-> m address (Value address body) effects (Either (SomeExc (BaseError (ValueError address body))) a)
|
||||
runValueError = runResumable
|
||||
|
||||
runValueErrorWith :: (Effectful (m address (Value address body)), Effects effects) => (forall resume . ValueError address body resume -> m address (Value address body) effects resume) -> m address (Value address body) (Resumable (ValueError address body) ': effects) a -> m address (Value address body) effects a
|
||||
runValueErrorWith :: (Effectful (m address (Value address body)), Effects effects)
|
||||
=> (forall resume . BaseError (ValueError address body) resume -> m address (Value address body) effects resume)
|
||||
-> m address (Value address body) (Resumable (BaseError (ValueError address body)) ': effects) a
|
||||
-> m address (Value address body) effects a
|
||||
runValueErrorWith = runResumableWith
|
||||
|
||||
throwValueError :: ( Member (Resumable (BaseError (ValueError address body))) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
)
|
||||
=> ValueError address body resume
|
||||
-> Evaluator address (Value address body) effects resume
|
||||
throwValueError = throwBaseError
|
||||
|
@ -13,6 +13,7 @@ import qualified Control.Abstract as Abstract
|
||||
import Control.Abstract hiding (Function(..), raiseHandler)
|
||||
import Control.Monad.Effect.Internal (raiseHandler)
|
||||
import Data.Abstract.Environment as Env
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Semigroup.Foldable (foldMap1)
|
||||
import qualified Data.Map as Map
|
||||
import Prologue hiding (TypeError)
|
||||
@ -84,12 +85,20 @@ instance Ord1 TypeError where
|
||||
|
||||
instance Show1 TypeError where liftShowsPrec _ _ = showsPrec
|
||||
|
||||
runTypeError :: (Effectful m, Effects effects) => m (Resumable TypeError ': effects) a -> m effects (Either (SomeExc TypeError) a)
|
||||
runTypeError :: (Effectful m, Effects effects) => m (Resumable (BaseError TypeError) ': effects) a -> m effects (Either (SomeExc (BaseError TypeError)) a)
|
||||
runTypeError = runResumable
|
||||
|
||||
runTypeErrorWith :: (Effectful m, Effects effects) => (forall resume . TypeError resume -> m effects resume) -> m (Resumable TypeError ': effects) a -> m effects a
|
||||
runTypeErrorWith :: (Effectful m, Effects effects) => (forall resume . (BaseError TypeError) resume -> m effects resume) -> m (Resumable (BaseError TypeError) ': effects) a -> m effects a
|
||||
runTypeErrorWith = runResumableWith
|
||||
|
||||
throwTypeError :: ( Member (Resumable (BaseError TypeError)) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
)
|
||||
=> TypeError resume
|
||||
-> Evaluator address value effects resume
|
||||
throwTypeError = throwBaseError
|
||||
|
||||
runTypeMap :: ( Effectful m
|
||||
, Effects effects
|
||||
)
|
||||
@ -100,15 +109,15 @@ runTypeMap = raiseHandler (runState emptyTypeMap >=> pure . snd)
|
||||
runTypes :: ( Effectful m
|
||||
, Effects effects
|
||||
)
|
||||
=> m (Resumable TypeError ': State TypeMap ': effects) a
|
||||
-> m effects (Either (SomeExc TypeError) a)
|
||||
=> m (Resumable (BaseError TypeError) ': State TypeMap ': effects) a
|
||||
-> m effects (Either (SomeExc (BaseError TypeError)) a)
|
||||
runTypes = runTypeMap . runTypeError
|
||||
|
||||
runTypesWith :: ( Effectful m
|
||||
, Effects effects
|
||||
)
|
||||
=> (forall resume . TypeError resume -> m (State TypeMap ': effects) resume)
|
||||
-> m (Resumable TypeError ': State TypeMap ': effects) a
|
||||
=> (forall resume . (BaseError TypeError) resume -> m (State TypeMap ': effects) resume)
|
||||
-> m (Resumable (BaseError TypeError) ': State TypeMap ': effects) a
|
||||
-> m effects a
|
||||
runTypesWith with = runTypeMap . runTypeErrorWith with
|
||||
|
||||
@ -173,31 +182,31 @@ occur id = prune >=> \case
|
||||
eitherM f (a, b) = (||) <$> f a <*> f b
|
||||
|
||||
-- | Substitutes a type variable name for another type
|
||||
substitute :: ( Effectful m
|
||||
, Monad (m effects)
|
||||
, Member (Resumable TypeError) effects
|
||||
substitute :: ( Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError TypeError)) effects
|
||||
, Member (State TypeMap) effects
|
||||
)
|
||||
=> TName
|
||||
-> Type
|
||||
-> m effects Type
|
||||
-> Evaluator address value effects Type
|
||||
substitute id ty = do
|
||||
infiniteType <- occur id ty
|
||||
ty <- if infiniteType
|
||||
then throwResumable (InfiniteType (Var id) ty)
|
||||
then throwTypeError (InfiniteType (Var id) ty)
|
||||
else pure ty
|
||||
modifyTypeMap (Map.insert id ty)
|
||||
pure ty
|
||||
|
||||
-- | Unify two 'Type's.
|
||||
unify :: ( Effectful m
|
||||
, Monad (m effects)
|
||||
, Member (Resumable TypeError) effects
|
||||
unify :: ( Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError TypeError)) effects
|
||||
, Member (State TypeMap) effects
|
||||
)
|
||||
=> Type
|
||||
-> Type
|
||||
-> m effects Type
|
||||
-> Evaluator address value effects Type
|
||||
unify a b = do
|
||||
a' <- prune a
|
||||
b' <- prune b
|
||||
@ -213,7 +222,7 @@ unify a b = do
|
||||
(a1 :+ b1, a2 :+ b2) -> (:+) <$> unify a1 a2 <*> unify b1 b2
|
||||
(a1 :* b1, a2 :* b2) -> (:*) <$> unify a1 a2 <*> unify b1 b2
|
||||
(t1, t2) | t1 == t2 -> pure t2
|
||||
_ -> throwResumable (UnificationError a b)
|
||||
_ -> throwTypeError (UnificationError a b)
|
||||
|
||||
instance Ord address => ValueRoots address Type where
|
||||
valueRoots _ = mempty
|
||||
@ -224,7 +233,9 @@ runFunction :: ( Member (Allocator address Type) effects
|
||||
, Member (Env address) effects
|
||||
, Member (Exc (Return address)) effects
|
||||
, Member Fresh effects
|
||||
, Member (Resumable TypeError) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError TypeError)) effects
|
||||
, Member (State TypeMap) effects
|
||||
, PureEffects effects
|
||||
)
|
||||
@ -245,7 +256,7 @@ runFunction = interpret $ \case
|
||||
unified <- op `unify` needed
|
||||
case unified of
|
||||
_ :-> ret -> box ret
|
||||
actual -> throwResumable (UnificationError needed actual) >>= box
|
||||
actual -> throwTypeError (UnificationError needed actual) >>= box
|
||||
|
||||
|
||||
instance AbstractHole Type where
|
||||
@ -270,7 +281,9 @@ instance ( Member (Allocator address Type) effects
|
||||
, Member (Deref address Type) effects
|
||||
, Member Fresh effects
|
||||
, Member NonDet effects
|
||||
, Member (Resumable TypeError) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError TypeError)) effects
|
||||
, Member (State TypeMap) effects
|
||||
)
|
||||
=> AbstractValue address Type effects where
|
||||
|
@ -393,7 +393,7 @@ instance Show1 Subscript where liftShowsPrec = genericLiftShowsPrec
|
||||
-- TODO return a special LvalSubscript instance here
|
||||
instance Evaluatable Subscript where
|
||||
eval (Subscript l [r]) = Rval <$> join (index <$> subtermValue l <*> subtermValue r)
|
||||
eval (Subscript _ _) = rvalBox =<< throwResumable (Unspecialized "Eval unspecialized for subscript with slices")
|
||||
eval (Subscript _ _) = rvalBox =<< throwUnspecializedError (UnspecializedError "Eval unspecialized for subscript with slices")
|
||||
|
||||
data Member a = Member { lhs :: a, rhs :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)
|
||||
|
@ -2,6 +2,7 @@
|
||||
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
|
||||
module Language.Go.Syntax where
|
||||
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.Abstract.Module
|
||||
import qualified Data.Abstract.Package as Package
|
||||
@ -31,7 +32,8 @@ defaultAlias = name . T.pack . takeFileName . unPath
|
||||
resolveGoImport :: ( Member (Modules address) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Package.PackageInfo) effects
|
||||
, Member (Resumable ResolutionError) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError ResolutionError)) effects
|
||||
, Member Trace effects
|
||||
)
|
||||
=> ImportPath
|
||||
@ -40,7 +42,7 @@ resolveGoImport (ImportPath path Relative) = do
|
||||
ModuleInfo{..} <- currentModule
|
||||
paths <- listModulesInDir (joinPaths (takeDirectory modulePath) path)
|
||||
case paths of
|
||||
[] -> throwResumable $ GoImportError path
|
||||
[] -> throwResolutionError $ GoImportError path
|
||||
_ -> pure paths
|
||||
resolveGoImport (ImportPath path NonRelative) = do
|
||||
package <- T.unpack . formatName . Package.packageName <$> currentPackage
|
||||
@ -50,7 +52,7 @@ resolveGoImport (ImportPath path NonRelative) = do
|
||||
-- First two are source, next is package name, remaining are path to package
|
||||
-- (e.g. github.com/golang/<package>/path...).
|
||||
(_ : _ : p : xs) | p == package -> listModulesInDir (joinPath xs)
|
||||
_ -> throwResumable $ GoImportError path
|
||||
_ -> throwResolutionError $ GoImportError path
|
||||
|
||||
-- | Import declarations (symbols are added directly to the calling environment).
|
||||
--
|
||||
|
@ -2,7 +2,7 @@
|
||||
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
|
||||
module Language.PHP.Syntax where
|
||||
|
||||
import Control.Abstract.Modules
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.Abstract.Module
|
||||
import Data.Abstract.Path
|
||||
@ -38,13 +38,15 @@ instance Evaluatable VariableName
|
||||
-- were defined inside that function.
|
||||
|
||||
resolvePHPName :: ( Member (Modules address) effects
|
||||
, Member (Resumable ResolutionError) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError ResolutionError)) effects
|
||||
)
|
||||
=> T.Text
|
||||
-> Evaluator address value effects ModulePath
|
||||
resolvePHPName n = do
|
||||
modulePath <- resolve [name]
|
||||
maybeM (throwResumable $ NotFoundError name [name] Language.PHP) modulePath
|
||||
maybeM (throwResolutionError $ NotFoundError name [name] Language.PHP) modulePath
|
||||
where name = toName n
|
||||
toName = T.unpack . dropRelativePrefix . stripQuotes
|
||||
|
||||
@ -52,8 +54,10 @@ include :: ( AbstractValue address value effects
|
||||
, Member (Deref address value) effects
|
||||
, Member (Env address) effects
|
||||
, Member (Modules address) effects
|
||||
, Member (Resumable ResolutionError) effects
|
||||
, Member (Resumable (EnvironmentError address)) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError ResolutionError)) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError address))) effects
|
||||
, Member Trace effects
|
||||
)
|
||||
=> Subterm term (Evaluator address value effects (ValueRef address))
|
||||
@ -375,12 +379,12 @@ instance Evaluatable Namespace where
|
||||
where
|
||||
-- Each namespace name creates a closure over the subsequent namespace closures
|
||||
go (n:x:xs) = do
|
||||
name <- maybeM (throwResumable NoNameError) n
|
||||
name <- maybeM (throwEvalError NoNameError) n
|
||||
letrec' name $ \addr ->
|
||||
box =<< makeNamespace name addr Nothing (void $ go (x:xs))
|
||||
-- The last name creates a closure over the namespace body.
|
||||
go [n] = do
|
||||
name <- maybeM (throwResumable NoNameError) n
|
||||
name <- maybeM (throwEvalError NoNameError) n
|
||||
letrec' name $ \addr ->
|
||||
box =<< makeNamespace name addr Nothing (void $ subtermAddress namespaceBody)
|
||||
-- The absence of names implies global scope, cf http://php.net/manual/en/language.namespaces.definitionmultiple.php
|
||||
|
@ -3,6 +3,7 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-} -- FIXME
|
||||
module Language.Python.Syntax where
|
||||
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Environment as Env
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.Abstract.Module
|
||||
@ -66,7 +67,8 @@ relativeQualifiedName prefix paths = RelativeQualifiedName (T.unpack prefix) (Ju
|
||||
-- `parent/three/__init__.py` respectively.
|
||||
resolvePythonModules :: ( Member (Modules address) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Resumable ResolutionError) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError ResolutionError)) effects
|
||||
, Member Trace effects
|
||||
)
|
||||
=> QualifiedName
|
||||
@ -94,7 +96,7 @@ resolvePythonModules q = do
|
||||
, path <.> ".py"
|
||||
]
|
||||
modulePath <- resolve searchPaths
|
||||
maybeM (throwResumable $ NotFoundError path searchPaths Language.Python) modulePath
|
||||
maybeM (throwResolutionError $ NotFoundError path searchPaths Language.Python) modulePath
|
||||
|
||||
|
||||
-- | Import declarations (symbols are added directly to the calling environment).
|
||||
|
@ -3,6 +3,7 @@
|
||||
module Language.Ruby.Syntax where
|
||||
|
||||
import Control.Monad (unless)
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Evaluatable
|
||||
import qualified Data.Abstract.Module as M
|
||||
import Data.Abstract.Path
|
||||
@ -19,7 +20,9 @@ import System.FilePath.Posix
|
||||
--
|
||||
-- require "json"
|
||||
resolveRubyName :: ( Member (Modules address) effects
|
||||
, Member (Resumable ResolutionError) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError ResolutionError)) effects
|
||||
)
|
||||
=> Text
|
||||
-> Evaluator address value effects M.ModulePath
|
||||
@ -27,18 +30,20 @@ resolveRubyName name = do
|
||||
let name' = cleanNameOrPath name
|
||||
let paths = [name' <.> "rb"]
|
||||
modulePath <- resolve paths
|
||||
maybeM (throwResumable $ NotFoundError name' paths Language.Ruby) modulePath
|
||||
maybeM (throwResolutionError $ NotFoundError name' paths Language.Ruby) modulePath
|
||||
|
||||
-- load "/root/src/file.rb"
|
||||
resolveRubyPath :: ( Member (Modules address) effects
|
||||
, Member (Resumable ResolutionError) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError ResolutionError)) effects
|
||||
)
|
||||
=> Text
|
||||
-> Evaluator address value effects M.ModulePath
|
||||
resolveRubyPath path = do
|
||||
let name' = cleanNameOrPath path
|
||||
modulePath <- resolve [name']
|
||||
maybeM (throwResumable $ NotFoundError name' [name'] Language.Ruby) modulePath
|
||||
maybeM (throwResolutionError $ NotFoundError name' [name'] Language.Ruby) modulePath
|
||||
|
||||
cleanNameOrPath :: Text -> String
|
||||
cleanNameOrPath = T.unpack . dropRelativePrefix . stripQuotes
|
||||
@ -107,7 +112,9 @@ instance Evaluatable Load where
|
||||
doLoad :: ( AbstractValue address value effects
|
||||
, Member (Env address) effects
|
||||
, Member (Modules address) effects
|
||||
, Member (Resumable ResolutionError) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError ResolutionError)) effects
|
||||
, Member Trace effects
|
||||
)
|
||||
=> Text
|
||||
|
@ -22,6 +22,7 @@ import qualified Proto3.Wire.Decode as Decode
|
||||
import qualified Proto3.Wire.Encode as Encode
|
||||
import System.FilePath.Posix
|
||||
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Evaluatable
|
||||
import qualified Data.Abstract.Module as M
|
||||
import Data.Abstract.Package
|
||||
@ -67,7 +68,8 @@ toName = name . T.pack . unPath
|
||||
resolveWithNodejsStrategy :: ( Member (Modules address) effects
|
||||
, Member (Reader M.ModuleInfo) effects
|
||||
, Member (Reader PackageInfo) effects
|
||||
, Member (Resumable ResolutionError) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError ResolutionError)) effects
|
||||
, Member Trace effects
|
||||
)
|
||||
=> ImportPath
|
||||
@ -86,7 +88,8 @@ resolveWithNodejsStrategy (ImportPath path _) exts = resolveRelativePa
|
||||
resolveRelativePath :: ( Member (Modules address) effects
|
||||
, Member (Reader M.ModuleInfo) effects
|
||||
, Member (Reader PackageInfo) effects
|
||||
, Member (Resumable ResolutionError) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError ResolutionError)) effects
|
||||
, Member Trace effects
|
||||
)
|
||||
=> FilePath
|
||||
@ -99,7 +102,7 @@ resolveRelativePath relImportPath exts = do
|
||||
trace ("attempting to resolve (relative) require/import " <> show relImportPath)
|
||||
resolveModule path exts >>= either notFound (\x -> x <$ traceResolve relImportPath path)
|
||||
where
|
||||
notFound xs = throwResumable $ NotFoundError relImportPath xs Language.TypeScript
|
||||
notFound xs = throwResolutionError $ NotFoundError relImportPath xs Language.TypeScript
|
||||
|
||||
-- | Resolve a non-relative TypeScript import to a known 'ModuleName' or fail.
|
||||
--
|
||||
@ -114,7 +117,8 @@ resolveRelativePath relImportPath exts = do
|
||||
resolveNonRelativePath :: ( Member (Modules address) effects
|
||||
, Member (Reader M.ModuleInfo) effects
|
||||
, Member (Reader PackageInfo) effects
|
||||
, Member (Resumable ResolutionError) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Resumable (BaseError ResolutionError)) effects
|
||||
, Member Trace effects
|
||||
)
|
||||
=> FilePath
|
||||
@ -133,7 +137,7 @@ resolveNonRelativePath name exts = do
|
||||
Left xs | parentDir <- takeDirectory path , root /= parentDir -> go root parentDir (searched <> xs)
|
||||
| otherwise -> notFound (searched <> xs)
|
||||
Right m -> m <$ traceResolve name m
|
||||
notFound xs = throwResumable $ NotFoundError name xs Language.TypeScript
|
||||
notFound xs = throwResolutionError $ NotFoundError name xs Language.TypeScript
|
||||
|
||||
-- | Resolve a module name to a ModulePath.
|
||||
resolveModule :: ( Member (Modules address) effects
|
||||
|
@ -102,7 +102,7 @@ graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute a g
|
||||
<$> graphType
|
||||
<*> switch (long "packages" <> help "Include a vertex for the package, with edges from it to each module")
|
||||
<*> serializer
|
||||
<*> (readProjectFromPaths <|> readProjectRecursively)
|
||||
<*> (readProjectRecursively <|> readProjectFromPaths)
|
||||
graphType = flag Graph.ImportGraph Graph.ImportGraph (long "imports" <> help "Compute an import graph (default)")
|
||||
<|> flag' Graph.CallGraph (long "calls" <> help "Compute a call graph")
|
||||
serializer = flag (Task.serialize (DOT Graph.style)) (Task.serialize (DOT Graph.style)) (long "dot" <> help "Output in DOT graph format (default)")
|
||||
|
@ -30,6 +30,7 @@ import Analysis.Abstract.Collecting
|
||||
import Analysis.Abstract.Graph as Graph
|
||||
import Control.Abstract
|
||||
import Data.Abstract.Address
|
||||
import Data.Abstract.BaseError (BaseError(..))
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.Abstract.Module
|
||||
import qualified Data.Abstract.ModuleTable as ModuleTable
|
||||
@ -195,13 +196,13 @@ newtype ImportGraphEff address outerEffects a = ImportGraphEff
|
||||
': Modules address
|
||||
': Reader (ModuleTable (NonEmpty (Module (ModuleResult address))))
|
||||
': State (Graph ModuleInfo)
|
||||
': Resumable (ValueError address (ImportGraphEff address outerEffects))
|
||||
': Resumable (AddressError address (Value address (ImportGraphEff address outerEffects)))
|
||||
': Resumable ResolutionError
|
||||
': Resumable EvalError
|
||||
': Resumable (EnvironmentError address)
|
||||
': Resumable (Unspecialized (Value address (ImportGraphEff address outerEffects)))
|
||||
': Resumable (LoadError address)
|
||||
': Resumable (BaseError (ValueError address (ImportGraphEff address outerEffects)))
|
||||
': Resumable (BaseError (AddressError address (Value address (ImportGraphEff address outerEffects))))
|
||||
': Resumable (BaseError ResolutionError)
|
||||
': Resumable (BaseError EvalError)
|
||||
': Resumable (BaseError (EnvironmentError address))
|
||||
': Resumable (BaseError (UnspecializedError (Value address (ImportGraphEff address outerEffects))))
|
||||
': Resumable (BaseError (LoadError address))
|
||||
': Fresh
|
||||
': State (Heap address Latest (Value address (ImportGraphEff address outerEffects)))
|
||||
': outerEffects
|
||||
@ -242,16 +243,37 @@ withTermSpans :: ( HasField fields Span
|
||||
-> SubtermAlgebra (TermF syntax (Record fields)) term (TermEvaluator term address value effects a)
|
||||
withTermSpans recur term = withCurrentSpan (getField (termFAnnotation term)) (recur term)
|
||||
|
||||
resumingResolutionError :: (Applicative (m effects), Effectful m, Member Trace effects, Effects effects) => m (Resumable ResolutionError ': effects) a -> m effects a
|
||||
resumingResolutionError = runResolutionErrorWith (\ err -> trace ("ResolutionError: " <> prettyShow err) *> case err of
|
||||
resumingResolutionError :: ( Applicative (m effects)
|
||||
, Effectful m
|
||||
, Member Trace effects
|
||||
, Effects effects
|
||||
)
|
||||
=> m (Resumable (BaseError ResolutionError) ': effects) a
|
||||
-> m effects a
|
||||
resumingResolutionError = runResolutionErrorWith (\ baseError -> traceError "ResolutionError" baseError *> case baseErrorException baseError of
|
||||
NotFoundError nameToResolve _ _ -> pure nameToResolve
|
||||
GoImportError pathToResolve -> pure [pathToResolve])
|
||||
|
||||
resumingLoadError :: (AbstractHole address, Effectful (m address value), Effects effects, Functor (m address value effects), Member Trace effects) => m address value (Resumable (LoadError address) ': effects) a -> m address value effects a
|
||||
resumingLoadError = runLoadErrorWith (\ (ModuleNotFound path) -> trace ("LoadError: " <> path) $> (lowerBound, hole))
|
||||
resumingLoadError :: ( Applicative (m address value effects)
|
||||
, AbstractHole address
|
||||
, Effectful (m address value)
|
||||
, Effects effects
|
||||
, Member Trace effects
|
||||
)
|
||||
=> m address value (Resumable (BaseError (LoadError address)) ': effects) a
|
||||
-> m address value effects a
|
||||
resumingLoadError = runLoadErrorWith (\ baseError -> traceError "LoadError" baseError *> case baseErrorException baseError of
|
||||
ModuleNotFoundError _ -> pure (lowerBound, hole))
|
||||
|
||||
resumingEvalError :: (Applicative (m effects), Effectful m, Effects effects, Member Fresh effects, Member Trace effects) => m (Resumable EvalError ': effects) a -> m effects a
|
||||
resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError:" <> prettyShow err) *> case err of
|
||||
resumingEvalError :: ( Applicative (m effects)
|
||||
, Effectful m
|
||||
, Effects effects
|
||||
, Member Fresh effects
|
||||
, Member Trace effects
|
||||
)
|
||||
=> m (Resumable (BaseError EvalError) ': effects) a
|
||||
-> m effects a
|
||||
resumingEvalError = runEvalErrorWith (\ baseError -> traceError "EvalError" baseError *> case baseErrorException baseError of
|
||||
DefaultExportError{} -> pure ()
|
||||
ExportError{} -> pure ()
|
||||
IntegerFormatError{} -> pure 0
|
||||
@ -259,16 +281,39 @@ resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError:" <> prettyShow
|
||||
RationalFormatError{} -> pure 0
|
||||
NoNameError -> gensym)
|
||||
|
||||
resumingUnspecialized :: (AbstractHole value, Effectful (m value), Effects effects, Functor (m value effects), Member Trace effects) => m value (Resumable (Unspecialized value) ': effects) a -> m value effects a
|
||||
resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> trace ("Unspecialized: " <> prettyShow err) $> hole)
|
||||
resumingUnspecialized :: ( Applicative (m value effects)
|
||||
, AbstractHole value
|
||||
, Effectful (m value)
|
||||
, Effects effects
|
||||
, Member Trace effects)
|
||||
=> m value (Resumable (BaseError (UnspecializedError value)) ': effects) a
|
||||
-> m value effects a
|
||||
resumingUnspecialized = runUnspecializedWith (\ baseError -> traceError "UnspecializedError" baseError *> case baseErrorException baseError of
|
||||
UnspecializedError _ -> pure hole)
|
||||
|
||||
resumingAddressError :: (AbstractHole value, Applicative (m address value effects), Effectful (m address value), Effects effects, Lower (Cell address value), Member Trace effects, Show address) => m address value (Resumable (AddressError address value) ': effects) a -> m address value effects a
|
||||
resumingAddressError = runAddressErrorWith $ \ err -> trace ("AddressError: " <> prettyShow err) *> case err of
|
||||
resumingAddressError :: ( AbstractHole value
|
||||
, Applicative (m address value effects)
|
||||
, Effectful (m address value)
|
||||
, Effects effects
|
||||
, Lower (Cell address value)
|
||||
, Member Trace effects
|
||||
, Show address
|
||||
)
|
||||
=> m address value (Resumable (BaseError (AddressError address value)) ': effects) a
|
||||
-> m address value effects a
|
||||
resumingAddressError = runAddressErrorWith $ \ baseError -> traceError "AddressError" baseError *> case baseErrorException baseError of
|
||||
UnallocatedAddress _ -> pure lowerBound
|
||||
UninitializedAddress _ -> pure hole
|
||||
|
||||
resumingValueError :: (Applicative (m address (Value address body) effects), Effectful (m address (Value address body)), Effects effects, Member Trace effects, Show address) => m address (Value address body) (Resumable (ValueError address body) ': effects) a -> m address (Value address body) effects a
|
||||
resumingValueError = runValueErrorWith (\ err -> trace ("ValueError: " <> prettyShow err) *> case err of
|
||||
resumingValueError :: ( Applicative (m address (Value address body) effects)
|
||||
, Effectful (m address (Value address body))
|
||||
, Effects effects
|
||||
, Member Trace effects
|
||||
, Show address
|
||||
)
|
||||
=> m address (Value address body) (Resumable (BaseError (ValueError address body)) ': effects) a
|
||||
-> m address (Value address body) effects a
|
||||
resumingValueError = runValueErrorWith (\ baseError -> traceError "ValueError" baseError *> case baseErrorException baseError of
|
||||
CallError val -> pure val
|
||||
StringError val -> pure (pack (prettyShow val))
|
||||
BoolError{} -> pure True
|
||||
@ -283,19 +328,28 @@ resumingValueError = runValueErrorWith (\ err -> trace ("ValueError: " <> pretty
|
||||
KeyValueError{} -> pure (hole, hole)
|
||||
ArithmeticError{} -> pure hole)
|
||||
|
||||
resumingEnvironmentError :: (Applicative (m (Hole (Maybe Name) address) value effects), Effectful (m (Hole (Maybe Name) address) value), Effects effects) => m (Hole (Maybe Name) address) value (Resumable (EnvironmentError (Hole (Maybe Name) address)) ': effects) a -> m (Hole (Maybe Name) address) value effects a
|
||||
resumingEnvironmentError = runResumableWith (\ (FreeVariable name) -> pure (Partial (Just name)))
|
||||
resumingEnvironmentError :: ( Monad (m (Hole (Maybe Name) address) value effects)
|
||||
, Effectful (m (Hole (Maybe Name) address) value)
|
||||
, Effects effects
|
||||
, Member Trace effects
|
||||
)
|
||||
=> m (Hole (Maybe Name) address) value (Resumable (BaseError (EnvironmentError (Hole (Maybe Name) address))) ': effects) a
|
||||
-> m (Hole (Maybe Name) address) value effects a
|
||||
resumingEnvironmentError = runResumableWith (\ baseError -> traceError "EnvironmentError" baseError >> (\ (FreeVariable name) -> pure (Partial (Just name))) (baseErrorException baseError))
|
||||
|
||||
resumingTypeError :: ( Alternative (m address Type (State TypeMap ': effects))
|
||||
, Effects effects
|
||||
, Effectful (m address Type)
|
||||
, Member Trace effects
|
||||
)
|
||||
=> m address Type (Resumable TypeError ': State TypeMap ': effects) a
|
||||
=> m address Type (Resumable (BaseError TypeError) ': State TypeMap ': effects) a
|
||||
-> m address Type effects a
|
||||
resumingTypeError = runTypesWith (\err -> trace ("TypeError: " <> prettyShow err) *> case err of
|
||||
resumingTypeError = runTypesWith (\ baseError -> traceError "TypeError" baseError *> case baseErrorException baseError of
|
||||
UnificationError l r -> pure l <|> pure r
|
||||
InfiniteType _ r -> pure r)
|
||||
|
||||
prettyShow :: Show a => a -> String
|
||||
prettyShow = hscolour TTY defaultColourPrefs False False "" False . ppShow
|
||||
|
||||
traceError :: (Member Trace effects, Effectful m, Show (exc resume)) => String -> BaseError exc resume -> m effects ()
|
||||
traceError prefix baseError = trace $ prefix <> ": " <> prettyShow baseError
|
||||
|
@ -10,6 +10,7 @@ import Control.Abstract
|
||||
import Control.Exception (displayException)
|
||||
import Control.Monad.Effect.Trace (runPrintingTrace)
|
||||
import Data.Abstract.Address
|
||||
import Data.Abstract.BaseError (BaseError(..))
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.Abstract.Module
|
||||
import qualified Data.Abstract.ModuleTable as ModuleTable
|
||||
@ -63,13 +64,13 @@ newtype UtilEff a = UtilEff
|
||||
, Reader (ModuleTable (NonEmpty (Module (ModuleResult Precise))))
|
||||
, Reader Span
|
||||
, Reader PackageInfo
|
||||
, Resumable (ValueError Precise UtilEff)
|
||||
, Resumable (AddressError Precise (Value Precise UtilEff))
|
||||
, Resumable ResolutionError
|
||||
, Resumable EvalError
|
||||
, Resumable (EnvironmentError Precise)
|
||||
, Resumable (Unspecialized (Value Precise UtilEff))
|
||||
, Resumable (LoadError Precise)
|
||||
, Resumable (BaseError (ValueError Precise UtilEff))
|
||||
, Resumable (BaseError (AddressError Precise (Value Precise UtilEff)))
|
||||
, Resumable (BaseError ResolutionError)
|
||||
, Resumable (BaseError EvalError)
|
||||
, Resumable (BaseError (EnvironmentError Precise))
|
||||
, Resumable (BaseError (UnspecializedError (Value Precise UtilEff)))
|
||||
, Resumable (BaseError (LoadError Precise))
|
||||
, Trace
|
||||
, Fresh
|
||||
, State (Heap Precise Latest (Value Precise UtilEff))
|
||||
|
@ -36,7 +36,7 @@ spec config = parallel $ do
|
||||
|
||||
it "evaluates load with wrapper" $ do
|
||||
(_, (_, res)) <- evaluate ["load-wrap.rb", "foo.rb"]
|
||||
res `shouldBe` Left (SomeExc (inject @(EnvironmentError Precise) (FreeVariable "foo")))
|
||||
res `shouldBe` Left (SomeExc (inject @(BaseError (EnvironmentError Precise)) (BaseError (ModuleInfo "load-wrap.rb") emptySpan (FreeVariable "foo"))))
|
||||
|
||||
it "evaluates subclass" $ do
|
||||
(_, (heap, res)) <- evaluate ["subclass.rb"]
|
||||
|
@ -38,7 +38,7 @@ spec config = parallel $ do
|
||||
|
||||
it "fails exporting symbols not defined in the module" $ do
|
||||
(_, (_, res)) <- evaluate ["bad-export.ts", "pip.ts", "a.ts", "foo.ts"]
|
||||
res `shouldBe` Left (SomeExc (inject @EvalError (ExportError "foo.ts" (name "pip"))))
|
||||
res `shouldBe` Left (SomeExc (inject @(BaseError EvalError) (BaseError (ModuleInfo "foo.ts") emptySpan (ExportError "foo.ts" (name "pip")))))
|
||||
|
||||
it "evaluates early return statements" $ do
|
||||
(_, (heap, res)) <- evaluate ["early-return.ts"]
|
||||
|
@ -5,6 +5,7 @@ module Control.Abstract.Evaluator.Spec
|
||||
) where
|
||||
|
||||
import Control.Abstract
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Module
|
||||
import qualified Data.Abstract.Number as Number
|
||||
import Data.Abstract.Package
|
||||
@ -36,6 +37,7 @@ evaluate
|
||||
. runFresh 0
|
||||
. runReader (PackageInfo (name "test") mempty)
|
||||
. runReader (ModuleInfo "test/Control/Abstract/Evaluator/Spec.hs")
|
||||
. runReader (lowerBound @Span)
|
||||
. fmap reassociate
|
||||
. runValueError
|
||||
. runEnvironmentError
|
||||
@ -59,9 +61,10 @@ newtype SpecEff a = SpecEff
|
||||
, Env Precise
|
||||
, Allocator Precise Val
|
||||
, Deref Precise Val
|
||||
, Resumable (AddressError Precise Val)
|
||||
, Resumable (EnvironmentError Precise)
|
||||
, Resumable (ValueError Precise SpecEff)
|
||||
, Resumable (BaseError (AddressError Precise Val))
|
||||
, Resumable (BaseError (EnvironmentError Precise))
|
||||
, Resumable (BaseError (ValueError Precise SpecEff))
|
||||
, Reader Span
|
||||
, Reader ModuleInfo
|
||||
, Reader PackageInfo
|
||||
, Fresh
|
||||
|
@ -96,25 +96,25 @@ readFilePair :: Both FilePath -> IO BlobPair
|
||||
readFilePair paths = let paths' = fmap file paths in
|
||||
runBothWith IO.readFilePair paths'
|
||||
|
||||
type TestEvaluatingEffects = '[ Resumable (ValueError Precise UtilEff)
|
||||
, Resumable (AddressError Precise Val)
|
||||
, Resumable ResolutionError
|
||||
, Resumable EvalError
|
||||
, Resumable (EnvironmentError Precise)
|
||||
, Resumable (Unspecialized Val)
|
||||
, Resumable (LoadError Precise)
|
||||
type TestEvaluatingEffects = '[ Resumable (BaseError (ValueError Precise UtilEff))
|
||||
, Resumable (BaseError (AddressError Precise Val))
|
||||
, Resumable (BaseError ResolutionError)
|
||||
, Resumable (BaseError EvalError)
|
||||
, Resumable (BaseError (EnvironmentError Precise))
|
||||
, Resumable (BaseError (UnspecializedError Val))
|
||||
, Resumable (BaseError (LoadError Precise))
|
||||
, Trace
|
||||
, Fresh
|
||||
, State (Heap Precise Latest Val)
|
||||
, Lift IO
|
||||
]
|
||||
type TestEvaluatingErrors = '[ ValueError Precise UtilEff
|
||||
, AddressError Precise Val
|
||||
, ResolutionError
|
||||
, EvalError
|
||||
, EnvironmentError Precise
|
||||
, Unspecialized Val
|
||||
, LoadError Precise
|
||||
type TestEvaluatingErrors = '[ BaseError (ValueError Precise UtilEff)
|
||||
, BaseError (AddressError Precise Val)
|
||||
, BaseError ResolutionError
|
||||
, BaseError EvalError
|
||||
, BaseError (EnvironmentError Precise)
|
||||
, BaseError (UnspecializedError Val)
|
||||
, BaseError (LoadError Precise)
|
||||
]
|
||||
testEvaluating :: Evaluator Precise Val TestEvaluatingEffects (ModuleTable (NonEmpty (Module (ModuleResult Precise))))
|
||||
-> IO
|
||||
@ -157,6 +157,8 @@ namespaceScope heap ns@(Namespace _ _ _)
|
||||
. runFresh 0
|
||||
. runAddressError
|
||||
. runState heap
|
||||
. runReader (lowerBound @Span)
|
||||
. runReader (ModuleInfo "SpecHelper.hs")
|
||||
. runDeref
|
||||
$ materializeEnvironment ns
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user