diff --git a/semantic.cabal b/semantic.cabal index 4f63a5871..0f6682c2d 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -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 diff --git a/src/Analysis/Abstract/Dead.hs b/src/Analysis/Abstract/Dead.hs index c5e8c387f..8efd8c7cc 100644 --- a/src/Analysis/Abstract/Dead.hs +++ b/src/Analysis/Abstract/Dead.hs @@ -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 ] diff --git a/src/Analysis/Abstract/Evaluating.hs b/src/Analysis/Abstract/Evaluating.hs index dbb043618..6e61efa34 100644 --- a/src/Analysis/Abstract/Evaluating.hs +++ b/src/Analysis/Abstract/Evaluating.hs @@ -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 } diff --git a/src/Control/Abstract/Evaluator.hs b/src/Control/Abstract/Evaluator.hs index 5ed3ae46f..6d60500fe 100644 --- a/src/Control/Abstract/Evaluator.hs +++ b/src/Control/Abstract/Evaluator.hs @@ -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 diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 8ab2a6103..be9f98501 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -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). diff --git a/src/Data/Abstract/Linker.hs b/src/Data/Abstract/Linker.hs deleted file mode 100644 index 86de72b37..000000000 --- a/src/Data/Abstract/Linker.hs +++ /dev/null @@ -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) diff --git a/src/Data/Abstract/ModuleTable.hs b/src/Data/Abstract/ModuleTable.hs new file mode 100644 index 000000000..848273aae --- /dev/null +++ b/src/Data/Abstract/ModuleTable.hs @@ -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)