improve pretty printing of call graph

app/Main.hs

@@ -43,8 +43,9 @@ data HtmlOptions = HtmlOptions
     _htmlTheme :: Theme
   }
 
-newtype CallGraphOptions = CallGraphOptions
-  { _graphInputFile :: FilePath
+data CallGraphOptions = CallGraphOptions
+  { _graphInputFile :: FilePath,
+    _graphShowIds :: Bool
   }
 
 parseHtml :: Parser HtmlOptions
@@ -83,6 +84,11 @@ parseCallGraph = do
       ( metavar "MINIJUVIX_FILE"
           <> help "Path to a .mjuvix file"
       )
+  _graphShowIds <-
+    switch
+      ( long "show-name-ids"
+          <> help "Show the unique number of each identifier"
+      )
   pure CallGraphOptions {..}
 
 parseParse :: Parser ParseOptions
@@ -195,6 +201,12 @@ mkScopePrettyOptions ScopeOptions {..} =
       _optInlineImports = _scopeInlineImports
     }
 
+mkAbstractPrettyOptions :: CallGraphOptions -> A.Options
+mkAbstractPrettyOptions CallGraphOptions {..} =
+  A.defaultOptions
+    { A._optShowNameId = _graphShowIds
+    }
+
 parseModuleIO :: FilePath -> IO (M.Module 'M.Parsed 'M.ModuleTop)
 parseModuleIO = fromRightIO id . M.runModuleParserIO
 
@@ -223,13 +235,13 @@ go c = case c of
     m <- parseModuleIO _htmlInputFile
     s <- fromRightIO' printErrorAnsi $ M.scopeCheck1IO root m
     genHtml defaultOptions _htmlRecursive _htmlTheme s
-  CallGraph CallGraphOptions {..} -> do
+  CallGraph opts@CallGraphOptions {..} -> do
     root <- getCurrentDirectory
     m <- parseModuleIO _graphInputFile
     s <- fromRightIO' printErrorAnsi $ M.scopeCheck1IO root m
     a <- fromRightIO' putStrLn (return $ A.translateModule s)
     let graph = A.buildCallGraph a
-    A.printPrettyCodeDefault graph
+    A.printPrettyCode (mkAbstractPrettyOptions opts) graph
 
 main :: IO ()
 main = execParser descr >>= go

src/MiniJuvix/Syntax/Abstract/Language/Extra.hs

@@ -0,0 +1,17 @@
+module MiniJuvix.Syntax.Abstract.Language.Extra (
+  module MiniJuvix.Syntax.Abstract.Language,
+  module MiniJuvix.Syntax.Abstract.Language.Extra
+                                       ) where
+
+import MiniJuvix.Syntax.Abstract.Language
+import MiniJuvix.Prelude
+
+patternVariables :: Pattern -> [VarName]
+patternVariables p = case p of
+  PatternVariable v -> [v]
+  PatternWildcard {} -> []
+  PatternEmpty {} -> []
+  PatternConstructorApp app -> appVariables app
+  where
+  appVariables :: ConstructorApp -> [VarName]
+  appVariables (ConstructorApp _ ps) = concatMap patternVariables ps

src/MiniJuvix/Syntax/Abstract/Pretty/Ann.hs

@@ -8,6 +8,7 @@ import MiniJuvix.Prelude
 data Ann =
   AnnKind S.NameKind
   | AnnKeyword
+  | AnnImportant
 
 fromScopedAnn :: S.Ann -> Maybe Ann
 fromScopedAnn s = case s of

src/MiniJuvix/Syntax/Abstract/Pretty/Ansi.hs

@@ -36,3 +36,4 @@ stylize a = case a of
     KNameLocal -> mempty
     KNameTopModule -> mempty
   AnnKeyword -> colorDull Blue
+  AnnImportant -> bold

src/MiniJuvix/Syntax/Concrete/Scoped/Error.hs

@@ -19,6 +19,7 @@ data ScopeError
   | ErrInfixPattern InfixErrorP
   | ErrMultipleDeclarations MultipleDeclarations
   | ErrLacksTypeSig LacksTypeSig
+  | ErrLacksFunctionClause LacksFunctionClause
   | ErrImportCycle ImportCycle
   | ErrSymNotInScope NotInScope
   | ErrQualSymNotInScope QualifiedName
@@ -51,6 +52,7 @@ ppScopeError s = case s of
   ErrAmbiguousSym e -> ppError e
   ErrAmbiguousModuleSym e -> ppError e
   ErrUnusedOperatorDef e -> ppError e
+  ErrLacksFunctionClause e -> ppError e
 
 docStream :: ScopeError -> SimpleDocStream Eann
 docStream = layoutPretty defaultLayoutOptions . ppScopeError

src/MiniJuvix/Termination/CallGraph.hs

@@ -4,7 +4,7 @@ module MiniJuvix.Termination.CallGraph
                                        ) where
 
 import MiniJuvix.Prelude
-import MiniJuvix.Syntax.Abstract.Language
+import MiniJuvix.Syntax.Abstract.Language.Extra
 import qualified Data.HashMap.Strict as HashMap
 import MiniJuvix.Termination.CallGraph.Types
 

src/MiniJuvix/Termination/CallGraph/Types.hs

@@ -11,6 +11,16 @@ newtype CallGraph = CallGraph {
   _callGraph :: HashMap A.FunctionName [Call] }
   deriving newtype (Semigroup, Monoid)
 
+data Argument = Argument {
+  _argOwnerFunction :: A.FunctionName,
+  _argIx :: Int
+  }
+
+data Rel =
+  REq
+  | RLe
+  | RNothing
+
 data Call = Call {
   _callName :: A.Name,
   _callArgs :: [A.Expression]
@@ -30,6 +40,6 @@ instance PrettyCode CallGraph where
     where
     ppEntry :: (A.FunctionName, [Call]) -> Sem r (Doc Ann)
     ppEntry (fun, calls) = do
-      fun' <- ppSCode fun
+      fun' <- annotate AnnImportant <$> ppSCode fun
       calls' <- vsep <$> mapM ppCode calls
-      return $ fun' <+> colon <+> align calls'
+      return $ fun' <+> pretty ("↝" :: Text) <+> align calls'