Removed ‘Visibility’ and the associated machinery
File Changes
Language.PlutusCore.Generators.Interesting
Language.PlutusCore.Generators.Test
Language.PlutusCore.Lexer
-
-- Language.PlutusCore.Parser
+
Language.PlutusCore.Parser
PlutusPrelude
Control.Monad.Trans.Inner
Common
module Language.PlutusCore
(
-- * Parser
-
parse
-
, parseST
-
, parseTermST
-
, parseTypeST
-
, parseScoped
-
, parseProgram
+
-- parse
+
-- , parseST
+
-- , parseTermST
+
-- , parseTypeST
+
-- , parseScoped
+
parseProgram
, parseTerm
, parseType
-- * AST
-- | Convert a PLC constant (unwrapped from 'Value') into the corresponding Haskell value.
-- Checks that the constant is of a given built-in type.
extractBuiltin
-
:: forall m uni a. (Monad m, InternalKnownType a uni)
+
:: forall m uni a. (Monad m, KnownType a uni)
=> Value TyName Name uni () -> EvaluateConstApp uni m a
extractBuiltin value =
thoist (InnerT . fmap nat . runReflectT) $ readKnownM value where
-- | A dynamic built-in name that allows to call arbitrary 'IO' actions over
-- PLC values of a built-in types (including dynamic built-in types).
+
{-# LANGUAGE DataKinds #-}
+
module Language.PlutusCore.Constant.Dynamic.Call
( dynamicCallTypeScheme
, dynamicCallAssign
import Data.Proxy
import System.IO.Unsafe
-
dynamicCallTypeScheme :: (KnownType a uni, Evaluable uni) => TypeScheme uni (a -> ()) ()
+
dynamicCallTypeScheme :: (KnownType a uni, Evaluable uni) => TypeScheme uni '[a] ()
dynamicCallTypeScheme = Proxy `TypeSchemeArrow` TypeSchemeResult Proxy
dynamicCallAssign
:: (KnownType a uni, Evaluable uni)
=> DynamicBuiltinName
-> (a -> IO ())
-
-> DynamicBuiltinNameDefinition uni
+
-> NameDefinition uni
dynamicCallAssign name f =
-
DynamicBuiltinNameDefinition name $
-
DynamicBuiltinNameMeaning dynamicCallTypeScheme (unsafePerformIO . f)
+
NameDefinition name $
+
NameMeaning dynamicCallTypeScheme (unsafePerformIO . f)
dynamicCall :: DynamicBuiltinName -> Term tyname name uni ()
dynamicCall = dynamicBuiltinNameAsTerm
prettyKnown = undefined
instance KnownType a uni => KnownType (EvaluationResult a) uni where
-
type VisibilityOf (EvaluationResult a) = VisibilityOf a
-
toTypeAst _ = toTypeAst @a Proxy
makeKnown EvaluationFailure = Error () $ toTypeAst @a Proxy
pretty = pretty . unShallow
instance (Evaluable uni, uni `Includes` a, PrettyKnown a) => KnownType (Shallow a) uni where
-
type VisibilityOf (Shallow a) = 'Internal
-
toTypeAst _ = constantType @a Proxy ()
makeKnown (Shallow x) = constantTerm () x
instance PrettyKnown a => PrettyKnown (Shallow a) where
prettyKnown = prettyKnown . unShallow
-
newtype Deep a = Deep
-
{ unDeep :: a
-
} deriving (Show, Generic, Typeable)
-
-
instance Pretty a => Pretty (Deep a) where
-
pretty = pretty . unDeep
-
-
instance ExternalKnownType a uni => KnownType (Deep a) uni where
-
type VisibilityOf (Deep a) = 'Internal
-
toTypeAst = undefined -- toTypeAst
-
makeKnown = makeKnown . unDeep
-
readKnown eval = fmap Deep . readKnown eval
-
instance PrettyKnown a => PrettyKnown (Deep a) where
-
prettyKnown = prettyKnown . unDeep
-
instance Evaluable uni => KnownType Bool uni where
toTypeAst _ = bool
instance (Evaluable uni, euni ~ Extend a uni, Typeable a, Pretty a) =>
KnownType (AsExtension uni a) euni where
-
type VisibilityOf (AsExtension uni a) = 'Internal
-
toTypeAst _ = extensionType ()
makeKnown = extensionTerm () . unAsExtension
-- make is just one @[email protected] by induction on the list type argument.
oneArg
-
:: (InternalKnownType a uni, InternalKnownType b uni)
+
:: (KnownType a uni, KnownType b uni)
=> TypeScheme uni '[a] b
oneArg =
Proxy `TypeSchemeArrow` TypeSchemeResult Proxy
twoArgs
-
:: (InternalKnownType a uni, InternalKnownType b uni, InternalKnownType c uni)
+
:: (KnownType a uni, KnownType b uni, KnownType c uni)
=> TypeScheme uni '[a, b] c
twoArgs =
Proxy `TypeSchemeArrow` Proxy `TypeSchemeArrow` TypeSchemeResult Proxy
threeArgs
-
:: (InternalKnownType a uni, InternalKnownType b uni, InternalKnownType c uni, InternalKnownType d uni)
+
:: (KnownType a uni, KnownType b uni, KnownType c uni, KnownType d uni)
=> TypeScheme uni '[a, b, c] d
threeArgs =
Proxy `TypeSchemeArrow` Proxy `TypeSchemeArrow` Proxy `TypeSchemeArrow` TypeSchemeResult Proxy
-- | Typed 'LessThanInteger'.
typedLessThanInteger
-
:: Evaluable uni => TypedBuiltinName uni '[Shallow Integer, Shallow Integer] (Deep Bool)
+
:: Evaluable uni => TypedBuiltinName uni '[Shallow Integer, Shallow Integer] Bool
typedLessThanInteger = TypedBuiltinName LessThanInteger twoArgs
-- | Typed 'LessThanEqInteger'.
typedLessThanEqInteger
-
:: Evaluable uni => TypedBuiltinName uni '[Shallow Integer, Shallow Integer] (Deep Bool)
+
:: Evaluable uni => TypedBuiltinName uni '[Shallow Integer, Shallow Integer] Bool
typedLessThanEqInteger = TypedBuiltinName LessThanEqInteger twoArgs
-- | Typed 'GreaterThanInteger'.
typedGreaterThanInteger
-
:: Evaluable uni => TypedBuiltinName uni '[Shallow Integer, Shallow Integer] (Deep Bool)
+
:: Evaluable uni => TypedBuiltinName uni '[Shallow Integer, Shallow Integer] Bool
typedGreaterThanInteger = TypedBuiltinName GreaterThanInteger twoArgs
-- | Typed 'GreaterThanEqInteger'.
typedGreaterThanEqInteger
-
:: Evaluable uni => TypedBuiltinName uni '[Shallow Integer, Shallow Integer] (Deep Bool)
+
:: Evaluable uni => TypedBuiltinName uni '[Shallow Integer, Shallow Integer] Bool
typedGreaterThanEqInteger = TypedBuiltinName GreaterThanEqInteger twoArgs
-- | Typed 'EqInteger'.
typedEqInteger
-
:: Evaluable uni => TypedBuiltinName uni '[Shallow Integer, Shallow Integer] (Deep Bool)
+
:: Evaluable uni => TypedBuiltinName uni '[Shallow Integer, Shallow Integer] Bool
typedEqInteger = TypedBuiltinName EqInteger twoArgs
-- | Typed 'Concatenate'.
-- | Typed 'VerifySignature'.
typedVerifySignature
-
:: Evaluable uni => TypedBuiltinName uni '[Shallow BSL.ByteString, Shallow BSL.ByteString, Shallow BSL.ByteString] (EvaluationResult (Deep Bool))
+
:: Evaluable uni => TypedBuiltinName uni '[Shallow BSL.ByteString, Shallow BSL.ByteString, Shallow BSL.ByteString] (EvaluationResult Bool)
typedVerifySignature = TypedBuiltinName VerifySignature threeArgs
-- | Typed 'EqByteString'.
typedEqByteString
-
:: Evaluable uni => TypedBuiltinName uni '[Shallow BSL.ByteString, Shallow BSL.ByteString] (Deep Bool)
+
:: Evaluable uni => TypedBuiltinName uni '[Shallow BSL.ByteString, Shallow BSL.ByteString] Bool
typedEqByteString = TypedBuiltinName EqByteString twoArgs
-- | Typed 'LtByteString'.
typedLtByteString
-
:: Evaluable uni => TypedBuiltinName uni '[Shallow BSL.ByteString, Shallow BSL.ByteString] (Deep Bool)
+
:: Evaluable uni => TypedBuiltinName uni '[Shallow BSL.ByteString, Shallow BSL.ByteString] Bool
typedLtByteString = TypedBuiltinName LtByteString twoArgs
-- | Typed 'GtByteString'.
typedGtByteString
-
:: Evaluable uni => TypedBuiltinName uni '[Shallow BSL.ByteString, Shallow BSL.ByteString] (Deep Bool)
+
:: Evaluable uni => TypedBuiltinName uni '[Shallow BSL.ByteString, Shallow BSL.ByteString] Bool
typedGtByteString = TypedBuiltinName GtByteString twoArgs
, Evaluator (..)
, EvaluateT (..)
, ReflectT (..)
-
, Visibility (..)
, KnownType (..)
-
, InternalKnownType
-
, ExternalKnownType
, PrettyKnown (..)
, KnownTypeValue (..)
, OpaqueTerm (..)
infixr 9 `TypeSchemeArrow`
-
type InternalKnownType a uni = (KnownType a uni, VisibilityOf a ~ 'Internal)
-
type ExternalKnownType a uni = (KnownType a uni, VisibilityOf a ~ 'External)
-
-- | Type schemes of primitive operations.
-- @[email protected] is the Haskell denotation of a PLC type represented as a 'TypeScheme'.
-- @[email protected] is the resulting type in @[email protected], e.g. the resulting type in
-- @ByteString -> Size -> [email protected] is @[email protected]
data TypeScheme uni as r where
TypeSchemeResult
-
:: InternalKnownType a uni => Proxy a -> TypeScheme uni '[] a
+
:: KnownType a uni => Proxy a -> TypeScheme uni '[] a
TypeSchemeArrow
-
:: InternalKnownType a uni => Proxy a -> TypeScheme uni as r -> TypeScheme uni (a ': as) r
+
:: KnownType a uni => Proxy a -> TypeScheme uni as r -> TypeScheme uni (a ': as) r
TypeSchemeAllType
:: (KnownSymbol text, KnownNat uniq)
-- Here we require the user to manually provide the unique of a type variable.
makeRightReflectT :: Monad m => m (EvaluationResult a) -> ReflectT m a
makeRightReflectT = ReflectT . lift . InnerT
-
data Visibility
-
= Internal
-
| External
-
-- See Note [Semantics of dynamic built-in types].
-- See Note [Converting PLC values to Haskell values].
-- | Haskell types known to exist on the PLC side.
class PrettyKnown a => KnownType a uni where
-
type VisibilityOf a :: Visibility
-
type VisibilityOf a = 'External
-
-- | The type representing @[email protected] used on the PLC side.
toTypeAst :: proxy a -> Type TyName uni ()
-- A type known in a universe is known in an extended version of that universe.
instance (Evaluable uni, KnownType a uni, euni ~ Extend b uni, Typeable b) =>
KnownType (InExtended b uni a) euni where
-
type VisibilityOf (InExtended b uni a) = 'Internal
-
toTypeAst _ = shiftConstantsType $ toTypeAst @a Proxy
makeKnown (InExtended x) = shiftConstantsTerm $ makeKnown @a x
instance (Evaluable uni, KnownType a euni, euni ~ Extend b uni, Typeable b) =>
KnownType (InUnextended euni a) uni where
-
type VisibilityOf (InUnextended euni a) = 'Internal
-
toTypeAst _ = unshiftConstantsType $ toTypeAst @a @euni Proxy
makeKnown (InUnextended x) = unshiftConstantsTerm $ makeKnown @a @euni x
-
{-# LANGUAGE TypeApplications #-}
+
{-# LANGUAGE DerivingVia #-}
+
{-# LANGUAGE FlexibleInstances #-}
+
{-# LANGUAGE Rank2Types #-}
+
{-# LANGUAGE RankNTypes #-}
+
{-# LANGUAGE TypeApplications #-}
+
{-# LANGUAGE UndecidableInstances #-}
-- | The CK machine.
-
{-# LANGUAGE OverloadedStrings #-}
+
{-# LANGUAGE OverloadedStrings #-}
module Language.PlutusCore.Evaluation.CkMachine
( CkMachineException
test2 :: EvaluationResult (Either Text ())
test2 = readKnownCk @() @DefaultUni unitval
-
infix 4 |>, <|
-- | The CK machine-specific 'MachineException'.
+
module Language.PlutusCore.Parser where
+
+
import Control.Monad.Except
+
import qualified Data.ByteString.Lazy as BSL
+
import Language.PlutusCore.Error
+
import Language.PlutusCore.Lexer
+
import Language.PlutusCore.Name
+
import Language.PlutusCore.Quote
+
import Language.PlutusCore.Type
+
+
-- | Parse a PLC program. The resulting program will have fresh names. The underlying monad must be capable
+
-- of handling any parse errors.
+
parseProgram :: (AsParseError e AlexPosn, MonadError e m, MonadQuote m) => BSL.ByteString -> m (Program TyName Name uni AlexPosn)
+
parseProgram str = undefined -- mapParseRun (parseST str)
+
+
-- | Parse a PLC term. The resulting program will have fresh names. The underlying monad must be capable
+
-- of handling any parse errors.
+
parseTerm :: (AsParseError e AlexPosn, MonadError e m, MonadQuote m) => BSL.ByteString -> m (Term TyName Name uni AlexPosn)
+
parseTerm str = undefined -- mapParseRun (parseTermST str)
+
+
-- | Parse a PLC type. The resulting program will have fresh names. The underlying monad must be capable
+
-- of handling any parse errors.
+
parseType :: (AsParseError e AlexPosn, MonadError e m, MonadQuote m) => BSL.ByteString -> m (Type TyName uni AlexPosn)
+
parseType str = undefined -- mapParseRun (parseTypeST str)