From 4c466d0dec8ec00b8158b038df1fb2479e82bea7 Mon Sep 17 00:00:00 2001 From: effectfully Date: Thu, 25 Jul 2024 07:01:19 +0200 Subject: [PATCH] [Plinth] [Builtins] Fix 'writeBits' --- .../src/PlutusTx/Compiler/Builtins.hs | 8 + .../writeBits-integerToByteString.eval.golden | 755 ++++++++++++++++++ .../test/Plugin/Primitives/Spec.hs | 5 + plutus-tx/src/PlutusTx/Builtins.hs | 4 +- plutus-tx/src/PlutusTx/Builtins/HasOpaque.hs | 12 + plutus-tx/src/PlutusTx/Builtins/Internal.hs | 8 + 6 files changed, 791 insertions(+), 1 deletion(-) 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/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..f388cc323bc --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/writeBits-integerToByteString.eval.golden @@ -0,0 +1,755 @@ +Error: Unsupported feature: Cannot construct a value of type: PlutusTx.Builtins.Internal.BuiltinList + Note: GHC can generate these unexpectedly, you may need '-fno-strictness', '-fno-specialise', '-fno-spec-constr', '-fno-unbox-strict-fields', or '-fno-unbox-small-strict-fields'. +Context: Compiling expr: PlutusTx.Builtins.Internal.BuiltinList +Context: Compiling expr: PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) +Context: Compiling expr: PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Num.Integer.Integer + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + @b1 + @GHC.Num.Integer.Integer + c + ((GHC.Base.id @GHC.Num.Integer.Integer) + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])) + :: GHC.Types.Coercible + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.Internal.BuiltinInteger) + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Num.Integer.Integer)))) + n + ixes1)) +Context: Compiling expr: (PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Num.Integer.Integer + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + @b1 + @GHC.Num.Integer.Integer + c + ((GHC.Base.id @GHC.Num.Integer.Integer) + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])) + :: GHC.Types.Coercible + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.Internal.BuiltinInteger) + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Num.Integer.Integer)))) + n + ixes1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinInteger)) +Context: Compiling expr: PlutusTx.Builtins.Internal.writeBits + bs1 + ((PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Num.Integer.Integer + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + @b1 + @GHC.Num.Integer.Integer + c + ((GHC.Base.id @GHC.Num.Integer.Integer) + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])) + :: GHC.Types.Coercible + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.Internal.BuiltinInteger) + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Num.Integer.Integer)))) + n + ixes1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinInteger))) +Context: Compiling expr: PlutusTx.Builtins.Internal.writeBits + bs1 + ((PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Num.Integer.Integer + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + @b1 + @GHC.Num.Integer.Integer + c + ((GHC.Base.id @GHC.Num.Integer.Integer) + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])) + :: GHC.Types.Coercible + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.Internal.BuiltinInteger) + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Num.Integer.Integer)))) + n + ixes1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinInteger))) + ((PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Types.Bool + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + @b1 + @GHC.Types.Bool + c + (PlutusTx.Builtins.HasBuiltin.$fHasToBuiltinBool1 + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinBool[0])) + :: GHC.Types.Coercible + (GHC.Types.Bool + -> PlutusTx.Builtins.Internal.BuiltinBool) + (GHC.Types.Bool + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Types.Bool)))) + n + bits1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinBool[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinBool))) +Context: Compiling expr: case bits of bits1 [Occ=Once1] { __DEFAULT -> + PlutusTx.Builtins.Internal.writeBits + bs1 + ((PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Num.Integer.Integer + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + @b1 + @GHC.Num.Integer.Integer + c + ((GHC.Base.id @GHC.Num.Integer.Integer) + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])) + :: GHC.Types.Coercible + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.Internal.BuiltinInteger) + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Num.Integer.Integer)))) + n + ixes1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinInteger))) + ((PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Types.Bool + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + @b1 + @GHC.Types.Bool + c + (PlutusTx.Builtins.HasBuiltin.$fHasToBuiltinBool1 + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinBool[0])) + :: GHC.Types.Coercible + (GHC.Types.Bool + -> PlutusTx.Builtins.Internal.BuiltinBool) + (GHC.Types.Bool + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Types.Bool)))) + n + bits1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinBool[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinBool))) + } +Context: Compiling expr: case ixes of ixes1 [Occ=Once1] { __DEFAULT -> + case bits of bits1 [Occ=Once1] { __DEFAULT -> + PlutusTx.Builtins.Internal.writeBits + bs1 + ((PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Num.Integer.Integer + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + @b1 + @GHC.Num.Integer.Integer + c + ((GHC.Base.id @GHC.Num.Integer.Integer) + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])) + :: GHC.Types.Coercible + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.Internal.BuiltinInteger) + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Num.Integer.Integer)))) + n + ixes1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinInteger))) + ((PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Types.Bool + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + @b1 + @GHC.Types.Bool + c + (PlutusTx.Builtins.HasBuiltin.$fHasToBuiltinBool1 + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinBool[0])) + :: GHC.Types.Coercible + (GHC.Types.Bool + -> PlutusTx.Builtins.Internal.BuiltinBool) + (GHC.Types.Bool + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Types.Bool)))) + n + bits1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinBool[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinBool))) + } + } +Context: Compiling expr: case bs of bs1 [Occ=Once1] + { PlutusTx.Builtins.Internal.BuiltinByteString _ [Occ=Dead] -> + case ixes of ixes1 [Occ=Once1] { __DEFAULT -> + case bits of bits1 [Occ=Once1] { __DEFAULT -> + PlutusTx.Builtins.Internal.writeBits + bs1 + ((PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Num.Integer.Integer + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + @b1 + @GHC.Num.Integer.Integer + c + ((GHC.Base.id @GHC.Num.Integer.Integer) + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])) + :: GHC.Types.Coercible + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.Internal.BuiltinInteger) + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Num.Integer.Integer)))) + n + ixes1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinInteger))) + ((PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Types.Bool + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + @b1 + @GHC.Types.Bool + c + (PlutusTx.Builtins.HasBuiltin.$fHasToBuiltinBool1 + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinBool[0])) + :: GHC.Types.Coercible + (GHC.Types.Bool + -> PlutusTx.Builtins.Internal.BuiltinBool) + (GHC.Types.Bool + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Types.Bool)))) + n + bits1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinBool[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinBool))) + } + } + } +Context: Compiling expr: \ (bits [Occ=Once1] :: [GHC.Types.Bool]) -> + case bs of bs1 [Occ=Once1] + { PlutusTx.Builtins.Internal.BuiltinByteString _ [Occ=Dead] -> + case ixes of ixes1 [Occ=Once1] { __DEFAULT -> + case bits of bits1 [Occ=Once1] { __DEFAULT -> + PlutusTx.Builtins.Internal.writeBits + bs1 + ((PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Num.Integer.Integer + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + @b1 + @GHC.Num.Integer.Integer + c + ((GHC.Base.id @GHC.Num.Integer.Integer) + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])) + :: GHC.Types.Coercible + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.Internal.BuiltinInteger) + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Num.Integer.Integer)))) + n + ixes1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Num.Integer.Integer)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinInteger))) + ((PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Types.Bool + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + @b1 + @GHC.Types.Bool + c + (PlutusTx.Builtins.HasBuiltin.$fHasToBuiltinBool1 + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinBool[0])) + :: GHC.Types.Coercible + (GHC.Types.Bool + -> PlutusTx.Builtins.Internal.BuiltinBool) + (GHC.Types.Bool + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Types.Bool)))) + n + bits1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinBool[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinBool))) + } + } + } +Context: Compiling expr: \ (ixes [Occ=Once1] :: [GHC.Num.Integer.Integer]) + (bits [Occ=Once1] :: [GHC.Types.Bool]) -> + case bs of bs1 [Occ=Once1] + { PlutusTx.Builtins.Internal.BuiltinByteString _ [Occ=Dead] -> + case ixes of ixes1 [Occ=Once1] { __DEFAULT -> + case bits of bits1 [Occ=Once1] { __DEFAULT -> + PlutusTx.Builtins.Internal.writeBits + bs1 + ((PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Num.Integer.Integer + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + @b1 + @GHC.Num.Integer.Integer + c + ((GHC.Base.id @GHC.Num.Integer.Integer) + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])) + :: GHC.Types.Coercible + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.Internal.BuiltinInteger) + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Num.Integer.Integer)))) + n + ixes1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Num.Integer.Integer)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinInteger))) + ((PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Types.Bool + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + @b1 + @GHC.Types.Bool + c + (PlutusTx.Builtins.HasBuiltin.$fHasToBuiltinBool1 + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinBool[0])) + :: GHC.Types.Coercible + (GHC.Types.Bool + -> PlutusTx.Builtins.Internal.BuiltinBool) + (GHC.Types.Bool + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Types.Bool)))) + n + bits1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinBool[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinBool))) + } + } + } +Context: Compiling expr: \ (bs [Occ=Once1!] + :: PlutusTx.Builtins.Internal.BuiltinByteString) + (ixes [Occ=Once1] :: [GHC.Num.Integer.Integer]) + (bits [Occ=Once1] :: [GHC.Types.Bool]) -> + case bs of bs1 [Occ=Once1] + { PlutusTx.Builtins.Internal.BuiltinByteString _ [Occ=Dead] -> + case ixes of ixes1 [Occ=Once1] { __DEFAULT -> + case bits of bits1 [Occ=Once1] { __DEFAULT -> + PlutusTx.Builtins.Internal.writeBits + bs1 + ((PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Num.Integer.Integer + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Num.Integer.Integer) + @b1 + @GHC.Num.Integer.Integer + c + ((GHC.Base.id @GHC.Num.Integer.Integer) + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])) + :: GHC.Types.Coercible + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.Internal.BuiltinInteger) + (GHC.Num.Integer.Integer + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Num.Integer.Integer)))) + n + ixes1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinInteger[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Num.Integer.Integer)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinInteger))) + ((PlutusTx.Builtins.Internal.BuiltinList + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + (GHC.Base.build + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + (\ (@b1) + (c [Occ=Once1, OS=OneShot] + :: PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool + -> b1 -> b1) + (n [Occ=Once1, OS=OneShot] :: b1) -> + GHC.Base.foldr + @GHC.Types.Bool + @b1 + (GHC.Base.mapFB + @(PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool) + @b1 + @GHC.Types.Bool + c + (PlutusTx.Builtins.HasBuiltin.$fHasToBuiltinBool1 + `cast` (_R + %<'GHC.Types.Many>_N ->_R Sub (Sym (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinBool[0])) + :: GHC.Types.Coercible + (GHC.Types.Bool + -> PlutusTx.Builtins.Internal.BuiltinBool) + (GHC.Types.Bool + -> PlutusTx.Builtins.HasBuiltin.ToBuiltin + GHC.Types.Bool)))) + n + bits1))) + `cast` ((PlutusTx.Builtins.Internal.BuiltinList + (Sub (PlutusTx.Builtins.HasBuiltin.D:R:ToBuiltinBool[0])))_R + :: GHC.Types.Coercible + (PlutusTx.Builtins.Internal.BuiltinList + (PlutusTx.Builtins.HasBuiltin.ToBuiltin GHC.Types.Bool)) + (PlutusTx.Builtins.Internal.BuiltinList + PlutusTx.Builtins.Internal.BuiltinBool))) + } + } + } +Context: Compiling definition of: PlutusTx.Builtins.writeBits +Context: Compiling expr: PlutusTx.Builtins.writeBits +Context: Compiling expr: PlutusTx.Builtins.writeBits + (src + PlutusTx.Builtins.integerToByteString + (src + GHC.ByteOrder.BigEndian) + (src GHC.Num.Integer.IS 6#) + (src + GHC.Num.Integer.IS 15#)) +Context: Compiling expr: PlutusTx.Builtins.writeBits + (src + PlutusTx.Builtins.integerToByteString + (src + GHC.ByteOrder.BigEndian) + (src GHC.Num.Integer.IS 6#) + (src + GHC.Num.Integer.IS 15#)) + (src + GHC.Base.build + @GHC.Num.Integer.Integer + (\ (@a) + (c_d1l5g [OS=OneShot] :: GHC.Num.Integer.Integer -> a -> a) + (n_d1l5h [Occ=Once1, OS=OneShot] :: a) -> + c_d1l5g + (src GHC.Num.Integer.IS 0#) + (c_d1l5g + (src GHC.Num.Integer.IS 2#) + (c_d1l5g + (src GHC.Num.Integer.IS 5#) + n_d1l5h)))) +Context: Compiling expr: PlutusTx.Builtins.writeBits + (src + PlutusTx.Builtins.integerToByteString + (src + GHC.ByteOrder.BigEndian) + (src GHC.Num.Integer.IS 6#) + (src + GHC.Num.Integer.IS 15#)) + (src + GHC.Base.build + @GHC.Num.Integer.Integer + (\ (@a) + (c_d1l5g [OS=OneShot] :: GHC.Num.Integer.Integer -> a -> a) + (n_d1l5h [Occ=Once1, OS=OneShot] :: a) -> + c_d1l5g + (src GHC.Num.Integer.IS 0#) + (c_d1l5g + (src GHC.Num.Integer.IS 2#) + (c_d1l5g + (src GHC.Num.Integer.IS 5#) + n_d1l5h)))) + (src + GHC.Base.build + @GHC.Types.Bool + (\ (@a) + (c_d1l5j [OS=OneShot] :: GHC.Types.Bool -> a -> a) + (n_d1l5k [Occ=Once1, OS=OneShot] :: a) -> + c_d1l5j + (src GHC.Types.True) + (c_d1l5j + (src GHC.Types.False) + (c_d1l5j + (src GHC.Types.True) + n_d1l5k)))) +Context: Compiling expr at: test/Plugin/Primitives/Spec.hs:197:5-95 +Context: Compiling expr: src + PlutusTx.Builtins.writeBits + (src + PlutusTx.Builtins.integerToByteString + (src + GHC.ByteOrder.BigEndian) + (src GHC.Num.Integer.IS 6#) + (src + GHC.Num.Integer.IS 15#)) + (src + GHC.Base.build + @GHC.Num.Integer.Integer + (\ (@a) + (c_d1l5g [OS=OneShot] :: GHC.Num.Integer.Integer -> a -> a) + (n_d1l5h [Occ=Once1, OS=OneShot] :: a) -> + c_d1l5g + (src GHC.Num.Integer.IS 0#) + (c_d1l5g + (src GHC.Num.Integer.IS 2#) + (c_d1l5g + (src GHC.Num.Integer.IS 5#) + n_d1l5h)))) + (src + GHC.Base.build + @GHC.Types.Bool + (\ (@a) + (c_d1l5j [OS=OneShot] :: GHC.Types.Bool -> a -> a) + (n_d1l5k [Occ=Once1, OS=OneShot] :: a) -> + c_d1l5j + (src GHC.Types.True) + (c_d1l5j + (src GHC.Types.False) + (c_d1l5j + (src GHC.Types.True) + n_d1l5k)))) +Context: Compiling expr at "writeBitsCompiled" \ 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..043eb122dba 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 @"writeBitsCompiled") + (P.writeBits (P.integerToByteString Builtins.BigEndian 6 15) [0, 2, 5] [True, False, True]) diff --git a/plutus-tx/src/PlutusTx/Builtins.hs b/plutus-tx/src/PlutusTx/Builtins.hs index 6b439ae23fb..5287e50868e 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 @@ -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). 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 []