Skip to content

Commit

Permalink
Add PlutusTx correspondents to the new builtins
Browse files Browse the repository at this point in the history
  • Loading branch information
@kozross
kozross committed May 7, 2024
1 parent 50081f0 commit 62d1e1a
Show file tree
Hide file tree
Showing 2 changed files with 213 additions and 0 deletions.
137 changes: 137 additions & 0 deletions plutus-tx/src/PlutusTx/Builtins.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -106,8 +106,17 @@ module PlutusTx.Builtins (
, toBuiltin
, integerToByteString
, byteStringToInteger
-- * Logical
, bitwiseLogicalAnd
, bitwiseLogicalOr
, bitwiseLogicalXor
, bitwiseLogicalComplement
, readBit
, writeBits
, byteStringReplicate
) where

import Data.Functor (fmap)
import Data.Maybe
import PlutusTx.Base (const, uncurry)
import PlutusTx.Bool (Bool (..))
Expand Down Expand Up @@ -637,3 +646,131 @@ integerToByteString endianness = BI.integerToByteString (toBuiltin (byteOrderToB
byteStringToInteger :: ByteOrder -> BuiltinByteString -> Integer
byteStringToInteger endianness =
BI.byteStringToInteger (toBuiltin (byteOrderToBool endianness))

-- Logical operations

-- | Perform logical AND on two 'BuiltinByteString' arguments, as described
-- [here](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#builtinlogicaland).
--
-- The first argument indicates whether padding semantics should be used or not;
-- if 'False', truncation semantics will be used instead.
--
-- = See also
--
-- * [Padding and truncation
-- semantics](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#padding-versus-truncation-semantics)
-- * [Bit indexing
-- scheme](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#bit-indexing-scheme)
{-# INLINEABLE bitwiseLogicalAnd #-}
bitwiseLogicalAnd ::
Bool ->
BuiltinByteString ->
BuiltinByteString ->
BuiltinByteString
bitwiseLogicalAnd b = BI.bitwiseLogicalAnd (toBuiltin b)

-- | Perform logical OR on two 'BuiltinByteString' arguments, as described
-- [here](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#builtinlogicalor).
--
-- The first argument indicates whether padding semantics should be used or not;
-- if 'False', truncation semantics will be used instead.
--
-- = See also
--
-- * [Padding and truncation
-- semantics](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#padding-versus-truncation-semantics)
-- * [Bit indexing
-- scheme](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#bit-indexing-scheme)
{-# INLINEABLE bitwiseLogicalOr #-}
bitwiseLogicalOr ::
Bool ->
BuiltinByteString ->
BuiltinByteString ->
BuiltinByteString
bitwiseLogicalOr b = BI.bitwiseLogicalOr (toBuiltin b)

-- | Perform logical XOR on two 'BuiltinByteString' arguments, as described
-- [here](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#builtinlogicalxor).
--
-- The first argument indicates whether padding semantics should be used or not;
-- if 'False', truncation semantics will be used instead.
--
-- = See also
--
-- * [Padding and truncation
-- semantics](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#padding-versus-truncation-semantics)
-- * [Bit indexing
-- scheme](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#bit-indexing-scheme)
{-# INLINEABLE bitwiseLogicalXor #-}
bitwiseLogicalXor ::
Bool ->
BuiltinByteString ->
BuiltinByteString ->
BuiltinByteString
bitwiseLogicalXor b = BI.bitwiseLogicalXor (toBuiltin b)

-- | Perform logical complement on a 'BuiltinByteString', as described
-- [here](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#builtinlogicalcomplement).
--
-- = See also
--
-- * [Bit indexing
-- scheme](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#bit-indexing-scheme)
{-# INLINEABLE bitwiseLogicalComplement #-}
bitwiseLogicalComplement ::
BuiltinByteString ->
BuiltinByteString
bitwiseLogicalComplement = BI.bitwiseLogicalComplement

-- | Read a bit at the _bit_ index given by the 'Integer' argument in the
-- 'BuiltinByteString' argument. The result will be 'True' if the corresponding bit is set, and
-- 'False' if it is clear. Will error if given an out-of-bounds index argument; that is, if the
-- index is either negative, or equal to or greater than the total number of bits in the
-- 'BuiltinByteString' argument.
--
-- = See also
--
-- * [Bit indexing
-- scheme](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#bit-indexing-scheme)
-- * [Operation
-- description](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#builtinreadbit)
{-# INLINEABLE readBit #-}
readBit ::
BuiltinByteString ->
Integer ->
Bool
readBit bs i = fromBuiltin (BI.readBit bs i)

-- | Given a 'BuiltinByteString' and a changelist of index-value pairs, set the _bit_ at each index
-- where the corresponding value is 'True', and clear the bit at each index where the corresponding
-- value is 'False'. Will error if any of the indexes are out-of-bounds: that is, if the index is
-- either negative, or equal to or greater than the total number of bits in the 'BuiltinByteString'
-- argument.
--
-- = See also
--
-- * [Bit indexing
-- scheme](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#bit-indexing-scheme)
-- * [Operation
-- description](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#builtinsetbits)
{-# INLINEABLE writeBits #-}
writeBits ::
BuiltinByteString ->
BI.BuiltinList (BI.BuiltinPair BI.BuiltinInteger BI.BuiltinBool) ->
BuiltinByteString
writeBits = BI.writeBits

-- | Given a length (first argument) and a byte (second argument), produce a 'BuiltinByteString' of
-- that length, with that byte in every position. Will error if given a negative length, or a second
-- argument that isn't a byte (less than 0, greater than 255).
--
-- = See also
--
-- * [Operation
-- description](https://github.com/mlabs-haskell/CIPs/blob/koz/logic-ops/CIP-XXX/CIP-XXX.md#builtinreplicate)
{-# INLINEABLE byteStringReplicate #-}
byteStringReplicate ::
Integer ->
Integer ->
BuiltinByteString
byteStringReplicate = BI.byteStringReplicate
76 changes: 76 additions & 0 deletions plutus-tx/src/PlutusTx/Builtins/Internal.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,7 @@ import Data.Text as Text (Text, empty)
import Data.Text.Encoding as Text (decodeUtf8, encodeUtf8)
import GHC.Generics (Generic)
import PlutusCore.Bitwise.Convert qualified as Convert
import PlutusCore.Bitwise.Logical qualified as Logical
import PlutusCore.Builtin (BuiltinResult (..))
import PlutusCore.Crypto.BLS12_381.G1 qualified as BLS12_381.G1
import PlutusCore.Crypto.BLS12_381.G2 qualified as BLS12_381.G2
Expand Down Expand Up @@ -706,3 +707,78 @@ byteStringToInteger
-> BuiltinInteger
byteStringToInteger (BuiltinBool statedEndianness) (BuiltinByteString input) =
Convert.byteStringToIntegerWrapper statedEndianness input

{-
LOGICAL
-}

{-# NOINLINE bitwiseLogicalAnd #-}
bitwiseLogicalAnd ::
BuiltinBool ->
BuiltinByteString ->
BuiltinByteString ->
BuiltinByteString
bitwiseLogicalAnd (BuiltinBool isPaddingSemantics) (BuiltinByteString data1) (BuiltinByteString data2) =
BuiltinByteString . Logical.bitwiseLogicalAnd isPaddingSemantics data1 $ data2

{-# NOINLINE bitwiseLogicalOr #-}
bitwiseLogicalOr ::
BuiltinBool ->
BuiltinByteString ->
BuiltinByteString ->
BuiltinByteString
bitwiseLogicalOr (BuiltinBool isPaddingSemantics) (BuiltinByteString data1) (BuiltinByteString data2) =
BuiltinByteString . Logical.bitwiseLogicalOr isPaddingSemantics data1 $ data2

{-# NOINLINE bitwiseLogicalXor #-}
bitwiseLogicalXor ::
BuiltinBool ->
BuiltinByteString ->
BuiltinByteString ->
BuiltinByteString
bitwiseLogicalXor (BuiltinBool isPaddingSemantics) (BuiltinByteString data1) (BuiltinByteString data2) =
BuiltinByteString . Logical.bitwiseLogicalXor isPaddingSemantics data1 $ data2

{-# NOINLINE bitwiseLogicalComplement #-}
bitwiseLogicalComplement ::
BuiltinByteString ->
BuiltinByteString
bitwiseLogicalComplement (BuiltinByteString bs) =
BuiltinByteString . Logical.bitwiseLogicalComplement $ bs

{-# NOINLINE readBit #-}
readBit ::
BuiltinByteString ->
BuiltinInteger ->
BuiltinBool
readBit (BuiltinByteString bs) i =
case Logical.readBit bs (fromIntegral i) of
BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $
Haskell.error "readBit errored."
BuiltinSuccess b -> BuiltinBool b
BuiltinSuccessWithLogs logs b -> traceAll logs $ BuiltinBool b

{-# NOINLINE writeBits #-}
writeBits ::
BuiltinByteString ->
BuiltinList (BuiltinPair BuiltinInteger BuiltinBool) ->
BuiltinByteString
writeBits (BuiltinByteString bs) (BuiltinList xs) =
let unwrapped = fmap (\(BuiltinPair (i, BuiltinBool b)) -> (i, b)) xs in
case Logical.writeBits bs unwrapped of
BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $
Haskell.error "writeBits errored."
BuiltinSuccess bs' -> BuiltinByteString bs'
BuiltinSuccessWithLogs logs bs' -> traceAll logs $ BuiltinByteString bs'

{-# NOINLINE byteStringReplicate #-}
byteStringReplicate ::
BuiltinInteger ->
BuiltinInteger ->
BuiltinByteString
byteStringReplicate n w8 =
case Logical.byteStringReplicate (fromIntegral n) (fromIntegral w8) of
BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $
Haskell.error "byteStringReplicate errored."
BuiltinSuccess bs -> BuiltinByteString bs
BuiltinSuccessWithLogs logs bs -> traceAll logs $ BuiltinByteString bs

0 comments on commit 62d1e1a

Please sign in to comment.