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

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

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

@since 1.7.0.0
-}
inliner :: Bool -> MVar a -> Fix Combinator a -> Fix Combinator a
inliner :: Bool -> MVar a -> Fix Combinator a -> Fix Combinator a
inliner Bool
recu MVar a
_ Fix Combinator a
body | Bool -> Bool
not Bool
recu, Fix Combinator a -> Bool
forall a. Fix Combinator a -> Bool
shouldInline Fix Combinator a
body = Fix Combinator a
body
inliner Bool
recu MVar a
μ Fix Combinator a
_ = Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Bool -> MVar a -> Combinator (Fix Combinator) a
forall a (k :: Type -> Type). Bool -> MVar a -> Combinator k a
Let Bool
recu MVar a
μ)

shouldInline :: Fix Combinator a -> Bool
shouldInline :: Fix Combinator a -> Bool
shouldInline = (Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
inlineThreshold) (Rational -> Bool)
-> (Fix Combinator a -> Rational) -> Fix Combinator a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InlineWeight a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight (InlineWeight a -> Rational)
-> (Fix Combinator a -> InlineWeight a)
-> Fix Combinator a
-> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall j. Combinator InlineWeight j -> InlineWeight j)
-> Fix Combinator a -> InlineWeight a
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 (Rational -> InlineWeight j
forall k (a :: k). Rational -> InlineWeight a
InlineWeight (Rational -> InlineWeight j)
-> (Combinator InlineWeight j -> Rational)
-> Combinator InlineWeight j
-> InlineWeight j
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Combinator InlineWeight j -> Rational
forall a. Combinator InlineWeight a -> Rational
alg)

newtype InlineWeight a = InlineWeight { InlineWeight a -> Rational
getWeight :: Rational }

-- Ideally these should mirror those in the backend inliner, how can we unify them?
alg :: Combinator InlineWeight a -> Rational
alg :: Combinator InlineWeight a -> Rational
alg (Pure Defunc a
_)             = Rational
0
alg (Satisfy Defunc (Char -> Bool)
_)          = Rational
1
alg Combinator InlineWeight a
Empty                = Rational
0
alg Let{}                = Integer
2 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
3
alg (Try InlineWeight a
p)              = InlineWeight a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
p
alg (InlineWeight a
l :<|>: InlineWeight a
r)          = 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
+ 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 a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
l Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
r
alg (InlineWeight (a -> a)
l :<*>: InlineWeight a
r)          = 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 (a -> a) -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight (a -> a)
l Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
r
alg (InlineWeight a
l :<*: InlineWeight b
r)           = InlineWeight a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
l Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight b -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight b
r
alg (InlineWeight a
l :*>: InlineWeight a
r)           = InlineWeight a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
l Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
r
alg (LookAhead InlineWeight a
c)        = InlineWeight a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
c
alg (NotFollowedBy InlineWeight a
p)    = 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 a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
p
alg (Debug String
_ InlineWeight a
c)          = Integer
2 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
4 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
c
alg (Loop InlineWeight ()
body InlineWeight a
exit)     = 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 () -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight ()
body Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
exit
alg (Branch InlineWeight (Either a b)
b InlineWeight (a -> a)
p InlineWeight (b -> 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
+ 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 (Either a b) -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight (Either a b)
b Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (a -> a) -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight (a -> a)
p Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight (b -> a) -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight (b -> a)
q
alg (Match InlineWeight a
p [Defunc (a -> Bool)]
_ [InlineWeight a]
qs InlineWeight a
def)   = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([InlineWeight a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [InlineWeight a]
qs 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 a -> Rational) -> [InlineWeight a] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map InlineWeight a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight [InlineWeight a]
qs) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
def Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
p
alg (MakeRegister ΣVar a
_ InlineWeight a
l InlineWeight a
r) = 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 a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
l Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ InlineWeight a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
r
alg (GetRegister ΣVar a
_)      = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
3
alg (PutRegister ΣVar a
_ InlineWeight a
c)    = 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 a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
c
alg (MetaCombinator MetaCombinator
_ InlineWeight a
c) = InlineWeight a -> Rational
forall k (a :: k). InlineWeight a -> Rational
getWeight InlineWeight a
c