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

Change writeBits to take changelists as two separate lists #6317

Merged
merged 7 commits into from
Jul 19, 2024
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
7 changes: 7 additions & 0 deletions plutus-core/plutus-core/src/PlutusCore/Bitwise.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ module PlutusCore.Bitwise (
byteStringToIntegerWrapper,
shiftByteStringWrapper,
rotateByteStringWrapper,
writeBitsWrapper,
-- * Implementation details
IntegerToByteStringError (..),
integerToByteStringMaximumOutputLength,
Expand Down Expand Up @@ -357,6 +358,12 @@ byteStringToInteger statedByteOrder input = case statedByteOrder of
endiannessArgToByteOrder :: Bool -> ByteOrder
endiannessArgToByteOrder b = if b then BigEndian else LittleEndian

-- | Needed due to the complexities of passing lists of pairs as arguments.
-- Effectively, we pass the second argument as required by CIP-122 in its
-- \'unzipped\' form, truncating mismatches.
writeBitsWrapper :: ByteString -> [Integer] -> [Bool] -> BuiltinResult ByteString
writeBitsWrapper bs ixes = writeBits bs . zip ixes

{- Note [Binary bitwise operation implementation and manual specialization]

All of the 'binary' bitwise operations (namely `andByteString`,
Expand Down
6 changes: 3 additions & 3 deletions plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1922,12 +1922,12 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where
(runCostingFunTwoArguments . unimplementedCostingFun)

toBuiltinMeaning _semvar WriteBits =
let writeBitsDenotation :: BS.ByteString -> [(Integer, Bool)] -> BuiltinResult BS.ByteString
writeBitsDenotation = Bitwise.writeBits
let writeBitsDenotation :: BS.ByteString -> [Integer] -> [Bool] -> BuiltinResult BS.ByteString
writeBitsDenotation = Bitwise.writeBitsWrapper
{-# INLINE writeBitsDenotation #-}
in makeBuiltinMeaning
writeBitsDenotation
(runCostingFunTwoArguments . unimplementedCostingFun)
(runCostingFunThreeArguments . unimplementedCostingFun)

toBuiltinMeaning _semvar ReplicateByte =
let replicateByteDenotation :: Int -> Word8 -> BuiltinResult BS.ByteString
Expand Down
Original file line number Diff line number Diff line change
@@ -1 +1 @@
bytestring -> list (pair integer bool) -> bytestring
bytestring -> list integer -> list bool -> bytestring
37 changes: 24 additions & 13 deletions plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Laws.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,8 @@ getSet =
b <- evaluateToHaskell lookupExp
let lhs = mkIterAppNoAnn (builtin () PLC.WriteBits) [
mkConstant @ByteString () bs,
mkConstant @[(Integer, Bool)] () [(i, b)]
mkConstant @[Integer] () [i],
mkConstant @[Bool] () [b]
]
evaluatesToConstant bs lhs

Expand All @@ -79,7 +80,8 @@ setGet =
b <- forAll Gen.bool
let lhsInner = mkIterAppNoAnn (builtin () PLC.WriteBits) [
mkConstant @ByteString () bs,
mkConstant @[(Integer, Bool)] () [(i, b)]
mkConstant @[Integer] () [i],
mkConstant @[Bool] () [b]
]
let lhs = mkIterAppNoAnn (builtin () PLC.ReadBit) [
lhsInner,
Expand All @@ -97,11 +99,13 @@ setSet =
b2 <- forAll Gen.bool
let lhs = mkIterAppNoAnn (builtin () PLC.WriteBits) [
mkConstant @ByteString () bs,
mkConstant @[(Integer, Bool)] () [(i, b1), (i, b2)]
mkConstant @[Integer] () [i, i],
mkConstant @[Bool] () [b1, b2]
]
let rhs = mkIterAppNoAnn (builtin () PLC.WriteBits) [
mkConstant @ByteString () bs,
mkConstant @[(Integer, Bool)] () [(i, b2)]
mkConstant @[Integer] () [i],
mkConstant @[Bool] () [b2]
]
evaluateTheSame lhs rhs

Expand All @@ -122,25 +126,29 @@ writeBitsHomomorphismLaws =
bs <- forAllByteString 1 512
let lhs = mkIterAppNoAnn (builtin () PLC.WriteBits) [
mkConstant @ByteString () bs,
mkConstant @[(Integer, Bool)] () []
mkConstant @[Integer] () [],
mkConstant @[Bool] () []
]
evaluatesToConstant bs lhs
compositionProp :: Property
compositionProp = property $ do
bs <- forAllByteString 1 512
changelist1 <- forAllChangelistOf bs
changelist2 <- forAllChangelistOf bs
(ixes1, bits1) <- forAllChangelistsOf bs
(ixes2, bits2) <- forAllChangelistsOf bs
let lhsInner = mkIterAppNoAnn (builtin () PLC.WriteBits) [
mkConstant @ByteString () bs,
mkConstant @[(Integer, Bool)] () changelist1
mkConstant @[Integer] () ixes1,
mkConstant @[Bool] () bits1
]
let lhs = mkIterAppNoAnn (builtin () PLC.WriteBits) [
lhsInner,
mkConstant @[(Integer, Bool)] () changelist2
mkConstant @[Integer] () ixes2,
mkConstant @[Bool] () bits2
]
let rhs = mkIterAppNoAnn (builtin () PLC.WriteBits) [
mkConstant @ByteString () bs,
mkConstant @[(Integer, Bool)] () (changelist1 <> changelist2)
mkConstant @[Integer] () (ixes1 <> ixes2),
mkConstant @[Bool] () (bits1 <> bits2)
]
evaluateTheSame lhs rhs

Expand Down Expand Up @@ -455,9 +463,12 @@ unitProp f isPadding unit = property $ do
forAllIndexOf :: ByteString -> PropertyT IO Integer
forAllIndexOf bs = forAll . Gen.integral . Range.linear 0 . fromIntegral $ BS.length bs * 8 - 1

forAllChangelistOf :: ByteString -> PropertyT IO [(Integer, Bool)]
forAllChangelistOf bs =
forAll . Gen.list (Range.linear 0 (8 * len - 1)) $ (,) <$> genIndex <*> Gen.bool
forAllChangelistsOf :: ByteString -> PropertyT IO ([Integer], [Bool])
forAllChangelistsOf bs = do
ourLen :: Int <- forAll . Gen.integral . Range.linear 0 $ 8 * len - 1
ixes <- forAll . Gen.list (Range.singleton ourLen) $ genIndex
bits <- forAll . Gen.list (Range.singleton ourLen) $ Gen.bool
pure (ixes, bits)
where
len :: Int
len = BS.length bs
Expand Down
32 changes: 25 additions & 7 deletions plutus-tx/src/PlutusTx/Builtins.hs
Original file line number Diff line number Diff line change
Expand Up @@ -784,11 +784,28 @@ readBit ::
Bool
readBit bs i = fromOpaque (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.
-- | Given a 'BuiltinByteString', a list of indexes to change, and a list of values to change those
-- indexes to, set the /bit/ at each of the specified index as follows:
--
-- * If the corresponding entry in the list of values is 'True', set that bit;
-- * Otherwise, clear that bit.
--
-- 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.
--
-- If the two list arguments have mismatched lengths, the longer argument will be truncated to match
-- the length of the shorter one:
--
-- * @writeBits bs [0, 1, 4] [True]@ is the same as @writeBits bs [0] [True]@
-- * @writeBits bs [0] [True, False, True]@ is the same as @writeBits bs [0] [True]@
--
-- = Note
--
-- This differs slightly from the description of the [corresponding operation in
-- CIP-122](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#writebits); instead of a
-- single changelist argument comprised of pairs, we instead pass two lists, one for indexes to
-- change, and one for the values to change those indexes to. Effectively, we are passing the
-- changelist argument \'unzipped\'.
--
-- = See also
--
Expand All @@ -799,9 +816,10 @@ readBit bs i = fromOpaque (BI.readBit bs i)
{-# INLINEABLE writeBits #-}
writeBits ::
BuiltinByteString ->
BI.BuiltinList (BI.BuiltinPair BI.BuiltinInteger BI.BuiltinBool) ->
[Integer] ->
[Bool] ->
BuiltinByteString
writeBits = BI.writeBits
writeBits bs ixes bits = BI.writeBits bs (toBuiltin ixes) (toBuiltin bits)

-- | 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
Expand Down
16 changes: 8 additions & 8 deletions plutus-tx/src/PlutusTx/Builtins/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -793,15 +793,15 @@ readBit (BuiltinByteString bs) i =
{-# NOINLINE writeBits #-}
writeBits ::
BuiltinByteString ->
BuiltinList (BuiltinPair BuiltinInteger BuiltinBool) ->
BuiltinList BuiltinInteger ->
BuiltinList BuiltinBool ->
BuiltinByteString
writeBits (BuiltinByteString bs) (BuiltinList xs) =
let unwrapped = fmap (\(BuiltinPair (i, BuiltinBool b)) -> (i, b)) xs in
case Bitwise.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'
writeBits (BuiltinByteString bs) (BuiltinList ixes) (BuiltinList bits) =
case Bitwise.writeBitsWrapper bs ixes (fmap (\(BuiltinBool b) -> b) bits) 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 replicateByte #-}
replicateByte ::
Expand Down