From 7f02fab796980b5a5c0e1caddab004d24f86f7db Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Thu, 25 Jul 2024 15:10:37 +1200 Subject: [PATCH 1/7] 8-queens using bitwise primops benchmark (#6311) * Milestone 3 benchmark, test * Fix cabal file * Update writeBits use in NQueens --- plutus-benchmark/bitwise/bench/Main.hs | 26 +++++++ .../bitwise/src/PlutusBenchmark/NQueens.hs | 77 +++++++++++++++++++ plutus-benchmark/bitwise/test/Main.hs | 12 +++ plutus-benchmark/plutus-benchmark.cabal | 32 ++++++++ 4 files changed, 147 insertions(+) create mode 100644 plutus-benchmark/bitwise/bench/Main.hs create mode 100644 plutus-benchmark/bitwise/src/PlutusBenchmark/NQueens.hs create mode 100644 plutus-benchmark/bitwise/test/Main.hs diff --git a/plutus-benchmark/bitwise/bench/Main.hs b/plutus-benchmark/bitwise/bench/Main.hs new file mode 100644 index 00000000000..110b460cb2e --- /dev/null +++ b/plutus-benchmark/bitwise/bench/Main.hs @@ -0,0 +1,26 @@ +module Main (main) where + +{- +import Criterion.Main (bench, defaultMain) +import PlutusBenchmark.Common (benchProgramCek, mkMostRecentEvalCtx) +import PlutusBenchmark.NQueens (nqueens) +import PlutusTx.Code (CompiledCode, getPlcNoAnn) +import PlutusTx.TH (compile) +-} + +main :: IO () +main = print "Pending" + +{- Currently not able to run, due to problems with writeBits compiling under PlutusTx + +main :: IO () +main = defaultMain [ + bench "8-queens" . benchProgramCek mkMostRecentEvalCtx . getPlcNoAnn $ nqueensCompiled + ] + +-- Helpers + +nqueensCompiled :: CompiledCode [(Integer, Integer)] +nqueensCompiled = $$(compile [||nqueens 8||]) + +-} diff --git a/plutus-benchmark/bitwise/src/PlutusBenchmark/NQueens.hs b/plutus-benchmark/bitwise/src/PlutusBenchmark/NQueens.hs new file mode 100644 index 00000000000..8b87152940c --- /dev/null +++ b/plutus-benchmark/bitwise/src/PlutusBenchmark/NQueens.hs @@ -0,0 +1,77 @@ +-- editorconfig-checker-disable-file +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module PlutusBenchmark.NQueens (nqueens) where + +import PlutusTx.Builtins (replicateByte) +import PlutusTx.Prelude + +-- Based on Qiu, Zongyan (February 2002). "Bit-vector encoding of n-queen problem". ACM SIGPLAN Notices. 37 (2): 68–70 +-- For simplicity, this only accepts multiples of 8 for the dimension (so 8, 16, +-- 24, etc): in all other cases it will return an empty list. Results are (row, +-- column) pairs. +{-# INLINE nqueens #-} +nqueens :: Integer -> [(Integer, Integer)] +nqueens dim + | dim < 8 = [] + | dim `remainder` 8 /= 0 = [] + | otherwise = + let down = replicateByte bytesNeeded 0x00 + left = replicateByte bytesNeeded 0x00 + right = replicateByte bytesNeeded 0x00 + in go 0 0 down left right (replicateByte bytesNeeded 0xFF) + where + bytesNeeded :: Integer + bytesNeeded = dim `quotient` 8 + go :: + Integer -> + Integer -> + BuiltinByteString -> + BuiltinByteString -> + BuiltinByteString -> + BuiltinByteString -> + [(Integer, Integer)] + go selectIx row down left right control + | selectIx == dim = [] + | otherwise = + -- In the original writeup, 0 in a position meant 'occupied'. However, + -- this makes updates to the control vectors very annoying, because + -- now we have to 'shift in' 1 bits, which costs us an extra two + -- copies. We can reduce this by one by instead treating 0 as 'free'. + -- Ideally, we would eliminate one more redundant copy, but this + -- requires a select0 operation, which can't be implemented + -- efficiently. However, given that these copies are per recursive + -- call, we can save ourselves considerable effort by avoiding them. + let available = selectByteString selectIx control + in if + | available == (-1) -> [] + | row == lastRow -> [(row, available)] + | otherwise -> + let newDown = writeBit down available True + newLeft = shiftByteString (writeBit left available True) 1 + newRight = shiftByteString (writeBit right available True) (-1) + newRow = row + 1 + -- We 'hoist' the control vector as a parameter rather + -- than recomputing it every time we modify selectIx. + newControl = complementByteString . orByteString False newDown . orByteString False newLeft $ newRight + in case go 0 newRow newDown newLeft newRight newControl of + [] -> go (selectIx + 1) row down left right control + next -> (row, available) : next + lastRow :: Integer + lastRow = dim - 1 + +-- Helpers + +{-# INLINE selectByteString #-} +selectByteString :: Integer -> BuiltinByteString -> Integer +selectByteString which bs + | which <= 0 = findFirstSetBit bs + | otherwise = let i = selectByteString (which - 1) bs + in if i == (-1) + then (-1) + else i + 1 + findFirstSetBit (shiftByteString bs $ negate (i + 1)) + +{-# INLINE writeBit #-} +writeBit :: BuiltinByteString -> Integer -> Bool -> BuiltinByteString +writeBit bs i b = writeBits bs [i] [b] diff --git a/plutus-benchmark/bitwise/test/Main.hs b/plutus-benchmark/bitwise/test/Main.hs new file mode 100644 index 00000000000..70b551eba3b --- /dev/null +++ b/plutus-benchmark/bitwise/test/Main.hs @@ -0,0 +1,12 @@ +module Main (main) where + +import PlutusBenchmark.NQueens (nqueens) +import Test.Tasty (defaultMain, testGroup) +import Test.Tasty.HUnit (assertEqual, testCase) + +main :: IO () +main = defaultMain . testGroup "nqueens" $ [ + testCase "solves for 8 queens" $ assertEqual "" + [(0,0), (1,4), (2,7), (3,5), (4,2), (5,6), (6,1), (7,3)] + (nqueens 8) + ] diff --git a/plutus-benchmark/plutus-benchmark.cabal b/plutus-benchmark/plutus-benchmark.cabal index 85931299603..28fd92ad75f 100644 --- a/plutus-benchmark/plutus-benchmark.cabal +++ b/plutus-benchmark/plutus-benchmark.cabal @@ -593,3 +593,35 @@ benchmark marlowe-agda-cek , plutus-benchmark-common , plutus-ledger-api ^>=1.31 , plutus-tx ^>=1.31 + +-------------------- bitwise----------------------- + +library bitwise-internal + import: lang, ghc-version-support + hs-source-dirs: bitwise/src + exposed-modules: PlutusBenchmark.NQueens + build-depends: plutus-tx ^>=1.31 + +test-suite bitwise-test + import: lang, ghc-version-support + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: bitwise/test + build-depends: + , base >=4.9 && <5 + , bitwise-internal + , tasty + , tasty-hunit + +benchmark bitwise-bench + import: lang, ghc-version-support + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: bitwise/bench + build-depends: base >=4.9 && <5 + +-- , bitwise-internal +-- , criterion +-- , plutus-benchmark-common +-- , plutus-tx ^>=1.30 +-- , plutus-tx-plugin ^>=1.30 From d510d248feaf01eeb3a3a30b7391f157d34bd871 Mon Sep 17 00:00:00 2001 From: effectfully Date: Thu, 25 Jul 2024 22:34:47 +0200 Subject: [PATCH 2/7] [Plinth] [Builtins] Fix 'writeBits' (#6329) --- .../src/PlutusTx/Compiler/Builtins.hs | 8 + .../test/Plugin/Debug/9.6/fib.pir.golden | 152 +++++++++--------- .../test/Plugin/Debug/9.6/letFun.pir.golden | 70 ++++---- .../writeBits-integerToByteString.eval.golden | 1 + .../test/Plugin/Primitives/Spec.hs | 5 + .../Plugin/Profiling/9.6/addInt.pir.golden | 8 +- .../Plugin/Profiling/9.6/addInt3.eval.golden | 2 +- .../Profiling/9.6/argMismatch1.eval.golden | 12 +- .../Profiling/9.6/argMismatch2.eval.golden | 2 +- .../Plugin/Profiling/9.6/fact4.eval.golden | 72 ++++----- .../test/Plugin/Profiling/9.6/fib.pir.golden | 16 +- .../Plugin/Profiling/9.6/fib4.eval.golden | 148 ++++++++--------- .../test/Plugin/Profiling/9.6/id.eval.golden | 2 +- .../Plugin/Profiling/9.6/idCode.pir.golden | 4 +- .../Plugin/Profiling/9.6/letInFun.eval.golden | 20 +-- .../Profiling/9.6/letInFunMoreArg.eval.golden | 24 +-- .../Profiling/9.6/letRecInFun.eval.golden | 56 +++---- .../Plugin/Profiling/9.6/swap.eval.golden | 2 +- .../Profiling/9.6/typeclass.eval.golden | 24 +-- plutus-tx/src/PlutusTx/Builtins.hs | 8 +- plutus-tx/src/PlutusTx/Builtins/HasOpaque.hs | 12 ++ plutus-tx/src/PlutusTx/Builtins/Internal.hs | 8 + 22 files changed, 346 insertions(+), 310 deletions(-) create mode 100644 plutus-tx-plugin/test/Plugin/Primitives/9.6/writeBits-integerToByteString.eval.golden diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs index 297f3297d41..7799bd8c604 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs @@ -228,6 +228,8 @@ builtinNames = [ , 'Builtins.head , 'Builtins.tail , 'Builtins.chooseList + , 'Builtins.mkNilInteger + , 'Builtins.mkNilBool , 'Builtins.mkNilData , 'Builtins.mkNilPairData , 'Builtins.mkCons @@ -332,6 +334,12 @@ defineBuiltinTerms = do -- Text constant defineBuiltinTerm annMayInline 'Builtins.emptyString $ PIR.mkConstant annMayInline ("" :: Text) + -- List constants + defineBuiltinTerm annMayInline 'Builtins.mkNilInteger $ + PIR.mkConstant annMayInline ([] @Integer) + defineBuiltinTerm annMayInline 'Builtins.mkNilBool $ + PIR.mkConstant annMayInline ([] @Bool) + -- The next two constants are 48 bytes long, so in fact we may not want to inline them. defineBuiltinTerm annMayInline 'Builtins.bls12_381_G1_compressed_generator $ PIR.mkConstant annMayInline BLS12_381.G1.compressed_generator diff --git a/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden b/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden index 7be80da7b1c..53808c671c1 100644 --- a/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden @@ -9,7 +9,7 @@ (strict) (vardecl { no-src-span } - addInteger-538 + addInteger-544 (fun { no-src-span } (con { no-src-span } integer) @@ -27,7 +27,7 @@ (nonstrict) (vardecl { no-src-span } - addInteger-543 + addInteger-549 (fun { no-src-span } (con { no-src-span } integer) @@ -40,7 +40,7 @@ ) (lam { no-src-span } - x-539 + x-545 (con { no-src-span } integer) (let { no-src-span } @@ -48,12 +48,12 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } x-541 (con { no-src-span } integer)) - { no-src-span } x-539 + (vardecl { no-src-span } x-547 (con { no-src-span } integer)) + { no-src-span } x-545 ) (lam { no-src-span } - y-540 + y-546 (con { no-src-span } integer) (let { no-src-span } @@ -61,17 +61,17 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } y-542 (con { no-src-span } integer)) - { no-src-span } y-540 + (vardecl { no-src-span } y-548 (con { no-src-span } integer)) + { no-src-span } y-546 ) [ { no-src-span } [ { no-src-span } - { no-src-span } addInteger-538 - { no-src-span } x-541 + { no-src-span } addInteger-544 + { no-src-span } x-547 ] - { no-src-span } y-542 + { no-src-span } y-548 ] ) ) @@ -82,11 +82,11 @@ { no-src-span } (datatype { no-src-span } - (tyvardecl { no-src-span } Bool-528 ({ no-src-span } type)) + (tyvardecl { no-src-span } Bool-534 ({ no-src-span } type)) - Bool_match-531 - (vardecl { no-src-span } True-529 { no-src-span } Bool-528) - (vardecl { no-src-span } False-530 { no-src-span } Bool-528) + Bool_match-537 + (vardecl { no-src-span } True-535 { no-src-span } Bool-534) + (vardecl { no-src-span } False-536 { no-src-span } Bool-534) ) ) (termbind @@ -94,7 +94,7 @@ (strict) (vardecl { no-src-span } - equalsInteger-527 + equalsInteger-533 (fun { no-src-span } (con { no-src-span } integer) @@ -112,18 +112,18 @@ (strict) (vardecl { no-src-span } - ifThenElse-525 + ifThenElse-531 (all { no-src-span } - a-526 + a-532 ({ no-src-span } type) (fun { no-src-span } (con { no-src-span } bool) (fun { no-src-span } - { no-src-span } a-526 - (fun { no-src-span } { no-src-span } a-526 { no-src-span } a-526) + { no-src-span } a-532 + (fun { no-src-span } { no-src-span } a-532 { no-src-span } a-532) ) ) ) @@ -135,20 +135,20 @@ (nonstrict) (vardecl { no-src-span } - equalsInteger-537 + equalsInteger-543 (fun { no-src-span } (con { no-src-span } integer) (fun { no-src-span } (con { no-src-span } integer) - { no-src-span } Bool-528 + { no-src-span } Bool-534 ) ) ) (lam { no-src-span } - x-532 + x-538 (con { no-src-span } integer) (let { no-src-span } @@ -156,12 +156,12 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } x-534 (con { no-src-span } integer)) - { no-src-span } x-532 + (vardecl { no-src-span } x-540 (con { no-src-span } integer)) + { no-src-span } x-538 ) (lam { no-src-span } - y-533 + y-539 (con { no-src-span } integer) (let { no-src-span } @@ -169,21 +169,21 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } y-535 (con { no-src-span } integer)) - { no-src-span } y-533 + (vardecl { no-src-span } y-541 (con { no-src-span } integer)) + { no-src-span } y-539 ) (termbind { no-src-span } (strict) - (vardecl { no-src-span } b-536 (con { no-src-span } bool)) + (vardecl { no-src-span } b-542 (con { no-src-span } bool)) [ { no-src-span } [ { no-src-span } - { no-src-span } equalsInteger-527 - { no-src-span } x-534 + { no-src-span } equalsInteger-533 + { no-src-span } x-540 ] - { no-src-span } y-535 + { no-src-span } y-541 ] ) [ @@ -194,14 +194,14 @@ { no-src-span } { { no-src-span } - { no-src-span } ifThenElse-525 - { no-src-span } Bool-528 + { no-src-span } ifThenElse-531 + { no-src-span } Bool-534 } - { no-src-span } b-536 + { no-src-span } b-542 ] - { no-src-span } True-529 + { no-src-span } True-535 ] - { no-src-span } False-530 + { no-src-span } False-536 ] ) ) @@ -213,7 +213,7 @@ (strict) (vardecl { no-src-span } - subtractInteger-519 + subtractInteger-525 (fun { no-src-span } (con { no-src-span } integer) @@ -231,7 +231,7 @@ (nonstrict) (vardecl { no-src-span } - subtractInteger-524 + subtractInteger-530 (fun { no-src-span } (con { no-src-span } integer) @@ -244,7 +244,7 @@ ) (lam { no-src-span } - x-520 + x-526 (con { no-src-span } integer) (let { no-src-span } @@ -252,12 +252,12 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } x-522 (con { no-src-span } integer)) - { no-src-span } x-520 + (vardecl { no-src-span } x-528 (con { no-src-span } integer)) + { no-src-span } x-526 ) (lam { no-src-span } - y-521 + y-527 (con { no-src-span } integer) (let { no-src-span } @@ -265,17 +265,17 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } y-523 (con { no-src-span } integer)) - { no-src-span } y-521 + (vardecl { no-src-span } y-529 (con { no-src-span } integer)) + { no-src-span } y-527 ) [ { no-src-span } [ { no-src-span } - { no-src-span } subtractInteger-519 - { no-src-span } x-522 + { no-src-span } subtractInteger-525 + { no-src-span } x-528 ] - { no-src-span } y-523 + { no-src-span } y-529 ] ) ) @@ -290,7 +290,7 @@ (nonstrict) (vardecl { no-src-span } - fib-544 + fib-550 (fun { no-src-span } (con { no-src-span } integer) @@ -299,7 +299,7 @@ ) (lam { no-src-span } - n-545 + n-551 (con { no-src-span } integer) (let { test/Plugin/Debug/Spec.hs:46:15-55:72 } @@ -309,10 +309,10 @@ (strict) (vardecl { test/Plugin/Debug/Spec.hs:46:15-55:72 } - n-546 + n-552 (con { test/Plugin/Debug/Spec.hs:46:15-55:72 } integer) ) - { test/Plugin/Debug/Spec.hs:46:15-55:72 } n-545 + { test/Plugin/Debug/Spec.hs:46:15-55:72 } n-551 ) { { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } @@ -325,15 +325,15 @@ [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } - Bool_match-531 + Bool_match-537 [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } - equalsInteger-537 + equalsInteger-543 { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:47:43-47:43 } - n-546 + n-552 ] (con { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:47:45-47:45 } @@ -344,7 +344,7 @@ ] (all { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } - dead-547 + dead-553 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } type) (con @@ -355,7 +355,7 @@ } (abs { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } - dead-548 + dead-554 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } type) (con @@ -367,7 +367,7 @@ ] (abs { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } - dead-549 + dead-555 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } type) { @@ -381,15 +381,15 @@ [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } - Bool_match-531 + Bool_match-537 [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } - equalsInteger-537 + equalsInteger-543 { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:50:51-50:51 } - n-546 + n-552 ] (con { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:50:53-50:53 } @@ -400,7 +400,7 @@ ] (all { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } - dead-550 + dead-556 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } type) (con @@ -411,7 +411,7 @@ } (abs { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } - dead-551 + dead-557 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } type) (con @@ -423,7 +423,7 @@ ] (abs { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } - dead-552 + dead-558 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } type) [ @@ -431,19 +431,19 @@ [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72 } - addInteger-543 + addInteger-549 [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72 } - fib-544 + fib-550 [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72, test/Plugin/Debug/Spec.hs:54:42-54:71 } [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72, test/Plugin/Debug/Spec.hs:54:42-54:71 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72, test/Plugin/Debug/Spec.hs:54:42-54:71 } - subtractInteger-524 + subtractInteger-530 { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72, test/Plugin/Debug/Spec.hs:54:42-54:71, test/Plugin/Debug/Spec.hs:54:68-54:68 } - n-546 + n-552 ] (con { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72, test/Plugin/Debug/Spec.hs:54:42-54:71, test/Plugin/Debug/Spec.hs:54:70-54:70 } @@ -456,15 +456,15 @@ [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72 } - fib-544 + fib-550 [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71 } [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71 } - subtractInteger-524 + subtractInteger-530 { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71, test/Plugin/Debug/Spec.hs:55:68-55:68 } - n-546 + n-552 ] (con { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71, test/Plugin/Debug/Spec.hs:55:70-55:70 } @@ -478,28 +478,28 @@ ] (all { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } - dead-553 + dead-559 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } type) { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } - dead-553 + dead-559 ) } ) ] (all { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } - dead-554 + dead-560 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } type) { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } - dead-554 + dead-560 ) } ) ) ) - { test/Plugin/Debug/Spec.hs:45:9-57:9 } fib-544 + { test/Plugin/Debug/Spec.hs:45:9-57:9 } fib-550 ) ) ) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden b/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden index e3ff78c1481..acfa5ab236a 100644 --- a/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden @@ -8,11 +8,11 @@ { no-src-span } (datatype { no-src-span } - (tyvardecl { no-src-span } Bool-445 ({ no-src-span } type)) + (tyvardecl { no-src-span } Bool-451 ({ no-src-span } type)) - Bool_match-448 - (vardecl { no-src-span } True-446 { no-src-span } Bool-445) - (vardecl { no-src-span } False-447 { no-src-span } Bool-445) + Bool_match-454 + (vardecl { no-src-span } True-452 { no-src-span } Bool-451) + (vardecl { no-src-span } False-453 { no-src-span } Bool-451) ) ) (termbind @@ -20,7 +20,7 @@ (strict) (vardecl { no-src-span } - equalsInteger-444 + equalsInteger-450 (fun { no-src-span } (con { no-src-span } integer) @@ -38,18 +38,18 @@ (strict) (vardecl { no-src-span } - ifThenElse-442 + ifThenElse-448 (all { no-src-span } - a-443 + a-449 ({ no-src-span } type) (fun { no-src-span } (con { no-src-span } bool) (fun { no-src-span } - { no-src-span } a-443 - (fun { no-src-span } { no-src-span } a-443 { no-src-span } a-443) + { no-src-span } a-449 + (fun { no-src-span } { no-src-span } a-449 { no-src-span } a-449) ) ) ) @@ -61,20 +61,20 @@ (nonstrict) (vardecl { no-src-span } - equalsInteger-454 + equalsInteger-460 (fun { no-src-span } (con { no-src-span } integer) (fun { no-src-span } (con { no-src-span } integer) - { no-src-span } Bool-445 + { no-src-span } Bool-451 ) ) ) (lam { no-src-span } - x-449 + x-455 (con { no-src-span } integer) (let { no-src-span } @@ -82,12 +82,12 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } x-451 (con { no-src-span } integer)) - { no-src-span } x-449 + (vardecl { no-src-span } x-457 (con { no-src-span } integer)) + { no-src-span } x-455 ) (lam { no-src-span } - y-450 + y-456 (con { no-src-span } integer) (let { no-src-span } @@ -95,21 +95,21 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } y-452 (con { no-src-span } integer)) - { no-src-span } y-450 + (vardecl { no-src-span } y-458 (con { no-src-span } integer)) + { no-src-span } y-456 ) (termbind { no-src-span } (strict) - (vardecl { no-src-span } b-453 (con { no-src-span } bool)) + (vardecl { no-src-span } b-459 (con { no-src-span } bool)) [ { no-src-span } [ { no-src-span } - { no-src-span } equalsInteger-444 - { no-src-span } x-451 + { no-src-span } equalsInteger-450 + { no-src-span } x-457 ] - { no-src-span } y-452 + { no-src-span } y-458 ] ) [ @@ -120,14 +120,14 @@ { no-src-span } { { no-src-span } - { no-src-span } ifThenElse-442 - { no-src-span } Bool-445 + { no-src-span } ifThenElse-448 + { no-src-span } Bool-451 } - { no-src-span } b-453 + { no-src-span } b-459 ] - { no-src-span } True-446 + { no-src-span } True-452 ] - { no-src-span } False-447 + { no-src-span } False-453 ] ) ) @@ -136,7 +136,7 @@ ) (lam { no-src-span } - ds-455 + ds-461 (con { no-src-span } integer) (let { test/Plugin/Debug/Spec.hs:38:9-38:87 } @@ -146,14 +146,14 @@ (strict) (vardecl { test/Plugin/Debug/Spec.hs:38:9-38:87 } - ds-457 + ds-463 (con { test/Plugin/Debug/Spec.hs:38:9-38:87 } integer) ) - { test/Plugin/Debug/Spec.hs:38:9-38:87 } ds-455 + { test/Plugin/Debug/Spec.hs:38:9-38:87 } ds-461 ) (lam { no-src-span } - ds-456 + ds-462 (con { no-src-span } integer) (let { test/Plugin/Debug/Spec.hs:38:9-38:87 } @@ -163,22 +163,22 @@ (strict) (vardecl { test/Plugin/Debug/Spec.hs:38:9-38:87 } - ds-458 + ds-464 (con { test/Plugin/Debug/Spec.hs:38:9-38:87 } integer) ) - { test/Plugin/Debug/Spec.hs:38:9-38:87 } ds-456 + { test/Plugin/Debug/Spec.hs:38:9-38:87 } ds-462 ) [ { test/Plugin/Debug/Spec.hs:38:9-38:87, test/Plugin/Debug/Spec.hs:38:44-38:86, test/Plugin/Debug/Spec.hs:38:54-38:79 } [ { test/Plugin/Debug/Spec.hs:38:9-38:87, test/Plugin/Debug/Spec.hs:38:44-38:86, test/Plugin/Debug/Spec.hs:38:54-38:79 } { test/Plugin/Debug/Spec.hs:38:9-38:87, test/Plugin/Debug/Spec.hs:38:44-38:86, test/Plugin/Debug/Spec.hs:38:54-38:79 } - equalsInteger-454 + equalsInteger-460 { test/Plugin/Debug/Spec.hs:38:9-38:87, test/Plugin/Debug/Spec.hs:38:44-38:86, test/Plugin/Debug/Spec.hs:38:54-38:79, test/Plugin/Debug/Spec.hs:38:77-38:77 } - ds-457 + ds-463 ] { test/Plugin/Debug/Spec.hs:38:9-38:87, test/Plugin/Debug/Spec.hs:38:44-38:86, test/Plugin/Debug/Spec.hs:38:54-38:79, test/Plugin/Debug/Spec.hs:38:79-38:79 } - ds-458 + ds-464 ] ) ) diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/writeBits-integerToByteString.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/writeBits-integerToByteString.eval.golden new file mode 100644 index 00000000000..aaac7478dd5 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/writeBits-integerToByteString.eval.golden @@ -0,0 +1 @@ +#00000000002b \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/Spec.hs b/plutus-tx-plugin/test/Plugin/Primitives/Spec.hs index 457e08b47a9..1fabfd93a7a 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Primitives/Spec.hs @@ -74,6 +74,7 @@ primitives = testNested "Primitives" . pure $ testNestedGhc , goldenPir "deconstructorData2" deconstructData2 , goldenUEval "deconstructData2" [ toUPlc deconstructData2, toUPlc constructData2 ] , goldenUEval "deconstructData3" [ toUPlc deconstructData3, toUPlc constructData3 ] + , goldenUEval "writeBits-integerToByteString" [ writeBitsIntegerToByteString ] ] string :: CompiledCode Builtins.BuiltinString @@ -190,3 +191,7 @@ deconstructData3 = plc (Proxy @"deconstructData2") (\(d :: Builtins.BuiltinData) matchData1 :: CompiledCode (Builtins.BuiltinData -> Maybe Integer) matchData1 = plc (Proxy @"matchData1") (\(d :: Builtins.BuiltinData) -> (Builtins.matchData d (\_ _ -> Nothing) (const Nothing) (const Nothing) (Just) (const Nothing))) + +writeBitsIntegerToByteString :: CompiledCode (P.BuiltinByteString) +writeBitsIntegerToByteString = plc (Proxy @"writeBitsIntegerToByteString") + (P.writeBits (P.integerToByteString Builtins.BigEndian 6 15) [0, 2, 5] [True, False, True]) diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt.pir.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt.pir.golden index b714fb429ee..d77b76dda76 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt.pir.golden @@ -13,9 +13,9 @@ program in trace {unit -> integer} - "entering addInteger-129" + "entering addInteger-131" (\(thunk : unit) -> - trace {integer} "exiting addInteger-129" (addInteger x y)) + trace {integer} "exiting addInteger-131" (addInteger x y)) () ~addInt : integer -> integer -> integer = \(x : integer) -> @@ -24,9 +24,9 @@ program in trace {unit -> integer -> integer} - "entering addInt-126" + "entering addInt-128" (\(thunk : unit) -> - trace {integer -> integer} "exiting addInt-126" (addInteger x)) + trace {integer -> integer} "exiting addInt-128" (addInteger x)) () in addInt) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt3.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt3.eval.golden index 9bd01c9535d..66b848fa868 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt3.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt3.eval.golden @@ -1 +1 @@ -[entering addInt-126, exiting addInt-126] \ No newline at end of file +[entering addInt-128, exiting addInt-128] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch1.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch1.eval.golden index 14e3e61691c..19f028f27ca 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch1.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch1.eval.golden @@ -1,6 +1,6 @@ -[ entering runIdentity-129 -, exiting runIdentity-129 -, entering newtypeFunction-137 -, exiting newtypeFunction-137 -, entering `$fFoldableIdentity`-131 -, exiting `$fFoldableIdentity`-131 ] \ No newline at end of file +[ entering runIdentity-131 +, exiting runIdentity-131 +, entering newtypeFunction-139 +, exiting newtypeFunction-139 +, entering `$fFoldableIdentity`-133 +, exiting `$fFoldableIdentity`-133 ] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch2.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch2.eval.golden index b0bc86d7306..866a739a4c8 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch2.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch2.eval.golden @@ -1 +1 @@ -[entering obscuredFunction-127, exiting obscuredFunction-127] \ No newline at end of file +[entering obscuredFunction-129, exiting obscuredFunction-129] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fact4.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fact4.eval.golden index 0d688af7c21..33f55c5979c 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fact4.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fact4.eval.golden @@ -1,36 +1,36 @@ -[ entering fact-126 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, entering subtractInteger-150 -, exiting subtractInteger-150 -, entering fact-126 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, entering subtractInteger-150 -, exiting subtractInteger-150 -, entering fact-126 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, entering subtractInteger-150 -, exiting subtractInteger-150 -, entering fact-126 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, entering subtractInteger-150 -, exiting subtractInteger-150 -, entering fact-126 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, exiting fact-126 -, entering multiplyInteger-144 -, exiting multiplyInteger-144 -, exiting fact-126 -, entering multiplyInteger-144 -, exiting multiplyInteger-144 -, exiting fact-126 -, entering multiplyInteger-144 -, exiting multiplyInteger-144 -, exiting fact-126 -, entering multiplyInteger-144 -, exiting multiplyInteger-144 -, exiting fact-126 ] \ No newline at end of file +[ entering fact-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering subtractInteger-152 +, exiting subtractInteger-152 +, entering fact-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering subtractInteger-152 +, exiting subtractInteger-152 +, entering fact-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering subtractInteger-152 +, exiting subtractInteger-152 +, entering fact-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering subtractInteger-152 +, exiting subtractInteger-152 +, entering fact-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, exiting fact-128 +, entering multiplyInteger-146 +, exiting multiplyInteger-146 +, exiting fact-128 +, entering multiplyInteger-146 +, exiting multiplyInteger-146 +, exiting fact-128 +, entering multiplyInteger-146 +, exiting multiplyInteger-146 +, exiting fact-128 +, entering multiplyInteger-146 +, exiting multiplyInteger-146 +, exiting fact-128 ] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden index 6df2672558c..c53e980e4c4 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden @@ -13,9 +13,9 @@ program in trace {unit -> integer} - "entering addInteger-148" + "entering addInteger-150" (\(thunk : unit) -> - trace {integer} "exiting addInteger-148" (addInteger x y)) + trace {integer} "exiting addInteger-150" (addInteger x y)) () data Bool | Bool_match where True : Bool @@ -33,11 +33,11 @@ program in trace {unit -> Bool} - "entering equalsInteger-133" + "entering equalsInteger-135" (\(thunk : unit) -> trace {Bool} - "exiting equalsInteger-133" + "exiting equalsInteger-135" (let !b : bool = equalsInteger x y in @@ -55,11 +55,11 @@ program in trace {unit -> integer} - "entering subtractInteger-154" + "entering subtractInteger-156" (\(thunk : unit) -> trace {integer} - "exiting subtractInteger-154" + "exiting subtractInteger-156" (subtractInteger x y)) () in @@ -71,11 +71,11 @@ program in trace {unit -> integer} - "entering fib-126" + "entering fib-128" (\(thunk : unit) -> trace {integer} - "exiting fib-126" + "exiting fib-128" (Bool_match (equalsInteger n 0) {all dead. integer} diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib4.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib4.eval.golden index dd4c4ebeacf..693c65f8713 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib4.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib4.eval.golden @@ -1,74 +1,74 @@ -[ entering fib-126 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, entering subtractInteger-154 -, exiting subtractInteger-154 -, entering fib-126 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, entering subtractInteger-154 -, exiting subtractInteger-154 -, entering fib-126 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, entering subtractInteger-154 -, exiting subtractInteger-154 -, entering fib-126 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, exiting fib-126 -, entering subtractInteger-154 -, exiting subtractInteger-154 -, entering fib-126 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, exiting fib-126 -, entering addInteger-148 -, exiting addInteger-148 -, exiting fib-126 -, entering subtractInteger-154 -, exiting subtractInteger-154 -, entering fib-126 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, exiting fib-126 -, entering addInteger-148 -, exiting addInteger-148 -, exiting fib-126 -, entering subtractInteger-154 -, exiting subtractInteger-154 -, entering fib-126 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, entering subtractInteger-154 -, exiting subtractInteger-154 -, entering fib-126 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, exiting fib-126 -, entering subtractInteger-154 -, exiting subtractInteger-154 -, entering fib-126 -, entering equalsInteger-133 -, exiting equalsInteger-133 -, exiting fib-126 -, entering addInteger-148 -, exiting addInteger-148 -, exiting fib-126 -, entering addInteger-148 -, exiting addInteger-148 -, exiting fib-126 ] \ No newline at end of file +[ entering fib-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering subtractInteger-156 +, exiting subtractInteger-156 +, entering fib-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering subtractInteger-156 +, exiting subtractInteger-156 +, entering fib-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering subtractInteger-156 +, exiting subtractInteger-156 +, entering fib-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, exiting fib-128 +, entering subtractInteger-156 +, exiting subtractInteger-156 +, entering fib-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, exiting fib-128 +, entering addInteger-150 +, exiting addInteger-150 +, exiting fib-128 +, entering subtractInteger-156 +, exiting subtractInteger-156 +, entering fib-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, exiting fib-128 +, entering addInteger-150 +, exiting addInteger-150 +, exiting fib-128 +, entering subtractInteger-156 +, exiting subtractInteger-156 +, entering fib-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering subtractInteger-156 +, exiting subtractInteger-156 +, entering fib-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, exiting fib-128 +, entering subtractInteger-156 +, exiting subtractInteger-156 +, entering fib-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, exiting fib-128 +, entering addInteger-150 +, exiting addInteger-150 +, exiting fib-128 +, entering addInteger-150 +, exiting addInteger-150 +, exiting fib-128 ] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/id.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/id.eval.golden index b44a413ba8b..5e31f19d924 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/id.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/id.eval.golden @@ -1 +1 @@ -[entering id-127, exiting id-127, entering id-127, exiting id-127] \ No newline at end of file +[entering id-129, exiting id-129, entering id-129, exiting id-129] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/idCode.pir.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/idCode.pir.golden index 7bb5394e1a3..e8874d71960 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/idCode.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/idCode.pir.golden @@ -6,8 +6,8 @@ program \(x : a) -> trace {unit -> a} - "entering id-127" - (\(thunk : unit) -> trace {a} "exiting id-127" x) + "entering id-129" + (\(thunk : unit) -> trace {a} "exiting id-129" x) () in id {integer} (id {integer} 1)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFun.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFun.eval.golden index 55db6efde8c..e598b91086d 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFun.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFun.eval.golden @@ -1,10 +1,10 @@ -[ entering f-138 -, entering addInteger-132 -, exiting addInteger-132 -, exiting f-138 -, entering f-138 -, entering addInteger-132 -, exiting addInteger-132 -, exiting f-138 -, entering addInteger-132 -, exiting addInteger-132 ] \ No newline at end of file +[ entering f-140 +, entering addInteger-134 +, exiting addInteger-134 +, exiting f-140 +, entering f-140 +, entering addInteger-134 +, exiting addInteger-134 +, exiting f-140 +, entering addInteger-134 +, exiting addInteger-134 ] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFunMoreArg.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFunMoreArg.eval.golden index dcf5f62de33..42995b25478 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFunMoreArg.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFunMoreArg.eval.golden @@ -1,12 +1,12 @@ -[ entering f-140 -, entering addInteger-134 -, exiting addInteger-134 -, exiting f-140 -, entering f-140 -, entering addInteger-134 -, exiting addInteger-134 -, exiting f-140 -, entering addInteger-134 -, exiting addInteger-134 -, entering multiplyInteger-142 -, exiting multiplyInteger-142 ] \ No newline at end of file +[ entering f-142 +, entering addInteger-136 +, exiting addInteger-136 +, exiting f-142 +, entering f-142 +, entering addInteger-136 +, exiting addInteger-136 +, exiting f-142 +, entering addInteger-136 +, exiting addInteger-136 +, entering multiplyInteger-144 +, exiting multiplyInteger-144 ] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/letRecInFun.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/letRecInFun.eval.golden index 29dd653b9b7..dce946b6315 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/letRecInFun.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/letRecInFun.eval.golden @@ -1,28 +1,28 @@ -[ entering f-128 -, entering equalsInteger-135 -, exiting equalsInteger-135 -, entering subtractInteger-152 -, exiting subtractInteger-152 -, entering f-128 -, entering equalsInteger-135 -, exiting equalsInteger-135 -, entering subtractInteger-152 -, exiting subtractInteger-152 -, entering f-128 -, entering equalsInteger-135 -, exiting equalsInteger-135 -, entering subtractInteger-152 -, exiting subtractInteger-152 -, entering f-128 -, entering equalsInteger-135 -, exiting equalsInteger-135 -, exiting f-128 -, entering addInteger-146 -, exiting addInteger-146 -, exiting f-128 -, entering addInteger-146 -, exiting addInteger-146 -, exiting f-128 -, entering addInteger-146 -, exiting addInteger-146 -, exiting f-128 ] \ No newline at end of file +[ entering f-130 +, entering equalsInteger-137 +, exiting equalsInteger-137 +, entering subtractInteger-154 +, exiting subtractInteger-154 +, entering f-130 +, entering equalsInteger-137 +, exiting equalsInteger-137 +, entering subtractInteger-154 +, exiting subtractInteger-154 +, entering f-130 +, entering equalsInteger-137 +, exiting equalsInteger-137 +, entering subtractInteger-154 +, exiting subtractInteger-154 +, entering f-130 +, entering equalsInteger-137 +, exiting equalsInteger-137 +, exiting f-130 +, entering addInteger-148 +, exiting addInteger-148 +, exiting f-130 +, entering addInteger-148 +, exiting addInteger-148 +, exiting f-130 +, entering addInteger-148 +, exiting addInteger-148 +, exiting f-130 ] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/swap.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/swap.eval.golden index 95ccf2e19ca..ea3312abd43 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/swap.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/swap.eval.golden @@ -1 +1 @@ -[entering swap-133, exiting swap-133] \ No newline at end of file +[entering swap-135, exiting swap-135] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/typeclass.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/typeclass.eval.golden index fe995dbadbe..5698abc5173 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/typeclass.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/typeclass.eval.golden @@ -1,12 +1,12 @@ -[ entering useTypeclass-135 -, entering methodA-149 -, exiting methodA-149 -, entering addInteger-142 -, exiting addInteger-142 -, entering methodB-160 -, exiting methodB-160 -, entering subtractInteger-172 -, exiting subtractInteger-172 -, entering addInteger-142 -, exiting addInteger-142 -, exiting useTypeclass-135 ] \ No newline at end of file +[ entering useTypeclass-137 +, entering methodA-151 +, exiting methodA-151 +, entering addInteger-144 +, exiting addInteger-144 +, entering methodB-162 +, exiting methodB-162 +, entering subtractInteger-174 +, exiting subtractInteger-174 +, entering addInteger-144 +, exiting addInteger-144 +, exiting useTypeclass-137 ] \ No newline at end of file diff --git a/plutus-tx/src/PlutusTx/Builtins.hs b/plutus-tx/src/PlutusTx/Builtins.hs index 6b439ae23fb..65a6fc6ecf9 100644 --- a/plutus-tx/src/PlutusTx/Builtins.hs +++ b/plutus-tx/src/PlutusTx/Builtins.hs @@ -108,9 +108,10 @@ module PlutusTx.Builtins ( , toOpaque , fromBuiltin , toBuiltin + -- * Logical + , ByteOrder (..) , integerToByteString , byteStringToInteger - -- * Logical , andByteString , orByteString , xorByteString @@ -350,7 +351,7 @@ remainderInteger x y = fromOpaque (BI.remainderInteger (toOpaque x) (toOpaque y) {-# INLINABLE greaterThanInteger #-} -- | Check whether one 'Integer' is greater than another. greaterThanInteger :: Integer -> Integer -> Bool -greaterThanInteger x y = BI.ifThenElse (BI.lessThanEqualsInteger x y ) False True +greaterThanInteger x y = BI.ifThenElse (BI.lessThanEqualsInteger x y) False True {-# INLINABLE greaterThanEqualsInteger #-} -- | Check whether one 'Integer' is greater than or equal to another. @@ -636,6 +637,7 @@ bls12_381_finalVerify a b = fromOpaque (BI.bls12_381_finalVerify a b) byteOrderToBool :: ByteOrder -> Bool byteOrderToBool BigEndian = True byteOrderToBool LittleEndian = False +{-# INLINABLE byteOrderToBool #-} -- | Convert a 'BuiltinInteger' into a 'BuiltinByteString', as described in -- [CIP-121](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0121). @@ -823,7 +825,7 @@ writeBits :: [Integer] -> [Bool] -> BuiltinByteString -writeBits bs ixes bits = BI.writeBits bs (toBuiltin ixes) (toBuiltin bits) +writeBits bs ixes bits = BI.writeBits bs (toOpaque ixes) (toOpaque 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 diff --git a/plutus-tx/src/PlutusTx/Builtins/HasOpaque.hs b/plutus-tx/src/PlutusTx/Builtins/HasOpaque.hs index f0a643ce192..13e28652e18 100644 --- a/plutus-tx/src/PlutusTx/Builtins/HasOpaque.hs +++ b/plutus-tx/src/PlutusTx/Builtins/HasOpaque.hs @@ -204,6 +204,18 @@ instance HasFromOpaque BuiltinBool Bool where fromOpaque b = ifThenElse b True False {-# INLINABLE fromOpaque #-} +instance HasToOpaque [BuiltinInteger] (BuiltinList BuiltinInteger) where + toOpaque = goList where + goList :: [BuiltinInteger] -> BuiltinList BuiltinInteger + goList [] = mkNilInteger + goList (d:ds) = mkCons (toOpaque d) (goList ds) + {-# INLINABLE toOpaque #-} +instance HasToOpaque [Bool] (BuiltinList BuiltinBool) where + toOpaque = goList where + goList :: [Bool] -> BuiltinList BuiltinBool + goList [] = mkNilBool + goList (d:ds) = mkCons (toOpaque d) (goList ds) + {-# INLINABLE toOpaque #-} instance HasToOpaque [BuiltinData] (BuiltinList BuiltinData) where toOpaque = goList where goList :: [BuiltinData] -> BuiltinList BuiltinData diff --git a/plutus-tx/src/PlutusTx/Builtins/Internal.hs b/plutus-tx/src/PlutusTx/Builtins/Internal.hs index 690d899a92b..8960ded91f4 100644 --- a/plutus-tx/src/PlutusTx/Builtins/Internal.hs +++ b/plutus-tx/src/PlutusTx/Builtins/Internal.hs @@ -403,6 +403,14 @@ chooseList :: BuiltinList a -> b -> b -> b chooseList (BuiltinList []) b1 _ = b1 chooseList (BuiltinList (_:_)) _ b2 = b2 +{-# NOINLINE mkNilInteger #-} +mkNilInteger :: BuiltinList BuiltinInteger +mkNilInteger = BuiltinList [] + +{-# NOINLINE mkNilBool #-} +mkNilBool :: BuiltinList BuiltinBool +mkNilBool = BuiltinList [] + {-# NOINLINE mkNilData #-} mkNilData :: BuiltinUnit -> BuiltinList BuiltinData mkNilData _ = BuiltinList [] From bfac69f8681376b6f7e34df461efec0326b0363a Mon Sep 17 00:00:00 2001 From: effectfully Date: Fri, 26 Jul 2024 05:47:16 +0200 Subject: [PATCH 3/7] [Plinth] Ban using 'toBuiltin' and 'fromBuiltin' (#6342) It used to be possible to use `toBuiltin`/`fromBuiltin` within a smart contract, but this is no longer the case, but this isn't obvious to the users as they already have code with `toBuiltin`/`fromBuiltin` that now just misbehaves instead of throwing a type error or breaking compilation some other way. This fixes the problem by throwing on any usage of `toBuiltin`/`fromBuiltin` with a suggestion to use `toOpaque`/`fromOpaque` instead. --- .../src/PlutusTx/Compiler/Expr.hs | 8 ++++ plutus-tx-plugin/src/PlutusTx/Plugin.hs | 3 ++ .../Errors/9.6/fromBuiltinUsed.uplc.golden | 1 + .../Errors/9.6/toBuiltinUsed.uplc.golden | 1 + plutus-tx-plugin/test/Plugin/Errors/Spec.hs | 8 ++++ plutus-tx/src/PlutusTx/Builtins.hs | 2 + plutus-tx/src/PlutusTx/Builtins/HasBuiltin.hs | 38 +++++++++++++------ plutus-tx/src/PlutusTx/IsData/Class.hs | 14 ++----- 8 files changed, 52 insertions(+), 23 deletions(-) create mode 100644 plutus-tx-plugin/test/Plugin/Errors/9.6/fromBuiltinUsed.uplc.golden create mode 100644 plutus-tx-plugin/test/Plugin/Errors/9.6/toBuiltinUsed.uplc.golden diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs index ae037a1a605..2320dda3fa7 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs @@ -688,6 +688,8 @@ compileExpr e = traceCompilation 2 ("Compiling expr:" GHC.<+> GHC.ppr e) $ do (Just t1, Just t2) -> pure (GHC.getName t1, GHC.getName t2) _ -> throwPlain $ CompilationError "No info for ByteString builtin" + useToOpaqueName <- GHC.getName <$> getThing 'Builtins.useToOpaque + useFromOpaqueName <- GHC.getName <$> getThing 'Builtins.useFromOpaque boolOperatorOr <- GHC.getName <$> getThing '(PlutusTx.Bool.||) boolOperatorAnd <- GHC.getName <$> getThing '(PlutusTx.Bool.&&) case e of @@ -775,6 +777,12 @@ compileExpr e = traceCompilation 2 ("Compiling expr:" GHC.<+> GHC.ppr e) $ do -- GHC.Var (isErrorId -> True) `GHC.App` GHC.Type t `GHC.App` _ -> PIR.TyInst annMayInline <$> errorFunc <*> compileTypeNorm t + GHC.Var n + | GHC.getName n == useToOpaqueName -> + throwPlain $ UnsupportedError "It is no longer possible to use 'toBuiltin' with a script, use 'toOpaque' instead" + GHC.Var n + | GHC.getName n == useFromOpaqueName -> + throwPlain $ UnsupportedError "It is no longer possible to use 'fromBuiltin' with a script, use 'fromOpaque' instead" -- See Note [Uses of Eq] GHC.Var n | GHC.getName n == GHC.eqName -> diff --git a/plutus-tx-plugin/src/PlutusTx/Plugin.hs b/plutus-tx-plugin/src/PlutusTx/Plugin.hs index 585bd3750bd..d7ffa3cfdff 100644 --- a/plutus-tx-plugin/src/PlutusTx/Plugin.hs +++ b/plutus-tx-plugin/src/PlutusTx/Plugin.hs @@ -21,6 +21,7 @@ module PlutusTx.Plugin (plugin, plc) where import Data.Bifunctor import PlutusPrelude import PlutusTx.Bool ((&&), (||)) +import PlutusTx.Builtins.HasBuiltin (useFromOpaque, useToOpaque) import PlutusTx.Code import PlutusTx.Compiler.Builtins import PlutusTx.Compiler.Error @@ -405,6 +406,8 @@ compileMarkedExpr locStr codeTy origE = do , 'GHC.Num.Integer.integerNegate , '(PlutusTx.Bool.&&) , '(PlutusTx.Bool.||) + , 'useToOpaque + , 'useFromOpaque ] modBreaks <- asks pcModuleModBreaks let coverage = CoverageOpts . Set.fromList $ diff --git a/plutus-tx-plugin/test/Plugin/Errors/9.6/fromBuiltinUsed.uplc.golden b/plutus-tx-plugin/test/Plugin/Errors/9.6/fromBuiltinUsed.uplc.golden new file mode 100644 index 00000000000..996893d1852 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Errors/9.6/fromBuiltinUsed.uplc.golden @@ -0,0 +1 @@ +Error: Unsupported feature: It is no longer possible to use 'fromBuiltin' with a script, use 'fromOpaque' instead \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Errors/9.6/toBuiltinUsed.uplc.golden b/plutus-tx-plugin/test/Plugin/Errors/9.6/toBuiltinUsed.uplc.golden new file mode 100644 index 00000000000..4342e24482e --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Errors/9.6/toBuiltinUsed.uplc.golden @@ -0,0 +1 @@ +Error: Unsupported feature: It is no longer possible to use 'toBuiltin' with a script, use 'toOpaque' instead \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Errors/Spec.hs b/plutus-tx-plugin/test/Plugin/Errors/Spec.hs index 11abfde85f4..391c5d2d76f 100644 --- a/plutus-tx-plugin/test/Plugin/Errors/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Errors/Spec.hs @@ -50,6 +50,8 @@ errors = testNested "Errors" . pure $ testNestedGhc , goldenUPlc "rangeEnumFromThenTo" rangeEnumFromThenTo , goldenUPlc "rangeEnumFrom" rangeEnumFrom , goldenUPlc "rangeEnumFromThen" rangeEnumFromThen + , goldenUPlc "toBuiltinUsed" toBuiltinUsed + , goldenUPlc "fromBuiltinUsed" fromBuiltinUsed ] machInt :: CompiledCode Int @@ -114,3 +116,9 @@ rangeEnumFrom = plc (Proxy @"rangeEnumFrom") [1..] rangeEnumFromThen :: CompiledCode [Integer] rangeEnumFromThen = plc (Proxy @"rangeEnumFromThen") [1,5..] + +toBuiltinUsed :: CompiledCode (Integer -> Integer) +toBuiltinUsed = plc (Proxy @"toBuiltinUsed") Builtins.toBuiltin + +fromBuiltinUsed :: CompiledCode (Integer -> Integer) +fromBuiltinUsed = plc (Proxy @"fromBuiltinUsed") Builtins.fromBuiltin diff --git a/plutus-tx/src/PlutusTx/Builtins.hs b/plutus-tx/src/PlutusTx/Builtins.hs index 65a6fc6ecf9..513d6e37587 100644 --- a/plutus-tx/src/PlutusTx/Builtins.hs +++ b/plutus-tx/src/PlutusTx/Builtins.hs @@ -106,6 +106,8 @@ module PlutusTx.Builtins ( -- * Conversions , fromOpaque , toOpaque + , useToOpaque + , useFromOpaque , fromBuiltin , toBuiltin -- * Logical diff --git a/plutus-tx/src/PlutusTx/Builtins/HasBuiltin.hs b/plutus-tx/src/PlutusTx/Builtins/HasBuiltin.hs index 85c509955fe..30cd0dc7beb 100644 --- a/plutus-tx/src/PlutusTx/Builtins/HasBuiltin.hs +++ b/plutus-tx/src/PlutusTx/Builtins/HasBuiltin.hs @@ -19,6 +19,20 @@ import Data.ByteString (ByteString) import Data.Kind qualified as GHC import Data.Text (Text) +{- Note [useToOpaque and useFromOpaque] +It used to be possible to use 'toBuiltin'/'fromBuiltin' within a smart contract, but this is no +longer the case, hence we throw a compilation error suggesting to use 'toOpaque'/'fromOpaque' +instead. +-} + +useToOpaque :: a -> a +useToOpaque x = x +{-# OPAQUE useToOpaque #-} + +useFromOpaque :: a -> a +useFromOpaque x = x +{-# OPAQUE useFromOpaque #-} + -- Also see Note [Built-in types and their Haskell counterparts]. -- | A class for converting values of Haskell-defined built-in types to their Plutus Tx -- counterparts. @@ -37,42 +51,42 @@ class HasToBuiltin (FromBuiltin arep) => HasFromBuiltin arep where instance HasToBuiltin Integer where type ToBuiltin Integer = BuiltinInteger - toBuiltin = id + toBuiltin = useToOpaque id instance HasFromBuiltin BuiltinInteger where type FromBuiltin BuiltinInteger = Integer - fromBuiltin = id + fromBuiltin = useFromOpaque id instance HasToBuiltin ByteString where type ToBuiltin ByteString = BuiltinByteString - toBuiltin = BuiltinByteString + toBuiltin = useToOpaque BuiltinByteString instance HasFromBuiltin BuiltinByteString where type FromBuiltin BuiltinByteString = ByteString - fromBuiltin (BuiltinByteString b) = b + fromBuiltin = useFromOpaque $ \(BuiltinByteString b) -> b instance HasToBuiltin Text where type ToBuiltin Text = BuiltinString - toBuiltin = BuiltinString + toBuiltin = useToOpaque BuiltinString instance HasFromBuiltin BuiltinString where type FromBuiltin BuiltinString = Text fromBuiltin (BuiltinString t) = t instance HasToBuiltin () where type ToBuiltin () = BuiltinUnit - toBuiltin = BuiltinUnit + toBuiltin = useToOpaque BuiltinUnit instance HasFromBuiltin BuiltinUnit where type FromBuiltin BuiltinUnit = () fromBuiltin (BuiltinUnit u) = u instance HasToBuiltin Bool where type ToBuiltin Bool = BuiltinBool - toBuiltin = BuiltinBool + toBuiltin = useToOpaque BuiltinBool instance HasFromBuiltin BuiltinBool where type FromBuiltin BuiltinBool = Bool fromBuiltin (BuiltinBool b) = b instance HasToBuiltin a => HasToBuiltin [a] where type ToBuiltin [a] = BuiltinList (ToBuiltin a) - toBuiltin = BuiltinList . map toBuiltin + toBuiltin = useToOpaque BuiltinList . map toBuiltin instance HasFromBuiltin a => HasFromBuiltin (BuiltinList a) where type FromBuiltin (BuiltinList a) = [FromBuiltin a] fromBuiltin (BuiltinList xs) = map fromBuiltin xs @@ -86,28 +100,28 @@ instance (HasFromBuiltin a, HasFromBuiltin b) => HasFromBuiltin (BuiltinPair a b instance HasToBuiltin Data where type ToBuiltin Data = BuiltinData - toBuiltin = BuiltinData + toBuiltin = useToOpaque BuiltinData instance HasFromBuiltin BuiltinData where type FromBuiltin BuiltinData = Data fromBuiltin (BuiltinData t) = t instance HasToBuiltin BLS12_381.G1.Element where type ToBuiltin BLS12_381.G1.Element = BuiltinBLS12_381_G1_Element - toBuiltin = BuiltinBLS12_381_G1_Element + toBuiltin = useToOpaque BuiltinBLS12_381_G1_Element instance HasFromBuiltin BuiltinBLS12_381_G1_Element where type FromBuiltin BuiltinBLS12_381_G1_Element = BLS12_381.G1.Element fromBuiltin (BuiltinBLS12_381_G1_Element a) = a instance HasToBuiltin BLS12_381.G2.Element where type ToBuiltin BLS12_381.G2.Element = BuiltinBLS12_381_G2_Element - toBuiltin = BuiltinBLS12_381_G2_Element + toBuiltin = useToOpaque BuiltinBLS12_381_G2_Element instance HasFromBuiltin BuiltinBLS12_381_G2_Element where type FromBuiltin BuiltinBLS12_381_G2_Element = BLS12_381.G2.Element fromBuiltin (BuiltinBLS12_381_G2_Element a) = a instance HasToBuiltin BLS12_381.Pairing.MlResult where type ToBuiltin BLS12_381.Pairing.MlResult = BuiltinBLS12_381_MlResult - toBuiltin = BuiltinBLS12_381_MlResult + toBuiltin = useToOpaque BuiltinBLS12_381_MlResult instance HasFromBuiltin BuiltinBLS12_381_MlResult where type FromBuiltin BuiltinBLS12_381_MlResult = BLS12_381.Pairing.MlResult fromBuiltin (BuiltinBLS12_381_MlResult a) = a diff --git a/plutus-tx/src/PlutusTx/IsData/Class.hs b/plutus-tx/src/PlutusTx/IsData/Class.hs index 7f7ca8de889..509d801579c 100644 --- a/plutus-tx/src/PlutusTx/IsData/Class.hs +++ b/plutus-tx/src/PlutusTx/IsData/Class.hs @@ -11,10 +11,8 @@ {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} module PlutusTx.IsData.Class where -import Prelude qualified as Haskell (Either (..), Int, error) +import Prelude qualified as Haskell (Int, error) -import PlutusCore.Crypto.BLS12_381.G1 qualified as BLS12_381.G1 -import PlutusCore.Crypto.BLS12_381.G2 qualified as BLS12_381.G2 import PlutusCore.Data qualified as PLC import PlutusTx.Base import PlutusTx.Builtins as Builtins @@ -159,10 +157,7 @@ instance FromData Builtins.BuiltinBLS12_381_G1_Element where fromBuiltinData d = case fromBuiltinData d of Nothing -> Nothing - Just (BI.BuiltinByteString bs) -> - case BLS12_381.G1.uncompress bs of - Haskell.Left _ -> Nothing - Haskell.Right g -> Just $ toBuiltin g + Just bs -> Just $ bls12_381_G1_uncompress bs instance UnsafeFromData Builtins.BuiltinBLS12_381_G1_Element where {-# INLINABLE unsafeFromBuiltinData #-} unsafeFromBuiltinData = Builtins.bls12_381_G1_uncompress . unsafeFromBuiltinData @@ -175,10 +170,7 @@ instance FromData Builtins.BuiltinBLS12_381_G2_Element where fromBuiltinData d = case fromBuiltinData d of Nothing -> Nothing - Just (BI.BuiltinByteString bs) -> - case BLS12_381.G2.uncompress bs of - Haskell.Left _ -> Nothing - Haskell.Right g -> Just $ toBuiltin g + Just bs -> Just $ bls12_381_G2_uncompress bs instance UnsafeFromData Builtins.BuiltinBLS12_381_G2_Element where {-# INLINABLE unsafeFromBuiltinData #-} unsafeFromBuiltinData = Builtins.bls12_381_G2_uncompress . unsafeFromBuiltinData From 5571f534452d44ffd75eb420e0e44d45a94cc82c Mon Sep 17 00:00:00 2001 From: Kenneth MacKenzie Date: Fri, 26 Jul 2024 06:37:00 +0100 Subject: [PATCH 4/7] Kwxm/bitwise/enable nqueens benchmark (#6343) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This enables the bitwise `nqueens` benchmark following the fix for `writeBits` in Plinth in #6309. ``` $ cabal bench bitwise-bench Build profile: -w ghc-9.6.6 -O1 In order, the following will be built (use -v for more details): - plutus-benchmark-0.1.0.0 (bench:bitwise-bench) (first run) Preprocessing benchmark 'bitwise-bench' for plutus-benchmark-0.1.0.0... Building benchmark 'bitwise-bench' for plutus-benchmark-0.1.0.0... Running 1 benchmarks... Benchmark bitwise-bench: RUNNING... benchmarking 8-queens time 683.4 ms (681.5 ms .. 685.0 ms) 1.000 R² (1.000 R² .. 1.000 R²) mean 678.6 ms (674.1 ms .. 680.4 ms) std dev 3.211 ms (92.63 μs .. 3.978 ms) variance introduced by outliers: 19% (moderately inflated) Benchmark bitwise-bench: FINISH ``` --- plutus-benchmark/bitwise/bench/Main.hs | 14 +++++--------- plutus-benchmark/plutus-benchmark.cabal | 14 +++++++------- 2 files changed, 12 insertions(+), 16 deletions(-) diff --git a/plutus-benchmark/bitwise/bench/Main.hs b/plutus-benchmark/bitwise/bench/Main.hs index 110b460cb2e..8841ffac3ce 100644 --- a/plutus-benchmark/bitwise/bench/Main.hs +++ b/plutus-benchmark/bitwise/bench/Main.hs @@ -1,17 +1,14 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} + module Main (main) where -{- import Criterion.Main (bench, defaultMain) import PlutusBenchmark.Common (benchProgramCek, mkMostRecentEvalCtx) import PlutusBenchmark.NQueens (nqueens) import PlutusTx.Code (CompiledCode, getPlcNoAnn) +import PlutusTx.Plugin () import PlutusTx.TH (compile) --} - -main :: IO () -main = print "Pending" - -{- Currently not able to run, due to problems with writeBits compiling under PlutusTx main :: IO () main = defaultMain [ @@ -21,6 +18,5 @@ main = defaultMain [ -- Helpers nqueensCompiled :: CompiledCode [(Integer, Integer)] -nqueensCompiled = $$(compile [||nqueens 8||]) +nqueensCompiled = $$(compile [|| nqueens 8 ||]) --} diff --git a/plutus-benchmark/plutus-benchmark.cabal b/plutus-benchmark/plutus-benchmark.cabal index 28fd92ad75f..ebf9dfa8c8f 100644 --- a/plutus-benchmark/plutus-benchmark.cabal +++ b/plutus-benchmark/plutus-benchmark.cabal @@ -618,10 +618,10 @@ benchmark bitwise-bench type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: bitwise/bench - build-depends: base >=4.9 && <5 - --- , bitwise-internal --- , criterion --- , plutus-benchmark-common --- , plutus-tx ^>=1.30 --- , plutus-tx-plugin ^>=1.30 + build-depends: + , base >=4.9 && <5 + , bitwise-internal + , criterion + , plutus-benchmark-common + , plutus-tx ^>=1.31 + , plutus-tx-plugin ^>=1.31 From c7eb24c72f3be0e9fd218dc340d297d7c9356530 Mon Sep 17 00:00:00 2001 From: Nikolaos Bezirgiannis <329939+bezirg@users.noreply.github.com> Date: Fri, 26 Jul 2024 15:06:01 +0200 Subject: [PATCH 5/7] [plc] Support for `Natural` numbers in the default universe, backed by `Integer`. (#6346) Co-authored-by: Nikolaos Bezirgiannis --- .../20240726_102834_bezirg_ratinteger.md | 3 +++ .../src/PlutusCore/Default/Universe.hs | 20 +++++++++++++++++++ 2 files changed, 23 insertions(+) create mode 100644 plutus-core/changelog.d/20240726_102834_bezirg_ratinteger.md diff --git a/plutus-core/changelog.d/20240726_102834_bezirg_ratinteger.md b/plutus-core/changelog.d/20240726_102834_bezirg_ratinteger.md new file mode 100644 index 00000000000..f36093e1e41 --- /dev/null +++ b/plutus-core/changelog.d/20240726_102834_bezirg_ratinteger.md @@ -0,0 +1,3 @@ +### Added + +- Support for `Natural` numbers in the default universe, backed by `Integer`. diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs index 104384f12e8..cfbd2049199 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs @@ -489,6 +489,26 @@ deriving newtype instance KnownBuiltinTypeIn DefaultUni term [a] => deriving newtype instance KnownBuiltinTypeIn DefaultUni term [a] => ReadKnownIn DefaultUni term (ListCostedByLength a) +deriving via AsInteger Natural instance + KnownTypeAst tyname DefaultUni Natural +deriving via AsInteger Natural instance HasConstantIn DefaultUni term => + MakeKnownIn DefaultUni term Natural +instance HasConstantIn DefaultUni term => ReadKnownIn DefaultUni term Natural where + readKnown term = + -- See Note [Performance of ReadKnownIn and MakeKnownIn instances]. + -- Funnily, we don't need 'inline' here, unlike in the default implementation of 'readKnown' + -- (go figure why). + inline readKnownConstant term >>= oneShot \(i :: Integer) -> + -- TODO: benchmark alternatives:signumInteger,integerIsNegative,integerToNaturalThrow + if i >= 0 + -- TODO: benchmark alternatives: ghc8.10 naturalFromInteger, ghc>=9 integerToNatural + then pure $ fromInteger i + else throwing _OperationalUnliftingError . MkUnliftingError $ fold + [ Text.pack $ show i + , " is not within the bounds of Natural" + ] + {-# INLINE readKnown #-} + {- Note [Stable encoding of tags] 'encodeUni' and 'decodeUni' are used for serialisation and deserialisation of types from the universe and we need serialised things to be extremely stable, hence the definitions of 'encodeUni' From f74023ec043bd28d4fd16008f61b8d5d138cc73f Mon Sep 17 00:00:00 2001 From: Yura Lazarev <1009751+Unisay@users.noreply.github.com> Date: Sat, 27 Jul 2024 14:21:12 +0200 Subject: [PATCH 6/7] nothunks ^>= 0.2 (#6349) --- cabal.project | 5 ----- .../20240726_165736_Yuriy.Lazaryev_nothunks_0_2.md | 3 +++ plutus-core/plutus-core.cabal | 2 +- plutus-core/plutus-core/src/PlutusCore/Builtin/Runtime.hs | 2 +- plutus-ledger-api/test/Spec/Eval.hs | 4 ++-- 5 files changed, 7 insertions(+), 9 deletions(-) create mode 100644 plutus-core/changelog.d/20240726_165736_Yuriy.Lazaryev_nothunks_0_2.md diff --git a/cabal.project b/cabal.project index 69630a4b6e7..19b5afd2622 100644 --- a/cabal.project +++ b/cabal.project @@ -92,9 +92,4 @@ constraints: -- The API has changed for version 2.2, ledger depends on the old version and ledger will not -- be updated until after the Conway release. , cardano-crypto-class ^>= 2.1 - -- Later versions have API changes. - , nothunks ^>= 0.1.5 - -allow-newer: - , nothunks:containers diff --git a/plutus-core/changelog.d/20240726_165736_Yuriy.Lazaryev_nothunks_0_2.md b/plutus-core/changelog.d/20240726_165736_Yuriy.Lazaryev_nothunks_0_2.md new file mode 100644 index 00000000000..5fdd7f1e24a --- /dev/null +++ b/plutus-core/changelog.d/20240726_165736_Yuriy.Lazaryev_nothunks_0_2.md @@ -0,0 +1,3 @@ +### Changed + +- Updated version boundaries for the `nothunks` dependency (^>=0.2) diff --git a/plutus-core/plutus-core.cabal b/plutus-core/plutus-core.cabal index e298e47e3c6..7fa5a16aa41 100644 --- a/plutus-core/plutus-core.cabal +++ b/plutus-core/plutus-core.cabal @@ -318,7 +318,7 @@ library , monoidal-containers , mtl , multiset - , nothunks ^>=0.1.5 + , nothunks ^>=0.2 , parser-combinators >=0.4.0 , prettyprinter >=1.1.0.1 , prettyprinter-configurable ^>=1.31 diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/Runtime.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/Runtime.hs index 805962c2c62..c6d5e39d567 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Builtin/Runtime.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Builtin/Runtime.hs @@ -38,7 +38,7 @@ instance NoThunks (BuiltinRuntime val) where wNoThunks ctx = \case -- Unreachable, because we don't allow nullary builtins and the 'BuiltinArrow' case only -- checks for WHNF without recursing. Hence we can throw if we reach this clause somehow. - BuiltinCostedResult _ _ -> pure . Just $ ThunkInfo ctx + BuiltinCostedResult _ _ -> pure . Just . ThunkInfo $ Left ctx -- This one doesn't do much. It only checks that the function stored in the 'BuiltinArrow' -- is in WHNF. The function may contain thunks inside of it. Not sure if it's possible to do -- better, since the final 'BuiltinCostedResult' contains a thunk for the result of the diff --git a/plutus-ledger-api/test/Spec/Eval.hs b/plutus-ledger-api/test/Spec/Eval.hs index c16cb6251f4..9fad9b0546c 100644 --- a/plutus-ledger-api/test/Spec/Eval.hs +++ b/plutus-ledger-api/test/Spec/Eval.hs @@ -114,8 +114,8 @@ evaluationContextCacheIsComplete = failIfThunk :: Show a => Maybe a -> IO () failIfThunk mbThunkInfo = - whenJust mbThunkInfo $ \thunkInfo -> - assertFailure $ "Unexpected thunk: " <> show thunkInfo + whenJust mbThunkInfo $ \thunk -> + assertFailure $ "Unexpected thunk: " <> show thunk -- | Ensure that no 'EvaluationContext' has thunks in it for all language versions. evaluationContextNoThunks :: TestTree From 613ab5f1716430b8122a8688c899b2705d9d2722 Mon Sep 17 00:00:00 2001 From: Kenneth MacKenzie Date: Mon, 29 Jul 2024 12:07:31 +0100 Subject: [PATCH 7/7] Make NumBytesCostedAsNumWords use Integer instead of Int (#6350) The `NumBytesCostedAsNumWords` wrapper contained an `Int`, but this changes it to `Integer` for consistency with the other wrappers. This change also affects the type of `Bitwise.replicateByte`. --- .../budgeting-bench/Benchmarks/Bitwise.hs | 8 +--- .../plutus-core/src/PlutusCore/Bitwise.hs | 43 +++++++++---------- .../src/PlutusCore/Default/Builtins.hs | 8 +--- .../Evaluation/Machine/ExMemoryUsage.hs | 14 +++++- .../test/Evaluation/Builtins/Conversion.hs | 19 ++++---- plutus-tx/src/PlutusTx/Builtins/Internal.hs | 2 +- 6 files changed, 47 insertions(+), 47 deletions(-) diff --git a/plutus-core/cost-model/budgeting-bench/Benchmarks/Bitwise.hs b/plutus-core/cost-model/budgeting-bench/Benchmarks/Bitwise.hs index d3621bc7301..0af273555ff 100644 --- a/plutus-core/cost-model/budgeting-bench/Benchmarks/Bitwise.hs +++ b/plutus-core/cost-model/budgeting-bench/Benchmarks/Bitwise.hs @@ -46,10 +46,6 @@ topBitIndex s = fromIntegral $ 8*(BS.length s)-1 memoryUsageAsNumBytes :: ExMemoryUsage a => a -> Int memoryUsageAsNumBytes = (8*) . fromSatInt . sumCostStream . flattenCostRose . memoryUsage --- An explicit conversion to avoid some type annotations later. -integerToInt :: Integer -> Int -integerToInt = fromIntegral - {- Experiments show that the times for big-endian and little-endian `byteStringToInteger` conversions are very similar, with big-endian conversion perhaps taking a fraction longer. We just generate a costing @@ -81,7 +77,7 @@ benchIntegerToByteString = -- The minimum width of bytestring needed to fit the inputs into. widthsInBytes = fmap (fromIntegral . memoryUsageAsNumBytes) inputs in createThreeTermBuiltinBenchElementwiseWithWrappers - (id, NumBytesCostedAsNumWords . integerToInt, id) b [] $ + (id, NumBytesCostedAsNumWords, id) b [] $ zip3 (repeat True) widthsInBytes inputs {- For `andByteString` with different-sized inputs, calling it with extension @@ -174,7 +170,7 @@ benchReplicateByte = -- ^ This gives us replication counts up to 64*128 = 8192, the maximum allowed. inputs = pairWith (const (0xFF::Integer)) xs in createTwoTermBuiltinBenchElementwiseWithWrappers - (NumBytesCostedAsNumWords . fromIntegral, id) ReplicateByte [] inputs + (NumBytesCostedAsNumWords, id) ReplicateByte [] inputs {- Benchmarks with varying sizes of bytestrings and varying amounts of shifting show that the execution time of `shiftByteString` depends linearly on the diff --git a/plutus-core/plutus-core/src/PlutusCore/Bitwise.hs b/plutus-core/plutus-core/src/PlutusCore/Bitwise.hs index 8f41cfd9078..d43f0d49020 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Bitwise.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Bitwise.hs @@ -14,7 +14,7 @@ module PlutusCore.Bitwise ( rotateByteStringWrapper, -- * Implementation details IntegerToByteStringError (..), - integerToByteStringMaximumOutputLength, + maximumOutputLength, integerToByteString, byteStringToInteger, andByteString, @@ -53,20 +53,17 @@ import GHC.Exts (Int (I#)) import GHC.Integer.Logarithms (integerLog2#) import GHC.IO.Unsafe (unsafeDupablePerformIO) -{- Note [Input length limitation for IntegerToByteString]. We make - `integerToByteString` fail if it is called with arguments which would cause - the length of the result to exceed about 8K bytes because the execution time - becomes difficult to predict accurately beyond this point (benchmarks on a - number of different machines show that the CPU time increases smoothly for - inputs up to about 8K then increases sharply, becoming chaotic after about - 14K). This restriction may be removed once a more efficient implementation - becomes available, which may happen when we no longer have to support GHC - 8.10. -} -{- NB: if we do relax the length restriction then we will need two variants of - integerToByteString in Plutus Core so that we can continue to support the - current behaviour for old scripts.-} -integerToByteStringMaximumOutputLength :: Integer -integerToByteStringMaximumOutputLength = 8192 +{- Note [Input length limitation for IntegerToByteString]. +We make `integerToByteString` and `replicateByte` fail if they're called with arguments which would +cause the length of the result to exceed about 8K bytes because the execution time becomes difficult +to predict accurately beyond this point (benchmarks on a number of different machines show that the +CPU time increases smoothly for inputs up to about 8K then increases sharply, becoming chaotic after +about 14K). This restriction may be removed once a more efficient implementation becomes available, +which may happen when we no longer have to support GHC 8.10. -} +{- NB: if we do relax the length restriction then we will need two variants of integerToByteString in + Plutus Core so that we can continue to support the current behaviour for old scripts.-} +maximumOutputLength :: Integer +maximumOutputLength = 8192 {- Return the base 2 logarithm of an integer, returning 0 for inputs that aren't strictly positive. This is essentially copied from GHC.Num.Integer, which @@ -85,9 +82,9 @@ integerToByteStringWrapper endiannessArg lengthArg input evaluationFailure -- Check that the requested length does not exceed the limit. *NB*: if we remove the limit we'll -- still have to make sure that the length fits into an Int. - | lengthArg > integerToByteStringMaximumOutputLength = do + | lengthArg > maximumOutputLength = do emit . pack $ "integerToByteString: requested length is too long (maximum is " - ++ show integerToByteStringMaximumOutputLength + ++ show maximumOutputLength ++ " bytes)" emit $ "Length requested: " <> (pack . show $ lengthArg) evaluationFailure @@ -96,12 +93,12 @@ integerToByteStringWrapper endiannessArg lengthArg input -- limit. If the requested length is nonzero and less than the limit, -- integerToByteString checks that the input fits. | lengthArg == 0 -- integerLog2 n is one less than the number of significant bits in n - && fromIntegral (integerLog2 input) >= 8 * integerToByteStringMaximumOutputLength = + && fromIntegral (integerLog2 input) >= 8 * maximumOutputLength = let bytesRequiredFor n = integerLog2 n `div` 8 + 1 -- ^ This gives 1 instead of 0 for n=0, but we'll never get that. in do emit . pack $ "integerToByteString: input too long (maximum is 2^" - ++ show (8 * integerToByteStringMaximumOutputLength) + ++ show (8 * maximumOutputLength) ++ "-1)" emit $ "Length required: " <> (pack . show $ bytesRequiredFor input) evaluationFailure @@ -599,18 +596,18 @@ writeBits bs ixs bits = case unsafeDupablePerformIO . try $ go of -- | Byte replication, as per [CIP-122](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122) -- We want to cautious about the allocation of huge amounts of memory so we -- impose the same length limit that's used in integerToByteString. -replicateByte :: Int -> Word8 -> BuiltinResult ByteString +replicateByte :: Integer -> Word8 -> BuiltinResult ByteString replicateByte len w8 | len < 0 = do emit "replicateByte: negative length requested" evaluationFailure - | toInteger len > integerToByteStringMaximumOutputLength = do + | len > maximumOutputLength = do emit . pack $ "replicateByte: requested length is too long (maximum is " - ++ show integerToByteStringMaximumOutputLength + ++ show maximumOutputLength ++ " bytes)" emit $ "Length requested: " <> (pack . show $ len) evaluationFailure - | otherwise = pure . BS.replicate len $ w8 + | otherwise = pure . BS.replicate (fromIntegral len) $ w8 -- | Wrapper for calling 'shiftByteString' safely. Specifically, we avoid various edge cases: -- diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs index cc437bbd89a..b3bd314cf76 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs @@ -1872,12 +1872,8 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where toBuiltinMeaning _semvar IntegerToByteString = let integerToByteStringDenotation :: Bool -> NumBytesCostedAsNumWords -> Integer -> BuiltinResult BS.ByteString {- The second argument is wrapped in a NumBytesCostedAsNumWords to allow us to - interpret it as a size during costing. Elsewhere we need - `NumBytesCostedAsNumWords` to contain an `Int` so we re-use that - here at the cost of not being able to convert an integer to a - bytestring of length greater than 2^63-1, which we're never going - to want to do anyway. -} - integerToByteStringDenotation b (NumBytesCostedAsNumWords w) = Bitwise.integerToByteStringWrapper b $ toInteger w + interpret it as a size during costing. -} + integerToByteStringDenotation b (NumBytesCostedAsNumWords w) = Bitwise.integerToByteStringWrapper b w {-# INLINE integerToByteStringDenotation #-} in makeBuiltinMeaning integerToByteStringDenotation diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs index 090ad7c3dab..e3b4fb2136e 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs @@ -179,10 +179,14 @@ instance ExMemoryUsage () where denotation of a builtin then it *MUST* also be used to wrap the same argument in the relevant budgeting benchmark. -} -newtype NumBytesCostedAsNumWords = NumBytesCostedAsNumWords { unNumBytesCostedAsNumWords :: Int } +newtype NumBytesCostedAsNumWords = NumBytesCostedAsNumWords { unNumBytesCostedAsNumWords :: Integer } instance ExMemoryUsage NumBytesCostedAsNumWords where memoryUsage (NumBytesCostedAsNumWords n) = singletonRose . fromIntegral $ ((n-1) `div` 8) + 1 {-# INLINE memoryUsage #-} + -- Note that this uses `fromIntegral`, which will narrow large values to + -- maxBound::SatInt = 2^63-1. This shouldn't be a problem for costing because no + -- realistic input should be that large; however if you're going to use this then be + -- sure to convince yourself that it's safe. {- | A wrapper for `Integer`s whose "memory usage" for costing purposes is the absolute value of the `Integer`. This is used for costing built-in functions @@ -195,6 +199,10 @@ newtype IntegerCostedLiterally = IntegerCostedLiterally { unIntegerCostedLiteral instance ExMemoryUsage IntegerCostedLiterally where memoryUsage (IntegerCostedLiterally n) = singletonRose . fromIntegral $ abs n {-# INLINE memoryUsage #-} + -- Note that this uses `fromIntegral`, which will narrow large values to + -- maxBound::SatInt = 2^63-1. This shouldn't be a problem for costing because no + -- realistic input should be that large; however if you're going to use this then be + -- sure to convince yourself that it's safe. {- | A wrappper for lists whose "memory usage" for costing purposes is just the length of the list, ignoring the sizes of the elements. If this is used to @@ -204,6 +212,10 @@ newtype ListCostedByLength a = ListCostedByLength { unListCostedByLength :: [a] instance ExMemoryUsage (ListCostedByLength a) where memoryUsage (ListCostedByLength l) = singletonRose . fromIntegral $ length l {-# INLINE memoryUsage #-} + -- Note that this uses `fromIntegral`, which will narrow large values to + -- maxBound::SatInt = 2^63-1. This shouldn't be a problem for costing because no + -- realistic input should be that large; however if you're going to use this then be + -- sure to convince yourself that it's safe. -- | Calculate a 'CostingInteger' for the given 'Integer'. memoryUsageInteger :: Integer -> CostingInteger diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Conversion.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Conversion.hs index 34c891554b3..f212938aa9f 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Conversion.hs +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Conversion.hs @@ -21,7 +21,7 @@ module Evaluation.Builtins.Conversion ( import Evaluation.Builtins.Common (typecheckEvaluateCek) import PlutusCore qualified as PLC -import PlutusCore.Bitwise (integerToByteStringMaximumOutputLength) +import PlutusCore.Bitwise qualified as Bitwise (maximumOutputLength) import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultBuiltinCostModelForTesting) import PlutusCore.MkPlc (builtin, mkConstant, mkIterAppNoAnn) import PlutusPrelude (Word8, def) @@ -47,7 +47,7 @@ i2bProperty1 = do e <- forAllWith ppShow Gen.bool -- We limit this temporarily due to the limit imposed on lengths for the -- conversion primitive. - d <- forAllWith ppShow $ Gen.integral (Range.constant 0 integerToByteStringMaximumOutputLength) + d <- forAllWith ppShow $ Gen.integral (Range.constant 0 Bitwise.maximumOutputLength) let actualExp = mkIterAppNoAnn (builtin () PLC.IntegerToByteString) [ mkConstant @Bool () e, mkConstant @Integer () d, @@ -68,7 +68,7 @@ i2bProperty2 = do e <- forAllWith ppShow Gen.bool -- We limit this temporarily due to the limit imposed on lengths for the -- conversion primitive. - k <- forAllWith ppShow $ Gen.integral (Range.constant 1 integerToByteStringMaximumOutputLength) + k <- forAllWith ppShow $ Gen.integral (Range.constant 1 Bitwise.maximumOutputLength) j <- forAllWith ppShow $ Gen.integral (Range.constant 0 (k-1)) let actualExp = mkIterAppNoAnn (builtin () PLC.IntegerToByteString) [ mkConstant @Bool () e, @@ -406,9 +406,8 @@ i2bCipExamples = [ -- inputs close to the maximum size. i2bLimitTests ::[TestTree] i2bLimitTests = - let maxAcceptableInput = 2 ^ (8*integerToByteStringMaximumOutputLength) - 1 - maxAcceptableLength = integerToByteStringMaximumOutputLength -- Just for brevity - maxOutput = fromList (take (fromIntegral integerToByteStringMaximumOutputLength) $ repeat 0xFF) + let maxAcceptableInput = 2 ^ (8*Bitwise.maximumOutputLength) - 1 + maxOutput = fromList (take (fromIntegral Bitwise.maximumOutputLength) $ repeat 0xFF) makeTests endianness = let prefix = if endianness then "Big-endian, " @@ -427,7 +426,7 @@ i2bLimitTests = in evaluateAssertEqual expectedExp actualExp, -- integerToByteString maxLen maxInput = 0xFF...FF testCase (prefix ++ "maximum acceptable input, maximum acceptable length argument") $ - let actualExp = mkIntegerToByteStringApp maxAcceptableLength maxAcceptableInput + let actualExp = mkIntegerToByteStringApp Bitwise.maximumOutputLength maxAcceptableInput expectedExp = mkConstant @ByteString () maxOutput in evaluateAssertEqual expectedExp actualExp, -- integerToByteString 0 (maxInput+1) fails @@ -436,16 +435,16 @@ i2bLimitTests = in evaluateShouldFail actualExp, -- integerToByteString maxLen (maxInput+1) fails testCase (prefix ++ "input too big, maximum acceptable length argument") $ - let actualExp = mkIntegerToByteStringApp maxAcceptableLength (maxAcceptableInput + 1) + let actualExp = mkIntegerToByteStringApp Bitwise.maximumOutputLength (maxAcceptableInput + 1) in evaluateShouldFail actualExp, -- integerToByteString (maxLen-1) maxInput fails testCase (prefix ++ "maximum acceptable input, length argument not big enough") $ - let actualExp = mkIntegerToByteStringApp (maxAcceptableLength - 1) maxAcceptableInput + let actualExp = mkIntegerToByteStringApp (Bitwise.maximumOutputLength - 1) maxAcceptableInput in evaluateShouldFail actualExp, -- integerToByteString _ (maxLen+1) 0 fails, just to make sure that -- we can't go beyond the supposed limit testCase (prefix ++ "input zero, length argument over limit") $ - let actualExp = mkIntegerToByteStringApp (maxAcceptableLength + 1) 0 + let actualExp = mkIntegerToByteStringApp (Bitwise.maximumOutputLength + 1) 0 in evaluateShouldFail actualExp ] in makeTests True ++ makeTests False diff --git a/plutus-tx/src/PlutusTx/Builtins/Internal.hs b/plutus-tx/src/PlutusTx/Builtins/Internal.hs index 8960ded91f4..aed894c7a36 100644 --- a/plutus-tx/src/PlutusTx/Builtins/Internal.hs +++ b/plutus-tx/src/PlutusTx/Builtins/Internal.hs @@ -817,7 +817,7 @@ replicateByte :: BuiltinInteger -> BuiltinByteString replicateByte n w8 = - case Bitwise.replicateByte (fromIntegral n) (fromIntegral w8) of + case Bitwise.replicateByte n (fromIntegral w8) of BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $ Haskell.error "byteStringReplicate errored." BuiltinSuccess bs -> BuiltinByteString bs