diff --git a/semantic.cabal b/semantic.cabal index 700f8c142..e9cb08d72 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -56,7 +56,6 @@ library , Data.Abstract.FreeVariables , Data.Abstract.Heap , Data.Abstract.Live - , Data.Abstract.Located , Data.Abstract.Module , Data.Abstract.ModuleTable , Data.Abstract.Number diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index ae6dd6922..e7138dd53 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -22,7 +22,6 @@ import Control.Abstract import Data.Abstract.Address import Data.Abstract.Evaluatable (LoadError (..)) import Data.Abstract.FreeVariables -import Data.Abstract.Located import Data.Abstract.Module (Module(moduleInfo), ModuleInfo(..)) import Data.Abstract.Package (PackageInfo(..)) import Data.Aeson hiding (Result) diff --git a/src/Control/Abstract/Addressable.hs b/src/Control/Abstract/Addressable.hs index f4fd2f496..dd2b43402 100644 --- a/src/Control/Abstract/Addressable.hs +++ b/src/Control/Abstract/Addressable.hs @@ -1,6 +1,7 @@ {-# LANGUAGE GADTs, RankNTypes, TypeOperators, UndecidableInstances #-} module Control.Abstract.Addressable where +import Control.Abstract.Context import Control.Abstract.Environment import Control.Abstract.Evaluator import Control.Abstract.Heap @@ -71,6 +72,15 @@ variable :: ( Addressable location effects -> Evaluator location value effects value variable name = lookupEnv name >>= maybe (freeVariableError name) deref +instance ( Addressable (location cell) effects + , Members '[ Reader ModuleInfo + , Reader PackageInfo + ] effects + ) + => Addressable (Located location cell) effects where + derefCell (Address (Located loc _ _)) = raiseEff . lowerEff . derefCell (Address loc) + + allocLoc name = raiseEff (lowerEff (Located <$> allocLoc name <*> currentPackage <*> currentModule)) -- Instances diff --git a/src/Data/Abstract/Address.hs b/src/Data/Abstract/Address.hs index edbdc245b..82c290ce9 100644 --- a/src/Data/Abstract/Address.hs +++ b/src/Data/Abstract/Address.hs @@ -2,6 +2,8 @@ module Data.Abstract.Address where import Data.Abstract.FreeVariables +import Data.Abstract.Module (ModuleInfo) +import Data.Abstract.Package (PackageInfo) import Data.Semigroup.Reducer import Data.Semilattice.Lower import Prologue @@ -44,6 +46,17 @@ instance Location (Monovariant cell) where type Cell (Monovariant cell) = cell +data Located location (cell :: * -> *) = Located + { location :: location cell + , locationPackage :: {-# UNPACK #-} !PackageInfo + , locationModule :: !ModuleInfo + } + deriving (Eq, Ord, Show) + +instance Location (Located location cell) where + type Cell (Located location cell) = Cell (location cell) + + -- | A cell holding a single value. Writes will replace any prior value. -- This is isomorphic to 'Last' from Data.Monoid, but is more convenient -- because it has a 'Reducer' instance. diff --git a/src/Data/Abstract/Located.hs b/src/Data/Abstract/Located.hs deleted file mode 100644 index 5a6482b97..000000000 --- a/src/Data/Abstract/Located.hs +++ /dev/null @@ -1,27 +0,0 @@ -{-# LANGUAGE TypeFamilies, UndecidableInstances #-} -module Data.Abstract.Located where - -import Control.Abstract -import Data.Abstract.Address -import Data.Abstract.Module (ModuleInfo) -import Data.Abstract.Package (PackageInfo) - -data Located location (cell :: * -> *) = Located - { location :: location cell - , locationPackage :: {-# UNPACK #-} !PackageInfo - , locationModule :: !ModuleInfo - } - deriving (Eq, Ord, Show) - -instance Location (Located location cell) where - type Cell (Located location cell) = Cell (location cell) - -instance ( Addressable (location cell) effects - , Members '[ Reader ModuleInfo - , Reader PackageInfo - ] effects - ) - => Addressable (Located location cell) effects where - derefCell (Address (Located loc _ _)) = raiseEff . lowerEff . derefCell (Address loc) - - allocLoc name = raiseEff (lowerEff (Located <$> allocLoc name <*> currentPackage <*> currentModule)) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 0b0df3ef1..897cd68b8 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -8,7 +8,6 @@ import qualified Control.Exception as Exc import Control.Monad.Effect (reinterpret) import Data.Abstract.Address import Data.Abstract.Evaluatable -import Data.Abstract.Located import Data.Abstract.Module import Data.Abstract.Package as Package import Data.Abstract.Value (Value, ValueError(..), runValueErrorWith)