Inliner.hs

{-# 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
  | Just thresh <- Opt.secondaryInlineThreshold ?flags = (<= thresh) . getWeight . cata4 (InlineWeight . alg)
  | otherwise                                          = const False

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

alg :: Instr o InlineWeight xs n r a -> Rational
alg Ret                = 0
alg (Push _ k)         = 0 + getWeight k
alg (Pop k)            = 0 + getWeight k
alg (Lift2 _ k)        = 1 % 5 + getWeight k
alg (Sat _ k)          = 1 + getWeight k
alg (Call _ k)         = 2 % 3 + getWeight k
alg Empt               = 0
alg (Commit k)         = 0 + getWeight k
alg (Catch k h)        = (if handlerInlined h then 0 else 1 % 4) + getWeight k + algHandler h
alg (Tell k)           = 0 + getWeight k
alg (Seek k)           = 0 + getWeight k
alg (Case p q)         = 1 % 3 + getWeight p + getWeight q
alg (Choices _ ks def) = fromIntegral (length ks + 1) % 3 + sum (map getWeight ks) + getWeight def
alg (Iter _ b h)       = 2 % 3 + getWeight b + algHandler h
alg (Join _)           = 0
alg (MkJoin _ b k)     = 2 % 5 + getWeight b + getWeight k
alg (Swap k)           = 0 + getWeight k
alg (Dup k)            = 1 % 10 + getWeight k
alg (Make _ Hard k)    = 1 % 3 + getWeight k
alg (Get _ Hard k)     = 1 % 3 + getWeight k
alg (Put _ Hard k)     = 1 % 3 + getWeight k
alg (SelectPos _ k)    = 1 % 5 + getWeight k
alg (Make _ Soft k)    = 1 % 10 + getWeight k
alg (Get _ Soft k)     = 0 + getWeight k
alg (Put _ Soft k)     = 1 % 10 + getWeight k
alg (LogEnter _ k)     = 1 % 4 + getWeight k
alg (LogExit _ k)      = 1 % 4 + getWeight k
alg (MetaInstr _ k)    = 0 + getWeight k

algHandler :: Handler o InlineWeight xs n r a -> Rational
algHandler (Always _ h) = getWeight h
algHandler (Same _ y _ n) = getWeight y + getWeight n

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