From 68f4b19dd059d4150b958feba069466d188466e0 Mon Sep 17 00:00:00 2001 From: Ziyang Liu Date: Thu, 16 Mar 2023 13:12:13 -0700 Subject: [PATCH] KnownApps --- .../test/Sum/left-fold-built-in.budget.golden | 2 + .../test/Sum/left-fold-data.budget.golden | 2 + .../test/Sum/left-fold-scott.budget.golden | 2 + .../Sum/right-fold-built-in.budget.golden | 2 + .../test/Sum/right-fold-data.budget.golden | 2 + .../test/Sum/right-fold-scott.budget.golden | 2 + .../nofib/src/PlutusBenchmark/NoFib/Queens.hs | 9 +- plutus-benchmark/nofib/test/Spec.hs | 6 +- .../nofib/test/formulaBudget.budget.golden | 2 + .../nofib/test/knightsBudget.budget.golden | 2 + .../nofib/test/queens4budget.budget.golden | 2 + .../nofib/test/queens5budget.budget.golden | 2 + .../src/PlutusBenchmark/ScriptContexts.hs | 7 +- ...kScriptContexEqualityData-20.budget.golden | 2 + .../test/checkScriptContext1-20.budget.golden | 2 + .../test/checkScriptContext1-4.budget.golden | 2 + .../test/checkScriptContext2-20.budget.golden | 2 + .../test/checkScriptContext2-4.budget.golden | 2 + ...ptContextEqualityOverhead-20.budget.golden | 2 + ...ScriptContextEqualityTerm-20.budget.golden | 2 + .../src/PlutusIR/Compiler/Definitions.hs | 2 +- .../src/PlutusLedgerApi/V1/Contexts.hs | 6 +- plutus-tx-plugin/plutus-tx-plugin.cabal | 1 + .../src/PlutusTx/Compiler/Expr.hs | 100 ++- .../src/PlutusTx/Compiler/Types.hs | 59 ++ plutus-tx-plugin/src/PlutusTx/Plugin.hs | 23 +- .../test/Budget/show.budget.golden | 2 + plutus-tx-plugin/test/Budget/show.plc.golden | 664 ++++++++++++++++++ .../Plugin/Errors/literalCaseBs.plc.golden | 4 +- .../Plugin/Errors/literalCaseInt.plc.golden | 86 ++- .../Plugin/Errors/literalCaseOther.plc.golden | 3 +- 31 files changed, 977 insertions(+), 29 deletions(-) create mode 100644 plutus-benchmark/lists/test/Sum/left-fold-built-in.budget.golden create mode 100644 plutus-benchmark/lists/test/Sum/left-fold-data.budget.golden create mode 100644 plutus-benchmark/lists/test/Sum/left-fold-scott.budget.golden create mode 100644 plutus-benchmark/lists/test/Sum/right-fold-built-in.budget.golden create mode 100644 plutus-benchmark/lists/test/Sum/right-fold-data.budget.golden create mode 100644 plutus-benchmark/lists/test/Sum/right-fold-scott.budget.golden create mode 100644 plutus-benchmark/nofib/test/formulaBudget.budget.golden create mode 100644 plutus-benchmark/nofib/test/knightsBudget.budget.golden create mode 100644 plutus-benchmark/nofib/test/queens4budget.budget.golden create mode 100644 plutus-benchmark/nofib/test/queens5budget.budget.golden create mode 100644 plutus-benchmark/script-contexts/test/checkScriptContexEqualityData-20.budget.golden create mode 100644 plutus-benchmark/script-contexts/test/checkScriptContext1-20.budget.golden create mode 100644 plutus-benchmark/script-contexts/test/checkScriptContext1-4.budget.golden create mode 100644 plutus-benchmark/script-contexts/test/checkScriptContext2-20.budget.golden create mode 100644 plutus-benchmark/script-contexts/test/checkScriptContext2-4.budget.golden create mode 100644 plutus-benchmark/script-contexts/test/checkScriptContextEqualityOverhead-20.budget.golden create mode 100644 plutus-benchmark/script-contexts/test/checkScriptContextEqualityTerm-20.budget.golden diff --git a/plutus-benchmark/lists/test/Sum/left-fold-built-in.budget.golden b/plutus-benchmark/lists/test/Sum/left-fold-built-in.budget.golden new file mode 100644 index 00000000000..c3dad1d4b3f --- /dev/null +++ b/plutus-benchmark/lists/test/Sum/left-fold-built-in.budget.golden @@ -0,0 +1,2 @@ +({cpu: 160559654 +| mem: 504532}) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Sum/left-fold-data.budget.golden b/plutus-benchmark/lists/test/Sum/left-fold-data.budget.golden new file mode 100644 index 00000000000..c2101ba6379 --- /dev/null +++ b/plutus-benchmark/lists/test/Sum/left-fold-data.budget.golden @@ -0,0 +1,2 @@ +({cpu: 422780685 +| mem: 1340362}) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Sum/left-fold-scott.budget.golden b/plutus-benchmark/lists/test/Sum/left-fold-scott.budget.golden new file mode 100644 index 00000000000..0a5bd881505 --- /dev/null +++ b/plutus-benchmark/lists/test/Sum/left-fold-scott.budget.golden @@ -0,0 +1,2 @@ +({cpu: 150781800 +| mem: 566100}) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Sum/right-fold-built-in.budget.golden b/plutus-benchmark/lists/test/Sum/right-fold-built-in.budget.golden new file mode 100644 index 00000000000..ba994d8016f --- /dev/null +++ b/plutus-benchmark/lists/test/Sum/right-fold-built-in.budget.golden @@ -0,0 +1,2 @@ +({cpu: 167459654 +| mem: 534532}) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Sum/right-fold-data.budget.golden b/plutus-benchmark/lists/test/Sum/right-fold-data.budget.golden new file mode 100644 index 00000000000..2cf1c44f181 --- /dev/null +++ b/plutus-benchmark/lists/test/Sum/right-fold-data.budget.golden @@ -0,0 +1,2 @@ +({cpu: 429680685 +| mem: 1370362}) \ No newline at end of file diff --git a/plutus-benchmark/lists/test/Sum/right-fold-scott.budget.golden b/plutus-benchmark/lists/test/Sum/right-fold-scott.budget.golden new file mode 100644 index 00000000000..7e2f0e82336 --- /dev/null +++ b/plutus-benchmark/lists/test/Sum/right-fold-scott.budget.golden @@ -0,0 +1,2 @@ +({cpu: 157681800 +| mem: 596100}) \ No newline at end of file diff --git a/plutus-benchmark/nofib/src/PlutusBenchmark/NoFib/Queens.hs b/plutus-benchmark/nofib/src/PlutusBenchmark/NoFib/Queens.hs index 33e38dd6079..bd845ea3d76 100644 --- a/plutus-benchmark/nofib/src/PlutusBenchmark/NoFib/Queens.hs +++ b/plutus-benchmark/nofib/src/PlutusBenchmark/NoFib/Queens.hs @@ -392,8 +392,8 @@ btr seed csp = bt csp . hrandom seed {-# INLINABLE random2 #-} random2 :: Integer -> Integer -random2 n = if test > 0 then test else test + 2147483647 - where test = 16807 * lo - 2836 * hi +random2 n = if test > 0 then test else test Haskell.+ 2147483647 + where test = 16807 Haskell.* lo - 2836 Haskell.* hi hi = n `Haskell.div` 127773 lo = n `Haskell.rem` 127773 @@ -403,7 +403,7 @@ randoms k = iterateN k random2 {-# INLINABLE random #-} random :: Integer -> Integer -random n = (a * n + c) -- mod m +random n = (a Haskell.* n Haskell.+ c) -- mod m where a = 994108973 c = a @@ -435,7 +435,8 @@ cacheChecks csp tbl (Node s cs) = fillTable :: State -> CSP -> Table -> Table fillTable [] csp tbl = tbl fillTable ((var' := val'):as) CSP{vars=vars,vals=vals,rel=rel} tbl = - zipWith (zipWith f) tbl [[(var,val) | val <- interval 1 vals] | var <- interval (var'+1) vars] + zipWith (zipWith f) tbl + [[(var,val) | val <- interval 1 vals] | var <- interval (var' Haskell.+ 1) vars] where f cs (var,val) = if cs == Unknown && not (rel (var' := val') (var := val)) then Known [var',var] else cs diff --git a/plutus-benchmark/nofib/test/Spec.hs b/plutus-benchmark/nofib/test/Spec.hs index 14f1128a8b0..a8ef46028ff 100644 --- a/plutus-benchmark/nofib/test/Spec.hs +++ b/plutus-benchmark/nofib/test/Spec.hs @@ -46,7 +46,7 @@ testClausify = testGroup "clausify" , testCase "formula3" $ mkClausifyTest Clausify.F3 , testCase "formula4" $ mkClausifyTest Clausify.F4 , testCase "formula5" $ mkClausifyTest Clausify.F5 - , Tx.fitsInto "formula1 (size)" (Clausify.mkClausifyCode Clausify.F1) 4901 + , Tx.fitsInto "formula1 (size)" (Clausify.mkClausifyCode Clausify.F1) 4781 , runTestNested $ Tx.goldenBudget "formulaBudget" $ Clausify.mkClausifyCode Clausify.F1 ] @@ -65,7 +65,7 @@ testKnights = testGroup "knights" -- Odd sizes call "error" because there are n , testCase "depth 100, 4x4" $ mkKnightsTest 100 4 , testCase "depth 100, 6x6" $ mkKnightsTest 100 6 , testCase "depth 100, 8x8" $ mkKnightsTest 100 8 - , Tx.fitsInto "depth 10, 4x4 (size)" (Knights.mkKnightsCode 10 4) 3516 + , Tx.fitsInto "depth 10, 4x4 (size)" (Knights.mkKnightsCode 10 4) 3494 , runTestNested $ Tx.goldenBudget "knightsBudget" $ Knights.mkKnightsCode 10 4 ] @@ -95,7 +95,7 @@ testQueens = testGroup "queens" , runTestNested $ Tx.goldenBudget "queens5budget" $ Queens.mkQueensCode 5 Queens.Bt ] - , Tx.fitsInto "Bt (size)" (Queens.mkQueensCode 5 Queens.Bt) 2759 + , Tx.fitsInto "Bt (size)" (Queens.mkQueensCode 5 Queens.Bt) 2852 ] ---------------- Primes ---------------- diff --git a/plutus-benchmark/nofib/test/formulaBudget.budget.golden b/plutus-benchmark/nofib/test/formulaBudget.budget.golden new file mode 100644 index 00000000000..06d86091336 --- /dev/null +++ b/plutus-benchmark/nofib/test/formulaBudget.budget.golden @@ -0,0 +1,2 @@ +({cpu: 26010640908 +| mem: 111558948}) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/knightsBudget.budget.golden b/plutus-benchmark/nofib/test/knightsBudget.budget.golden new file mode 100644 index 00000000000..77388cd16ac --- /dev/null +++ b/plutus-benchmark/nofib/test/knightsBudget.budget.golden @@ -0,0 +1,2 @@ +({cpu: 7378435298 +| mem: 27654740}) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/queens4budget.budget.golden b/plutus-benchmark/nofib/test/queens4budget.budget.golden new file mode 100644 index 00000000000..a67c36c1574 --- /dev/null +++ b/plutus-benchmark/nofib/test/queens4budget.budget.golden @@ -0,0 +1,2 @@ +({cpu: 17033524305 +| mem: 67169742}) \ No newline at end of file diff --git a/plutus-benchmark/nofib/test/queens5budget.budget.golden b/plutus-benchmark/nofib/test/queens5budget.budget.golden new file mode 100644 index 00000000000..f4eaa9eda76 --- /dev/null +++ b/plutus-benchmark/nofib/test/queens5budget.budget.golden @@ -0,0 +1,2 @@ +({cpu: 236999646648 +| mem: 923154380}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/src/PlutusBenchmark/ScriptContexts.hs b/plutus-benchmark/script-contexts/src/PlutusBenchmark/ScriptContexts.hs index 03709efa8fa..7643adbf0fc 100644 --- a/plutus-benchmark/script-contexts/src/PlutusBenchmark/ScriptContexts.hs +++ b/plutus-benchmark/script-contexts/src/PlutusBenchmark/ScriptContexts.hs @@ -11,6 +11,7 @@ import PlutusLedgerApi.V1.Value import PlutusTx qualified as PlutusTx import PlutusTx.Builtins qualified as PlutusTx import PlutusTx.Prelude qualified as PlutusTx +import Prelude as Haskell -- | A very crude deterministic generator for 'ScriptContext's with size -- approximately proportional to the input integer. @@ -53,7 +54,7 @@ checkScriptContext1 d = let !sc = PlutusTx.unsafeFromBuiltinData d (ScriptContext txi _) = sc in - if PlutusTx.length (txInfoOutputs txi) `PlutusTx.modInteger` 2 PlutusTx.== 0 + if PlutusTx.length (txInfoOutputs txi) `PlutusTx.modInteger` 2 Haskell.== 0 then () else PlutusTx.traceError "Odd number of outputs" @@ -74,7 +75,7 @@ checkScriptContext2 d = -- for now! in case sc of !_ -> - if 48*9900 PlutusTx.== (475200 :: Integer) + if 48*9900 Haskell.== (475200 :: Integer) then () else PlutusTx.traceError "Got my sums wrong" @@ -119,7 +120,7 @@ mkScriptContextEqualityDataCode sc = scriptContextEqualityTerm :: ScriptContext -> PlutusTx.BuiltinData -> () -- See note [Redundant arguments to equality benchmarks] scriptContextEqualityTerm sc _ = - if sc PlutusTx.== sc + if sc Haskell.== sc then () else PlutusTx.traceError "The argument is not equal to itself" diff --git a/plutus-benchmark/script-contexts/test/checkScriptContexEqualityData-20.budget.golden b/plutus-benchmark/script-contexts/test/checkScriptContexEqualityData-20.budget.golden new file mode 100644 index 00000000000..ea5e0bcbc42 --- /dev/null +++ b/plutus-benchmark/script-contexts/test/checkScriptContexEqualityData-20.budget.golden @@ -0,0 +1,2 @@ +({cpu: 52948597 +| mem: 167402}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/checkScriptContext1-20.budget.golden b/plutus-benchmark/script-contexts/test/checkScriptContext1-20.budget.golden new file mode 100644 index 00000000000..f6c983e236a --- /dev/null +++ b/plutus-benchmark/script-contexts/test/checkScriptContext1-20.budget.golden @@ -0,0 +1,2 @@ +({cpu: 460269997 +| mem: 1473369}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/checkScriptContext1-4.budget.golden b/plutus-benchmark/script-contexts/test/checkScriptContext1-4.budget.golden new file mode 100644 index 00000000000..1bf29f00c6a --- /dev/null +++ b/plutus-benchmark/script-contexts/test/checkScriptContext1-4.budget.golden @@ -0,0 +1,2 @@ +({cpu: 133937245 +| mem: 431993}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/checkScriptContext2-20.budget.golden b/plutus-benchmark/script-contexts/test/checkScriptContext2-20.budget.golden new file mode 100644 index 00000000000..ebcce03ed89 --- /dev/null +++ b/plutus-benchmark/script-contexts/test/checkScriptContext2-20.budget.golden @@ -0,0 +1,2 @@ +({cpu: 436044997 +| mem: 1387928}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/checkScriptContext2-4.budget.golden b/plutus-benchmark/script-contexts/test/checkScriptContext2-4.budget.golden new file mode 100644 index 00000000000..7907ba8972c --- /dev/null +++ b/plutus-benchmark/script-contexts/test/checkScriptContext2-4.budget.golden @@ -0,0 +1,2 @@ +({cpu: 126999877 +| mem: 407384}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/checkScriptContextEqualityOverhead-20.budget.golden b/plutus-benchmark/script-contexts/test/checkScriptContextEqualityOverhead-20.budget.golden new file mode 100644 index 00000000000..4b2267e51e5 --- /dev/null +++ b/plutus-benchmark/script-contexts/test/checkScriptContextEqualityOverhead-20.budget.golden @@ -0,0 +1,2 @@ +({cpu: 37927100 +| mem: 165000}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/checkScriptContextEqualityTerm-20.budget.golden b/plutus-benchmark/script-contexts/test/checkScriptContextEqualityTerm-20.budget.golden new file mode 100644 index 00000000000..bc77ac824a1 --- /dev/null +++ b/plutus-benchmark/script-contexts/test/checkScriptContextEqualityTerm-20.budget.golden @@ -0,0 +1,2 @@ +({cpu: 841344251 +| mem: 3500046}) \ No newline at end of file diff --git a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Definitions.hs b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Definitions.hs index ab07f509633..02540312f45 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Definitions.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Definitions.hs @@ -12,7 +12,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} -- | Support for generating PIR with global definitions with dependencies between them. -module PlutusIR.Compiler.Definitions (DefT +module PlutusIR.Compiler.Definitions (DefT (..) , MonadDefs (..) , TermDefWithStrictness , runDefT diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V1/Contexts.hs b/plutus-ledger-api/src/PlutusLedgerApi/V1/Contexts.hs index aee8b7a493d..d60763bb5d8 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V1/Contexts.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V1/Contexts.hs @@ -132,7 +132,11 @@ data ScriptContext = ScriptContext { scriptContextTxInfo :: TxInfo -- ^ information about the transaction the currently-executing script is included in , scriptContextPurpose :: ScriptPurpose -- ^ the purpose of the currently-executing script } - deriving stock (Generic, Haskell.Eq, Haskell.Show) + deriving stock (Generic, Haskell.Show) + +instance Haskell.Eq ScriptContext where + {-# INLINABLE (==) #-} + (==) = (==) instance Eq ScriptContext where {-# INLINABLE (==) #-} diff --git a/plutus-tx-plugin/plutus-tx-plugin.cabal b/plutus-tx-plugin/plutus-tx-plugin.cabal index c6d5988c023..87d57638312 100644 --- a/plutus-tx-plugin/plutus-tx-plugin.cabal +++ b/plutus-tx-plugin/plutus-tx-plugin.cabal @@ -80,6 +80,7 @@ library , either , extra , flat <0.5 + , ghc-prim , lens , mtl , plutus-core:{plutus-core, plutus-ir} ^>=1.3 diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs index 437c0a31965..d80fd371b16 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs @@ -39,6 +39,7 @@ import PlutusTx.PIRTypes import PlutusTx.PLCTypes (PLCType, PLCVar) -- I feel like we shouldn't need this, we only need it to spot the special String type, which is annoying import PlutusTx.Builtins.Class qualified as Builtins +import PlutusTx.Builtins.Internal qualified as BI import PlutusTx.Trace import PlutusIR qualified as PIR @@ -60,11 +61,17 @@ import Data.Array qualified as Array import Data.ByteString qualified as BS import Data.List (elemIndex) import Data.List.NonEmpty qualified as NE +import Data.Map (Map) import Data.Map qualified as Map import Data.Set qualified as Set import Data.Text qualified as T import Data.Text.Encoding qualified as TE import Data.Traversable +import Data.Tuple.Extra +import GHC.Classes qualified +import GHC.Num qualified +import GHC.Real qualified +import Language.Haskell.TH qualified as TH {- Note [System FC and System FW] Haskell uses system FC, which includes type equalities and coercions. @@ -707,7 +714,7 @@ compileExpr e = withContextM 2 (sdToTxt $ "Compiling expr:" GHC.<+> GHC.ppr e) $ PIR.TyInst annMayInline <$> errorFunc <*> compileTypeNorm t -- See Note [Uses of Eq] - GHC.Var n | GHC.getName n == GHC.eqName -> throwPlain $ UnsupportedError "Use of == from the Haskell Eq typeclass" + -- GHC.Var n | GHC.getName n == GHC.eqName -> throwPlain $ UnsupportedError "Use of == from the Haskell Eq typeclass" GHC.Var n | GHC.getName n == GHC.integerEqName -> throwPlain $ UnsupportedError "Use of Haskell Integer equality, possibly via the Haskell Eq typeclass" GHC.Var n | isProbablyBytestringEq n -> throwPlain $ UnsupportedError "Use of Haskell ByteString equality, possibly via the Haskell Eq typeclass" @@ -744,7 +751,8 @@ compileExpr e = withContextM 2 (sdToTxt $ "Compiling expr:" GHC.<+> GHC.ppr e) $ "Variable" GHC.<+> GHC.ppr n GHC.$+$ (GHC.ppr $ GHC.idDetails n) GHC.$+$ (GHC.ppr $ GHC.realIdUnfolding n) - + ((bimap strip (fmap strip) . GHC.collectArgs) -> (GHC.Var n, args)) + | Just action <- isKnownApp n args -> action -- ignoring applications to types of 'RuntimeRep' kind, see Note [Unboxed tuples] l `GHC.App` GHC.Type t | GHC.isRuntimeRepKindedTy t -> compileExpr l -- arg can be a type here, in which case it's a type instantiation @@ -848,6 +856,94 @@ compileExpr e = withContextM 2 (sdToTxt $ "Compiling expr:" GHC.<+> GHC.ppr e) $ GHC.Type _ -> throwPlain $ UnsupportedError "Types as standalone expressions" GHC.Coercion _ -> throwPlain $ UnsupportedError "Coercions as expressions" +isKnownApp :: + CompilingDefault uni fun m ann => + GHC.Var -> + [GHC.CoreExpr] -> + Maybe (m (PIRTerm uni fun)) +isKnownApp fun args = Map.lookup (splitNameString (GHC.varName fun)) knownApps >>= ($ args) + +knownApps :: + CompilingDefault uni fun m ann => + Map (Maybe String, String) ([GHC.CoreExpr] -> Maybe (m (PIRTerm uni fun))) +knownApps = + Map.fromListWithKey (\n -> error ("knownApps: key defined more than once: " <> show n)) + . fmap (first (TH.nameModule &&& TH.nameBase)) + $ [ + ( '(GHC.Classes.==) + , \case + [GHC.Type ty, _numDict, GHC.Lit (GHC.LitNumber _ i), GHC.Lit (GHC.LitNumber _ j)] + | ty `GHC.eqType` GHC.integerTy -> Just $ do + res <- lookupDataCon =<< thNameToGhcNameOrFail (if i == j then 'True else 'False) + compileDataConRef $ res + [GHC.Type ty, _eqDict] + | ty `GHC.eqType` GHC.integerTy -> + Just $ + compileExpr . GHC.Var =<< lookupId =<< thNameToGhcNameOrFail 'Builtins.equalsInteger + _ -> Nothing + ) + , + ( '(GHC.Num.+) + , \case + [GHC.Type ty, _numDict, GHC.Lit (GHC.LitNumber numTy i), GHC.Lit (GHC.LitNumber _numTy j)] + | ty `GHC.eqType` GHC.integerTy -> + Just . compileExpr . GHC.Lit $ GHC.LitNumber numTy (i + j) + [GHC.Type ty, _numDict] + | ty `GHC.eqType` GHC.integerTy -> + Just $ + compileExpr . GHC.Var =<< lookupId =<< thNameToGhcNameOrFail 'BI.addInteger + _ -> Nothing + ) + , + ( '(GHC.Num.*) + , \case + [GHC.Type ty, _numDict, GHC.Lit (GHC.LitNumber numTy i), GHC.Lit (GHC.LitNumber _numTy j)] + | ty `GHC.eqType` GHC.integerTy -> + Just . compileExpr . GHC.Lit $ GHC.LitNumber numTy (i * j) + [GHC.Type ty, _numDict] + | ty `GHC.eqType` GHC.integerTy -> + Just $ + compileExpr . GHC.Var =<< lookupId =<< thNameToGhcNameOrFail 'BI.multiplyInteger + _ -> Nothing + ) + , + ( 'GHC.Num.fromInteger + , \case + [GHC.Type ty, _numDict, arg] + | ty `GHC.eqType` GHC.integerTy -> Just $ compileExpr arg + [GHC.Type ty, _numDict] + | ty `GHC.eqType` GHC.integerTy -> Just $ do + idId <- lookupId =<< thNameToGhcNameOrFail 'id + compileExpr $ GHC.mkCoreApps (GHC.Var idId) [GHC.Type GHC.integerTy] + _ -> Nothing + ) + , + ( 'GHC.Num.negate + , \case + [GHC.Type ty, _numDict, GHC.Lit (GHC.LitNumber numTy i)] + | ty `GHC.eqType` GHC.integerTy -> + Just . compileExpr . GHC.Lit $ GHC.LitNumber numTy (-i) + _ -> Nothing + ) + , + ( 'GHC.Real.toInteger + , \case + [GHC.Type ty, _numDict, arg] + | ty `GHC.eqType` GHC.integerTy -> Just $ compileExpr arg + [GHC.Type ty, _integralDict] + | ty `GHC.eqType` GHC.integerTy -> Just $ do + idId <- lookupId =<< thNameToGhcNameOrFail 'id + compileExpr $ GHC.mkCoreApps (GHC.Var idId) [GHC.Type GHC.integerTy] + _ -> Nothing + ) + ] + +splitNameString :: GHC.Name -> (Maybe String, String) +splitNameString name = (modu, occ) + where + modu = fmap (GHC.moduleNameString . GHC.moduleName) (GHC.nameModule_maybe name) + occ = GHC.occNameString (GHC.nameOccName name) + {- Note [What source locations to cover] We try to get as much coverage information as we can out of GHC. This means that anything we find in the GHC Core code that hints at a source location will be diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Types.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Types.hs index 0596cebb405..238b0ca30ee 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Types.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Types.hs @@ -22,13 +22,16 @@ import PlutusCore.Annotation import PlutusCore.Builtin qualified as PLC import PlutusCore.Default qualified as PLC import PlutusCore.Quote +import PlutusIR.Compiler.Definitions qualified as PIR import GHC qualified import GHC.Core.FamInstEnv qualified as GHC import GHC.Plugins qualified as GHC +import GHC.Types.TyThing qualified as GHC import Control.Monad.Except import Control.Monad.Reader +import Control.Monad.State import Control.Monad.Writer import Data.List.NonEmpty qualified as NE @@ -174,6 +177,61 @@ stableModuleCmp m1 m2 = -- See Note [Stable name comparisons] (GHC.moduleUnit m1 `GHC.stableUnitCmp` GHC.moduleUnit m2) +class Monad m => MonadCoreM m where + lookupId :: GHC.Name -> m GHC.Id + lookupDataCon :: GHC.Name -> m GHC.DataCon + lookupTyCon :: GHC.Name -> m GHC.TyCon + thNameToGhcName :: TH.Name -> m (Maybe GHC.Name) + +instance MonadCoreM GHC.CoreM where + lookupId = GHC.lookupId + lookupDataCon = GHC.lookupDataCon + lookupTyCon = GHC.lookupTyCon + thNameToGhcName = GHC.thNameToGhcName + +instance MonadCoreM m => MonadCoreM (ReaderT r m) where + lookupId = lift . lookupId + lookupDataCon = lift . lookupDataCon + lookupTyCon = lift . lookupTyCon + thNameToGhcName = lift . thNameToGhcName + +instance (MonadCoreM m, Monoid w) => MonadCoreM (WriterT w m) where + lookupId = lift . lookupId + lookupDataCon = lift . lookupDataCon + lookupTyCon = lift . lookupTyCon + thNameToGhcName = lift . thNameToGhcName + +instance MonadCoreM m => MonadCoreM (StateT s m) where + lookupId = lift . lookupId + lookupDataCon = lift . lookupDataCon + lookupTyCon = lift . lookupTyCon + thNameToGhcName = lift . thNameToGhcName + +instance MonadCoreM m => MonadCoreM (QuoteT m) where + lookupId = lift . lookupId + lookupDataCon = lift . lookupDataCon + lookupTyCon = lift . lookupTyCon + thNameToGhcName = lift . thNameToGhcName + +instance MonadCoreM m => MonadCoreM (ExceptT s m) where + lookupId = lift . lookupId + lookupDataCon = lift . lookupDataCon + lookupTyCon = lift . lookupTyCon + thNameToGhcName = lift . thNameToGhcName + +deriving newtype instance MonadCoreM m => MonadCoreM (PIR.DefT key uni fun ann m) + +-- | Get the 'GHC.Name' corresponding to the given 'TH.Name', or throw an error if we can't get it. +thNameToGhcNameOrFail :: + (MonadCoreM m, MonadError (CompileError uni fun ann) m) => + TH.Name -> + m GHC.Name +thNameToGhcNameOrFail name = do + maybeName <- thNameToGhcName name + case maybeName of + Just n -> pure n + Nothing -> throwError . NoContext $ CoreNameLookupError name + -- See Note [Scopes] type Compiling uni fun m ann = ( MonadError (CompileError uni fun ann) m @@ -181,6 +239,7 @@ type Compiling uni fun m ann = , MonadReader (CompileContext uni fun) m , MonadDefs LexName uni fun Ann m , MonadWriter CoverageIndex m + , MonadCoreM m ) -- Packing up equality constraints gives us a nice way of writing type signatures as this way diff --git a/plutus-tx-plugin/src/PlutusTx/Plugin.hs b/plutus-tx-plugin/src/PlutusTx/Plugin.hs index c130359c218..a14dee321b7 100644 --- a/plutus-tx-plugin/src/PlutusTx/Plugin.hs +++ b/plutus-tx-plugin/src/PlutusTx/Plugin.hs @@ -369,6 +369,7 @@ runCompiler :: , MonadQuote m , MonadError (CompileError uni fun Ann) m , MonadIO m + , MonadCoreM m ) => String -> PluginOptions -> @@ -455,16 +456,14 @@ runCompiler moduleName opts expr = do getSrcSpans :: PIR.Provenance Ann -> SrcSpans getSrcSpans = SrcSpans . Set.unions . fmap (unSrcSpans . annSrcSpans) . toList --- | Get the 'GHC.Name' corresponding to the given 'TH.Name', or throw an error if we can't get it. -thNameToGhcNameOrFail :: TH.Name -> PluginM uni fun GHC.Name -thNameToGhcNameOrFail name = do - maybeName <- lift . lift $ GHC.thNameToGhcName name - case maybeName of - Just n -> pure n - Nothing -> throwError . NoContext $ CoreNameLookupError name - -- | Create a GHC Core expression that will evaluate to the given ByteString at runtime. -makeByteStringLiteral :: BS.ByteString -> PluginM uni fun GHC.CoreExpr +makeByteStringLiteral :: + ( MonadCoreM m + , MonadError (CompileError uni fun ann) m + , GHC.HasDynFlags m + ) => + BS.ByteString -> + m GHC.CoreExpr makeByteStringLiteral bs = do flags <- GHC.getDynFlags @@ -476,9 +475,9 @@ makeByteStringLiteral bs = do -} -- Get the names of functions/types that we need for our expression - upio <- lift . lift . GHC.lookupId =<< thNameToGhcNameOrFail 'unsafePerformIO - bsTc <- lift . lift . GHC.lookupTyCon =<< thNameToGhcNameOrFail ''BS.ByteString - upal <- lift . lift . GHC.lookupId =<< thNameToGhcNameOrFail 'BSUnsafe.unsafePackAddressLen + upio <- lookupId =<< thNameToGhcNameOrFail 'unsafePerformIO + bsTc <- lookupTyCon =<< thNameToGhcNameOrFail ''BS.ByteString + upal <- lookupId =<< thNameToGhcNameOrFail 'BSUnsafe.unsafePackAddressLen -- We construct the following expression: -- unsafePerformIO $ unsafePackAddressLen diff --git a/plutus-tx-plugin/test/Budget/show.budget.golden b/plutus-tx-plugin/test/Budget/show.budget.golden index e69de29bb2d..7ec6be7a098 100644 --- a/plutus-tx-plugin/test/Budget/show.budget.golden +++ b/plutus-tx-plugin/test/Budget/show.budget.golden @@ -0,0 +1,2 @@ +({cpu: 6426906630 +| mem: 21756773}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/show.plc.golden b/plutus-tx-plugin/test/Budget/show.plc.golden index e69de29bb2d..77fe843997c 100644 --- a/plutus-tx-plugin/test/Budget/show.plc.golden +++ b/plutus-tx-plugin/test/Budget/show.plc.golden @@ -0,0 +1,664 @@ +let + !x : integer = -1234567890 + !y : integer = 10 + data Bool | Bool_match where + True : Bool + False : Bool +in +letrec + data (List :: * -> *) a | Nil_match where + Nil : List a + Cons : a -> List a -> List a +in +letrec + !go : List integer -> integer -> List integer + = \(acc : List integer) + (n : integer) -> + let + ~q : integer = quotientInteger n y + in + Bool_match + (ifThenElse {Bool} (equalsInteger q 0) True False) + {all dead. List integer} + (/\dead -> Cons {integer} (remainderInteger n y) acc) + (/\dead -> go (Cons {integer} (remainderInteger n y) acc) q) + {all dead. dead} +in +letrec + !foldr : all a. all b. (a -> b -> b) -> b -> List a -> b + = /\a + b -> + \(f : a -> b -> b) + (acc : b) + (l : List a) -> + Nil_match + {a} + l + {all dead. b} + (/\dead -> acc) + (\(x : a) (xs : List a) -> /\dead -> f x (foldr {a} {b} f acc xs)) + {all dead. dead} +in +let + !id : all a. a -> a = /\a -> \(x : a) -> x +in +letrec + !wcshowsPrec + : integer -> List string -> List string + = \(w : integer) -> + Bool_match + (ifThenElse {Bool} (lessThanInteger w 0) True False) + {all dead. List string -> List string} + (/\dead -> + \(x : List string) -> + Cons {string} "-" (wcshowsPrec (subtractInteger 0 w) x)) + (/\dead -> + foldr + {integer} + {List string -> List string} + (\(digit : integer) + (acc : List string -> List string) + (x : List string) -> + Cons + {string} + (Bool_match + (ifThenElse {Bool} (equalsInteger digit 0) True False) + {all dead. string} + (/\dead -> "0") + (/\dead -> + Bool_match + (ifThenElse + {Bool} + (equalsInteger digit 1) + True + False) + {all dead. string} + (/\dead -> "1") + (/\dead -> + Bool_match + (ifThenElse + {Bool} + (equalsInteger digit 2) + True + False) + {all dead. string} + (/\dead -> "2") + (/\dead -> + Bool_match + (ifThenElse + {Bool} + (equalsInteger digit 3) + True + False) + {all dead. string} + (/\dead -> "3") + (/\dead -> + Bool_match + (ifThenElse + {Bool} + (equalsInteger digit 4) + True + False) + {all dead. string} + (/\dead -> "4") + (/\dead -> + Bool_match + (ifThenElse + {Bool} + (equalsInteger digit 5) + True + False) + {all dead. string} + (/\dead -> "5") + (/\dead -> + Bool_match + (ifThenElse + {Bool} + (equalsInteger digit 6) + True + False) + {all dead. string} + (/\dead -> "6") + (/\dead -> + Bool_match + (ifThenElse + {Bool} + (equalsInteger + digit + 7) + True + False) + {all dead. string} + (/\dead -> "7") + (/\dead -> + Bool_match + (ifThenElse + {Bool} + (equalsInteger + digit + 8) + True + False) + {all dead. string} + (/\dead -> "8") + (/\dead -> + Bool_match + (ifThenElse + {Bool} + (equalsInteger + digit + 9) + 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 x)) + (id {List string}) + (go (Nil {integer}) w)) + {all dead. dead} +in +let + !toHex : integer -> List string -> List string + = \(x : integer) -> + Bool_match + (ifThenElse {Bool} (lessThanEqualsInteger x 9) True False) + {all dead. List string -> List string} + (/\dead -> wcshowsPrec x) + (/\dead -> + Bool_match + (ifThenElse {Bool} (equalsInteger x 10) True False) + {all dead. List string -> List string} + (/\dead -> \(ds : List string) -> Cons {string} "a" ds) + (/\dead -> + Bool_match + (ifThenElse {Bool} (equalsInteger x 11) True False) + {all dead. List string -> List string} + (/\dead -> \(ds : List string) -> Cons {string} "b" ds) + (/\dead -> + Bool_match + (ifThenElse {Bool} (equalsInteger x 12) True False) + {all dead. List string -> List string} + (/\dead -> \(ds : List string) -> Cons {string} "c" ds) + (/\dead -> + Bool_match + (ifThenElse + {Bool} + (equalsInteger x 13) + True + False) + {all dead. List string -> List string} + (/\dead -> + \(ds : List string) -> Cons {string} "d" ds) + (/\dead -> + Bool_match + (ifThenElse + {Bool} + (equalsInteger x 14) + True + False) + {all dead. List string -> List string} + (/\dead -> + \(ds : List string) -> + Cons {string} "e" ds) + (/\dead -> + Bool_match + (ifThenElse + {Bool} + (equalsInteger x 15) + True + False) + {List string -> List string} + (\(ds : List string) -> + Cons {string} "f" ds) + (\(ds : List string) -> + Cons {string} "" ds)) + {all dead. dead}) + {all dead. dead}) + {all dead. dead}) + {all dead. dead}) + {all dead. dead}) + {all dead. dead} + 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) -> + Nil_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 ds 1) 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 +let + data (Show :: * -> *) a | Show_match where + CConsShow + : (integer -> a -> List string -> List string) -> (a -> string) -> Show a + !showsPrec : all a. Show a -> integer -> a -> List string -> List string + = /\a -> + \(v : Show a) -> + Show_match + {a} + v + {integer -> a -> List string -> List string} + (\(v : integer -> a -> List string -> List string) + (v : a -> string) -> + v) + !wcshowsPrec + : all a. all b. all c. all d. all e. Show a -> Show b -> Show c -> Show d -> Show e -> a -> b -> c -> d -> e -> List string -> List string + = /\a + b + c + d + e -> + \(w : Show a) + (w : Show b) + (w : Show c) + (w : Show d) + (w : Show e) + (ww : a) + (ww : b) + (ww : c) + (ww : d) + (ww : e) + (x : List string) -> + Cons + {string} + "(" + (showsPrec + {a} + w + 0 + ww + (Cons + {string} + "," + (showsPrec + {b} + w + 0 + ww + (Cons + {string} + "," + (showsPrec + {c} + w + 0 + ww + (Cons + {string} + "," + (showsPrec + {d} + w + 0 + ww + (Cons + {string} + "," + (showsPrec + {e} + w + 0 + ww + (Cons {string} ")" x)))))))))) + !fShowBool_cshow : Bool -> string + = \(b : Bool) -> Bool_match b {string} "True" "False" +in +letrec + !fEnumBool_cenumFromTo : integer -> integer -> List integer + = \(x : integer) + (y : integer) -> + Bool_match + (ifThenElse {Bool} (lessThanEqualsInteger x y) False True) + {all dead. List integer} + (/\dead -> Nil {integer}) + (/\dead -> + Cons {integer} x (fEnumBool_cenumFromTo (addInteger x 1) y)) + {all dead. dead} +in +let + !fShowBuiltinByteString_cshowsPrec + : integer -> bytestring -> List string -> List string + = \(w : integer) + (w : bytestring) -> + foldr + {integer} + {List string -> List string} + (\(i : integer) -> + let + ~x : integer = indexByteString w i + in + \(acc : List string -> List string) + (x : List string) -> + toHex (divideInteger x 16) (toHex (modInteger x 16) (acc x))) + (id {List string}) + (fEnumBool_cenumFromTo 0 (subtractInteger (lengthOfByteString w) 1)) + !fShowInteger_cshowsPrec : integer -> integer -> List string -> List string + = \(w : integer) (w : integer) -> wcshowsPrec w +in +letrec + !go : List string -> integer -> integer + = \(ds : List string) + (eta : integer) -> + Nil_match + {string} + ds + {all dead. integer} + (/\dead -> eta) + (\(x : string) + (xs : List string) -> + /\dead -> go xs (addInteger eta 1)) + {all dead. dead} +in +let + data (UTuple2 :: * -> * -> *) a b | UTuple2_match where + UTuple2 : a -> b -> UTuple2 a b +in +letrec + !concatBuiltinStrings : List string -> string + = \(ds : List string) -> + let + ~ds : Tuple2 (List string) (List string) + = let + !w : integer = divideInteger (go ds 0) 2 + in + UTuple2_match + {List string} + {List string} + (Bool_match + (ifThenElse {Bool} (lessThanEqualsInteger w 0) True False) + {all dead. UTuple2 (List string) (List string)} + (/\dead -> + UTuple2 {List string} {List string} (Nil {string}) ds) + (/\dead -> + Tuple2_match + {List string} + {List string} + (go {string} w ds) + {UTuple2 (List string) (List string)} + (\(ww : List string) + (ww : List string) -> + UTuple2 {List string} {List string} ww ww)) + {all dead. dead}) + {Tuple2 (List string) (List string)} + (\(ww : List string) + (ww : List string) -> + Tuple2 {List string} {List string} ww ww) + in + Nil_match + {string} + ds + {string} + "" + (\(x : string) + (ds : List string) -> + Nil_match + {string} + ds + {all dead. string} + (/\dead -> x) + (\(ipv : string) + (ipv : List string) -> + /\dead -> + appendString + (Tuple2_match + {List string} + {List string} + ds + {string} + (\(ys : List string) + (zs : List string) -> + concatBuiltinStrings ys)) + (Tuple2_match + {List string} + {List string} + ds + {string} + (\(ys : List string) + (zs : List string) -> + concatBuiltinStrings zs))) + {all dead. dead}) +in +let + ~fShowInteger : Show integer + = CConsShow + {integer} + fShowInteger_cshowsPrec + (\(x : integer) -> + concatBuiltinStrings (fShowInteger_cshowsPrec 0 x (Nil {string}))) + data (Tuple5 :: * -> * -> * -> * -> * -> *) a b c d e | Tuple5_match where + Tuple5 : a -> b -> c -> d -> e -> Tuple5 a b c d e + !show : all a. Show a -> a -> string + = /\a -> + \(v : Show a) -> + Show_match + {a} + v + {a -> string} + (\(v : integer -> a -> List string -> List string) + (v : a -> string) -> + v) + !wshowList + : all a. (a -> List string -> List string) -> List a -> List string -> UTuple2 string (List string) + = /\a -> + \(w : a -> List string -> List string) + (w : List a) + (w : List string) -> + Nil_match + {a} + w + {all dead. UTuple2 string (List string)} + (/\dead -> UTuple2 {string} {List string} "[]" w) + (\(x : a) + (xs : List a) -> + /\dead -> + UTuple2 + {string} + {List string} + "[" + (w + x + (foldr + {a} + {List string -> List string} + (\(a : a) + (acc : List string -> List string) + (x : List string) -> + Cons {string} "," (w a (acc x))) + (id {List string}) + xs + (Cons {string} "]" w)))) + {all dead. dead} + !a : integer = trace {integer} (show {integer} fShowInteger x) x + !b : integer = trace {integer} "This is an example" a + !c : integer + = trace + {integer} + (show + {bytestring} + (CConsShow + {bytestring} + fShowBuiltinByteString_cshowsPrec + (\(x : bytestring) -> + concatBuiltinStrings + (fShowBuiltinByteString_cshowsPrec 0 x (Nil {string})))) + (encodeUtf8 "This is an example")) + b + !d : integer + = trace + {integer} + (show + {Bool} + (CConsShow + {Bool} + (\(ds : integer) + (x : Bool) + (ss : List string) -> + Cons {string} (fShowBool_cshow x) ss) + fShowBool_cshow) + (ifThenElse {Bool} (lessThanEqualsInteger c 0) False True)) + c + !e : integer + = trace + {integer} + (show + {List integer} + (let + !v : Show integer = fShowInteger + in + CConsShow + {List integer} + (\(w : integer) + (w : List integer) + (w : List string) -> + UTuple2_match + {string} + {List string} + (wshowList {integer} (showsPrec {integer} v 0) w w) + {List string} + (\(ww : string) (ww : List string) -> Cons {string} ww ww)) + (\(x : List integer) -> + concatBuiltinStrings + (let + !w : integer -> List string -> List string + = showsPrec {integer} v 0 + !w : List string = Nil {string} + in + UTuple2_match + {string} + {List string} + (wshowList {integer} w x w) + {List string} + (\(ww : string) + (ww : List string) -> + Cons {string} ww ww)))) + ((let + a = List integer + in + \(c : integer -> a -> a) (n : a) -> c a (c b (c c (c d n)))) + (\(ds : integer) (ds : List integer) -> Cons {integer} ds ds) + (Nil {integer}))) + d + !x : integer + = trace + {integer} + (show + {Tuple5 integer integer integer integer integer} + (let + !v : Show integer = fShowInteger + !v : Show integer = fShowInteger + !v : Show integer = fShowInteger + !v : Show integer = fShowInteger + !v : Show integer = fShowInteger + in + CConsShow + {Tuple5 integer integer integer integer integer} + (\(w : integer) + (w : Tuple5 integer integer integer integer integer) -> + Tuple5_match + {integer} + {integer} + {integer} + {integer} + {integer} + w + {List string -> List string} + (\(ww : integer) + (ww : integer) + (ww : integer) + (ww : integer) + (ww : integer) -> + wcshowsPrec + {integer} + {integer} + {integer} + {integer} + {integer} + v + v + v + v + v + ww + ww + ww + ww + ww)) + (\(w : Tuple5 integer integer integer integer integer) -> + Tuple5_match + {integer} + {integer} + {integer} + {integer} + {integer} + w + {string} + (\(ww : integer) + (ww : integer) + (ww : integer) + (ww : integer) + (ww : integer) -> + concatBuiltinStrings + (wcshowsPrec + {integer} + {integer} + {integer} + {integer} + {integer} + v + v + v + v + v + ww + ww + ww + ww + ww + (Nil {string}))))) + (Tuple5 {integer} {integer} {integer} {integer} {integer} a b c d e)) + e +in +multiplyInteger x 2 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Errors/literalCaseBs.plc.golden b/plutus-tx-plugin/test/Plugin/Errors/literalCaseBs.plc.golden index 1f750777ee0..4ff3eba45a7 100644 --- a/plutus-tx-plugin/test/Plugin/Errors/literalCaseBs.plc.golden +++ b/plutus-tx-plugin/test/Plugin/Errors/literalCaseBs.plc.golden @@ -1 +1,3 @@ -Error: Unsupported feature: Use of == from the Haskell Eq typeclass \ No newline at end of file +Error: Reference to a name which is not a local, a builtin, or an external INLINABLE function: Variable PlutusTx.Builtins.Internal.$fEqBuiltinByteString + [DFunId] + No unfolding \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Errors/literalCaseInt.plc.golden b/plutus-tx-plugin/test/Plugin/Errors/literalCaseInt.plc.golden index 1f750777ee0..4b64639ce7c 100644 --- a/plutus-tx-plugin/test/Plugin/Errors/literalCaseInt.plc.golden +++ b/plutus-tx-plugin/test/Plugin/Errors/literalCaseInt.plc.golden @@ -1 +1,85 @@ -Error: Unsupported feature: Use of == from the Haskell Eq typeclass \ No newline at end of file +(program + 1.1.0 + (lam + ds_i0 + (force + [ + [ + (force + [ + [ + [ + (force + (delay + (lam + True_i0 + (lam + False_i0 + (lam + Bool_match_i0 + [ + Bool_match_i1 + [ + [ + [ + (lam equalsInteger_i0 equalsInteger_i1) + (lam + x_i0 + (lam + y_i0 + [ + [ + [ + (force + [ + (lam + ifThenElse_i0 ifThenElse_i1 + ) + (builtin ifThenElse) + ] + ) + [ + [ + [ + (lam + equalsInteger_i0 + equalsInteger_i1 + ) + (builtin equalsInteger) + ] + x_i2 + ] + y_i1 + ] + ] + True_i5 + ] + False_i4 + ] + ) + ) + ] + ds_i4 + ] + (con integer 1) + ] + ] + ) + ) + ) + ) + ) + (delay (lam case_True_i0 (lam case_False_i0 case_True_i2))) + ] + (delay (lam case_True_i0 (lam case_False_i0 case_False_i1))) + ] + (lam x_i0 x_i1) + ] + ) + (delay (con integer 2)) + ] + (delay ds_i1) + ] + ) + ) +) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Errors/literalCaseOther.plc.golden b/plutus-tx-plugin/test/Plugin/Errors/literalCaseOther.plc.golden index 1f750777ee0..65b65e9dc20 100644 --- a/plutus-tx-plugin/test/Plugin/Errors/literalCaseOther.plc.golden +++ b/plutus-tx-plugin/test/Plugin/Errors/literalCaseOther.plc.golden @@ -1 +1,2 @@ -Error: Unsupported feature: Use of == from the Haskell Eq typeclass \ No newline at end of file +Error: Reference to a name which is not a local, a builtin, or an external INLINABLE function: Variable $c/= + No unfolding \ No newline at end of file