{-# LANGUAGE ImplicitParams #-}
{-|
Module      : Parsley.Internal.Backend.Analysis.Inliner
Description : Determines whether a machine should be inlined.
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : experimental

Exposes an inliner analysis that determines whether or not a given machine should be inlined
as opposed to bound in the generated code.

@since 1.7.0.0
-}
module Parsley.Internal.Backend.Analysis.Inliner (shouldInline) where

import Data.Ratio                       ((%))
import Parsley.Internal.Backend.Machine (Instr(..), Handler(..), Access(Hard, Soft))
import Parsley.Internal.Common.Indexed  (cata4, Fix4, Nat)

import qualified Parsley.Internal.Opt   as Opt

{-|
Provides a conservative estimate on whether or not each of the elements of the stack on
entry to a machine are actually used in the computation.

@since 1.7.0.0
-}
shouldInline :: (?flags :: Opt.Flags) => Fix4 (Instr o) xs n r a -> Bool
shouldInline :: forall o (xs :: [Type]) (n :: Nat) r a.
(?flags::Flags) =>
Fix4 (Instr o) xs n r a -> Bool
shouldInline
  | Just Rational
thresh <- Flags -> Maybe Rational
Opt.secondaryInlineThreshold ?flags::Flags
?flags = (forall a. Ord a => a -> a -> Bool
<= Rational
thresh) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: ([Type] -> Nat -> Type -> Type -> Type)
             -> [Type] -> Nat -> Type -> Type -> Type)
       (a :: [Type] -> Nat -> Type -> Type -> Type) (i :: [Type])
       (j :: Nat) k x.
IFunctor4 f =>
(forall (i' :: [Type]) (j' :: Nat) k'.
 f a i' j' k' x -> a i' j' k' x)
-> Fix4 f i j k x -> a i j k x
cata4 (forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
Rational -> InlineWeight xs n r a
InlineWeight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o (xs :: [Type]) (n :: Nat) r a.
Instr o InlineWeight xs n r a -> Rational
alg)
  | Bool
otherwise                                          = forall a b. a -> b -> a
const Bool
False

newtype InlineWeight xs (n :: Nat) r a = InlineWeight { forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight :: Rational }

alg :: Instr o InlineWeight xs n r a -> Rational
alg :: forall o (xs :: [Type]) (n :: Nat) r a.
Instr o InlineWeight xs n r a -> Rational
alg Instr o InlineWeight xs n r a
Ret                = Rational
0
alg (Push Defunc x
_ InlineWeight (x : xs) n r a
k)         = Rational
0 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : xs) n r a
k
alg (Pop InlineWeight xs1 n r a
k)            = Rational
0 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs1 n r a
k
alg (Lift2 Defunc (x -> y -> z)
_ InlineWeight (z : xs1) n r a
k)        = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
5 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (z : xs1) n r a
k
alg (Sat CharPred
_ InlineWeight (Char : xs) ('Succ n1) r a
k)          = Rational
1 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (Char : xs) ('Succ n1) r a
k
alg (Call MVar x
_ InlineWeight (x : xs) ('Succ n1) r a
k)         = Integer
2 forall a. Integral a => a -> a -> Ratio a
% Integer
3 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : xs) ('Succ n1) r a
k
alg Instr o InlineWeight xs n r a
Empt               = Rational
0
alg (Commit InlineWeight xs n1 r a
k)         = Rational
0 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs n1 r a
k
alg (Catch InlineWeight xs ('Succ n) r a
k Handler o InlineWeight (o : xs) n r a
h)        = (if forall o (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a.
Handler o k xs n r a -> Bool
handlerInlined Handler o InlineWeight (o : xs) n r a
h then Rational
0 else Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
4) forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs ('Succ n) r a
k forall a. Num a => a -> a -> a
+ forall o (xs :: [Type]) (n :: Nat) r a.
Handler o InlineWeight xs n r a -> Rational
algHandler Handler o InlineWeight (o : xs) n r a
h
alg (Tell InlineWeight (o : xs) n r a
k)           = Rational
0 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (o : xs) n r a
k
alg (Seek InlineWeight xs1 n r a
k)           = Rational
0 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs1 n r a
k
alg (Case InlineWeight (x : xs1) n r a
p InlineWeight (y : xs1) n r a
q)         = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
3 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : xs1) n r a
p forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (y : xs1) n r a
q
alg (Choices [Defunc (x -> Bool)]
_ [InlineWeight xs1 n r a]
ks InlineWeight xs1 n r a
def) = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [InlineWeight xs1 n r a]
ks forall a. Num a => a -> a -> a
+ Int
1) forall a. Integral a => a -> a -> Ratio a
% Integer
3 forall a. Num a => a -> a -> a
+ forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight [InlineWeight xs1 n r a]
ks) forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs1 n r a
def
alg (Iter MVar Void
_ InlineWeight '[] One Void a
b Handler o InlineWeight (o : xs) n r a
h)       = Integer
2 forall a. Integral a => a -> a -> Ratio a
% Integer
3 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight '[] One Void a
b forall a. Num a => a -> a -> a
+ forall o (xs :: [Type]) (n :: Nat) r a.
Handler o InlineWeight xs n r a -> Rational
algHandler Handler o InlineWeight (o : xs) n r a
h
alg (Join ΦVar x
_)           = Rational
0
alg (MkJoin ΦVar x
_ InlineWeight (x : xs) n r a
b InlineWeight xs n r a
k)     = Integer
2 forall a. Integral a => a -> a -> Ratio a
% Integer
5 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : xs) n r a
b forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs n r a
k
alg (Swap InlineWeight (x : y : xs1) n r a
k)           = Rational
0 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : y : xs1) n r a
k
alg (Dup InlineWeight (x : x : xs1) n r a
k)            = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
10 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : x : xs1) n r a
k
alg (Make ΣVar x
_ Access
Hard InlineWeight xs1 n r a
k)    = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
3 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs1 n r a
k
alg (Get ΣVar x
_ Access
Hard InlineWeight (x : xs) n r a
k)     = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
3 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : xs) n r a
k
alg (Put ΣVar x
_ Access
Hard InlineWeight xs1 n r a
k)     = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
3 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs1 n r a
k
alg (SelectPos PosSelector
_ InlineWeight (Int : xs) n r a
k)    = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
5 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (Int : xs) n r a
k
alg (Make ΣVar x
_ Access
Soft InlineWeight xs1 n r a
k)    = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
10 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs1 n r a
k
alg (Get ΣVar x
_ Access
Soft InlineWeight (x : xs) n r a
k)     = Rational
0 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : xs) n r a
k
alg (Put ΣVar x
_ Access
Soft InlineWeight xs1 n r a
k)     = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
10 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs1 n r a
k
alg (LogEnter String
_ InlineWeight xs ('Succ ('Succ n1)) r a
k)     = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
4 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs ('Succ ('Succ n1)) r a
k
alg (LogExit String
_ InlineWeight xs n r a
k)      = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
4 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs n r a
k
alg (MetaInstr MetaInstr n
_ InlineWeight xs n r a
k)    = Rational
0 forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs n r a
k

algHandler :: Handler o InlineWeight xs n r a -> Rational
algHandler :: forall o (xs :: [Type]) (n :: Nat) r a.
Handler o InlineWeight xs n r a -> Rational
algHandler (Always Bool
_ InlineWeight (o : xs1) n r a
h) = forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (o : xs1) n r a
h
algHandler (Same Bool
_ InlineWeight xs1 n r a
y Bool
_ InlineWeight (o : xs1) n r a
n) = forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs1 n r a
y forall a. Num a => a -> a -> a
+ forall {k} {k} {k} (xs :: k) (n :: Nat) (r :: k) (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (o : xs1) n r a
n

handlerInlined :: Handler o k xs n r a -> Bool
handlerInlined :: forall o (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a.
Handler o k xs n r a -> Bool
handlerInlined (Always Bool
True k (o : xs1) n r a
_) = Bool
True
handlerInlined Handler o k xs n r a
_               = Bool
False