Remove prismatic error handling from Ck/Cek machines

Author: SeungheonOh

plutus-core/cost-model/budgeting-bench/Benchmarks/Nops.hs

@@ -22,7 +22,6 @@ import PlutusCore.Evaluation.Machine.BuiltinCostModel hiding (BuiltinCostModel)
 import PlutusCore.Evaluation.Machine.ExBudgetingDefaults
 import PlutusCore.Evaluation.Machine.ExMemoryUsage (ExMemoryUsage)
 import PlutusCore.Evaluation.Machine.MachineParameters
-import PlutusCore.Evaluation.Result (evaluationFailure)
 import PlutusCore.Pretty
 import PlutusPrelude
 import UntypedPlutusCore.Evaluation.Machine.Cek
@@ -137,7 +136,7 @@ infixr >:
 n >: k =
     case n of
       SomeConstant (Some (ValueOf DefaultUniInteger _)) -> k
-      _                                                 -> evaluationFailure
+      _                                                 -> builtinResultFailure
 {-# INLINE (>:) #-}
 
 {- | The meanings of the builtins.  Each one takes a number of arguments and

plutus-core/docs/BuiltinsOverview.md

@@ -402,7 +402,7 @@ Here's an example instance (where `Term` is the type of TPLC terms):
 ```haskell
 instance HasConstant (Term TyName Name uni fun ()) where
     asConstant (Constant _ val) = pure val
-    asConstant _                = throwNotAConstant
+    asConstant _                = throwError notAConstant
 ```
 
 Unlifting of constants then is just a matter of unwrapping a value as a constant and checking that the constant is of the right type, which is what the default implementation of `readKnown` does:
@@ -452,5 +452,5 @@ instance
         ( TypeError ('Text "‘BuiltinResult’ cannot appear in the type of an argument")
         , uni ~ UniOf val
         ) => ReadKnownIn uni val (BuiltinResult a) where
-    readKnown _ = throwUnderTypeError
+    readKnown _ = throwError underTypeError
 ```

plutus-core/plutus-core/examples/PlutusCore/Examples/Builtins.hs

@@ -24,14 +24,14 @@ import PlutusCore.Data
 import PlutusCore.Evaluation.Machine.BuiltinCostModel
 import PlutusCore.Evaluation.Machine.ExBudget
 import PlutusCore.Evaluation.Machine.ExBudgetStream
-import PlutusCore.Evaluation.Result (evaluationFailure)
 import PlutusCore.Pretty
 
 import PlutusCore.StdLib.Data.ScottList qualified as Plc
 
 import Control.Concurrent.MVar
 import Control.Exception
 import Control.Monad
+import Control.Monad.Except
 import Data.Default.Class
 import Data.Either
 import Data.Kind qualified as GHC (Type)
@@ -199,7 +199,7 @@ instance tyname ~ TyName => KnownTypeAst tyname DefaultUni Void where
 instance UniOf term ~ DefaultUni => MakeKnownIn DefaultUni term Void where
     makeKnown = absurd
 instance UniOf term ~ DefaultUni => ReadKnownIn DefaultUni term Void where
-    readKnown _ = throwing _StructuralUnliftingError "Can't unlift to 'Void'"
+    readKnown _ = throwError $ structuralUnliftingError "Can't unlift to 'Void'"
 
 data BuiltinErrorCall = BuiltinErrorCall
     deriving stock (Show, Eq)
@@ -286,7 +286,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni ExtensionFun where
         idAssumeCheckBoolPlc val =
             case asConstant val of
                 Right (Some (ValueOf DefaultUniBool b)) -> pure b
-                _                                       -> evaluationFailure
+                _                                       -> builtinResultFailure
 
     toBuiltinMeaning _semvar IdSomeConstantBool =
         makeBuiltinMeaning
@@ -296,7 +296,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni ExtensionFun where
         idSomeConstantBoolPlc :: SomeConstant uni Bool -> BuiltinResult Bool
         idSomeConstantBoolPlc = \case
             SomeConstant (Some (ValueOf DefaultUniBool b)) -> pure b
-            _                                              -> evaluationFailure
+            _                                              -> builtinResultFailure
 
     toBuiltinMeaning _semvar IdIntegerAsBool =
         makeBuiltinMeaning
@@ -306,7 +306,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni ExtensionFun where
         idIntegerAsBool :: SomeConstant uni Integer -> BuiltinResult (SomeConstant uni Integer)
         idIntegerAsBool = \case
             con@(SomeConstant (Some (ValueOf DefaultUniBool _))) -> pure con
-            _                                                    -> evaluationFailure
+            _                                                    -> builtinResultFailure
 
     toBuiltinMeaning _semvar IdFInteger =
         makeBuiltinMeaning
@@ -397,7 +397,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni ExtensionFun where
 
     toBuiltinMeaning _semvar ErrorPrime =
         makeBuiltinMeaning
-            (evaluationFailure :: forall a. BuiltinResult a)
+            (builtinResultFailure :: forall a. BuiltinResult a)
             whatever
 
     toBuiltinMeaning _semvar Comma =

plutus-core/plutus-core/src/PlutusCore/Bitwise.hs

@@ -24,8 +24,7 @@ module PlutusCore.Bitwise (
   maximumOutputLength
   ) where
 
-import PlutusCore.Builtin (BuiltinResult, emit)
-import PlutusCore.Evaluation.Result (evaluationFailure)
+import PlutusCore.Builtin (BuiltinResult, builtinResultFailure, emit)
 
 import ByteString.StrictBuilder (Builder)
 import ByteString.StrictBuilder qualified as Builder
@@ -64,15 +63,15 @@ integerToByteString endiannessArg lengthArg input
   | lengthArg < 0 = do
       emit "integerToByteString: negative length argument"
       emit $ "Length requested: " <> (pack . show $ input)
-      evaluationFailure
+      builtinResultFailure
   -- Check that the requested length does not exceed the limit.  *NB*: if we remove the limit we'll
   -- still have to make sure that the length fits into an Int.
   | lengthArg > maximumOutputLength = do
       emit . pack $ "integerToByteString: requested length is too long (maximum is "
                ++ show maximumOutputLength
                ++ " bytes)"
       emit $ "Length requested: " <> (pack . show $ lengthArg)
-      evaluationFailure
+      builtinResultFailure
   -- If the requested length is zero (ie, an explicit output size is not
   -- specified) we still have to make sure that the output won't exceed the size
   -- limit.  If the requested length is nonzero and less than the limit,
@@ -86,7 +85,7 @@ integerToByteString endiannessArg lengthArg input
                ++ show (8 * maximumOutputLength)
                ++ "-1)"
       emit $ "Length required: " <> (pack . show $ bytesRequiredFor input)
-      evaluationFailure
+      builtinResultFailure
   | otherwise = let endianness = endiannessArgToByteOrder endiannessArg in
     -- We use fromIntegral here, despite advice to the contrary in general when defining builtin
     -- denotations. This is because, if we've made it this far, we know that overflow or truncation
@@ -98,14 +97,14 @@ integerToByteString endiannessArg lengthArg input
           -- This does work proportional to the size of input. However, we're in a failing case
           -- anyway, and the user's paid for work proportional to this size in any case.
           emit $ "Input: " <> (pack . show $ input)
-          evaluationFailure
+          builtinResultFailure
         NotEnoughDigits -> do
           emit "integerToByteString: cannot represent Integer in given number of bytes"
           -- This does work proportional to the size of input. However, we're in a failing case
           -- anyway, and the user's paid for work proportional to this size in any case.
           emit $ "Input: " <> (pack . show $ input)
           emit $ "Bytes requested: " <> (pack . show $ lengthArg)
-          evaluationFailure
+          builtinResultFailure
       Right result -> pure result
 
 -- | Conversion from 'Integer' to 'ByteString', as per
@@ -528,11 +527,11 @@ readBit bs ix
   | ix < 0 = do
       emit "readBit: index out of bounds"
       emit $ "Index: " <> (pack . show $ ix)
-      evaluationFailure
+      builtinResultFailure
   | ix >= len * 8 = do
       emit "readBit: index out of bounds"
       emit $ "Index: " <> (pack . show $ ix)
-      evaluationFailure
+      builtinResultFailure
   | otherwise = do
       let (bigIx, littleIx) = ix `quotRem` 8
       let flipIx = len - bigIx - 1
@@ -548,7 +547,7 @@ writeBits bs ixs bit = case unsafeDupablePerformIO . try $ go of
   Left (WriteBitsException i) -> do
     emit "writeBits: index out of bounds"
     emit $ "Index: " <> (pack . show $ i)
-    evaluationFailure
+    builtinResultFailure
   Right result -> pure result
   where
     -- This is written in a somewhat strange way. See Note [writeBits and
@@ -588,13 +587,13 @@ replicateByte :: Integer -> Word8 -> BuiltinResult ByteString
 replicateByte len w8
   | len < 0 = do
       emit "replicateByte: negative length requested"
-      evaluationFailure
+      builtinResultFailure
   | len > maximumOutputLength = do
       emit . pack $ "replicateByte: requested length is too long (maximum is "
                ++ show maximumOutputLength
                ++ " bytes)"
       emit $ "Length requested: " <> (pack . show $ len)
-      evaluationFailure
+      builtinResultFailure
   | otherwise = pure . BS.replicate (fromIntegral len) $ w8
 
 -- | Wrapper for calling 'unsafesShiftByteString' safely. Specifically, we avoid various edge cases:

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

@@ -5,7 +5,7 @@
 
 module PlutusCore.Builtin.HasConstant
     ( BuiltinError (..)
-    , throwNotAConstant
+    , notAConstant
     , HasConstant (..)
     , HasConstantIn
     , fromValueOf
@@ -18,6 +18,8 @@ import PlutusCore.Name.Unique
 
 import Universe
 
+import Control.Monad.Except
+
 {- Note [Existence of HasConstant]
 We don't really need 'HasConstant' and could get away with only having 'HasConstantIn', however
 defining the latter directly as a @class@ instead of a type synonym in terms of the former is
@@ -56,6 +58,6 @@ fromValue = fromValueOf knownUni
 
 instance HasConstant (Term TyName Name uni fun ()) where
     asConstant (Constant _ val) = pure val
-    asConstant _                = throwNotAConstant
+    asConstant _                = throwError notAConstant
 
     fromConstant = Constant ()

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

@@ -17,7 +17,6 @@
 
 module PlutusCore.Builtin.KnownType
     ( BuiltinError
-    , throwBuiltinErrorWithCause
     , KnownBuiltinTypeIn
     , KnownBuiltinType
     , BuiltinResult (..)
@@ -39,10 +38,11 @@ import PlutusCore.Builtin.HasConstant
 import PlutusCore.Builtin.Polymorphism
 import PlutusCore.Builtin.Result
 import PlutusCore.Core
-import PlutusCore.Evaluation.ErrorWithCause
+import PlutusCore.Evaluation.Machine.Exception
 import PlutusCore.Evaluation.Result
 import PlutusCore.Pretty
 
+import Control.Monad.Except
 import Data.Either.Extras
 import Data.Functor.Identity
 import Data.String
@@ -276,7 +276,7 @@ readKnownConstant val = asConstant val >>= oneShot \case
         -- optimize some of the matching away.
         case uniExp `geq` uniAct of
             Just Refl -> pure x
-            Nothing   -> throwing _UnliftingEvaluationError $ typeMismatchError uniExp uniAct
+            Nothing   -> throwError $ BuiltinUnliftingEvaluationError $ typeMismatchError uniExp uniAct
 {-# INLINE readKnownConstant #-}
 
 -- | A non-empty spine. Isomorphic to 'NonEmpty', except is strict and is defined as a single
@@ -363,9 +363,9 @@ makeKnownOrFail x = case makeKnown x of
 
 -- | Same as 'readKnown', but the cause of a potential failure is the provided term itself.
 readKnownSelf
-    :: (ReadKnown val a, AsUnliftingEvaluationError err, AsEvaluationFailure err)
-    => val -> Either (ErrorWithCause err val) a
-readKnownSelf val = fromRightM (throwBuiltinErrorWithCause val) $ readKnown val
+    :: (ReadKnown val a, BuiltinErrorToEvaluationError structural operational)
+    => val -> Either (ErrorWithCause (EvaluationError structural operational) val) a
+readKnownSelf val = fromRightM (flip throwErrorWithCause val . builtinErrorToEvaluationError) $ readKnown val
 {-# INLINE readKnownSelf #-}
 
 instance MakeKnownIn uni val a => MakeKnownIn uni val (BuiltinResult a) where
@@ -382,21 +382,21 @@ instance
         ( TypeError ('Text "‘BuiltinResult’ cannot appear in the type of an argument")
         , uni ~ UniOf val
         ) => ReadKnownIn uni val (BuiltinResult a) where
-    readKnown _ = throwUnderTypeError
+    readKnown _ = throwError underTypeError
     {-# INLINE readKnown #-}
 
 instance
         ( TypeError ('Text "Use ‘BuiltinResult’ instead of ‘EvaluationResult’")
         , uni ~ UniOf val
         ) => MakeKnownIn uni val (EvaluationResult a) where
-    makeKnown _ = throwUnderTypeError
+    makeKnown _ = throwError underTypeError
     {-# INLINE makeKnown #-}
 
 instance
         ( TypeError ('Text "Use ‘BuiltinResult’ instead of ‘EvaluationResult’")
         , uni ~ UniOf val
         ) => ReadKnownIn uni val (EvaluationResult a) where
-    readKnown _ = throwUnderTypeError
+    readKnown _ = throwError underTypeError
     {-# INLINE readKnown #-}
 
 instance HasConstantIn uni val => MakeKnownIn uni val (SomeConstant uni rep) where