{-# LANGUAGE ImplicitParams #-}
{-|
Module      : Parsley.Internal.Frontend.Analysis.Inliner
Description : Decides whether to inline a let-bound parser.
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : experimental

Exposes a transformation which can be used to inline let-bindings into their use-sites.

@since 1.7.0.0
-}
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

{-|
Annotate a tree with its cut-points. We assume a cut for let-bound parsers.

@since 1.7.0.0
-}
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

-- Ideally these should mirror those in the backend inliner, how can we unify them?
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