{-# LANGUAGE TemplateHaskell #-}

module UntypedPlutusCore.Simplify.Opts
  ( SimplifyOpts (..)
  , soMaxSimplifierIterations
  , soMaxCseIterations
  , soInlineHints
  , soConservativeOpts
  , soInlineConstants
  , defaultSimplifyOpts
  ) where

import Control.Lens.TH (makeLenses)
import PlutusCore.Annotation (InlineHints)

data SimplifyOpts name a = SimplifyOpts
  { forall name a. SimplifyOpts name a -> Int
_soMaxSimplifierIterations :: Int
  , forall name a. SimplifyOpts name a -> Int
_soMaxCseIterations        :: Int
  , forall name a. SimplifyOpts name a -> Bool
_soConservativeOpts        :: Bool
  , forall name a. SimplifyOpts name a -> InlineHints name a
_soInlineHints             :: InlineHints name a
  , forall name a. SimplifyOpts name a -> Bool
_soInlineConstants         :: Bool
  }
  deriving stock (Int -> SimplifyOpts name a -> ShowS
[SimplifyOpts name a] -> ShowS
SimplifyOpts name a -> String
(Int -> SimplifyOpts name a -> ShowS)
-> (SimplifyOpts name a -> String)
-> ([SimplifyOpts name a] -> ShowS)
-> Show (SimplifyOpts name a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall name a. Int -> SimplifyOpts name a -> ShowS
forall name a. [SimplifyOpts name a] -> ShowS
forall name a. SimplifyOpts name a -> String
$cshowsPrec :: forall name a. Int -> SimplifyOpts name a -> ShowS
showsPrec :: Int -> SimplifyOpts name a -> ShowS
$cshow :: forall name a. SimplifyOpts name a -> String
show :: SimplifyOpts name a -> String
$cshowList :: forall name a. [SimplifyOpts name a] -> ShowS
showList :: [SimplifyOpts name a] -> ShowS
Show)

$(makeLenses ''SimplifyOpts)

defaultSimplifyOpts :: SimplifyOpts name a
defaultSimplifyOpts :: forall name a. SimplifyOpts name a
defaultSimplifyOpts =
  SimplifyOpts
    { _soMaxSimplifierIterations :: Int
_soMaxSimplifierIterations = Int
12
    , _soMaxCseIterations :: Int
_soMaxCseIterations = Int
4
    , _soConservativeOpts :: Bool
_soConservativeOpts = Bool
False
    , _soInlineHints :: InlineHints name a
_soInlineHints = InlineHints name a
forall a. Monoid a => a
mempty
    , _soInlineConstants :: Bool
_soInlineConstants = Bool
True
    }