Simplify VertexDeclaration to avoid the extra type parameter.

bench/Evaluation.hs

@@ -38,7 +38,7 @@ callGraphProject' :: ( Language.SLanguage lang
                      , AccessControls1 syntax
                      , HasPrelude lang
                      , Functor syntax
-                     , VertexDeclarationWithStrategy (VertexDeclarationStrategy syntax) syntax syntax
+                     , VertexDeclaration syntax
                      )
                   => TaskSession
                   -> Proxy lang

src/Analysis/Abstract/Graph.hs

@@ -74,10 +74,9 @@ graphingTerms :: ( Member (Reader ModuleInfo) sig
                  , Declarations1 syntax
                  , Ord address
                  , Foldable syntax
-                 , term ~ Term syntax Loc
                  , Carrier sig m
                  )
-              => Open (term -> Evaluator term address value m a)
+              => Open (Term syntax Loc -> Evaluator (Term syntax Loc) address value m a)
 graphingTerms recur term@(Term (In a syntax)) = do
   definedInModule <- currentModule
   case toVertex a definedInModule syntax of

src/Data/Graph/ControlFlowVertex.hs

@@ -10,9 +10,6 @@ module Data.Graph.ControlFlowVertex
 , vertexIdentifier
 , showSpan
 , VertexDeclaration (..)
-, VertexDeclaration' (..)
-, VertexDeclarationStrategy
-, VertexDeclarationWithStrategy
 ) where
 
 import           Data.Abstract.Declarations
@@ -100,24 +97,18 @@ instance ToJSON ControlFlowVertex where
 -- 'Name's for terms with symbolic names like Identifiers and Declarations.
 
 class VertexDeclaration syntax where
-  toVertex :: (Declarations1 syntax, Foldable syntax)
-           => Loc
-           -> ModuleInfo
-           -> syntax (Term syntax Loc)
-           -> Maybe (ControlFlowVertex, Name)
-
-instance (VertexDeclaration' syntax syntax) => VertexDeclaration syntax where
-  toVertex = toVertex'
-
-class VertexDeclaration' whole syntax where
-  toVertex' :: (Declarations1 whole, Foldable whole)
+  toVertex :: (Declarations1 whole, Foldable whole, VertexDeclaration whole)
            => Loc
            -> ModuleInfo
            -> syntax (Term whole Loc)
            -> Maybe (ControlFlowVertex, Name)
 
-instance (VertexDeclarationStrategy syntax ~ strategy, VertexDeclarationWithStrategy strategy whole syntax) => VertexDeclaration' whole syntax where
-  toVertex' = toVertexWithStrategy (Proxy :: Proxy strategy)
+instance (VertexDeclarationStrategy syntax ~ strategy, VertexDeclarationWithStrategy strategy syntax) => VertexDeclaration syntax where
+  toVertex = toVertexWithStrategy (Proxy :: Proxy strategy)
+
+-- | This appears to be required to convince 'Semantic.Graph.runCallGraph' not to try to specialize the instance too eagerly.
+instance {-# OVERLAPPING #-} VertexDeclaration Maybe where
+  toVertex _ _ _ = Nothing
 
 data Strategy = Default | Custom
 
@@ -129,8 +120,8 @@ type family VertexDeclarationStrategy syntax where
   VertexDeclarationStrategy (Sum _)                 = 'Custom
   VertexDeclarationStrategy syntax                  = 'Default
 
-class VertexDeclarationWithStrategy (strategy :: Strategy) whole syntax where
-  toVertexWithStrategy :: (Declarations1 whole, Foldable whole)
+class VertexDeclarationWithStrategy (strategy :: Strategy) syntax where
+  toVertexWithStrategy :: (Declarations1 whole, Foldable whole, VertexDeclaration whole)
                        => proxy strategy
                        -> Loc
                        -> ModuleInfo
@@ -138,24 +129,24 @@ class VertexDeclarationWithStrategy (strategy :: Strategy) whole syntax where
                        -> Maybe (ControlFlowVertex, Name)
 
 -- | The 'Default' strategy produces 'Nothing'.
-instance VertexDeclarationWithStrategy 'Default whole syntax where
+instance VertexDeclarationWithStrategy 'Default syntax where
   toVertexWithStrategy _ _ _ _ = Nothing
 
-instance Apply (VertexDeclaration' whole) fs => VertexDeclarationWithStrategy 'Custom whole (Sum fs) where
-  toVertexWithStrategy _ ann info = apply @(VertexDeclaration' whole) (toVertex' ann info)
+instance Apply VertexDeclaration fs => VertexDeclarationWithStrategy 'Custom (Sum fs) where
+  toVertexWithStrategy _ ann info = apply @VertexDeclaration (toVertex ann info)
 
-instance VertexDeclarationWithStrategy 'Custom whole Syntax.Identifier where
+instance VertexDeclarationWithStrategy 'Custom Syntax.Identifier where
   toVertexWithStrategy _ ann info (Syntax.Identifier name) = Just (variableVertex (formatName name) info (Loc.span ann), name)
 
-instance VertexDeclarationWithStrategy 'Custom whole Declaration.Function where
+instance VertexDeclarationWithStrategy 'Custom Declaration.Function where
   toVertexWithStrategy _ ann info term@Declaration.Function{} = (\n -> (functionVertex (formatName n) info (Loc.span ann), n)) <$> liftDeclaredName declaredName term
 
-instance VertexDeclarationWithStrategy 'Custom whole Declaration.Method where
+instance VertexDeclarationWithStrategy 'Custom Declaration.Method where
   toVertexWithStrategy _ ann info term@Declaration.Method{} = (\n -> (methodVertex (formatName n) info (Loc.span ann), n)) <$> liftDeclaredName declaredName term
 
-instance VertexDeclarationWithStrategy 'Custom whole whole => VertexDeclarationWithStrategy 'Custom whole Expression.MemberAccess where
-  toVertexWithStrategy proxy ann info (Expression.MemberAccess (Term (In lhsAnn lhs)) (Term (In rhsAnn rhs))) =
-    case (toVertexWithStrategy proxy lhsAnn info lhs, toVertexWithStrategy proxy rhsAnn info rhs) of
+instance VertexDeclarationWithStrategy 'Custom Expression.MemberAccess where
+  toVertexWithStrategy _ ann info (Expression.MemberAccess (Term (In lhsAnn lhs)) (Term (In rhsAnn rhs))) =
+    case (toVertex lhsAnn info lhs, toVertex rhsAnn info rhs) of
       (Just (Variable n _ _, _), Just (_, name)) -> Just (variableVertex (n <> "." <> formatName name) info (Loc.span ann), name)
       (_, Just (_, name)) -> Just (variableVertex (formatName name) info (Loc.span ann), name)
       _ -> Nothing

src/Parsing/Parser.hs

@@ -38,7 +38,7 @@ import           Assigning.Assignment
 import qualified CMarkGFM
 import           Data.Abstract.Evaluatable (HasPrelude)
 import           Data.AST
-import           Data.Graph.ControlFlowVertex (VertexDeclaration')
+import           Data.Graph.ControlFlowVertex (VertexDeclaration)
 import           Data.Language
 import           Data.Kind (Constraint)
 import qualified Data.Map as Map
@@ -70,11 +70,11 @@ import           TreeSitter.Unmarshal
 
 -- | A parser, suitable for program analysis, for some specific language, producing 'Term's whose syntax satisfies a list of typeclass constraints.
 data SomeAnalysisParser (constraint :: (* -> *) -> Constraint) ann where
-  SomeAnalysisParser :: ( constraint (Sum fs)
-                        , Apply (VertexDeclaration' (Sum fs)) fs
+  SomeAnalysisParser :: ( constraint syntax
+                        , VertexDeclaration syntax
                         , HasPrelude lang
                         )
-                     => Parser (Term (Sum fs) ann)
+                     => Parser (Term syntax ann)
                      -> Proxy lang
                      -> SomeAnalysisParser constraint ann
 

src/Semantic/Graph.hs

@@ -52,7 +52,7 @@ import           Data.Abstract.Value.Type as Type
 import           Data.Abstract.AccessControls.Instances ()
 import           Data.Blob
 import           Data.Graph
-import           Data.Graph.ControlFlowVertex (VertexDeclarationStrategy, VertexDeclarationWithStrategy)
+import           Data.Graph.ControlFlowVertex (VertexDeclaration)
 import           Data.Language as Language
 import           Data.List (isPrefixOf, isSuffixOf)
 import           Data.Project
@@ -118,7 +118,7 @@ runGraph CallGraph includePackages project
     modules <- topologicalSort <$> runImportGraphToModules lang package
     runCallGraph lang includePackages modules package
 
-runCallGraph :: ( VertexDeclarationWithStrategy (VertexDeclarationStrategy syntax) syntax syntax
+runCallGraph :: ( VertexDeclaration syntax
                 , Declarations1 syntax
                 , AccessControls1 syntax
                 , Ord1 syntax