Move the Allocatable/Derefable instances into the address modules.

src/Control/Abstract/Addressable.hs

@@ -1,17 +1,10 @@
-{-# LANGUAGE UndecidableInstances #-}
 module Control.Abstract.Addressable
 ( Allocatable(..)
 , Derefable(..)
 ) where
 
-import Control.Abstract.Context
 import Control.Abstract.Evaluator
-import Control.Abstract.Hole
-import Data.Abstract.Address.Located
-import Data.Abstract.Address.Monovariant
-import Data.Abstract.Address.Precise
 import Data.Abstract.Name
-import qualified Data.Set as Set
 import Prologue
 
 class (Ord address, Show address) => Allocatable address effects where
@@ -21,44 +14,3 @@ class (Ord address, Show address) => Allocatable address effects where
 
 class (Ord address, Show address) => Derefable address effects where
   derefCell :: address -> Set value -> Evaluator address value effects (Maybe value)
-
-
-instance Member Fresh effects => Allocatable Precise effects where
-  allocCell _ = Precise <$> fresh
-
-  assignCell _ value _ = pure (Set.singleton value)
-
-instance Derefable Precise effects where
-  derefCell _ = pure . fmap fst . Set.minView
-
-
-instance Allocatable Monovariant effects where
-  allocCell = pure . Monovariant
-
-  assignCell _ value values = pure (Set.insert value values)
-
-instance Member NonDet effects => Derefable Monovariant effects where
-  derefCell _ = traverse (foldMapA pure) . nonEmpty . toList
-
-
-instance (Allocatable address effects, Member (Reader ModuleInfo) effects, Member (Reader PackageInfo) effects, Member (Reader Span) effects) => Allocatable (Located address) effects where
-  allocCell name = relocate (Located <$> allocCell name <*> currentPackage <*> currentModule <*> pure name <*> ask)
-
-  assignCell (Located loc _ _ _ _) value = relocate . assignCell loc value
-
-instance Derefable address effects => Derefable (Located address) effects where
-  derefCell (Located loc _ _ _ _) = relocate . derefCell loc
-
-
-instance (Allocatable address effects, Ord context, Show context) => Allocatable (Hole context address) effects where
-  allocCell name = relocate (Total <$> allocCell name)
-
-  assignCell (Total loc) value = relocate . assignCell loc value
-  assignCell (Partial _) _ = pure
-
-instance (Derefable address effects, Ord context, Show context) => Derefable (Hole context address) effects where
-  derefCell (Total loc) = relocate . derefCell loc
-  derefCell (Partial _) = const (pure Nothing)
-
-relocate :: Evaluator address1 value effects a -> Evaluator address2 value effects a
-relocate = raiseEff . lowerEff

src/Control/Abstract/Hole.hs

@@ -4,6 +4,8 @@ module Control.Abstract.Hole
   , toMaybe
   ) where
 
+import Control.Abstract.Addressable
+import Control.Abstract.Evaluator
 import Prologue
 
 class AbstractHole a where
@@ -19,3 +21,17 @@ instance Lower context => AbstractHole (Hole context a) where
 toMaybe :: Hole context a -> Maybe a
 toMaybe (Partial _) = Nothing
 toMaybe (Total a)   = Just a
+
+
+instance (Allocatable address effects, Ord context, Show context) => Allocatable (Hole context address) effects where
+  allocCell name = relocate (Total <$> allocCell name)
+
+  assignCell (Total loc) value = relocate . assignCell loc value
+  assignCell (Partial _) _ = pure
+
+instance (Derefable address effects, Ord context, Show context) => Derefable (Hole context address) effects where
+  derefCell (Total loc) = relocate . derefCell loc
+  derefCell (Partial _) = const (pure Nothing)
+
+relocate :: Evaluator address1 value effects a -> Evaluator address2 value effects a
+relocate = raiseEff . lowerEff

src/Data/Abstract/Address/Located.hs

@@ -1,11 +1,14 @@
+{-# LANGUAGE UndecidableInstances #-}
 module Data.Abstract.Address.Located
 ( Located(..)
 ) where
 
+import Control.Abstract.Addressable
+import Control.Abstract.Context
+import Control.Abstract.Evaluator
 import Data.Abstract.Module (ModuleInfo)
 import Data.Abstract.Name
 import Data.Abstract.Package (PackageInfo)
-import Data.Span
 
 data Located address = Located
   { address        :: address
@@ -15,3 +18,16 @@ data Located address = Located
   , addressSpan    :: Span
   }
   deriving (Eq, Ord, Show)
+
+
+instance (Allocatable address effects, Member (Reader ModuleInfo) effects, Member (Reader PackageInfo) effects, Member (Reader Span) effects) => Allocatable (Located address) effects where
+  allocCell name = relocate (Located <$> allocCell name <*> currentPackage <*> currentModule <*> pure name <*> ask)
+
+  assignCell (Located loc _ _ _ _) value = relocate . assignCell loc value
+
+instance Derefable address effects => Derefable (Located address) effects where
+  derefCell (Located loc _ _ _ _) = relocate . derefCell loc
+
+
+relocate :: Evaluator address1 value effects a -> Evaluator address2 value effects a
+relocate = raiseEff . lowerEff

src/Data/Abstract/Address/Monovariant.hs

@@ -1,8 +1,12 @@
+{-# LANGUAGE UndecidableInstances #-}
 module Data.Abstract.Address.Monovariant
 ( Monovariant(..)
 ) where
 
+import Control.Abstract.Addressable
+import Control.Monad.Effect.NonDet
 import Data.Abstract.Name
+import qualified Data.Set as Set
 import Prologue
 
 -- | 'Monovariant' models using one address for a particular name. It trackes the set of values that a particular address takes and uses it's name to lookup in the store and only allocation if new.
@@ -11,3 +15,12 @@ newtype Monovariant = Monovariant { unMonovariant :: Name }
 
 instance Show Monovariant where
   showsPrec d = showsUnaryWith showsPrec "Monovariant" d . unMonovariant
+
+
+instance Allocatable Monovariant effects where
+  allocCell = pure . Monovariant
+
+  assignCell _ value values = pure (Set.insert value values)
+
+instance Member NonDet effects => Derefable Monovariant effects where
+  derefCell _ = traverse (foldMapA pure) . nonEmpty . toList

src/Data/Abstract/Address/Precise.hs

@@ -1,7 +1,11 @@
+{-# LANGUAGE UndecidableInstances #-}
 module Data.Abstract.Address.Precise
 ( Precise(..)
 ) where
 
+import Control.Abstract.Addressable
+import Control.Monad.Effect.Fresh
+import qualified Data.Set as Set
 import Prologue
 
 -- | 'Precise' models precise store semantics where only the 'Latest' value is taken. Everything gets it's own address (always makes a new allocation) which makes for a larger store.
@@ -10,3 +14,12 @@ newtype Precise = Precise { unPrecise :: Int }
 
 instance Show Precise where
   showsPrec d = showsUnaryWith showsPrec "Precise" d . unPrecise
+
+
+instance Member Fresh effects => Allocatable Precise effects where
+  allocCell _ = Precise <$> fresh
+
+  assignCell _ value _ = pure (Set.singleton value)
+
+instance Derefable Precise effects where
+  derefCell _ = pure . fmap fst . Set.minView