Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[CGP-365] [Constants] Use 'BlockNum', remove 'BlockTime' #176

Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 0 additions & 2 deletions language-plutus-core/src/Language/PlutusCore/CBOR.hs
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,6 @@ encodeBuiltinName bi =
EqByteString -> 19
TxHash -> 20
BlockNum -> 21
BlockTime -> 22
in encodeTag i

decodeBuiltinName :: Decoder s BuiltinName
Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -192,4 +192,3 @@ applyBuiltinName VerifySignature = applyTypedBuiltinName typedVerifySignatu
applyBuiltinName EqByteString = applyTypedBuiltinName typedEqByteString (==)
applyBuiltinName TxHash = applyTypedBuiltinName typedTxHash undefined
applyBuiltinName BlockNum = undefined
applyBuiltinName BlockTime = undefined
18 changes: 17 additions & 1 deletion language-plutus-core/src/Language/PlutusCore/Constant/Typed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -50,6 +50,7 @@ module Language.PlutusCore.Constant.Typed
, typedResizeByteString
, typedEqByteString
, typedTxHash
, typedBlockNum
) where

import Language.PlutusCore.Lexer.Type (BuiltinName (..), TypeBuiltin (..), prettyBytes)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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 ())
Expand Down Expand Up @@ -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)
1 change: 0 additions & 1 deletion language-plutus-core/src/Language/PlutusCore/Lexer.x
Original file line number Diff line number Diff line change
Expand Up @@ -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 }
Expand Down
10 changes: 4 additions & 6 deletions language-plutus-core/src/Language/PlutusCore/Lexer/Type.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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"
Expand All @@ -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]
effectfully marked this conversation as resolved.
Show resolved Hide resolved
-- 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.
9 changes: 1 addition & 8 deletions language-plutus-core/test/Generators.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
effectfully marked this conversation as resolved.
Show resolved Hide resolved

genBuiltin :: MonadGen m => m (Constant AlexPosn)
genBuiltin = Gen.choice [BuiltinName emptyPosn <$> genBuiltinName, genInt, genSize, genBS]
Expand Down Expand Up @@ -76,4 +70,3 @@ genProgram = Program emptyPosn <$> genVersion <*> genTerm

emptyPosn :: AlexPosn
emptyPosn = AlexPn 0 0 0

Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
(all s0 (size) (fun [(con size) s0] [(con integer) s0]))