diff --git a/.hlint.yaml b/.hlint.yaml index a41958d886d..d9532dcc200 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -27,3 +27,4 @@ - ignore: {name: Use first, within: [UntypedPlutusCore.Evaluation.Machine.Cek]} - ignore: {name: Redundant if, within: [PlutusLedgerApi.V1.Value, PlutusLedgerApi.V1.Data.Value]} - ignore: {name: Replace case with maybe, within: [PlutusLedgerApi.V1.Value, PlutusLedgerApi.V1.Data.Value]} +- ignore: {name: Use bimap, within: [PlutusTx.Builtins.HasOpaque]} diff --git a/plutus-benchmark/bitwise/src/PlutusBenchmark/Ed25519/Compiled.hs b/plutus-benchmark/bitwise/src/PlutusBenchmark/Ed25519/Compiled.hs index 2da928537f1..5607b13e1d4 100644 --- a/plutus-benchmark/bitwise/src/PlutusBenchmark/Ed25519/Compiled.hs +++ b/plutus-benchmark/bitwise/src/PlutusBenchmark/Ed25519/Compiled.hs @@ -1,14 +1,14 @@ --- editorconfig-checker-disable-file {-# LANGUAGE DataKinds #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} -module PlutusBenchmark.Ed25519.Compiled ( - checkValidCompiled, - msgAsData, - signatureAsData, - pkAsData +module PlutusBenchmark.Ed25519.Compiled + ( checkValidCompiled + , msgAsData + , signatureAsData + , pkAsData ) where import PlutusBenchmark.Ed25519 (checkValid) @@ -19,17 +19,43 @@ import PlutusTx.Plugin () import PlutusTx.Prelude import PlutusTx.TH (compile) -checkValidCompiled :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> Bool) -checkValidCompiled = $$(compile [|| \signature msg pk -> checkValid (unsafeFromBuiltinData signature) - (unsafeFromBuiltinData msg) - (unsafeFromBuiltinData pk) ||]) +checkValidCompiled + :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> Bool) +checkValidCompiled = + $$( compile + [|| + \signature msg pk -> + checkValid + (unsafeFromBuiltinData signature) + (unsafeFromBuiltinData msg) + (unsafeFromBuiltinData pk) + ||] + ) msgAsData :: CompiledCode BuiltinData -msgAsData = liftCodeDef (toBuiltinData ("hello world" :: BuiltinByteString)) +msgAsData = + liftCodeDef + $ toBuiltinData @BuiltinByteString + "\x68\x65\x6C\x6C\x6F\x20\x77\x6F\x72\x6C\x64" signatureAsData :: CompiledCode BuiltinData signatureAsData = - $$(compile [|| toBuiltinData ("\NUL\147!x\173\167\209z`\t\243|\195$X$\233\166\234\NUL\134\152l\DC4\243\&4\217\NAK\152\180{$M\227R\214\218%\241\157\ENQ\SO\ENQ\t\152\140\171\240\200f\184\133\203\227z\163\NUL\185\155Y\139\178\249\STX" :: BuiltinByteString) ||]) + $$( compile + [|| + toBuiltinData @BuiltinByteString + "\xC0\x80\xC2\x93\x21\x78\xC2\xAD\xC2\xA7\xC3\x91\x7A\x60\x09\xC3\xB3\ + \\x7C\xC3\x83\x24\x58\x24\xC3\xA9\xC2\xA6\xC3\xAA\xC0\x80\xC2\x86\xC2\ + \\x98\x6C\x14\xC3\xB3\x34\xC3\x99\x15\xC2\x98\xC2\xB4\x7B\x24\x4D\xC3\ + \\xA3\x52\xC3\x96\xC3\x9A\x25\xC3\xB1\xC2\x9D\x05\x0E\x05\x09\xC2\x98\ + \\xC2\x8C\xC2\xAB\xC3\xB0\xC3\x88\x66\xC2\xB8\xC2\x85\xC3\x8B\xC3\xA3\ + \\x7A\xC2\xA3\xC0\x80\xC2\xB9\xC2\x9B\x59\xC2\x8B\xC2\xB2\xC3\xB9\x02" + ||] + ) pkAsData :: CompiledCode BuiltinData -pkAsData = liftCodeDef (toBuiltinData ("(:\255\251\129\&7-^w\253\145\vh\ESC\171r\189\223/\213Qzb\249\175$z\211q\195\DC1\198" :: BuiltinByteString)) +pkAsData = + liftCodeDef + $ toBuiltinData @BuiltinByteString + "\x28\x3A\xC3\xBF\xC3\xBB\xC2\x81\x37\x2D\x5E\x77\xC3\xBD\xC2\x91\x0B\x68\ + \\x1B\xC2\xAB\x72\xC2\xBD\xC3\x9F\x2F\xC3\x95\x51\x7A\x62\xC3\xB9\xC2\xAF\ + \\x24\x7A\xC3\x93\x71\xC3\x83\x11\xC3\x86" diff --git a/plutus-core/cost-model/test/TH.hs b/plutus-core/cost-model/test/TH.hs index ea849584b16..e193400d399 100644 --- a/plutus-core/cost-model/test/TH.hs +++ b/plutus-core/cost-model/test/TH.hs @@ -3,17 +3,14 @@ restrictions. -} -{-# LANGUAGE TemplateHaskell #-} - -module TH (genTest) -where +module TH (genTest) where import Data.Char (toUpper) import Language.Haskell.TH toUpper1 :: String -> String toUpper1 [] = error "empty string in toUpper1" -toUpper1 (c:cs) = (toUpper c):cs +toUpper1 (c:cs) = toUpper c : cs mkIterApp :: Exp -> [Exp] -> Exp mkIterApp = foldl AppE diff --git a/plutus-tx-plugin/changelog.d/20241113_120551_Yuriy.Lazaryev_builtin_byte_string_literals.md b/plutus-tx-plugin/changelog.d/20241113_120551_Yuriy.Lazaryev_builtin_byte_string_literals.md new file mode 100644 index 00000000000..cd6b8d93514 --- /dev/null +++ b/plutus-tx-plugin/changelog.d/20241113_120551_Yuriy.Lazaryev_builtin_byte_string_literals.md @@ -0,0 +1,4 @@ +### Changed + +- `BuiltinByteString` literals changed to avoid UTF8 encoding and now can represent bytes in the range 0-255 directly, e.g. `"\x00\x01\x02" :: BuiltinByteString` or `stringToBuiltinByteString "\0\42\255"`. + diff --git a/plutus-tx-plugin/plutus-tx-plugin.cabal b/plutus-tx-plugin/plutus-tx-plugin.cabal index 6a30448462a..2aca7912545 100644 --- a/plutus-tx-plugin/plutus-tx-plugin.cabal +++ b/plutus-tx-plugin/plutus-tx-plugin.cabal @@ -124,6 +124,7 @@ test-suite plutus-tx-plugin-tests Budget.Spec Budget.WithGHCOptimisations Budget.WithoutGHCOptimisations + ByteStringLiterals.Spec IntegerLiterals.NoStrict.NegativeLiterals.Spec IntegerLiterals.NoStrict.NoNegativeLiterals.Spec IntegerLiterals.Strict.NegativeLiterals.Spec diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs index 86f64e3a6b6..461a6456f4e 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs @@ -12,6 +12,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} + {-# OPTIONS_GHC -Wno-partial-type-signatures #-} -- | Functions for compiling GHC Core expressions into Plutus Core terms. @@ -24,6 +25,7 @@ import GHC.Core qualified as GHC import GHC.Core.Class qualified as GHC import GHC.Core.Multiplicity qualified as GHC import GHC.Core.TyCo.Rep qualified as GHC +import GHC.Num.Integer qualified import GHC.Plugins qualified as GHC import GHC.Types.CostCentre qualified as GHC import GHC.Types.Id.Make qualified as GHC @@ -76,12 +78,13 @@ import Data.ByteString qualified as BS import Data.Generics.Uniplate.Data (transform, universeBi) import Data.List (elemIndex, isPrefixOf, isSuffixOf) import Data.Map qualified as Map -import Data.Maybe +import Data.Maybe (mapMaybe) import Data.Set qualified as Set import Data.Text qualified as T import Data.Text.Encoding qualified as TE -import Data.Traversable -import GHC.Num.Integer qualified +import Data.Traversable (for) +import Data.Word (Word8) + {- Note [System FC and System FW] Haskell uses system FC, which includes type equalities and coercions. @@ -136,23 +139,51 @@ compileLiteral = \case -- do different things to the inner expression. This one assumes it's a literal, the other one keeps compiling -- through it. --- | Get the bytestring content of a string expression, if possible. Follows (Haskell) variable references! -stringExprContent :: GHC.CoreExpr -> Maybe BS.ByteString -stringExprContent = \case - GHC.Lit (GHC.LitString bs) -> Just bs - -- unpackCString# / unpackCStringUtf8# are just wrappers around a literal - GHC.Var n `GHC.App` expr - | let name = GHC.getName n - , name == GHC.unpackCStringName || name == GHC.unpackCStringUtf8Name -> - stringExprContent expr +data StringExprContentAs = AsBytes | AsText + +-- | Get the bytestring content of a string expression, if possible. +-- Follows (Haskell) variable references! +stringExprContent :: StringExprContentAs -> GHC.CoreExpr -> Maybe BS.ByteString +stringExprContent contentAs coreExpr = case coreExpr of + GHC.Lit (GHC.LitString bytes) -> + Just bytes + GHC.Var isUnpackCString `GHC.App` GHC.Lit (GHC.LitString bytes) + | GHC.getName isUnpackCString == GHC.unpackCStringName -> + Just bytes + GHC.Var isUnpackCStringUtf8 `GHC.App` GHC.Lit (GHC.LitString bytes) + | GHC.getName isUnpackCStringUtf8 == GHC.unpackCStringUtf8Name -> + case contentAs of + AsText -> Just bytes + AsBytes -> + -- GHC stores bytestring literals UTF-8 encoded, decoding them at runtime. + -- In Plinth we decode such bytestrings in compile-time. + BS.pack <$> fromUtf8 (BS.unpack bytes) -- See Note [unpackFoldrCString#] GHC.Var build `GHC.App` _ `GHC.App` GHC.Lam _ (GHC.Var unpack `GHC.App` _ `GHC.App` expr) - | GHC.getName build == GHC.buildName && GHC.getName unpack == GHC.unpackCStringFoldrName -> stringExprContent expr + | GHC.getName build == GHC.buildName && GHC.getName unpack == GHC.unpackCStringFoldrName -> + stringExprContent contentAs expr -- GHC helpfully generates an empty list for the empty string literal instead of a 'LitString' GHC.Var nil `GHC.App` GHC.Type (GHC.tyConAppTyCon_maybe -> Just tc) - | nil == GHC.dataConWorkId GHC.nilDataCon, GHC.getName tc == GHC.charTyConName -> Just mempty - -- Chase variable references! GHC likes to lift string constants to variables, that is not good for us! - GHC.Var (GHC.maybeUnfoldingTemplate . GHC.realIdUnfolding -> Just unfolding) -> stringExprContent unfolding + | nil == GHC.dataConWorkId GHC.nilDataCon, GHC.getName tc == GHC.charTyConName -> + Just mempty + -- Chase variable references! GHC likes to lift string constants to variables, + -- that is not good for us! + GHC.Var (GHC.maybeUnfoldingTemplate . GHC.realIdUnfolding -> Just unfolding) -> + stringExprContent contentAs unfolding + _ -> Nothing + +{- | Decoding that undoes GHC's UTF-8 encoding of bytestring literals: + +This isn't a full UTF-8 decoder: it only decodes the subset of UTF-8 that +is expected to be found in bytestring literals: 0x00 - 0xFF +-} +fromUtf8 :: [Word8] -> Maybe [Word8] +fromUtf8 = \case + [] -> Just [] + 192 : 128 : rest -> (0x00 :) <$> fromUtf8 rest + 194 : b : rest | b > 127 && b < 192 -> (b :) <$> fromUtf8 rest + 195 : b : rest | b > 127 && b < 192 -> ((b + 64) :) <$> fromUtf8 rest + b : rest | b > 0 && b < 128 -> (b :) <$> fromUtf8 rest _ -> Nothing {- | Strip off irrelevant things when we're trying to match a particular pattern in the code. Mostly ticks. @@ -699,13 +730,21 @@ compileExpr e = traceCompilation 2 ("Compiling expr:" GHC.<+> GHC.ppr e) $ do _ -> throwPlain $ CompilationError "No info for Pair builtin" -- TODO: Maybe share this to avoid repeated lookups. Probably cheap, though. - (stringTyName, sbsName) <- case (Map.lookup ''Builtins.BuiltinString nameInfo, Map.lookup 'Builtins.stringToBuiltinString nameInfo) of + (stringTyName, sbsName) <- + case + ( Map.lookup ''Builtins.BuiltinString nameInfo + , Map.lookup 'Builtins.stringToBuiltinString nameInfo + ) of (Just t1, Just t2) -> pure (GHC.getName t1, GHC.getName t2) _ -> throwPlain $ CompilationError "No info for String builtin" - (bsTyName, sbbsName) <- case (Map.lookup ''Builtins.BuiltinByteString nameInfo, Map.lookup 'Builtins.stringToBuiltinByteString nameInfo) of - (Just t1, Just t2) -> pure (GHC.getName t1, GHC.getName t2) - _ -> throwPlain $ CompilationError "No info for ByteString builtin" + (builtinByteStringTyName, sbbsName) <- + case + ( Map.lookup ''Builtins.BuiltinByteString nameInfo + , Map.lookup 'Builtins.stringToBuiltinByteString nameInfo + ) of + (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 @@ -730,39 +769,54 @@ compileExpr e = traceCompilation 2 ("Compiling expr:" GHC.<+> GHC.ppr e) $ do -- to know we're looking at fromString. -- We can safely commit to this match as soon as we've seen fromString - we won't accept -- any applications of fromString that aren't creating literals of our builtin types. - (strip -> GHC.Var (GHC.idDetails -> GHC.ClassOpId cls)) `GHC.App` GHC.Type ty `GHC.App` _ `GHC.App` content + (strip -> GHC.Var (GHC.idDetails -> GHC.ClassOpId cls)) + `GHC.App` GHC.Type ty `GHC.App` _dict `GHC.App` content | GHC.getName cls == GHC.isStringClassName -> - case GHC.tyConAppTyCon_maybe ty of - Just tc -> case stringExprContent (strip content) of - Just bs -> - if - | GHC.getName tc == bsTyName -> pure $ PIR.Constant annMayInline $ PLC.someValue bs - | GHC.getName tc == stringTyName -> case TE.decodeUtf8' bs of - Right t -> pure $ PIR.Constant annMayInline $ PLC.someValue t - Left err -> - throwPlain . CompilationError $ - "Text literal with invalid UTF-8 content: " <> (T.pack $ show err) - | otherwise -> - throwSd UnsupportedError $ - "Use of fromString on type other than builtin strings or bytestrings:" GHC.<+> GHC.ppr ty - Nothing -> - throwSd CompilationError $ - "Use of fromString with inscrutable content:" GHC.<+> GHC.ppr content + case GHC.tyConAppTyCon_maybe ty of -- extract Type constructor without arguments + Just tc -> + if + | GHC.getName tc == builtinByteStringTyName -> + case stringExprContent AsBytes (strip content) of + Nothing -> + throwSd CompilationError $ + "Use of fromString @BuiltinByteString with inscrutable content:" + GHC.<+> GHC.ppr content + Just bs -> + pure $ PIR.Constant annMayInline $ PLC.someValue bs + | GHC.getName tc == stringTyName -> + case stringExprContent AsText (strip content) of + Nothing -> + throwSd CompilationError $ + "Use of fromString @BuiltinString with inscrutable content:" + GHC.<+> GHC.ppr content + Just bs -> + case TE.decodeUtf8' bs of + Right t -> pure $ PIR.Constant annMayInline $ PLC.someValue t + Left err -> + throwPlain . CompilationError $ + "Text literal with invalid UTF-8 content: " <> T.pack (show err) + | otherwise -> + throwSd UnsupportedError $ + "Use of fromString on type other than builtin strings or bytestrings:" + GHC.<+> GHC.ppr ty Nothing -> throwSd UnsupportedError $ - "Use of fromString on type other than builtin strings or bytestrings:" GHC.<+> GHC.ppr ty + "Use of fromString on type other than builtin strings or bytestrings:" + GHC.<+> GHC.ppr ty + -- 'stringToBuiltinByteString' invocation - (strip -> GHC.Var n) `GHC.App` (strip -> stringExprContent -> Just bs) + (strip -> GHC.Var n) `GHC.App` (strip -> stringExprContent AsBytes -> Just bs) | GHC.getName n == sbbsName -> pure $ PIR.Constant annMayInline $ PLC.someValue bs -- 'stringToBuiltinString' invocation - (strip -> GHC.Var n) `GHC.App` (strip -> stringExprContent -> Just bs) | GHC.getName n == sbsName -> - case TE.decodeUtf8' bs of - Right t -> pure $ PIR.Constant annMayInline $ PLC.someValue t - Left err -> - throwPlain $ - CompilationError $ - "Text literal with invalid UTF-8 content: " <> (T.pack $ show err) + (strip -> GHC.Var n) `GHC.App` (strip -> stringExprContent AsText -> Just bs) + | GHC.getName n == sbsName -> + case TE.decodeUtf8' bs of + Right t -> pure $ PIR.Constant annMayInline $ PLC.someValue t + Left err -> + throwPlain $ + CompilationError $ + "Text literal with invalid UTF-8 content: " <> (T.pack $ show err) -- See Note [Literals] GHC.Lit lit -> compileLiteral lit -- These are all wrappers around string and char literals, but keeping them allows us to give better errors diff --git a/plutus-tx-plugin/test/AssocMap/Spec.hs b/plutus-tx-plugin/test/AssocMap/Spec.hs index 04e4f2604c2..c4beb1d5a8e 100644 --- a/plutus-tx-plugin/test/AssocMap/Spec.hs +++ b/plutus-tx-plugin/test/AssocMap/Spec.hs @@ -36,7 +36,6 @@ import PlutusTx.IsData qualified as P import PlutusTx.Lift (liftCodeDef, makeLift) import PlutusTx.List qualified as PlutusTx import PlutusTx.Prelude qualified as PlutusTx -import PlutusTx.Show qualified as PlutusTx import PlutusTx.Test import PlutusTx.Test.Util.Compiled (cekResultMatchesHaskellValue, compiledCodeToTerm, unsafeRunTermCek) @@ -50,26 +49,22 @@ import Test.Tasty.Hedgehog (testProperty) map1 :: CompiledCode ( Integer -> - ( Maybe PlutusTx.BuiltinByteString - , Maybe PlutusTx.BuiltinByteString - , Maybe PlutusTx.BuiltinByteString - , Maybe PlutusTx.BuiltinByteString - , Maybe PlutusTx.BuiltinByteString + ( Maybe Integer + , Maybe Integer + , Maybe Integer + , Maybe Integer + , Maybe Integer ) ) map1 = $$( compile [|| \n -> - let m :: Data.AssocMap.Map Integer PlutusTx.BuiltinByteString + let m :: Data.AssocMap.Map Integer Integer m = foldr - (\i -> - Data.AssocMap.insert - (n PlutusTx.+ i) - (PlutusTx.encodeUtf8 (PlutusTx.show i)) - ) - (Data.AssocMap.singleton n "0") + (\i -> Data.AssocMap.insert (n PlutusTx.+ i) i) + (Data.AssocMap.singleton n 0) (PlutusTx.enumFromTo 1 10) m' = Data.AssocMap.delete (n PlutusTx.+ 5) m in ( Data.AssocMap.lookup n m @@ -84,56 +79,57 @@ map1 = -- | Test that 'unionWith' is implemented correctly. Due to the nature of 'Map k v', -- some type errors are only caught when running the PlutusTx compiler on code which uses -- 'unionWith'. -map2 :: CompiledCode (Integer -> [(Integer, PlutusTx.BuiltinString)]) +map2 :: CompiledCode (Integer -> [(Integer, Integer)]) map2 = $$( compile [|| \n -> - let m1 = + let m1 :: Data.AssocMap.Map Integer Integer + m1 = Data.AssocMap.unsafeFromList - [ (n PlutusTx.+ 1, "one") - , (n PlutusTx.+ 2, "two") - , (n PlutusTx.+ 3, "three") - , (n PlutusTx.+ 4, "four") - , (n PlutusTx.+ 5, "five") + [ (n PlutusTx.+ 1, 1) + , (n PlutusTx.+ 2, 2) + , (n PlutusTx.+ 3, 3) + , (n PlutusTx.+ 4, 4) + , (n PlutusTx.+ 5, 5) ] m2 = Data.AssocMap.unsafeFromList - [ (n PlutusTx.+ 3, "THREE") - , (n PlutusTx.+ 4, "FOUR") - , (n PlutusTx.+ 6, "SIX") - , (n PlutusTx.+ 7, "SEVEN") + [ (n PlutusTx.+ 3, 33) + , (n PlutusTx.+ 4, 44) + , (n PlutusTx.+ 6, 66) + , (n PlutusTx.+ 7, 77) ] - m = Data.AssocMap.unionWith PlutusTx.appendByteString m1 m2 - in PlutusTx.fmap (\(k, v) -> (k, PlutusTx.decodeUtf8 v)) (Data.AssocMap.toList m) + m = Data.AssocMap.unionWith (PlutusTx.+) m1 m2 + in Data.AssocMap.toList m ||] ) -- | Similar to map2, but uses 'union' instead of 'unionWith'. Evaluating 'map3' and 'map2' -- should yield the same result. -map3 :: CompiledCode (Integer -> [(Integer, PlutusTx.BuiltinString)]) +map3 :: CompiledCode (Integer -> [(Integer, Integer)]) map3 = $$( compile [|| \n -> let m1 = Data.AssocMap.unsafeFromList - [ (n PlutusTx.+ 1, "one") - , (n PlutusTx.+ 2, "two") - , (n PlutusTx.+ 3, "three") - , (n PlutusTx.+ 4, "four") - , (n PlutusTx.+ 5, "five") + [ (n PlutusTx.+ 1, 1) + , (n PlutusTx.+ 2, 2) + , (n PlutusTx.+ 3, 3) + , (n PlutusTx.+ 4, 4) + , (n PlutusTx.+ 5, 5) ] m2 = Data.AssocMap.unsafeFromList - [ (n PlutusTx.+ 3, "THREE") - , (n PlutusTx.+ 4, "FOUR") - , (n PlutusTx.+ 6, "SIX") - , (n PlutusTx.+ 7, "SEVEN") + [ (n PlutusTx.+ 3, 30) + , (n PlutusTx.+ 4, 40) + , (n PlutusTx.+ 6, 60) + , (n PlutusTx.+ 7, 70) ] m = Data.AssocMap.union m1 m2 - f = these id id PlutusTx.appendByteString - in PlutusTx.fmap (\(k, v) -> (k, PlutusTx.decodeUtf8 (f v))) (Data.AssocMap.toList m) + f = these id id (PlutusTx.+) + in PlutusTx.fmap (PlutusTx.fmap f) (Data.AssocMap.toList m) ||] ) diff --git a/plutus-tx-plugin/test/Budget/9.6/map1-budget.budget.golden b/plutus-tx-plugin/test/Budget/9.6/map1-budget.budget.golden index 79a1656df56..bf692a3a26a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map1-budget.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map1-budget.budget.golden @@ -1,2 +1,2 @@ -({cpu: 329673186 -| mem: 1015513}) \ No newline at end of file +({cpu: 279348667 +| mem: 788158}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map1.eval.golden b/plutus-tx-plugin/test/Budget/9.6/map1.eval.golden index 2976eddf5c9..9732f5cd234 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map1.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map1.eval.golden @@ -1,8 +1,8 @@ (constr 0 - (constr 0 (con bytestring #30)) - (constr 0 (con bytestring #35)) - (constr 0 (con bytestring #3130)) + (constr 0 (con integer 0)) + (constr 0 (con integer 5)) + (constr 0 (con integer 10)) (constr 1) (constr 1) ) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map1.pir.golden b/plutus-tx-plugin/test/Budget/9.6/map1.pir.golden index ee64841c69d..371bf7563e6 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map1.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map1.pir.golden @@ -1,13 +1,13 @@ -let - data Bool | Bool_match where - True : Bool - False : Bool -in letrec data (List :: * -> *) a | List_match where Nil : List a Cons : a -> List a -> List a in +let + data Bool | Bool_match where + True : Bool + False : Bool +in letrec !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer = \(x : integer) (lim : integer) -> @@ -19,248 +19,9 @@ letrec Cons {integer} x (`$fEnumBool_$cenumFromTo` (addInteger 1 x) lim)) {all dead. dead} in -letrec - !go : List integer -> integer -> List integer - = \(acc : List integer) (n : integer) -> - let - !x : integer = quotientInteger n 10 - in - Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) - {all dead. List integer} - (/\dead -> Cons {integer} (remainderInteger n 10) acc) - (/\dead -> go (Cons {integer} (remainderInteger n 10) acc) x) - {all dead. dead} -in -letrec - !go : - List integer -> List string -> List string - = \(ds : List integer) -> - List_match - {integer} - ds - {all dead. List string -> List string} - (/\dead -> \(x : List string) -> x) - (\(x : integer) - (xs : List integer) -> - /\dead -> - let - !acc : List string -> List string = go xs - in - \(eta : List string) -> - Cons - {string} - (Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) - {all dead. string} - (/\dead -> "0") - (/\dead -> - Bool_match - (ifThenElse {Bool} (equalsInteger 1 x) True False) - {all dead. string} - (/\dead -> "1") - (/\dead -> - Bool_match - (ifThenElse - {Bool} - (equalsInteger 2 x) - True - False) - {all dead. string} - (/\dead -> "2") - (/\dead -> - Bool_match - (ifThenElse - {Bool} - (equalsInteger 3 x) - True - False) - {all dead. string} - (/\dead -> "3") - (/\dead -> - Bool_match - (ifThenElse - {Bool} - (equalsInteger 4 x) - True - False) - {all dead. string} - (/\dead -> "4") - (/\dead -> - Bool_match - (ifThenElse - {Bool} - (equalsInteger 5 x) - True - False) - {all dead. string} - (/\dead -> "5") - (/\dead -> - Bool_match - (ifThenElse - {Bool} - (equalsInteger 6 x) - True - False) - {all dead. string} - (/\dead -> "6") - (/\dead -> - Bool_match - (ifThenElse - {Bool} - (equalsInteger 7 x) - True - False) - {all dead. string} - (/\dead -> "7") - (/\dead -> - Bool_match - (ifThenElse - {Bool} - (equalsInteger - 8 - x) - True - False) - {all dead. string} - (/\dead -> "8") - (/\dead -> - Bool_match - (ifThenElse - {Bool} - (equalsInteger - 9 - x) - True - False) - {string} - "9" - "") - {all dead. dead}) - {all dead. dead}) - {all dead. dead}) - {all dead. dead}) - {all dead. dead}) - {all dead. dead}) - {all dead. dead}) - {all dead. dead}) - {all dead. dead}) - (acc eta)) - {all dead. dead} -in -letrec - !`$fShowBuiltinByteString_$cshowsPrec` : - integer -> integer -> List string -> List string - = \(p : integer) (n : integer) -> - Bool_match - (ifThenElse {Bool} (lessThanInteger n 0) True False) - {all dead. List string -> List string} - (/\dead -> - \(eta : List string) -> - Cons - {string} - "-" - (`$fShowBuiltinByteString_$cshowsPrec` - p - (subtractInteger 0 n) - eta)) - (/\dead -> go (go (Nil {integer}) n)) - {all dead. dead} -in let data (Tuple5 :: * -> * -> * -> * -> * -> *) a b c d e | Tuple5_match where Tuple5 : a -> b -> c -> d -> e -> Tuple5 a b c d e - data (Tuple2 :: * -> * -> *) a b | Tuple2_match where - Tuple2 : a -> b -> Tuple2 a b -in -letrec - !go : all a. integer -> List a -> Tuple2 (List a) (List a) - = /\a -> - \(ds : integer) (ds : List a) -> - List_match - {a} - ds - {all dead. Tuple2 (List a) (List a)} - (/\dead -> Tuple2 {List a} {List a} (Nil {a}) (Nil {a})) - (\(y : a) (ys : List a) -> - /\dead -> - Bool_match - (ifThenElse {Bool} (equalsInteger 1 ds) True False) - {all dead. Tuple2 (List a) (List a)} - (/\dead -> - Tuple2 - {List a} - {List a} - ((let - a = List a - in - \(c : a -> a -> a) (n : a) -> c y n) - (\(ds : a) (ds : List a) -> Cons {a} ds ds) - (Nil {a})) - ys) - (/\dead -> - Tuple2_match - {List a} - {List a} - (go {a} (subtractInteger ds 1) ys) - {Tuple2 (List a) (List a)} - (\(zs : List a) (ws : List a) -> - Tuple2 {List a} {List a} (Cons {a} y zs) ws)) - {all dead. dead}) - {all dead. dead} -in -letrec - !go : List string -> integer - = \(ds : List string) -> - List_match - {string} - ds - {all dead. integer} - (/\dead -> 0) - (\(x : string) (xs : List string) -> /\dead -> addInteger 1 (go xs)) - {all dead. dead} -in -letrec - !concatBuiltinStrings : List string -> string - = \(ds : List string) -> - List_match - {string} - ds - {string} - "" - (\(x : string) (ds : List string) -> - List_match - {string} - ds - {all dead. string} - (/\dead -> x) - (\(ipv : string) (ipv : List string) -> - /\dead -> - Tuple2_match - {List string} - {List string} - (let - !n : integer = divideInteger (go ds) 2 - in - Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger n 0) - True - False) - {all dead. Tuple2 (List string) (List string)} - (/\dead -> - Tuple2 {List string} {List string} (Nil {string}) ds) - (/\dead -> go {string} n ds) - {all dead. dead}) - {string} - (\(ipv : List string) (ipv : List string) -> - appendString - (concatBuiltinStrings ipv) - (concatBuiltinStrings ipv))) - {all dead. dead}) -in -let data (Maybe :: * -> *) a | Maybe_match where Just : a -> Maybe a Nothing : Maybe a @@ -321,7 +82,7 @@ in let !nt : list (pair data data) = (let - b = (\k a -> list (pair data data)) integer bytestring + b = (\k a -> list (pair data data)) integer integer in \(k : integer -> b -> b) (z : b) -> letrec @@ -340,18 +101,11 @@ in (\(i : integer) -> let !ds : integer = addInteger n i - !ds : bytestring - = encodeUtf8 - (concatBuiltinStrings - (`$fShowBuiltinByteString_$cshowsPrec` - 0 - i - (Nil {string}))) in - \(ds : (\k a -> list (pair data data)) integer bytestring) -> + \(ds : (\k a -> list (pair data data)) integer integer) -> let !k : data = iData ds - !a : data = bData ds + !a : data = iData i !nilCase : list (pair data data) = mkCons {pair data data} (mkPairData k a) [] in @@ -375,7 +129,7 @@ in {all dead. dead}) in go ds) - (mkCons {pair data data} (mkPairData (iData n) (B #30)) []) + (mkCons {pair data data} (mkPairData (iData n) (I 0)) []) (`$fEnumBool_$cenumFromTo` 1 10) !nt : list (pair data data) = let @@ -402,37 +156,37 @@ in go nt in Tuple5 - {Maybe bytestring} - {Maybe bytestring} - {Maybe bytestring} - {Maybe bytestring} - {Maybe bytestring} - (lookup {integer} {bytestring} (\(i : integer) -> iData i) unBData n nt) + {Maybe integer} + {Maybe integer} + {Maybe integer} + {Maybe integer} + {Maybe integer} + (lookup {integer} {integer} (\(i : integer) -> iData i) unIData n nt) (lookup {integer} - {bytestring} + {integer} (\(i : integer) -> iData i) - unBData + unIData (addInteger 5 n) nt) (lookup {integer} - {bytestring} + {integer} (\(i : integer) -> iData i) - unBData + unIData (addInteger 10 n) nt) (lookup {integer} - {bytestring} + {integer} (\(i : integer) -> iData i) - unBData + unIData (addInteger 20 n) nt) (lookup {integer} - {bytestring} + {integer} (\(i : integer) -> iData i) - unBData + unIData (addInteger 5 n) nt) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden index e9376850d02..1967a9214ca 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden @@ -1,485 +1,162 @@ (program 1.1.0 ((\fix1 -> - (\`$fEnumBool_$cenumFromTo` -> - (\go -> - (\go -> - (\`$fShowBuiltinByteString_$cshowsPrec` -> - (\go -> - (\go -> - (\concatBuiltinStrings - n -> - (\caseList' -> - (\nt -> - (\nt -> - (\lookup -> - constr 0 - [ (lookup - (\i -> iData i) - unBData - n - nt) - , (lookup - (\i -> iData i) - unBData - (addInteger 5 n) - nt) - , (lookup - (\i -> iData i) - unBData - (addInteger 10 n) - nt) - , (lookup - (\i -> iData i) - unBData - (addInteger 20 n) - nt) - , (lookup - (\i -> iData i) - unBData - (addInteger 5 n) - nt) ]) - (\`$dToData` - `$dUnsafeFromData` - ds - ds -> - force - (case - ((\k -> - force - (fix1 - (\go - arg -> - delay - (caseList' - (constr 1 []) - (\hd -> - force - (force - (force - ifThenElse - (equalsData - k - (force - (force - fstPair) - hd)) - (delay - (delay - (\ds -> - constr 0 - [ (force - (force - sndPair) - hd) ]))) - (delay - (delay - (force - (go - (delay - (\x -> - x))))))))))) - (delay (\x -> x))) - ds) - (`$dToData` ds)) - [ (\a -> - delay - (constr 0 - [ (`$dUnsafeFromData` - a) ])) - , (delay (constr 1 [])) ]))) - ((\k -> - force - (fix1 - (\go - arg -> - delay - (caseList' - [] - (\hd - tl -> - force - (force - (force - ifThenElse - (equalsData - k - (force - (force - fstPair) - hd)) - (delay - (delay tl)) - (delay - (delay - (force - mkCons - hd - (force - (go - (delay - (\x -> - x))) - tl))))))))) - (delay (\x -> x))) - nt) - (iData (addInteger 5 n)))) - ((\z -> - (\go eta -> - go eta) - (fix1 - (\go - ds -> - force - (case - ds - [ (delay z) - , (\y - ys -> - delay - ((\ds -> - (\ds - ds -> - (\k -> - (\a -> - (\nilCase -> - force - (fix1 - (\go - arg -> - delay - (caseList' - nilCase - (\hd - tl -> - force - (force - (force - ifThenElse - (equalsData - k - (force - (force - fstPair) - hd)) - (delay - (delay - (force - mkCons - (mkPairData - k - a) - tl))) - (delay - (delay - (force - mkCons - hd - (force - (go - (delay - (\x -> - x))) - tl))))))))) - (delay - (\x -> - x))) - ds) - (force - mkCons - (mkPairData - k - a) - [])) - (bData ds)) - (iData ds)) - (encodeUtf8 - (concatBuiltinStrings - (`$fShowBuiltinByteString_$cshowsPrec` - 0 - y - (constr 0 - [ ]))))) - (addInteger n y) - (go ys))) ])))) - (force mkCons - (mkPairData (iData n) (B #30)) - []) - (`$fEnumBool_$cenumFromTo` 1 10))) - (\z f xs -> + (\`$fEnumBool_$cenumFromTo` + n -> + (\caseList' -> + (\nt -> + (\nt -> + (\lookup -> + constr 0 + [ (lookup (\i -> iData i) unIData n nt) + , (lookup (\i -> iData i) unIData (addInteger 5 n) nt) + , (lookup (\i -> iData i) unIData (addInteger 10 n) nt) + , (lookup (\i -> iData i) unIData (addInteger 20 n) nt) + , (lookup + (\i -> iData i) + unIData + (addInteger 5 n) + nt) ]) + (\`$dToData` + `$dUnsafeFromData` + ds + ds -> + force + (case + ((\k -> force - (force (force chooseList) - xs - (delay z) - (delay - (f - (force headList xs) - (force tailList xs)))))) - (fix1 - (\concatBuiltinStrings - ds -> - case - ds - [ "" - , (\x - ds -> - force - (case - ds - [ (delay x) - , (\ipv - ipv -> - delay - (case - ((\n -> - force - (force - (force - ifThenElse - (lessThanEqualsInteger - n - 0) - (delay - (delay - (constr 0 - [ (constr 0 - [ ]) - , ds ]))) - (delay - (delay + (fix1 + (\go + arg -> + delay + (caseList' + (constr 1 []) + (\hd -> + force + (force + (force + ifThenElse + (equalsData + k + (force + (force fstPair) + hd)) + (delay + (delay + (\ds -> + constr 0 + [ (force (force - go - n - ds)))))) - (divideInteger - (go ds) - 2)) - [ (\ipv - ipv -> - appendString - (concatBuiltinStrings - ipv) - (concatBuiltinStrings - ipv)) ])) ])) ]))) + sndPair) + hd) ]))) + (delay + (delay + (force + (go + (delay + (\x -> + x))))))))))) + (delay (\x -> x))) + ds) + (`$dToData` ds)) + [ (\a -> delay (constr 0 [(`$dUnsafeFromData` a)])) + , (delay (constr 1 [])) ]))) + ((\k -> + force (fix1 - (\go ds -> - force - (case - ds - [ (delay 0) - , (\x xs -> - delay (addInteger 1 (go xs))) ])))) + (\go arg -> + delay + (caseList' + [] + (\hd tl -> + force + (force + (force ifThenElse + (equalsData + k + (force (force fstPair) hd)) + (delay (delay tl)) + (delay + (delay + (force mkCons + hd + (force + (go (delay (\x -> x))) + tl))))))))) + (delay (\x -> x))) + nt) + (iData (addInteger 5 n)))) + ((\z -> + (\go eta -> + go eta) (fix1 (\go - arg -> - delay - (\ds - ds -> - force - (case - ds - [ (delay - (constr 0 - [(constr 0 []), (constr 0 [])])) - , (\y - ys -> - delay - (force - (force - (force - ifThenElse - (equalsInteger 1 ds) - (delay - (delay - (constr 0 - [ (constr 1 - [ y - , (constr 0 - []) ]) - , ys ]))) - (delay - (delay - (case - (force - (go - (delay - (\x -> - x))) - (subtractInteger - ds - 1) - ys) - [ (\zs - ws -> - constr 0 - [ (constr 1 - [ y - , zs ]) - , ws ]) ]))))))) ]))) - (delay (\x -> x)))) - (fix1 - (\`$fShowBuiltinByteString_$cshowsPrec` - p - n -> - force - (force - (force - ifThenElse - (lessThanInteger n 0) - (delay - (delay - (\eta -> - constr 1 - [ "-" - , (`$fShowBuiltinByteString_$cshowsPrec` - p - (subtractInteger 0 n) - eta) ]))) - (delay (delay (go (go (constr 0 []) n))))))))) - (fix1 - (\go - ds -> - force - (case - ds - [ (delay (\x -> x)) - , (\x - xs -> - delay - ((\acc - eta -> - constr 1 - [ (force - (force - (force - ifThenElse - (equalsInteger 0 x) - (delay (delay "0")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 1 - x) - (delay - (delay "1")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 2 - x) - (delay - (delay - "2")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 3 - x) - (delay - (delay - "3")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 4 - x) - (delay - (delay - "4")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 5 - x) - (delay - (delay - "5")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 6 - x) - (delay - (delay - "6")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 7 - x) - (delay - (delay - "7")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 8 - x) - (delay - (delay - "8")) - (delay - (delay - (force - (force - ifThenElse - (equalsInteger - 9 - x) - (delay - "9") - (delay - "")))))))))))))))))))))))))))))))))))))))))))))))) - , (acc eta) ]) - (go xs))) ])))) - (fix1 - (\go acc n -> - (\x -> - force - (force - (force ifThenElse - (equalsInteger 0 x) - (delay - (delay - (constr 1 [(remainderInteger n 10), acc]))) - (delay - (delay - (go - (constr 1 [(remainderInteger n 10), acc]) - x)))))) - (quotientInteger n 10)))) + ds -> + force + (case + ds + [ (delay z) + , (\y + ys -> + delay + ((\ds -> + (\k -> + (\a -> + (\nilCase -> + force + (fix1 + (\go + arg -> + delay + (caseList' + nilCase + (\hd + tl -> + force + (force + (force + ifThenElse + (equalsData + k + (force + (force + fstPair) + hd)) + (delay + (delay + (force + mkCons + (mkPairData + k + a) + tl))) + (delay + (delay + (force + mkCons + hd + (force + (go + (delay + (\x -> + x))) + tl))))))))) + (delay (\x -> x))) + ds) + (force mkCons + (mkPairData k a) + [])) + (iData y)) + (iData (addInteger n y))) + (go ys))) ])))) + (force mkCons (mkPairData (iData n) (I 0)) []) + (`$fEnumBool_$cenumFromTo` 1 10))) + (\z f xs -> + force + (force (force chooseList) + xs + (delay z) + (delay (f (force headList xs) (force tailList xs)))))) (fix1 (\`$fEnumBool_$cenumFromTo` x lim -> force diff --git a/plutus-tx-plugin/test/Budget/9.6/map2-budget.budget.golden b/plutus-tx-plugin/test/Budget/9.6/map2-budget.budget.golden index 432791a44b6..c13a0f75dc8 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map2-budget.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map2-budget.budget.golden @@ -1,2 +1,2 @@ -({cpu: 138097368 -| mem: 465626}) \ No newline at end of file +({cpu: 134696515 +| mem: 446782}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map2.eval.golden b/plutus-tx-plugin/test/Budget/9.6/map2.eval.golden index e8e3b12565c..5bd4d9be18b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map2.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map2.eval.golden @@ -1,24 +1,22 @@ (constr 1 - (constr 0 (con integer 105) (con string "five")) + (constr 0 (con integer 105) (con integer 5)) (constr 1 - (constr 0 (con integer 104) (con string "fourFOUR")) + (constr 0 (con integer 104) (con integer 48)) (constr 1 - (constr 0 (con integer 103) (con string "threeTHREE")) + (constr 0 (con integer 103) (con integer 36)) (constr 1 - (constr 0 (con integer 102) (con string "two")) + (constr 0 (con integer 102) (con integer 2)) (constr 1 - (constr 0 (con integer 101) (con string "one")) + (constr 0 (con integer 101) (con integer 1)) (constr 1 - (constr 0 (con integer 106) (con string "SIX")) - (constr - 1 (constr 0 (con integer 107) (con string "SEVEN")) (constr 0) - ) + (constr 0 (con integer 106) (con integer 66)) + (constr 1 (constr 0 (con integer 107) (con integer 77)) (constr 0)) ) ) ) diff --git a/plutus-tx-plugin/test/Budget/9.6/map2.pir.golden b/plutus-tx-plugin/test/Budget/9.6/map2.pir.golden index 2a8e73cb7e8..efefa183e36 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map2.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map2.pir.golden @@ -18,19 +18,19 @@ letrec Cons : a -> List a -> List a in letrec - ~go : list (pair data data) -> List (Tuple2 integer bytestring) + ~go : list (pair data data) -> List (Tuple2 integer integer) = caseList' {pair data data} - {List (Tuple2 integer bytestring)} - (Nil {Tuple2 integer bytestring}) + {List (Tuple2 integer integer)} + (Nil {Tuple2 integer integer}) (\(hd : pair data data) (tl : list (pair data data)) -> Cons - {Tuple2 integer bytestring} + {Tuple2 integer integer} (Tuple2 {integer} - {bytestring} + {integer} (unIData (fstPair {data} {data} hd)) - (unBData (sndPair {data} {data} hd))) + (unIData (sndPair {data} {data} hd))) (go tl)) in letrec @@ -112,36 +112,24 @@ in !nt : list (pair data data) = unsafeFromList {integer} - {bytestring} + {integer} + (\(i : integer) -> iData i) (\(i : integer) -> iData i) - bData ((let - a = Tuple2 integer bytestring + a = Tuple2 integer integer in \(g : all b. (a -> b -> b) -> b -> b) -> g {List a} (\(ds : a) (ds : List a) -> Cons {a} ds ds) (Nil {a})) (/\a -> - \(c : Tuple2 integer bytestring -> a -> a) (n : a) -> + \(c : Tuple2 integer integer -> a -> a) (n : a) -> c - (Tuple2 {integer} {bytestring} (addInteger 3 n) #5448524545) + (Tuple2 {integer} {integer} (addInteger 3 n) 33) (c - (Tuple2 - {integer} - {bytestring} - (addInteger 4 n) - #464f5552) + (Tuple2 {integer} {integer} (addInteger 4 n) 44) (c - (Tuple2 - {integer} - {bytestring} - (addInteger 6 n) - #534958) + (Tuple2 {integer} {integer} (addInteger 6 n) 66) (c - (Tuple2 - {integer} - {bytestring} - (addInteger 7 n) - #534556454e) + (Tuple2 {integer} {integer} (addInteger 7 n) 77) n))))) in letrec @@ -185,7 +173,7 @@ in {pair data data} (mkPairData k' - (bData (appendByteString (unBData v') (unBData r)))) + (iData (addInteger (unIData v') (unIData r)))) (go tl)) (/\dead -> mkCons {pair data data} (mkPairData k' v') (go tl)) {all dead. dead}) @@ -194,38 +182,26 @@ in !nt : list (pair data data) = unsafeFromList {integer} - {bytestring} + {integer} + (\(i : integer) -> iData i) (\(i : integer) -> iData i) - bData ((let - a = Tuple2 integer bytestring + a = Tuple2 integer integer in \(g : all b. (a -> b -> b) -> b -> b) -> g {List a} (\(ds : a) (ds : List a) -> Cons {a} ds ds) (Nil {a})) (/\a -> - \(c : Tuple2 integer bytestring -> a -> a) (n : a) -> + \(c : Tuple2 integer integer -> a -> a) (n : a) -> c - (Tuple2 {integer} {bytestring} (addInteger 1 n) #6f6e65) + (Tuple2 {integer} {integer} (addInteger 1 n) 1) (c - (Tuple2 {integer} {bytestring} (addInteger 2 n) #74776f) + (Tuple2 {integer} {integer} (addInteger 2 n) 2) (c - (Tuple2 - {integer} - {bytestring} - (addInteger 3 n) - #7468726565) + (Tuple2 {integer} {integer} (addInteger 3 n) 3) (c - (Tuple2 - {integer} - {bytestring} - (addInteger 4 n) - #666f7572) + (Tuple2 {integer} {integer} (addInteger 4 n) 4) (c - (Tuple2 - {integer} - {bytestring} - (addInteger 5 n) - #66697665) + (Tuple2 {integer} {integer} (addInteger 5 n) 5) n)))))) in letrec @@ -274,30 +250,4 @@ in in go rs' ls' in - (let - a = Tuple2 integer bytestring - in - /\b -> - \(f : a -> b) -> - letrec - !go : List a -> List b - = \(ds : List a) -> - List_match - {a} - ds - {all dead. List b} - (/\dead -> Nil {b}) - (\(x : a) (xs : List a) -> /\dead -> Cons {b} (f x) (go xs)) - {all dead. dead} - in - \(eta : List a) -> go eta) - {Tuple2 integer string} - (\(ds : Tuple2 integer bytestring) -> - Tuple2_match - {integer} - {bytestring} - ds - {Tuple2 integer string} - (\(k : integer) (v : bytestring) -> - Tuple2 {integer} {string} k (decodeUtf8 v))) - (go nt) \ No newline at end of file + go nt \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden index 140bc4e7dae..3be003ef59a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden @@ -11,24 +11,7 @@ (\go -> (\nt -> (\nt -> - fix1 - (\go ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (constr 1 - [ (case - x - [ (\k v -> - constr 0 - [ k - , (decodeUtf8 - v) ]) ]) - , (go xs) ])) ])) - (force go nt)) + force go nt) ((\rs' -> (\ls' -> go rs' ls') (force go nt)) (force @@ -95,24 +78,20 @@ nt))) (unsafeFromList (\i -> iData i) - bData + (\i -> iData i) (constr 1 - [ (constr 0 [(addInteger 1 n), #6f6e65]) + [ (constr 0 [(addInteger 1 n), 1]) , (constr 1 - [ (constr 0 - [(addInteger 2 n), #74776f]) + [ (constr 0 [(addInteger 2 n), 2]) , (constr 1 - [ (constr 0 - [ (addInteger 3 n) - , #7468726565 ]) + [ (constr 0 [(addInteger 3 n), 3]) , (constr 1 [ (constr 0 - [ (addInteger 4 n) - , #666f7572 ]) + [(addInteger 4 n), 4]) , (constr 1 [ (constr 0 [ (addInteger 5 n) - , #66697665 ]) + , 5 ]) , (constr 0 [ ]) ]) ]) ]) ]) ]))) (fix1 @@ -164,15 +143,14 @@ nt) [ (\r -> delay - (force - mkCons + (force mkCons (mkPairData k' - (bData - (appendByteString - (unBData + (iData + (addInteger + (unIData v') - (unBData + (unIData r)))) (force (go @@ -193,17 +171,15 @@ (delay (\x -> x)))) (unsafeFromList (\i -> iData i) - bData + (\i -> iData i) (constr 1 - [ (constr 0 [(addInteger 3 n), #5448524545]) + [ (constr 0 [(addInteger 3 n), 33]) , (constr 1 - [ (constr 0 [(addInteger 4 n), #464f5552]) + [ (constr 0 [(addInteger 4 n), 44]) , (constr 1 - [ (constr 0 [(addInteger 6 n), #534958]) + [ (constr 0 [(addInteger 6 n), 66]) , (constr 1 - [ (constr 0 - [ (addInteger 7 n) - , #534556454e ]) + [ (constr 0 [(addInteger 7 n), 77]) , (constr 0 []) ]) ]) ]) ]))) (\`$dToData` `$dToData` -> (\go eta -> goList (go eta)) @@ -244,7 +220,7 @@ constr 1 [ (constr 0 [ (unIData (force (force fstPair) hd)) - , (unBData (force (force sndPair) hd)) ]) + , (unIData (force (force sndPair) hd)) ]) , (force (go (delay (\x -> x))) tl) ]))) (delay (\x -> x)))) (\z f xs -> diff --git a/plutus-tx-plugin/test/Budget/9.6/map3-budget.budget.golden b/plutus-tx-plugin/test/Budget/9.6/map3-budget.budget.golden index 432791a44b6..c13a0f75dc8 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map3-budget.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map3-budget.budget.golden @@ -1,2 +1,2 @@ -({cpu: 138097368 -| mem: 465626}) \ No newline at end of file +({cpu: 134696515 +| mem: 446782}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map3.eval.golden b/plutus-tx-plugin/test/Budget/9.6/map3.eval.golden index e8e3b12565c..5bd4d9be18b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map3.eval.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map3.eval.golden @@ -1,24 +1,22 @@ (constr 1 - (constr 0 (con integer 105) (con string "five")) + (constr 0 (con integer 105) (con integer 5)) (constr 1 - (constr 0 (con integer 104) (con string "fourFOUR")) + (constr 0 (con integer 104) (con integer 48)) (constr 1 - (constr 0 (con integer 103) (con string "threeTHREE")) + (constr 0 (con integer 103) (con integer 36)) (constr 1 - (constr 0 (con integer 102) (con string "two")) + (constr 0 (con integer 102) (con integer 2)) (constr 1 - (constr 0 (con integer 101) (con string "one")) + (constr 0 (con integer 101) (con integer 1)) (constr 1 - (constr 0 (con integer 106) (con string "SIX")) - (constr - 1 (constr 0 (con integer 107) (con string "SEVEN")) (constr 0) - ) + (constr 0 (con integer 106) (con integer 66)) + (constr 1 (constr 0 (con integer 107) (con integer 77)) (constr 0)) ) ) ) diff --git a/plutus-tx-plugin/test/Budget/9.6/map3.pir.golden b/plutus-tx-plugin/test/Budget/9.6/map3.pir.golden index 2a8e73cb7e8..efefa183e36 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map3.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map3.pir.golden @@ -18,19 +18,19 @@ letrec Cons : a -> List a -> List a in letrec - ~go : list (pair data data) -> List (Tuple2 integer bytestring) + ~go : list (pair data data) -> List (Tuple2 integer integer) = caseList' {pair data data} - {List (Tuple2 integer bytestring)} - (Nil {Tuple2 integer bytestring}) + {List (Tuple2 integer integer)} + (Nil {Tuple2 integer integer}) (\(hd : pair data data) (tl : list (pair data data)) -> Cons - {Tuple2 integer bytestring} + {Tuple2 integer integer} (Tuple2 {integer} - {bytestring} + {integer} (unIData (fstPair {data} {data} hd)) - (unBData (sndPair {data} {data} hd))) + (unIData (sndPair {data} {data} hd))) (go tl)) in letrec @@ -112,36 +112,24 @@ in !nt : list (pair data data) = unsafeFromList {integer} - {bytestring} + {integer} + (\(i : integer) -> iData i) (\(i : integer) -> iData i) - bData ((let - a = Tuple2 integer bytestring + a = Tuple2 integer integer in \(g : all b. (a -> b -> b) -> b -> b) -> g {List a} (\(ds : a) (ds : List a) -> Cons {a} ds ds) (Nil {a})) (/\a -> - \(c : Tuple2 integer bytestring -> a -> a) (n : a) -> + \(c : Tuple2 integer integer -> a -> a) (n : a) -> c - (Tuple2 {integer} {bytestring} (addInteger 3 n) #5448524545) + (Tuple2 {integer} {integer} (addInteger 3 n) 33) (c - (Tuple2 - {integer} - {bytestring} - (addInteger 4 n) - #464f5552) + (Tuple2 {integer} {integer} (addInteger 4 n) 44) (c - (Tuple2 - {integer} - {bytestring} - (addInteger 6 n) - #534958) + (Tuple2 {integer} {integer} (addInteger 6 n) 66) (c - (Tuple2 - {integer} - {bytestring} - (addInteger 7 n) - #534556454e) + (Tuple2 {integer} {integer} (addInteger 7 n) 77) n))))) in letrec @@ -185,7 +173,7 @@ in {pair data data} (mkPairData k' - (bData (appendByteString (unBData v') (unBData r)))) + (iData (addInteger (unIData v') (unIData r)))) (go tl)) (/\dead -> mkCons {pair data data} (mkPairData k' v') (go tl)) {all dead. dead}) @@ -194,38 +182,26 @@ in !nt : list (pair data data) = unsafeFromList {integer} - {bytestring} + {integer} + (\(i : integer) -> iData i) (\(i : integer) -> iData i) - bData ((let - a = Tuple2 integer bytestring + a = Tuple2 integer integer in \(g : all b. (a -> b -> b) -> b -> b) -> g {List a} (\(ds : a) (ds : List a) -> Cons {a} ds ds) (Nil {a})) (/\a -> - \(c : Tuple2 integer bytestring -> a -> a) (n : a) -> + \(c : Tuple2 integer integer -> a -> a) (n : a) -> c - (Tuple2 {integer} {bytestring} (addInteger 1 n) #6f6e65) + (Tuple2 {integer} {integer} (addInteger 1 n) 1) (c - (Tuple2 {integer} {bytestring} (addInteger 2 n) #74776f) + (Tuple2 {integer} {integer} (addInteger 2 n) 2) (c - (Tuple2 - {integer} - {bytestring} - (addInteger 3 n) - #7468726565) + (Tuple2 {integer} {integer} (addInteger 3 n) 3) (c - (Tuple2 - {integer} - {bytestring} - (addInteger 4 n) - #666f7572) + (Tuple2 {integer} {integer} (addInteger 4 n) 4) (c - (Tuple2 - {integer} - {bytestring} - (addInteger 5 n) - #66697665) + (Tuple2 {integer} {integer} (addInteger 5 n) 5) n)))))) in letrec @@ -274,30 +250,4 @@ in in go rs' ls' in - (let - a = Tuple2 integer bytestring - in - /\b -> - \(f : a -> b) -> - letrec - !go : List a -> List b - = \(ds : List a) -> - List_match - {a} - ds - {all dead. List b} - (/\dead -> Nil {b}) - (\(x : a) (xs : List a) -> /\dead -> Cons {b} (f x) (go xs)) - {all dead. dead} - in - \(eta : List a) -> go eta) - {Tuple2 integer string} - (\(ds : Tuple2 integer bytestring) -> - Tuple2_match - {integer} - {bytestring} - ds - {Tuple2 integer string} - (\(k : integer) (v : bytestring) -> - Tuple2 {integer} {string} k (decodeUtf8 v))) - (go nt) \ No newline at end of file + go nt \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden index 140bc4e7dae..3be003ef59a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden @@ -11,24 +11,7 @@ (\go -> (\nt -> (\nt -> - fix1 - (\go ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (constr 1 - [ (case - x - [ (\k v -> - constr 0 - [ k - , (decodeUtf8 - v) ]) ]) - , (go xs) ])) ])) - (force go nt)) + force go nt) ((\rs' -> (\ls' -> go rs' ls') (force go nt)) (force @@ -95,24 +78,20 @@ nt))) (unsafeFromList (\i -> iData i) - bData + (\i -> iData i) (constr 1 - [ (constr 0 [(addInteger 1 n), #6f6e65]) + [ (constr 0 [(addInteger 1 n), 1]) , (constr 1 - [ (constr 0 - [(addInteger 2 n), #74776f]) + [ (constr 0 [(addInteger 2 n), 2]) , (constr 1 - [ (constr 0 - [ (addInteger 3 n) - , #7468726565 ]) + [ (constr 0 [(addInteger 3 n), 3]) , (constr 1 [ (constr 0 - [ (addInteger 4 n) - , #666f7572 ]) + [(addInteger 4 n), 4]) , (constr 1 [ (constr 0 [ (addInteger 5 n) - , #66697665 ]) + , 5 ]) , (constr 0 [ ]) ]) ]) ]) ]) ]))) (fix1 @@ -164,15 +143,14 @@ nt) [ (\r -> delay - (force - mkCons + (force mkCons (mkPairData k' - (bData - (appendByteString - (unBData + (iData + (addInteger + (unIData v') - (unBData + (unIData r)))) (force (go @@ -193,17 +171,15 @@ (delay (\x -> x)))) (unsafeFromList (\i -> iData i) - bData + (\i -> iData i) (constr 1 - [ (constr 0 [(addInteger 3 n), #5448524545]) + [ (constr 0 [(addInteger 3 n), 33]) , (constr 1 - [ (constr 0 [(addInteger 4 n), #464f5552]) + [ (constr 0 [(addInteger 4 n), 44]) , (constr 1 - [ (constr 0 [(addInteger 6 n), #534958]) + [ (constr 0 [(addInteger 6 n), 66]) , (constr 1 - [ (constr 0 - [ (addInteger 7 n) - , #534556454e ]) + [ (constr 0 [(addInteger 7 n), 77]) , (constr 0 []) ]) ]) ]) ]))) (\`$dToData` `$dToData` -> (\go eta -> goList (go eta)) @@ -244,7 +220,7 @@ constr 1 [ (constr 0 [ (unIData (force (force fstPair) hd)) - , (unBData (force (force sndPair) hd)) ]) + , (unIData (force (force sndPair) hd)) ]) , (force (go (delay (\x -> x))) tl) ]))) (delay (\x -> x)))) (\z f xs -> diff --git a/plutus-tx-plugin/test/ByteStringLiterals/Spec.hs b/plutus-tx-plugin/test/ByteStringLiterals/Spec.hs new file mode 100644 index 00000000000..dbf9197d07d --- /dev/null +++ b/plutus-tx-plugin/test/ByteStringLiterals/Spec.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +module ByteStringLiterals.Spec (tests) where + +import Data.ByteString (ByteString) +import Data.Char (chr) +import Data.Foldable (for_) +import Data.String (fromString) +import PlutusPrelude (display) +import PlutusTx (CompiledCode, getPlcNoAnn) +import PlutusTx.Builtins (BuiltinByteString, fromBuiltin) +import PlutusTx.Builtins.HasOpaque (stringToBuiltinByteString) +import PlutusTx.TH (compile) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (testCase, (@?=)) +import UntypedPlutusCore (Program (_progTerm)) + +tests :: TestTree +tests = + testGroup + "ByteStringLiterals" + [ test_FromString + , testGroup + "Compile BuiltinByteString Literal" + [ test_CompileBuiltinByteStringLiteral_IsString + , test_CompileBuiltinByteStringLiteral_StringToBuiltinByteString + ] + ] + +test_FromString :: TestTree +test_FromString = testCase "fromString" do + for_ [0x00 .. 0xFF] \(i :: Int) -> do + let s :: String = [chr i] + fromBuiltin (fromString @BuiltinByteString s) @?= fromString @ByteString s + +test_CompileBuiltinByteStringLiteral_IsString :: TestTree +test_CompileBuiltinByteStringLiteral_IsString = + testCase "OverloadedStrings" do + display (_progTerm (getPlcNoAnn compiledLiteral)) @?= expectedUplc + where + compiledLiteral :: CompiledCode BuiltinByteString = + $$( compile + [|| + "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x0C\x0D\x0E\x0F\ + \\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1A\x1B\x1C\x1D\x1E\x1F\ + \\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2A\x2B\x2C\x2D\x2E\x2F\ + \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3A\x3B\x3C\x3D\x3E\x3F\ + \\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4A\x4B\x4C\x4D\x4E\x4F\ + \\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5A\x5B\x5C\x5D\x5E\x5F\ + \\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6A\x6B\x6C\x6D\x6E\x6F\ + \\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7A\x7B\x7C\x7D\x7E\x7F\ + \\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8A\x8B\x8C\x8D\x8E\x8F\ + \\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9A\x9B\x9C\x9D\x9E\x9F\ + \\xA0\xA1\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xAB\xAC\xAD\xAE\xAF\ + \\xB0\xB1\xB2\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xBB\xBC\xBD\xBE\xBF\ + \\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF\ + \\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF\ + \\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF\ + \\xF0\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA\xFB\xFC\xFD\xFE\xFF" + ||] + ) + +test_CompileBuiltinByteStringLiteral_StringToBuiltinByteString :: TestTree +test_CompileBuiltinByteStringLiteral_StringToBuiltinByteString = + testCase "stringToBuiltinByteString" do + display (_progTerm (getPlcNoAnn compiledLiteral)) @?= expectedUplc + where + compiledLiteral :: CompiledCode BuiltinByteString = + $$( compile + [|| + stringToBuiltinByteString + "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x0C\x0D\x0E\x0F\ + \\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1A\x1B\x1C\x1D\x1E\x1F\ + \\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2A\x2B\x2C\x2D\x2E\x2F\ + \\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3A\x3B\x3C\x3D\x3E\x3F\ + \\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4A\x4B\x4C\x4D\x4E\x4F\ + \\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5A\x5B\x5C\x5D\x5E\x5F\ + \\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6A\x6B\x6C\x6D\x6E\x6F\ + \\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7A\x7B\x7C\x7D\x7E\x7F\ + \\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8A\x8B\x8C\x8D\x8E\x8F\ + \\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9A\x9B\x9C\x9D\x9E\x9F\ + \\xA0\xA1\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xAB\xAC\xAD\xAE\xAF\ + \\xB0\xB1\xB2\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xBB\xBC\xBD\xBE\xBF\ + \\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF\ + \\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF\ + \\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF\ + \\xF0\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA\xFB\xFC\xFD\xFE\xFF" + ||] + ) + +expectedUplc :: String +expectedUplc = + "(con\n bytestring\n #\ + \000102030405060708090a0b0c0d0e0f\ + \101112131415161718191a1b1c1d1e1f\ + \202122232425262728292a2b2c2d2e2f\ + \303132333435363738393a3b3c3d3e3f\ + \404142434445464748494a4b4c4d4e4f\ + \505152535455565758595a5b5c5d5e5f\ + \606162636465666768696a6b6c6d6e6f\ + \707172737475767778797a7b7c7d7e7f\ + \808182838485868788898a8b8c8d8e8f\ + \909192939495969798999a9b9c9d9e9f\ + \a0a1a2a3a4a5a6a7a8a9aaabacadaeaf\ + \b0b1b2b3b4b5b6b7b8b9babbbcbdbebf\ + \c0c1c2c3c4c5c6c7c8c9cacbcccdcecf\ + \d0d1d2d3d4d5d6d7d8d9dadbdcdddedf\ + \e0e1e2e3e4e5e6e7e8e9eaebecedeeef\ + \f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff\ + \\n)" diff --git a/plutus-tx-plugin/test/Spec.hs b/plutus-tx-plugin/test/Spec.hs index a7b4b505a58..f9b3a5acf10 100644 --- a/plutus-tx-plugin/test/Spec.hs +++ b/plutus-tx-plugin/test/Spec.hs @@ -4,6 +4,7 @@ import AsData.Budget.Spec qualified as AsData.Budget import AssocMap.Spec qualified as AssocMap import Blueprint.Tests qualified import Budget.Spec qualified as Budget +import ByteStringLiterals.Spec qualified as ByteStringLiterals import IntegerLiterals.NoStrict.NegativeLiterals.Spec qualified import IntegerLiterals.NoStrict.NoNegativeLiterals.Spec qualified import IntegerLiterals.Strict.NegativeLiterals.Spec qualified @@ -26,12 +27,14 @@ main = defaultMain tests tests :: TestTree tests = - runTestNested ["test"] + runTestNested + ["test"] [ Plugin.tests , IntegerLiterals.NoStrict.NegativeLiterals.Spec.tests , IntegerLiterals.NoStrict.NoNegativeLiterals.Spec.tests , IntegerLiterals.Strict.NegativeLiterals.Spec.tests , IntegerLiterals.Strict.NoNegativeLiterals.Spec.tests + , embed ByteStringLiterals.tests , IsData.tests , Lift.tests , TH.tests diff --git a/plutus-tx/src/PlutusTx/Builtins/HasOpaque.hs b/plutus-tx/src/PlutusTx/Builtins/HasOpaque.hs index ed784740a52..d254beeefa3 100644 --- a/plutus-tx/src/PlutusTx/Builtins/HasOpaque.hs +++ b/plutus-tx/src/PlutusTx/Builtins/HasOpaque.hs @@ -43,7 +43,7 @@ an unfolding. -} stringToBuiltinByteString :: Haskell.String -> BuiltinByteString -stringToBuiltinByteString str = encodeUtf8 $ stringToBuiltinString str +stringToBuiltinByteString str = BuiltinByteString (fromString str) {-# OPAQUE stringToBuiltinByteString #-} stringToBuiltinString :: Haskell.String -> BuiltinString