-- editorconfig-checker-disable-file
{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NumericUnderscores    #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

{-# LANGUAGE StrictData            #-}
module PlutusCore.Evaluation.Machine.CostingFun.Core
    ( CostingFun(..)
    , UnimplementedCostingFun(..)
    , Intercept(..)
    , Slope(..)
    , Coefficient0(..)
    , Coefficient1(..)
    , Coefficient2(..)
    , Coefficient00(..)
    , Coefficient10(..)
    , Coefficient01(..)
    , Coefficient20(..)
    , Coefficient11(..)
    , Coefficient02(..)
    , OneVariableLinearFunction(..)
    , OneVariableQuadraticFunction(..)
    , TwoVariableLinearFunction(..)
    , TwoVariableQuadraticFunction(..)
    , ModelSubtractedSizes(..)
    , ModelConstantOrLinear(..)  -- Deprecated: see below.
    , ModelConstantOrOneArgument(..)
    , ModelConstantOrTwoArguments(..)
    , ModelOneArgument(..)
    , ModelTwoArguments(..)
    , ModelThreeArguments(..)
    , ModelFourArguments(..)
    , ModelFiveArguments(..)
    , ModelSixArguments(..)
    , runCostingFunOneArgument
    , runCostingFunTwoArguments
    , runCostingFunThreeArguments
    , runCostingFunFourArguments
    , runCostingFunFiveArguments
    , runCostingFunSixArguments
    , Hashable
    )
where

import PlutusCore.Evaluation.Machine.CostStream
import PlutusCore.Evaluation.Machine.ExBudgetStream
import PlutusCore.Evaluation.Machine.ExMemory
import PlutusCore.Evaluation.Machine.ExMemoryUsage

import Control.DeepSeq
import Data.Default.Class
import Data.Hashable
import Deriving.Aeson
import GHC.Exts
import Language.Haskell.TH.Syntax hiding (Name, newName)

-- | A class used for convenience in this module, don't export it.
class OnMemoryUsages c a where
    -- | Turn
    --
    -- > \mem1 ... memN -> f mem1 ... memN
    --
    -- into
    --
    -- > \arg1 ... argN -> f (memoryUsage arg1) ... (memoryUsage argN)
    --
    -- so that we don't need to repeat those 'memoryUsage' calls at every use site, which would also
    -- require binding @arg*@ explicitly, i.e. require even more boilerplate.
    onMemoryUsages :: c -> a

instance (ab ~ (a -> b), ExMemoryUsage a, OnMemoryUsages c b) =>
        OnMemoryUsages (CostStream -> c) ab where
    -- 'inline' is for making sure that 'memoryUsage' does get inlined.
    onMemoryUsages :: (CostStream -> c) -> ab
onMemoryUsages CostStream -> c
f = c -> b
forall c a. OnMemoryUsages c a => c -> a
onMemoryUsages (c -> b) -> (a -> c) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostStream -> c
f (CostStream -> c) -> (a -> CostStream) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostRose -> CostStream
flattenCostRose (CostRose -> CostStream) -> (a -> CostRose) -> a -> CostStream
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> CostRose) -> a -> CostRose
forall a. a -> a
inline a -> CostRose
forall a. ExMemoryUsage a => a -> CostRose
memoryUsage
    {-# INLINE onMemoryUsages #-}

instance ab ~ ExBudgetStream => OnMemoryUsages ExBudgetStream ab where
    onMemoryUsages :: ExBudgetStream -> ab
onMemoryUsages = ExBudgetStream -> ab
ExBudgetStream -> ExBudgetStream
forall a. a -> a
id
    {-# INLINE onMemoryUsages #-}

{- | A type of costing functions parametric over a model type.  In practice the we
have one model type `Model<N>Arguments` for every N, where N is the arity of the
builtin whose costs we want to model.  Each model type has a number of
constructors defining different "shapes" of N-parameter functions which
calculate a cost given the sizes of the builtin's arguments. -}
data CostingFun model = CostingFun
    { forall model. CostingFun model -> model
costingFunCpu    :: model
    , forall model. CostingFun model -> model
costingFunMemory :: model
    }
    deriving stock (Int -> CostingFun model -> ShowS
[CostingFun model] -> ShowS
CostingFun model -> String
(Int -> CostingFun model -> ShowS)
-> (CostingFun model -> String)
-> ([CostingFun model] -> ShowS)
-> Show (CostingFun model)
forall model. Show model => Int -> CostingFun model -> ShowS
forall model. Show model => [CostingFun model] -> ShowS
forall model. Show model => CostingFun model -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall model. Show model => Int -> CostingFun model -> ShowS
showsPrec :: Int -> CostingFun model -> ShowS
$cshow :: forall model. Show model => CostingFun model -> String
show :: CostingFun model -> String
$cshowList :: forall model. Show model => [CostingFun model] -> ShowS
showList :: [CostingFun model] -> ShowS
Show, CostingFun model -> CostingFun model -> Bool
(CostingFun model -> CostingFun model -> Bool)
-> (CostingFun model -> CostingFun model -> Bool)
-> Eq (CostingFun model)
forall model.
Eq model =>
CostingFun model -> CostingFun model -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall model.
Eq model =>
CostingFun model -> CostingFun model -> Bool
== :: CostingFun model -> CostingFun model -> Bool
$c/= :: forall model.
Eq model =>
CostingFun model -> CostingFun model -> Bool
/= :: CostingFun model -> CostingFun model -> Bool
Eq, (forall x. CostingFun model -> Rep (CostingFun model) x)
-> (forall x. Rep (CostingFun model) x -> CostingFun model)
-> Generic (CostingFun model)
forall x. Rep (CostingFun model) x -> CostingFun model
forall x. CostingFun model -> Rep (CostingFun model) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall model x. Rep (CostingFun model) x -> CostingFun model
forall model x. CostingFun model -> Rep (CostingFun model) x
$cfrom :: forall model x. CostingFun model -> Rep (CostingFun model) x
from :: forall x. CostingFun model -> Rep (CostingFun model) x
$cto :: forall model x. Rep (CostingFun model) x -> CostingFun model
to :: forall x. Rep (CostingFun model) x -> CostingFun model
Generic, (forall (m :: * -> *). Quote m => CostingFun model -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    CostingFun model -> Code m (CostingFun model))
-> Lift (CostingFun model)
forall model (m :: * -> *).
(Lift model, Quote m) =>
CostingFun model -> m Exp
forall model (m :: * -> *).
(Lift model, Quote m) =>
CostingFun model -> Code m (CostingFun model)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => CostingFun model -> m Exp
forall (m :: * -> *).
Quote m =>
CostingFun model -> Code m (CostingFun model)
$clift :: forall model (m :: * -> *).
(Lift model, Quote m) =>
CostingFun model -> m Exp
lift :: forall (m :: * -> *). Quote m => CostingFun model -> m Exp
$cliftTyped :: forall model (m :: * -> *).
(Lift model, Quote m) =>
CostingFun model -> Code m (CostingFun model)
liftTyped :: forall (m :: * -> *).
Quote m =>
CostingFun model -> Code m (CostingFun model)
Lift)
    deriving anyclass (CostingFun model
CostingFun model -> Default (CostingFun model)
forall a. a -> Default a
forall model. Default model => CostingFun model
$cdef :: forall model. Default model => CostingFun model
def :: CostingFun model
Default, CostingFun model -> ()
(CostingFun model -> ()) -> NFData (CostingFun model)
forall model. NFData model => CostingFun model -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall model. NFData model => CostingFun model -> ()
rnf :: CostingFun model -> ()
NFData)

{- | In the initial stages of implementing a new builtin it is necessary to
   provide a temporary costing function which is used until the builtin has been
   properly costed: `see CostModelGeneration.md`.  Each `Model<N>Arguments` type
   defines an instance of this class where `unimplementedCostingFun` is a
   constant costing function which returns a very high cost for all inputs.
   This prevents new functions from being used in situations where costs are
   important until a sensible costing function has been implemented. -}
class UnimplementedCostingFun a where
  unimplementedCostingFun :: b -> CostingFun a

{- | Make a very expensive pair of CPU and memory costing functions.  The name is
   slightly misleading because it actually makes a function which returns such a
   pair, which is what is required at the use site in `PlutusCore.Default.Builtins`,
   where properly implemented costing functions are constructed from a
   BuiltinCostModel object.  We can't use maxBound :: CostingInteger because then the
   evaluator always fails; instead we assign a cost of 100,000,000,000, which is well
   beyond the current on-chain CPU and memory limits (10,000,000,000 and 14,000,000
   respectively) but still allows over 92,000,000 evaluations before the maximum
   CostingInteger is reached.  This allows us to use an "uncosted" builtin for
   testing and for running costing benchmarks, but will prevent it from being used
   when the Plutus Core evaluator is invoked by the ledger.
-}
makeUnimplementedCostingFun :: (CostingInteger -> model) -> b -> CostingFun model
makeUnimplementedCostingFun :: forall model b. (CostingInteger -> model) -> b -> CostingFun model
makeUnimplementedCostingFun CostingInteger -> model
c =
  CostingFun model -> b -> CostingFun model
forall a b. a -> b -> a
const (CostingFun model -> b -> CostingFun model)
-> CostingFun model -> b -> CostingFun model
forall a b. (a -> b) -> a -> b
$ model -> model -> CostingFun model
forall model. model -> model -> CostingFun model
CostingFun (CostingInteger -> model
c CostingInteger
k) (CostingInteger -> model
c CostingInteger
k)
  where k :: CostingInteger
k = CostingInteger
100_000_000_000

---------------- Types for use within costing functions ----------------

-- | A wrapped 'CostingInteger' that is supposed to be used as an intercept.
newtype Intercept = Intercept
    { Intercept -> CostingInteger
unIntercept :: CostingInteger
    } deriving stock ((forall x. Intercept -> Rep Intercept x)
-> (forall x. Rep Intercept x -> Intercept) -> Generic Intercept
forall x. Rep Intercept x -> Intercept
forall x. Intercept -> Rep Intercept x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Intercept -> Rep Intercept x
from :: forall x. Intercept -> Rep Intercept x
$cto :: forall x. Rep Intercept x -> Intercept
to :: forall x. Rep Intercept x -> Intercept
Generic, (forall (m :: * -> *). Quote m => Intercept -> m Exp)
-> (forall (m :: * -> *). Quote m => Intercept -> Code m Intercept)
-> Lift Intercept
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Intercept -> m Exp
forall (m :: * -> *). Quote m => Intercept -> Code m Intercept
$clift :: forall (m :: * -> *). Quote m => Intercept -> m Exp
lift :: forall (m :: * -> *). Quote m => Intercept -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Intercept -> Code m Intercept
liftTyped :: forall (m :: * -> *). Quote m => Intercept -> Code m Intercept
Lift)
      deriving newtype (Int -> Intercept -> ShowS
[Intercept] -> ShowS
Intercept -> String
(Int -> Intercept -> ShowS)
-> (Intercept -> String)
-> ([Intercept] -> ShowS)
-> Show Intercept
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Intercept -> ShowS
showsPrec :: Int -> Intercept -> ShowS
$cshow :: Intercept -> String
show :: Intercept -> String
$cshowList :: [Intercept] -> ShowS
showList :: [Intercept] -> ShowS
Show, Intercept -> Intercept -> Bool
(Intercept -> Intercept -> Bool)
-> (Intercept -> Intercept -> Bool) -> Eq Intercept
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Intercept -> Intercept -> Bool
== :: Intercept -> Intercept -> Bool
$c/= :: Intercept -> Intercept -> Bool
/= :: Intercept -> Intercept -> Bool
Eq, Integer -> Intercept
Intercept -> Intercept
Intercept -> Intercept -> Intercept
(Intercept -> Intercept -> Intercept)
-> (Intercept -> Intercept -> Intercept)
-> (Intercept -> Intercept -> Intercept)
-> (Intercept -> Intercept)
-> (Intercept -> Intercept)
-> (Intercept -> Intercept)
-> (Integer -> Intercept)
-> Num Intercept
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Intercept -> Intercept -> Intercept
+ :: Intercept -> Intercept -> Intercept
$c- :: Intercept -> Intercept -> Intercept
- :: Intercept -> Intercept -> Intercept
$c* :: Intercept -> Intercept -> Intercept
* :: Intercept -> Intercept -> Intercept
$cnegate :: Intercept -> Intercept
negate :: Intercept -> Intercept
$cabs :: Intercept -> Intercept
abs :: Intercept -> Intercept
$csignum :: Intercept -> Intercept
signum :: Intercept -> Intercept
$cfromInteger :: Integer -> Intercept
fromInteger :: Integer -> Intercept
Num, Intercept -> ()
(Intercept -> ()) -> NFData Intercept
forall a. (a -> ()) -> NFData a
$crnf :: Intercept -> ()
rnf :: Intercept -> ()
NFData)

-- | A wrapped 'CostingInteger' that is supposed to be used as a slope.
newtype Slope = Slope
    { Slope -> CostingInteger
unSlope :: CostingInteger
    } deriving stock ((forall x. Slope -> Rep Slope x)
-> (forall x. Rep Slope x -> Slope) -> Generic Slope
forall x. Rep Slope x -> Slope
forall x. Slope -> Rep Slope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Slope -> Rep Slope x
from :: forall x. Slope -> Rep Slope x
$cto :: forall x. Rep Slope x -> Slope
to :: forall x. Rep Slope x -> Slope
Generic, (forall (m :: * -> *). Quote m => Slope -> m Exp)
-> (forall (m :: * -> *). Quote m => Slope -> Code m Slope)
-> Lift Slope
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Slope -> m Exp
forall (m :: * -> *). Quote m => Slope -> Code m Slope
$clift :: forall (m :: * -> *). Quote m => Slope -> m Exp
lift :: forall (m :: * -> *). Quote m => Slope -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Slope -> Code m Slope
liftTyped :: forall (m :: * -> *). Quote m => Slope -> Code m Slope
Lift)
      deriving newtype (Int -> Slope -> ShowS
[Slope] -> ShowS
Slope -> String
(Int -> Slope -> ShowS)
-> (Slope -> String) -> ([Slope] -> ShowS) -> Show Slope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Slope -> ShowS
showsPrec :: Int -> Slope -> ShowS
$cshow :: Slope -> String
show :: Slope -> String
$cshowList :: [Slope] -> ShowS
showList :: [Slope] -> ShowS
Show, Slope -> Slope -> Bool
(Slope -> Slope -> Bool) -> (Slope -> Slope -> Bool) -> Eq Slope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Slope -> Slope -> Bool
== :: Slope -> Slope -> Bool
$c/= :: Slope -> Slope -> Bool
/= :: Slope -> Slope -> Bool
Eq, Integer -> Slope
Slope -> Slope
Slope -> Slope -> Slope
(Slope -> Slope -> Slope)
-> (Slope -> Slope -> Slope)
-> (Slope -> Slope -> Slope)
-> (Slope -> Slope)
-> (Slope -> Slope)
-> (Slope -> Slope)
-> (Integer -> Slope)
-> Num Slope
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Slope -> Slope -> Slope
+ :: Slope -> Slope -> Slope
$c- :: Slope -> Slope -> Slope
- :: Slope -> Slope -> Slope
$c* :: Slope -> Slope -> Slope
* :: Slope -> Slope -> Slope
$cnegate :: Slope -> Slope
negate :: Slope -> Slope
$cabs :: Slope -> Slope
abs :: Slope -> Slope
$csignum :: Slope -> Slope
signum :: Slope -> Slope
$cfromInteger :: Integer -> Slope
fromInteger :: Integer -> Slope
Num, Slope -> ()
(Slope -> ()) -> NFData Slope
forall a. (a -> ()) -> NFData a
$crnf :: Slope -> ()
rnf :: Slope -> ()
NFData)

-- | A wrapped 'CostingInteger' that is supposed to be used as the degree 0
-- coefficient of a polynomial.
newtype Coefficient0 = Coefficient0
    { Coefficient0 -> CostingInteger
unCoefficient0 :: CostingInteger
    } deriving stock ((forall x. Coefficient0 -> Rep Coefficient0 x)
-> (forall x. Rep Coefficient0 x -> Coefficient0)
-> Generic Coefficient0
forall x. Rep Coefficient0 x -> Coefficient0
forall x. Coefficient0 -> Rep Coefficient0 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Coefficient0 -> Rep Coefficient0 x
from :: forall x. Coefficient0 -> Rep Coefficient0 x
$cto :: forall x. Rep Coefficient0 x -> Coefficient0
to :: forall x. Rep Coefficient0 x -> Coefficient0
Generic, (forall (m :: * -> *). Quote m => Coefficient0 -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Coefficient0 -> Code m Coefficient0)
-> Lift Coefficient0
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Coefficient0 -> m Exp
forall (m :: * -> *).
Quote m =>
Coefficient0 -> Code m Coefficient0
$clift :: forall (m :: * -> *). Quote m => Coefficient0 -> m Exp
lift :: forall (m :: * -> *). Quote m => Coefficient0 -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient0 -> Code m Coefficient0
liftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient0 -> Code m Coefficient0
Lift)
      deriving newtype (Int -> Coefficient0 -> ShowS
[Coefficient0] -> ShowS
Coefficient0 -> String
(Int -> Coefficient0 -> ShowS)
-> (Coefficient0 -> String)
-> ([Coefficient0] -> ShowS)
-> Show Coefficient0
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Coefficient0 -> ShowS
showsPrec :: Int -> Coefficient0 -> ShowS
$cshow :: Coefficient0 -> String
show :: Coefficient0 -> String
$cshowList :: [Coefficient0] -> ShowS
showList :: [Coefficient0] -> ShowS
Show, Coefficient0 -> Coefficient0 -> Bool
(Coefficient0 -> Coefficient0 -> Bool)
-> (Coefficient0 -> Coefficient0 -> Bool) -> Eq Coefficient0
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Coefficient0 -> Coefficient0 -> Bool
== :: Coefficient0 -> Coefficient0 -> Bool
$c/= :: Coefficient0 -> Coefficient0 -> Bool
/= :: Coefficient0 -> Coefficient0 -> Bool
Eq, Integer -> Coefficient0
Coefficient0 -> Coefficient0
Coefficient0 -> Coefficient0 -> Coefficient0
(Coefficient0 -> Coefficient0 -> Coefficient0)
-> (Coefficient0 -> Coefficient0 -> Coefficient0)
-> (Coefficient0 -> Coefficient0 -> Coefficient0)
-> (Coefficient0 -> Coefficient0)
-> (Coefficient0 -> Coefficient0)
-> (Coefficient0 -> Coefficient0)
-> (Integer -> Coefficient0)
-> Num Coefficient0
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Coefficient0 -> Coefficient0 -> Coefficient0
+ :: Coefficient0 -> Coefficient0 -> Coefficient0
$c- :: Coefficient0 -> Coefficient0 -> Coefficient0
- :: Coefficient0 -> Coefficient0 -> Coefficient0
$c* :: Coefficient0 -> Coefficient0 -> Coefficient0
* :: Coefficient0 -> Coefficient0 -> Coefficient0
$cnegate :: Coefficient0 -> Coefficient0
negate :: Coefficient0 -> Coefficient0
$cabs :: Coefficient0 -> Coefficient0
abs :: Coefficient0 -> Coefficient0
$csignum :: Coefficient0 -> Coefficient0
signum :: Coefficient0 -> Coefficient0
$cfromInteger :: Integer -> Coefficient0
fromInteger :: Integer -> Coefficient0
Num, Coefficient0 -> ()
(Coefficient0 -> ()) -> NFData Coefficient0
forall a. (a -> ()) -> NFData a
$crnf :: Coefficient0 -> ()
rnf :: Coefficient0 -> ()
NFData)

-- | A wrapped 'CostingInteger' that is supposed to be used as the degree 1
-- coefficient of a polynomial.
newtype Coefficient1 = Coefficient1
    { Coefficient1 -> CostingInteger
unCoefficient1 :: CostingInteger
    } deriving stock ((forall x. Coefficient1 -> Rep Coefficient1 x)
-> (forall x. Rep Coefficient1 x -> Coefficient1)
-> Generic Coefficient1
forall x. Rep Coefficient1 x -> Coefficient1
forall x. Coefficient1 -> Rep Coefficient1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Coefficient1 -> Rep Coefficient1 x
from :: forall x. Coefficient1 -> Rep Coefficient1 x
$cto :: forall x. Rep Coefficient1 x -> Coefficient1
to :: forall x. Rep Coefficient1 x -> Coefficient1
Generic, (forall (m :: * -> *). Quote m => Coefficient1 -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Coefficient1 -> Code m Coefficient1)
-> Lift Coefficient1
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Coefficient1 -> m Exp
forall (m :: * -> *).
Quote m =>
Coefficient1 -> Code m Coefficient1
$clift :: forall (m :: * -> *). Quote m => Coefficient1 -> m Exp
lift :: forall (m :: * -> *). Quote m => Coefficient1 -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient1 -> Code m Coefficient1
liftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient1 -> Code m Coefficient1
Lift)
      deriving newtype (Int -> Coefficient1 -> ShowS
[Coefficient1] -> ShowS
Coefficient1 -> String
(Int -> Coefficient1 -> ShowS)
-> (Coefficient1 -> String)
-> ([Coefficient1] -> ShowS)
-> Show Coefficient1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Coefficient1 -> ShowS
showsPrec :: Int -> Coefficient1 -> ShowS
$cshow :: Coefficient1 -> String
show :: Coefficient1 -> String
$cshowList :: [Coefficient1] -> ShowS
showList :: [Coefficient1] -> ShowS
Show, Coefficient1 -> Coefficient1 -> Bool
(Coefficient1 -> Coefficient1 -> Bool)
-> (Coefficient1 -> Coefficient1 -> Bool) -> Eq Coefficient1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Coefficient1 -> Coefficient1 -> Bool
== :: Coefficient1 -> Coefficient1 -> Bool
$c/= :: Coefficient1 -> Coefficient1 -> Bool
/= :: Coefficient1 -> Coefficient1 -> Bool
Eq, Integer -> Coefficient1
Coefficient1 -> Coefficient1
Coefficient1 -> Coefficient1 -> Coefficient1
(Coefficient1 -> Coefficient1 -> Coefficient1)
-> (Coefficient1 -> Coefficient1 -> Coefficient1)
-> (Coefficient1 -> Coefficient1 -> Coefficient1)
-> (Coefficient1 -> Coefficient1)
-> (Coefficient1 -> Coefficient1)
-> (Coefficient1 -> Coefficient1)
-> (Integer -> Coefficient1)
-> Num Coefficient1
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Coefficient1 -> Coefficient1 -> Coefficient1
+ :: Coefficient1 -> Coefficient1 -> Coefficient1
$c- :: Coefficient1 -> Coefficient1 -> Coefficient1
- :: Coefficient1 -> Coefficient1 -> Coefficient1
$c* :: Coefficient1 -> Coefficient1 -> Coefficient1
* :: Coefficient1 -> Coefficient1 -> Coefficient1
$cnegate :: Coefficient1 -> Coefficient1
negate :: Coefficient1 -> Coefficient1
$cabs :: Coefficient1 -> Coefficient1
abs :: Coefficient1 -> Coefficient1
$csignum :: Coefficient1 -> Coefficient1
signum :: Coefficient1 -> Coefficient1
$cfromInteger :: Integer -> Coefficient1
fromInteger :: Integer -> Coefficient1
Num, Coefficient1 -> ()
(Coefficient1 -> ()) -> NFData Coefficient1
forall a. (a -> ()) -> NFData a
$crnf :: Coefficient1 -> ()
rnf :: Coefficient1 -> ()
NFData)

-- | A wrapped 'CostingInteger' that is supposed to be used as the degree 2
-- coefficient of a polynomial.
newtype Coefficient2 = Coefficient2
    { Coefficient2 -> CostingInteger
unCoefficient2 :: CostingInteger
    } deriving stock ((forall x. Coefficient2 -> Rep Coefficient2 x)
-> (forall x. Rep Coefficient2 x -> Coefficient2)
-> Generic Coefficient2
forall x. Rep Coefficient2 x -> Coefficient2
forall x. Coefficient2 -> Rep Coefficient2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Coefficient2 -> Rep Coefficient2 x
from :: forall x. Coefficient2 -> Rep Coefficient2 x
$cto :: forall x. Rep Coefficient2 x -> Coefficient2
to :: forall x. Rep Coefficient2 x -> Coefficient2
Generic, (forall (m :: * -> *). Quote m => Coefficient2 -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Coefficient2 -> Code m Coefficient2)
-> Lift Coefficient2
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Coefficient2 -> m Exp
forall (m :: * -> *).
Quote m =>
Coefficient2 -> Code m Coefficient2
$clift :: forall (m :: * -> *). Quote m => Coefficient2 -> m Exp
lift :: forall (m :: * -> *). Quote m => Coefficient2 -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient2 -> Code m Coefficient2
liftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient2 -> Code m Coefficient2
Lift)
      deriving newtype (Int -> Coefficient2 -> ShowS
[Coefficient2] -> ShowS
Coefficient2 -> String
(Int -> Coefficient2 -> ShowS)
-> (Coefficient2 -> String)
-> ([Coefficient2] -> ShowS)
-> Show Coefficient2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Coefficient2 -> ShowS
showsPrec :: Int -> Coefficient2 -> ShowS
$cshow :: Coefficient2 -> String
show :: Coefficient2 -> String
$cshowList :: [Coefficient2] -> ShowS
showList :: [Coefficient2] -> ShowS
Show, Coefficient2 -> Coefficient2 -> Bool
(Coefficient2 -> Coefficient2 -> Bool)
-> (Coefficient2 -> Coefficient2 -> Bool) -> Eq Coefficient2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Coefficient2 -> Coefficient2 -> Bool
== :: Coefficient2 -> Coefficient2 -> Bool
$c/= :: Coefficient2 -> Coefficient2 -> Bool
/= :: Coefficient2 -> Coefficient2 -> Bool
Eq, Integer -> Coefficient2
Coefficient2 -> Coefficient2
Coefficient2 -> Coefficient2 -> Coefficient2
(Coefficient2 -> Coefficient2 -> Coefficient2)
-> (Coefficient2 -> Coefficient2 -> Coefficient2)
-> (Coefficient2 -> Coefficient2 -> Coefficient2)
-> (Coefficient2 -> Coefficient2)
-> (Coefficient2 -> Coefficient2)
-> (Coefficient2 -> Coefficient2)
-> (Integer -> Coefficient2)
-> Num Coefficient2
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Coefficient2 -> Coefficient2 -> Coefficient2
+ :: Coefficient2 -> Coefficient2 -> Coefficient2
$c- :: Coefficient2 -> Coefficient2 -> Coefficient2
- :: Coefficient2 -> Coefficient2 -> Coefficient2
$c* :: Coefficient2 -> Coefficient2 -> Coefficient2
* :: Coefficient2 -> Coefficient2 -> Coefficient2
$cnegate :: Coefficient2 -> Coefficient2
negate :: Coefficient2 -> Coefficient2
$cabs :: Coefficient2 -> Coefficient2
abs :: Coefficient2 -> Coefficient2
$csignum :: Coefficient2 -> Coefficient2
signum :: Coefficient2 -> Coefficient2
$cfromInteger :: Integer -> Coefficient2
fromInteger :: Integer -> Coefficient2
Num, Coefficient2 -> ()
(Coefficient2 -> ()) -> NFData Coefficient2
forall a. (a -> ()) -> NFData a
$crnf :: Coefficient2 -> ()
rnf :: Coefficient2 -> ()
NFData)

-- | A wrapped 'CostingInteger' that is supposed to be used as the degree (0,0)
-- coefficient of a two-variable polynomial.
newtype Coefficient00 = Coefficient00
    { Coefficient00 -> CostingInteger
unCoefficient00 :: CostingInteger
    } deriving stock ((forall x. Coefficient00 -> Rep Coefficient00 x)
-> (forall x. Rep Coefficient00 x -> Coefficient00)
-> Generic Coefficient00
forall x. Rep Coefficient00 x -> Coefficient00
forall x. Coefficient00 -> Rep Coefficient00 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Coefficient00 -> Rep Coefficient00 x
from :: forall x. Coefficient00 -> Rep Coefficient00 x
$cto :: forall x. Rep Coefficient00 x -> Coefficient00
to :: forall x. Rep Coefficient00 x -> Coefficient00
Generic, (forall (m :: * -> *). Quote m => Coefficient00 -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Coefficient00 -> Code m Coefficient00)
-> Lift Coefficient00
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Coefficient00 -> m Exp
forall (m :: * -> *).
Quote m =>
Coefficient00 -> Code m Coefficient00
$clift :: forall (m :: * -> *). Quote m => Coefficient00 -> m Exp
lift :: forall (m :: * -> *). Quote m => Coefficient00 -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient00 -> Code m Coefficient00
liftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient00 -> Code m Coefficient00
Lift)
      deriving newtype (Int -> Coefficient00 -> ShowS
[Coefficient00] -> ShowS
Coefficient00 -> String
(Int -> Coefficient00 -> ShowS)
-> (Coefficient00 -> String)
-> ([Coefficient00] -> ShowS)
-> Show Coefficient00
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Coefficient00 -> ShowS
showsPrec :: Int -> Coefficient00 -> ShowS
$cshow :: Coefficient00 -> String
show :: Coefficient00 -> String
$cshowList :: [Coefficient00] -> ShowS
showList :: [Coefficient00] -> ShowS
Show, Coefficient00 -> Coefficient00 -> Bool
(Coefficient00 -> Coefficient00 -> Bool)
-> (Coefficient00 -> Coefficient00 -> Bool) -> Eq Coefficient00
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Coefficient00 -> Coefficient00 -> Bool
== :: Coefficient00 -> Coefficient00 -> Bool
$c/= :: Coefficient00 -> Coefficient00 -> Bool
/= :: Coefficient00 -> Coefficient00 -> Bool
Eq, Integer -> Coefficient00
Coefficient00 -> Coefficient00
Coefficient00 -> Coefficient00 -> Coefficient00
(Coefficient00 -> Coefficient00 -> Coefficient00)
-> (Coefficient00 -> Coefficient00 -> Coefficient00)
-> (Coefficient00 -> Coefficient00 -> Coefficient00)
-> (Coefficient00 -> Coefficient00)
-> (Coefficient00 -> Coefficient00)
-> (Coefficient00 -> Coefficient00)
-> (Integer -> Coefficient00)
-> Num Coefficient00
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Coefficient00 -> Coefficient00 -> Coefficient00
+ :: Coefficient00 -> Coefficient00 -> Coefficient00
$c- :: Coefficient00 -> Coefficient00 -> Coefficient00
- :: Coefficient00 -> Coefficient00 -> Coefficient00
$c* :: Coefficient00 -> Coefficient00 -> Coefficient00
* :: Coefficient00 -> Coefficient00 -> Coefficient00
$cnegate :: Coefficient00 -> Coefficient00
negate :: Coefficient00 -> Coefficient00
$cabs :: Coefficient00 -> Coefficient00
abs :: Coefficient00 -> Coefficient00
$csignum :: Coefficient00 -> Coefficient00
signum :: Coefficient00 -> Coefficient00
$cfromInteger :: Integer -> Coefficient00
fromInteger :: Integer -> Coefficient00
Num, Coefficient00 -> ()
(Coefficient00 -> ()) -> NFData Coefficient00
forall a. (a -> ()) -> NFData a
$crnf :: Coefficient00 -> ()
rnf :: Coefficient00 -> ()
NFData)

-- | A wrapped 'CostingInteger' that is supposed to be used as the degree (1,0)
-- coefficient of a two-variable polynomial.
newtype Coefficient10 = Coefficient10
    { Coefficient10 -> CostingInteger
unCoefficient10 :: CostingInteger
    } deriving stock ((forall x. Coefficient10 -> Rep Coefficient10 x)
-> (forall x. Rep Coefficient10 x -> Coefficient10)
-> Generic Coefficient10
forall x. Rep Coefficient10 x -> Coefficient10
forall x. Coefficient10 -> Rep Coefficient10 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Coefficient10 -> Rep Coefficient10 x
from :: forall x. Coefficient10 -> Rep Coefficient10 x
$cto :: forall x. Rep Coefficient10 x -> Coefficient10
to :: forall x. Rep Coefficient10 x -> Coefficient10
Generic, (forall (m :: * -> *). Quote m => Coefficient10 -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Coefficient10 -> Code m Coefficient10)
-> Lift Coefficient10
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Coefficient10 -> m Exp
forall (m :: * -> *).
Quote m =>
Coefficient10 -> Code m Coefficient10
$clift :: forall (m :: * -> *). Quote m => Coefficient10 -> m Exp
lift :: forall (m :: * -> *). Quote m => Coefficient10 -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient10 -> Code m Coefficient10
liftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient10 -> Code m Coefficient10
Lift)
      deriving newtype (Int -> Coefficient10 -> ShowS
[Coefficient10] -> ShowS
Coefficient10 -> String
(Int -> Coefficient10 -> ShowS)
-> (Coefficient10 -> String)
-> ([Coefficient10] -> ShowS)
-> Show Coefficient10
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Coefficient10 -> ShowS
showsPrec :: Int -> Coefficient10 -> ShowS
$cshow :: Coefficient10 -> String
show :: Coefficient10 -> String
$cshowList :: [Coefficient10] -> ShowS
showList :: [Coefficient10] -> ShowS
Show, Coefficient10 -> Coefficient10 -> Bool
(Coefficient10 -> Coefficient10 -> Bool)
-> (Coefficient10 -> Coefficient10 -> Bool) -> Eq Coefficient10
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Coefficient10 -> Coefficient10 -> Bool
== :: Coefficient10 -> Coefficient10 -> Bool
$c/= :: Coefficient10 -> Coefficient10 -> Bool
/= :: Coefficient10 -> Coefficient10 -> Bool
Eq, Integer -> Coefficient10
Coefficient10 -> Coefficient10
Coefficient10 -> Coefficient10 -> Coefficient10
(Coefficient10 -> Coefficient10 -> Coefficient10)
-> (Coefficient10 -> Coefficient10 -> Coefficient10)
-> (Coefficient10 -> Coefficient10 -> Coefficient10)
-> (Coefficient10 -> Coefficient10)
-> (Coefficient10 -> Coefficient10)
-> (Coefficient10 -> Coefficient10)
-> (Integer -> Coefficient10)
-> Num Coefficient10
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Coefficient10 -> Coefficient10 -> Coefficient10
+ :: Coefficient10 -> Coefficient10 -> Coefficient10
$c- :: Coefficient10 -> Coefficient10 -> Coefficient10
- :: Coefficient10 -> Coefficient10 -> Coefficient10
$c* :: Coefficient10 -> Coefficient10 -> Coefficient10
* :: Coefficient10 -> Coefficient10 -> Coefficient10
$cnegate :: Coefficient10 -> Coefficient10
negate :: Coefficient10 -> Coefficient10
$cabs :: Coefficient10 -> Coefficient10
abs :: Coefficient10 -> Coefficient10
$csignum :: Coefficient10 -> Coefficient10
signum :: Coefficient10 -> Coefficient10
$cfromInteger :: Integer -> Coefficient10
fromInteger :: Integer -> Coefficient10
Num, Coefficient10 -> ()
(Coefficient10 -> ()) -> NFData Coefficient10
forall a. (a -> ()) -> NFData a
$crnf :: Coefficient10 -> ()
rnf :: Coefficient10 -> ()
NFData)

-- | A wrapped 'CostingInteger' that is supposed to be used as the degree (0,1)
-- coefficient of a two-variable polynomial.
newtype Coefficient01 = Coefficient01
    { Coefficient01 -> CostingInteger
unCoefficient01 :: CostingInteger
    } deriving stock ((forall x. Coefficient01 -> Rep Coefficient01 x)
-> (forall x. Rep Coefficient01 x -> Coefficient01)
-> Generic Coefficient01
forall x. Rep Coefficient01 x -> Coefficient01
forall x. Coefficient01 -> Rep Coefficient01 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Coefficient01 -> Rep Coefficient01 x
from :: forall x. Coefficient01 -> Rep Coefficient01 x
$cto :: forall x. Rep Coefficient01 x -> Coefficient01
to :: forall x. Rep Coefficient01 x -> Coefficient01
Generic, (forall (m :: * -> *). Quote m => Coefficient01 -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Coefficient01 -> Code m Coefficient01)
-> Lift Coefficient01
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Coefficient01 -> m Exp
forall (m :: * -> *).
Quote m =>
Coefficient01 -> Code m Coefficient01
$clift :: forall (m :: * -> *). Quote m => Coefficient01 -> m Exp
lift :: forall (m :: * -> *). Quote m => Coefficient01 -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient01 -> Code m Coefficient01
liftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient01 -> Code m Coefficient01
Lift)
      deriving newtype (Int -> Coefficient01 -> ShowS
[Coefficient01] -> ShowS
Coefficient01 -> String
(Int -> Coefficient01 -> ShowS)
-> (Coefficient01 -> String)
-> ([Coefficient01] -> ShowS)
-> Show Coefficient01
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Coefficient01 -> ShowS
showsPrec :: Int -> Coefficient01 -> ShowS
$cshow :: Coefficient01 -> String
show :: Coefficient01 -> String
$cshowList :: [Coefficient01] -> ShowS
showList :: [Coefficient01] -> ShowS
Show, Coefficient01 -> Coefficient01 -> Bool
(Coefficient01 -> Coefficient01 -> Bool)
-> (Coefficient01 -> Coefficient01 -> Bool) -> Eq Coefficient01
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Coefficient01 -> Coefficient01 -> Bool
== :: Coefficient01 -> Coefficient01 -> Bool
$c/= :: Coefficient01 -> Coefficient01 -> Bool
/= :: Coefficient01 -> Coefficient01 -> Bool
Eq, Integer -> Coefficient01
Coefficient01 -> Coefficient01
Coefficient01 -> Coefficient01 -> Coefficient01
(Coefficient01 -> Coefficient01 -> Coefficient01)
-> (Coefficient01 -> Coefficient01 -> Coefficient01)
-> (Coefficient01 -> Coefficient01 -> Coefficient01)
-> (Coefficient01 -> Coefficient01)
-> (Coefficient01 -> Coefficient01)
-> (Coefficient01 -> Coefficient01)
-> (Integer -> Coefficient01)
-> Num Coefficient01
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Coefficient01 -> Coefficient01 -> Coefficient01
+ :: Coefficient01 -> Coefficient01 -> Coefficient01
$c- :: Coefficient01 -> Coefficient01 -> Coefficient01
- :: Coefficient01 -> Coefficient01 -> Coefficient01
$c* :: Coefficient01 -> Coefficient01 -> Coefficient01
* :: Coefficient01 -> Coefficient01 -> Coefficient01
$cnegate :: Coefficient01 -> Coefficient01
negate :: Coefficient01 -> Coefficient01
$cabs :: Coefficient01 -> Coefficient01
abs :: Coefficient01 -> Coefficient01
$csignum :: Coefficient01 -> Coefficient01
signum :: Coefficient01 -> Coefficient01
$cfromInteger :: Integer -> Coefficient01
fromInteger :: Integer -> Coefficient01
Num, Coefficient01 -> ()
(Coefficient01 -> ()) -> NFData Coefficient01
forall a. (a -> ()) -> NFData a
$crnf :: Coefficient01 -> ()
rnf :: Coefficient01 -> ()
NFData)

-- | A wrapped 'CostingInteger' that is supposed to be used as the degree (2,0)
-- coefficient of a two-variable polynomial.
newtype Coefficient20 = Coefficient20
    { Coefficient20 -> CostingInteger
unCoefficient20 :: CostingInteger
    } deriving stock ((forall x. Coefficient20 -> Rep Coefficient20 x)
-> (forall x. Rep Coefficient20 x -> Coefficient20)
-> Generic Coefficient20
forall x. Rep Coefficient20 x -> Coefficient20
forall x. Coefficient20 -> Rep Coefficient20 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Coefficient20 -> Rep Coefficient20 x
from :: forall x. Coefficient20 -> Rep Coefficient20 x
$cto :: forall x. Rep Coefficient20 x -> Coefficient20
to :: forall x. Rep Coefficient20 x -> Coefficient20
Generic, (forall (m :: * -> *). Quote m => Coefficient20 -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Coefficient20 -> Code m Coefficient20)
-> Lift Coefficient20
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Coefficient20 -> m Exp
forall (m :: * -> *).
Quote m =>
Coefficient20 -> Code m Coefficient20
$clift :: forall (m :: * -> *). Quote m => Coefficient20 -> m Exp
lift :: forall (m :: * -> *). Quote m => Coefficient20 -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient20 -> Code m Coefficient20
liftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient20 -> Code m Coefficient20
Lift)
      deriving newtype (Int -> Coefficient20 -> ShowS
[Coefficient20] -> ShowS
Coefficient20 -> String
(Int -> Coefficient20 -> ShowS)
-> (Coefficient20 -> String)
-> ([Coefficient20] -> ShowS)
-> Show Coefficient20
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Coefficient20 -> ShowS
showsPrec :: Int -> Coefficient20 -> ShowS
$cshow :: Coefficient20 -> String
show :: Coefficient20 -> String
$cshowList :: [Coefficient20] -> ShowS
showList :: [Coefficient20] -> ShowS
Show, Coefficient20 -> Coefficient20 -> Bool
(Coefficient20 -> Coefficient20 -> Bool)
-> (Coefficient20 -> Coefficient20 -> Bool) -> Eq Coefficient20
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Coefficient20 -> Coefficient20 -> Bool
== :: Coefficient20 -> Coefficient20 -> Bool
$c/= :: Coefficient20 -> Coefficient20 -> Bool
/= :: Coefficient20 -> Coefficient20 -> Bool
Eq, Integer -> Coefficient20
Coefficient20 -> Coefficient20
Coefficient20 -> Coefficient20 -> Coefficient20
(Coefficient20 -> Coefficient20 -> Coefficient20)
-> (Coefficient20 -> Coefficient20 -> Coefficient20)
-> (Coefficient20 -> Coefficient20 -> Coefficient20)
-> (Coefficient20 -> Coefficient20)
-> (Coefficient20 -> Coefficient20)
-> (Coefficient20 -> Coefficient20)
-> (Integer -> Coefficient20)
-> Num Coefficient20
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Coefficient20 -> Coefficient20 -> Coefficient20
+ :: Coefficient20 -> Coefficient20 -> Coefficient20
$c- :: Coefficient20 -> Coefficient20 -> Coefficient20
- :: Coefficient20 -> Coefficient20 -> Coefficient20
$c* :: Coefficient20 -> Coefficient20 -> Coefficient20
* :: Coefficient20 -> Coefficient20 -> Coefficient20
$cnegate :: Coefficient20 -> Coefficient20
negate :: Coefficient20 -> Coefficient20
$cabs :: Coefficient20 -> Coefficient20
abs :: Coefficient20 -> Coefficient20
$csignum :: Coefficient20 -> Coefficient20
signum :: Coefficient20 -> Coefficient20
$cfromInteger :: Integer -> Coefficient20
fromInteger :: Integer -> Coefficient20
Num, Coefficient20 -> ()
(Coefficient20 -> ()) -> NFData Coefficient20
forall a. (a -> ()) -> NFData a
$crnf :: Coefficient20 -> ()
rnf :: Coefficient20 -> ()
NFData)

-- | A wrapped 'CostingInteger' that is supposed to be used as the degree (1,1)
-- coefficient of a two-variable polynomial.
newtype Coefficient11 = Coefficient11
    { Coefficient11 -> CostingInteger
unCoefficient11 :: CostingInteger
    } deriving stock ((forall x. Coefficient11 -> Rep Coefficient11 x)
-> (forall x. Rep Coefficient11 x -> Coefficient11)
-> Generic Coefficient11
forall x. Rep Coefficient11 x -> Coefficient11
forall x. Coefficient11 -> Rep Coefficient11 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Coefficient11 -> Rep Coefficient11 x
from :: forall x. Coefficient11 -> Rep Coefficient11 x
$cto :: forall x. Rep Coefficient11 x -> Coefficient11
to :: forall x. Rep Coefficient11 x -> Coefficient11
Generic, (forall (m :: * -> *). Quote m => Coefficient11 -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Coefficient11 -> Code m Coefficient11)
-> Lift Coefficient11
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Coefficient11 -> m Exp
forall (m :: * -> *).
Quote m =>
Coefficient11 -> Code m Coefficient11
$clift :: forall (m :: * -> *). Quote m => Coefficient11 -> m Exp
lift :: forall (m :: * -> *). Quote m => Coefficient11 -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient11 -> Code m Coefficient11
liftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient11 -> Code m Coefficient11
Lift)
      deriving newtype (Int -> Coefficient11 -> ShowS
[Coefficient11] -> ShowS
Coefficient11 -> String
(Int -> Coefficient11 -> ShowS)
-> (Coefficient11 -> String)
-> ([Coefficient11] -> ShowS)
-> Show Coefficient11
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Coefficient11 -> ShowS
showsPrec :: Int -> Coefficient11 -> ShowS
$cshow :: Coefficient11 -> String
show :: Coefficient11 -> String
$cshowList :: [Coefficient11] -> ShowS
showList :: [Coefficient11] -> ShowS
Show, Coefficient11 -> Coefficient11 -> Bool
(Coefficient11 -> Coefficient11 -> Bool)
-> (Coefficient11 -> Coefficient11 -> Bool) -> Eq Coefficient11
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Coefficient11 -> Coefficient11 -> Bool
== :: Coefficient11 -> Coefficient11 -> Bool
$c/= :: Coefficient11 -> Coefficient11 -> Bool
/= :: Coefficient11 -> Coefficient11 -> Bool
Eq, Integer -> Coefficient11
Coefficient11 -> Coefficient11
Coefficient11 -> Coefficient11 -> Coefficient11
(Coefficient11 -> Coefficient11 -> Coefficient11)
-> (Coefficient11 -> Coefficient11 -> Coefficient11)
-> (Coefficient11 -> Coefficient11 -> Coefficient11)
-> (Coefficient11 -> Coefficient11)
-> (Coefficient11 -> Coefficient11)
-> (Coefficient11 -> Coefficient11)
-> (Integer -> Coefficient11)
-> Num Coefficient11
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Coefficient11 -> Coefficient11 -> Coefficient11
+ :: Coefficient11 -> Coefficient11 -> Coefficient11
$c- :: Coefficient11 -> Coefficient11 -> Coefficient11
- :: Coefficient11 -> Coefficient11 -> Coefficient11
$c* :: Coefficient11 -> Coefficient11 -> Coefficient11
* :: Coefficient11 -> Coefficient11 -> Coefficient11
$cnegate :: Coefficient11 -> Coefficient11
negate :: Coefficient11 -> Coefficient11
$cabs :: Coefficient11 -> Coefficient11
abs :: Coefficient11 -> Coefficient11
$csignum :: Coefficient11 -> Coefficient11
signum :: Coefficient11 -> Coefficient11
$cfromInteger :: Integer -> Coefficient11
fromInteger :: Integer -> Coefficient11
Num, Coefficient11 -> ()
(Coefficient11 -> ()) -> NFData Coefficient11
forall a. (a -> ()) -> NFData a
$crnf :: Coefficient11 -> ()
rnf :: Coefficient11 -> ()
NFData)

-- | A wrapped 'CostingInteger' that is supposed to be used as the degree (0,2)
-- coefficient of a two-variable polynomial.
newtype Coefficient02 = Coefficient02
    { Coefficient02 -> CostingInteger
unCoefficient02 :: CostingInteger
    } deriving stock ((forall x. Coefficient02 -> Rep Coefficient02 x)
-> (forall x. Rep Coefficient02 x -> Coefficient02)
-> Generic Coefficient02
forall x. Rep Coefficient02 x -> Coefficient02
forall x. Coefficient02 -> Rep Coefficient02 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Coefficient02 -> Rep Coefficient02 x
from :: forall x. Coefficient02 -> Rep Coefficient02 x
$cto :: forall x. Rep Coefficient02 x -> Coefficient02
to :: forall x. Rep Coefficient02 x -> Coefficient02
Generic, (forall (m :: * -> *). Quote m => Coefficient02 -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Coefficient02 -> Code m Coefficient02)
-> Lift Coefficient02
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Coefficient02 -> m Exp
forall (m :: * -> *).
Quote m =>
Coefficient02 -> Code m Coefficient02
$clift :: forall (m :: * -> *). Quote m => Coefficient02 -> m Exp
lift :: forall (m :: * -> *). Quote m => Coefficient02 -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient02 -> Code m Coefficient02
liftTyped :: forall (m :: * -> *).
Quote m =>
Coefficient02 -> Code m Coefficient02
Lift)
      deriving newtype (Int -> Coefficient02 -> ShowS
[Coefficient02] -> ShowS
Coefficient02 -> String
(Int -> Coefficient02 -> ShowS)
-> (Coefficient02 -> String)
-> ([Coefficient02] -> ShowS)
-> Show Coefficient02
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Coefficient02 -> ShowS
showsPrec :: Int -> Coefficient02 -> ShowS
$cshow :: Coefficient02 -> String
show :: Coefficient02 -> String
$cshowList :: [Coefficient02] -> ShowS
showList :: [Coefficient02] -> ShowS
Show, Coefficient02 -> Coefficient02 -> Bool
(Coefficient02 -> Coefficient02 -> Bool)
-> (Coefficient02 -> Coefficient02 -> Bool) -> Eq Coefficient02
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Coefficient02 -> Coefficient02 -> Bool
== :: Coefficient02 -> Coefficient02 -> Bool
$c/= :: Coefficient02 -> Coefficient02 -> Bool
/= :: Coefficient02 -> Coefficient02 -> Bool
Eq, Integer -> Coefficient02
Coefficient02 -> Coefficient02
Coefficient02 -> Coefficient02 -> Coefficient02
(Coefficient02 -> Coefficient02 -> Coefficient02)
-> (Coefficient02 -> Coefficient02 -> Coefficient02)
-> (Coefficient02 -> Coefficient02 -> Coefficient02)
-> (Coefficient02 -> Coefficient02)
-> (Coefficient02 -> Coefficient02)
-> (Coefficient02 -> Coefficient02)
-> (Integer -> Coefficient02)
-> Num Coefficient02
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Coefficient02 -> Coefficient02 -> Coefficient02
+ :: Coefficient02 -> Coefficient02 -> Coefficient02
$c- :: Coefficient02 -> Coefficient02 -> Coefficient02
- :: Coefficient02 -> Coefficient02 -> Coefficient02
$c* :: Coefficient02 -> Coefficient02 -> Coefficient02
* :: Coefficient02 -> Coefficient02 -> Coefficient02
$cnegate :: Coefficient02 -> Coefficient02
negate :: Coefficient02 -> Coefficient02
$cabs :: Coefficient02 -> Coefficient02
abs :: Coefficient02 -> Coefficient02
$csignum :: Coefficient02 -> Coefficient02
signum :: Coefficient02 -> Coefficient02
$cfromInteger :: Integer -> Coefficient02
fromInteger :: Integer -> Coefficient02
Num, Coefficient02 -> ()
(Coefficient02 -> ()) -> NFData Coefficient02
forall a. (a -> ()) -> NFData a
$crnf :: Coefficient02 -> ()
rnf :: Coefficient02 -> ()
NFData)

---------------- One-argument costing functions ----------------

data ModelOneArgument =
    ModelOneArgumentConstantCost CostingInteger
    | ModelOneArgumentLinearInX OneVariableLinearFunction
    deriving stock (Int -> ModelOneArgument -> ShowS
[ModelOneArgument] -> ShowS
ModelOneArgument -> String
(Int -> ModelOneArgument -> ShowS)
-> (ModelOneArgument -> String)
-> ([ModelOneArgument] -> ShowS)
-> Show ModelOneArgument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelOneArgument -> ShowS
showsPrec :: Int -> ModelOneArgument -> ShowS
$cshow :: ModelOneArgument -> String
show :: ModelOneArgument -> String
$cshowList :: [ModelOneArgument] -> ShowS
showList :: [ModelOneArgument] -> ShowS
Show, ModelOneArgument -> ModelOneArgument -> Bool
(ModelOneArgument -> ModelOneArgument -> Bool)
-> (ModelOneArgument -> ModelOneArgument -> Bool)
-> Eq ModelOneArgument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelOneArgument -> ModelOneArgument -> Bool
== :: ModelOneArgument -> ModelOneArgument -> Bool
$c/= :: ModelOneArgument -> ModelOneArgument -> Bool
/= :: ModelOneArgument -> ModelOneArgument -> Bool
Eq, (forall x. ModelOneArgument -> Rep ModelOneArgument x)
-> (forall x. Rep ModelOneArgument x -> ModelOneArgument)
-> Generic ModelOneArgument
forall x. Rep ModelOneArgument x -> ModelOneArgument
forall x. ModelOneArgument -> Rep ModelOneArgument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModelOneArgument -> Rep ModelOneArgument x
from :: forall x. ModelOneArgument -> Rep ModelOneArgument x
$cto :: forall x. Rep ModelOneArgument x -> ModelOneArgument
to :: forall x. Rep ModelOneArgument x -> ModelOneArgument
Generic, (forall (m :: * -> *). Quote m => ModelOneArgument -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ModelOneArgument -> Code m ModelOneArgument)
-> Lift ModelOneArgument
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ModelOneArgument -> m Exp
forall (m :: * -> *).
Quote m =>
ModelOneArgument -> Code m ModelOneArgument
$clift :: forall (m :: * -> *). Quote m => ModelOneArgument -> m Exp
lift :: forall (m :: * -> *). Quote m => ModelOneArgument -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ModelOneArgument -> Code m ModelOneArgument
liftTyped :: forall (m :: * -> *).
Quote m =>
ModelOneArgument -> Code m ModelOneArgument
Lift)
    deriving anyclass (ModelOneArgument -> ()
(ModelOneArgument -> ()) -> NFData ModelOneArgument
forall a. (a -> ()) -> NFData a
$crnf :: ModelOneArgument -> ()
rnf :: ModelOneArgument -> ()
NFData)

instance Default ModelOneArgument where
    def :: ModelOneArgument
def = CostingInteger -> ModelOneArgument
ModelOneArgumentConstantCost CostingInteger
forall a. Bounded a => a
maxBound

instance UnimplementedCostingFun ModelOneArgument where
  unimplementedCostingFun :: forall b. b -> CostingFun ModelOneArgument
unimplementedCostingFun = (CostingInteger -> ModelOneArgument)
-> b -> CostingFun ModelOneArgument
forall model b. (CostingInteger -> model) -> b -> CostingFun model
makeUnimplementedCostingFun CostingInteger -> ModelOneArgument
ModelOneArgumentConstantCost

{- Note [runCostingFun* API]
Costing functions take unlifted values, compute the 'ExMemory' of each of them and then invoke
the corresponding @run*Model@ over the computed 'ExMemory's. The reason why we don't just make the
costing functions take 'ExMemory's in the first place is that this would move the burden of
computing the 'ExMemory's onto the caller, i.e. the user defining the meaning of a builtin and it
would be just another hoop to jump through and a completely unnecessary complication for the user.

The reason why costing functions take unlifted values are:

1. we need to unlift them anyway to compute the result of a builtin application, so since we already
   need them elsewhere, we can utilize them in the costing machinery too. Otherwise the costing
   machinery would need to do some unlifting itself, which would be wasteful
2. the costing function might actually depend on the constants that get fed to the builtin.
   For example, checking equality of integers stored in a 'Data' object potentially has a different
   complexity to checking equality of lists of bytestrings
-}

{- Note [Optimizations of runCostingFun*]
We optimize all @runCostingFun*@ functions in the same way:

1. the two calls to @run*Model@ are placed right after matching on the first argument, so that
   they are partially computed and cached, which results in them being called only once per builtin
2. we use a strict case-expression for matching, which GHC can't move inside the resulting lambda
   (unlike a strict let-expression for example)
3. the whole definition is marked with @INLINE@, because it gets worker-wrapper transformed and we
   don't want to keep the worker separate from the wrapper as it just results in unnecessary
   wrapping-unwrapping

In order for @run*Model@ functions to be able to partially compute we need to define them
accordingly, i.e. by matching on the first argument and returning a lambda. We wrap one of the
clauses with a call to 'lazy', so that GHC does not "optimize" the function by moving matching to
the inside of the resulting lambda (which would defeat the whole purpose of caching the function).
It's enough to put 'lazy' in only one of the clauses for all of them to be compiled the right way,
however adding 'lazy' to all the other clauses too turned out to improve performance by a couple of
percent, reasons are unclear.

Alternatively, we could use @-fpedantic-bottoms@, which prevents GHC from moving matching above
a lambda (see https://github.com/IntersectMBO/plutus/pull/4621), however it doesn't make anything
faster, generates more Core and doesn't take much to break, hence we choose the hacky 'lazy'
version.

Since we want @run*Model@ functions to partially compute, we mark them as @NOINLINE@ to prevent GHC
from inlining them and breaking the sharing friendliness. Without the @NOINLINE@ Core doesn't seem
to be worse, however it was verified that no @NOINLINE@ causes a slowdown in both the @validation@
and @nofib@ benchmarks.

Note that looking at the generated Core isn't really enough. We might have enemies down the pipeline,
for example @-fstg-lift-lams@ looks suspicious:

> Enables the late lambda lifting optimisation on the STG intermediate language. This selectively
> lifts local functions to top-level by converting free variables into function parameters.

This wasn't investigated.

These optimizations gave us a ~3.2% speedup at the time this Note was written.
-}

-- See Note [runCostingFun* API].
runCostingFunOneArgument
    :: ExMemoryUsage a1
    => CostingFun ModelOneArgument
    -> a1
    -> ExBudgetStream
runCostingFunOneArgument :: forall a1.
ExMemoryUsage a1 =>
CostingFun ModelOneArgument -> a1 -> ExBudgetStream
runCostingFunOneArgument (CostingFun ModelOneArgument
cpu ModelOneArgument
mem) =
    case (ModelOneArgument -> CostStream -> CostStream
runOneArgumentModel ModelOneArgument
cpu, ModelOneArgument -> CostStream -> CostStream
runOneArgumentModel ModelOneArgument
mem) of
        (!CostStream -> CostStream
runCpu, !CostStream -> CostStream
runMem) -> (CostStream -> ExBudgetStream) -> a1 -> ExBudgetStream
forall c a. OnMemoryUsages c a => c -> a
onMemoryUsages ((CostStream -> ExBudgetStream) -> a1 -> ExBudgetStream)
-> (CostStream -> ExBudgetStream) -> a1 -> ExBudgetStream
forall a b. (a -> b) -> a -> b
$ \CostStream
mem1 ->
            CostStream -> CostStream -> ExBudgetStream
zipCostStream
                (CostStream -> CostStream
runCpu CostStream
mem1)
                (CostStream -> CostStream
runMem CostStream
mem1)
{-# INLINE runCostingFunOneArgument #-}

-- | Take an intercept, a slope and a stream and scale each element of the stream by the slope and
-- cons the intercept to the stream afterwards.
scaleLinearly :: Intercept -> Slope -> CostStream -> CostStream
scaleLinearly :: Intercept -> Slope -> CostStream -> CostStream
scaleLinearly (Intercept CostingInteger
intercept) (Slope CostingInteger
slope) =
    CostStream -> CostStream -> CostStream
addCostStream (CostingInteger -> CostStream
CostLast CostingInteger
intercept) (CostStream -> CostStream)
-> (CostStream -> CostStream) -> CostStream -> CostStream
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CostingInteger -> CostingInteger) -> CostStream -> CostStream
mapCostStream (CostingInteger
slope CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
*)
{-# INLINE scaleLinearly #-}

runOneArgumentModel
    :: ModelOneArgument
    -> CostStream
    -> CostStream
runOneArgumentModel :: ModelOneArgument -> CostStream -> CostStream
runOneArgumentModel (ModelOneArgumentConstantCost CostingInteger
c) =
    (CostStream -> CostStream) -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream) -> CostStream -> CostStream)
-> (CostStream -> CostStream) -> CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
_ -> CostingInteger -> CostStream
CostLast CostingInteger
c
runOneArgumentModel (ModelOneArgumentLinearInX (OneVariableLinearFunction Intercept
intercept Slope
slope)) =
    (CostStream -> CostStream) -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream) -> CostStream -> CostStream)
-> (CostStream -> CostStream) -> CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
costs1 -> Intercept -> Slope -> CostStream -> CostStream
scaleLinearly Intercept
intercept Slope
slope CostStream
costs1
{-# NOINLINE runOneArgumentModel #-}

---------------- Two-argument costing functions ----------------

{- Because of the way the costing code has evolved the names of the model types
below aren't very consistent.  However it's a little difficult to change them
because that would change some of the JSON tags in the cost model file.  The
basic models are one-variable and two-variable linear models and their names
(`OneVariableLinearFunction` and `TwoVariableLinearFunction`) reflect this .
Other models have names like `ModelAddedSizes` and it might be more logical if
they were called things like `LinearInXPlusY` and so on since these are really
abstract functions that don't know anything about sizes.  Also many of the types
have their own intercept and slope values because they are linear on some
function of the inputs or are linear in some region of the plane.  Maybe these
should contain nested objects of type ModelLinearInOneVariable instead, but that
would complicate the JSON encoding and might also impact efficiency.
-}

-- | s * x + I
data OneVariableLinearFunction = OneVariableLinearFunction
    { OneVariableLinearFunction -> Intercept
oneVariableLinearFunctionIntercept :: Intercept
    , OneVariableLinearFunction -> Slope
oneVariableLinearFunctionSlope     :: Slope
    } deriving stock (Int -> OneVariableLinearFunction -> ShowS
[OneVariableLinearFunction] -> ShowS
OneVariableLinearFunction -> String
(Int -> OneVariableLinearFunction -> ShowS)
-> (OneVariableLinearFunction -> String)
-> ([OneVariableLinearFunction] -> ShowS)
-> Show OneVariableLinearFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OneVariableLinearFunction -> ShowS
showsPrec :: Int -> OneVariableLinearFunction -> ShowS
$cshow :: OneVariableLinearFunction -> String
show :: OneVariableLinearFunction -> String
$cshowList :: [OneVariableLinearFunction] -> ShowS
showList :: [OneVariableLinearFunction] -> ShowS
Show, OneVariableLinearFunction -> OneVariableLinearFunction -> Bool
(OneVariableLinearFunction -> OneVariableLinearFunction -> Bool)
-> (OneVariableLinearFunction -> OneVariableLinearFunction -> Bool)
-> Eq OneVariableLinearFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OneVariableLinearFunction -> OneVariableLinearFunction -> Bool
== :: OneVariableLinearFunction -> OneVariableLinearFunction -> Bool
$c/= :: OneVariableLinearFunction -> OneVariableLinearFunction -> Bool
/= :: OneVariableLinearFunction -> OneVariableLinearFunction -> Bool
Eq, (forall x.
 OneVariableLinearFunction -> Rep OneVariableLinearFunction x)
-> (forall x.
    Rep OneVariableLinearFunction x -> OneVariableLinearFunction)
-> Generic OneVariableLinearFunction
forall x.
Rep OneVariableLinearFunction x -> OneVariableLinearFunction
forall x.
OneVariableLinearFunction -> Rep OneVariableLinearFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
OneVariableLinearFunction -> Rep OneVariableLinearFunction x
from :: forall x.
OneVariableLinearFunction -> Rep OneVariableLinearFunction x
$cto :: forall x.
Rep OneVariableLinearFunction x -> OneVariableLinearFunction
to :: forall x.
Rep OneVariableLinearFunction x -> OneVariableLinearFunction
Generic, (forall (m :: * -> *).
 Quote m =>
 OneVariableLinearFunction -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    OneVariableLinearFunction -> Code m OneVariableLinearFunction)
-> Lift OneVariableLinearFunction
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => OneVariableLinearFunction -> m Exp
forall (m :: * -> *).
Quote m =>
OneVariableLinearFunction -> Code m OneVariableLinearFunction
$clift :: forall (m :: * -> *). Quote m => OneVariableLinearFunction -> m Exp
lift :: forall (m :: * -> *). Quote m => OneVariableLinearFunction -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
OneVariableLinearFunction -> Code m OneVariableLinearFunction
liftTyped :: forall (m :: * -> *).
Quote m =>
OneVariableLinearFunction -> Code m OneVariableLinearFunction
Lift)
    deriving anyclass (OneVariableLinearFunction -> ()
(OneVariableLinearFunction -> ())
-> NFData OneVariableLinearFunction
forall a. (a -> ()) -> NFData a
$crnf :: OneVariableLinearFunction -> ()
rnf :: OneVariableLinearFunction -> ()
NFData)

-- | s1 * x + s2 * y + I
data TwoVariableLinearFunction = TwoVariableLinearFunction
    { TwoVariableLinearFunction -> Intercept
twoVariableLinearFunctionIntercept :: Intercept
    , TwoVariableLinearFunction -> Slope
twoVariableLinearFunctionSlope1    :: Slope
    , TwoVariableLinearFunction -> Slope
twoVariableLinearFunctionSlope2    :: Slope
    } deriving stock (Int -> TwoVariableLinearFunction -> ShowS
[TwoVariableLinearFunction] -> ShowS
TwoVariableLinearFunction -> String
(Int -> TwoVariableLinearFunction -> ShowS)
-> (TwoVariableLinearFunction -> String)
-> ([TwoVariableLinearFunction] -> ShowS)
-> Show TwoVariableLinearFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TwoVariableLinearFunction -> ShowS
showsPrec :: Int -> TwoVariableLinearFunction -> ShowS
$cshow :: TwoVariableLinearFunction -> String
show :: TwoVariableLinearFunction -> String
$cshowList :: [TwoVariableLinearFunction] -> ShowS
showList :: [TwoVariableLinearFunction] -> ShowS
Show, TwoVariableLinearFunction -> TwoVariableLinearFunction -> Bool
(TwoVariableLinearFunction -> TwoVariableLinearFunction -> Bool)
-> (TwoVariableLinearFunction -> TwoVariableLinearFunction -> Bool)
-> Eq TwoVariableLinearFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TwoVariableLinearFunction -> TwoVariableLinearFunction -> Bool
== :: TwoVariableLinearFunction -> TwoVariableLinearFunction -> Bool
$c/= :: TwoVariableLinearFunction -> TwoVariableLinearFunction -> Bool
/= :: TwoVariableLinearFunction -> TwoVariableLinearFunction -> Bool
Eq, (forall x.
 TwoVariableLinearFunction -> Rep TwoVariableLinearFunction x)
-> (forall x.
    Rep TwoVariableLinearFunction x -> TwoVariableLinearFunction)
-> Generic TwoVariableLinearFunction
forall x.
Rep TwoVariableLinearFunction x -> TwoVariableLinearFunction
forall x.
TwoVariableLinearFunction -> Rep TwoVariableLinearFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
TwoVariableLinearFunction -> Rep TwoVariableLinearFunction x
from :: forall x.
TwoVariableLinearFunction -> Rep TwoVariableLinearFunction x
$cto :: forall x.
Rep TwoVariableLinearFunction x -> TwoVariableLinearFunction
to :: forall x.
Rep TwoVariableLinearFunction x -> TwoVariableLinearFunction
Generic, (forall (m :: * -> *).
 Quote m =>
 TwoVariableLinearFunction -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    TwoVariableLinearFunction -> Code m TwoVariableLinearFunction)
-> Lift TwoVariableLinearFunction
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => TwoVariableLinearFunction -> m Exp
forall (m :: * -> *).
Quote m =>
TwoVariableLinearFunction -> Code m TwoVariableLinearFunction
$clift :: forall (m :: * -> *). Quote m => TwoVariableLinearFunction -> m Exp
lift :: forall (m :: * -> *). Quote m => TwoVariableLinearFunction -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
TwoVariableLinearFunction -> Code m TwoVariableLinearFunction
liftTyped :: forall (m :: * -> *).
Quote m =>
TwoVariableLinearFunction -> Code m TwoVariableLinearFunction
Lift)
    deriving anyclass (TwoVariableLinearFunction -> ()
(TwoVariableLinearFunction -> ())
-> NFData TwoVariableLinearFunction
forall a. (a -> ()) -> NFData a
$crnf :: TwoVariableLinearFunction -> ()
rnf :: TwoVariableLinearFunction -> ()
NFData)

-- | c0 + c1*x + c2*x^2
data OneVariableQuadraticFunction = OneVariableQuadraticFunction
    { OneVariableQuadraticFunction -> Coefficient0
oneVariableQuadraticFunctionC0 :: Coefficient0
    , OneVariableQuadraticFunction -> Coefficient1
oneVariableQuadraticFunctionC1 :: Coefficient1
    , OneVariableQuadraticFunction -> Coefficient2
oneVariableQuadraticFunctionC2 :: Coefficient2
    } deriving stock (Int -> OneVariableQuadraticFunction -> ShowS
[OneVariableQuadraticFunction] -> ShowS
OneVariableQuadraticFunction -> String
(Int -> OneVariableQuadraticFunction -> ShowS)
-> (OneVariableQuadraticFunction -> String)
-> ([OneVariableQuadraticFunction] -> ShowS)
-> Show OneVariableQuadraticFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OneVariableQuadraticFunction -> ShowS
showsPrec :: Int -> OneVariableQuadraticFunction -> ShowS
$cshow :: OneVariableQuadraticFunction -> String
show :: OneVariableQuadraticFunction -> String
$cshowList :: [OneVariableQuadraticFunction] -> ShowS
showList :: [OneVariableQuadraticFunction] -> ShowS
Show, OneVariableQuadraticFunction
-> OneVariableQuadraticFunction -> Bool
(OneVariableQuadraticFunction
 -> OneVariableQuadraticFunction -> Bool)
-> (OneVariableQuadraticFunction
    -> OneVariableQuadraticFunction -> Bool)
-> Eq OneVariableQuadraticFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OneVariableQuadraticFunction
-> OneVariableQuadraticFunction -> Bool
== :: OneVariableQuadraticFunction
-> OneVariableQuadraticFunction -> Bool
$c/= :: OneVariableQuadraticFunction
-> OneVariableQuadraticFunction -> Bool
/= :: OneVariableQuadraticFunction
-> OneVariableQuadraticFunction -> Bool
Eq, (forall x.
 OneVariableQuadraticFunction -> Rep OneVariableQuadraticFunction x)
-> (forall x.
    Rep OneVariableQuadraticFunction x -> OneVariableQuadraticFunction)
-> Generic OneVariableQuadraticFunction
forall x.
Rep OneVariableQuadraticFunction x -> OneVariableQuadraticFunction
forall x.
OneVariableQuadraticFunction -> Rep OneVariableQuadraticFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
OneVariableQuadraticFunction -> Rep OneVariableQuadraticFunction x
from :: forall x.
OneVariableQuadraticFunction -> Rep OneVariableQuadraticFunction x
$cto :: forall x.
Rep OneVariableQuadraticFunction x -> OneVariableQuadraticFunction
to :: forall x.
Rep OneVariableQuadraticFunction x -> OneVariableQuadraticFunction
Generic, (forall (m :: * -> *).
 Quote m =>
 OneVariableQuadraticFunction -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    OneVariableQuadraticFunction
    -> Code m OneVariableQuadraticFunction)
-> Lift OneVariableQuadraticFunction
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *).
Quote m =>
OneVariableQuadraticFunction -> m Exp
forall (m :: * -> *).
Quote m =>
OneVariableQuadraticFunction -> Code m OneVariableQuadraticFunction
$clift :: forall (m :: * -> *).
Quote m =>
OneVariableQuadraticFunction -> m Exp
lift :: forall (m :: * -> *).
Quote m =>
OneVariableQuadraticFunction -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
OneVariableQuadraticFunction -> Code m OneVariableQuadraticFunction
liftTyped :: forall (m :: * -> *).
Quote m =>
OneVariableQuadraticFunction -> Code m OneVariableQuadraticFunction
Lift)
    deriving anyclass (OneVariableQuadraticFunction -> ()
(OneVariableQuadraticFunction -> ())
-> NFData OneVariableQuadraticFunction
forall a. (a -> ()) -> NFData a
$crnf :: OneVariableQuadraticFunction -> ()
rnf :: OneVariableQuadraticFunction -> ()
NFData)

{-# INLINE evaluateOneVariableQuadraticFunction #-}
evaluateOneVariableQuadraticFunction
  :: OneVariableQuadraticFunction
  -> CostingInteger
  -> CostingInteger
evaluateOneVariableQuadraticFunction :: OneVariableQuadraticFunction -> CostingInteger -> CostingInteger
evaluateOneVariableQuadraticFunction
   (OneVariableQuadraticFunction (Coefficient0 CostingInteger
c0) (Coefficient1 CostingInteger
c1)  (Coefficient2 CostingInteger
c2)) CostingInteger
x =
       CostingInteger
c0 CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
+ CostingInteger
c1CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
*CostingInteger
x CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
+ CostingInteger
c2CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
*CostingInteger
xCostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
*CostingInteger
x

{- Note [Minimum values for two-variable quadratic costing functions] Unlike most
   of our other costing functions our use cases for two-variable quadratic
   costing functions may require one or more negative coefficients, so there's a
   danger that we could return a negative cost.  This is unlikely, but we make
   certain that it never happens by returning a result that is at never smaller
   than a minimum value that is stored along with the coefficients of the
   function.
-}
-- | c00 + c10*x + c01*y + c20*x^2 + c11*c*y + c02*y^2
data TwoVariableQuadraticFunction = TwoVariableQuadraticFunction
  { TwoVariableQuadraticFunction -> CostingInteger
twoVariableQuadraticFunctionMinimum :: CostingInteger
  , TwoVariableQuadraticFunction -> Coefficient00
twoVariableQuadraticFunctionC00     :: Coefficient00
  , TwoVariableQuadraticFunction -> Coefficient10
twoVariableQuadraticFunctionC10     :: Coefficient10
  , TwoVariableQuadraticFunction -> Coefficient01
twoVariableQuadraticFunctionC01     :: Coefficient01
  , TwoVariableQuadraticFunction -> Coefficient20
twoVariableQuadraticFunctionC20     :: Coefficient20
  , TwoVariableQuadraticFunction -> Coefficient11
twoVariableQuadraticFunctionC11     :: Coefficient11
  , TwoVariableQuadraticFunction -> Coefficient02
twoVariableQuadraticFunctionC02     :: Coefficient02
  } deriving stock (Int -> TwoVariableQuadraticFunction -> ShowS
[TwoVariableQuadraticFunction] -> ShowS
TwoVariableQuadraticFunction -> String
(Int -> TwoVariableQuadraticFunction -> ShowS)
-> (TwoVariableQuadraticFunction -> String)
-> ([TwoVariableQuadraticFunction] -> ShowS)
-> Show TwoVariableQuadraticFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TwoVariableQuadraticFunction -> ShowS
showsPrec :: Int -> TwoVariableQuadraticFunction -> ShowS
$cshow :: TwoVariableQuadraticFunction -> String
show :: TwoVariableQuadraticFunction -> String
$cshowList :: [TwoVariableQuadraticFunction] -> ShowS
showList :: [TwoVariableQuadraticFunction] -> ShowS
Show, TwoVariableQuadraticFunction
-> TwoVariableQuadraticFunction -> Bool
(TwoVariableQuadraticFunction
 -> TwoVariableQuadraticFunction -> Bool)
-> (TwoVariableQuadraticFunction
    -> TwoVariableQuadraticFunction -> Bool)
-> Eq TwoVariableQuadraticFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TwoVariableQuadraticFunction
-> TwoVariableQuadraticFunction -> Bool
== :: TwoVariableQuadraticFunction
-> TwoVariableQuadraticFunction -> Bool
$c/= :: TwoVariableQuadraticFunction
-> TwoVariableQuadraticFunction -> Bool
/= :: TwoVariableQuadraticFunction
-> TwoVariableQuadraticFunction -> Bool
Eq, (forall x.
 TwoVariableQuadraticFunction -> Rep TwoVariableQuadraticFunction x)
-> (forall x.
    Rep TwoVariableQuadraticFunction x -> TwoVariableQuadraticFunction)
-> Generic TwoVariableQuadraticFunction
forall x.
Rep TwoVariableQuadraticFunction x -> TwoVariableQuadraticFunction
forall x.
TwoVariableQuadraticFunction -> Rep TwoVariableQuadraticFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
TwoVariableQuadraticFunction -> Rep TwoVariableQuadraticFunction x
from :: forall x.
TwoVariableQuadraticFunction -> Rep TwoVariableQuadraticFunction x
$cto :: forall x.
Rep TwoVariableQuadraticFunction x -> TwoVariableQuadraticFunction
to :: forall x.
Rep TwoVariableQuadraticFunction x -> TwoVariableQuadraticFunction
Generic, (forall (m :: * -> *).
 Quote m =>
 TwoVariableQuadraticFunction -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    TwoVariableQuadraticFunction
    -> Code m TwoVariableQuadraticFunction)
-> Lift TwoVariableQuadraticFunction
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *).
Quote m =>
TwoVariableQuadraticFunction -> m Exp
forall (m :: * -> *).
Quote m =>
TwoVariableQuadraticFunction -> Code m TwoVariableQuadraticFunction
$clift :: forall (m :: * -> *).
Quote m =>
TwoVariableQuadraticFunction -> m Exp
lift :: forall (m :: * -> *).
Quote m =>
TwoVariableQuadraticFunction -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
TwoVariableQuadraticFunction -> Code m TwoVariableQuadraticFunction
liftTyped :: forall (m :: * -> *).
Quote m =>
TwoVariableQuadraticFunction -> Code m TwoVariableQuadraticFunction
Lift)
    deriving anyclass (TwoVariableQuadraticFunction -> ()
(TwoVariableQuadraticFunction -> ())
-> NFData TwoVariableQuadraticFunction
forall a. (a -> ()) -> NFData a
$crnf :: TwoVariableQuadraticFunction -> ()
rnf :: TwoVariableQuadraticFunction -> ()
NFData)

{-# INLINE evaluateTwoVariableQuadraticFunction #-}
evaluateTwoVariableQuadraticFunction
  :: TwoVariableQuadraticFunction
  -> CostingInteger
  -> CostingInteger
  -> CostingInteger
evaluateTwoVariableQuadraticFunction :: TwoVariableQuadraticFunction
-> CostingInteger -> CostingInteger -> CostingInteger
evaluateTwoVariableQuadraticFunction
   (TwoVariableQuadraticFunction CostingInteger
minVal
    (Coefficient00 CostingInteger
c00) (Coefficient10 CostingInteger
c10)  (Coefficient01 CostingInteger
c01)
    (Coefficient20 CostingInteger
c20) (Coefficient11 CostingInteger
c11) (Coefficient02 CostingInteger
c02)
   ) CostingInteger
x CostingInteger
y = CostingInteger -> CostingInteger -> CostingInteger
forall a. Ord a => a -> a -> a
max CostingInteger
minVal (CostingInteger
c00 CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
+ CostingInteger
c10CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
*CostingInteger
x CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
+ CostingInteger
c01CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
*CostingInteger
y CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
+ CostingInteger
c20CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
*CostingInteger
xCostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
*CostingInteger
x CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
+ CostingInteger
c11CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
*CostingInteger
xCostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
*CostingInteger
y CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
+ CostingInteger
c02CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
*CostingInteger
yCostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
*CostingInteger
y)
  -- We want to be absolutely sure that we don't get back a negative number
  -- here: see Note [Minimum values for two-variable quadratic costing functions]

-- FIXME: we could use ModelConstantOrOneArgument for
-- ModelTwoArgumentsSubtractedSizes instead, but that would change the order of
-- the cost model parameters since the minimum value would come first instead of
-- last.
-- | s * (x - y) + I
data ModelSubtractedSizes = ModelSubtractedSizes
    { ModelSubtractedSizes -> Intercept
modelSubtractedSizesIntercept :: Intercept
    , ModelSubtractedSizes -> Slope
modelSubtractedSizesSlope     :: Slope
    , ModelSubtractedSizes -> CostingInteger
modelSubtractedSizesMinimum   :: CostingInteger
    } deriving stock (Int -> ModelSubtractedSizes -> ShowS
[ModelSubtractedSizes] -> ShowS
ModelSubtractedSizes -> String
(Int -> ModelSubtractedSizes -> ShowS)
-> (ModelSubtractedSizes -> String)
-> ([ModelSubtractedSizes] -> ShowS)
-> Show ModelSubtractedSizes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelSubtractedSizes -> ShowS
showsPrec :: Int -> ModelSubtractedSizes -> ShowS
$cshow :: ModelSubtractedSizes -> String
show :: ModelSubtractedSizes -> String
$cshowList :: [ModelSubtractedSizes] -> ShowS
showList :: [ModelSubtractedSizes] -> ShowS
Show, ModelSubtractedSizes -> ModelSubtractedSizes -> Bool
(ModelSubtractedSizes -> ModelSubtractedSizes -> Bool)
-> (ModelSubtractedSizes -> ModelSubtractedSizes -> Bool)
-> Eq ModelSubtractedSizes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelSubtractedSizes -> ModelSubtractedSizes -> Bool
== :: ModelSubtractedSizes -> ModelSubtractedSizes -> Bool
$c/= :: ModelSubtractedSizes -> ModelSubtractedSizes -> Bool
/= :: ModelSubtractedSizes -> ModelSubtractedSizes -> Bool
Eq, (forall x. ModelSubtractedSizes -> Rep ModelSubtractedSizes x)
-> (forall x. Rep ModelSubtractedSizes x -> ModelSubtractedSizes)
-> Generic ModelSubtractedSizes
forall x. Rep ModelSubtractedSizes x -> ModelSubtractedSizes
forall x. ModelSubtractedSizes -> Rep ModelSubtractedSizes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModelSubtractedSizes -> Rep ModelSubtractedSizes x
from :: forall x. ModelSubtractedSizes -> Rep ModelSubtractedSizes x
$cto :: forall x. Rep ModelSubtractedSizes x -> ModelSubtractedSizes
to :: forall x. Rep ModelSubtractedSizes x -> ModelSubtractedSizes
Generic, (forall (m :: * -> *). Quote m => ModelSubtractedSizes -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ModelSubtractedSizes -> Code m ModelSubtractedSizes)
-> Lift ModelSubtractedSizes
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ModelSubtractedSizes -> m Exp
forall (m :: * -> *).
Quote m =>
ModelSubtractedSizes -> Code m ModelSubtractedSizes
$clift :: forall (m :: * -> *). Quote m => ModelSubtractedSizes -> m Exp
lift :: forall (m :: * -> *). Quote m => ModelSubtractedSizes -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ModelSubtractedSizes -> Code m ModelSubtractedSizes
liftTyped :: forall (m :: * -> *).
Quote m =>
ModelSubtractedSizes -> Code m ModelSubtractedSizes
Lift)
    deriving anyclass (ModelSubtractedSizes -> ()
(ModelSubtractedSizes -> ()) -> NFData ModelSubtractedSizes
forall a. (a -> ()) -> NFData a
$crnf :: ModelSubtractedSizes -> ()
rnf :: ModelSubtractedSizes -> ()
NFData)

-- | NB: this is subsumed by ModelConstantOrOneArgument, but we have to keep it
-- for the time being.  See Note [Backward compatibility for costing functions].
-- | if p then s*x else c; p depends on usage
data ModelConstantOrLinear = ModelConstantOrLinear
    { ModelConstantOrLinear -> CostingInteger
modelConstantOrLinearConstant  :: CostingInteger
    , ModelConstantOrLinear -> Intercept
modelConstantOrLinearIntercept :: Intercept
    , ModelConstantOrLinear -> Slope
modelConstantOrLinearSlope     :: Slope
    } deriving stock (Int -> ModelConstantOrLinear -> ShowS
[ModelConstantOrLinear] -> ShowS
ModelConstantOrLinear -> String
(Int -> ModelConstantOrLinear -> ShowS)
-> (ModelConstantOrLinear -> String)
-> ([ModelConstantOrLinear] -> ShowS)
-> Show ModelConstantOrLinear
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelConstantOrLinear -> ShowS
showsPrec :: Int -> ModelConstantOrLinear -> ShowS
$cshow :: ModelConstantOrLinear -> String
show :: ModelConstantOrLinear -> String
$cshowList :: [ModelConstantOrLinear] -> ShowS
showList :: [ModelConstantOrLinear] -> ShowS
Show, ModelConstantOrLinear -> ModelConstantOrLinear -> Bool
(ModelConstantOrLinear -> ModelConstantOrLinear -> Bool)
-> (ModelConstantOrLinear -> ModelConstantOrLinear -> Bool)
-> Eq ModelConstantOrLinear
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelConstantOrLinear -> ModelConstantOrLinear -> Bool
== :: ModelConstantOrLinear -> ModelConstantOrLinear -> Bool
$c/= :: ModelConstantOrLinear -> ModelConstantOrLinear -> Bool
/= :: ModelConstantOrLinear -> ModelConstantOrLinear -> Bool
Eq, (forall x. ModelConstantOrLinear -> Rep ModelConstantOrLinear x)
-> (forall x. Rep ModelConstantOrLinear x -> ModelConstantOrLinear)
-> Generic ModelConstantOrLinear
forall x. Rep ModelConstantOrLinear x -> ModelConstantOrLinear
forall x. ModelConstantOrLinear -> Rep ModelConstantOrLinear x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModelConstantOrLinear -> Rep ModelConstantOrLinear x
from :: forall x. ModelConstantOrLinear -> Rep ModelConstantOrLinear x
$cto :: forall x. Rep ModelConstantOrLinear x -> ModelConstantOrLinear
to :: forall x. Rep ModelConstantOrLinear x -> ModelConstantOrLinear
Generic, (forall (m :: * -> *). Quote m => ModelConstantOrLinear -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ModelConstantOrLinear -> Code m ModelConstantOrLinear)
-> Lift ModelConstantOrLinear
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ModelConstantOrLinear -> m Exp
forall (m :: * -> *).
Quote m =>
ModelConstantOrLinear -> Code m ModelConstantOrLinear
$clift :: forall (m :: * -> *). Quote m => ModelConstantOrLinear -> m Exp
lift :: forall (m :: * -> *). Quote m => ModelConstantOrLinear -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ModelConstantOrLinear -> Code m ModelConstantOrLinear
liftTyped :: forall (m :: * -> *).
Quote m =>
ModelConstantOrLinear -> Code m ModelConstantOrLinear
Lift)
    deriving anyclass (ModelConstantOrLinear -> ()
(ModelConstantOrLinear -> ()) -> NFData ModelConstantOrLinear
forall a. (a -> ()) -> NFData a
$crnf :: ModelConstantOrLinear -> ()
rnf :: ModelConstantOrLinear -> ()
NFData)

-- | if p then f(x) else c; p depends on usage
data ModelConstantOrOneArgument = ModelConstantOrOneArgument
    { ModelConstantOrOneArgument -> CostingInteger
modelConstantOrOneArgumentConstant :: CostingInteger
    , ModelConstantOrOneArgument -> ModelOneArgument
modelConstantOrOneArgumentModel    :: ModelOneArgument
    } deriving stock (Int -> ModelConstantOrOneArgument -> ShowS
[ModelConstantOrOneArgument] -> ShowS
ModelConstantOrOneArgument -> String
(Int -> ModelConstantOrOneArgument -> ShowS)
-> (ModelConstantOrOneArgument -> String)
-> ([ModelConstantOrOneArgument] -> ShowS)
-> Show ModelConstantOrOneArgument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelConstantOrOneArgument -> ShowS
showsPrec :: Int -> ModelConstantOrOneArgument -> ShowS
$cshow :: ModelConstantOrOneArgument -> String
show :: ModelConstantOrOneArgument -> String
$cshowList :: [ModelConstantOrOneArgument] -> ShowS
showList :: [ModelConstantOrOneArgument] -> ShowS
Show, ModelConstantOrOneArgument -> ModelConstantOrOneArgument -> Bool
(ModelConstantOrOneArgument -> ModelConstantOrOneArgument -> Bool)
-> (ModelConstantOrOneArgument
    -> ModelConstantOrOneArgument -> Bool)
-> Eq ModelConstantOrOneArgument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelConstantOrOneArgument -> ModelConstantOrOneArgument -> Bool
== :: ModelConstantOrOneArgument -> ModelConstantOrOneArgument -> Bool
$c/= :: ModelConstantOrOneArgument -> ModelConstantOrOneArgument -> Bool
/= :: ModelConstantOrOneArgument -> ModelConstantOrOneArgument -> Bool
Eq, (forall x.
 ModelConstantOrOneArgument -> Rep ModelConstantOrOneArgument x)
-> (forall x.
    Rep ModelConstantOrOneArgument x -> ModelConstantOrOneArgument)
-> Generic ModelConstantOrOneArgument
forall x.
Rep ModelConstantOrOneArgument x -> ModelConstantOrOneArgument
forall x.
ModelConstantOrOneArgument -> Rep ModelConstantOrOneArgument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ModelConstantOrOneArgument -> Rep ModelConstantOrOneArgument x
from :: forall x.
ModelConstantOrOneArgument -> Rep ModelConstantOrOneArgument x
$cto :: forall x.
Rep ModelConstantOrOneArgument x -> ModelConstantOrOneArgument
to :: forall x.
Rep ModelConstantOrOneArgument x -> ModelConstantOrOneArgument
Generic, (forall (m :: * -> *).
 Quote m =>
 ModelConstantOrOneArgument -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ModelConstantOrOneArgument -> Code m ModelConstantOrOneArgument)
-> Lift ModelConstantOrOneArgument
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *).
Quote m =>
ModelConstantOrOneArgument -> m Exp
forall (m :: * -> *).
Quote m =>
ModelConstantOrOneArgument -> Code m ModelConstantOrOneArgument
$clift :: forall (m :: * -> *).
Quote m =>
ModelConstantOrOneArgument -> m Exp
lift :: forall (m :: * -> *).
Quote m =>
ModelConstantOrOneArgument -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ModelConstantOrOneArgument -> Code m ModelConstantOrOneArgument
liftTyped :: forall (m :: * -> *).
Quote m =>
ModelConstantOrOneArgument -> Code m ModelConstantOrOneArgument
Lift)
    deriving anyclass (ModelConstantOrOneArgument -> ()
(ModelConstantOrOneArgument -> ())
-> NFData ModelConstantOrOneArgument
forall a. (a -> ()) -> NFData a
$crnf :: ModelConstantOrOneArgument -> ()
rnf :: ModelConstantOrOneArgument -> ()
NFData)

-- | if p then f(x,y) else c; p depends on usage
data ModelConstantOrTwoArguments = ModelConstantOrTwoArguments
    { ModelConstantOrTwoArguments -> CostingInteger
modelConstantOrTwoArgumentsConstant :: CostingInteger
    , ModelConstantOrTwoArguments -> ModelTwoArguments
modelConstantOrTwoArgumentsModel    :: ModelTwoArguments
    } deriving stock (Int -> ModelConstantOrTwoArguments -> ShowS
[ModelConstantOrTwoArguments] -> ShowS
ModelConstantOrTwoArguments -> String
(Int -> ModelConstantOrTwoArguments -> ShowS)
-> (ModelConstantOrTwoArguments -> String)
-> ([ModelConstantOrTwoArguments] -> ShowS)
-> Show ModelConstantOrTwoArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelConstantOrTwoArguments -> ShowS
showsPrec :: Int -> ModelConstantOrTwoArguments -> ShowS
$cshow :: ModelConstantOrTwoArguments -> String
show :: ModelConstantOrTwoArguments -> String
$cshowList :: [ModelConstantOrTwoArguments] -> ShowS
showList :: [ModelConstantOrTwoArguments] -> ShowS
Show, ModelConstantOrTwoArguments -> ModelConstantOrTwoArguments -> Bool
(ModelConstantOrTwoArguments
 -> ModelConstantOrTwoArguments -> Bool)
-> (ModelConstantOrTwoArguments
    -> ModelConstantOrTwoArguments -> Bool)
-> Eq ModelConstantOrTwoArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelConstantOrTwoArguments -> ModelConstantOrTwoArguments -> Bool
== :: ModelConstantOrTwoArguments -> ModelConstantOrTwoArguments -> Bool
$c/= :: ModelConstantOrTwoArguments -> ModelConstantOrTwoArguments -> Bool
/= :: ModelConstantOrTwoArguments -> ModelConstantOrTwoArguments -> Bool
Eq, (forall x.
 ModelConstantOrTwoArguments -> Rep ModelConstantOrTwoArguments x)
-> (forall x.
    Rep ModelConstantOrTwoArguments x -> ModelConstantOrTwoArguments)
-> Generic ModelConstantOrTwoArguments
forall x.
Rep ModelConstantOrTwoArguments x -> ModelConstantOrTwoArguments
forall x.
ModelConstantOrTwoArguments -> Rep ModelConstantOrTwoArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ModelConstantOrTwoArguments -> Rep ModelConstantOrTwoArguments x
from :: forall x.
ModelConstantOrTwoArguments -> Rep ModelConstantOrTwoArguments x
$cto :: forall x.
Rep ModelConstantOrTwoArguments x -> ModelConstantOrTwoArguments
to :: forall x.
Rep ModelConstantOrTwoArguments x -> ModelConstantOrTwoArguments
Generic, (forall (m :: * -> *).
 Quote m =>
 ModelConstantOrTwoArguments -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ModelConstantOrTwoArguments -> Code m ModelConstantOrTwoArguments)
-> Lift ModelConstantOrTwoArguments
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *).
Quote m =>
ModelConstantOrTwoArguments -> m Exp
forall (m :: * -> *).
Quote m =>
ModelConstantOrTwoArguments -> Code m ModelConstantOrTwoArguments
$clift :: forall (m :: * -> *).
Quote m =>
ModelConstantOrTwoArguments -> m Exp
lift :: forall (m :: * -> *).
Quote m =>
ModelConstantOrTwoArguments -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ModelConstantOrTwoArguments -> Code m ModelConstantOrTwoArguments
liftTyped :: forall (m :: * -> *).
Quote m =>
ModelConstantOrTwoArguments -> Code m ModelConstantOrTwoArguments
Lift)
    deriving anyclass (ModelConstantOrTwoArguments -> ()
(ModelConstantOrTwoArguments -> ())
-> NFData ModelConstantOrTwoArguments
forall a. (a -> ()) -> NFData a
$crnf :: ModelConstantOrTwoArguments -> ()
rnf :: ModelConstantOrTwoArguments -> ()
NFData)

{- Note [Backward compatibility for costing functions].  The PR at
   https://github.com/IntersectMBO/plutus/pull/5857 generalised the costing
   function types and made them more composable: in particular,
   ModelTwoArgumentsLinearOnDiagonal was replaced by
   ModelTwoArgumentsConstOffDiagonal and ModelConstantOrLinear was removed.
   However, this changes some of the tags (specifically, for `equalsByteString`
   and `equalsString`) in builtinCostModel.json, and these are used in the
   Alonzo genesis file and so shouldn't be changed.  For the time being we've
   restored the ModelTwoArgumentsLinearOnDiagonal constructor so that we can
   still deal with the old tags.  New builtins should use
   ModelTwoArgumentsConstOffDiagonal instead.  A better long-term solution might
   be to adapt the JSON conversion code to translate linear_on_diagonal objects
   to ConstOffDiagonal objects (and perhaps back, although configurable cost
   models may mean that we don't need to do that).
-}

data ModelTwoArguments =
    ModelTwoArgumentsConstantCost        CostingInteger
  | ModelTwoArgumentsLinearInX           OneVariableLinearFunction
  | ModelTwoArgumentsLinearInY           OneVariableLinearFunction
  | ModelTwoArgumentsLinearInXAndY       TwoVariableLinearFunction
  | ModelTwoArgumentsAddedSizes          OneVariableLinearFunction
  | ModelTwoArgumentsSubtractedSizes     ModelSubtractedSizes
  | ModelTwoArgumentsMultipliedSizes     OneVariableLinearFunction
  | ModelTwoArgumentsMinSize             OneVariableLinearFunction
  | ModelTwoArgumentsMaxSize             OneVariableLinearFunction
  | ModelTwoArgumentsLinearOnDiagonal    ModelConstantOrLinear
  | ModelTwoArgumentsConstOffDiagonal    ModelConstantOrOneArgument
  | ModelTwoArgumentsConstAboveDiagonal  ModelConstantOrTwoArguments
  | ModelTwoArgumentsConstBelowDiagonal  ModelConstantOrTwoArguments
  | ModelTwoArgumentsQuadraticInY        OneVariableQuadraticFunction
  | ModelTwoArgumentsQuadraticInXAndY    TwoVariableQuadraticFunction
    deriving stock (Int -> ModelTwoArguments -> ShowS
[ModelTwoArguments] -> ShowS
ModelTwoArguments -> String
(Int -> ModelTwoArguments -> ShowS)
-> (ModelTwoArguments -> String)
-> ([ModelTwoArguments] -> ShowS)
-> Show ModelTwoArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelTwoArguments -> ShowS
showsPrec :: Int -> ModelTwoArguments -> ShowS
$cshow :: ModelTwoArguments -> String
show :: ModelTwoArguments -> String
$cshowList :: [ModelTwoArguments] -> ShowS
showList :: [ModelTwoArguments] -> ShowS
Show, ModelTwoArguments -> ModelTwoArguments -> Bool
(ModelTwoArguments -> ModelTwoArguments -> Bool)
-> (ModelTwoArguments -> ModelTwoArguments -> Bool)
-> Eq ModelTwoArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelTwoArguments -> ModelTwoArguments -> Bool
== :: ModelTwoArguments -> ModelTwoArguments -> Bool
$c/= :: ModelTwoArguments -> ModelTwoArguments -> Bool
/= :: ModelTwoArguments -> ModelTwoArguments -> Bool
Eq, (forall x. ModelTwoArguments -> Rep ModelTwoArguments x)
-> (forall x. Rep ModelTwoArguments x -> ModelTwoArguments)
-> Generic ModelTwoArguments
forall x. Rep ModelTwoArguments x -> ModelTwoArguments
forall x. ModelTwoArguments -> Rep ModelTwoArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModelTwoArguments -> Rep ModelTwoArguments x
from :: forall x. ModelTwoArguments -> Rep ModelTwoArguments x
$cto :: forall x. Rep ModelTwoArguments x -> ModelTwoArguments
to :: forall x. Rep ModelTwoArguments x -> ModelTwoArguments
Generic, (forall (m :: * -> *). Quote m => ModelTwoArguments -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ModelTwoArguments -> Code m ModelTwoArguments)
-> Lift ModelTwoArguments
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ModelTwoArguments -> m Exp
forall (m :: * -> *).
Quote m =>
ModelTwoArguments -> Code m ModelTwoArguments
$clift :: forall (m :: * -> *). Quote m => ModelTwoArguments -> m Exp
lift :: forall (m :: * -> *). Quote m => ModelTwoArguments -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ModelTwoArguments -> Code m ModelTwoArguments
liftTyped :: forall (m :: * -> *).
Quote m =>
ModelTwoArguments -> Code m ModelTwoArguments
Lift)
    deriving anyclass (ModelTwoArguments -> ()
(ModelTwoArguments -> ()) -> NFData ModelTwoArguments
forall a. (a -> ()) -> NFData a
$crnf :: ModelTwoArguments -> ()
rnf :: ModelTwoArguments -> ()
NFData)

instance Default ModelTwoArguments where
    def :: ModelTwoArguments
def = CostingInteger -> ModelTwoArguments
ModelTwoArgumentsConstantCost CostingInteger
forall a. Bounded a => a
maxBound

instance UnimplementedCostingFun ModelTwoArguments where
  unimplementedCostingFun :: forall b. b -> CostingFun ModelTwoArguments
unimplementedCostingFun = (CostingInteger -> ModelTwoArguments)
-> b -> CostingFun ModelTwoArguments
forall model b. (CostingInteger -> model) -> b -> CostingFun model
makeUnimplementedCostingFun CostingInteger -> ModelTwoArguments
ModelTwoArgumentsConstantCost

-- See Note [runCostingFun* API].
runCostingFunTwoArguments
    :: ( ExMemoryUsage a1
       , ExMemoryUsage a2
       )
    => CostingFun ModelTwoArguments
    -> a1
    -> a2
    -> ExBudgetStream
runCostingFunTwoArguments :: forall a1 a2.
(ExMemoryUsage a1, ExMemoryUsage a2) =>
CostingFun ModelTwoArguments -> a1 -> a2 -> ExBudgetStream
runCostingFunTwoArguments (CostingFun ModelTwoArguments
cpu ModelTwoArguments
mem) =
    case (ModelTwoArguments -> CostStream -> CostStream -> CostStream
runTwoArgumentModel ModelTwoArguments
cpu, ModelTwoArguments -> CostStream -> CostStream -> CostStream
runTwoArgumentModel ModelTwoArguments
mem) of
        (!CostStream -> CostStream -> CostStream
runCpu, !CostStream -> CostStream -> CostStream
runMem) -> (CostStream -> CostStream -> ExBudgetStream)
-> a1 -> a2 -> ExBudgetStream
forall c a. OnMemoryUsages c a => c -> a
onMemoryUsages ((CostStream -> CostStream -> ExBudgetStream)
 -> a1 -> a2 -> ExBudgetStream)
-> (CostStream -> CostStream -> ExBudgetStream)
-> a1
-> a2
-> ExBudgetStream
forall a b. (a -> b) -> a -> b
$ \CostStream
mem1 CostStream
mem2 ->
            CostStream -> CostStream -> ExBudgetStream
zipCostStream
                (CostStream -> CostStream -> CostStream
runCpu CostStream
mem1 CostStream
mem2)
                (CostStream -> CostStream -> CostStream
runMem CostStream
mem1 CostStream
mem2)
{-# INLINE runCostingFunTwoArguments #-}

-- | Take an intercept, two slopes and two streams, and scale each element of
-- the first stream by the first slope, each element of the second stream by the
-- second slope, add the two scaled streams together, and cons the intercept to
-- the stream afterwards.
scaleLinearlyTwoVariables :: Intercept -> Slope -> CostStream -> Slope -> CostStream -> CostStream
scaleLinearlyTwoVariables :: Intercept
-> Slope -> CostStream -> Slope -> CostStream -> CostStream
scaleLinearlyTwoVariables (Intercept CostingInteger
intercept) (Slope CostingInteger
slope1) CostStream
stream1 (Slope CostingInteger
slope2) CostStream
stream2 =
    CostStream -> CostStream -> CostStream
addCostStream
    (CostingInteger -> CostStream
CostLast CostingInteger
intercept)
    (CostStream -> CostStream -> CostStream
addCostStream
     ((CostingInteger -> CostingInteger) -> CostStream -> CostStream
mapCostStream (CostingInteger
slope1 CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
*) CostStream
stream1)
     ((CostingInteger -> CostingInteger) -> CostStream -> CostStream
mapCostStream (CostingInteger
slope2 CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
*) CostStream
stream2)
    )
{-# INLINE scaleLinearlyTwoVariables #-}

runTwoArgumentModel
    :: ModelTwoArguments
    -> CostStream
    -> CostStream
    -> CostStream
runTwoArgumentModel :: ModelTwoArguments -> CostStream -> CostStream -> CostStream
runTwoArgumentModel
    (ModelTwoArgumentsConstantCost CostingInteger
c) = (CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
_ CostStream
_ -> CostingInteger -> CostStream
CostLast CostingInteger
c
runTwoArgumentModel
    (ModelTwoArgumentsAddedSizes (OneVariableLinearFunction Intercept
intercept Slope
slope)) =
        (CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
costs1 CostStream
costs2 ->
            Intercept -> Slope -> CostStream -> CostStream
scaleLinearly Intercept
intercept Slope
slope (CostStream -> CostStream) -> CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ CostStream -> CostStream -> CostStream
addCostStream CostStream
costs1 CostStream
costs2
runTwoArgumentModel
    (ModelTwoArgumentsSubtractedSizes (ModelSubtractedSizes Intercept
intercept Slope
slope CostingInteger
minSize)) =
        (CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
costs1 CostStream
costs2 -> do
            let !size1 :: CostingInteger
size1 = CostStream -> CostingInteger
sumCostStream CostStream
costs1
                !size2 :: CostingInteger
size2 = CostStream -> CostingInteger
sumCostStream CostStream
costs2
            Intercept -> Slope -> CostStream -> CostStream
scaleLinearly Intercept
intercept Slope
slope (CostStream -> CostStream) -> CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ CostingInteger -> CostStream
CostLast (CostingInteger -> CostingInteger -> CostingInteger
forall a. Ord a => a -> a -> a
max CostingInteger
minSize (CostingInteger -> CostingInteger)
-> CostingInteger -> CostingInteger
forall a b. (a -> b) -> a -> b
$ CostingInteger
size1 CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
- CostingInteger
size2)
runTwoArgumentModel
    (ModelTwoArgumentsMultipliedSizes (OneVariableLinearFunction Intercept
intercept Slope
slope)) =
        (CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
costs1 CostStream
costs2 -> do
            let !size1 :: CostingInteger
size1 = CostStream -> CostingInteger
sumCostStream CostStream
costs1
                !size2 :: CostingInteger
size2 = CostStream -> CostingInteger
sumCostStream CostStream
costs2
            Intercept -> Slope -> CostStream -> CostStream
scaleLinearly Intercept
intercept Slope
slope (CostStream -> CostStream) -> CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ CostingInteger -> CostStream
CostLast (CostingInteger
size1 CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
* CostingInteger
size2)
runTwoArgumentModel
    (ModelTwoArgumentsMinSize (OneVariableLinearFunction Intercept
intercept Slope
slope)) =
        (CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
costs1 CostStream
costs2 -> do
            Intercept -> Slope -> CostStream -> CostStream
scaleLinearly Intercept
intercept Slope
slope (CostStream -> CostStream) -> CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ CostStream -> CostStream -> CostStream
minCostStream CostStream
costs1 CostStream
costs2
runTwoArgumentModel
    (ModelTwoArgumentsMaxSize (OneVariableLinearFunction Intercept
intercept Slope
slope)) =
        (CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
costs1 CostStream
costs2 -> do
            let !size1 :: CostingInteger
size1 = CostStream -> CostingInteger
sumCostStream CostStream
costs1
                !size2 :: CostingInteger
size2 = CostStream -> CostingInteger
sumCostStream CostStream
costs2
            Intercept -> Slope -> CostStream -> CostStream
scaleLinearly Intercept
intercept Slope
slope (CostStream -> CostStream) -> CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ CostingInteger -> CostStream
CostLast (CostingInteger -> CostingInteger -> CostingInteger
forall a. Ord a => a -> a -> a
max CostingInteger
size1 CostingInteger
size2)
runTwoArgumentModel
    (ModelTwoArgumentsLinearInX (OneVariableLinearFunction Intercept
intercept Slope
slope)) =
        (CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
costs1 CostStream
_ ->
            Intercept -> Slope -> CostStream -> CostStream
scaleLinearly Intercept
intercept Slope
slope CostStream
costs1
runTwoArgumentModel
    (ModelTwoArgumentsLinearInY (OneVariableLinearFunction Intercept
intercept Slope
slope)) =
        (CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
_ CostStream
costs2 ->
            Intercept -> Slope -> CostStream -> CostStream
scaleLinearly Intercept
intercept Slope
slope CostStream
costs2
runTwoArgumentModel
    (ModelTwoArgumentsLinearInXAndY (TwoVariableLinearFunction Intercept
intercept Slope
slope1 Slope
slope2)) =
        (CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
costs1 CostStream
costs2 ->
            Intercept
-> Slope -> CostStream -> Slope -> CostStream -> CostStream
scaleLinearlyTwoVariables Intercept
intercept Slope
slope1 CostStream
costs1 Slope
slope2 CostStream
costs2
runTwoArgumentModel
    -- See Note [Backward compatibility for costing functions]
    -- Off the diagonal, return the constant.  On the diagonal, run the one-variable linear model.
    (ModelTwoArgumentsLinearOnDiagonal (ModelConstantOrLinear CostingInteger
c Intercept
intercept Slope
slope)) =
        (CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
costs1 CostStream
costs2 -> do
            let !size1 :: CostingInteger
size1 = CostStream -> CostingInteger
sumCostStream CostStream
costs1
                !size2 :: CostingInteger
size2 = CostStream -> CostingInteger
sumCostStream CostStream
costs2
            if CostingInteger
size1 CostingInteger -> CostingInteger -> Bool
forall a. Eq a => a -> a -> Bool
== CostingInteger
size2
                then Intercept -> Slope -> CostStream -> CostStream
scaleLinearly Intercept
intercept Slope
slope (CostStream -> CostStream) -> CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ CostingInteger -> CostStream
CostLast CostingInteger
size1
                else CostingInteger -> CostStream
CostLast CostingInteger
c
runTwoArgumentModel
    -- Off the diagonal, return the constant.  On the diagonal, run the other model.
    (ModelTwoArgumentsConstOffDiagonal (ModelConstantOrOneArgument CostingInteger
c ModelOneArgument
m)) =
        case ModelOneArgument -> CostStream -> CostStream
runOneArgumentModel ModelOneArgument
m of
            !CostStream -> CostStream
run -> (CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
costs1 CostStream
costs2 -> do
                let !size1 :: CostingInteger
size1 = CostStream -> CostingInteger
sumCostStream CostStream
costs1
                    !size2 :: CostingInteger
size2 = CostStream -> CostingInteger
sumCostStream CostStream
costs2
                if CostingInteger
size1 CostingInteger -> CostingInteger -> Bool
forall a. Eq a => a -> a -> Bool
/= CostingInteger
size2
                    then CostingInteger -> CostStream
CostLast CostingInteger
c
                    else CostStream -> CostStream
run (CostingInteger -> CostStream
CostLast CostingInteger
size1)
runTwoArgumentModel
    -- Below the diagonal, return the constant. Above the diagonal, run the other model.
    (ModelTwoArgumentsConstBelowDiagonal (ModelConstantOrTwoArguments CostingInteger
c ModelTwoArguments
m)) =
        case ModelTwoArguments -> CostStream -> CostStream -> CostStream
runTwoArgumentModel ModelTwoArguments
m of
            !CostStream -> CostStream -> CostStream
run -> (CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
costs1 CostStream
costs2 -> do
                let !size1 :: CostingInteger
size1 = CostStream -> CostingInteger
sumCostStream CostStream
costs1
                    !size2 :: CostingInteger
size2 = CostStream -> CostingInteger
sumCostStream CostStream
costs2
                if CostingInteger
size1 CostingInteger -> CostingInteger -> Bool
forall a. Ord a => a -> a -> Bool
> CostingInteger
size2
                    then CostingInteger -> CostStream
CostLast CostingInteger
c
                    else CostStream -> CostStream -> CostStream
run (CostingInteger -> CostStream
CostLast CostingInteger
size1) (CostingInteger -> CostStream
CostLast CostingInteger
size2)
runTwoArgumentModel
    -- Above the diagonal, return the constant. Below the diagonal, run the other model.
    (ModelTwoArgumentsConstAboveDiagonal (ModelConstantOrTwoArguments CostingInteger
c ModelTwoArguments
m)) =
        case ModelTwoArguments -> CostStream -> CostStream -> CostStream
runTwoArgumentModel ModelTwoArguments
m of
            !CostStream -> CostStream -> CostStream
run -> (CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
costs1 CostStream
costs2 -> do
                let !size1 :: CostingInteger
size1 = CostStream -> CostingInteger
sumCostStream CostStream
costs1
                    !size2 :: CostingInteger
size2 = CostStream -> CostingInteger
sumCostStream CostStream
costs2
                if CostingInteger
size1 CostingInteger -> CostingInteger -> Bool
forall a. Ord a => a -> a -> Bool
< CostingInteger
size2
                    then CostingInteger -> CostStream
CostLast CostingInteger
c
                    else CostStream -> CostStream -> CostStream
run (CostingInteger -> CostStream
CostLast CostingInteger
size1) (CostingInteger -> CostStream
CostLast CostingInteger
size2)
runTwoArgumentModel
    (ModelTwoArgumentsQuadraticInY OneVariableQuadraticFunction
f) =
        (CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
_ CostStream
costs2 ->
            CostingInteger -> CostStream
CostLast (CostingInteger -> CostStream) -> CostingInteger -> CostStream
forall a b. (a -> b) -> a -> b
$ OneVariableQuadraticFunction -> CostingInteger -> CostingInteger
evaluateOneVariableQuadraticFunction OneVariableQuadraticFunction
f (CostingInteger -> CostingInteger)
-> CostingInteger -> CostingInteger
forall a b. (a -> b) -> a -> b
$ CostStream -> CostingInteger
sumCostStream CostStream
costs2
runTwoArgumentModel
    (ModelTwoArgumentsQuadraticInXAndY TwoVariableQuadraticFunction
f) =
        (CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
costs1 CostStream
costs2 ->
             let !size1 :: CostingInteger
size1 = CostStream -> CostingInteger
sumCostStream CostStream
costs1
                 !size2 :: CostingInteger
size2 = CostStream -> CostingInteger
sumCostStream CostStream
costs2
             in CostingInteger -> CostStream
CostLast (CostingInteger -> CostStream) -> CostingInteger -> CostStream
forall a b. (a -> b) -> a -> b
$ TwoVariableQuadraticFunction
-> CostingInteger -> CostingInteger -> CostingInteger
evaluateTwoVariableQuadraticFunction TwoVariableQuadraticFunction
f CostingInteger
size1 CostingInteger
size2
{-# NOINLINE runTwoArgumentModel #-}


---------------- Three-argument costing functions ----------------

data ModelThreeArguments =
    ModelThreeArgumentsConstantCost          CostingInteger
  | ModelThreeArgumentsLinearInX             OneVariableLinearFunction
  | ModelThreeArgumentsLinearInY             OneVariableLinearFunction
  | ModelThreeArgumentsLinearInZ             OneVariableLinearFunction
  | ModelThreeArgumentsQuadraticInZ          OneVariableQuadraticFunction
  | ModelThreeArgumentsLiteralInYOrLinearInZ OneVariableLinearFunction
  | ModelThreeArgumentsLinearInMaxYZ         OneVariableLinearFunction
  | ModelThreeArgumentsLinearInYAndZ         TwoVariableLinearFunction
    deriving stock (Int -> ModelThreeArguments -> ShowS
[ModelThreeArguments] -> ShowS
ModelThreeArguments -> String
(Int -> ModelThreeArguments -> ShowS)
-> (ModelThreeArguments -> String)
-> ([ModelThreeArguments] -> ShowS)
-> Show ModelThreeArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelThreeArguments -> ShowS
showsPrec :: Int -> ModelThreeArguments -> ShowS
$cshow :: ModelThreeArguments -> String
show :: ModelThreeArguments -> String
$cshowList :: [ModelThreeArguments] -> ShowS
showList :: [ModelThreeArguments] -> ShowS
Show, ModelThreeArguments -> ModelThreeArguments -> Bool
(ModelThreeArguments -> ModelThreeArguments -> Bool)
-> (ModelThreeArguments -> ModelThreeArguments -> Bool)
-> Eq ModelThreeArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelThreeArguments -> ModelThreeArguments -> Bool
== :: ModelThreeArguments -> ModelThreeArguments -> Bool
$c/= :: ModelThreeArguments -> ModelThreeArguments -> Bool
/= :: ModelThreeArguments -> ModelThreeArguments -> Bool
Eq, (forall x. ModelThreeArguments -> Rep ModelThreeArguments x)
-> (forall x. Rep ModelThreeArguments x -> ModelThreeArguments)
-> Generic ModelThreeArguments
forall x. Rep ModelThreeArguments x -> ModelThreeArguments
forall x. ModelThreeArguments -> Rep ModelThreeArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModelThreeArguments -> Rep ModelThreeArguments x
from :: forall x. ModelThreeArguments -> Rep ModelThreeArguments x
$cto :: forall x. Rep ModelThreeArguments x -> ModelThreeArguments
to :: forall x. Rep ModelThreeArguments x -> ModelThreeArguments
Generic, (forall (m :: * -> *). Quote m => ModelThreeArguments -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ModelThreeArguments -> Code m ModelThreeArguments)
-> Lift ModelThreeArguments
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ModelThreeArguments -> m Exp
forall (m :: * -> *).
Quote m =>
ModelThreeArguments -> Code m ModelThreeArguments
$clift :: forall (m :: * -> *). Quote m => ModelThreeArguments -> m Exp
lift :: forall (m :: * -> *). Quote m => ModelThreeArguments -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ModelThreeArguments -> Code m ModelThreeArguments
liftTyped :: forall (m :: * -> *).
Quote m =>
ModelThreeArguments -> Code m ModelThreeArguments
Lift)
    deriving anyclass (ModelThreeArguments -> ()
(ModelThreeArguments -> ()) -> NFData ModelThreeArguments
forall a. (a -> ()) -> NFData a
$crnf :: ModelThreeArguments -> ()
rnf :: ModelThreeArguments -> ()
NFData)

instance Default ModelThreeArguments where
    def :: ModelThreeArguments
def = CostingInteger -> ModelThreeArguments
ModelThreeArgumentsConstantCost CostingInteger
forall a. Bounded a => a
maxBound

instance UnimplementedCostingFun ModelThreeArguments where
  unimplementedCostingFun :: forall b. b -> CostingFun ModelThreeArguments
unimplementedCostingFun = (CostingInteger -> ModelThreeArguments)
-> b -> CostingFun ModelThreeArguments
forall model b. (CostingInteger -> model) -> b -> CostingFun model
makeUnimplementedCostingFun CostingInteger -> ModelThreeArguments
ModelThreeArgumentsConstantCost

runThreeArgumentModel
    :: ModelThreeArguments
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
runThreeArgumentModel :: ModelThreeArguments
-> CostStream -> CostStream -> CostStream -> CostStream
runThreeArgumentModel (ModelThreeArgumentsConstantCost CostingInteger
c) = (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
_ CostStream
_ CostStream
_ -> CostingInteger -> CostStream
CostLast CostingInteger
c
runThreeArgumentModel
    (ModelThreeArgumentsLinearInX (OneVariableLinearFunction Intercept
intercept Slope
slope)) =
        (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
costs1 CostStream
_ CostStream
_ ->
            Intercept -> Slope -> CostStream -> CostStream
scaleLinearly Intercept
intercept Slope
slope CostStream
costs1
runThreeArgumentModel
    (ModelThreeArgumentsLinearInY (OneVariableLinearFunction Intercept
intercept Slope
slope)) =
        (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
_ CostStream
costs2 CostStream
_ ->
            Intercept -> Slope -> CostStream -> CostStream
scaleLinearly Intercept
intercept Slope
slope CostStream
costs2
runThreeArgumentModel
    (ModelThreeArgumentsLinearInZ (OneVariableLinearFunction Intercept
intercept Slope
slope)) =
        (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
_ CostStream
_ CostStream
costs3 ->
            Intercept -> Slope -> CostStream -> CostStream
scaleLinearly Intercept
intercept Slope
slope CostStream
costs3
runThreeArgumentModel
    (ModelThreeArgumentsQuadraticInZ OneVariableQuadraticFunction
f) =
        (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
_ CostStream
_ CostStream
costs3 -> CostingInteger -> CostStream
CostLast (CostingInteger -> CostStream) -> CostingInteger -> CostStream
forall a b. (a -> b) -> a -> b
$ OneVariableQuadraticFunction -> CostingInteger -> CostingInteger
evaluateOneVariableQuadraticFunction OneVariableQuadraticFunction
f (CostingInteger -> CostingInteger)
-> CostingInteger -> CostingInteger
forall a b. (a -> b) -> a -> b
$ CostStream -> CostingInteger
sumCostStream CostStream
costs3
{- Either a literal number of bytes or a linear function.  This is for
   `integerToByteString`, where if the second argument is zero, the output
   bytestring has the minimum length required to contain the converted integer,
   but if the second argument is nonzero it specifies the exact length of the
   output bytestring. We could generalise this to something like `LinearInYOrZ`
   since the argument wrapping takes care of calculating the memory usages for
   us anyway (the costing function here knows nothing about the wrapper: it just
   gets a number from `onMemoryUsages`).
-}
runThreeArgumentModel
    (ModelThreeArgumentsLiteralInYOrLinearInZ (OneVariableLinearFunction Intercept
intercept Slope
slope)) =
        (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
_ CostStream
costs2 CostStream
costs3 ->
            let !width :: CostingInteger
width = CostStream -> CostingInteger
sumCostStream CostStream
costs2
            in if CostingInteger
width CostingInteger -> CostingInteger -> Bool
forall a. Eq a => a -> a -> Bool
== CostingInteger
0
            then Intercept -> Slope -> CostStream -> CostStream
scaleLinearly Intercept
intercept Slope
slope CostStream
costs3
            else CostStream
costs2
runThreeArgumentModel
    (ModelThreeArgumentsLinearInMaxYZ (OneVariableLinearFunction Intercept
intercept Slope
slope)) =
        (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
_ CostStream
costs2 CostStream
costs3 ->
            let !size2 :: CostingInteger
size2 = CostStream -> CostingInteger
sumCostStream CostStream
costs2
                !size3 :: CostingInteger
size3 = CostStream -> CostingInteger
sumCostStream CostStream
costs3
            in Intercept -> Slope -> CostStream -> CostStream
scaleLinearly Intercept
intercept Slope
slope (CostStream -> CostStream) -> CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ CostingInteger -> CostStream
CostLast (CostingInteger -> CostingInteger -> CostingInteger
forall a. Ord a => a -> a -> a
max CostingInteger
size2 CostingInteger
size3)
runThreeArgumentModel
    (ModelThreeArgumentsLinearInYAndZ (TwoVariableLinearFunction Intercept
intercept Slope
slope2 Slope
slope3)) =
        (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream -> CostStream -> CostStream -> CostStream
forall a. a -> a
lazy ((CostStream -> CostStream -> CostStream -> CostStream)
 -> CostStream -> CostStream -> CostStream -> CostStream)
-> (CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
_costs1 CostStream
costs2 CostStream
costs3 ->
            Intercept
-> Slope -> CostStream -> Slope -> CostStream -> CostStream
scaleLinearlyTwoVariables Intercept
intercept Slope
slope2 CostStream
costs2 Slope
slope3 CostStream
costs3
{-# NOINLINE runThreeArgumentModel #-}

-- See Note [runCostingFun* API].
runCostingFunThreeArguments
    :: ( ExMemoryUsage a1
       , ExMemoryUsage a2
       , ExMemoryUsage a3
       )
    => CostingFun ModelThreeArguments
    -> a1
    -> a2
    -> a3
    -> ExBudgetStream
runCostingFunThreeArguments :: forall a1 a2 a3.
(ExMemoryUsage a1, ExMemoryUsage a2, ExMemoryUsage a3) =>
CostingFun ModelThreeArguments -> a1 -> a2 -> a3 -> ExBudgetStream
runCostingFunThreeArguments (CostingFun ModelThreeArguments
cpu ModelThreeArguments
mem) =
    case (ModelThreeArguments
-> CostStream -> CostStream -> CostStream -> CostStream
runThreeArgumentModel ModelThreeArguments
cpu, ModelThreeArguments
-> CostStream -> CostStream -> CostStream -> CostStream
runThreeArgumentModel ModelThreeArguments
mem) of
        (!CostStream -> CostStream -> CostStream -> CostStream
runCpu, !CostStream -> CostStream -> CostStream -> CostStream
runMem) -> (CostStream -> CostStream -> CostStream -> ExBudgetStream)
-> a1 -> a2 -> a3 -> ExBudgetStream
forall c a. OnMemoryUsages c a => c -> a
onMemoryUsages ((CostStream -> CostStream -> CostStream -> ExBudgetStream)
 -> a1 -> a2 -> a3 -> ExBudgetStream)
-> (CostStream -> CostStream -> CostStream -> ExBudgetStream)
-> a1
-> a2
-> a3
-> ExBudgetStream
forall a b. (a -> b) -> a -> b
$ \CostStream
mem1 CostStream
mem2 CostStream
mem3 ->
            CostStream -> CostStream -> ExBudgetStream
zipCostStream
                (CostStream -> CostStream -> CostStream -> CostStream
runCpu CostStream
mem1 CostStream
mem2 CostStream
mem3)
                (CostStream -> CostStream -> CostStream -> CostStream
runMem CostStream
mem1 CostStream
mem2 CostStream
mem3)
{-# INLINE runCostingFunThreeArguments #-}


---------------- Four-argument costing functions ----------------

data ModelFourArguments =
      ModelFourArgumentsConstantCost CostingInteger
    deriving stock (Int -> ModelFourArguments -> ShowS
[ModelFourArguments] -> ShowS
ModelFourArguments -> String
(Int -> ModelFourArguments -> ShowS)
-> (ModelFourArguments -> String)
-> ([ModelFourArguments] -> ShowS)
-> Show ModelFourArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelFourArguments -> ShowS
showsPrec :: Int -> ModelFourArguments -> ShowS
$cshow :: ModelFourArguments -> String
show :: ModelFourArguments -> String
$cshowList :: [ModelFourArguments] -> ShowS
showList :: [ModelFourArguments] -> ShowS
Show, ModelFourArguments -> ModelFourArguments -> Bool
(ModelFourArguments -> ModelFourArguments -> Bool)
-> (ModelFourArguments -> ModelFourArguments -> Bool)
-> Eq ModelFourArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelFourArguments -> ModelFourArguments -> Bool
== :: ModelFourArguments -> ModelFourArguments -> Bool
$c/= :: ModelFourArguments -> ModelFourArguments -> Bool
/= :: ModelFourArguments -> ModelFourArguments -> Bool
Eq, (forall x. ModelFourArguments -> Rep ModelFourArguments x)
-> (forall x. Rep ModelFourArguments x -> ModelFourArguments)
-> Generic ModelFourArguments
forall x. Rep ModelFourArguments x -> ModelFourArguments
forall x. ModelFourArguments -> Rep ModelFourArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModelFourArguments -> Rep ModelFourArguments x
from :: forall x. ModelFourArguments -> Rep ModelFourArguments x
$cto :: forall x. Rep ModelFourArguments x -> ModelFourArguments
to :: forall x. Rep ModelFourArguments x -> ModelFourArguments
Generic, (forall (m :: * -> *). Quote m => ModelFourArguments -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ModelFourArguments -> Code m ModelFourArguments)
-> Lift ModelFourArguments
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ModelFourArguments -> m Exp
forall (m :: * -> *).
Quote m =>
ModelFourArguments -> Code m ModelFourArguments
$clift :: forall (m :: * -> *). Quote m => ModelFourArguments -> m Exp
lift :: forall (m :: * -> *). Quote m => ModelFourArguments -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ModelFourArguments -> Code m ModelFourArguments
liftTyped :: forall (m :: * -> *).
Quote m =>
ModelFourArguments -> Code m ModelFourArguments
Lift)
    deriving anyclass (ModelFourArguments -> ()
(ModelFourArguments -> ()) -> NFData ModelFourArguments
forall a. (a -> ()) -> NFData a
$crnf :: ModelFourArguments -> ()
rnf :: ModelFourArguments -> ()
NFData)

instance Default ModelFourArguments where
    def :: ModelFourArguments
def = CostingInteger -> ModelFourArguments
ModelFourArgumentsConstantCost CostingInteger
forall a. Bounded a => a
maxBound

instance UnimplementedCostingFun ModelFourArguments where
  unimplementedCostingFun :: forall b. b -> CostingFun ModelFourArguments
unimplementedCostingFun = (CostingInteger -> ModelFourArguments)
-> b -> CostingFun ModelFourArguments
forall model b. (CostingInteger -> model) -> b -> CostingFun model
makeUnimplementedCostingFun CostingInteger -> ModelFourArguments
ModelFourArgumentsConstantCost

runFourArgumentModel
    :: ModelFourArguments
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
runFourArgumentModel :: ModelFourArguments
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runFourArgumentModel (ModelFourArgumentsConstantCost CostingInteger
c) = (CostStream
 -> CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
forall a. a -> a
lazy ((CostStream
  -> CostStream -> CostStream -> CostStream -> CostStream)
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream)
-> (CostStream
    -> CostStream -> CostStream -> CostStream -> CostStream)
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
_ CostStream
_ CostStream
_ CostStream
_ -> CostingInteger -> CostStream
CostLast CostingInteger
c
{-# NOINLINE runFourArgumentModel #-}

-- See Note [runCostingFun* API].
runCostingFunFourArguments
    :: ( ExMemoryUsage a1
       , ExMemoryUsage a2
       , ExMemoryUsage a3
       , ExMemoryUsage a4
       )
    => CostingFun ModelFourArguments
    -> a1
    -> a2
    -> a3
    -> a4
    -> ExBudgetStream
runCostingFunFourArguments :: forall a1 a2 a3 a4.
(ExMemoryUsage a1, ExMemoryUsage a2, ExMemoryUsage a3,
 ExMemoryUsage a4) =>
CostingFun ModelFourArguments
-> a1 -> a2 -> a3 -> a4 -> ExBudgetStream
runCostingFunFourArguments (CostingFun ModelFourArguments
cpu ModelFourArguments
mem) =
    case (ModelFourArguments
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runFourArgumentModel ModelFourArguments
cpu, ModelFourArguments
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runFourArgumentModel ModelFourArguments
mem) of
        (!CostStream -> CostStream -> CostStream -> CostStream -> CostStream
runCpu, !CostStream -> CostStream -> CostStream -> CostStream -> CostStream
runMem) -> (CostStream
 -> CostStream -> CostStream -> CostStream -> ExBudgetStream)
-> a1 -> a2 -> a3 -> a4 -> ExBudgetStream
forall c a. OnMemoryUsages c a => c -> a
onMemoryUsages ((CostStream
  -> CostStream -> CostStream -> CostStream -> ExBudgetStream)
 -> a1 -> a2 -> a3 -> a4 -> ExBudgetStream)
-> (CostStream
    -> CostStream -> CostStream -> CostStream -> ExBudgetStream)
-> a1
-> a2
-> a3
-> a4
-> ExBudgetStream
forall a b. (a -> b) -> a -> b
$ \CostStream
mem1 CostStream
mem2 CostStream
mem3 CostStream
mem4 ->
            CostStream -> CostStream -> ExBudgetStream
zipCostStream
                (CostStream -> CostStream -> CostStream -> CostStream -> CostStream
runCpu CostStream
mem1 CostStream
mem2 CostStream
mem3 CostStream
mem4)
                (CostStream -> CostStream -> CostStream -> CostStream -> CostStream
runMem CostStream
mem1 CostStream
mem2 CostStream
mem3 CostStream
mem4)
{-# INLINE runCostingFunFourArguments #-}


---------------- Five-argument costing functions ----------------

data ModelFiveArguments =
      ModelFiveArgumentsConstantCost CostingInteger
    deriving stock (Int -> ModelFiveArguments -> ShowS
[ModelFiveArguments] -> ShowS
ModelFiveArguments -> String
(Int -> ModelFiveArguments -> ShowS)
-> (ModelFiveArguments -> String)
-> ([ModelFiveArguments] -> ShowS)
-> Show ModelFiveArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelFiveArguments -> ShowS
showsPrec :: Int -> ModelFiveArguments -> ShowS
$cshow :: ModelFiveArguments -> String
show :: ModelFiveArguments -> String
$cshowList :: [ModelFiveArguments] -> ShowS
showList :: [ModelFiveArguments] -> ShowS
Show, ModelFiveArguments -> ModelFiveArguments -> Bool
(ModelFiveArguments -> ModelFiveArguments -> Bool)
-> (ModelFiveArguments -> ModelFiveArguments -> Bool)
-> Eq ModelFiveArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelFiveArguments -> ModelFiveArguments -> Bool
== :: ModelFiveArguments -> ModelFiveArguments -> Bool
$c/= :: ModelFiveArguments -> ModelFiveArguments -> Bool
/= :: ModelFiveArguments -> ModelFiveArguments -> Bool
Eq, (forall x. ModelFiveArguments -> Rep ModelFiveArguments x)
-> (forall x. Rep ModelFiveArguments x -> ModelFiveArguments)
-> Generic ModelFiveArguments
forall x. Rep ModelFiveArguments x -> ModelFiveArguments
forall x. ModelFiveArguments -> Rep ModelFiveArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModelFiveArguments -> Rep ModelFiveArguments x
from :: forall x. ModelFiveArguments -> Rep ModelFiveArguments x
$cto :: forall x. Rep ModelFiveArguments x -> ModelFiveArguments
to :: forall x. Rep ModelFiveArguments x -> ModelFiveArguments
Generic, (forall (m :: * -> *). Quote m => ModelFiveArguments -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ModelFiveArguments -> Code m ModelFiveArguments)
-> Lift ModelFiveArguments
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ModelFiveArguments -> m Exp
forall (m :: * -> *).
Quote m =>
ModelFiveArguments -> Code m ModelFiveArguments
$clift :: forall (m :: * -> *). Quote m => ModelFiveArguments -> m Exp
lift :: forall (m :: * -> *). Quote m => ModelFiveArguments -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ModelFiveArguments -> Code m ModelFiveArguments
liftTyped :: forall (m :: * -> *).
Quote m =>
ModelFiveArguments -> Code m ModelFiveArguments
Lift)
    deriving anyclass (ModelFiveArguments -> ()
(ModelFiveArguments -> ()) -> NFData ModelFiveArguments
forall a. (a -> ()) -> NFData a
$crnf :: ModelFiveArguments -> ()
rnf :: ModelFiveArguments -> ()
NFData)

instance Default ModelFiveArguments where
    def :: ModelFiveArguments
def = CostingInteger -> ModelFiveArguments
ModelFiveArgumentsConstantCost CostingInteger
forall a. Bounded a => a
maxBound

instance UnimplementedCostingFun ModelFiveArguments where
  unimplementedCostingFun :: forall b. b -> CostingFun ModelFiveArguments
unimplementedCostingFun = (CostingInteger -> ModelFiveArguments)
-> b -> CostingFun ModelFiveArguments
forall model b. (CostingInteger -> model) -> b -> CostingFun model
makeUnimplementedCostingFun CostingInteger -> ModelFiveArguments
ModelFiveArgumentsConstantCost

runFiveArgumentModel
    :: ModelFiveArguments
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
runFiveArgumentModel :: ModelFiveArguments
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runFiveArgumentModel (ModelFiveArgumentsConstantCost CostingInteger
c) = (CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream)
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
forall a. a -> a
lazy ((CostStream
  -> CostStream
  -> CostStream
  -> CostStream
  -> CostStream
  -> CostStream)
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream)
-> (CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream)
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
_ CostStream
_ CostStream
_ CostStream
_ CostStream
_ -> CostingInteger -> CostStream
CostLast CostingInteger
c
{-# NOINLINE runFiveArgumentModel #-}

-- See Note [runCostingFun* API].
runCostingFunFiveArguments
    :: ( ExMemoryUsage a1
       , ExMemoryUsage a2
       , ExMemoryUsage a3
       , ExMemoryUsage a4
       , ExMemoryUsage a5
       )
    => CostingFun ModelFiveArguments
    -> a1
    -> a2
    -> a3
    -> a4
    -> a5
    -> ExBudgetStream
runCostingFunFiveArguments :: forall a1 a2 a3 a4 a5.
(ExMemoryUsage a1, ExMemoryUsage a2, ExMemoryUsage a3,
 ExMemoryUsage a4, ExMemoryUsage a5) =>
CostingFun ModelFiveArguments
-> a1 -> a2 -> a3 -> a4 -> a5 -> ExBudgetStream
runCostingFunFiveArguments (CostingFun ModelFiveArguments
cpu ModelFiveArguments
mem) =
    case (ModelFiveArguments
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runFiveArgumentModel ModelFiveArguments
cpu, ModelFiveArguments
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runFiveArgumentModel ModelFiveArguments
mem) of
        (!CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runCpu, !CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runMem) -> (CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> ExBudgetStream)
-> a1 -> a2 -> a3 -> a4 -> a5 -> ExBudgetStream
forall c a. OnMemoryUsages c a => c -> a
onMemoryUsages ((CostStream
  -> CostStream
  -> CostStream
  -> CostStream
  -> CostStream
  -> ExBudgetStream)
 -> a1 -> a2 -> a3 -> a4 -> a5 -> ExBudgetStream)
-> (CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> ExBudgetStream)
-> a1
-> a2
-> a3
-> a4
-> a5
-> ExBudgetStream
forall a b. (a -> b) -> a -> b
$ \CostStream
mem1 CostStream
mem2 CostStream
mem3 CostStream
mem4 CostStream
mem5 ->
            CostStream -> CostStream -> ExBudgetStream
zipCostStream
                (CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runCpu CostStream
mem1 CostStream
mem2 CostStream
mem3 CostStream
mem4 CostStream
mem5)
                (CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runMem CostStream
mem1 CostStream
mem2 CostStream
mem3 CostStream
mem4 CostStream
mem5)
{-# INLINE runCostingFunFiveArguments #-}

---------------- Six-argument costing functions ----------------

data ModelSixArguments =
      ModelSixArgumentsConstantCost CostingInteger
    deriving stock (Int -> ModelSixArguments -> ShowS
[ModelSixArguments] -> ShowS
ModelSixArguments -> String
(Int -> ModelSixArguments -> ShowS)
-> (ModelSixArguments -> String)
-> ([ModelSixArguments] -> ShowS)
-> Show ModelSixArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelSixArguments -> ShowS
showsPrec :: Int -> ModelSixArguments -> ShowS
$cshow :: ModelSixArguments -> String
show :: ModelSixArguments -> String
$cshowList :: [ModelSixArguments] -> ShowS
showList :: [ModelSixArguments] -> ShowS
Show, ModelSixArguments -> ModelSixArguments -> Bool
(ModelSixArguments -> ModelSixArguments -> Bool)
-> (ModelSixArguments -> ModelSixArguments -> Bool)
-> Eq ModelSixArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelSixArguments -> ModelSixArguments -> Bool
== :: ModelSixArguments -> ModelSixArguments -> Bool
$c/= :: ModelSixArguments -> ModelSixArguments -> Bool
/= :: ModelSixArguments -> ModelSixArguments -> Bool
Eq, (forall x. ModelSixArguments -> Rep ModelSixArguments x)
-> (forall x. Rep ModelSixArguments x -> ModelSixArguments)
-> Generic ModelSixArguments
forall x. Rep ModelSixArguments x -> ModelSixArguments
forall x. ModelSixArguments -> Rep ModelSixArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModelSixArguments -> Rep ModelSixArguments x
from :: forall x. ModelSixArguments -> Rep ModelSixArguments x
$cto :: forall x. Rep ModelSixArguments x -> ModelSixArguments
to :: forall x. Rep ModelSixArguments x -> ModelSixArguments
Generic, (forall (m :: * -> *). Quote m => ModelSixArguments -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ModelSixArguments -> Code m ModelSixArguments)
-> Lift ModelSixArguments
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ModelSixArguments -> m Exp
forall (m :: * -> *).
Quote m =>
ModelSixArguments -> Code m ModelSixArguments
$clift :: forall (m :: * -> *). Quote m => ModelSixArguments -> m Exp
lift :: forall (m :: * -> *). Quote m => ModelSixArguments -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ModelSixArguments -> Code m ModelSixArguments
liftTyped :: forall (m :: * -> *).
Quote m =>
ModelSixArguments -> Code m ModelSixArguments
Lift)
    deriving anyclass (ModelSixArguments -> ()
(ModelSixArguments -> ()) -> NFData ModelSixArguments
forall a. (a -> ()) -> NFData a
$crnf :: ModelSixArguments -> ()
rnf :: ModelSixArguments -> ()
NFData)

instance Default ModelSixArguments where
    def :: ModelSixArguments
def = CostingInteger -> ModelSixArguments
ModelSixArgumentsConstantCost CostingInteger
forall a. Bounded a => a
maxBound

instance UnimplementedCostingFun ModelSixArguments where
  unimplementedCostingFun :: forall b. b -> CostingFun ModelSixArguments
unimplementedCostingFun = (CostingInteger -> ModelSixArguments)
-> b -> CostingFun ModelSixArguments
forall model b. (CostingInteger -> model) -> b -> CostingFun model
makeUnimplementedCostingFun CostingInteger -> ModelSixArguments
ModelSixArgumentsConstantCost

runSixArgumentModel
    :: ModelSixArguments
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
runSixArgumentModel :: ModelSixArguments
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runSixArgumentModel (ModelSixArgumentsConstantCost CostingInteger
c) = (CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream)
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
forall a. a -> a
lazy ((CostStream
  -> CostStream
  -> CostStream
  -> CostStream
  -> CostStream
  -> CostStream
  -> CostStream)
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream)
-> (CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream)
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
forall a b. (a -> b) -> a -> b
$ \CostStream
_ CostStream
_ CostStream
_ CostStream
_ CostStream
_ CostStream
_ -> CostingInteger -> CostStream
CostLast CostingInteger
c
{-# NOINLINE runSixArgumentModel #-}

-- See Note [runCostingFun* API].
runCostingFunSixArguments
    :: ( ExMemoryUsage a1
       , ExMemoryUsage a2
       , ExMemoryUsage a3
       , ExMemoryUsage a4
       , ExMemoryUsage a5
       , ExMemoryUsage a6
       )
    => CostingFun ModelSixArguments
    -> a1
    -> a2
    -> a3
    -> a4
    -> a5
    -> a6
    -> ExBudgetStream
runCostingFunSixArguments :: forall a1 a2 a3 a4 a5 a6.
(ExMemoryUsage a1, ExMemoryUsage a2, ExMemoryUsage a3,
 ExMemoryUsage a4, ExMemoryUsage a5, ExMemoryUsage a6) =>
CostingFun ModelSixArguments
-> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> ExBudgetStream
runCostingFunSixArguments (CostingFun ModelSixArguments
cpu ModelSixArguments
mem) =
    case (ModelSixArguments
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runSixArgumentModel ModelSixArguments
cpu, ModelSixArguments
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runSixArgumentModel ModelSixArguments
mem) of
        (!CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runCpu, !CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runMem) -> (CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> CostStream
 -> ExBudgetStream)
-> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> ExBudgetStream
forall c a. OnMemoryUsages c a => c -> a
onMemoryUsages ((CostStream
  -> CostStream
  -> CostStream
  -> CostStream
  -> CostStream
  -> CostStream
  -> ExBudgetStream)
 -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> ExBudgetStream)
-> (CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> CostStream
    -> ExBudgetStream)
-> a1
-> a2
-> a3
-> a4
-> a5
-> a6
-> ExBudgetStream
forall a b. (a -> b) -> a -> b
$ \CostStream
mem1 CostStream
mem2 CostStream
mem3 CostStream
mem4 CostStream
mem5 CostStream
mem6 ->
            CostStream -> CostStream -> ExBudgetStream
zipCostStream
                (CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runCpu CostStream
mem1 CostStream
mem2 CostStream
mem3 CostStream
mem4 CostStream
mem5 CostStream
mem6)
                (CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
-> CostStream
runMem CostStream
mem1 CostStream
mem2 CostStream
mem3 CostStream
mem4 CostStream
mem5 CostStream
mem6)
{-# INLINE runCostingFunSixArguments #-}