Give Hole an extra parameter for context about errors.

src/Analysis/Abstract/Graph.hs

@@ -47,12 +47,12 @@ style = (defaultStyle (T.encodeUtf8Builder . vertexName))
 -- | Add vertices to the graph for evaluated identifiers.
 graphingTerms :: ( Element Syntax.Identifier syntax
                  , Member (Reader ModuleInfo) effects
-                 , Member (Env (Hole (Located address))) effects
+                 , Member (Env (Hole context (Located address))) effects
                  , Member (State (Graph Vertex)) effects
                  , Base term ~ TermF (Sum syntax) ann
                  )
-              => SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a)
-              -> SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a)
+              => SubtermAlgebra (Base term) term (TermEvaluator term (Hole context (Located address)) value effects a)
+              -> SubtermAlgebra (Base term) term (TermEvaluator term (Hole context (Located address)) value effects a)
 graphingTerms recur term@(In _ syntax) = do
   case project syntax of
     Just (Syntax.Identifier name) -> do
@@ -128,11 +128,11 @@ moduleInclusion v = do
   appendGraph (vertex (moduleVertex m) `connect` vertex v)
 
 -- | Add an edge from the passed variable name to the module it originated within.
-variableDefinition :: ( Member (Env (Hole (Located address))) effects
+variableDefinition :: ( Member (Env (Hole context (Located address))) effects
                       , Member (State (Graph Vertex)) effects
                       )
                    => Name
-                   -> TermEvaluator term (Hole (Located address)) value effects ()
+                   -> TermEvaluator term (Hole context (Located address)) value effects ()
 variableDefinition name = do
   graph <- maybe lowerBound (maybe lowerBound (vertex . moduleVertex . addressModule) . toMaybe) <$> TermEvaluator (lookupEnv name)
   appendGraph (vertex (Variable (formatName name)) `connect` graph)

src/Control/Abstract/Addressable.hs

@@ -40,12 +40,12 @@ instance (Addressable address effects, Member (Reader ModuleInfo) effects, Membe
   allocCell name = relocate (Located <$> allocCell name <*> currentPackage <*> currentModule)
   derefCell (Located loc _ _) = relocate . derefCell loc
 
-instance Addressable address effects => Addressable (Hole address) effects where
-  type Cell (Hole address) = Cell address
+instance (Addressable address effects, Ord context, Show context) => Addressable (Hole context address) effects where
+  type Cell (Hole context address) = Cell address
 
   allocCell name = relocate (Total <$> allocCell name)
   derefCell (Total loc) = relocate . derefCell loc
-  derefCell Partial     = const (pure Nothing)
+  derefCell (Partial _) = const (pure Nothing)
 
 relocate :: Evaluator address1 value effects a -> Evaluator address2 value effects a
 relocate = raiseEff . lowerEff

src/Control/Abstract/Hole.hs

@@ -1,15 +1,17 @@
 module Control.Abstract.Hole where
 
+import Prologue
+
 class AbstractHole a where
   hole :: a
 
 
-data Hole a = Partial | Total a
+data Hole context a = Partial context | Total a
   deriving (Foldable, Functor, Eq, Ord, Show, Traversable)
 
-instance AbstractHole (Hole a) where
-  hole = Partial
+instance Lower context => AbstractHole (Hole context a) where
+  hole = Partial lowerBound
 
-toMaybe :: Hole a -> Maybe a
-toMaybe Partial = Nothing
-toMaybe (Total a) = Just a
+toMaybe :: Hole context a -> Maybe a
+toMaybe (Partial _) = Nothing
+toMaybe (Total a)   = Just a

src/Semantic/Graph.hs

@@ -92,7 +92,7 @@ runCallGraph lang includePackages modules package = do
       analyzeModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules
       extractGraph (_, (_, (graph, _))) = simplify graph
       runGraphAnalysis
-        = runState (lowerBound @(Heap (Hole (Located Monovariant)) All Abstract))
+        = runState (lowerBound @(Heap (Hole () (Located Monovariant)) All Abstract))
         . runFresh 0
         . resumingLoadError
         . resumingUnspecialized
@@ -100,13 +100,13 @@ runCallGraph lang includePackages modules package = do
         . resumingEvalError
         . resumingResolutionError
         . resumingAddressError
-        . runTermEvaluator @_ @(Hole (Located Monovariant)) @Abstract
+        . runTermEvaluator @_ @(Hole () (Located Monovariant)) @Abstract
         . graphing
         . caching @[]
         . runReader (packageInfo package)
         . runReader (lowerBound @Span)
         . providingLiveSet
-        . runReader (lowerBound @(ModuleTable (NonEmpty (Module (Environment (Hole (Located Monovariant)), Hole (Located Monovariant))))))
+        . runReader (lowerBound @(ModuleTable (NonEmpty (Module (Environment (Hole () (Located Monovariant)), Hole () (Located Monovariant))))))
         . raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))
   extractGraph <$> runEvaluator (runGraphAnalysis (evaluate lang analyzeModule analyzeTerm modules))
 
@@ -146,7 +146,7 @@ runImportGraph lang (package :: Package term)
         . runState lowerBound
         . runReader lowerBound
         . runModules (ModuleTable.modulePaths (packageModules package))
-        . runTermEvaluator @_ @_ @(Value (Hole Precise) (ImportGraphEff term (Hole Precise) effs))
+        . runTermEvaluator @_ @_ @(Value (Hole () Precise) (ImportGraphEff term (Hole () Precise) effs))
         . runReader (packageInfo package)
         . runReader lowerBound
   in extractGraph <$> runEvaluator (runImportGraphAnalysis (evaluate @_ @_ @_ @_ @term lang analyzeModule id (ModuleTable.toPairs (packageModules package) >>= toList . snd)))