Put 'EvaluationError' inside of 'UnliftingError'

plutus-core/plutus-core.cabal

@@ -116,6 +116,7 @@ library
     PlutusCore.Default
     PlutusCore.Default.Builtins
     PlutusCore.Error
+    PlutusCore.Evaluation.Error
     PlutusCore.Evaluation.ErrorWithCause
     PlutusCore.Evaluation.Machine.BuiltinCostModel
     PlutusCore.Evaluation.Machine.Ck

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

@@ -255,7 +255,7 @@ typeMismatchError
     => uni (Esc a)
     -> uni (Esc b)
     -> UnliftingError
-typeMismatchError uniExp uniAct = fromString $ concat
+typeMismatchError uniExp uniAct = MkUnliftingError . StructuralEvaluationError . fromString $ concat
     [ "Type mismatch: "
     , "expected: " ++ render (prettyBy botRenderContext $ SomeTypeIn uniExp)
     , "; actual: " ++ render (prettyBy botRenderContext $ SomeTypeIn uniAct)
@@ -335,9 +335,7 @@ 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
-       , AsUnliftingError err, AsEvaluationFailure err
-       )
+    :: (ReadKnown val a, AsUnliftingError err, AsEvaluationFailure err)
     => val -> Either (ErrorWithCause err val) a
 readKnownSelf val = fromRightM (throwBuiltinErrorWithCause val) $ readKnown val
 {-# INLINE readKnownSelf #-}
@@ -361,7 +359,8 @@ instance
         ( TypeError ('Text "‘EvaluationResult’ cannot appear in the type of an argument")
         , uni ~ UniOf val
         ) => ReadKnownIn uni val (EvaluationResult a) where
-    readKnown _ = throwing _UnliftingError "Panic: 'TypeError' was bypassed"
+    readKnown _ =
+        throwing (_UnliftingError . _StructuralEvaluationError) "Panic: 'TypeError' was bypassed"
     -- Just for 'readKnown' not to appear in the generated Core.
     {-# INLINE readKnown #-}
 
@@ -374,7 +373,8 @@ instance
         ( TypeError ('Text "‘Emitter’ cannot appear in the type of an argument")
         , uni ~ UniOf val
         ) => ReadKnownIn uni val (Emitter a) where
-    readKnown _ = throwing _UnliftingError "Panic: 'TypeError' was bypassed"
+    readKnown _ =
+        throwing (_UnliftingError . _StructuralEvaluationError) "Panic: 'TypeError' was bypassed"
     -- Just for 'readKnown' not to appear in the generated Core.
     {-# INLINE readKnown #-}
 

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

@@ -6,7 +6,9 @@
 {-# LANGUAGE TemplateHaskell        #-}
 
 module PlutusCore.Builtin.Result
-    ( UnliftingError (..)
+    ( EvaluationError (..)
+    , AsEvaluationError (..)
+    , UnliftingError (..)
     , BuiltinError (..)
     , BuiltinResult (..)
     , AsUnliftingError (..)
@@ -21,21 +23,21 @@ module PlutusCore.Builtin.Result
 import PlutusPrelude
 
 import PlutusCore.Builtin.Emitter
+import PlutusCore.Evaluation.Error
 import PlutusCore.Evaluation.Result
 
 import Control.Lens
 import Control.Monad.Error.Lens (throwing, throwing_)
 import Control.Monad.Except
 import Data.DList (DList)
-import Data.String (IsString)
 import Data.Text (Text)
 import Prettyprinter
 
 -- | When unlifting of a PLC term into a Haskell value fails, this error is thrown.
 newtype UnliftingError = MkUnliftingError
-    { unUnliftingError :: Text
+    { unUnliftingError :: EvaluationError Text Text
     } deriving stock (Show, Eq)
-      deriving newtype (IsString, Semigroup, NFData)
+      deriving newtype (NFData)
 
 -- | The type of errors that 'readKnown' and 'makeKnown' can return.
 data BuiltinError
@@ -69,6 +71,13 @@ mtraverse makeClassyPrisms
     , ''BuiltinResult
     ]
 
+instance AsEvaluationError UnliftingError Text Text where
+    _EvaluationError = _UnliftingError . _EvaluationError
+
+instance (AsUnliftingError operational, AsUnliftingError structural) =>
+        AsUnliftingError (EvaluationError operational structural) where
+    _UnliftingError = undefined -- prism' (_ . unUnliftingError) _
+
 instance AsUnliftingError BuiltinError where
     _UnliftingError = _BuiltinUnliftingError
     {-# INLINE _UnliftingError #-}
@@ -107,7 +116,9 @@ instance Pretty BuiltinError where
     pretty BuiltinEvaluationFailure    = "Builtin evaluation failure"
 
 throwNotAConstant :: MonadError BuiltinError m => m void
-throwNotAConstant = throwError $ BuiltinUnliftingError "Not a constant"
+throwNotAConstant =
+    throwError . BuiltinUnliftingError . MkUnliftingError $
+        StructuralEvaluationError "Not a constant"
 {-# INLINE throwNotAConstant #-}
 
 -- | Prepend logs to a 'BuiltinResult' computation.

plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs

@@ -385,7 +385,7 @@ instance (HasConstantIn DefaultUni term, Integral a, Bounded a, Typeable a) =>
             -- TODO: benchmark an alternative `integerToIntMaybe`, modified from 'ghc-bignum'
             if fromIntegral (minBound :: a) <= i && i <= fromIntegral (maxBound :: a)
                 then pure . AsInteger $ fromIntegral i
-                else throwing _UnliftingError . MkUnliftingError $ fold
+                else throwing (_UnliftingError . _OperationalEvaluationError) $ fold
                         [ Text.pack $ show i
                         , " is not within the bounds of "
                         , Text.pack . show . typeRep $ Proxy @a

plutus-core/plutus-core/src/PlutusCore/Evaluation/Error.hs

@@ -0,0 +1,74 @@
+-- editorconfig-checker-disable-file
+-- | The exceptions that an abstract machine can throw.
+
+-- appears in the generated instances
+{-# OPTIONS_GHC -Wno-overlapping-patterns #-}
+
+{-# LANGUAGE DataKinds              #-}
+{-# LANGUAGE DeriveAnyClass         #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE OverloadedStrings      #-}
+{-# LANGUAGE TemplateHaskell        #-}
+{-# LANGUAGE TypeFamilies           #-}
+{-# LANGUAGE TypeOperators          #-}
+{-# LANGUAGE UndecidableInstances   #-}
+
+module PlutusCore.Evaluation.Error
+    ( EvaluationError (..)
+    , AsEvaluationError (..)
+    ) where
+
+import PlutusPrelude
+
+import PlutusCore.Evaluation.Result
+
+import Control.Lens
+
+{- | The type of errors that can occur during evaluation. There are two kinds of errors:
+
+1. Operational ones -- these are errors that are indicative of the _logic_ of the program being
+   wrong. For example, 'Error' was executed, 'tailList' was applied to an empty list or evaluation
+   ran out of gas.
+2. Structural ones -- these are errors that are indicative of the _structure_ of the program being
+   wrong. For example, a free variable was encountered during evaluation, or a non-function was
+   applied to an argument.
+
+On the chain both of these are just regular failures and we don't distinguish between them there:
+if a script fails, it fails, it doesn't matter what the reason was. However in the tests it does
+matter why the failure occurred: a structural error may indicate that the test was written
+incorrectly while an operational error may be entirely expected.
+
+In other words, operational errors are regular runtime errors and structural errors are \"runtime
+type errors\". Which means that evaluating an (erased) well-typed program should never produce a
+structural error, only an operational one. This creates a sort of \"runtime type system\" for UPLC
+and it would be great to stick to it and enforce in tests etc, but we currently don't. For example,
+a built-in function expecting a list but getting something else should throw a structural error,
+but currently it'll throw an operational one. This is something that we plan to improve upon in
+future.
+-}
+data EvaluationError operational structural
+    = OperationalEvaluationError !operational
+    | StructuralEvaluationError !structural
+    deriving stock (Show, Eq, Functor, Generic)
+    deriving anyclass (NFData)
+
+mtraverse makeClassyPrisms
+    [ ''EvaluationError
+    ]
+
+instance AsEvaluationFailure operational =>
+        AsEvaluationFailure (EvaluationError operational structural) where
+    _EvaluationFailure = _OperationalEvaluationError . _EvaluationFailure
+
+instance
+        ( HasPrettyDefaults config ~ 'True
+        , Pretty operational, PrettyBy config structural
+        ) => PrettyBy config (EvaluationError operational structural) where
+    prettyBy _      (OperationalEvaluationError operational) = pretty operational
+    prettyBy config (StructuralEvaluationError structural)   = prettyBy config structural
+
+instance (Pretty operational, Pretty structural) =>
+        Pretty (EvaluationError operational structural) where
+    pretty (OperationalEvaluationError operational) = pretty operational
+    pretty (StructuralEvaluationError structural)   = pretty structural

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

@@ -35,6 +35,7 @@ module PlutusCore.Evaluation.Machine.Exception
 import PlutusPrelude
 
 import PlutusCore.Builtin.Result
+import PlutusCore.Evaluation.Error
 import PlutusCore.Evaluation.ErrorWithCause
 import PlutusCore.Evaluation.Result
 import PlutusCore.Pretty
@@ -65,50 +66,15 @@ data MachineError fun
     deriving stock (Show, Eq, Functor, Generic)
     deriving anyclass (NFData)
 
-{- | The type of errors that can occur during evaluation. There are two kinds of errors:
-
-1. Operational ones -- these are errors that are indicative of the _logic_ of the program being
-   wrong. For example, 'Error' was executed, 'tailList' was applied to an empty list or evaluation
-   ran out of gas.
-2. Structural ones -- these are errors that are indicative of the _structure_ of the program being
-   wrong. For example, a free variable was encountered during evaluation, or a non-function was
-   applied to an argument.
-
-On the chain both of these are just regular failures and we don't distinguish between them there:
-if a script fails, it fails, it doesn't matter what the reason was. However in the tests it does
-matter why the failure occurred: a structural error may indicate that the test was written
-incorrectly while an operational error may be entirely expected.
-
-In other words, operational errors are regular runtime errors and structural errors are \"runtime
-type errors\". Which means that evaluating an (erased) well-typed program should never produce a
-structural error, only an operational one. This creates a sort of \"runtime type system\" for UPLC
-and it would be great to stick to it and enforce in tests etc, but we currently don't. For example,
-a built-in function expecting a list but getting something else should throw a structural error,
-but currently it'll throw an operational one. This is something that we plan to improve upon in
-future.
--}
-data EvaluationError operational structural
-    = OperationalEvaluationError !operational
-    | StructuralEvaluationError !structural
-    deriving stock (Show, Eq, Functor, Generic)
-    deriving anyclass (NFData)
-
 mtraverse makeClassyPrisms
     [ ''MachineError
-    , ''EvaluationError
     ]
 
 instance structural ~ MachineError fun =>
         AsMachineError (EvaluationError operational structural) fun where
     _MachineError = _StructuralEvaluationError
-instance AsUnliftingError structural =>
-        AsUnliftingError (EvaluationError operational structural) where
-    _UnliftingError = _StructuralEvaluationError . _UnliftingError
 instance AsUnliftingError (MachineError fun) where
     _UnliftingError = _UnliftingMachineError
-instance AsEvaluationFailure operational =>
-        AsEvaluationFailure (EvaluationError operational structural) where
-    _EvaluationFailure = _OperationalEvaluationError . _EvaluationFailure
 
 type EvaluationException operational structural =
     ErrorWithCause (EvaluationError operational structural)
@@ -163,10 +129,3 @@ instance (HasPrettyDefaults config ~ 'True, Pretty fun) =>
         "A non-constructor value was scrutinized in a case expression"
     prettyBy _      (MissingCaseBranch i) =
         "Case expression missing the branch required by the scrutinee tag:" <+> pretty i
-
-instance
-        ( HasPrettyDefaults config ~ 'True
-        , Pretty operational, PrettyBy config structural
-        ) => PrettyBy config (EvaluationError operational structural) where
-    prettyBy _      (OperationalEvaluationError operational) = pretty operational
-    prettyBy config (StructuralEvaluationError structural)   = prettyBy config structural