{-# LANGUAGE BangPatterns #-}
module PlutusCore.Evaluation.Machine.CostStream
( CostStream(..)
, unconsCost
, reconsCost
, sumCostStream
, mapCostStream
, addCostStream
, minCostStream
) where
import PlutusCore.Evaluation.Machine.ExMemory
data CostStream
= CostLast {-# UNPACK #-} !CostingInteger
| CostCons {-# UNPACK #-} !CostingInteger CostStream
deriving stock (Int -> CostStream -> ShowS
[CostStream] -> ShowS
CostStream -> String
(Int -> CostStream -> ShowS)
-> (CostStream -> String)
-> ([CostStream] -> ShowS)
-> Show CostStream
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CostStream -> ShowS
showsPrec :: Int -> CostStream -> ShowS
$cshow :: CostStream -> String
show :: CostStream -> String
$cshowList :: [CostStream] -> ShowS
showList :: [CostStream] -> ShowS
Show)
unconsCost :: CostStream -> (CostingInteger, Maybe CostStream)
unconsCost :: CostStream -> (CostingInteger, Maybe CostStream)
unconsCost (CostLast CostingInteger
cost) = (CostingInteger
cost, Maybe CostStream
forall a. Maybe a
Nothing)
unconsCost (CostCons CostingInteger
cost CostStream
costs) = (CostingInteger
cost, CostStream -> Maybe CostStream
forall a. a -> Maybe a
Just CostStream
costs)
{-# INLINE unconsCost #-}
reconsCost :: CostingInteger -> Maybe CostStream -> CostStream
reconsCost :: CostingInteger -> Maybe CostStream -> CostStream
reconsCost CostingInteger
cost = CostStream
-> (CostStream -> CostStream) -> Maybe CostStream -> CostStream
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CostingInteger -> CostStream
CostLast CostingInteger
cost) (CostingInteger -> CostStream -> CostStream
CostCons CostingInteger
cost)
{-# INLINE reconsCost #-}
sumCostStreamGo :: CostingInteger -> CostStream -> CostingInteger
sumCostStreamGo :: CostingInteger -> CostStream -> CostingInteger
sumCostStreamGo !CostingInteger
acc (CostLast CostingInteger
cost) = CostingInteger
acc CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
+ CostingInteger
cost
sumCostStreamGo !CostingInteger
acc (CostCons CostingInteger
cost CostStream
costs) = CostingInteger -> CostStream -> CostingInteger
sumCostStreamGo (CostingInteger
acc CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
+ CostingInteger
cost) CostStream
costs
sumCostStream :: CostStream -> CostingInteger
sumCostStream :: CostStream -> CostingInteger
sumCostStream (CostLast CostingInteger
cost0) = CostingInteger
cost0
sumCostStream (CostCons CostingInteger
cost0 CostStream
costs0) = CostingInteger -> CostStream -> CostingInteger
sumCostStreamGo CostingInteger
cost0 CostStream
costs0
{-# INLINE sumCostStream #-}
mapCostStream :: (CostingInteger -> CostingInteger) -> CostStream -> CostStream
mapCostStream :: (CostingInteger -> CostingInteger) -> CostStream -> CostStream
mapCostStream CostingInteger -> CostingInteger
f (CostLast CostingInteger
cost0) = CostingInteger -> CostStream
CostLast (CostingInteger -> CostingInteger
f CostingInteger
cost0)
mapCostStream CostingInteger -> CostingInteger
f (CostCons CostingInteger
cost0 CostStream
costs0) = CostingInteger -> CostStream -> CostStream
CostCons (CostingInteger -> CostingInteger
f CostingInteger
cost0) (CostStream -> CostStream) -> CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ CostStream -> CostStream
go CostStream
costs0 where
go :: CostStream -> CostStream
go :: CostStream -> CostStream
go (CostLast CostingInteger
cost) = CostingInteger -> CostStream
CostLast (CostingInteger -> CostingInteger
f CostingInteger
cost)
go (CostCons CostingInteger
cost CostStream
costs) = CostingInteger -> CostStream -> CostStream
CostCons (CostingInteger -> CostingInteger
f CostingInteger
cost) (CostStream -> CostStream) -> CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ CostStream -> CostStream
go CostStream
costs
{-# INLINE mapCostStream #-}
addCostStreamGo :: CostStream -> CostStream -> CostStream
addCostStreamGo :: CostStream -> CostStream -> CostStream
addCostStreamGo (CostLast CostingInteger
costL) CostStream
costsR = CostingInteger -> CostStream -> CostStream
CostCons CostingInteger
costL CostStream
costsR
addCostStreamGo (CostCons CostingInteger
costL CostStream
costsL) CostStream
costsR = CostingInteger -> CostStream -> CostStream
CostCons CostingInteger
costL (CostStream -> CostStream) -> CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ CostStream -> CostStream -> CostStream
addCostStreamGo CostStream
costsR CostStream
costsL
addCostStream :: CostStream -> CostStream -> CostStream
addCostStream :: CostStream -> CostStream -> CostStream
addCostStream CostStream
costsL0 CostStream
costsR0 = case (CostStream
costsL0, CostStream
costsR0) of
(CostLast CostingInteger
costL, CostLast CostingInteger
costR) -> CostingInteger -> CostStream
CostLast (CostingInteger -> CostStream) -> CostingInteger -> CostStream
forall a b. (a -> b) -> a -> b
$ CostingInteger
costL CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
+ CostingInteger
costR
(CostStream, CostStream)
_ -> CostStream -> CostStream -> CostStream
addCostStreamGo CostStream
costsL0 CostStream
costsR0
{-# INLINE addCostStream #-}
minCostStreamGo :: CostStream -> CostStream -> CostStream
minCostStreamGo :: CostStream -> CostStream -> CostStream
minCostStreamGo CostStream
costsL CostStream
costsR =
let (!CostingInteger
costL, !Maybe CostStream
mayCostsL') = CostStream -> (CostingInteger, Maybe CostStream)
unconsCost CostStream
costsL
(!CostingInteger
costR, !Maybe CostStream
mayCostsR') = CostStream -> (CostingInteger, Maybe CostStream)
unconsCost CostStream
costsR
(!CostingInteger
costMin, !Maybe CostStream
mayCostsL'', !Maybe CostStream
mayCostsR'') = case CostingInteger
costL CostingInteger -> CostingInteger -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` CostingInteger
costR of
Ordering
LT -> (CostingInteger
costL, Maybe CostStream
mayCostsL', CostStream -> Maybe CostStream
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CostStream -> Maybe CostStream) -> CostStream -> Maybe CostStream
forall a b. (a -> b) -> a -> b
$ CostingInteger -> Maybe CostStream -> CostStream
reconsCost (CostingInteger
costR CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
- CostingInteger
costL) Maybe CostStream
mayCostsR')
Ordering
EQ -> (CostingInteger
costL, Maybe CostStream
mayCostsL', Maybe CostStream
mayCostsR')
Ordering
GT -> (CostingInteger
costR, CostStream -> Maybe CostStream
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CostStream -> Maybe CostStream) -> CostStream -> Maybe CostStream
forall a b. (a -> b) -> a -> b
$ CostingInteger -> Maybe CostStream -> CostStream
reconsCost (CostingInteger
costL CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
- CostingInteger
costR) Maybe CostStream
mayCostsL', Maybe CostStream
mayCostsR')
in CostingInteger -> Maybe CostStream -> CostStream
reconsCost CostingInteger
costMin (Maybe CostStream -> CostStream) -> Maybe CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ CostStream -> CostStream -> CostStream
minCostStreamGo (CostStream -> CostStream -> CostStream)
-> Maybe CostStream -> Maybe (CostStream -> CostStream)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CostStream
mayCostsL'' Maybe (CostStream -> CostStream)
-> Maybe CostStream -> Maybe CostStream
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe CostStream
mayCostsR''
minCostStream :: CostStream -> CostStream -> CostStream
minCostStream :: CostStream -> CostStream -> CostStream
minCostStream CostStream
costsL0 CostStream
costsR0 = case (CostStream
costsL0, CostStream
costsR0) of
(CostLast CostingInteger
costL, CostLast CostingInteger
costR) -> CostingInteger -> CostStream
CostLast (CostingInteger -> CostStream) -> CostingInteger -> CostStream
forall a b. (a -> b) -> a -> b
$ CostingInteger -> CostingInteger -> CostingInteger
forall a. Ord a => a -> a -> a
min CostingInteger
costL CostingInteger
costR
(CostStream, CostStream)
_ -> CostStream -> CostStream -> CostStream
minCostStreamGo CostStream
costsL0 CostStream
costsR0
{-# INLINE minCostStream #-}