Skip to content
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Next Next commit
consensus: remove BoundedMeasure and WithTop
BoundedMeasure is no longer necessary, as of PR
#1182.
  • Loading branch information
nfrisby committed Sep 4, 2024
commit b966f232db2f448bf66d5de195c55e8ad439dad4
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,6 @@ module Ouroboros.Consensus.Shelley.Ledger.Mempool (
, SL.ApplyTxError (..)
, TxId (..)
, Validated (..)
, WithTop (..)
, fixedBlockBodyOverhead
, mkShelleyTx
, mkShelleyValidatedTx
Expand Down Expand Up @@ -54,8 +53,7 @@ import Control.Monad.Except (Except)
import Control.Monad.Identity (Identity (..))
import Data.DerivingVia (InstantiatedAt (..))
import Data.Foldable (toList)
import Data.Measure (BoundedMeasure, Measure)
import qualified Data.Measure as Measure
import Data.Measure (Measure)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import GHC.Natural (Natural)
Expand Down Expand Up @@ -322,13 +320,15 @@ instance ( ShelleyCompatible p (AlonzoEra c)

data AlonzoMeasure = AlonzoMeasure {
byteSize :: !Mempool.ByteSize
, exUnits :: !(ExUnits' (WithTop Natural))
, exUnits :: !(ExUnits' Natural)
} deriving stock (Eq, Generic, Show)
deriving (BoundedMeasure, Measure)
deriving (Measure)
via (InstantiatedAt Generic AlonzoMeasure)

fromExUnits :: ExUnits -> ExUnits' (WithTop Natural)
fromExUnits = fmap NotTop . unWrapExUnits
-- | This function used to do more, but now it's merely a synonym that avoids
-- more import statements in modules that import this one.
fromExUnits :: ExUnits -> ExUnits' Natural
fromExUnits = unWrapExUnits

txMeasureAlonzo ::
forall proto era.
Expand Down Expand Up @@ -367,7 +367,7 @@ data ConwayMeasure = ConwayMeasure {
alonzoMeasure :: !AlonzoMeasure
, refScriptsSize :: !Mempool.ByteSize
} deriving stock (Eq, Generic, Show)
deriving (BoundedMeasure, Measure)
deriving (Measure)
via (InstantiatedAt Generic ConwayMeasure)

instance ( ShelleyCompatible p (ConwayEra c)
Expand All @@ -392,38 +392,3 @@ instance ( ShelleyCompatible p (ConwayEra c)
-- For post-Conway eras, this will become a protocol parameter.
SL.maxRefScriptSizePerBlock
}

{-------------------------------------------------------------------------------
WithTop
-------------------------------------------------------------------------------}

-- | Add a unique top element to a lattice.
--
-- TODO This should be relocated to `cardano-base:Data.Measure'.
data WithTop a = NotTop a | Top
deriving (Eq, Generic, Show)

instance Ord a => Ord (WithTop a) where
compare = curry $ \case
(Top , Top ) -> EQ
(Top , _ ) -> GT
(_ , Top ) -> LT
(NotTop l, NotTop r) -> compare l r

instance Measure a => Measure (WithTop a) where
zero = NotTop Measure.zero
plus = curry $ \case
(Top , _ ) -> Top
(_ , Top ) -> Top
(NotTop l, NotTop r) -> NotTop $ Measure.plus l r
min = curry $ \case
(Top , r ) -> r
(l , Top ) -> l
(NotTop l, NotTop r) -> NotTop $ Measure.min l r
max = curry $ \case
(Top , _ ) -> Top
(_ , Top ) -> Top
(NotTop l, NotTop r) -> NotTop $ Measure.max l r

instance Measure a => BoundedMeasure (WithTop a) where
maxBound = Top
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ module Ouroboros.Consensus.Mempool.Capacity (
) where

import Cardano.Prelude (NFData)
import Data.Measure (BoundedMeasure, Measure)
import Data.Measure (Measure)
import Data.Word (Word32)
import NoThunks.Class
import Ouroboros.Consensus.Ledger.Basics
Expand Down Expand Up @@ -106,7 +106,7 @@ instance Monoid MempoolSize where
-- eras (starting with Alonzo) this measure was a bit more complex
-- as it had to take other factors into account (like execution units).
-- For details please see the individual instances for the TxLimits.
class BoundedMeasure (TxMeasure blk) => TxLimits blk where
class Measure (TxMeasure blk) => TxLimits blk where
type TxMeasure blk

-- | What is the measure an individual tx?
Expand All @@ -125,4 +125,4 @@ class BoundedMeasure (TxMeasure blk) => TxLimits blk where
newtype ByteSize = ByteSize { unByteSize :: Word32 }
deriving stock (Show)
deriving newtype (Eq, NFData, Ord)
deriving newtype (BoundedMeasure, Measure)
deriving newtype (Measure)