Skip to content

Commit

Permalink
Remove AssocMap comparison instances (#6173)
Browse files Browse the repository at this point in the history

Signed-off-by: Ana Pantilie <ana.pantilie95@gmail.com>
  • Loading branch information
ana-pantilie authored Jun 13, 2024
1 parent 7d6dbc1 commit 294eaca
Show file tree
Hide file tree
Showing 9 changed files with 15 additions and 135 deletions.
Original file line number Diff line number Diff line change
Expand Up @@ -134,24 +134,6 @@ mkScriptContextEqualityDataCode sc =
`PlutusTx.unsafeApplyCode` PlutusTx.liftCodeDef sc
`PlutusTx.unsafeApplyCode` PlutusTx.liftCodeDef d

-- This example checks the script context for equality (with itself) when encoded
-- as a normal (i.e. Scott-encoded) term, using the normal (i.e. typeclass-based) equality
-- functions. This can be quite expensive for a large structure!
{-# INLINABLE scriptContextEqualityTerm #-}
scriptContextEqualityTerm :: ScriptContext -> PlutusTx.BuiltinData -> ()
-- See Note [Redundant arguments to equality benchmarks]
scriptContextEqualityTerm sc _ =
if sc PlutusTx.== sc
then ()
else PlutusTx.traceError "The argument is not equal to itself"

mkScriptContextEqualityTermCode :: ScriptContext -> PlutusTx.CompiledCode ()
mkScriptContextEqualityTermCode sc =
let d = PlutusTx.toBuiltinData sc
in $$(PlutusTx.compile [|| scriptContextEqualityTerm ||])
`PlutusTx.unsafeApplyCode` PlutusTx.liftCodeDef sc
`PlutusTx.unsafeApplyCode` PlutusTx.liftCodeDef d

-- This example is just the overhead from the previous two
-- See Note [Redundant arguments to equality benchmarks]
{-# INLINABLE scriptContextEqualityOverhead #-}
Expand Down

This file was deleted.

This file was deleted.

4 changes: 0 additions & 4 deletions plutus-benchmark/script-contexts/test/Spec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -85,10 +85,6 @@ testCheckScEquality = testGroup "checkScriptContextEquality"
mkScriptContextEqualityDataCode (mkScriptContext 20)
, Tx.goldenEvalCekCatch "checkScriptContextEqualityData-20" $
[mkScriptContextEqualityDataCode (mkScriptContext 20)]
, Tx.goldenBudget "checkScriptContextEqualityTerm-20" $
mkScriptContextEqualityTermCode (mkScriptContext 20)
, Tx.goldenEvalCekCatch "checkScriptContextEqualityTerm-20" $
[mkScriptContextEqualityTermCode (mkScriptContext 20)]
, Tx.goldenBudget "checkScriptContextEqualityOverhead-20" $
mkScriptContextEqualityOverheadCode (mkScriptContext 20)
, Tx.goldenEvalCekCatch "checkScriptContextEqualityOverhead-20" $
Expand Down
13 changes: 2 additions & 11 deletions plutus-ledger-api/src/PlutusLedgerApi/V2/Contexts.hs
Original file line number Diff line number Diff line change
Expand Up @@ -84,12 +84,7 @@ data TxInfo = TxInfo
, txInfoData :: Map DatumHash Datum -- ^ The lookup table of datums attached to the transaction
-- /V1->V2/: changed from assoc list to a 'PlutusTx.AssocMap'
, txInfoId :: TxId -- ^ Hash of the pending transaction body (i.e. transaction excluding witnesses)
} deriving stock (Generic, Haskell.Show, Haskell.Eq)

instance Eq TxInfo where
{-# INLINABLE (==) #-}
TxInfo i ri o f m c w r s rs d tid == TxInfo i' ri' o' f' m' c' w' r' s' rs' d' tid' =
i == i' && ri == ri' && o == o' && f == f' && m == m' && c == c' && w == w' && r == r' && s == s' && rs == rs' && d == d' && tid == tid'
} deriving stock (Generic, Haskell.Show)

instance Pretty TxInfo where
pretty TxInfo{txInfoInputs, txInfoReferenceInputs, txInfoOutputs, txInfoFee, txInfoMint, txInfoDCert, txInfoWdrl, txInfoValidRange, txInfoSignatories, txInfoRedeemers, txInfoData, txInfoId} =
Expand All @@ -113,11 +108,7 @@ data ScriptContext = ScriptContext
{ scriptContextTxInfo :: TxInfo -- ^ information about the transaction the currently-executing script is included in
, scriptContextPurpose :: ScriptPurpose -- ^ the purpose of the currently-executing script
}
deriving stock (Generic, Haskell.Eq, Haskell.Show)

instance Eq ScriptContext where
{-# INLINABLE (==) #-}
ScriptContext info purpose == ScriptContext info' purpose' = info == info' && purpose == purpose'
deriving stock (Generic, Haskell.Show)

instance Pretty ScriptContext where
pretty ScriptContext{scriptContextTxInfo, scriptContextPurpose} =
Expand Down
103 changes: 7 additions & 96 deletions plutus-ledger-api/src/PlutusLedgerApi/V3/Contexts.hs
Original file line number Diff line number Diff line change
Expand Up @@ -237,7 +237,7 @@ data Committee = Committee
, committeeQuorum :: PlutusTx.Rational
-- ^ Quorum of the committee that is necessary for a successful vote
}
deriving stock (Generic, Haskell.Show, Haskell.Eq)
deriving stock (Generic, Haskell.Show)

instance Pretty Committee where
pretty Committee{..} =
Expand All @@ -246,11 +246,6 @@ instance Pretty Committee where
, "committeeQuorum:" <+> pretty committeeQuorum
]

instance PlutusTx.Eq Committee where
{-# INLINEABLE (==) #-}
Committee a b == Committee a' b' =
a PlutusTx.== a' PlutusTx.&& b PlutusTx.== b'

-- | A constitution. The optional anchor is omitted.
newtype Constitution = Constitution
{ constitutionScript :: Haskell.Maybe V2.ScriptHash
Expand Down Expand Up @@ -322,35 +317,16 @@ data GovernanceAction
Rational -- ^ New quorum
| NewConstitution (Haskell.Maybe GovernanceActionId) Constitution
| InfoAction
deriving stock (Generic, Haskell.Show, Haskell.Eq)
deriving stock (Generic, Haskell.Show)
deriving (Pretty) via (PrettyShow GovernanceAction)

instance PlutusTx.Eq GovernanceAction where
{-# INLINEABLE (==) #-}
ParameterChange a b c == ParameterChange a' b' c' =
a PlutusTx.== a' PlutusTx.&& b PlutusTx.== b' PlutusTx.&& c PlutusTx.== c'
HardForkInitiation a b == HardForkInitiation a' b' =
a PlutusTx.== a' PlutusTx.&& b PlutusTx.== b'
TreasuryWithdrawals a b == TreasuryWithdrawals a' b' =
a PlutusTx.== a' PlutusTx.&& b PlutusTx.== b'
NoConfidence a == NoConfidence a' = a PlutusTx.== a'
UpdateCommittee a b c d == UpdateCommittee a' b' c' d' =
a PlutusTx.== a'
PlutusTx.&& b PlutusTx.== b'
PlutusTx.&& c PlutusTx.== c'
PlutusTx.&& d PlutusTx.== d'
NewConstitution a b == NewConstitution a' b' =
a PlutusTx.== a' PlutusTx.&& b PlutusTx.== b'
InfoAction == InfoAction = Haskell.True
_ == _ = Haskell.False

-- | A proposal procedure. The optional anchor is omitted.
data ProposalProcedure = ProposalProcedure
{ ppDeposit :: V2.Lovelace
, ppReturnAddr :: V2.Credential
, ppGovernanceAction :: GovernanceAction
}
deriving stock (Generic, Haskell.Show, Haskell.Eq)
deriving stock (Generic, Haskell.Show)

instance Pretty ProposalProcedure where
pretty ProposalProcedure{..} =
Expand All @@ -360,13 +336,6 @@ instance Pretty ProposalProcedure where
, "ppGovernanceAction:" <+> pretty ppGovernanceAction
]

instance PlutusTx.Eq ProposalProcedure where
{-# INLINEABLE (==) #-}
ProposalProcedure a b c == ProposalProcedure a' b' c' =
a PlutusTx.== a'
PlutusTx.&& b PlutusTx.== b'
PlutusTx.&& c PlutusTx.== c'

-- | A `ScriptPurpose` uniquely identifies a Plutus script within a transaction.
data ScriptPurpose
= Minting V2.CurrencySymbol
Expand All @@ -381,25 +350,9 @@ data ScriptPurpose
Haskell.Integer
-- ^ 0-based index of the given `ProposalProcedure` in `txInfoProposalProcedures`
ProposalProcedure
deriving stock (Generic, Haskell.Show, Haskell.Eq)
deriving stock (Generic, Haskell.Show)
deriving (Pretty) via (PrettyShow ScriptPurpose)

instance PlutusTx.Eq ScriptPurpose where
{-# INLINEABLE (==) #-}
Minting a == Minting a' =
a PlutusTx.== a'
Spending a == Spending a' =
a PlutusTx.== a'
Rewarding a == Rewarding a' =
a PlutusTx.== a'
Certifying a b == Certifying a' b' =
a PlutusTx.== a' PlutusTx.&& b PlutusTx.== b'
Voting a == Voting a' =
a PlutusTx.== a'
Proposing a b == Proposing a' b' =
a PlutusTx.== a' PlutusTx.&& b PlutusTx.== b'
_ == _ = Haskell.False

-- | Like `ScriptPurpose` but with an optional datum for spending scripts.
data ScriptInfo
= MintingScript V2.CurrencySymbol
Expand All @@ -414,25 +367,9 @@ data ScriptInfo
Haskell.Integer
-- ^ 0-based index of the given `ProposalProcedure` in `txInfoProposalProcedures`
ProposalProcedure
deriving stock (Generic, Haskell.Show, Haskell.Eq)
deriving stock (Generic, Haskell.Show)
deriving (Pretty) via (PrettyShow ScriptInfo)

instance PlutusTx.Eq ScriptInfo where
{-# INLINEABLE (==) #-}
MintingScript a == MintingScript a' =
a PlutusTx.== a'
SpendingScript a b== SpendingScript a' b' =
a PlutusTx.== a' PlutusTx.&& b PlutusTx.== b'
RewardingScript a == RewardingScript a' =
a PlutusTx.== a'
CertifyingScript a b == CertifyingScript a' b' =
a PlutusTx.== a' PlutusTx.&& b PlutusTx.== b'
VotingScript a == VotingScript a' =
a PlutusTx.== a'
ProposingScript a b == ProposingScript a' b' =
a PlutusTx.== a' PlutusTx.&& b PlutusTx.== b'
_ == _ = Haskell.False

-- | An input of a pending transaction.
data TxInInfo = TxInInfo
{ txInInfoOutRef :: V3.TxOutRef
Expand Down Expand Up @@ -471,7 +408,7 @@ data TxInfo = TxInfo
, txInfoCurrentTreasuryAmount :: Haskell.Maybe V2.Lovelace
, txInfoTreasuryDonation :: Haskell.Maybe V2.Lovelace
}
deriving stock (Generic, Haskell.Show, Haskell.Eq)
deriving stock (Generic, Haskell.Show)

instance Pretty TxInfo where
pretty TxInfo{..} =
Expand All @@ -494,27 +431,6 @@ instance Pretty TxInfo where
, "Treasury Donation:" <+> pretty txInfoTreasuryDonation
]

instance PlutusTx.Eq TxInfo where
{-# INLINEABLE (==) #-}
TxInfo a b c d e f g h i j k l m n o p
== TxInfo a' b' c' d' e' f' g' h' i' j' k' l' m' n' o' p' =
a PlutusTx.== a'
PlutusTx.&& b PlutusTx.== b'
PlutusTx.&& c PlutusTx.== c'
PlutusTx.&& d PlutusTx.== d'
PlutusTx.&& e PlutusTx.== e'
PlutusTx.&& f PlutusTx.== f'
PlutusTx.&& g PlutusTx.== g'
PlutusTx.&& h PlutusTx.== h'
PlutusTx.&& i PlutusTx.== i'
PlutusTx.&& j PlutusTx.== j'
PlutusTx.&& k PlutusTx.== k'
PlutusTx.&& l PlutusTx.== l'
PlutusTx.&& m PlutusTx.== m'
PlutusTx.&& n PlutusTx.== n'
PlutusTx.&& o PlutusTx.== o'
PlutusTx.&& p PlutusTx.== p'

-- | The context that the currently-executing script can access.
data ScriptContext = ScriptContext
{ scriptContextTxInfo :: TxInfo
Expand All @@ -525,7 +441,7 @@ data ScriptContext = ScriptContext
-- ^ the purpose of the currently-executing script, along with information associated
-- with the purpose
}
deriving stock (Generic, Haskell.Eq, Haskell.Show)
deriving stock (Generic, Haskell.Show)

instance Pretty ScriptContext where
pretty ScriptContext{..} =
Expand All @@ -535,11 +451,6 @@ instance Pretty ScriptContext where
, nest 2 (vsep ["Redeemer:", pretty scriptContextRedeemer])
]

instance PlutusTx.Eq ScriptContext where
{-# INLINEABLE (==) #-}
ScriptContext a b c == ScriptContext a' b' c' =
a PlutusTx.== a' PlutusTx.&& b PlutusTx.== b' PlutusTx.&& c PlutusTx.== c'

{-# INLINEABLE findOwnInput #-}

-- | Find the input currently being validated.
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
### Removed

- Removed incorrect Ord and Eq instances from AssocMap and Data.AssocMap.
4 changes: 2 additions & 2 deletions plutus-tx/src/PlutusTx/AssocMap.hs
Original file line number Diff line number Diff line change
Expand Up @@ -70,8 +70,8 @@ import Prettyprinter (Pretty (..))
-- Take care when using 'fromBuiltinData' and 'unsafeFromBuiltinData', as neither function performs
-- deduplication of the input collection and may create invalid 'Map's!
newtype Map k v = Map {unMap :: [(k, v)]}
deriving stock (Generic, Haskell.Eq, Haskell.Show, Data, TH.Lift)
deriving newtype (Eq, Ord, NFData)
deriving stock (Generic, Haskell.Show, Data, TH.Lift)
deriving newtype (NFData)

-- | Hand-written instances to use the underlying 'Map' type in 'Data', and
-- to be reasonably efficient.
Expand Down
2 changes: 1 addition & 1 deletion plutus-tx/src/PlutusTx/Data/AssocMap.hs
Original file line number Diff line number Diff line change
Expand Up @@ -63,7 +63,7 @@ this implementation provides slow lookup and update operations because it is bas
on a list representation.
-}
newtype Map k a = Map (BI.BuiltinList (BI.BuiltinPair BuiltinData BuiltinData))
deriving stock (Haskell.Eq, Haskell.Show)
deriving stock (Haskell.Show)

instance P.ToData (Map k a) where
{-# INLINEABLE toBuiltinData #-}
Expand Down

0 comments on commit 294eaca

Please sign in to comment.