Do reference-based pruning for ucm compile, turn back on inlining

The pruning was causing problems with compiled programs when
inlining was on, because it would prune based on the inlined
code. The inlined code may have certain intermediate combinators
omitted, but those are still necessary to have a full picture of
the source code. Since `compile` was using the MCode numbering
and backing out which References are necessary from that, it
would throw away the source code for these intermediate
definitions. This then caused problems when e.g. cloud (running
from a compiled build) would try to send code to other
environments. It wouldn't have the intermediate terms necessary
for the remote environment to do its own
intermediate->interpreter step.

This new approach does all the 'necessary terms' tracing at the
intermediate level, and then instead determines which MCode level
defintions are necessary from that. This means that the pruning
is no longer sensitive to the inlining. So, it should be safe to
turn inlining back on.

unison-runtime/src/Unison/Runtime/Interface.hs

@@ -109,13 +109,11 @@ import Unison.Runtime.Exception
 import Unison.Runtime.MCode
   ( Args (..),
     CombIx (..),
-    GCombs,
     GInstr (..),
     GSection (..),
     RCombs,
     RefNums (..),
     absurdCombs,
-    combDeps,
     combTypes,
     emitComb,
     emptyRNs,
@@ -1373,21 +1371,22 @@ restoreCache (SCache cs crs cacheableCombs trs ftm fty int rtm rty sbs) = do
         & resolveCombs Nothing
 
 traceNeeded ::
-  Word64 ->
-  EnumMap Word64 (GCombs clos comb) ->
-  IO (EnumMap Word64 (GCombs clos comb))
-traceNeeded init src = fmap (`withoutKeys` ks) $ go mempty init
+  Reference ->
+  Map Reference (SuperGroup Symbol) ->
+  IO (Map Reference (SuperGroup Symbol))
+traceNeeded init src = go mempty init
   where
-    ks = keysSet numberedTermLookup
-    go acc w
-      | hasKey w acc = pure acc
-      | Just co <- EC.lookup w src =
-          foldlM go (mapInsert w co acc) (foldMap combDeps co)
-      | otherwise = die $ "traceNeeded: unknown combinator: " ++ show w
+    go acc nx
+      | RF.isBuiltin nx = pure acc
+      | Map.member nx acc = pure acc
+      | Just co <- Map.lookup nx src =
+          foldlM go (Map.insert nx co acc) (groupTermLinks co)
+      | otherwise =
+          die $ "traceNeeded: unknown combinator: " ++ show nx
 
 buildSCache ::
-  EnumMap Word64 Combs ->
   EnumMap Word64 Reference ->
+  EnumMap Word64 Combs ->
   EnumSet Word64 ->
   EnumMap Word64 Reference ->
   Word64 ->
@@ -1397,27 +1396,39 @@ buildSCache ::
   Map Reference Word64 ->
   Map Reference (Set Reference) ->
   StoredCache
-buildSCache cs crsrc cacheableCombs trsrc ftm fty intsrc rtmsrc rtysrc sndbx =
+buildSCache crsrc cssrc cacheableCombs trsrc ftm fty int rtmsrc rtysrc sndbx =
   SCache
     cs
     crs
     cacheableCombs
     trs
     ftm
     fty
-    (restrictTmR intsrc)
-    (restrictTmR rtmsrc)
+    int
+    rtm
     (restrictTyR rtysrc)
     (restrictTmR sndbx)
   where
-    combKeys = keysSet cs
+    termRefs = Map.keysSet int
+
+    -- Retain just the Reference->Word mappings for needed code
+    rtm :: Map Reference Word64
+    rtm = restrictTmR rtmsrc
+
+    -- Retain numbers that correspond to the above termRefs
+    combKeys :: EnumSet Word64
+    combKeys = foldMap setSingleton rtm
+
     crs = restrictTmW crsrc
-    termRefs = foldMap Set.singleton crs
+
+    cs :: EnumMap Word64 Combs
+    cs = restrictTmW cssrc
 
     typeKeys = setFromList $ (foldMap . foldMap) combTypes cs
     trs = restrictTyW trsrc
     typeRefs = foldMap Set.singleton trs
 
+    restrictTmW :: EnumMap Word64 a -> EnumMap Word64 a
     restrictTmW m = restrictKeys m combKeys
     restrictTmR :: Map Reference a -> Map Reference a
     restrictTmR m = Map.restrictKeys m termRefs
@@ -1426,15 +1437,18 @@ buildSCache cs crsrc cacheableCombs trsrc ftm fty intsrc rtmsrc rtysrc sndbx =
     restrictTyR m = Map.restrictKeys m typeRefs
 
 standalone :: CCache -> Word64 -> IO StoredCache
-standalone cc init =
-  buildSCache
-    <$> (readTVarIO (srcCombs cc) >>= traceNeeded init)
-    <*> readTVarIO (combRefs cc)
-    <*> readTVarIO (cacheableCombs cc)
-    <*> readTVarIO (tagRefs cc)
-    <*> readTVarIO (freshTm cc)
-    <*> readTVarIO (freshTy cc)
-    <*> readTVarIO (intermed cc)
-    <*> readTVarIO (refTm cc)
-    <*> readTVarIO (refTy cc)
-    <*> readTVarIO (sandbox cc)
+standalone cc init = readTVarIO (combRefs cc) >>= \crs ->
+  case EC.lookup init crs of
+    Just rinit ->
+      buildSCache crs
+        <$> readTVarIO (srcCombs cc)
+        <*> readTVarIO (cacheableCombs cc)
+        <*> readTVarIO (tagRefs cc)
+        <*> readTVarIO (freshTm cc)
+        <*> readTVarIO (freshTy cc)
+        <*> (readTVarIO (intermed cc) >>= traceNeeded rinit)
+        <*> readTVarIO (refTm cc)
+        <*> readTVarIO (refTy cc)
+        <*> readTVarIO (sandbox cc)
+    Nothing ->
+      die $ "standalone: unknown combinator: " ++ show init

unison-runtime/src/Unison/Runtime/Machine.hs

@@ -2207,10 +2207,11 @@ cacheAdd0 ntys0 termSuperGroups sands cc = do
     rtm <- updateMap (M.fromList $ zip rs [ntm ..]) (refTm cc)
     -- check for missing references
     let arities = fmap (head . ANF.arities) int <> builtinArities
+        inlinfo = ANF.buildInlineMap int <> builtinInlineInfo
         rns = RN (refLookup "ty" rty) (refLookup "tm" rtm) (flip M.lookup arities)
         combinate :: Word64 -> (Reference, SuperGroup Symbol) -> (Word64, EnumMap Word64 Comb)
         combinate n (r, g) =
-          (n, emitCombs rns r n g)
+          (n, emitCombs rns r n $ ANF.inline inlinfo g)
     let combRefUpdates = (mapFromList $ zip [ntm ..] rs)
     let combIdFromRefMap = (M.fromList $ zip rs [ntm ..])
     let newCacheableCombs =