[Builtins] Make 'BuiltinSuccess' the first constructor

plutus-core/plutus-core/src/PlutusCore/Builtin/KnownType.hs

@@ -328,9 +328,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.

plutus-core/plutus-core/src/PlutusCore/Builtin/Result.hs

@@ -58,9 +58,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
@@ -113,43 +123,43 @@ throwNotAConstant = throwError $ BuiltinUnliftingError "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 (>>=) #-}
 
     (>>) = (*>)

plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Ck.hs

@@ -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 ()

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs

@@ -655,11 +655,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 #-}
 

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs

@@ -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 #-}
 

plutus-tx/src/PlutusTx/Builtins/Internal.hs

@@ -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 ::
@@ -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 ::
@@ -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
@@ -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