{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module PlutusCore.Builtin.Polymorphism
( Opaque (..)
, SomeConstant (..)
, TyNameRep (..)
, TyVarRep
, TyAppRep
, TyForallRep
, BuiltinHead
, LastArg
, ElaborateBuiltin
, AllElaboratedArgs
, AllBuiltinArgs
) where
import PlutusPrelude
import PlutusCore.Builtin.HasConstant
import PlutusCore.Core
import PlutusCore.Evaluation.Machine.ExMemoryUsage
import Data.Kind qualified as GHC
import GHC.Ix
import GHC.TypeLits
import Universe
newtype Opaque val (rep :: GHC.Type) = Opaque
{ forall val rep. Opaque val rep -> val
unOpaque :: val
} deriving newtype (Some (ValueOf (UniOf (Opaque val rep))) -> Opaque val rep
Opaque val rep
-> Either BuiltinError (Some (ValueOf (UniOf (Opaque val rep))))
(Opaque val rep
-> Either BuiltinError (Some (ValueOf (UniOf (Opaque val rep)))))
-> (Some (ValueOf (UniOf (Opaque val rep))) -> Opaque val rep)
-> HasConstant (Opaque val rep)
forall term.
(term -> Either BuiltinError (Some (ValueOf (UniOf term))))
-> (Some (ValueOf (UniOf term)) -> term) -> HasConstant term
forall val rep.
HasConstant val =>
Some (ValueOf (UniOf (Opaque val rep))) -> Opaque val rep
forall val rep.
HasConstant val =>
Opaque val rep
-> Either BuiltinError (Some (ValueOf (UniOf (Opaque val rep))))
$casConstant :: forall val rep.
HasConstant val =>
Opaque val rep
-> Either BuiltinError (Some (ValueOf (UniOf (Opaque val rep))))
asConstant :: Opaque val rep
-> Either BuiltinError (Some (ValueOf (UniOf (Opaque val rep))))
$cfromConstant :: forall val rep.
HasConstant val =>
Some (ValueOf (UniOf (Opaque val rep))) -> Opaque val rep
fromConstant :: Some (ValueOf (UniOf (Opaque val rep))) -> Opaque val rep
HasConstant, Opaque val rep -> CostRose
(Opaque val rep -> CostRose) -> ExMemoryUsage (Opaque val rep)
forall a. (a -> CostRose) -> ExMemoryUsage a
forall val rep. ExMemoryUsage val => Opaque val rep -> CostRose
$cmemoryUsage :: forall val rep. ExMemoryUsage val => Opaque val rep -> CostRose
memoryUsage :: Opaque val rep -> CostRose
ExMemoryUsage)
type instance UniOf (Opaque val rep) = UniOf val
newtype SomeConstant uni (rep :: GHC.Type) = SomeConstant
{ forall (uni :: * -> *) rep.
SomeConstant uni rep -> Some (ValueOf uni)
unSomeConstant :: Some (ValueOf uni)
}
deriving newtype instance (Everywhere uni ExMemoryUsage, Closed uni)
=> ExMemoryUsage (SomeConstant uni rep)
type instance UniOf (SomeConstant uni rep) = uni
instance HasConstant (SomeConstant uni rep) where
asConstant :: SomeConstant uni rep
-> Either
BuiltinError (Some (ValueOf (UniOf (SomeConstant uni rep))))
asConstant = (Some (ValueOf uni) -> Either BuiltinError (Some (ValueOf uni)))
-> SomeConstant uni rep -> Either BuiltinError (Some (ValueOf uni))
forall a b s. Coercible a b => (a -> s) -> b -> s
coerceArg Some (ValueOf uni) -> Either BuiltinError (Some (ValueOf uni))
forall a. a -> Either BuiltinError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE asConstant #-}
fromConstant :: Some (ValueOf (UniOf (SomeConstant uni rep)))
-> SomeConstant uni rep
fromConstant = Some (ValueOf uni) -> SomeConstant uni rep
Some (ValueOf (UniOf (SomeConstant uni rep)))
-> SomeConstant uni rep
forall a b. Coercible a b => a -> b
coerce
{-# INLINE fromConstant #-}
data TyNameRep (kind :: GHC.Type) = TyNameRep Symbol Nat
data family TyVarRep (name :: TyNameRep kind) :: kind
data family TyAppRep (fun :: dom -> cod) (arg :: dom) :: cod
data family TyForallRep (name :: TyNameRep kind) (a :: GHC.Type) :: GHC.Type
type BuiltinHead :: forall a. a -> a
data family BuiltinHead x
type LastArg :: GHC.Type -> GHC.Type -> GHC.Type
data family LastArg x y
type ElaborateBuiltin :: forall a. (GHC.Type -> GHC.Type) -> a -> a
type family ElaborateBuiltin uni x
type AllElaboratedArgs :: forall a. (GHC.Type -> GHC.Constraint) -> a -> GHC.Constraint
type family AllElaboratedArgs constr x where
AllElaboratedArgs constr (f `TyAppRep` x) = (constr x, AllElaboratedArgs constr f)
AllElaboratedArgs _ (BuiltinHead _) = ()
type AllBuiltinArgs
:: forall a. (GHC.Type -> GHC.Type) -> (GHC.Type -> GHC.Constraint) -> a -> GHC.Constraint
class AllElaboratedArgs constr (ElaborateBuiltin uni x) => AllBuiltinArgs uni constr x
instance AllElaboratedArgs constr (ElaborateBuiltin uni x) => AllBuiltinArgs uni constr x
underTypeError :: void
underTypeError :: forall void. void
underTypeError = [Char] -> void
forall a. HasCallStack => [Char] -> a
error [Char]
"Panic: a 'TypeError' was bypassed"
type NoStandalonePolymorphicDataErrMsg =
'Text "An unwrapped built-in type constructor can't be applied to a type variable" ':$$:
'Text "Are you trying to define a polymorphic built-in function over a polymorphic type?" ':$$:
'Text "In that case you need to wrap all polymorphic built-in types applied to type" ':$$:
'Text " variables with either ‘SomeConstant’ or ‘Opaque’ depending on whether its the" ':$$:
'Text " type of an argument or the type of the result, respectively"
instance TypeError NoStandalonePolymorphicDataErrMsg => uni `Contains` TyVarRep where
knownUni :: uni (Esc TyVarRep)
knownUni = uni (Esc TyVarRep)
forall void. void
underTypeError
type NoConstraintsErrMsg =
'Text "Built-in functions are not allowed to have constraints" ':$$:
'Text "To fix this error instantiate all constrained type variables"
instance TypeError NoConstraintsErrMsg => Eq (Opaque val rep) where
== :: Opaque val rep -> Opaque val rep -> Bool
(==) = Opaque val rep -> Opaque val rep -> Bool
forall void. void
underTypeError
instance TypeError NoConstraintsErrMsg => Ord (Opaque val rep) where
compare :: Opaque val rep -> Opaque val rep -> Ordering
compare = Opaque val rep -> Opaque val rep -> Ordering
forall void. void
underTypeError
instance TypeError NoConstraintsErrMsg => Num (Opaque val rep) where
+ :: Opaque val rep -> Opaque val rep -> Opaque val rep
(+) = Opaque val rep -> Opaque val rep -> Opaque val rep
forall void. void
underTypeError
* :: Opaque val rep -> Opaque val rep -> Opaque val rep
(*) = Opaque val rep -> Opaque val rep -> Opaque val rep
forall void. void
underTypeError
abs :: Opaque val rep -> Opaque val rep
abs = Opaque val rep -> Opaque val rep
forall void. void
underTypeError
signum :: Opaque val rep -> Opaque val rep
signum = Opaque val rep -> Opaque val rep
forall void. void
underTypeError
fromInteger :: Integer -> Opaque val rep
fromInteger = Integer -> Opaque val rep
forall void. void
underTypeError
negate :: Opaque val rep -> Opaque val rep
negate = Opaque val rep -> Opaque val rep
forall void. void
underTypeError
instance TypeError NoConstraintsErrMsg => Enum (Opaque val rep) where
toEnum :: Int -> Opaque val rep
toEnum = Int -> Opaque val rep
forall void. void
underTypeError
fromEnum :: Opaque val rep -> Int
fromEnum = Opaque val rep -> Int
forall void. void
underTypeError
instance TypeError NoConstraintsErrMsg => Real (Opaque val rep) where
toRational :: Opaque val rep -> Rational
toRational = Opaque val rep -> Rational
forall void. void
underTypeError
instance TypeError NoConstraintsErrMsg => Integral (Opaque val rep) where
quotRem :: Opaque val rep
-> Opaque val rep -> (Opaque val rep, Opaque val rep)
quotRem = Opaque val rep
-> Opaque val rep -> (Opaque val rep, Opaque val rep)
forall void. void
underTypeError
divMod :: Opaque val rep
-> Opaque val rep -> (Opaque val rep, Opaque val rep)
divMod = Opaque val rep
-> Opaque val rep -> (Opaque val rep, Opaque val rep)
forall void. void
underTypeError
toInteger :: Opaque val rep -> Integer
toInteger = Opaque val rep -> Integer
forall void. void
underTypeError
instance TypeError NoConstraintsErrMsg => Bounded (Opaque val rep) where
minBound :: Opaque val rep
minBound = Opaque val rep
forall void. void
underTypeError
maxBound :: Opaque val rep
maxBound = Opaque val rep
forall void. void
underTypeError
instance TypeError NoConstraintsErrMsg => Ix (Opaque val rep) where
range :: (Opaque val rep, Opaque val rep) -> [Opaque val rep]
range = (Opaque val rep, Opaque val rep) -> [Opaque val rep]
forall void. void
underTypeError
index :: (Opaque val rep, Opaque val rep) -> Opaque val rep -> Int
index = (Opaque val rep, Opaque val rep) -> Opaque val rep -> Int
forall void. void
underTypeError
inRange :: (Opaque val rep, Opaque val rep) -> Opaque val rep -> Bool
inRange = (Opaque val rep, Opaque val rep) -> Opaque val rep -> Bool
forall void. void
underTypeError
instance TypeError NoConstraintsErrMsg => Semigroup (Opaque val rep) where
<> :: Opaque val rep -> Opaque val rep -> Opaque val rep
(<>) = Opaque val rep -> Opaque val rep -> Opaque val rep
forall void. void
underTypeError
instance TypeError NoConstraintsErrMsg => Monoid (Opaque val rep) where
mempty :: Opaque val rep
mempty = Opaque val rep
forall void. void
underTypeError