{-# LANGUAGE LambdaCase #-}

-- | Deciding, before compiling a function, whether native code for it
-- would be faster than the interpreter. See design.md, "What isn't
-- compiled".
--
-- What compiling saves is the interpreter's overhead (dispatch and stack
-- traffic), a few nanoseconds per instruction; the instruction's own work
-- costs the same either way. What it can cost is exits: leaving native
-- code for something only the interpreter can do, and coming back, is a
-- round trip worth several instructions' savings. So a function that does
-- one foreign call and little else is slower compiled.
--
-- The estimate walks the function's MCode and computes, for an average
-- path from entry to return, the saving (in units of one simple
-- instruction's overhead) and the number of exits that are certain: taken
-- every time the code runs. Exits that only happen on a slow path (a fast
-- path's miss, the poll, stack growth) don't count.
module Unison.Runtime.JIT.Estimate
  ( Estimate (..),
    judge,
  )
where

import Control.Monad (unless, when)
import Data.IORef
import Data.Map.Strict qualified as Map
import Data.Maybe (catMaybes)
import Data.Set qualified as Set
import Foreign.Ptr (Ptr)
import Unison.Runtime.JIT.Codegen (Switches (..), callOutWorthwhile, instrNativeIn, startsSupported, switches)
import Unison.Runtime.JIT.Config (Config, entryCost, exitCost)
import Unison.Runtime.MCode hiding (Env)
import Unison.Runtime.MCode qualified as MCode (GRef (Env))
import Unison.Runtime.Stack (MSection, Val)
import Unison.Util.EnumContainers qualified as EC

-- | For an average path through a function: the interpreter overhead that
-- native code avoids, and the exits it is certain to take.
data Estimate = Estimate
  { Estimate -> Double
esSaving :: !Double,
    Estimate -> Double
esExits :: !Double,
    -- | the path calls the function itself: it is a loop or a recursion
    Estimate -> Bool
esRec :: !Bool
  }

plus :: Estimate -> Estimate -> Estimate
plus :: Estimate -> Estimate -> Estimate
plus (Estimate Double
a Double
b Bool
l) (Estimate Double
c Double
d Bool
m) = Double -> Double -> Bool -> Estimate
Estimate (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
c) (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
d) (Bool
l Bool -> Bool -> Bool
|| Bool
m)

-- | The interpreter's overhead for an instruction or a branch, and for a
-- call or a let (a frame pushed, arguments moved).
simple, call :: Estimate
simple :: Estimate
simple = Double -> Double -> Bool -> Estimate
Estimate Double
1 Double
0 Bool
False
call :: Estimate
call = Double -> Double -> Bool -> Estimate
Estimate Double
3 Double
0 Bool
False

-- | A certain exit. The node saves nothing: the interpreter does its work.
exit :: Estimate
exit :: Estimate
exit = Double -> Double -> Bool -> Estimate
Estimate Double
0 Double
1 Bool
False

worth :: Config -> Maybe Estimate -> Bool
worth :: Config -> Maybe Estimate -> Bool
worth Config
config = \case
  Maybe Estimate
Nothing -> Bool
True -- never returns; it doesn't matter
  Just (Estimate Double
saving Double
exits Bool
_) -> Bool -> Bool
not (Double
exits Double -> Double -> Double
forall a. Num a => a -> a -> a
* Config -> Double
exitCost Config
config Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
saving)

-- | How likely a call of the function is to exit, as far as is known: its
-- certain exits on an average path, at most one.
exiting :: Maybe Estimate -> Double
exiting :: Maybe Estimate -> Double
exiting = Double -> (Estimate -> Double) -> Maybe Estimate -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
1 (Double -> Double) -> (Estimate -> Double) -> Estimate -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate -> Double
esExits)

-- | What is recorded in the cell (see 'readNativeVerdict'). The low two
-- bits: 2 not worth compiling, 1 worth it, 3 worth it only for native
-- callers, because a call saves less than entering native code from the
-- interpreter costs. Above them, 'exiting' in hundredths.
verdictOf :: Config -> Maybe Estimate -> Int
verdictOf :: Config -> Maybe Estimate -> Int
verdictOf Config
config Maybe Estimate
path = Int
code Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Maybe Estimate -> Double
exiting Maybe Estimate
path)
  where
    code :: Int
code
      | Bool -> Bool
not (Config -> Maybe Estimate -> Bool
worth Config
config Maybe Estimate
path) = Int
2
      | Just (Estimate Double
saving Double
_ Bool
False) <- Maybe Estimate
path, Double
saving Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Config -> Double
entryCost Config
config = Int
3
      | Bool
otherwise = Int
1

data Cx = Cx
  { Cx -> Config
cxConfig :: Config,
    Cx -> Switches
cxSwitches :: Switches,
    Cx -> Ptr NativeCell
cxSelf :: Ptr NativeCell,
    -- | how likely a call of the function itself is to exit (from a first
    -- pass that assumed it doesn't)
    Cx -> Double
cxSelfExits :: Double,
    -- | the functions being judged further up: a cycle is assumed native
    Cx -> Set (Ptr NativeCell)
cxBusy :: Set.Set (Ptr NativeCell),
    -- | set when the result relied on that assumption
    Cx -> IORef Bool
cxTainted :: IORef Bool,
    -- | what was found out during this walk, final or not: whether each
    -- callee is worth compiling, and how likely a call of it is to exit
    Cx -> IORef (Map (Ptr NativeCell) (Bool, Double))
cxMemo :: IORef (Map.Map (Ptr NativeCell) (Bool, Double))
  }

-- | Whether the function in this cell, with this body, is worth compiling,
-- and the estimate that says so (Nothing for code that never returns).
-- The verdict is recorded in the cell. Callees that have not been judged
-- are judged on the way, and their verdicts recorded too, so the answer
-- doesn't depend on the order in which functions get hot.
judge :: Config -> Ptr NativeCell -> MSection -> IO (Bool, Maybe Estimate)
judge :: Config -> Ptr NativeCell -> MSection -> IO (Bool, Maybe Estimate)
judge Config
config Ptr NativeCell
cell MSection
sect = do
  IORef (Map (Ptr NativeCell) (Bool, Double))
memo <- Map (Ptr NativeCell) (Bool, Double)
-> IO (IORef (Map (Ptr NativeCell) (Bool, Double)))
forall a. a -> IO (IORef a)
newIORef Map (Ptr NativeCell) (Bool, Double)
forall k a. Map k a
Map.empty
  IORef Bool
tainted <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  Maybe Estimate
path <- Cx -> MSection -> IO (Maybe Estimate)
function (Config
-> Switches
-> Ptr NativeCell
-> Double
-> Set (Ptr NativeCell)
-> IORef Bool
-> IORef (Map (Ptr NativeCell) (Bool, Double))
-> Cx
Cx Config
config (Config -> Switches
switches Config
config) Ptr NativeCell
cell Double
0 Set (Ptr NativeCell)
forall a. Set a
Set.empty IORef Bool
tainted IORef (Map (Ptr NativeCell) (Bool, Double))
memo) MSection
sect
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ptr NativeCell
cell Ptr NativeCell -> Ptr NativeCell -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr NativeCell
noNativeCell) (Ptr NativeCell -> Int -> IO ()
writeNativeVerdict Ptr NativeCell
cell (Config -> Maybe Estimate -> Int
verdictOf Config
config Maybe Estimate
path))
  pure (Config -> Maybe Estimate -> Bool
worth Config
config Maybe Estimate
path, Maybe Estimate
path)

-- | The estimate for a whole function. A function that calls itself is
-- walked twice: the first walk finds how likely a call of it is to exit,
-- and the second counts that against each of its calls to itself.
function :: Cx -> MSection -> IO (Maybe Estimate)
function :: Cx -> MSection -> IO (Maybe Estimate)
function Cx
cx MSection
sect = do
  Maybe Estimate
first <- Cx -> MSection -> IO (Maybe Estimate)
walk Cx
cx {cxSelfExits = 0} MSection
sect
  case Maybe Estimate
first of
    Just (Estimate Double
_ Double
exits Bool
True) | Double
exits Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 -> Cx -> MSection -> IO (Maybe Estimate)
walk Cx
cx {cxSelfExits = min 1 exits} MSection
sect
    Maybe Estimate
_ -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Estimate
first

-- | Whether a call to this combinator stays in native code, and if it
-- does, how likely the callee is to exit before it returns.
native :: Cx -> RComb Val -> IO (Bool, Double)
native :: Cx -> RComb Val -> IO (Bool, Double)
native Cx
cx RComb Val
comb = case RComb Val -> GComb Val (RComb Val)
forall val. RComb val -> GComb val (RComb val)
unRComb RComb Val
comb of
  CachedVal {} -> (Bool, Double) -> IO (Bool, Double)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, Double
0)
  Comb (LamI Int
_ Int
_ MSection
entry Ptr NativeCell
cell)
    -- code not loaded through the cache: never compiled
    | Ptr NativeCell
cell Ptr NativeCell -> Ptr NativeCell -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr NativeCell
noNativeCell -> (Bool, Double) -> IO (Bool, Double)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, Double
0)
    | Ptr NativeCell
cell Ptr NativeCell -> Ptr NativeCell -> Bool
forall a. Eq a => a -> a -> Bool
== Cx -> Ptr NativeCell
cxSelf Cx
cx -> (Bool, Double) -> IO (Bool, Double)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
True, Cx -> Double
cxSelfExits Cx
cx)
    | Ptr NativeCell -> Set (Ptr NativeCell) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Ptr NativeCell
cell (Cx -> Set (Ptr NativeCell)
cxBusy Cx
cx) -> IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Cx -> IORef Bool
cxTainted Cx
cx) Bool
True IO () -> IO (Bool, Double) -> IO (Bool, Double)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Bool, Double) -> IO (Bool, Double)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
True, Double
0)
    | Bool
otherwise -> do
        Int
verdict <- Ptr NativeCell -> IO Int
readNativeVerdict Ptr NativeCell
cell
        Maybe (Bool, Double)
known <- Ptr NativeCell
-> Map (Ptr NativeCell) (Bool, Double) -> Maybe (Bool, Double)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ptr NativeCell
cell (Map (Ptr NativeCell) (Bool, Double) -> Maybe (Bool, Double))
-> IO (Map (Ptr NativeCell) (Bool, Double))
-> IO (Maybe (Bool, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Map (Ptr NativeCell) (Bool, Double))
-> IO (Map (Ptr NativeCell) (Bool, Double))
forall a. IORef a -> IO a
readIORef (Cx -> IORef (Map (Ptr NativeCell) (Bool, Double))
cxMemo Cx
cx)
        case (Maybe (Bool, Double)
known, Int
verdict) of
          (Just (Bool, Double)
v, Int
_) -> (Bool, Double) -> IO (Bool, Double)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool, Double)
v
          (Maybe (Bool, Double)
_, Int
0) -> do
            IORef Bool
tainted <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
            Maybe Estimate
path <- Cx -> MSection -> IO (Maybe Estimate)
function Cx
cx {cxSelf = cell, cxBusy = Set.insert (cxSelf cx) (cxBusy cx), cxTainted = tainted} MSection
entry
            let v :: (Bool, Double)
v = (Config -> Maybe Estimate -> Bool
worth (Cx -> Config
cxConfig Cx
cx) Maybe Estimate
path, Maybe Estimate -> Double
exiting Maybe Estimate
path)
            Bool
t <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
tainted
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
t (IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Cx -> IORef Bool
cxTainted Cx
cx) Bool
True)
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
t (Ptr NativeCell -> Int -> IO ()
writeNativeVerdict Ptr NativeCell
cell (Config -> Maybe Estimate -> Int
verdictOf (Cx -> Config
cxConfig Cx
cx) Maybe Estimate
path))
            IORef (Map (Ptr NativeCell) (Bool, Double))
-> (Map (Ptr NativeCell) (Bool, Double)
    -> Map (Ptr NativeCell) (Bool, Double))
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Cx -> IORef (Map (Ptr NativeCell) (Bool, Double))
cxMemo Cx
cx) (Ptr NativeCell
-> (Bool, Double)
-> Map (Ptr NativeCell) (Bool, Double)
-> Map (Ptr NativeCell) (Bool, Double)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ptr NativeCell
cell (Bool, Double)
v)
            pure (Bool, Double)
v
          (Maybe (Bool, Double), Int)
_ -> (Bool, Double) -> IO (Bool, Double)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
verdict Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
2, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
verdict Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100)

-- | The estimate for the paths through a section, following what the code
-- generator does with each node ('genSection'). Nothing: no path returns.
walk :: Cx -> MSection -> IO (Maybe Estimate)
walk :: Cx -> MSection -> IO (Maybe Estimate)
walk Cx
cx = \case
  Yield Args
_ -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just Estimate
simple)
  Die String
_ -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Estimate
forall a. Maybe a
Nothing
  MSection
Exit -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Estimate
forall a. Maybe a
Nothing
  Ins GInstr (RComb Val)
i MSection
rest
    | Switches -> GInstr (RComb Val) -> MSection -> Bool
instrNativeIn (Cx -> Switches
cxSwitches Cx
cx) GInstr (RComb Val)
i MSection
rest -> (Estimate -> Estimate) -> Maybe Estimate -> Maybe Estimate
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Estimate -> Estimate -> Estimate
plus Estimate
simple) (Maybe Estimate -> Maybe Estimate)
-> IO (Maybe Estimate) -> IO (Maybe Estimate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cx -> MSection -> IO (Maybe Estimate)
walk Cx
cx MSection
rest
    -- a call-out: the interpreter runs the instruction, native code goes on
    | Just Int
_ <- GInstr (RComb Val) -> Maybe Int
forall comb. GInstr comb -> Maybe Int
pushCount GInstr (RComb Val)
i, GInstr (RComb Val) -> MSection -> Bool
callOutWorthwhile GInstr (RComb Val)
i MSection
rest -> (Estimate -> Estimate) -> Maybe Estimate -> Maybe Estimate
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Estimate -> Estimate -> Estimate
plus Estimate
exit) (Maybe Estimate -> Maybe Estimate)
-> IO (Maybe Estimate) -> IO (Maybe Estimate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cx -> MSection -> IO (Maybe Estimate)
walk Cx
cx MSection
rest
    -- the interpreter takes the rest of the function
    | Bool
otherwise -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just Estimate
exit)
  Match Int
_ GBranch (RComb Val)
br -> GBranch (RComb Val) -> IO (Maybe Estimate)
branch GBranch (RComb Val)
br
  NMatch Maybe Reference
_ Int
_ GBranch (RComb Val)
br -> GBranch (RComb Val) -> IO (Maybe Estimate)
branch GBranch (RComb Val)
br
  DMatch Maybe Reference
_ Int
_ GBranch (RComb Val)
br -> GBranch (RComb Val) -> IO (Maybe Estimate)
branch GBranch (RComb Val)
br
  Call Bool
_ CombIx
_ RComb Val
comb Args
args
    | RComb Val -> Args -> Bool
forall {val}. RComb val -> Args -> Bool
constant RComb Val
comb Args
args -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just (Estimate -> Estimate -> Estimate
plus Estimate
simple Estimate
simple))
    | Bool
otherwise -> RComb Val -> IO (Maybe Estimate)
tailCall RComb Val
comb
  App Bool
_ (MCode.Env CombIx
_ RComb Val
comb) Args
args
    | RComb Val -> Args -> Bool
forall {val}. RComb val -> Args -> Bool
constant RComb Val
comb Args
args -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just (Estimate -> Estimate -> Estimate
plus Estimate
simple Estimate
simple))
    | Bool
otherwise -> RComb Val -> IO (Maybe Estimate)
tailCall RComb Val
comb
  App Bool
_ (Stk Int
_) Args
_ -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just Estimate
call) -- a function value: nothing is known about it
  -- a request: a call of the handler, a function value found at run time
  App Bool
_ (Dyn Word64
_) Args
_ | Switches -> Bool
swRequests (Cx -> Switches
cxSwitches Cx
cx) -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just Estimate
call)
  -- a request match: the pure arm and every ability's arms
  RMatch Int
_ MSection
pu EnumMap Word64 (GBranch (RComb Val))
br
    | Switches -> Bool
swRequests (Cx -> Switches
cxSwitches Cx
cx), Just [[MSection]]
arms <- (GBranch (RComb Val) -> Maybe [MSection])
-> [GBranch (RComb Val)] -> Maybe [[MSection]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse GBranch (RComb Val) -> Maybe [MSection]
forall {comb}. GBranch comb -> Maybe [GSection comb]
armsOf (((Word64, GBranch (RComb Val)) -> GBranch (RComb Val))
-> [(Word64, GBranch (RComb Val))] -> [GBranch (RComb Val)]
forall a b. (a -> b) -> [a] -> [b]
map (Word64, GBranch (RComb Val)) -> GBranch (RComb Val)
forall a b. (a, b) -> b
snd (EnumMap Word64 (GBranch (RComb Val))
-> [(Word64, GBranch (RComb Val))]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
EC.mapToList EnumMap Word64 (GBranch (RComb Val))
br)) -> [MSection] -> IO (Maybe Estimate)
weigh (MSection
pu MSection -> [MSection] -> [MSection]
forall a. a -> [a] -> [a]
: [[MSection]] -> [MSection]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MSection]]
arms)
  Let MSection
b CombIx
_ Int
_ MSection
body Ptr NativeCell
_ ->
    MSection -> IO (Maybe Estimate)
binding MSection
b IO (Maybe Estimate)
-> (Maybe Estimate -> IO (Maybe Estimate)) -> IO (Maybe Estimate)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe Estimate
Nothing -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Estimate
forall a. Maybe a
Nothing
      Just Estimate
e -> (Estimate -> Estimate) -> Maybe Estimate -> Maybe Estimate
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Estimate -> Estimate -> Estimate
plus Estimate
e) (Maybe Estimate -> Maybe Estimate)
-> IO (Maybe Estimate) -> IO (Maybe Estimate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cx -> MSection -> IO (Maybe Estimate)
walk Cx
cx MSection
body
  -- the interpreter takes these: a jump to a continuation, a request with
  -- requests disabled, a request match with requests disabled or with arms
  -- the generator has no shape for
  Jump {} -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just Estimate
exit)
  App Bool
_ (Dyn Word64
_) Args
_ -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just Estimate
exit)
  RMatch {} -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just Estimate
exit)
  where
    isSelf :: RComb Val -> Bool
isSelf RComb Val
comb = case RComb Val -> GComb Val (RComb Val)
forall val. RComb val -> GComb val (RComb val)
unRComb RComb Val
comb of
      Comb (LamI Int
_ Int
_ MSection
_ Ptr NativeCell
cell) -> Ptr NativeCell
cell Ptr NativeCell -> Ptr NativeCell -> Bool
forall a. Eq a => a -> a -> Bool
== Cx -> Ptr NativeCell
cxSelf Cx
cx Bool -> Bool -> Bool
&& Ptr NativeCell
cell Ptr NativeCell -> Ptr NativeCell -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr NativeCell
noNativeCell
      GComb Val (RComb Val)
_ -> Bool
False
    -- A tail call leaves nothing of the caller behind, so what the callee
    -- does afterwards is not the caller's concern.
    tailCall :: RComb Val -> IO (Maybe Estimate)
tailCall RComb Val
comb = do
      (Bool
ok, Double
_) <- Cx -> RComb Val -> IO (Bool, Double)
native Cx
cx RComb Val
comb
      Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just (if Bool
ok then Estimate
call {esRec = isSelf comb} else Estimate
exit))
    -- A call that returns here. If the callee exits, this function's
    -- frame is unwound with it and the rest of the function is entered
    -- again through the trampoline: that is an exit for this function too.
    returningCall :: RComb Val -> IO (Maybe Estimate)
returningCall RComb Val
comb = do
      (Bool
ok, Double
exits) <- Cx -> RComb Val -> IO (Bool, Double)
native Cx
cx RComb Val
comb
      Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just (if Bool
ok then Double -> Double -> Bool -> Estimate
Estimate Double
3 Double
exits (RComb Val -> Bool
isSelf RComb Val
comb) else Estimate
exit))
    -- a combinator used as a value is a constant, and so is a top-level
    -- value that was evaluated when it was loaded
    constant :: RComb val -> Args -> Bool
constant RComb val
comb Args
args = case (RComb val -> GComb val (RComb val)
forall val. RComb val -> GComb val (RComb val)
unRComb RComb val
comb, Args
args) of
      (Comb (LamI Int
arity Int
_ GSection (RComb val)
_ Ptr NativeCell
_), Args
ZArgs) -> Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      (CachedVal {}, Args
ZArgs) -> Bool
True
      (GComb val (RComb val), Args)
_ -> Bool
False
    -- A binding that is a call is a native call if the callee is native,
    -- and otherwise the interpreter's; either way native code continues
    -- with the body. Other bindings are generated inline.
    binding :: MSection -> IO (Maybe Estimate)
binding = \case
      Call Bool
_ CombIx
_ RComb Val
comb Args
args
        | RComb Val -> Args -> Bool
forall {val}. RComb val -> Args -> Bool
constant RComb Val
comb Args
args -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just Estimate
simple)
        | Bool
otherwise -> RComb Val -> IO (Maybe Estimate)
returningCall RComb Val
comb
      App Bool
_ (MCode.Env CombIx
_ RComb Val
comb) Args
args
        | RComb Val -> Args -> Bool
forall {val}. RComb val -> Args -> Bool
constant RComb Val
comb Args
args -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just Estimate
simple)
        | Bool
otherwise -> RComb Val -> IO (Maybe Estimate)
returningCall RComb Val
comb
      App Bool
_ (Stk Int
_) Args
_ -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just Estimate
call)
      App Bool
_ (Dyn Word64
_) Args
_ | Switches -> Bool
swRequests (Cx -> Switches
cxSwitches Cx
cx) -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just Estimate
call)
      MSection
b
        | Switches -> MSection -> Bool
startsSupported (Cx -> Switches
cxSwitches Cx
cx) MSection
b -> (Estimate -> Estimate) -> Maybe Estimate -> Maybe Estimate
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Estimate -> Estimate -> Estimate
plus Estimate
call) (Maybe Estimate -> Maybe Estimate)
-> IO (Maybe Estimate) -> IO (Maybe Estimate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cx -> MSection -> IO (Maybe Estimate)
walk Cx
cx MSection
b
        | Bool
otherwise -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just Estimate
exit)
    -- The arms weigh the same, with two exceptions: those that can't
    -- return don't count, and in a function that calls itself the arms
    -- that do (the loop, the recursion) weigh more than the arms that
    -- don't (the way out, the base cases).
    branch :: GBranch (RComb Val) -> IO (Maybe Estimate)
branch GBranch (RComb Val)
br = case GBranch (RComb Val) -> Maybe [MSection]
forall {comb}. GBranch comb -> Maybe [GSection comb]
armsOf GBranch (RComb Val)
br of
      Maybe [MSection]
Nothing -> Maybe Estimate -> IO (Maybe Estimate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just Estimate
exit)
      Just [MSection]
sects -> [MSection] -> IO (Maybe Estimate)
weigh [MSection]
sects
    weigh :: [MSection] -> IO (Maybe Estimate)
weigh [MSection]
sects = do
      [Estimate]
arms <- [Maybe Estimate] -> [Estimate]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Estimate] -> [Estimate])
-> IO [Maybe Estimate] -> IO [Estimate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MSection -> IO (Maybe Estimate))
-> [MSection] -> IO [Maybe Estimate]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Cx -> MSection -> IO (Maybe Estimate)
walk Cx
cx) [MSection]
sects
      pure $ case [Estimate]
arms of
        [] -> Maybe Estimate
forall a. Maybe a
Nothing
        [Estimate]
_ ->
          let weight :: Estimate -> Double
weight Estimate
e = if Estimate -> Bool
esRec Estimate
e then Double
recursiveWeight else Double
1
              total :: Double
total = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Estimate -> Double) -> [Estimate] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Estimate -> Double
weight [Estimate]
arms)
              s :: Double
s = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Estimate -> Double
weight Estimate
e Double -> Double -> Double
forall a. Num a => a -> a -> a
* Estimate -> Double
esSaving Estimate
e | Estimate
e <- [Estimate]
arms] Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
total
              x :: Double
x = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Estimate -> Double
weight Estimate
e Double -> Double -> Double
forall a. Num a => a -> a -> a
* Estimate -> Double
esExits Estimate
e | Estimate
e <- [Estimate]
arms] Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
total
           in Estimate -> Maybe Estimate
forall a. a -> Maybe a
Just (Estimate -> Estimate -> Estimate
plus Estimate
simple (Double -> Double -> Bool -> Estimate
Estimate Double
s Double
x ((Estimate -> Bool) -> [Estimate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Estimate -> Bool
esRec [Estimate]
arms)))
    armsOf :: GBranch comb -> Maybe [GSection comb]
armsOf = \case
      Test1 Word64
_ (Arm Int
_ GSection comb
a) GSection comb
d -> [GSection comb] -> Maybe [GSection comb]
forall a. a -> Maybe a
Just [GSection comb
a, GSection comb
d]
      Test2 Word64
_ (Arm Int
_ GSection comb
a) Word64
_ (Arm Int
_ GSection comb
b) GSection comb
d -> [GSection comb] -> Maybe [GSection comb]
forall a. a -> Maybe a
Just [GSection comb
a, GSection comb
b, GSection comb
d]
      TestW GSection comb
d EnumMap Word64 (Arm comb)
m -> [GSection comb] -> Maybe [GSection comb]
forall a. a -> Maybe a
Just (GSection comb
d GSection comb -> [GSection comb] -> [GSection comb]
forall a. a -> [a] -> [a]
: ((Word64, Arm comb) -> GSection comb)
-> [(Word64, Arm comb)] -> [GSection comb]
forall a b. (a -> b) -> [a] -> [b]
map (Arm comb -> GSection comb
forall comb. Arm comb -> GSection comb
armSection (Arm comb -> GSection comb)
-> ((Word64, Arm comb) -> Arm comb)
-> (Word64, Arm comb)
-> GSection comb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, Arm comb) -> Arm comb
forall a b. (a, b) -> b
snd) (EnumMap Word64 (Arm comb) -> [(Word64, Arm comb)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
EC.mapToList EnumMap Word64 (Arm comb)
m))
      -- matches on text and other boxed values are the interpreter's
      TestT GSection comb
_ Map Text (GSection comb)
_ -> Maybe [GSection comb]
forall a. Maybe a
Nothing
      TestY GSection comb
_ Map Bytes (GSection comb)
_ -> Maybe [GSection comb]
forall a. Maybe a
Nothing

-- | How much more often a branch arm that loops or recurses is taken than
-- one that doesn't. A guess: a loop takes its way out once, a binary
-- recursion reaches a base case every other call.
recursiveWeight :: Double
recursiveWeight :: Double
recursiveWeight = Double
4