From 84ec5ba24aeaa88b0f137fb4586fd8a9e8f56019 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Mon, 1 Nov 2021 16:09:08 +0500 Subject: [PATCH] Add shift builtin (fix #4168). --- .../plutus-core/src/PlutusCore/Default/Builtins.hs | 9 +++++++++ .../test/TypeSynthesis/Golden/ShiftInteger.plc.golden | 1 + .../test/Evaluation/Builtins/Definition.hs | 3 +++ plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs | 2 ++ plutus-tx/src/PlutusTx/Builtins.hs | 10 ++++++++++ plutus-tx/src/PlutusTx/Builtins/Internal.hs | 5 +++++ 6 files changed, 30 insertions(+) create mode 100644 plutus-core/plutus-core/test/TypeSynthesis/Golden/ShiftInteger.plc.golden diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs index 1e9bfe98304..685d4fb3a1c 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs @@ -26,6 +26,7 @@ import PlutusCore.Evaluation.Result import PlutusCore.Pretty import Crypto +import qualified Data.Bits as Bits import qualified Data.ByteString as BS import qualified Data.ByteString.Hash as Hash import Data.Char @@ -51,6 +52,7 @@ data DefaultFun | EqualsInteger | LessThanInteger | LessThanEqualsInteger + | ShiftInteger -- Bytestrings | AppendByteString | ConsByteString @@ -178,6 +180,10 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where makeBuiltinMeaning ((<=) @Integer) (runCostingFunTwoArguments . paramLessThanEqualsInteger) + toBuiltinMeaning ShiftInteger = + makeBuiltinMeaning + (\x i -> Bits.shift @Integer x (fromIntegral @Integer i)) + mempty -- TODO: add costing for ShiftInteger -- Bytestrings toBuiltinMeaning AppendByteString = makeBuiltinMeaning @@ -502,6 +508,8 @@ instance Flat DefaultFun where MkNilData -> 49 MkNilPairData -> 50 + ShiftInteger -> 51 + decode = go =<< decodeBuiltin where go 0 = pure AddInteger go 1 = pure SubtractInteger @@ -554,6 +562,7 @@ instance Flat DefaultFun where go 48 = pure MkPairData go 49 = pure MkNilData go 50 = pure MkNilPairData + go 51 = pure ShiftInteger go t = fail $ "Failed to decode builtin tag, got: " ++ show t size _ n = n + builtinTagWidth diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Golden/ShiftInteger.plc.golden b/plutus-core/plutus-core/test/TypeSynthesis/Golden/ShiftInteger.plc.golden new file mode 100644 index 00000000000..577e3fd2a40 --- /dev/null +++ b/plutus-core/plutus-core/test/TypeSynthesis/Golden/ShiftInteger.plc.golden @@ -0,0 +1 @@ +(fun (con integer) (fun (con integer) (con integer))) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs index 13a30978653..0d675cb8d5d 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs @@ -343,6 +343,9 @@ test_Integer = testCase "Integer" $ do evals False LessThanEqualsInteger [cons @Integer 4001, cons @Integer 4000] evals True EqualsInteger [cons @Integer (-101), cons @Integer (-101)] evals False EqualsInteger [cons @Integer 0, cons @Integer 1] + evals @Integer 24 ShiftInteger [cons @Integer 3, cons @Integer 3] + evals @Integer 0 ShiftInteger [cons @Integer 3, cons @Integer (-3)] + evals @Integer (-2) ShiftInteger [cons @Integer (-3), cons @Integer (-1)] -- | Test all string-like builtins test_String :: TestTree diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs index 20f4c83b784..13c1a537317 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs @@ -186,6 +186,7 @@ builtinNames = [ , 'Builtins.lessThanInteger , 'Builtins.lessThanEqualsInteger , 'Builtins.equalsInteger + , 'Builtins.shiftInteger , 'Builtins.error @@ -305,6 +306,7 @@ defineBuiltinTerms = do defineBuiltinTerm 'Builtins.lessThanInteger $ mkBuiltin PLC.LessThanInteger defineBuiltinTerm 'Builtins.lessThanEqualsInteger $ mkBuiltin PLC.LessThanEqualsInteger defineBuiltinTerm 'Builtins.equalsInteger $ mkBuiltin PLC.EqualsInteger + defineBuiltinTerm 'Builtins.shiftInteger $ mkBuiltin PLC.ShiftInteger -- Error -- See Note [Delaying error] diff --git a/plutus-tx/src/PlutusTx/Builtins.hs b/plutus-tx/src/PlutusTx/Builtins.hs index 1c29444f351..8160eb6a1eb 100644 --- a/plutus-tx/src/PlutusTx/Builtins.hs +++ b/plutus-tx/src/PlutusTx/Builtins.hs @@ -35,6 +35,7 @@ module PlutusTx.Builtins ( , lessThanInteger , lessThanEqualsInteger , equalsInteger + , shiftInteger -- * Error , error -- * Data @@ -217,6 +218,15 @@ lessThanEqualsInteger x y = fromBuiltin (BI.lessThanEqualsInteger (toBuiltin x) equalsInteger :: Integer -> Integer -> Bool equalsInteger x y = fromBuiltin (BI.equalsInteger (toBuiltin x) (toBuiltin y)) +{-# INLINABLE shiftInteger #-} +{-| @'shiftInteger' x i@ shifts @x@ left by @i@ bits if @i@ is positive, + or right by @-i@ bits otherwise. + Right shifts perform sign extension on signed number types; + i.e. they fill the top bits with 1 if the @x@ is negative + and with 0 otherwise. -} +shiftInteger :: Integer -> Integer -> Integer +shiftInteger x y = fromBuiltin (BI.shiftInteger (toBuiltin x) (toBuiltin y)) + {-# INLINABLE error #-} -- | Aborts evaluation with an error. error :: () -> a diff --git a/plutus-tx/src/PlutusTx/Builtins/Internal.hs b/plutus-tx/src/PlutusTx/Builtins/Internal.hs index b5096cf22a5..567c8565397 100644 --- a/plutus-tx/src/PlutusTx/Builtins/Internal.hs +++ b/plutus-tx/src/PlutusTx/Builtins/Internal.hs @@ -15,6 +15,7 @@ module PlutusTx.Builtins.Internal where import Codec.Serialise import Control.DeepSeq (NFData) import qualified Crypto +import qualified Data.Bits as Bits import qualified Data.ByteArray as BA import Data.ByteString as BS import qualified Data.ByteString.Hash as Hash @@ -143,6 +144,10 @@ lessThanEqualsInteger = coerce ((<=) @Integer) equalsInteger :: BuiltinInteger -> BuiltinInteger -> BuiltinBool equalsInteger = coerce ((==) @Integer) +{-# NOINLINE shiftInteger #-} +shiftInteger :: BuiltinInteger -> BuiltinInteger -> BuiltinInteger +shiftInteger x i = Bits.shift @Integer x (fromIntegral @Integer i) + {- BYTESTRING -}