From 6591ba57d5f189d5dff876cb2085a8c0bbf2178e Mon Sep 17 00:00:00 2001 From: effectfully Date: Fri, 5 Oct 2018 16:40:12 +0300 Subject: [PATCH] [CGP-365] [Constants] Use 'BlockNum', remove 'BlockTime' --- .../src/Language/PlutusCore/CBOR.hs | 2 -- .../src/Language/PlutusCore/Constant/Apply.hs | 1 - .../src/Language/PlutusCore/Constant/Typed.hs | 18 +++++++++++++++++- .../src/Language/PlutusCore/Lexer.x | 1 - .../src/Language/PlutusCore/Lexer/Type.hs | 10 ++++------ language-plutus-core/test/Generators.hs | 9 +-------- .../TypeSynthesis/Golden/BlockNum.plc.golden | 1 + 7 files changed, 23 insertions(+), 19 deletions(-) create mode 100644 language-plutus-core/test/TypeSynthesis/Golden/BlockNum.plc.golden diff --git a/language-plutus-core/src/Language/PlutusCore/CBOR.hs b/language-plutus-core/src/Language/PlutusCore/CBOR.hs index 09c1ff46ad5..9cab433c1ac 100644 --- a/language-plutus-core/src/Language/PlutusCore/CBOR.hs +++ b/language-plutus-core/src/Language/PlutusCore/CBOR.hs @@ -55,7 +55,6 @@ encodeBuiltinName bi = EqByteString -> 19 TxHash -> 20 BlockNum -> 21 - BlockTime -> 22 in encodeTag i decodeBuiltinName :: Decoder s BuiltinName @@ -82,7 +81,6 @@ decodeBuiltinName = go =<< decodeTag go 19 = pure EqByteString go 20 = pure TxHash go 21 = pure BlockNum - go 22 = pure BlockTime go _ = fail "Failed to decode BuiltinName" encodeNatural :: Natural -> Encoding diff --git a/language-plutus-core/src/Language/PlutusCore/Constant/Apply.hs b/language-plutus-core/src/Language/PlutusCore/Constant/Apply.hs index 1e4b26f4d5a..7ecc7c0c4eb 100644 --- a/language-plutus-core/src/Language/PlutusCore/Constant/Apply.hs +++ b/language-plutus-core/src/Language/PlutusCore/Constant/Apply.hs @@ -192,4 +192,3 @@ applyBuiltinName VerifySignature = applyTypedBuiltinName typedVerifySignatu applyBuiltinName EqByteString = applyTypedBuiltinName typedEqByteString (==) applyBuiltinName TxHash = applyTypedBuiltinName typedTxHash undefined applyBuiltinName BlockNum = undefined -applyBuiltinName BlockTime = undefined diff --git a/language-plutus-core/src/Language/PlutusCore/Constant/Typed.hs b/language-plutus-core/src/Language/PlutusCore/Constant/Typed.hs index 20e247afb2a..cbe0844fabb 100644 --- a/language-plutus-core/src/Language/PlutusCore/Constant/Typed.hs +++ b/language-plutus-core/src/Language/PlutusCore/Constant/Typed.hs @@ -50,6 +50,7 @@ module Language.PlutusCore.Constant.Typed , typedResizeByteString , typedEqByteString , typedTxHash + , typedBlockNum ) where import Language.PlutusCore.Lexer.Type (BuiltinName (..), TypeBuiltin (..), prettyBytes) @@ -101,6 +102,9 @@ data TypedBuiltin size a where data TypedBuiltinValue size a = TypedBuiltinValue (TypedBuiltin size a) a -- | Type schemes of primitive operations. +-- @a@ is the Haskell denotation of a PLC type represented as a 'TypeScheme'. +-- @r@ is the resulting type in @a@, e.g. the resulting type in +-- @ByteString -> Size -> Integer@ is @Integer@. data TypeScheme size a r where TypeSchemeBuiltin :: TypedBuiltin size a -> TypeScheme size a a TypeSchemeArrow :: TypeScheme size a q -> TypeScheme size b r -> TypeScheme size (a -> b) r @@ -110,6 +114,10 @@ data TypeScheme size a r where -- We can make this generic by parametrising @TypeScheme@ by an -- @f :: Kind () -> *@ rather than @size@. + -- The @r@ is rather ad hoc and needed only for tests. + -- We could use type families to compute it instead of storing as an index. + -- That's a TODO perhaps. + -- | A 'BuiltinName' with an associated 'TypeScheme'. data TypedBuiltinName a r = TypedBuiltinName BuiltinName (forall size. TypeScheme size a r) -- I attempted to unify various typed things, but sometimes type variables must be universally @@ -266,7 +274,7 @@ withTypedBuiltinName VerifySignature k = k typedVerifySignature withTypedBuiltinName ResizeByteString k = k typedResizeByteString withTypedBuiltinName EqByteString k = k typedEqByteString withTypedBuiltinName TxHash k = k typedTxHash -withTypedBuiltinName _ _ = error "Outdated" +withTypedBuiltinName BlockNum k = k typedBlockNum -- | Return the 'Type' of a 'TypedBuiltinName'. typeOfTypedBuiltinName :: TypedBuiltinName a r -> Quote (Type TyName ()) @@ -424,3 +432,11 @@ typedTxHash :: TypedBuiltinName BSL.ByteString BSL.ByteString typedTxHash = TypedBuiltinName TxHash $ TypeSchemeBuiltin (TypedBuiltinSized (SizeValue 256) TypedBuiltinSizedBS) + +-- | Typed 'BlockNum'. +typedBlockNum :: TypedBuiltinName (Size -> Integer) Integer +typedBlockNum = + TypedBuiltinName BlockNum $ + TypeSchemeAllSize $ \s -> + TypeSchemeBuiltin (TypedBuiltinSized (SizeBound s) TypedBuiltinSizedSize) `TypeSchemeArrow` + TypeSchemeBuiltin (TypedBuiltinSized (SizeBound s) TypedBuiltinSizedInt) diff --git a/language-plutus-core/src/Language/PlutusCore/Lexer.x b/language-plutus-core/src/Language/PlutusCore/Lexer.x index 52b3a49640b..83ed9bc056d 100644 --- a/language-plutus-core/src/Language/PlutusCore/Lexer.x +++ b/language-plutus-core/src/Language/PlutusCore/Lexer.x @@ -93,7 +93,6 @@ tokens :- <0> equalsByteString { mkBuiltin EqByteString } <0> txhash { mkBuiltin TxHash } <0> blocknum { mkBuiltin BlockNum } - <0> blocktime { mkBuiltin BlockTime } -- Various special characters <0> "(" { mkSpecial OpenParen } diff --git a/language-plutus-core/src/Language/PlutusCore/Lexer/Type.hs b/language-plutus-core/src/Language/PlutusCore/Lexer/Type.hs index 4e9484c57b8..4040136c2d3 100644 --- a/language-plutus-core/src/Language/PlutusCore/Lexer/Type.hs +++ b/language-plutus-core/src/Language/PlutusCore/Lexer/Type.hs @@ -49,7 +49,6 @@ data BuiltinName = AddInteger | EqByteString | TxHash | BlockNum - | BlockTime deriving (Show, Eq, Ord, Enum, Bounded, Generic, NFData, Lift) -- | Version of Plutus Core to be used for the program. @@ -163,7 +162,6 @@ instance Pretty BuiltinName where pretty VerifySignature = "verifySignature" pretty TxHash = "txhash" pretty BlockNum = "blocknum" - pretty BlockTime = "blocktime" instance Pretty TypeBuiltin where pretty TyInteger = "integer" @@ -173,8 +171,8 @@ instance Pretty TypeBuiltin where instance Pretty (Version a) where pretty (Version _ i j k) = pretty i <> "." <> pretty j <> "." <> pretty k +-- | The list of all 'BuiltinName's. allBuiltinNames :: [BuiltinName] -allBuiltinNames = dropR 2 [minBound .. maxBound] -- Ignoring the last two outdated 'BuiltinName's. - -dropR :: Int -> [a] -> [a] -dropR n xs = take (length xs - n) xs +allBuiltinNames = [minBound .. maxBound] +-- The way it's defined ensures that it's enough to add a new built-in to 'BuiltinName' and it'll be +-- automatically handled by tests and other stuff that deals with all built-in names at once. diff --git a/language-plutus-core/test/Generators.hs b/language-plutus-core/test/Generators.hs index 590c8371b3e..7fabb627909 100644 --- a/language-plutus-core/test/Generators.hs +++ b/language-plutus-core/test/Generators.hs @@ -30,13 +30,7 @@ genKind = simpleRecursive nonRecursive recursive recursive = [KindArrow emptyPosn <$> genKind <*> genKind] genBuiltinName :: MonadGen m => m BuiltinName -genBuiltinName = Gen.choice $ pure <$> - [ AddInteger, SubtractInteger, MultiplyInteger, DivideInteger, RemainderInteger - , LessThanInteger, LessThanEqInteger, GreaterThanInteger, GreaterThanEqInteger - , EqInteger, ResizeInteger, IntToByteString, Concatenate, TakeByteString - , DropByteString, ResizeByteString, SHA2, SHA3, VerifySignature - , EqByteString, TxHash, BlockNum, BlockTime - ] +genBuiltinName = Gen.element allBuiltinNames genBuiltin :: MonadGen m => m (Constant AlexPosn) genBuiltin = Gen.choice [BuiltinName emptyPosn <$> genBuiltinName, genInt, genSize, genBS] @@ -76,4 +70,3 @@ genProgram = Program emptyPosn <$> genVersion <*> genTerm emptyPosn :: AlexPosn emptyPosn = AlexPn 0 0 0 - diff --git a/language-plutus-core/test/TypeSynthesis/Golden/BlockNum.plc.golden b/language-plutus-core/test/TypeSynthesis/Golden/BlockNum.plc.golden new file mode 100644 index 00000000000..3478ebf0f77 --- /dev/null +++ b/language-plutus-core/test/TypeSynthesis/Golden/BlockNum.plc.golden @@ -0,0 +1 @@ +(all s0 (size) (fun [(con size) s0] [(con integer) s0])) \ No newline at end of file