{-|
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)

inlineThreshold :: Rational
inlineThreshold :: Rational
inlineThreshold = Integer
13 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
10

{-|
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 :: Fix4 (Instr o) xs n r a -> Bool
shouldInline :: Fix4 (Instr o) xs n r a -> Bool
shouldInline = (Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
inlineThreshold) (Rational -> Bool)
-> (Fix4 (Instr o) xs n r a -> Rational)
-> Fix4 (Instr o) xs n r a
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InlineWeight xs n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight (InlineWeight xs n r a -> Rational)
-> (Fix4 (Instr o) xs n r a -> InlineWeight xs n r a)
-> Fix4 (Instr o) xs n r a
-> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (i' :: [Type]) (j' :: Nat) k'.
 Instr o InlineWeight i' j' k' a -> InlineWeight i' j' k' a)
-> Fix4 (Instr o) xs n r a -> InlineWeight xs n r a
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 (Rational -> InlineWeight i' j' k' a
forall k k k (xs :: k) (n :: Nat) (r :: k) (a :: k).
Rational -> InlineWeight xs n r a
InlineWeight (Rational -> InlineWeight i' j' k' a)
-> (Instr o InlineWeight i' j' k' a -> Rational)
-> Instr o InlineWeight i' j' k' a
-> InlineWeight i' j' k' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr o InlineWeight i' j' k' a -> Rational
forall o (xs :: [Type]) (n :: Nat) r a.
Instr o InlineWeight xs n r a -> Rational
alg)

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

alg :: Instr o InlineWeight xs n r a -> Rational
alg :: 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 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (x : xs) n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : xs) n r a
k
alg (Pop InlineWeight xs n r a
k)            = Rational
0 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight xs n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs n r a
k
alg (Lift2 Defunc (x -> y -> z)
_ InlineWeight (z : xs) n r a
k)        = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
5 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (z : xs) n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (z : xs) n r a
k
alg (Sat Defunc (Char -> Bool)
_ InlineWeight (Char : xs) ('Succ n) r a
k)          = Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (Char : xs) ('Succ n) r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (Char : xs) ('Succ n) r a
k
alg (Call MVar x
_ InlineWeight (x : xs) ('Succ n) r a
k)         = Integer
2 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
3 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (x : xs) ('Succ n) r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : xs) ('Succ n) r a
k
alg (Jump MVar r
_)           = Rational
0
alg Instr o InlineWeight xs n r a
Empt               = Rational
0
alg (Commit InlineWeight xs n r a
k)         = Rational
0 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight xs n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs n r a
k
alg (Catch InlineWeight xs ('Succ n) r a
k Handler o InlineWeight (o : xs) n r a
h)        = (if Handler o InlineWeight (o : xs) n r a -> Bool
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 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
4) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight xs ('Succ n) r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs ('Succ n) r a
k Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Handler o InlineWeight (o : xs) n r a -> Rational
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 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (o : xs) n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (o : xs) n r a
k
alg (Seek InlineWeight xs n r a
k)           = Rational
0 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight xs n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs n r a
k
alg (Case InlineWeight (x : xs) n r a
p InlineWeight (y : xs) n r a
q)         = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
3 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (x : xs) n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : xs) n r a
p Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (y : xs) n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (y : xs) n r a
q
alg (Choices [Defunc (x -> Bool)]
_ [InlineWeight xs n r a]
ks InlineWeight xs n r a
def) = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([InlineWeight xs n r a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [InlineWeight xs n r a]
ks Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
3 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ [Rational] -> Rational
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum ((InlineWeight xs n r a -> Rational)
-> [InlineWeight xs n r a] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map InlineWeight xs n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight [InlineWeight xs n r a]
ks) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight xs n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs n r a
def
alg (Iter MVar Void
_ InlineWeight '[] One Void a
b Handler o InlineWeight (o : xs) n r a
h)       = Integer
2 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
3 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight '[] One Void a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight '[] One Void a
b Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Handler o InlineWeight (o : xs) n r a -> Rational
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 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
5 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (x : xs) n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : xs) n r a
b Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight xs n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs n r a
k
alg (Swap InlineWeight (x : y : xs) n r a
k)           = Rational
0 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (x : y : xs) n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : y : xs) n r a
k
alg (Dup InlineWeight (x : x : xs) n r a
k)            = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
10 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (x : x : xs) n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : x : xs) n r a
k
alg (Make ΣVar x
_ Access
Hard InlineWeight xs n r a
k)    = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
3 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight xs n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs n r a
k
alg (Get ΣVar x
_ Access
Hard InlineWeight (x : xs) n r a
k)     = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
3 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (x : xs) n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : xs) n r a
k
alg (Put ΣVar x
_ Access
Hard InlineWeight xs n r a
k)     = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
3 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight xs n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs n r a
k
alg (SelectPos PosSelector
_ InlineWeight (Int : xs) n r a
k)    = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
5 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (Int : xs) n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (Int : xs) n r a
k
alg (Make ΣVar x
_ Access
Soft InlineWeight xs n r a
k)    = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
10 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight xs n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs n r a
k
alg (Get ΣVar x
_ Access
Soft InlineWeight (x : xs) n r a
k)     = Rational
0 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (x : xs) n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (x : xs) n r a
k
alg (Put ΣVar x
_ Access
Soft InlineWeight xs n r a
k)     = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
10 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight xs n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs n r a
k
alg (LogEnter String
_ InlineWeight xs ('Succ ('Succ n)) r a
k)     = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
4 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight xs ('Succ ('Succ n)) r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs ('Succ ('Succ n)) r a
k
alg (LogExit String
_ InlineWeight xs n r a
k)      = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
4 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight xs n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) 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 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight xs n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) 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 :: Handler o InlineWeight xs n r a -> Rational
algHandler (Always Bool
_ InlineWeight (o : xs) n r a
h) = InlineWeight (o : xs) n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (o : xs) n r a
h
algHandler (Same Bool
_ InlineWeight xs n r a
y Bool
_ InlineWeight (o : xs) n r a
n) = InlineWeight xs n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight xs n r a
y Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (o : xs) n r a -> Rational
forall k (xs :: k) (n :: Nat) k (r :: k) k (a :: k).
InlineWeight xs n r a -> Rational
getWeight InlineWeight (o : xs) n r a
n

handlerInlined :: Handler o k xs n r a -> Bool
handlerInlined :: Handler o k xs n r a -> Bool
handlerInlined (Always Bool
True k (o : xs) n r a
_) = Bool
True
handlerInlined Handler o k xs n r a
_               = Bool
False