{-# LANGUAGE ImplicitParams #-}
module Parsley.Internal.Frontend.Analysis.Inliner (inliner) where
import Data.Ratio ((%))
import Parsley.Internal.Common.Indexed (Fix(..), cata)
import Parsley.Internal.Core.CombinatorAST (Combinator(..))
import Parsley.Internal.Core.Identifiers (MVar)
import qualified Parsley.Internal.Opt as Opt
inliner :: (?flags :: Opt.Flags) => Maybe Int -> MVar a -> Fix Combinator a -> Fix Combinator a
inliner :: forall a.
(?flags::Flags) =>
Maybe Int -> MVar a -> Fix Combinator a -> Fix Combinator a
inliner Maybe Int
occs MVar a
_ Fix Combinator a
body
| Just Int
n <- Maybe Int
occs
, Just Rational
thresh <- Flags -> Maybe Rational
Opt.primaryInlineThreshold ?flags::Flags
?flags
, forall a. Int -> Rational -> Fix Combinator a -> Bool
shouldInline Int
n Rational
thresh Fix Combinator a
body = Fix Combinator a
body
inliner Maybe Int
_ MVar a
μ Fix Combinator a
_ = forall {k} (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (forall a (k :: Type -> Type). MVar a -> Combinator k a
Let MVar a
μ)
shouldInline :: Int -> Rational -> Fix Combinator a -> Bool
shouldInline :: forall a. Int -> Rational -> Fix Combinator a -> Bool
shouldInline Int
occs Rational
inlineThreshold = (forall a. Ord a => a -> a -> Bool
<= Rational
inlineThreshold) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* forall a. Real a => a -> Rational
toRational Int
occs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
subtract Rational
callCost forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k). InlineWeight a -> Rational
getWeight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: (Type -> Type) -> Type -> Type) (a :: Type -> Type) i.
IFunctor f =>
(forall j. f a j -> a j) -> Fix f i -> a i
cata (forall {k} (a :: k). Rational -> InlineWeight a
InlineWeight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Combinator InlineWeight a -> Rational
alg)
newtype InlineWeight a = InlineWeight { forall {k} (a :: k). InlineWeight a -> Rational
getWeight :: Rational }
callCost :: Rational
callCost :: Rational
callCost = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
3
handlerCost :: Rational
handlerCost :: Rational
handlerCost = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
4
registerCost :: Rational
registerCost :: Rational
registerCost = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
3
alg :: Combinator InlineWeight a -> Rational
alg :: forall a. Combinator InlineWeight a -> Rational
alg (Pure Defunc a
_) = Rational
0
alg (Satisfy CharPred
_) = Rational
1
alg Combinator InlineWeight a
Empty = Rational
0
alg Let{} = Rational
callCost
alg (Try InlineWeight a
p) = forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
p
alg (InlineWeight a
l :<|>: InlineWeight a
r) = Rational
handlerCost forall a. Num a => a -> a -> a
+ Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
5 forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
l forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
r
alg (InlineWeight (a1 -> a)
l :<*>: InlineWeight a1
r) = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
5 forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight (a1 -> a)
l forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a1
r
alg (InlineWeight a
l :<*: InlineWeight b
r) = forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
l forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight b
r
alg (InlineWeight a1
l :*>: InlineWeight a
r) = forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a1
l forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
r
alg (LookAhead InlineWeight a
c) = forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
c
alg (NotFollowedBy InlineWeight a1
p) = Rational
handlerCost forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a1
p
alg (Debug String
_ InlineWeight a
c) = forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
c
alg (Loop InlineWeight ()
body InlineWeight a
exit) = Rational
handlerCost forall a. Num a => a -> a -> a
+ Rational
callCost forall a. Num a => a -> a -> a
+ Integer
2 forall a. Integral a => a -> a -> Ratio a
% Integer
3 forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight ()
body forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
exit
alg (Branch InlineWeight (Either a1 b)
b InlineWeight (a1 -> a)
p InlineWeight (b -> a)
q) = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
3 forall a. Num a => a -> a -> a
+ Integer
2 forall a. Integral a => a -> a -> Ratio a
% Integer
5 forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight (Either a1 b)
b forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight (a1 -> a)
p forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight (b -> a)
q
alg (Match InlineWeight a1
p [Defunc (a1 -> Bool)]
_ [InlineWeight a]
qs InlineWeight a
def) = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [InlineWeight a]
qs 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} (a :: k). InlineWeight a -> Rational
getWeight [InlineWeight a]
qs) forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
def forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a1
p
alg (MakeRegister ΣVar a1
_ InlineWeight a1
l InlineWeight a
r) = Rational
registerCost forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a1
l forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
r
alg (GetRegister ΣVar a
_) = Rational
registerCost
alg (PutRegister ΣVar a1
_ InlineWeight a1
c) = Rational
registerCost forall a. Num a => a -> a -> a
+ forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a1
c
alg (Position PosSelector
_) = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
5
alg (MetaCombinator MetaCombinator
_ InlineWeight a
c) = forall {k} (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
c