Skip to content

Commit

Permalink
[Builtins] Make 'BuiltinSuccess' the first constructor (#5885)
Browse files Browse the repository at this point in the history
This makes `BuiltinSuccess` the first constructor of `BuiltinResult`, see the comment there of why we want that.

See [this](#5885 (comment)) comment for the very ambiguous benchmarking results.
  • Loading branch information
effectfully committed Aug 6, 2024
1 parent 6b52ae8 commit 2260c8b
Show file tree
Hide file tree
Showing 6 changed files with 32 additions and 22 deletions.
Original file line number Diff line number Diff line change
Expand Up @@ -317,9 +317,9 @@ type ReadKnown val = ReadKnownIn (UniOf val) val
-- | Same as 'makeKnown', but allows for neither emitting nor storing the cause of a failure.
makeKnownOrFail :: MakeKnownIn uni val a => a -> EvaluationResult val
makeKnownOrFail x = case makeKnown x of
BuiltinFailure _ _ -> EvaluationFailure
BuiltinSuccess val -> EvaluationSuccess val
BuiltinSuccessWithLogs _ val -> EvaluationSuccess val
BuiltinFailure _ _ -> EvaluationFailure
{-# INLINE makeKnownOrFail #-}

-- | Same as 'readKnown', but the cause of a potential failure is the provided term itself.
Expand Down
26 changes: 18 additions & 8 deletions plutus-core/plutus-core/src/PlutusCore/Builtin/Result.hs
Original file line number Diff line number Diff line change
Expand Up @@ -74,9 +74,19 @@ data BuiltinError
-- logging, since there's no logging on the chain and builtins don't emit much anyway. Otherwise
-- we'd have to use @text-builder@ or @text-builder-linear@ or something of this sort.
data BuiltinResult a
= BuiltinFailure (DList Text) BuiltinError
| BuiltinSuccess a
= -- 'BuiltinSuccess' is the first constructor to make it a bit more likely for GHC to
-- branch-predict it (which is something that we want, because most builtins return this
-- constructor). It is however not guaranteed that GHC will predict it, because even though
-- it's likely going to be a recursive case (it certainly is in the CEK machine) and thus the
-- constructor has precedence over 'BuiltinFailure', it doesn't have precedence over
-- 'BuiltinSuccessWithLogs', since that case is equally likely to be recursive.
--
-- Unfortunately, GHC doesn't offer any explicit control over branch-prediction (see this
-- ticket: https://gitlab.haskell.org/ghc/ghc/-/issues/849), so relying on hope is the best we
-- can do here.
BuiltinSuccess a
| BuiltinSuccessWithLogs (DList Text) a
| BuiltinFailure (DList Text) BuiltinError
deriving stock (Show, Foldable)

mtraverse makeClassyPrisms
Expand Down Expand Up @@ -174,43 +184,43 @@ throwNotAConstant = throwing _StructuralUnliftingError "Not a constant"
-- | Prepend logs to a 'BuiltinResult' computation.
withLogs :: DList Text -> BuiltinResult a -> BuiltinResult a
withLogs logs1 = \case
BuiltinFailure logs2 err -> BuiltinFailure (logs1 <> logs2) err
BuiltinSuccess x -> BuiltinSuccessWithLogs logs1 x
BuiltinSuccessWithLogs logs2 x -> BuiltinSuccessWithLogs (logs1 <> logs2) x
BuiltinFailure logs2 err -> BuiltinFailure (logs1 <> logs2) err
{-# INLINE withLogs #-}

instance Functor BuiltinResult where
fmap _ (BuiltinFailure logs err) = BuiltinFailure logs err
fmap f (BuiltinSuccess x) = BuiltinSuccess (f x)
fmap f (BuiltinSuccessWithLogs logs x) = BuiltinSuccessWithLogs logs (f x)
fmap _ (BuiltinFailure logs err) = BuiltinFailure logs err
{-# INLINE fmap #-}

-- Written out explicitly just in case.
_ <$ BuiltinFailure logs err = BuiltinFailure logs err
x <$ BuiltinSuccess _ = BuiltinSuccess x
x <$ BuiltinSuccessWithLogs logs _ = BuiltinSuccessWithLogs logs x
_ <$ BuiltinFailure logs err = BuiltinFailure logs err
{-# INLINE (<$) #-}

instance Applicative BuiltinResult where
pure = BuiltinSuccess
{-# INLINE pure #-}

BuiltinFailure logs err <*> _ = BuiltinFailure logs err
BuiltinSuccess f <*> a = fmap f a
BuiltinSuccessWithLogs logs f <*> a = withLogs logs $ fmap f a
BuiltinFailure logs err <*> _ = BuiltinFailure logs err
{-# INLINE (<*>) #-}

-- Better than the default implementation, because the value in the 'BuiltinSuccess' case
-- doesn't need to be retained.
BuiltinFailure logs err *> _ = BuiltinFailure logs err
BuiltinSuccess _ *> b = b
BuiltinSuccessWithLogs logs _ *> b = withLogs logs b
BuiltinFailure logs err *> _ = BuiltinFailure logs err
{-# INLINE (*>) #-}

instance Monad BuiltinResult where
BuiltinFailure logs err >>= _ = BuiltinFailure logs err
BuiltinSuccess x >>= f = f x
BuiltinSuccessWithLogs logs x >>= f = withLogs logs $ f x
BuiltinFailure logs err >>= _ = BuiltinFailure logs err
{-# INLINE (>>=) #-}

(>>) = (*>)
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -74,9 +74,9 @@ evalBuiltinApp
-> CkM uni fun s (CkValue uni fun)
evalBuiltinApp term runtime = case runtime of
BuiltinCostedResult _ getX -> case getX of
BuiltinFailure logs err -> emitCkM logs *> throwBuiltinErrorWithCause term err
BuiltinSuccess x -> pure x
BuiltinSuccessWithLogs logs x -> emitCkM logs $> x
BuiltinFailure logs err -> emitCkM logs *> throwBuiltinErrorWithCause term err
_ -> pure $ VBuiltin term runtime

ckValueToTerm :: CkValue uni fun -> Term TyName Name uni fun ()
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -658,11 +658,11 @@ evalBuiltinApp fun term runtime = case runtime of
BuiltinCostedResult budgets getX -> do
spendBudgetStreamCek (BBuiltinApp fun) budgets
case getX of
BuiltinSuccess x -> pure x
BuiltinSuccessWithLogs logs x -> ?cekEmitter logs $> x
BuiltinFailure logs err -> do
?cekEmitter logs
throwBuiltinErrorWithCause term err
BuiltinSuccess x -> pure x
BuiltinSuccessWithLogs logs x -> ?cekEmitter logs $> x
_ -> pure $ VBuiltin fun term runtime
{-# INLINE evalBuiltinApp #-}

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -445,11 +445,11 @@ evalBuiltinApp fun term runtime = case runtime of
BuiltinCostedResult budgets getX -> do
spendBudgetStreamCek (BBuiltinApp fun) budgets
case getX of
BuiltinSuccess x -> pure x
BuiltinSuccessWithLogs logs x -> ?cekEmitter logs $> x
BuiltinFailure logs err -> do
?cekEmitter logs
throwBuiltinErrorWithCause term err
BuiltinSuccess x -> pure x
BuiltinSuccessWithLogs logs x -> ?cekEmitter logs $> x
_ -> pure $ VBuiltin fun term runtime
{-# INLINE evalBuiltinApp #-}

Expand Down
16 changes: 8 additions & 8 deletions plutus-tx/src/PlutusTx/Builtins/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -258,10 +258,10 @@ keccak_256 (BuiltinByteString b) = BuiltinByteString $ Hash.keccak_256 b
verifyEd25519Signature :: BuiltinByteString -> BuiltinByteString -> BuiltinByteString -> BuiltinBool
verifyEd25519Signature (BuiltinByteString vk) (BuiltinByteString msg) (BuiltinByteString sig) =
case PlutusCore.Crypto.Ed25519.verifyEd25519Signature_V1 vk msg sig of
BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $
Haskell.error "Ed25519 signature verification errored."
BuiltinSuccess b -> BuiltinBool b
BuiltinSuccessWithLogs logs b -> traceAll logs $ BuiltinBool b
BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $
Haskell.error "Ed25519 signature verification errored."

{-# NOINLINE verifyEcdsaSecp256k1Signature #-}
verifyEcdsaSecp256k1Signature ::
Expand All @@ -271,10 +271,10 @@ verifyEcdsaSecp256k1Signature ::
BuiltinBool
verifyEcdsaSecp256k1Signature (BuiltinByteString vk) (BuiltinByteString msg) (BuiltinByteString sig) =
case PlutusCore.Crypto.Secp256k1.verifyEcdsaSecp256k1Signature vk msg sig of
BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $
Haskell.error "ECDSA SECP256k1 signature verification errored."
BuiltinSuccess b -> BuiltinBool b
BuiltinSuccessWithLogs logs b -> traceAll logs $ BuiltinBool b
BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $
Haskell.error "ECDSA SECP256k1 signature verification errored."

{-# NOINLINE verifySchnorrSecp256k1Signature #-}
verifySchnorrSecp256k1Signature ::
Expand All @@ -284,10 +284,10 @@ verifySchnorrSecp256k1Signature ::
BuiltinBool
verifySchnorrSecp256k1Signature (BuiltinByteString vk) (BuiltinByteString msg) (BuiltinByteString sig) =
case PlutusCore.Crypto.Secp256k1.verifySchnorrSecp256k1Signature vk msg sig of
BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $
Haskell.error "Schnorr SECP256k1 signature verification errored."
BuiltinSuccess b -> BuiltinBool b
BuiltinSuccessWithLogs logs b -> traceAll logs $ BuiltinBool b
BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $
Haskell.error "Schnorr SECP256k1 signature verification errored."

traceAll :: forall (a :: Type) (f :: Type -> Type) .
(Foldable f) => f Text -> a -> a
Expand Down Expand Up @@ -694,10 +694,10 @@ integerToByteString
-> BuiltinByteString
integerToByteString (BuiltinBool endiannessArg) paddingArg input =
case Convert.integerToByteStringWrapper endiannessArg paddingArg input of
BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $
Haskell.error "Integer to ByteString conversion errored."
BuiltinSuccess bs -> BuiltinByteString bs
BuiltinSuccessWithLogs logs bs -> traceAll logs $ BuiltinByteString bs
BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $
Haskell.error "Integer to ByteString conversion errored."

{-# NOINLINE byteStringToInteger #-}
byteStringToInteger
Expand Down

0 comments on commit 2260c8b

Please sign in to comment.