'HasConstant' as a worker class

IntersectMBO · Feb 19, 2022 · 41a1f8d · 41a1f8d
1 parent b1d0467
commit 41a1f8d
Show file tree

Hide file tree

Showing 6 changed files with 16 additions and 12 deletions.
diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/HasConstant.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/HasConstant.hs
@@ -6,7 +6,8 @@
 
 module PlutusCore.Builtin.HasConstant
     ( throwNotAConstant
-    , HasConstantIn (..)
+    , HasConstant (..)
+    , HasConstantIn
     ) where
 
 import PlutusCore.Core
@@ -22,20 +23,23 @@ throwNotAConstant
     => Maybe cause -> m r
 throwNotAConstant = throwingWithCause _UnliftingError "Not a constant"
 
--- | Ensures that @term@ has a 'Constant'-like constructor to lift values to and unlift values from
--- and connects @term@ and its @uni@.
-class uni ~ UniOf term => HasConstantIn uni term where
+-- | Ensures that @term@ has a 'Constant'-like constructor to lift values to and unlift values from.
+class HasConstant term where
     -- Switching from 'MonadError' to 'Either' here gave us a speedup of 2-4%.
     -- | Unlift from the 'Constant' constructor throwing an 'UnliftingError' if the provided @term@
     -- is not a 'Constant'.
     asConstant
         :: AsUnliftingError err
-        => Maybe cause -> term -> Either (ErrorWithCause err cause) (Some (ValueOf uni))
+        => Maybe cause -> term -> Either (ErrorWithCause err cause) (Some (ValueOf (UniOf term)))
 
     -- | Wrap a Haskell value as a @term@.
     fromConstant :: Some (ValueOf (UniOf term)) -> term
 
-instance HasConstantIn uni (Term TyName Name uni fun ()) where
+-- | Ensures that @term@ has a 'Constant'-like constructor to lift values to and unlift values from
+-- and connects @term@ and its @uni@.
+type HasConstantIn uni term = (UniOf term ~ uni, HasConstant term)
+
+instance HasConstant (Term TyName Name uni fun ()) where
     asConstant _        (Constant _ val) = pure val
     asConstant mayCause _                = throwNotAConstant mayCause
 

diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/Polymorphism.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/Polymorphism.hs
@@ -54,7 +54,7 @@ We need to support polymorphism for built-in functions for these reasons:
 -- Haskell and back and instead can keep it intact.
 newtype Opaque val (rep :: GHC.Type) = Opaque
     { unOpaque :: val
-    } deriving newtype (Pretty, HasConstantIn uni)
+    } deriving newtype (Pretty, HasConstant)
 
 type instance UniOf (Opaque val rep) = UniOf val
 

diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Ck.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/Ck.hs
@@ -117,7 +117,7 @@ emitCkM str = do
 
 type instance UniOf (CkValue uni fun) = uni
 
-instance HasConstantIn uni (CkValue uni fun) where
+instance HasConstant (CkValue uni fun) where
     asConstant _        (VCon val) = pure val
     asConstant mayCause _          = throwNotAConstant mayCause
 

diff --git a/plutus-core/plutus-ir/src/PlutusIR/Core/Type.hs b/plutus-core/plutus-ir/src/PlutusIR/Core/Type.hs
@@ -30,7 +30,7 @@ import PlutusPrelude
 import Control.Lens.TH
 import PlutusCore (Kind, Name, TyName, Type (..))
 import PlutusCore qualified as PLC
-import PlutusCore.Builtin (HasConstantIn (..), throwNotAConstant)
+import PlutusCore.Builtin (HasConstant (..), throwNotAConstant)
 import PlutusCore.Core (UniOf)
 import PlutusCore.Flat ()
 import PlutusCore.MkPlc (Def (..), TermLike (..), TyVarDecl (..), VarDecl (..))
@@ -129,7 +129,7 @@ data Term tyname name uni fun a =
 
 type instance UniOf (Term tyname name uni fun ann) = uni
 
-instance HasConstantIn uni (Term tyname name uni fun ()) where
+instance HasConstant (Term tyname name uni fun ()) where
     asConstant _        (Constant _ val) = pure val
     asConstant mayCause _                = throwNotAConstant mayCause
 

diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs
@@ -105,7 +105,7 @@ instance TermLike (Term name uni fun) TPLC.TyName name uni fun where
     iWrap    = \_ _ _ -> id
     error    = \ann _ -> Error ann
 
-instance TPLC.HasConstantIn uni (Term name uni fun ()) where
+instance TPLC.HasConstant (Term name uni fun ()) where
     asConstant _        (Constant _ val) = pure val
     asConstant mayCause _                = TPLC.throwNotAConstant mayCause
 

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
@@ -480,7 +480,7 @@ instance (Closed uni, GShow uni, uni `Everywhere` PrettyConst, Pretty fun) =>
 
 type instance UniOf (CekValue uni fun) = uni
 
-instance HasConstantIn uni (CekValue uni fun) where
+instance HasConstant (CekValue uni fun) where
     asConstant _        (VCon val) = pure val
     asConstant mayCause _          = throwNotAConstant mayCause