1
1
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:
Timothy Clem 2018-03-07 08:07:23 -08:00 committed by GitHub
commit 02d153e7ab
7 changed files with 38 additions and 35 deletions

View File

@ -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

View File

@ -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
]

View File

@ -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 }

View File

@ -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

View File

@ -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).

View File

@ -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)

View 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)