From 67d1c0d5692dfca0b46dc004dfdd6479a676feb5 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Mon, 25 Nov 2024 16:26:54 -0800
Subject: [PATCH 01/12] Add export lists and specializations

---
 .../src/Unison/Runtime/Exception.hs           | 11 ++-
 unison-runtime/src/Unison/Runtime/Machine.hs  | 90 +++++--------------
 2 files changed, 30 insertions(+), 71 deletions(-)

diff --git a/unison-runtime/src/Unison/Runtime/Exception.hs b/unison-runtime/src/Unison/Runtime/Exception.hs
index 7d0d7bd5ea..75d63ee75e 100644
--- a/unison-runtime/src/Unison/Runtime/Exception.hs
+++ b/unison-runtime/src/Unison/Runtime/Exception.hs
@@ -1,4 +1,10 @@
-module Unison.Runtime.Exception where
+module Unison.Runtime.Exception
+  ( RuntimeExn (..),
+    die,
+    dieP,
+    exn,
+  )
+where
 
 import Control.Exception
 import Data.String (fromString)
@@ -17,9 +23,12 @@ instance Exception RuntimeExn
 
 die :: (HasCallStack) => String -> IO a
 die = throwIO . PE callStack . P.lit . fromString
+{-# INLINEABLE die #-}
 
 dieP :: (HasCallStack) => P.Pretty P.ColorText -> IO a
 dieP = throwIO . PE callStack
+{-# INLINEABLE dieP #-}
 
 exn :: (HasCallStack) => String -> a
 exn = throw . PE callStack . P.lit . fromString
+{-# INLINEABLE exn #-}
diff --git a/unison-runtime/src/Unison/Runtime/Machine.hs b/unison-runtime/src/Unison/Runtime/Machine.hs
index 22b4add374..95e601a353 100644
--- a/unison-runtime/src/Unison/Runtime/Machine.hs
+++ b/unison-runtime/src/Unison/Runtime/Machine.hs
@@ -2,7 +2,26 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 
-module Unison.Runtime.Machine where
+module Unison.Runtime.Machine
+  ( ActiveThreads,
+    CCache (..),
+    Combs,
+    Tracer (..),
+    apply0,
+    baseCCache,
+    cacheAdd,
+    cacheAdd0,
+    eval0,
+    expandSandbox,
+    preEvalTopLevelConstants,
+    refLookup,
+    refNumTm,
+    refNumsTm,
+    refNumsTy,
+    reifyValue,
+    resolveSection,
+  )
+where
 
 import Control.Concurrent (ThreadId)
 import Control.Concurrent.STM as STM
@@ -136,15 +155,6 @@ refNumTm cc r =
     (M.lookup r -> Just w) -> pure w
     _ -> die $ "refNumTm: unknown reference: " ++ show r
 
-refNumTy :: CCache -> Reference -> IO Word64
-refNumTy cc r =
-  refNumsTy cc >>= \case
-    (M.lookup r -> Just w) -> pure w
-    _ -> die $ "refNumTy: unknown reference: " ++ show r
-
-refNumTy' :: CCache -> Reference -> IO (Maybe Word64)
-refNumTy' cc r = M.lookup r <$> refNumsTy cc
-
 baseCCache :: Bool -> IO CCache
 baseCCache sandboxed = do
   CCache ffuncs sandboxed noTrace
@@ -185,13 +195,6 @@ info ctx x = infos ctx (show x)
 infos :: String -> String -> IO ()
 infos ctx s = putStrLn $ ctx ++ ": " ++ s
 
-stk'info :: Stack -> IO ()
-stk'info s@(Stack _ _ sp _ _) = do
-  let prn i
-        | i < 0 = return ()
-        | otherwise = bpeekOff s i >>= print >> prn (i - 1)
-  prn sp
-
 -- Entry point for evaluating a section
 eval0 :: CCache -> ActiveThreads -> MSection -> IO ()
 eval0 !env !activeThreads !co = do
@@ -266,33 +269,9 @@ apply1 callback env threadTracker clo = do
   where
     k0 = CB $ Hook callback
 
--- Entry point for evaluating a saved continuation.
---
--- The continuation must be from an evaluation context expecting a
--- unit value.
-jump0 ::
-  (Stack -> IO ()) ->
-  CCache ->
-  ActiveThreads ->
-  Closure ->
-  IO ()
-jump0 !callback !env !activeThreads !clo = do
-  stk <- alloc
-  cmbs <- readTVarIO $ combs env
-  (denv, kf) <-
-    topDEnv cmbs <$> readTVarIO (refTy env) <*> readTVarIO (refTm env)
-  stk <- bump stk
-  bpoke stk (Enum Rf.unitRef TT.unitTag)
-  jump env denv activeThreads stk (kf k0) (VArg1 0) clo
-  where
-    k0 = CB (Hook callback)
-
 unitValue :: Closure
 unitValue = Enum Rf.unitRef TT.unitTag
 
-lookupDenv :: Word64 -> DEnv -> Val
-lookupDenv p denv = fromMaybe (BoxedVal BlackHole) $ EC.lookup p denv
-
 litToVal :: MLit -> Val
 litToVal = \case
   MT t -> BoxedVal $ Foreign (Wrap Rf.textRef t)
@@ -640,14 +619,6 @@ encodeExn stk exc = do
               (Rf.threadKilledFailureRef, disp ie, boxedVal unitValue)
           | otherwise = (Rf.miscFailureRef, disp exn, boxedVal unitValue)
 
-numValue :: Maybe Reference -> Val -> IO Word64
-numValue _ (UnboxedVal v _) = pure (fromIntegral @Int @Word64 v)
-numValue mr clo =
-  die $
-    "numValue: bad closure: "
-      ++ show clo
-      ++ maybe "" (\r -> "\nexpected type: " ++ show r) mr
-
 -- | Evaluate a section
 eval ::
   CCache ->
@@ -1034,13 +1005,6 @@ closeArgs mode !stk !seg args = augSeg mode stk seg as
             | otherwise = Nothing
           l = fsize stk - i
 
-peekForeign :: Stack -> Int -> IO a
-peekForeign stk i =
-  bpeekOff stk i >>= \case
-    Foreign x -> pure $ unwrapForeign x
-    _ -> die "bad foreign argument"
-{-# INLINE peekForeign #-}
-
 uprim1 :: Stack -> UPrim1 -> Int -> IO Stack
 uprim1 !stk DECI !i = do
   m <- peekOffI stk i
@@ -1903,17 +1867,6 @@ splitCont !denv !stk !k !p =
       return (BoxedVal $ Captured ck asz seg, denv, stk, k)
 {-# INLINE splitCont #-}
 
-discardCont ::
-  DEnv ->
-  Stack ->
-  K ->
-  Word64 ->
-  IO (DEnv, Stack, K)
-discardCont denv stk k p =
-  splitCont denv stk k p
-    <&> \(_, denv, stk, k) -> (denv, stk, k)
-{-# INLINE discardCont #-}
-
 resolve :: CCache -> DEnv -> Stack -> MRef -> IO Val
 resolve _ _ _ (Env cix mcomb) = pure $ mCombVal cix mcomb
 resolve _ _ stk (Stk i) = peekOff stk i
@@ -1945,9 +1898,6 @@ resolveSection cc section = do
 dummyRef :: Reference
 dummyRef = Builtin (DTx.pack "dummy")
 
-reserveIds :: Word64 -> TVar Word64 -> IO Word64
-reserveIds n free = atomically . stateTVar free $ \i -> (i, i + n)
-
 updateMap :: (Semigroup s) => s -> TVar s -> STM s
 updateMap new0 r = do
   new <- evaluateSTM new0

From 1b268ea91b364cf5b24c81a50e36ed21267c8c11 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 26 Nov 2024 10:35:36 -0800
Subject: [PATCH 02/12] Manually unbox functions in FF

---
 .../src/Unison/Runtime/Foreign/Function.hs    | 18 +++++++---
 unison-runtime/src/Unison/Runtime/Stack.hs    | 35 ++++++++++++++++++-
 2 files changed, 47 insertions(+), 6 deletions(-)

diff --git a/unison-runtime/src/Unison/Runtime/Foreign/Function.hs b/unison-runtime/src/Unison/Runtime/Foreign/Function.hs
index b9bb278112..afde8c99ca 100644
--- a/unison-runtime/src/Unison/Runtime/Foreign/Function.hs
+++ b/unison-runtime/src/Unison/Runtime/Foreign/Function.hs
@@ -1,7 +1,9 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE MagicHash #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UnboxedTuples #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -22,14 +24,15 @@ import Data.IORef (IORef)
 import Data.Sequence qualified as Sq
 import Data.Time.Clock.POSIX (POSIXTime)
 import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.Base (IO (..))
 import GHC.IO.Exception (IOErrorType (..), IOException (..))
 import Network.Socket (Socket)
 import Network.UDP (UDPSocket)
 import System.IO (BufferMode (..), Handle, IOMode, SeekMode)
 import Unison.Builtin.Decls qualified as Ty
 import Unison.Reference (Reference)
-import Unison.Runtime.Array qualified as PA
 import Unison.Runtime.ANF (Code, PackedTag (..), Value, internalBug)
+import Unison.Runtime.Array qualified as PA
 import Unison.Runtime.Exception
 import Unison.Runtime.Foreign
 import Unison.Runtime.MCode
@@ -53,8 +56,8 @@ import Unison.Util.Text (Text, pack, unpack)
 -- Foreign functions operating on stacks
 data ForeignFunc where
   FF ::
-    (Stack -> Args -> IO a) ->
-    (Stack -> r -> IO Stack) ->
+    (XStack -> Args -> IO a) ->
+    (XStack -> r -> IOStack) ->
     (a -> IO r) ->
     ForeignFunc
 
@@ -74,12 +77,17 @@ class ForeignConvention a where
     Stack -> a -> IO Stack
 
 mkForeign ::
+  forall a r.
   (ForeignConvention a, ForeignConvention r) =>
   (a -> IO r) ->
   ForeignFunc
-mkForeign ev = FF readArgs writeForeign ev
+mkForeign ev = FF readArgs doWrite ev
   where
-    readArgs stk (argsToLists -> args) =
+    doWrite :: XStack -> r -> IOStack
+    doWrite stk a = case writeForeign (packXStack stk) a of
+      (IO f) -> \state -> case f state of
+        (# state', stk #) -> (# state', unpackXStack stk #)
+    readArgs (packXStack -> stk) (argsToLists -> args) =
       readForeign args stk >>= \case
         ([], a) -> pure a
         _ ->
diff --git a/unison-runtime/src/Unison/Runtime/Stack.hs b/unison-runtime/src/Unison/Runtime/Stack.hs
index ebc9ef33dd..25e5059504 100644
--- a/unison-runtime/src/Unison/Runtime/Stack.hs
+++ b/unison-runtime/src/Unison/Runtime/Stack.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE UnboxedTuples #-}
 
 module Unison.Runtime.Stack
   ( K (..),
@@ -27,6 +30,16 @@ module Unison.Runtime.Stack
     Augment (..),
     Dump (..),
     Stack (..),
+    XStack,
+    pattern XStack,
+    packXStack,
+    unpackXStack,
+    IOStack,
+    apX,
+    fpX,
+    spX,
+    ustkX,
+    bstkX,
     Off,
     SZ,
     FP,
@@ -127,10 +140,10 @@ where
 
 import Control.Monad.Primitive
 import Data.Char qualified as Char
-import Data.Kind (Constraint)
 import Data.Primitive (sizeOf)
 import Data.Primitive.ByteArray qualified as BA
 import Data.Word
+import GHC.Base
 import GHC.Exts as L (IsList (..))
 import Unison.Prelude
 import Unison.Reference (Reference)
@@ -597,6 +610,26 @@ data Stack = Stack
     bstk :: {-# UNPACK #-} !(MutableArray (PrimState IO) Closure)
   }
 
+-- Unboxed representation of the Stack, used to force GHC optimizations in a few spots.
+type XStack = (# Int#, Int#, Int#, MutableByteArray# (PrimState IO), MutableArray# (PrimState IO) Closure #)
+
+type IOStack = State# RealWorld -> (# State# RealWorld, XStack #)
+
+pattern XStack :: Int# -> Int# -> Int# -> MutableByteArray# RealWorld -> MutableArray# RealWorld Closure -> Stack
+pattern XStack {apX, fpX, spX, ustkX, bstkX} = Stack (I# apX) (I# fpX) (I# spX) (MutableByteArray ustkX) (MutableArray bstkX)
+
+{-# COMPLETE XStack #-}
+
+{-# INLINE XStack #-}
+
+packXStack :: XStack -> Stack
+packXStack (# ap, fp, sp, ustk, bstk #) = Stack {ap = I# ap, fp = I# fp, sp = I# sp, ustk = MutableByteArray ustk, bstk = MutableArray bstk}
+{-# INLINE packXStack #-}
+
+unpackXStack :: Stack -> XStack
+unpackXStack (Stack (I# ap) (I# fp) (I# sp) (MutableByteArray ustk) (MutableArray bstk)) = (# ap, fp, sp, ustk, bstk #)
+{-# INLINE unpackXStack #-}
+
 instance Show Stack where
   show (Stack ap fp sp _ _) =
     "Stack " ++ show ap ++ " " ++ show fp ++ " " ++ show sp

From 6d8b26d96a4a3b05e6c9e307d755832c6cfa6a3d Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Thu, 21 Nov 2024 13:40:07 -0800
Subject: [PATCH 03/12] Add dumpcore flag

---
 unison-runtime/package.yaml         | 6 +++++-
 unison-runtime/unison-runtime.cabal | 8 ++++++++
 2 files changed, 13 insertions(+), 1 deletion(-)

diff --git a/unison-runtime/package.yaml b/unison-runtime/package.yaml
index e9221c6d3e..850a83046c 100644
--- a/unison-runtime/package.yaml
+++ b/unison-runtime/package.yaml
@@ -11,13 +11,17 @@ flags:
   stackchecks:
     manual: true
     default: false
+  dumpcore:
+    manual: true
+    default: false
 
 when:
   - condition: flag(arraychecks)
     cpp-options: -DARRAY_CHECK
   - condition: flag(stackchecks)
     cpp-options: -DSTACK_CHECK
-
+  - condition: flag(dumpcore)
+    ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes # -dsuppress-type-applications -dsuppress-type-signatures
 
 library:
   source-dirs: src
diff --git a/unison-runtime/unison-runtime.cabal b/unison-runtime/unison-runtime.cabal
index cc6e59bc6a..a23132a3f9 100644
--- a/unison-runtime/unison-runtime.cabal
+++ b/unison-runtime/unison-runtime.cabal
@@ -21,6 +21,10 @@ flag arraychecks
   manual: True
   default: False
 
+flag dumpcore
+  manual: True
+  default: False
+
 flag stackchecks
   manual: True
   default: False
@@ -142,6 +146,8 @@ library
     cpp-options: -DARRAY_CHECK
   if flag(stackchecks)
     cpp-options: -DSTACK_CHECK
+  if flag(dumpcore)
+    ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes
 
 test-suite runtime-tests
   type: exitcode-stdio-1.0
@@ -221,3 +227,5 @@ test-suite runtime-tests
     cpp-options: -DARRAY_CHECK
   if flag(stackchecks)
     cpp-options: -DSTACK_CHECK
+  if flag(dumpcore)
+    ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes

From e2cf40a2596588560335ecf04a9cfc5da357f233 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 26 Nov 2024 11:05:32 -0800
Subject: [PATCH 04/12] Fix max worker args, and add unboxing to callbacks too

---
 unison-runtime/package.yaml                  |  4 +--
 unison-runtime/src/Unison/Runtime/Machine.hs | 37 ++++++++++++--------
 unison-runtime/src/Unison/Runtime/Stack.hs   |  2 +-
 unison-runtime/unison-runtime.cabal          |  8 ++---
 4 files changed, 29 insertions(+), 22 deletions(-)

diff --git a/unison-runtime/package.yaml b/unison-runtime/package.yaml
index 850a83046c..c67aae8e6d 100644
--- a/unison-runtime/package.yaml
+++ b/unison-runtime/package.yaml
@@ -2,7 +2,7 @@ name: unison-runtime
 github: unisonweb/unison
 copyright: Copyright (C) 2013-2024 Unison Computing, PBC and contributors
 
-ghc-options: -Wall -funbox-strict-fields -O2
+ghc-options: -fmax-worker-args=100 -Wall -funbox-strict-fields -O2
 
 flags:
   arraychecks:
@@ -21,7 +21,7 @@ when:
   - condition: flag(stackchecks)
     cpp-options: -DSTACK_CHECK
   - condition: flag(dumpcore)
-    ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes # -dsuppress-type-applications -dsuppress-type-signatures
+    ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures # -dsuppress-type-applications -dsuppress-type-signatures
 
 library:
   source-dirs: src
diff --git a/unison-runtime/src/Unison/Runtime/Machine.hs b/unison-runtime/src/Unison/Runtime/Machine.hs
index 95e601a353..444b588d9c 100644
--- a/unison-runtime/src/Unison/Runtime/Machine.hs
+++ b/unison-runtime/src/Unison/Runtime/Machine.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
 
 module Unison.Runtime.Machine
   ( ActiveThreads,
@@ -37,6 +39,7 @@ import Data.Set qualified as Set
 import Data.Text qualified as DTx
 import Data.Text.IO qualified as Tx
 import Data.Traversable
+import GHC.Base (IO (..))
 import GHC.Conc as STM (unsafeIOToSTM)
 import Unison.Builtin.Decls (exceptionRef, ioFailureRef)
 import Unison.Builtin.Decls qualified as Rf
@@ -253,7 +256,7 @@ apply0 !callback !env !threadTracker !i = do
     -- if it's cached, we can just finish
     CachedVal _ val -> bump stk >>= \stk -> poke stk val
   where
-    k0 = maybe KE (CB . Hook) callback
+    k0 = fromMaybe KE (callback <&> \cb -> CB . Hook $ \stk -> cb $ packXStack stk)
 
 -- Apply helper currently used for forking. Creates the new stacks
 -- necessary to evaluate a closure with the provided information.
@@ -267,7 +270,7 @@ apply1 callback env threadTracker clo = do
   stk <- alloc
   apply env mempty threadTracker stk k0 True ZArgs $ clo
   where
-    k0 = CB $ Hook callback
+    k0 = CB $ Hook (\stk -> callback $ packXStack stk)
 
 unitValue :: Closure
 unitValue = Enum Rf.unitRef TT.unitTag
@@ -550,9 +553,11 @@ exec !_ !denv !_activeThreads !stk !k _ (Seq as) = do
   pokeS stk $ Sq.fromList l
   pure (denv, stk, k)
 exec !env !denv !_activeThreads !stk !k _ (ForeignCall _ w args)
-  | Just (FF arg res ev) <- EC.lookup w (foreignFuncs env) =
-      (denv,,k)
-        <$> (arg stk args >>= ev >>= res stk)
+  | Just (FF arg res ev) <- EC.lookup w (foreignFuncs env) = do
+      let xStack = unpackXStack stk
+      r <- arg (unpackXStack stk) args >>= ev
+      IO $ \s -> case res xStack r s of
+        (# s, xstk #) -> (# s, (denv, packXStack xstk, k) #)
   | otherwise =
       die $ "reference to unknown foreign function: " ++ show w
 exec !env !denv !activeThreads !stk !k _ (Fork i)
@@ -647,16 +652,18 @@ eval !env !denv !activeThreads !stk !k r (DMatch mr i br) = do
     selectBranch (maskTags t) br
 eval !env !denv !activeThreads !stk !k r (NMatch _mr i br) = do
   n <- peekOffN stk i
+
   eval env denv activeThreads stk k r $ selectBranch n br
-eval !env !denv !activeThreads !stk !k r (RMatch i pu br) = do
-  (t, stk) <- dumpDataNoTag Nothing stk =<< peekOff stk i
-  if t == PackedTag 0
-    then eval env denv activeThreads stk k r pu
-    else case ANF.unpackTags t of
-      (ANF.rawTag -> e, ANF.rawTag -> t)
-        | Just ebs <- EC.lookup e br ->
-            eval env denv activeThreads stk k r $ selectBranch t ebs
-        | otherwise -> unhandledErr "eval" env e
+eval !_env !_denv !_activeThreads !_stk !_k _r (RMatch _i _pu _br) = do
+  pure ()
+--   (t, stk) <- dumpDataNoTag Nothing stk =<< peekOff stk i
+--   if t == PackedTag 0
+--     then eval env denv activeThreads stk k r pu
+--     else case ANF.unpackTags t of
+--       (ANF.rawTag -> e, ANF.rawTag -> t)
+--         | Just ebs <- EC.lookup e br ->
+--             eval env denv activeThreads stk k r $ selectBranch t ebs
+--         | otherwise -> unhandledErr "eval" env e
 eval !env !denv !activeThreads !stk !k _ (Yield args)
   | asize stk > 0,
     VArg1 i <- args =
@@ -1799,7 +1806,7 @@ yield !env !denv !activeThreads !stk !k = leap denv k
       stk <- restoreFrame stk fsz asz
       stk <- ensure stk f
       eval env denv activeThreads stk k ref nx
-    leap _ (CB (Hook f)) = f stk
+    leap _ (CB (Hook f)) = f (unpackXStack stk)
     leap _ KE = pure ()
 {-# INLINE yield #-}
 
diff --git a/unison-runtime/src/Unison/Runtime/Stack.hs b/unison-runtime/src/Unison/Runtime/Stack.hs
index 25e5059504..4e297defd4 100644
--- a/unison-runtime/src/Unison/Runtime/Stack.hs
+++ b/unison-runtime/src/Unison/Runtime/Stack.hs
@@ -198,7 +198,7 @@ type DebugCallStack = (() :: Constraint)
 #endif
 {- ORMOLU_ENABLE -}
 
-newtype Callback = Hook (Stack -> IO ())
+newtype Callback = Hook (XStack -> IO ())
 
 instance Eq Callback where _ == _ = True
 
diff --git a/unison-runtime/unison-runtime.cabal b/unison-runtime/unison-runtime.cabal
index a23132a3f9..08184c9bab 100644
--- a/unison-runtime/unison-runtime.cabal
+++ b/unison-runtime/unison-runtime.cabal
@@ -87,7 +87,7 @@ library
       TypeApplications
       TypeFamilies
       ViewPatterns
-  ghc-options: -Wall -funbox-strict-fields -O2
+  ghc-options: -fmax-worker-args=100 -Wall -funbox-strict-fields -O2
   build-depends:
       asn1-encoding
     , asn1-types
@@ -147,7 +147,7 @@ library
   if flag(stackchecks)
     cpp-options: -DSTACK_CHECK
   if flag(dumpcore)
-    ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes
+    ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures
 
 test-suite runtime-tests
   type: exitcode-stdio-1.0
@@ -194,7 +194,7 @@ test-suite runtime-tests
       TypeApplications
       TypeFamilies
       ViewPatterns
-  ghc-options: -Wall -funbox-strict-fields -O2 -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0
+  ghc-options: -fmax-worker-args=100 -Wall -funbox-strict-fields -O2 -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0
   build-depends:
       base
     , bytes
@@ -228,4 +228,4 @@ test-suite runtime-tests
   if flag(stackchecks)
     cpp-options: -DSTACK_CHECK
   if flag(dumpcore)
-    ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes
+    ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures

From eec7498bc25f9e2806a8e54def5572a0059b9c72 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 26 Nov 2024 11:17:48 -0800
Subject: [PATCH 05/12] Experiment with optimization flags

---
 unison-runtime/package.yaml                  |  3 ++-
 unison-runtime/src/Unison/Runtime/Machine.hs | 19 +++++++++----------
 unison-runtime/unison-runtime.cabal          |  8 ++++----
 3 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/unison-runtime/package.yaml b/unison-runtime/package.yaml
index c67aae8e6d..4dbde33972 100644
--- a/unison-runtime/package.yaml
+++ b/unison-runtime/package.yaml
@@ -3,6 +3,7 @@ github: unisonweb/unison
 copyright: Copyright (C) 2013-2024 Unison Computing, PBC and contributors
 
 ghc-options: -fmax-worker-args=100 -Wall -funbox-strict-fields -O2
+# -fsimpl-tick-factor=300  -fmax-simplifier-iterations=10 -fspecialise-aggressively -fexpose-all-unfoldings
 
 flags:
   arraychecks:
@@ -21,7 +22,7 @@ when:
   - condition: flag(stackchecks)
     cpp-options: -DSTACK_CHECK
   - condition: flag(dumpcore)
-    ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures # -dsuppress-type-applications -dsuppress-type-signatures
+    ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures -ddump-simpl-stats # -dsuppress-type-applications -dsuppress-type-signatures
 
 library:
   source-dirs: src
diff --git a/unison-runtime/src/Unison/Runtime/Machine.hs b/unison-runtime/src/Unison/Runtime/Machine.hs
index 444b588d9c..e0da7831a6 100644
--- a/unison-runtime/src/Unison/Runtime/Machine.hs
+++ b/unison-runtime/src/Unison/Runtime/Machine.hs
@@ -654,16 +654,15 @@ eval !env !denv !activeThreads !stk !k r (NMatch _mr i br) = do
   n <- peekOffN stk i
 
   eval env denv activeThreads stk k r $ selectBranch n br
-eval !_env !_denv !_activeThreads !_stk !_k _r (RMatch _i _pu _br) = do
-  pure ()
---   (t, stk) <- dumpDataNoTag Nothing stk =<< peekOff stk i
---   if t == PackedTag 0
---     then eval env denv activeThreads stk k r pu
---     else case ANF.unpackTags t of
---       (ANF.rawTag -> e, ANF.rawTag -> t)
---         | Just ebs <- EC.lookup e br ->
---             eval env denv activeThreads stk k r $ selectBranch t ebs
---         | otherwise -> unhandledErr "eval" env e
+eval !env !denv !activeThreads !stk !k r (RMatch i pu br) = do
+  (t, stk) <- dumpDataNoTag Nothing stk =<< peekOff stk i
+  if t == PackedTag 0
+    then eval env denv activeThreads stk k r pu
+    else case ANF.unpackTags t of
+      (ANF.rawTag -> e, ANF.rawTag -> t)
+        | Just ebs <- EC.lookup e br ->
+            eval env denv activeThreads stk k r $ selectBranch t ebs
+        | otherwise -> unhandledErr "eval" env e
 eval !env !denv !activeThreads !stk !k _ (Yield args)
   | asize stk > 0,
     VArg1 i <- args =
diff --git a/unison-runtime/unison-runtime.cabal b/unison-runtime/unison-runtime.cabal
index 08184c9bab..51c9340edf 100644
--- a/unison-runtime/unison-runtime.cabal
+++ b/unison-runtime/unison-runtime.cabal
@@ -87,7 +87,7 @@ library
       TypeApplications
       TypeFamilies
       ViewPatterns
-  ghc-options: -fmax-worker-args=100 -Wall -funbox-strict-fields -O2
+  ghc-options: -fsimpl-tick-factor=300 -fmax-simplifier-iterations=10 -fmax-worker-args=100 -Wall -funbox-strict-fields -fspecialise-aggressively -fexpose-all-unfoldings -O2
   build-depends:
       asn1-encoding
     , asn1-types
@@ -147,7 +147,7 @@ library
   if flag(stackchecks)
     cpp-options: -DSTACK_CHECK
   if flag(dumpcore)
-    ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures
+    ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures -ddump-simpl-stats
 
 test-suite runtime-tests
   type: exitcode-stdio-1.0
@@ -194,7 +194,7 @@ test-suite runtime-tests
       TypeApplications
       TypeFamilies
       ViewPatterns
-  ghc-options: -fmax-worker-args=100 -Wall -funbox-strict-fields -O2 -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0
+  ghc-options: -fsimpl-tick-factor=300 -fmax-simplifier-iterations=10 -fmax-worker-args=100 -Wall -funbox-strict-fields -fspecialise-aggressively -fexpose-all-unfoldings -O2 -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0
   build-depends:
       base
     , bytes
@@ -228,4 +228,4 @@ test-suite runtime-tests
   if flag(stackchecks)
     cpp-options: -DSTACK_CHECK
   if flag(dumpcore)
-    ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures
+    ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures -ddump-simpl-stats

From 73fbed48aa0947efb0e203c1d41312e1f8d50864 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 26 Nov 2024 12:47:28 -0800
Subject: [PATCH 06/12] Just replace the broken case with error

---
 unison-runtime/src/Unison/Runtime/Machine.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/unison-runtime/src/Unison/Runtime/Machine.hs b/unison-runtime/src/Unison/Runtime/Machine.hs
index e0da7831a6..6380a3680c 100644
--- a/unison-runtime/src/Unison/Runtime/Machine.hs
+++ b/unison-runtime/src/Unison/Runtime/Machine.hs
@@ -81,6 +81,7 @@ import Unison.Util.Bytes qualified as By
 import Unison.Util.EnumContainers as EC
 import Unison.Util.Monoid qualified as Monoid
 import Unison.Util.Pretty (toPlainUnbroken)
+import Unison.Util.Pretty qualified as P
 import Unison.Util.Text qualified as Util.Text
 import UnliftIO (IORef)
 import UnliftIO qualified
@@ -652,7 +653,6 @@ eval !env !denv !activeThreads !stk !k r (DMatch mr i br) = do
     selectBranch (maskTags t) br
 eval !env !denv !activeThreads !stk !k r (NMatch _mr i br) = do
   n <- peekOffN stk i
-
   eval env denv activeThreads stk k r $ selectBranch n br
 eval !env !denv !activeThreads !stk !k r (RMatch i pu br) = do
   (t, stk) <- dumpDataNoTag Nothing stk =<< peekOff stk i
@@ -662,7 +662,8 @@ eval !env !denv !activeThreads !stk !k r (RMatch i pu br) = do
       (ANF.rawTag -> e, ANF.rawTag -> t)
         | Just ebs <- EC.lookup e br ->
             eval env denv activeThreads stk k r $ selectBranch t ebs
-        | otherwise -> unhandledErr "eval" env e
+        | otherwise ->
+            error . show . PE undefined . P.lit . fromString $ "eval: unhandled ability request"
 eval !env !denv !activeThreads !stk !k _ (Yield args)
   | asize stk > 0,
     VArg1 i <- args =

From 930e5b43301b6f0a4f578ce3493db6cded1f06ce Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 26 Nov 2024 16:53:07 -0800
Subject: [PATCH 07/12] Inspection testing

---
 out                                                 |  0
 unison-runtime/package.yaml                         |  2 ++
 unison-runtime/src/Unison/Runtime/Machine.hs        |  5 +++++
 unison-runtime/src/Unison/Runtime/Stack.hs          |  6 ++++++
 unison-runtime/tests/Unison/Test/Runtime/Machine.hs | 13 +++++++++++++
 unison-runtime/unison-runtime.cabal                 |  7 +++++--
 6 files changed, 31 insertions(+), 2 deletions(-)
 create mode 100644 out
 create mode 100644 unison-runtime/tests/Unison/Test/Runtime/Machine.hs

diff --git a/out b/out
new file mode 100644
index 0000000000..e69de29bb2
diff --git a/unison-runtime/package.yaml b/unison-runtime/package.yaml
index 4dbde33972..d83585e046 100644
--- a/unison-runtime/package.yaml
+++ b/unison-runtime/package.yaml
@@ -105,11 +105,13 @@ tests:
       - filemanip
       - filepath
       - hex-text
+      - inspection-testing
       - lens
       - megaparsec
       - mtl
       - primitive
       - stm
+      - template-haskell
       - text
       - unison-core1
       - unison-hash
diff --git a/unison-runtime/src/Unison/Runtime/Machine.hs b/unison-runtime/src/Unison/Runtime/Machine.hs
index 6380a3680c..d349a77097 100644
--- a/unison-runtime/src/Unison/Runtime/Machine.hs
+++ b/unison-runtime/src/Unison/Runtime/Machine.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE MagicHash #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE UnboxedTuples #-}
 
 module Unison.Runtime.Machine
@@ -2536,3 +2537,7 @@ arrayCmp cmpVal l r =
     go i
       | i < 0 = EQ
       | otherwise = cmpVal (PA.indexArray l i) (PA.indexArray r i) <> go (i - 1)
+
+-- TI.inspect $ 'eval `TI.hasNoType` ''Stack
+
+-- TI.inspect $ hasNoAllocations 'eval
diff --git a/unison-runtime/src/Unison/Runtime/Stack.hs b/unison-runtime/src/Unison/Runtime/Stack.hs
index 4e297defd4..d2c7347d3c 100644
--- a/unison-runtime/src/Unison/Runtime/Stack.hs
+++ b/unison-runtime/src/Unison/Runtime/Stack.hs
@@ -135,6 +135,7 @@ module Unison.Runtime.Stack
     intTypeTag,
     charTypeTag,
     floatTypeTag,
+    hasNoAllocations,
   )
 where
 
@@ -145,6 +146,8 @@ import Data.Primitive.ByteArray qualified as BA
 import Data.Word
 import GHC.Base
 import GHC.Exts as L (IsList (..))
+import Language.Haskell.TH qualified as TH
+import Test.Inspection qualified as TI
 import Unison.Prelude
 import Unison.Reference (Reference)
 import Unison.Runtime.ANF (PackedTag)
@@ -1206,3 +1209,6 @@ contTermRefs f (Mark _ _ m k) =
 contTermRefs f (Push _ _ (CIx r _ _) _ _ k) =
   f r <> contTermRefs f k
 contTermRefs _ _ = mempty
+
+hasNoAllocations :: TH.Name -> TI.Obligation
+hasNoAllocations n = TI.mkObligation n TI.NoAllocation
diff --git a/unison-runtime/tests/Unison/Test/Runtime/Machine.hs b/unison-runtime/tests/Unison/Test/Runtime/Machine.hs
new file mode 100644
index 0000000000..943ca5b2a4
--- /dev/null
+++ b/unison-runtime/tests/Unison/Test/Runtime/Machine.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Unison.Test.Runtime.Machine () where
+
+import Language.Haskell.TH
+import Test.Inspection
+import Unison.Runtime.Machine (eval)
+import Unison.Runtime.Stack (Stack)
+
+inspect $ 'eval `hasNoType` ''Stack
+
+hasNoAllocations :: Name -> Name -> Obligation
+hasNoAllocations n tn = mkObligation n (NoTypes [tn])
diff --git a/unison-runtime/unison-runtime.cabal b/unison-runtime/unison-runtime.cabal
index 51c9340edf..2222f599bc 100644
--- a/unison-runtime/unison-runtime.cabal
+++ b/unison-runtime/unison-runtime.cabal
@@ -87,7 +87,7 @@ library
       TypeApplications
       TypeFamilies
       ViewPatterns
-  ghc-options: -fsimpl-tick-factor=300 -fmax-simplifier-iterations=10 -fmax-worker-args=100 -Wall -funbox-strict-fields -fspecialise-aggressively -fexpose-all-unfoldings -O2
+  ghc-options: -fmax-worker-args=100 -Wall -funbox-strict-fields -O2
   build-depends:
       asn1-encoding
     , asn1-types
@@ -158,6 +158,7 @@ test-suite runtime-tests
       Unison.Test.Runtime.ANF
       Unison.Test.Runtime.ANF.Serialization
       Unison.Test.Runtime.Crypto.Rsa
+      Unison.Test.Runtime.Machine
       Unison.Test.Runtime.MCode
       Unison.Test.Runtime.MCode.Serialization
       Unison.Test.UnisonSources
@@ -194,7 +195,7 @@ test-suite runtime-tests
       TypeApplications
       TypeFamilies
       ViewPatterns
-  ghc-options: -fsimpl-tick-factor=300 -fmax-simplifier-iterations=10 -fmax-worker-args=100 -Wall -funbox-strict-fields -fspecialise-aggressively -fexpose-all-unfoldings -O2 -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0
+  ghc-options: -fmax-worker-args=100 -Wall -funbox-strict-fields -O2 -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0
   build-depends:
       base
     , bytes
@@ -208,11 +209,13 @@ test-suite runtime-tests
     , filepath
     , hedgehog
     , hex-text
+    , inspection-testing
     , lens
     , megaparsec
     , mtl
     , primitive
     , stm
+    , template-haskell
     , text
     , unison-core1
     , unison-hash

From 7c0bbfe81b30eb8d4ff4e45880a3e6ad4499e2b1 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 26 Nov 2024 22:01:23 -0800
Subject: [PATCH 08/12] Get eval0 working without allocating any 'Stack'

---
 out                                           |  0
 unison-runtime/package.yaml                   |  2 +
 .../src/Unison/Runtime/Interface.hs           |  5 +-
 unison-runtime/src/Unison/Runtime/Machine.hs  | 58 ++++++++++++++++---
 unison-runtime/unison-runtime.cabal           |  2 +
 5 files changed, 56 insertions(+), 11 deletions(-)
 delete mode 100644 out

diff --git a/out b/out
deleted file mode 100644
index e69de29bb2..0000000000
diff --git a/unison-runtime/package.yaml b/unison-runtime/package.yaml
index d83585e046..f0c19da682 100644
--- a/unison-runtime/package.yaml
+++ b/unison-runtime/package.yaml
@@ -66,6 +66,8 @@ library:
     - tagged
     - temporary
     - text
+    - template-haskell
+    - inspection-testing
     - time
     - tls
     - unison-codebase-sqlite
diff --git a/unison-runtime/src/Unison/Runtime/Interface.hs b/unison-runtime/src/Unison/Runtime/Interface.hs
index a9103e1ec4..33619b22b0 100644
--- a/unison-runtime/src/Unison/Runtime/Interface.hs
+++ b/unison-runtime/src/Unison/Runtime/Interface.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UnboxedTuples #-}
 
 module Unison.Runtime.Interface
   ( startRuntime,
@@ -858,8 +859,8 @@ prepareEvaluation ppe tm ctx = do
       Just r -> r
       Nothing -> error "prepareEvaluation: could not remap main ref"
 
-watchHook :: IORef Val -> Stack -> IO ()
-watchHook r stk = peek stk >>= writeIORef r
+watchHook :: IORef Val -> XStack -> IO ()
+watchHook r xstk = peek (packXStack xstk) >>= writeIORef r
 
 backReferenceTm ::
   EnumMap Word64 Reference ->
diff --git a/unison-runtime/src/Unison/Runtime/Machine.hs b/unison-runtime/src/Unison/Runtime/Machine.hs
index d349a77097..310de9b379 100644
--- a/unison-runtime/src/Unison/Runtime/Machine.hs
+++ b/unison-runtime/src/Unison/Runtime/Machine.hs
@@ -37,11 +37,14 @@ import Data.Ord (comparing)
 import Data.Sequence qualified as Sq
 import Data.Set qualified as S
 import Data.Set qualified as Set
+import Data.Text (Text)
 import Data.Text qualified as DTx
 import Data.Text.IO qualified as Tx
 import Data.Traversable
 import GHC.Base (IO (..))
 import GHC.Conc as STM (unsafeIOToSTM)
+import GHC.Stack
+import Test.Inspection qualified as TI
 import Unison.Builtin.Decls (exceptionRef, ioFailureRef)
 import Unison.Builtin.Decls qualified as Rf
 import Unison.ConstructorReference qualified as CR
@@ -69,7 +72,6 @@ import Unison.Runtime.ANF as ANF
 import Unison.Runtime.ANF qualified as ANF
 import Unison.Runtime.Array as PA
 import Unison.Runtime.Builtin
-import Unison.Runtime.Exception
 import Unison.Runtime.Foreign
 import Unison.Runtime.Foreign.Function
 import Unison.Runtime.MCode
@@ -95,6 +97,13 @@ import System.IO.Unsafe (unsafePerformIO)
 #endif
 {- ORMOLU_ENABLE -}
 
+data RuntimeExn
+  = PE CallStack (P.Pretty P.ColorText)
+  | BU [(Reference, Int)] Text Val
+  deriving (Show)
+
+instance Exception RuntimeExn
+
 -- | A ref storing every currently active thread.
 -- This is helpful for cleaning up orphaned threads when the main process
 -- completes.
@@ -236,7 +245,7 @@ topDEnv _ _ _ = (mempty, id)
 -- This is the entry point actually used in the interactive
 -- environment currently.
 apply0 ::
-  Maybe (Stack -> IO ()) ->
+  Maybe (XStack -> IO ()) ->
   CCache ->
   ActiveThreads ->
   Word64 ->
@@ -258,7 +267,7 @@ apply0 !callback !env !threadTracker !i = do
     -- if it's cached, we can just finish
     CachedVal _ val -> bump stk >>= \stk -> poke stk val
   where
-    k0 = fromMaybe KE (callback <&> \cb -> CB . Hook $ \stk -> cb $ packXStack stk)
+    k0 = fromMaybe KE (callback <&> \cb -> CB . Hook $ \stk -> cb stk)
 
 -- Apply helper currently used for forking. Creates the new stacks
 -- necessary to evaluate a closure with the provided information.
@@ -508,7 +517,8 @@ exec !_ !denv !_activeThreads !stk !k _ (BPrim2 CMPU i j) = do
 exec !_ !_ !_activeThreads !stk !k r (BPrim2 THRO i j) = do
   name <- peekOffBi @Util.Text.Text stk i
   x <- peekOff stk j
-  throwIO (BU (traceK r k) (Util.Text.toText name) x)
+  () <- throwIO (BU (traceK r k) (Util.Text.toText name) x)
+  error "throwIO should never return"
 exec !env !denv !_activeThreads !stk !k _ (BPrim2 TRCE i j)
   | sandboxed env = die "attempted to use sandboxed operation: trace"
   | otherwise = do
@@ -2105,8 +2115,8 @@ preEvalTopLevelConstants cacheableCombs newCombs cc = do
   activeThreads <- Just <$> UnliftIO.newIORef mempty
   evaluatedCacheableCombsVar <- newTVarIO mempty
   for_ (EC.mapToList cacheableCombs) \(w, _) -> do
-    let hook stk = do
-          val <- peek stk
+    let hook xstk = do
+          val <- peek (packXStack xstk)
           atomically $ do
             modifyTVar evaluatedCacheableCombsVar $ EC.mapInsert w (EC.mapSingleton 0 $ CachedVal w val)
     apply0 (Just hook) cc activeThreads w
@@ -2538,6 +2548,36 @@ arrayCmp cmpVal l r =
       | i < 0 = EQ
       | otherwise = cmpVal (PA.indexArray l i) (PA.indexArray r i) <> go (i - 1)
 
--- TI.inspect $ 'eval `TI.hasNoType` ''Stack
-
--- TI.inspect $ hasNoAllocations 'eval
+die :: (HasCallStack) => String -> IO a
+die s = do
+  void . throwIO . PE callStack . P.lit . fromString $ s
+  -- This is unreachable, but we need it to fix some quirks in GHC's
+  -- worker/wrapper optimization, specifically, it seems that when throwIO's polymorphic return
+  -- value is specialized to a type like 'Stack' which we want GHC to unbox, it will sometimes
+  -- fail to unbox it, possibly because it can't unbox it when it's strictly a type application.
+  -- For whatever reason, this seems to fix it while still allowing us to throw exceptions in IO
+  -- like we prefer.
+  pure $ error "unreachable"
+{-# INLINE die #-}
+
+-- Assert that we don't allocate any 'Stack' objects in 'eval', since we expect GHC to always
+-- trigger the worker/wrapper optimization and unbox it fully, and if it fails to do so, we want to
+-- know about it.
+--
+-- Note: We _must_ check 'eval0' instead of 'eval' here because if you simply check 'eval', you'll be
+-- testing the 'wrapper' part of the worker/wrapper, which will always mention the 'Stack' object as part of its
+-- unwrapping, and since there's  no way to refer to the generated wrapper directly, we instead refer to 'eval0'
+-- which allocates its own stack to pass in, meaning it's one level above the wrapper, and GHC should always detect that
+-- it can call the worker directly without using the wrapper.
+-- See: https://github.com/nomeata/inspection-testing/issues/50 for more information.
+--
+-- If this test starts failing, here are some things you can check.
+--
+-- 1. Are 'Stack's being passed to dynamic functions? If so, try changing those functions to take an 'XStack' instead,
+--    and manually unpack/pack the 'Stack' where necessary.
+-- 2. Are there calls to 'die' or 'throwIO' or something similar in which a fully polymorphic type variable is being
+--    specialized to 'Stack'? Sometimes this trips up the optimization, you can try using an 'error' instead, or even
+--    following the 'throwIO' with a useless call to @error "unreachable"@, this seems to help for some reason.
+--
+-- Best of luck!
+TI.inspect $ 'eval0 `TI.hasNoType` ''Stack
diff --git a/unison-runtime/unison-runtime.cabal b/unison-runtime/unison-runtime.cabal
index 2222f599bc..f6b622cff3 100644
--- a/unison-runtime/unison-runtime.cabal
+++ b/unison-runtime/unison-runtime.cabal
@@ -109,6 +109,7 @@ library
     , directory
     , exceptions
     , filepath
+    , inspection-testing
     , iproute
     , lens
     , memory
@@ -125,6 +126,7 @@ library
     , safe-exceptions
     , stm
     , tagged
+    , template-haskell
     , temporary
     , text
     , time

From 73c1b9d2875409c98eb51fa6e2d7d1946730b08c Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 26 Nov 2024 22:21:32 -0800
Subject: [PATCH 09/12] Hide inspection testing behind build flag

---
 unison-runtime/package.yaml                  |  3 +++
 unison-runtime/src/Unison/Runtime/Machine.hs | 10 +++++++++-
 2 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/unison-runtime/package.yaml b/unison-runtime/package.yaml
index f0c19da682..aa8a9713a1 100644
--- a/unison-runtime/package.yaml
+++ b/unison-runtime/package.yaml
@@ -21,6 +21,9 @@ when:
     cpp-options: -DARRAY_CHECK
   - condition: flag(stackchecks)
     cpp-options: -DSTACK_CHECK
+    # Run optimization assertion tests, make sure this runs with O2
+  - condition: flag(optchecks)
+    ghc-options: -O2 -DOPT_CHECK
   - condition: flag(dumpcore)
     ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures -ddump-simpl-stats # -dsuppress-type-applications -dsuppress-type-signatures
 
diff --git a/unison-runtime/src/Unison/Runtime/Machine.hs b/unison-runtime/src/Unison/Runtime/Machine.hs
index 310de9b379..1a779055ab 100644
--- a/unison-runtime/src/Unison/Runtime/Machine.hs
+++ b/unison-runtime/src/Unison/Runtime/Machine.hs
@@ -44,7 +44,6 @@ import Data.Traversable
 import GHC.Base (IO (..))
 import GHC.Conc as STM (unsafeIOToSTM)
 import GHC.Stack
-import Test.Inspection qualified as TI
 import Unison.Builtin.Decls (exceptionRef, ioFailureRef)
 import Unison.Builtin.Decls qualified as Rf
 import Unison.ConstructorReference qualified as CR
@@ -95,6 +94,10 @@ import UnliftIO.Concurrent qualified as UnliftIO
 import Unison.Debug qualified as Debug
 import System.IO.Unsafe (unsafePerformIO)
 #endif
+
+#ifdef OPT_CHECK
+import Test.Inspection qualified as TI
+#endif
 {- ORMOLU_ENABLE -}
 
 data RuntimeExn
@@ -2560,6 +2563,8 @@ die s = do
   pure $ error "unreachable"
 {-# INLINE die #-}
 
+{- ORMOLU_DISABLE -}
+#ifdef OPT_CHECK
 -- Assert that we don't allocate any 'Stack' objects in 'eval', since we expect GHC to always
 -- trigger the worker/wrapper optimization and unbox it fully, and if it fails to do so, we want to
 -- know about it.
@@ -2573,6 +2578,7 @@ die s = do
 --
 -- If this test starts failing, here are some things you can check.
 --
+-- 1. Did you manually
 -- 1. Are 'Stack's being passed to dynamic functions? If so, try changing those functions to take an 'XStack' instead,
 --    and manually unpack/pack the 'Stack' where necessary.
 -- 2. Are there calls to 'die' or 'throwIO' or something similar in which a fully polymorphic type variable is being
@@ -2581,3 +2587,5 @@ die s = do
 --
 -- Best of luck!
 TI.inspect $ 'eval0 `TI.hasNoType` ''Stack
+#endif
+{- ORMOLU_ENABLE -}

From e2b8302b3227e5cf2cb21533b4a5100c6080558a Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 26 Nov 2024 22:24:37 -0800
Subject: [PATCH 10/12] Wire up inspection testing into CI

---
 .github/workflows/bundle-ucm.yaml   |  1 +
 unison-runtime/package.yaml         | 11 +++++++++--
 unison-runtime/unison-runtime.cabal | 10 ++++++++++
 3 files changed, 20 insertions(+), 2 deletions(-)

diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml
index bd05781b39..e97da0292a 100644
--- a/.github/workflows/bundle-ucm.yaml
+++ b/.github/workflows/bundle-ucm.yaml
@@ -59,6 +59,7 @@ jobs:
                 --ghc-options='-O2' \
                 --local-bin-path ucm-bin \
                 --copy-bins \
+                --flag unison-runtime:optchecks \
                 && break;
           done
 
diff --git a/unison-runtime/package.yaml b/unison-runtime/package.yaml
index aa8a9713a1..8d874dfe1f 100644
--- a/unison-runtime/package.yaml
+++ b/unison-runtime/package.yaml
@@ -12,6 +12,13 @@ flags:
   stackchecks:
     manual: true
     default: false
+
+  # Run optimization assertion tests, make sure this runs with O2
+  optchecks:
+    manual: true
+    default: false
+
+  # Dumps core for debugging to unison-runtime/.stack-work/dist/<arch>/ghc-x.y.z/build/
   dumpcore:
     manual: true
     default: false
@@ -21,9 +28,9 @@ when:
     cpp-options: -DARRAY_CHECK
   - condition: flag(stackchecks)
     cpp-options: -DSTACK_CHECK
-    # Run optimization assertion tests, make sure this runs with O2
   - condition: flag(optchecks)
-    ghc-options: -O2 -DOPT_CHECK
+    ghc-options: -O2
+    cpp-options: -DOPT_CHECK
   - condition: flag(dumpcore)
     ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures -ddump-simpl-stats # -dsuppress-type-applications -dsuppress-type-signatures
 
diff --git a/unison-runtime/unison-runtime.cabal b/unison-runtime/unison-runtime.cabal
index f6b622cff3..b908088591 100644
--- a/unison-runtime/unison-runtime.cabal
+++ b/unison-runtime/unison-runtime.cabal
@@ -25,6 +25,10 @@ flag dumpcore
   manual: True
   default: False
 
+flag optchecks
+  manual: True
+  default: False
+
 flag stackchecks
   manual: True
   default: False
@@ -148,6 +152,9 @@ library
     cpp-options: -DARRAY_CHECK
   if flag(stackchecks)
     cpp-options: -DSTACK_CHECK
+  if flag(optchecks)
+    ghc-options: -O2
+    cpp-options: -DOPT_CHECK
   if flag(dumpcore)
     ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures -ddump-simpl-stats
 
@@ -232,5 +239,8 @@ test-suite runtime-tests
     cpp-options: -DARRAY_CHECK
   if flag(stackchecks)
     cpp-options: -DSTACK_CHECK
+  if flag(optchecks)
+    ghc-options: -O2
+    cpp-options: -DOPT_CHECK
   if flag(dumpcore)
     ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures -ddump-simpl-stats

From deb544cad2213cd2305bd297b9efd2ba0d6ddb03 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 26 Nov 2024 22:51:14 -0800
Subject: [PATCH 11/12] Only include inspection testing when used

---
 unison-runtime/package.yaml                         |  3 ++-
 unison-runtime/tests/Unison/Test/Runtime/Machine.hs | 13 -------------
 unison-runtime/unison-runtime.cabal                 |  6 ++++--
 3 files changed, 6 insertions(+), 16 deletions(-)
 delete mode 100644 unison-runtime/tests/Unison/Test/Runtime/Machine.hs

diff --git a/unison-runtime/package.yaml b/unison-runtime/package.yaml
index 8d874dfe1f..848b2d7d16 100644
--- a/unison-runtime/package.yaml
+++ b/unison-runtime/package.yaml
@@ -31,6 +31,8 @@ when:
   - condition: flag(optchecks)
     ghc-options: -O2
     cpp-options: -DOPT_CHECK
+    dependencies:
+      - inspection-testing
   - condition: flag(dumpcore)
     ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures -ddump-simpl-stats # -dsuppress-type-applications -dsuppress-type-signatures
 
@@ -117,7 +119,6 @@ tests:
       - filemanip
       - filepath
       - hex-text
-      - inspection-testing
       - lens
       - megaparsec
       - mtl
diff --git a/unison-runtime/tests/Unison/Test/Runtime/Machine.hs b/unison-runtime/tests/Unison/Test/Runtime/Machine.hs
deleted file mode 100644
index 943ca5b2a4..0000000000
--- a/unison-runtime/tests/Unison/Test/Runtime/Machine.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Unison.Test.Runtime.Machine () where
-
-import Language.Haskell.TH
-import Test.Inspection
-import Unison.Runtime.Machine (eval)
-import Unison.Runtime.Stack (Stack)
-
-inspect $ 'eval `hasNoType` ''Stack
-
-hasNoAllocations :: Name -> Name -> Obligation
-hasNoAllocations n tn = mkObligation n (NoTypes [tn])
diff --git a/unison-runtime/unison-runtime.cabal b/unison-runtime/unison-runtime.cabal
index b908088591..7317a9b728 100644
--- a/unison-runtime/unison-runtime.cabal
+++ b/unison-runtime/unison-runtime.cabal
@@ -155,6 +155,8 @@ library
   if flag(optchecks)
     ghc-options: -O2
     cpp-options: -DOPT_CHECK
+    build-depends:
+        inspection-testing
   if flag(dumpcore)
     ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures -ddump-simpl-stats
 
@@ -167,7 +169,6 @@ test-suite runtime-tests
       Unison.Test.Runtime.ANF
       Unison.Test.Runtime.ANF.Serialization
       Unison.Test.Runtime.Crypto.Rsa
-      Unison.Test.Runtime.Machine
       Unison.Test.Runtime.MCode
       Unison.Test.Runtime.MCode.Serialization
       Unison.Test.UnisonSources
@@ -218,7 +219,6 @@ test-suite runtime-tests
     , filepath
     , hedgehog
     , hex-text
-    , inspection-testing
     , lens
     , megaparsec
     , mtl
@@ -242,5 +242,7 @@ test-suite runtime-tests
   if flag(optchecks)
     ghc-options: -O2
     cpp-options: -DOPT_CHECK
+    build-depends:
+        inspection-testing
   if flag(dumpcore)
     ghc-options: -ddump-simpl -ddump-stg-final -ddump-to-file -dsuppress-coercions -dsuppress-idinfo -dsuppress-module-prefixes -ddump-str-signatures -ddump-simpl-stats

From cc68b25ada5714754ee8547776bca709080c38bf Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 26 Nov 2024 23:07:03 -0800
Subject: [PATCH 12/12] PR Cleanup

---
 unison-runtime/package.yaml                   |  2 --
 .../src/Unison/Runtime/Exception.hs           |  6 ++---
 unison-runtime/src/Unison/Runtime/Machine.hs  | 22 +++++++++----------
 unison-runtime/unison-runtime.cabal           |  1 -
 4 files changed, 13 insertions(+), 18 deletions(-)

diff --git a/unison-runtime/package.yaml b/unison-runtime/package.yaml
index 848b2d7d16..4cf83f10c9 100644
--- a/unison-runtime/package.yaml
+++ b/unison-runtime/package.yaml
@@ -3,7 +3,6 @@ github: unisonweb/unison
 copyright: Copyright (C) 2013-2024 Unison Computing, PBC and contributors
 
 ghc-options: -fmax-worker-args=100 -Wall -funbox-strict-fields -O2
-# -fsimpl-tick-factor=300  -fmax-simplifier-iterations=10 -fspecialise-aggressively -fexpose-all-unfoldings
 
 flags:
   arraychecks:
@@ -124,7 +123,6 @@ tests:
       - mtl
       - primitive
       - stm
-      - template-haskell
       - text
       - unison-core1
       - unison-hash
diff --git a/unison-runtime/src/Unison/Runtime/Exception.hs b/unison-runtime/src/Unison/Runtime/Exception.hs
index 75d63ee75e..2e79c163bd 100644
--- a/unison-runtime/src/Unison/Runtime/Exception.hs
+++ b/unison-runtime/src/Unison/Runtime/Exception.hs
@@ -23,12 +23,12 @@ instance Exception RuntimeExn
 
 die :: (HasCallStack) => String -> IO a
 die = throwIO . PE callStack . P.lit . fromString
-{-# INLINEABLE die #-}
+{-# INLINE die #-}
 
 dieP :: (HasCallStack) => P.Pretty P.ColorText -> IO a
 dieP = throwIO . PE callStack
-{-# INLINEABLE dieP #-}
+{-# INLINE dieP #-}
 
 exn :: (HasCallStack) => String -> a
 exn = throw . PE callStack . P.lit . fromString
-{-# INLINEABLE exn #-}
+{-# INLINE exn #-}
diff --git a/unison-runtime/src/Unison/Runtime/Machine.hs b/unison-runtime/src/Unison/Runtime/Machine.hs
index 1a779055ab..e287d2b90c 100644
--- a/unison-runtime/src/Unison/Runtime/Machine.hs
+++ b/unison-runtime/src/Unison/Runtime/Machine.hs
@@ -37,7 +37,6 @@ import Data.Ord (comparing)
 import Data.Sequence qualified as Sq
 import Data.Set qualified as S
 import Data.Set qualified as Set
-import Data.Text (Text)
 import Data.Text qualified as DTx
 import Data.Text.IO qualified as Tx
 import Data.Traversable
@@ -71,6 +70,7 @@ import Unison.Runtime.ANF as ANF
 import Unison.Runtime.ANF qualified as ANF
 import Unison.Runtime.Array as PA
 import Unison.Runtime.Builtin
+import Unison.Runtime.Exception (RuntimeExn (..))
 import Unison.Runtime.Foreign
 import Unison.Runtime.Foreign.Function
 import Unison.Runtime.MCode
@@ -100,13 +100,6 @@ import Test.Inspection qualified as TI
 #endif
 {- ORMOLU_ENABLE -}
 
-data RuntimeExn
-  = PE CallStack (P.Pretty P.ColorText)
-  | BU [(Reference, Int)] Text Val
-  deriving (Show)
-
-instance Exception RuntimeExn
-
 -- | A ref storing every currently active thread.
 -- This is helpful for cleaning up orphaned threads when the main process
 -- completes.
@@ -676,8 +669,7 @@ eval !env !denv !activeThreads !stk !k r (RMatch i pu br) = do
       (ANF.rawTag -> e, ANF.rawTag -> t)
         | Just ebs <- EC.lookup e br ->
             eval env denv activeThreads stk k r $ selectBranch t ebs
-        | otherwise ->
-            error . show . PE undefined . P.lit . fromString $ "eval: unhandled ability request"
+        | otherwise -> unhandledAbilityRequest
 eval !env !denv !activeThreads !stk !k _ (Yield args)
   | asize stk > 0,
     VArg1 i <- args =
@@ -710,6 +702,9 @@ eval !_ !_ !_ !_activeThreads !_ _ Exit = pure ()
 eval !_ !_ !_ !_activeThreads !_ _ (Die s) = die s
 {-# NOINLINE eval #-}
 
+unhandledAbilityRequest :: (HasCallStack) => IO a
+unhandledAbilityRequest = error . show . PE callStack . P.lit . fromString $ "eval: unhandled ability request"
+
 forkEval :: CCache -> ActiveThreads -> Val -> IO ThreadId
 forkEval env activeThreads clo =
   do
@@ -2560,7 +2555,7 @@ die s = do
   -- fail to unbox it, possibly because it can't unbox it when it's strictly a type application.
   -- For whatever reason, this seems to fix it while still allowing us to throw exceptions in IO
   -- like we prefer.
-  pure $ error "unreachable"
+  error "unreachable"
 {-# INLINE die #-}
 
 {- ORMOLU_DISABLE -}
@@ -2569,6 +2564,9 @@ die s = do
 -- trigger the worker/wrapper optimization and unbox it fully, and if it fails to do so, we want to
 -- know about it.
 --
+-- Note: this must remain in this module, it can't be moved to a testing module, this is a requirement of the inspection
+-- testing library.
+--
 -- Note: We _must_ check 'eval0' instead of 'eval' here because if you simply check 'eval', you'll be
 -- testing the 'wrapper' part of the worker/wrapper, which will always mention the 'Stack' object as part of its
 -- unwrapping, and since there's  no way to refer to the generated wrapper directly, we instead refer to 'eval0'
@@ -2578,12 +2576,12 @@ die s = do
 --
 -- If this test starts failing, here are some things you can check.
 --
--- 1. Did you manually
 -- 1. Are 'Stack's being passed to dynamic functions? If so, try changing those functions to take an 'XStack' instead,
 --    and manually unpack/pack the 'Stack' where necessary.
 -- 2. Are there calls to 'die' or 'throwIO' or something similar in which a fully polymorphic type variable is being
 --    specialized to 'Stack'? Sometimes this trips up the optimization, you can try using an 'error' instead, or even
 --    following the 'throwIO' with a useless call to @error "unreachable"@, this seems to help for some reason.
+--    See this page for more info on precise exceptions: https://gitlab.haskell.org/ghc/ghc/-/wikis/exceptions/precise-exceptions
 --
 -- Best of luck!
 TI.inspect $ 'eval0 `TI.hasNoType` ''Stack
diff --git a/unison-runtime/unison-runtime.cabal b/unison-runtime/unison-runtime.cabal
index 7317a9b728..0477ee1bf5 100644
--- a/unison-runtime/unison-runtime.cabal
+++ b/unison-runtime/unison-runtime.cabal
@@ -224,7 +224,6 @@ test-suite runtime-tests
     , mtl
     , primitive
     , stm
-    , template-haskell
     , text
     , unison-core1
     , unison-hash