Extract holes into a new, relatively unconstrained typeclass.

src/Analysis/Abstract/BadAddresses.hs

@@ -13,7 +13,7 @@ deriving instance MonadEvaluator location term value effects m => MonadEvaluator
 instance ( Effectful m
          , Member (Resumable (AddressError location value)) effects
          , MonadAnalysis location term value effects m
-         , MonadValue location value effects (BadAddresses m)
+         , MonadHole value effects (BadAddresses m)
          , Monoid (Cell location value)
          , Show location
          )
@@ -30,7 +30,7 @@ instance ( Effectful m
   analyzeModule = liftAnalyze analyzeModule
 
 instance ( Interpreter effects result rest m
-         , MonadValue location value effects m
+         , MonadHole value effects m
          , Monoid (Cell location value)
          )
       => Interpreter (Resumable (AddressError location value) ': effects) result rest (BadAddresses m) where

src/Analysis/Abstract/BadValues.hs

@@ -14,7 +14,8 @@ deriving instance MonadEvaluator location term value effects m   => MonadEvaluat
 instance ( Effectful m
          , Member (Resumable (ValueError location value)) effects
          , MonadAnalysis location term value effects m
-         , MonadValue location value effects (BadValues m)
+         , MonadHole value effects (BadValues m)
+         , Show value
          )
       => MonadAnalysis location term value effects (BadValues m) where
   type Effects location term value (BadValues m) = Resumable (ValueError location value) ': Effects location term value m
@@ -42,7 +43,7 @@ instance ( Effectful m
 
 instance ( Interpreter effects result rest m
          , MonadEvaluator location term value effects m
-         , MonadValue location value effects m
+         , MonadHole value effects m
          , Show value
          )
       => Interpreter (Resumable (ValueError location value) ': effects) result rest (BadValues m) where

src/Analysis/Abstract/BadVariables.hs

@@ -17,7 +17,7 @@ instance ( Effectful m
          , Member (Resumable (EvalError value)) effects
          , Member (State [Name]) effects
          , MonadAnalysis location term value effects m
-         , MonadValue location value effects (BadVariables m)
+         , MonadHole value effects (BadVariables m)
          )
       => MonadAnalysis location term value effects (BadVariables m) where
   type Effects location term value (BadVariables m) = Resumable (EvalError value) ': State [Name] ': Effects location term value m
@@ -37,7 +37,7 @@ instance ( Effectful m
   analyzeModule = liftAnalyze analyzeModule
 
 instance ( Interpreter effects (result, [Name]) rest m
-         , MonadValue location value (State [Name] ': effects) m
+         , MonadHole value (State [Name] ': effects) m
          )
       => Interpreter (Resumable (EvalError value) ': State [Name] ': effects) result rest (BadVariables m) where
   interpret

src/Analysis/Abstract/Quiet.hs

@@ -22,7 +22,7 @@ deriving instance MonadEvaluator location term value effects m => MonadEvaluator
 instance ( Effectful m
          , Member (Resumable (Unspecialized value)) effects
          , MonadAnalysis location term value effects m
-         , MonadValue location value effects (Quietly m)
+         , MonadHole value effects (Quietly m)
          )
       => MonadAnalysis location term value effects (Quietly m) where
   type Effects location term value (Quietly m) = Resumable (Unspecialized value) ': Effects location term value m
@@ -33,7 +33,7 @@ instance ( Effectful m
   analyzeModule = liftAnalyze analyzeModule
 
 instance ( Interpreter effects result rest m
-         , MonadValue location value effects m
+         , MonadHole value effects m
          )
       => Interpreter (Resumable (Unspecialized value) ': effects) result rest (Quietly m) where
   interpret

src/Control/Abstract/Value.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE FunctionalDependencies, GADTs, KindSignatures, Rank2Types #-}
 module Control.Abstract.Value
 ( MonadValue(..)
+, MonadHole(..)
 , Comparator(..)
 , while
 , doWhile
@@ -31,6 +32,9 @@ data Comparator
   = Concrete (forall a . Ord a => a -> a -> Bool)
   | Generalized
 
+class Monad (m effects) => MonadHole value (effects :: [* -> *]) m where
+  hole :: m effects value
+
 -- | A 'Monad' abstracting the evaluation of (and under) binding constructs (functions, methods, etc).
 --
 --   This allows us to abstract the choice of whether to evaluate under binders for different value types.
@@ -39,9 +43,6 @@ class (Monad (m effects), Show value) => MonadValue location value (effects :: [
   --   TODO: This might be the same as the empty tuple for some value types
   unit :: m effects value
 
-  -- | Construct an abstract hole.
-  hole :: m effects value
-
   -- | Construct an abstract integral value.
   integer :: Prelude.Integer -> m effects value
 

src/Data/Abstract/Type.hs

@@ -52,6 +52,9 @@ instance Ord location => ValueRoots location Type where
   valueRoots _ = mempty
 
 
+instance Monad (m effects) => MonadHole Type effects m where
+  hole = pure Hole
+
 -- | Discard the value arguments (if any), constructing a 'Type' instead.
 instance ( Alternative (m effects)
          , Member Fail effects
@@ -71,7 +74,6 @@ instance ( Alternative (m effects)
     ret <- localEnv (mappend env) body
     pure (Product tvars :-> ret)
 
-  hole       = pure Hole
   unit       = pure Unit
   integer _  = pure Int
   boolean _  = pure Bool

src/Data/Abstract/Value.hs

@@ -197,9 +197,11 @@ instance Ord location => ValueRoots location (Value location) where
     | otherwise                            = mempty
 
 
+instance Monad (m effects) => MonadHole (Value location) effects m where
+  hole = pure (injValue Hole)
+
 -- | Construct a 'Value' wrapping the value arguments (if any).
 instance (Monad (m effects), MonadEvaluatable location term (Value location) effects m) => MonadValue location (Value location) effects m where
-  hole     = pure . injValue $ Hole
   unit     = pure . injValue $ Unit
   integer  = pure . injValue . Integer . Number.Integer
   boolean  = pure . injValue . Boolean