mirror of
https://github.com/github/semantic.git
synced 2024-12-26 08:25:19 +03:00
Merge branch 'master' into bump-tree-sitter
This commit is contained in:
commit
02d153e7ab
@ -48,9 +48,9 @@ library
|
||||
, Data.Abstract.Configuration
|
||||
, Data.Abstract.Environment
|
||||
, Data.Abstract.Evaluatable
|
||||
, Data.Abstract.Linker
|
||||
, Data.Abstract.FreeVariables
|
||||
, Data.Abstract.Live
|
||||
, Data.Abstract.ModuleTable
|
||||
, Data.Abstract.Store
|
||||
, Data.Abstract.Type
|
||||
, Data.Abstract.Value
|
||||
|
@ -9,7 +9,7 @@ import Control.Monad.Effect.Reader
|
||||
import Control.Monad.Effect.State
|
||||
import Data.Abstract.Address
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.Abstract.Linker
|
||||
import Data.Abstract.ModuleTable
|
||||
import Data.Abstract.Store
|
||||
import Data.Abstract.Value
|
||||
import Data.Set (delete)
|
||||
@ -22,8 +22,8 @@ type DeadCodeEffects t v
|
||||
, State (Store (LocationFor v) v) -- The heap
|
||||
, State (EnvironmentFor v) -- Global (imperative) environment
|
||||
, Reader (EnvironmentFor v) -- Local environment (e.g. binding over a closure)
|
||||
, Reader (Linker t) -- Cache of unevaluated modules
|
||||
, State (Linker v) -- Cache of evaluated modules
|
||||
, Reader (ModuleTable t) -- Cache of unevaluated modules
|
||||
, State (ModuleTable v) -- Cache of evaluated modules
|
||||
]
|
||||
|
||||
|
||||
|
@ -9,7 +9,7 @@ import Control.Monad.Effect.Reader
|
||||
import Control.Monad.Effect.State
|
||||
import Data.Abstract.Address
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.Abstract.Linker
|
||||
import Data.Abstract.ModuleTable
|
||||
import Data.Abstract.Store
|
||||
import Data.Abstract.Value
|
||||
import Data.Blob
|
||||
@ -23,8 +23,8 @@ type EvaluationEffects t v
|
||||
, State (Store (LocationFor v) v) -- The heap
|
||||
, State (EnvironmentFor v) -- Global (imperative) environment
|
||||
, Reader (EnvironmentFor v) -- Local environment (e.g. binding over a closure)
|
||||
, Reader (Linker t) -- Cache of unevaluated modules
|
||||
, State (Linker v) -- Cache of evaluated modules
|
||||
, Reader (ModuleTable t) -- Cache of unevaluated modules
|
||||
, State (ModuleTable v) -- Cache of evaluated modules
|
||||
]
|
||||
|
||||
|
||||
@ -60,7 +60,7 @@ evaluates pairs (_, t) = run @(EvaluationEffects term v) (runEvaluator (runEvalu
|
||||
-- | Run an action with the passed ('Blob', @term@) pairs available for imports.
|
||||
withModules :: (MonadAnalysis term value m, MonadEvaluator term value m) => [(Blob, term)] -> m a -> m a
|
||||
withModules pairs = localModuleTable (const moduleTable)
|
||||
where moduleTable = Linker (Map.fromList (map (first (dropExtensions . blobPath)) pairs))
|
||||
where moduleTable = ModuleTable (Map.fromList (map (first (dropExtensions . blobPath)) pairs))
|
||||
|
||||
-- | An analysis performing concrete evaluation of @term@s to @value@s.
|
||||
newtype Evaluation term value a = Evaluation { runEvaluation :: Evaluator (EvaluationEffects term value) term value a }
|
||||
|
@ -8,7 +8,7 @@ import Control.Monad.Effect.Fresh
|
||||
import Control.Monad.Effect.NonDetEff
|
||||
import Control.Monad.Effect.Reader
|
||||
import Control.Monad.Effect.State
|
||||
import Data.Abstract.Linker
|
||||
import Data.Abstract.ModuleTable
|
||||
import Data.Abstract.Value
|
||||
import Prelude hiding (fail)
|
||||
|
||||
@ -35,21 +35,21 @@ class MonadFail m => MonadEvaluator term value m | m -> term, m -> value where
|
||||
modifyStore :: (StoreFor value -> StoreFor value) -> m ()
|
||||
|
||||
-- | Retrieve the table of evaluated modules.
|
||||
getModuleTable :: m (Linker value)
|
||||
getModuleTable :: m (ModuleTable value)
|
||||
-- | Update the table of evaluated modules.
|
||||
modifyModuleTable :: (Linker value -> Linker value) -> m ()
|
||||
modifyModuleTable :: (ModuleTable value -> ModuleTable value) -> m ()
|
||||
|
||||
-- | Retrieve the table of unevaluated modules.
|
||||
askModuleTable :: m (Linker term)
|
||||
askModuleTable :: m (ModuleTable term)
|
||||
-- | Run an action with a locally-modified table of unevaluated modules.
|
||||
localModuleTable :: (Linker term -> Linker term) -> m a -> m a
|
||||
localModuleTable :: (ModuleTable term -> ModuleTable term) -> m a -> m a
|
||||
|
||||
instance Members '[ Fail
|
||||
, Reader (EnvironmentFor value)
|
||||
, State (EnvironmentFor value)
|
||||
, State (StoreFor value)
|
||||
, Reader (Linker term)
|
||||
, State (Linker value)
|
||||
, Reader (ModuleTable term)
|
||||
, State (ModuleTable value)
|
||||
] effects
|
||||
=> MonadEvaluator term value (Evaluator effects term value) where
|
||||
getGlobalEnv = Evaluator get
|
||||
|
@ -18,7 +18,7 @@ import Control.Monad.Effect.Fail
|
||||
import Data.Abstract.Address
|
||||
import Data.Abstract.Environment
|
||||
import Data.Abstract.FreeVariables as FreeVariables
|
||||
import Data.Abstract.Linker
|
||||
import Data.Abstract.ModuleTable
|
||||
import Data.Abstract.Value
|
||||
import Data.Algebra
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
@ -84,7 +84,7 @@ require :: ( FreeVariables term
|
||||
)
|
||||
=> term
|
||||
-> m v
|
||||
require term = getModuleTable >>= maybe (load term) pure . linkerLookup name
|
||||
require term = getModuleTable >>= maybe (load term) pure . moduleTableLookup name
|
||||
where name = moduleName term
|
||||
|
||||
-- | Load another term/file and return an Effect.
|
||||
@ -96,12 +96,12 @@ load :: ( FreeVariables term
|
||||
)
|
||||
=> term
|
||||
-> m v
|
||||
load term = askModuleTable >>= maybe notFound evalAndCache . linkerLookup name
|
||||
load term = askModuleTable >>= maybe notFound evalAndCache . moduleTableLookup name
|
||||
where name = moduleName term
|
||||
notFound = fail ("cannot find " <> show name)
|
||||
evalAndCache e = do
|
||||
v <- evaluateTerm e
|
||||
modifyModuleTable (linkerInsert name v)
|
||||
modifyModuleTable (moduleTableInsert name v)
|
||||
pure v
|
||||
|
||||
-- | Get a module name from a term (expects single free variables).
|
||||
|
@ -1,16 +0,0 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
module Data.Abstract.Linker where
|
||||
|
||||
import Data.Semigroup
|
||||
import GHC.Generics
|
||||
import qualified Data.Map as Map
|
||||
|
||||
|
||||
newtype Linker a = Linker { unLinker :: Map.Map FilePath a }
|
||||
deriving (Eq, Foldable, Functor, Generic1, Monoid, Ord, Semigroup, Show, Traversable)
|
||||
|
||||
linkerLookup :: FilePath -> Linker a -> Maybe a
|
||||
linkerLookup k = Map.lookup k . unLinker
|
||||
|
||||
linkerInsert :: FilePath -> a -> Linker a -> Linker a
|
||||
linkerInsert k v Linker{..} = Linker (Map.insert k v unLinker)
|
19
src/Data/Abstract/ModuleTable.hs
Normal file
19
src/Data/Abstract/ModuleTable.hs
Normal file
@ -0,0 +1,19 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
module Data.Abstract.ModuleTable
|
||||
( ModuleTable (..)
|
||||
, moduleTableLookup
|
||||
, moduleTableInsert
|
||||
)where
|
||||
|
||||
import Data.Semigroup
|
||||
import GHC.Generics
|
||||
import qualified Data.Map as Map
|
||||
|
||||
newtype ModuleTable a = ModuleTable { unModuleTable :: Map.Map FilePath a }
|
||||
deriving (Eq, Foldable, Functor, Generic1, Monoid, Ord, Semigroup, Show, Traversable)
|
||||
|
||||
moduleTableLookup :: FilePath -> ModuleTable a -> Maybe a
|
||||
moduleTableLookup k = Map.lookup k . unModuleTable
|
||||
|
||||
moduleTableInsert :: FilePath -> a -> ModuleTable a -> ModuleTable a
|
||||
moduleTableInsert k v ModuleTable{..} = ModuleTable (Map.insert k v unModuleTable)
|
Loading…
Reference in New Issue
Block a user