From 09c4b6cc03e553961e1da46e8c2f025b8e946770 Mon Sep 17 00:00:00 2001
From: Edwin Brady <ecb10@st-andrews.ac.uk>
Date: Mon, 3 May 2021 14:24:03 +0100
Subject: [PATCH] Recalculate call graph after inlining

This means we can eliminate unused definitions from the generated code.
As usual, this doesn't make the generated code any faster, or the chez
compilation, but it's still good for tidiness and it does make the
generated scheme smaller.
---
 src/Compiler/Inline.idr | 50 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 50 insertions(+)

diff --git a/src/Compiler/Inline.idr b/src/Compiler/Inline.idr
index 0ea7af829..bb6428045 100644
--- a/src/Compiler/Inline.idr
+++ b/src/Compiler/Inline.idr
@@ -416,6 +416,43 @@ mergeLam (MkFun args def)
          pure $ MkFun args' exp'
 mergeLam d = pure d
 
+mutual
+  addRefs : NameMap Bool -> CExp vars -> NameMap Bool
+  addRefs ds (CRef _ n) = insert n False ds
+  addRefs ds (CLam _ _ sc) = addRefs ds sc
+  addRefs ds (CLet _ _ _ val sc) = addRefs (addRefs ds val) sc
+  addRefs ds (CApp _ f args) = addRefsArgs (addRefs ds f) args
+  addRefs ds (CCon _ _ _ args) = addRefsArgs ds args
+  addRefs ds (COp _ _ args) = addRefsArgs ds (toList args)
+  addRefs ds (CExtPrim _ _ args) = addRefsArgs ds args
+  addRefs ds (CForce _ _ e) = addRefs ds e
+  addRefs ds (CDelay _ _ e) = addRefs ds e
+  addRefs ds (CConCase _ sc alts def)
+      = let ds' = maybe ds (addRefs ds) def in
+            addRefsConAlts (addRefs ds' sc) alts
+  addRefs ds (CConstCase _ sc alts def)
+      = let ds' = maybe ds (addRefs ds) def in
+            addRefsConstAlts (addRefs ds' sc) alts
+  addRefs ds tm = ds
+
+  addRefsArgs : NameMap Bool -> List (CExp vars) -> NameMap Bool
+  addRefsArgs ds [] = ds
+  addRefsArgs ds (a :: as) = addRefsArgs (addRefs ds a) as
+
+  addRefsConAlts : NameMap Bool -> List (CConAlt vars) -> NameMap Bool
+  addRefsConAlts ds [] = ds
+  addRefsConAlts ds (MkConAlt _ _ _ sc :: rest)
+      = addRefsConAlts (addRefs ds sc) rest
+
+  addRefsConstAlts : NameMap Bool -> List (CConstAlt vars) -> NameMap Bool
+  addRefsConstAlts ds [] = ds
+  addRefsConstAlts ds (MkConstAlt _ sc :: rest)
+      = addRefsConstAlts (addRefs ds sc) rest
+
+getRefs : CDef -> NameMap Bool
+getRefs (MkFun args exp) = addRefs empty exp
+getRefs _ = empty
+
 export
 inlineDef : {auto c : Ref Ctxt Defs} ->
             Name -> Core ()
@@ -425,6 +462,17 @@ inlineDef n
          let Just cexpr =  compexpr def             | Nothing => pure ()
          setCompiled n !(inline n cexpr)
 
+-- Update the names a function refers to at runtime based on the transformation
+-- results (saves generating code unnecessarily).
+updateCallGraph : {auto c : Ref Ctxt Defs} ->
+                  Name -> Core ()
+updateCallGraph n
+    = do defs <- get Ctxt
+         Just def <- lookupCtxtExact n (gamma defs) | Nothing => pure ()
+         let Just cexpr =  compexpr def             | Nothing => pure ()
+         let refs = getRefs cexpr
+         ignore $ addDef n (record { refersToRuntimeM = Just refs } def)
+
 export
 fixArityDef : {auto c : Ref Ctxt Defs} ->
               Name -> Core ()
@@ -462,6 +510,8 @@ compileAndInlineAll
          traverse_ mergeLamDef cns
          traverse_ caseLamDef cns
          traverse_ fixArityDef cns
+
+         traverse_ updateCallGraph cns
   where
     nonErased : Name -> Core Bool
     nonErased n