Make it work

IntersectMBO · May 27, 2024 · 5a639ab · 5a639ab
1 parent 8d136bb
commit 5a639ab
Show file tree

Hide file tree

Showing 4 changed files with 11 additions and 1 deletion.
diff --git a/plutus-core/plutus-core/examples/PlutusCore/Examples/Builtins.hs b/plutus-core/plutus-core/examples/PlutusCore/Examples/Builtins.hs
@@ -197,7 +197,10 @@ 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 _UnliftingError "Can't unlift to 'Void'"
+    readKnown _ =
+        throwing
+            (_BuiltinUnliftingEvaluationError . _StructuralEvaluationError)
+            "Can't unlift to 'Void'"
 
 data BuiltinErrorCall = BuiltinErrorCall
     deriving stock (Show, Eq)

diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/Result.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/Result.hs
@@ -85,6 +85,7 @@ instance Wrapped UnliftingError
 
 instance AsEvaluationError UnliftingEvaluationError UnliftingError UnliftingError where
     _EvaluationError = _UnliftingEvaluationError . _EvaluationError
+    {-# INLINE _EvaluationError #-}
 
 instance (AsUnliftingError operational, AsUnliftingError structural) =>
         AsUnliftingEvaluationError (EvaluationError operational structural) where

diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Exception.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Exception.hs
@@ -72,6 +72,8 @@ mtraverse makeClassyPrisms
 instance structural ~ MachineError fun =>
         AsMachineError (EvaluationError operational structural) fun where
     _MachineError = _StructuralEvaluationError
+
+-- TODO: state the assumption, rename 'MachineError'
 instance AsUnliftingError (MachineError fun) where
     __UnliftingError = _UnliftingMachineError
 

diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs
@@ -86,6 +86,7 @@ import UntypedPlutusCore.Evaluation.Machine.Cek.CekMachineCosts (CekMachineCosts
                                                                  CekMachineCostsBase (..))
 import UntypedPlutusCore.Evaluation.Machine.Cek.StepCounter
 
+import Control.Lens (iso)
 import Control.Lens.Review
 import Control.Monad (unless, when)
 import Control.Monad.Catch
@@ -405,6 +406,9 @@ data CekUserError
     deriving stock (Show, Eq, Generic)
     deriving anyclass (NFData)
 
+instance AsUnliftingError CekUserError where
+    __UnliftingError = iso (UnliftingError . display) (const CekEvaluationFailure)
+
 type CekM :: (GHC.Type -> GHC.Type) -> GHC.Type -> GHC.Type -> GHC.Type -> GHC.Type
 -- | The monad the CEK machine runs in.
 newtype CekM uni fun s a = CekM