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 cb2070377..8676eeb6f 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) @@ -17,13 +17,13 @@ import Prologue -- | The effects necessary for dead code analysis. type DeadCodeEffects t v - = '[ State (Dead t) -- The set of dead terms - , Fail -- Failure with an error message - , 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 (EnvironmentFor v)) -- Cache of evaluated modules + = '[ State (Dead t) -- The set of dead terms + , Fail -- Failure with an error message + , 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 (ModuleTable t) -- Cache of unevaluated modules + , State (ModuleTable (EnvironmentFor v)) -- Cache of evaluated modules ] diff --git a/src/Analysis/Abstract/Evaluating.hs b/src/Analysis/Abstract/Evaluating.hs index 466ed2c6d..8b8f00a0a 100644 --- a/src/Analysis/Abstract/Evaluating.hs +++ b/src/Analysis/Abstract/Evaluating.hs @@ -8,7 +8,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 @@ -22,12 +22,12 @@ import System.FilePath.Posix -- | The effects necessary for concrete interpretation. type EvaluationEffects t v - = '[ Fail -- Failure with an error message - , 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 (EnvironmentFor v)) -- Cache of evaluated modules + = '[ Fail -- Failure with an error message + , 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 (ModuleTable t) -- Cache of unevaluated modules + , State (ModuleTable (EnvironmentFor v)) -- Cache of evaluated modules ] -- | Evaluate a term to a value. @@ -63,7 +63,7 @@ evaluates pairs (b, t) = run @(EvaluationEffects term v) (runEvaluator (runEvalu withModules :: (MonadAnalysis term value m, MonadEvaluator term value m) => Blob -> [(Blob, term)] -> m a -> m a withModules Blob{..} pairs = localModuleTable (const moduleTable) where - moduleTable = Linker (Map.fromList (map (first moduleName) pairs)) + moduleTable = ModuleTable (Map.fromList (map (first moduleName) pairs)) rootDir = dropFileName blobPath replacePathSeps str = intercalate "." (splitWhen (== pathSeparator) str) moduleName Blob{..} = BC.pack $ replacePathSeps (dropExtensions (makeRelative rootDir blobPath)) diff --git a/src/Control/Abstract/Evaluator.hs b/src/Control/Abstract/Evaluator.hs index eb5427d30..57b596820 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) @@ -37,21 +37,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 (EnvironmentFor value)) + getModuleTable :: m (ModuleTable (EnvironmentFor value)) -- | Update the table of evaluated modules. - modifyModuleTable :: (Linker (EnvironmentFor value) -> Linker (EnvironmentFor value)) -> m () + modifyModuleTable :: (ModuleTable (EnvironmentFor value) -> ModuleTable (EnvironmentFor 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 (EnvironmentFor value)) + , Reader (ModuleTable term) + , State (ModuleTable (EnvironmentFor 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 543bfad5e..abee5becf 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 Data.Functor.Classes @@ -83,7 +83,7 @@ require :: ( MonadAnalysis term v m ) => ModuleName -> m (EnvironmentFor v) -require name = getModuleTable >>= maybe (load name) pure . linkerLookup name +require name = getModuleTable >>= maybe (load name) pure . moduleTableLookup name -- | Load another term/file and return an Effect. -- @@ -94,10 +94,10 @@ load :: ( MonadAnalysis term v m ) => ModuleName -> m (EnvironmentFor v) -load name = askModuleTable >>= maybe notFound evalAndCache . linkerLookup name +load name = askModuleTable >>= maybe notFound evalAndCache . moduleTableLookup name where notFound = fail ("cannot find " <> show name) evalAndCache e = do v <- evaluateTerm e env <- environment v - modifyModuleTable (linkerInsert name env) + modifyModuleTable (moduleTableInsert name env) pure env diff --git a/src/Data/Abstract/Linker.hs b/src/Data/Abstract/Linker.hs deleted file mode 100644 index 783bb5391..000000000 --- a/src/Data/Abstract/Linker.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Data.Abstract.Linker where - -import Data.Semigroup -import GHC.Generics -import Data.ByteString -import qualified Data.Map as Map - -type ModuleName = ByteString - -newtype Linker a = Linker { unLinker :: Map.Map ModuleName a } - deriving (Eq, Foldable, Functor, Generic1, Monoid, Ord, Semigroup, Show, Traversable) - -linkerLookup :: ModuleName -> Linker a -> Maybe a -linkerLookup k = Map.lookup k . unLinker - -linkerInsert :: ModuleName -> 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..a6e4a5b4c --- /dev/null +++ b/src/Data/Abstract/ModuleTable.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Data.Abstract.ModuleTable + ( ModuleName + , ModuleTable (..) + , moduleTableLookup + , moduleTableInsert + ) where + +import Data.ByteString +import Data.Semigroup +import GHC.Generics +import qualified Data.Map as Map + + + +type ModuleName = ByteString + +newtype ModuleTable a = ModuleTable { unModuleTable :: Map.Map ModuleName a } + deriving (Eq, Foldable, Functor, Generic1, Monoid, Ord, Semigroup, Show, Traversable) + +moduleTableLookup :: ModuleName -> ModuleTable a -> Maybe a +moduleTableLookup k = Map.lookup k . unModuleTable + +moduleTableInsert :: ModuleName -> a -> ModuleTable a -> ModuleTable a +moduleTableInsert k v ModuleTable {..} = ModuleTable (Map.insert k v unModuleTable)