From b9238168b90865aa95a7efbe30936fa80877dfe5 Mon Sep 17 00:00:00 2001 From: Kenneth MacKenzie Date: Thu, 23 Nov 2023 13:48:18 +0000 Subject: [PATCH] Better errors for literal ranges in PlutusTx (PLT-8174) (#5619) * WIP * Add PlutusTx.enumFromThenTo and tests * Remove range failure tests * Generalise range syntax check to non-Integer types * Extend enumFromThenTo tests * Extend enumFromThenTo tests * Extend enumFromThenTo tests * Restore missing test * Restore missing comment * Cover rewrite rules for enum ranges * Separate checks for finite and infinite ranges * Separate checks for finite and infinite ranges * Improve tests involving possibly infinite lists * Golden tests for literal range errors * Amend comment * Really delete unwanted files * Update comment * Delete plutus-tx-plugin/test/tmp/Main.hs Delete accidentally-added file * Didn't want to commit those * plutus-tx-tests -> plutus-tx-plugin-tests * Tidying up * Efficiency improvements * Improve comment * Add changelog entries * Remove redundant pragma * Update budget test results * Restore -fplugin pragma in plutus-ledger-api test * Improve error messages * Improve error messages * Update error messages in golden files * Update error messages in golden files --- ...ckScriptContextEqualityTerm-20.eval.golden | 4 +- ...ckScriptContextEqualityTerm-20.eval.golden | 4 +- ...4_kenneth.mackenzie_better_range_errors.md | 3 ++ plutus-tx-plugin/plutus-tx-plugin.cabal | 2 +- .../src/PlutusTx/Compiler/Expr.hs | 48 ++++++++++++++++- .../test/Budget/9.2/show.pir.golden | 6 +-- .../test/Budget/9.2/show.uplc.golden | 6 +-- .../test/Budget/9.2/sumL.pir.golden | 6 +-- .../test/Budget/9.2/sumL.uplc.golden | 8 +-- .../test/Budget/9.2/sumR.pir.golden | 6 +-- .../test/Budget/9.2/sumR.uplc.golden | 6 +-- .../test/Budget/9.6/show.pir.golden | 6 +-- .../test/Budget/9.6/show.uplc.golden | 6 +-- .../test/Budget/9.6/sumL.pir.golden | 6 +-- .../test/Budget/9.6/sumL.uplc.golden | 8 +-- .../test/Budget/9.6/sumR.pir.golden | 6 +-- .../test/Budget/9.6/sumR.uplc.golden | 6 +-- .../Errors/9.2/rangeEnumFrom.uplc.golden | 1 + .../Errors/9.2/rangeEnumFromThen.uplc.golden | 1 + .../9.2/rangeEnumFromThenTo.uplc.golden | 1 + .../Errors/9.2/rangeEnumFromTo.uplc.golden | 1 + .../Errors/9.6/rangeEnumFrom.uplc.golden | 1 + .../Errors/9.6/rangeEnumFromThen.uplc.golden | 1 + .../9.6/rangeEnumFromThenTo.uplc.golden | 1 + .../Errors/9.6/rangeEnumFromTo.uplc.golden | 1 + plutus-tx-plugin/test/Plugin/Errors/Spec.hs | 50 +++++++++++------ plutus-tx-plugin/test/TH/Spec.hs | 24 ++++----- ...0_kenneth.mackenzie_better_range_errors.md | 6 +++ plutus-tx/src/PlutusTx/Enum.hs | 40 ++++++++++++-- plutus-tx/test/Spec.hs | 53 ++++++++++++++++++- 30 files changed, 241 insertions(+), 77 deletions(-) create mode 100644 plutus-tx-plugin/changelog.d/20231109_113944_kenneth.mackenzie_better_range_errors.md create mode 100644 plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFrom.uplc.golden create mode 100644 plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFromThen.uplc.golden create mode 100644 plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFromThenTo.uplc.golden create mode 100644 plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFromTo.uplc.golden create mode 100644 plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFrom.uplc.golden create mode 100644 plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFromThen.uplc.golden create mode 100644 plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFromThenTo.uplc.golden create mode 100644 plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFromTo.uplc.golden create mode 100644 plutus-tx/changelog.d/20231109_113820_kenneth.mackenzie_better_range_errors.md diff --git a/plutus-benchmark/script-contexts/test/9.2/checkScriptContextEqualityTerm-20.eval.golden b/plutus-benchmark/script-contexts/test/9.2/checkScriptContextEqualityTerm-20.eval.golden index eb937d59622..ef4c5f1b468 100644 --- a/plutus-benchmark/script-contexts/test/9.2/checkScriptContextEqualityTerm-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/9.2/checkScriptContextEqualityTerm-20.eval.golden @@ -1,2 +1,2 @@ -({cpu: 310936611 -| mem: 1245566}) \ No newline at end of file +({cpu: 310959611 +| mem: 1245666}) \ No newline at end of file diff --git a/plutus-benchmark/script-contexts/test/9.6/checkScriptContextEqualityTerm-20.eval.golden b/plutus-benchmark/script-contexts/test/9.6/checkScriptContextEqualityTerm-20.eval.golden index 3e43f147376..2e9e998082e 100644 --- a/plutus-benchmark/script-contexts/test/9.6/checkScriptContextEqualityTerm-20.eval.golden +++ b/plutus-benchmark/script-contexts/test/9.6/checkScriptContextEqualityTerm-20.eval.golden @@ -1,2 +1,2 @@ -({cpu: 310775611 -| mem: 1244866}) \ No newline at end of file +({cpu: 310798611 +| mem: 1244966}) \ No newline at end of file diff --git a/plutus-tx-plugin/changelog.d/20231109_113944_kenneth.mackenzie_better_range_errors.md b/plutus-tx-plugin/changelog.d/20231109_113944_kenneth.mackenzie_better_range_errors.md new file mode 100644 index 00000000000..adf407e8b04 --- /dev/null +++ b/plutus-tx-plugin/changelog.d/20231109_113944_kenneth.mackenzie_better_range_errors.md @@ -0,0 +1,3 @@ +### Added + +- A more informative error message when the plugin encounters a literal range. diff --git a/plutus-tx-plugin/plutus-tx-plugin.cabal b/plutus-tx-plugin/plutus-tx-plugin.cabal index 85f392e179d..5d507904617 100644 --- a/plutus-tx-plugin/plutus-tx-plugin.cabal +++ b/plutus-tx-plugin/plutus-tx-plugin.cabal @@ -116,7 +116,7 @@ executable gen-plugin-opts-doc default-language: Haskell2010 -test-suite plutus-tx-tests +test-suite plutus-tx-plugin-tests import: lang, ghc-version-support if flag(use-ghc-stub) diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs index 39786d3317b..469edf1a8d4 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs @@ -70,7 +70,7 @@ import Control.Monad.Reader (ask) import Data.Array qualified as Array import Data.ByteString qualified as BS import Data.Generics.Uniplate.Data (transform, universeBi) -import Data.List (elemIndex) +import Data.List (elemIndex, isPrefixOf, isSuffixOf) import Data.Map qualified as Map import Data.Maybe import Data.Set qualified as Set @@ -231,6 +231,40 @@ isProbablyIntegerEq (GHC.getName -> n) True isProbablyIntegerEq _ = False +-- | Check for literal ranges like [1..9] and [1, 5..101]. This will also +-- return `True` if there's an explicit use of `enumFromTo` or similar. +isProbablyBoundedRange :: GHC.Id -> Bool +isProbablyBoundedRange (GHC.getName -> n) + | Just m <- GHC.nameModule_maybe n + , GHC.moduleNameString (GHC.moduleName m) == "GHC.Enum" = + ("$fEnum" `isPrefixOf` methodName && + ( "_$cenumFromTo" `isSuffixOf` methodName -- [1..100] + || "_$cenumFromThenTo" `isSuffixOf` methodName -- [1,3..100] + ) + ) + || "enumDeltaToInteger" `isPrefixOf` methodName + -- ^ These are introduced by inlining for Integer ranges in + -- GHC.Enum. This also happens for Char, Word, and Int, but those types + -- aren't supported in Plutus Core. + where methodName = GHC.occNameString (GHC.nameOccName n) +isProbablyBoundedRange _ = False + +-- | Check for literal ranges like [1..] and [1, 5..]. This will also return +-- `True` if there's an explicit use of `enumFrom` or similar. +isProbablyUnboundedRange :: GHC.Id -> Bool +isProbablyUnboundedRange (GHC.getName -> n) + | Just m <- GHC.nameModule_maybe n + , GHC.moduleNameString (GHC.moduleName m) == "GHC.Enum" = + ("$fEnum" `isPrefixOf` methodName && + ( "_$cenumFrom" `isSuffixOf` methodName -- [1..] + || "_$cenumFromThen" `isSuffixOf` methodName -- [1,3..] + ) + ) + || "enumDeltaInteger" `isPrefixOf` methodName -- Introduced by inlining + where methodName = GHC.occNameString (GHC.nameOccName n) +isProbablyUnboundedRange _ = False + + {- Note [GHC runtime errors] GHC has a number of runtime errors for things like pattern matching failures and so on. @@ -733,6 +767,18 @@ compileExpr e = traceCompilation 2 ("Compiling expr:" GHC.<+> GHC.ppr e) $ do GHC.Var n | isProbablyBytestringEq n -> throwPlain $ UnsupportedError "Use of Haskell ByteString equality, possibly via the Haskell Eq typeclass" + GHC.Var n + -- Try to produce a sensible error message if a range like [1..9] is encountered. This works + -- by looking for occurrences of GHC.Enum.enumFromTo and similar functions; the same error + -- occurs if these functions are used explicitly. + | isProbablyBoundedRange n -> + throwPlain $ UnsupportedError $ T.pack ("Use of enumFromTo or enumFromThenTo, possibly via range syntax. " ++ + "Please use PlutusTx.Enum.enumFromTo or PlutusTx.Enum.enumFromThenTo instead.") + -- Throw an error if we find an infinite range like [1..] + GHC.Var n + | isProbablyUnboundedRange n -> + throwPlain $ UnsupportedError $ T.pack ("Use of enumFrom or enumFromThen, possibly via range syntax. " ++ + "Unbounded ranges are not supported.") -- locally bound vars GHC.Var (lookupName scope . GHC.getName -> Just var) -> pure $ PIR.mkVar annMayInline var -- Special kinds of id diff --git a/plutus-tx-plugin/test/Budget/9.2/show.pir.golden b/plutus-tx-plugin/test/Budget/9.2/show.pir.golden index 505836c7520..e8cd0f904f4 100644 --- a/plutus-tx-plugin/test/Budget/9.2/show.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.2/show.pir.golden @@ -200,12 +200,12 @@ let in letrec !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer - = \(x : integer) (y : integer) -> + = \(x : integer) (lim : integer) -> ifThenElse {all dead. List integer} - (lessThanEqualsInteger x y) + (lessThanEqualsInteger x lim) (/\dead -> - Cons {integer} x (`$fEnumBool_$cenumFromTo` (addInteger 1 x) y)) + Cons {integer} x (`$fEnumBool_$cenumFromTo` (addInteger 1 x) lim)) (/\dead -> Nil {integer}) {all dead. dead} in diff --git a/plutus-tx-plugin/test/Budget/9.2/show.uplc.golden b/plutus-tx-plugin/test/Budget/9.2/show.uplc.golden index 7107d151d19..b0b21d51556 100644 --- a/plutus-tx-plugin/test/Budget/9.2/show.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.2/show.uplc.golden @@ -256,16 +256,16 @@ program , ws ]) ]))))) ]))) (delay (\x -> x)))) (fix1 - (\`$fEnumBool_$cenumFromTo` x y -> + (\`$fEnumBool_$cenumFromTo` x lim -> force (force ifThenElse - (lessThanEqualsInteger x y) + (lessThanEqualsInteger x lim) (delay (constr 1 [ x , (`$fEnumBool_$cenumFromTo` (addInteger 1 x) - y) ])) + lim) ])) (delay (constr 0 [])))))) -1234567890) (fix1 diff --git a/plutus-tx-plugin/test/Budget/9.2/sumL.pir.golden b/plutus-tx-plugin/test/Budget/9.2/sumL.pir.golden index e53c5f906ac..06a5b10c150 100644 --- a/plutus-tx-plugin/test/Budget/9.2/sumL.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.2/sumL.pir.golden @@ -17,12 +17,12 @@ letrec in letrec !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer - = \(x : integer) (y : integer) -> + = \(x : integer) (lim : integer) -> ifThenElse {all dead. List integer} - (lessThanEqualsInteger x y) + (lessThanEqualsInteger x lim) (/\dead -> - Cons {integer} x (`$fEnumBool_$cenumFromTo` (addInteger 1 x) y)) + Cons {integer} x (`$fEnumBool_$cenumFromTo` (addInteger 1 x) lim)) (/\dead -> Nil {integer}) {all dead. dead} in diff --git a/plutus-tx-plugin/test/Budget/9.2/sumL.uplc.golden b/plutus-tx-plugin/test/Budget/9.2/sumL.uplc.golden index 72a15c61241..7324d9c1098 100644 --- a/plutus-tx-plugin/test/Budget/9.2/sumL.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.2/sumL.uplc.golden @@ -4,14 +4,16 @@ program (\go -> (\ls -> go 0 ls) (fix1 - (\`$fEnumBool_$cenumFromTo` x y -> + (\`$fEnumBool_$cenumFromTo` x lim -> force (force ifThenElse - (lessThanEqualsInteger x y) + (lessThanEqualsInteger x lim) (delay (constr 1 [ x - , (`$fEnumBool_$cenumFromTo` (addInteger 1 x) y) ])) + , (`$fEnumBool_$cenumFromTo` + (addInteger 1 x) + lim) ])) (delay (constr 0 [])))) 1 1000)) diff --git a/plutus-tx-plugin/test/Budget/9.2/sumR.pir.golden b/plutus-tx-plugin/test/Budget/9.2/sumR.pir.golden index ed20af8ba80..707a9373795 100644 --- a/plutus-tx-plugin/test/Budget/9.2/sumR.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.2/sumR.pir.golden @@ -16,12 +16,12 @@ letrec in letrec !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer - = \(x : integer) (y : integer) -> + = \(x : integer) (lim : integer) -> ifThenElse {all dead. List integer} - (lessThanEqualsInteger x y) + (lessThanEqualsInteger x lim) (/\dead -> - Cons {integer} x (`$fEnumBool_$cenumFromTo` (addInteger 1 x) y)) + Cons {integer} x (`$fEnumBool_$cenumFromTo` (addInteger 1 x) lim)) (/\dead -> Nil {integer}) {all dead. dead} in diff --git a/plutus-tx-plugin/test/Budget/9.2/sumR.uplc.golden b/plutus-tx-plugin/test/Budget/9.2/sumR.uplc.golden index 1d8026b628e..68234bff3af 100644 --- a/plutus-tx-plugin/test/Budget/9.2/sumR.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.2/sumR.uplc.golden @@ -5,13 +5,13 @@ program (\go ds -> force (case ds [(delay 0), (\x xs -> delay (addInteger x (go xs)))])) (fix1 - (\`$fEnumBool_$cenumFromTo` x y -> + (\`$fEnumBool_$cenumFromTo` x lim -> force (force ifThenElse - (lessThanEqualsInteger x y) + (lessThanEqualsInteger x lim) (delay (constr 1 - [x, (`$fEnumBool_$cenumFromTo` (addInteger 1 x) y)])) + [x, (`$fEnumBool_$cenumFromTo` (addInteger 1 x) lim)])) (delay (constr 0 [])))) 1 1000)) diff --git a/plutus-tx-plugin/test/Budget/9.6/show.pir.golden b/plutus-tx-plugin/test/Budget/9.6/show.pir.golden index 2b7e8dea2bb..a4823bc267c 100644 --- a/plutus-tx-plugin/test/Budget/9.6/show.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/show.pir.golden @@ -200,12 +200,12 @@ let in letrec !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer - = \(x : integer) (y : integer) -> + = \(x : integer) (lim : integer) -> ifThenElse {all dead. List integer} - (lessThanEqualsInteger x y) + (lessThanEqualsInteger x lim) (/\dead -> - Cons {integer} x (`$fEnumBool_$cenumFromTo` (addInteger 1 x) y)) + Cons {integer} x (`$fEnumBool_$cenumFromTo` (addInteger 1 x) lim)) (/\dead -> Nil {integer}) {all dead. dead} in diff --git a/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden index a6c8acd94c3..d2ca895476a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden @@ -254,16 +254,16 @@ program , ws ]) ]))))) ]))) (delay (\x -> x)))) (fix1 - (\`$fEnumBool_$cenumFromTo` x y -> + (\`$fEnumBool_$cenumFromTo` x lim -> force (force ifThenElse - (lessThanEqualsInteger x y) + (lessThanEqualsInteger x lim) (delay (constr 1 [ x , (`$fEnumBool_$cenumFromTo` (addInteger 1 x) - y) ])) + lim) ])) (delay (constr 0 [])))))) -1234567890) (fix1 diff --git a/plutus-tx-plugin/test/Budget/9.6/sumL.pir.golden b/plutus-tx-plugin/test/Budget/9.6/sumL.pir.golden index e53c5f906ac..06a5b10c150 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumL.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumL.pir.golden @@ -17,12 +17,12 @@ letrec in letrec !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer - = \(x : integer) (y : integer) -> + = \(x : integer) (lim : integer) -> ifThenElse {all dead. List integer} - (lessThanEqualsInteger x y) + (lessThanEqualsInteger x lim) (/\dead -> - Cons {integer} x (`$fEnumBool_$cenumFromTo` (addInteger 1 x) y)) + Cons {integer} x (`$fEnumBool_$cenumFromTo` (addInteger 1 x) lim)) (/\dead -> Nil {integer}) {all dead. dead} in diff --git a/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden index 72a15c61241..7324d9c1098 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden @@ -4,14 +4,16 @@ program (\go -> (\ls -> go 0 ls) (fix1 - (\`$fEnumBool_$cenumFromTo` x y -> + (\`$fEnumBool_$cenumFromTo` x lim -> force (force ifThenElse - (lessThanEqualsInteger x y) + (lessThanEqualsInteger x lim) (delay (constr 1 [ x - , (`$fEnumBool_$cenumFromTo` (addInteger 1 x) y) ])) + , (`$fEnumBool_$cenumFromTo` + (addInteger 1 x) + lim) ])) (delay (constr 0 [])))) 1 1000)) diff --git a/plutus-tx-plugin/test/Budget/9.6/sumR.pir.golden b/plutus-tx-plugin/test/Budget/9.6/sumR.pir.golden index ed20af8ba80..707a9373795 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumR.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumR.pir.golden @@ -16,12 +16,12 @@ letrec in letrec !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer - = \(x : integer) (y : integer) -> + = \(x : integer) (lim : integer) -> ifThenElse {all dead. List integer} - (lessThanEqualsInteger x y) + (lessThanEqualsInteger x lim) (/\dead -> - Cons {integer} x (`$fEnumBool_$cenumFromTo` (addInteger 1 x) y)) + Cons {integer} x (`$fEnumBool_$cenumFromTo` (addInteger 1 x) lim)) (/\dead -> Nil {integer}) {all dead. dead} in diff --git a/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden index 1d8026b628e..68234bff3af 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden @@ -5,13 +5,13 @@ program (\go ds -> force (case ds [(delay 0), (\x xs -> delay (addInteger x (go xs)))])) (fix1 - (\`$fEnumBool_$cenumFromTo` x y -> + (\`$fEnumBool_$cenumFromTo` x lim -> force (force ifThenElse - (lessThanEqualsInteger x y) + (lessThanEqualsInteger x lim) (delay (constr 1 - [x, (`$fEnumBool_$cenumFromTo` (addInteger 1 x) y)])) + [x, (`$fEnumBool_$cenumFromTo` (addInteger 1 x) lim)])) (delay (constr 0 [])))) 1 1000)) diff --git a/plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFrom.uplc.golden b/plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFrom.uplc.golden new file mode 100644 index 00000000000..aa364563387 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFrom.uplc.golden @@ -0,0 +1 @@ +Error: Unsupported feature: Use of enumFrom or enumFromThen, possibly via range syntax. Unbounded ranges are not supported. \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFromThen.uplc.golden b/plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFromThen.uplc.golden new file mode 100644 index 00000000000..aa364563387 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFromThen.uplc.golden @@ -0,0 +1 @@ +Error: Unsupported feature: Use of enumFrom or enumFromThen, possibly via range syntax. Unbounded ranges are not supported. \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFromThenTo.uplc.golden b/plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFromThenTo.uplc.golden new file mode 100644 index 00000000000..3c525b91804 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFromThenTo.uplc.golden @@ -0,0 +1 @@ +Error: Unsupported feature: Use of enumFromTo or enumFromThenTo, possibly via range syntax. Please use PlutusTx.Enum.enumFromTo or PlutusTx.Enum.enumFromThenTo instead. \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFromTo.uplc.golden b/plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFromTo.uplc.golden new file mode 100644 index 00000000000..3c525b91804 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Errors/9.2/rangeEnumFromTo.uplc.golden @@ -0,0 +1 @@ +Error: Unsupported feature: Use of enumFromTo or enumFromThenTo, possibly via range syntax. Please use PlutusTx.Enum.enumFromTo or PlutusTx.Enum.enumFromThenTo instead. \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFrom.uplc.golden b/plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFrom.uplc.golden new file mode 100644 index 00000000000..aa364563387 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFrom.uplc.golden @@ -0,0 +1 @@ +Error: Unsupported feature: Use of enumFrom or enumFromThen, possibly via range syntax. Unbounded ranges are not supported. \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFromThen.uplc.golden b/plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFromThen.uplc.golden new file mode 100644 index 00000000000..aa364563387 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFromThen.uplc.golden @@ -0,0 +1 @@ +Error: Unsupported feature: Use of enumFrom or enumFromThen, possibly via range syntax. Unbounded ranges are not supported. \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFromThenTo.uplc.golden b/plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFromThenTo.uplc.golden new file mode 100644 index 00000000000..3c525b91804 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFromThenTo.uplc.golden @@ -0,0 +1 @@ +Error: Unsupported feature: Use of enumFromTo or enumFromThenTo, possibly via range syntax. Please use PlutusTx.Enum.enumFromTo or PlutusTx.Enum.enumFromThenTo instead. \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFromTo.uplc.golden b/plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFromTo.uplc.golden new file mode 100644 index 00000000000..3c525b91804 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Errors/9.6/rangeEnumFromTo.uplc.golden @@ -0,0 +1 @@ +Error: Unsupported feature: Use of enumFromTo or enumFromThenTo, possibly via range syntax. Please use PlutusTx.Enum.enumFromTo or PlutusTx.Enum.enumFromThenTo instead. \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Errors/Spec.hs b/plutus-tx-plugin/test/Plugin/Errors/Spec.hs index d48ac148670..bfafb805018 100644 --- a/plutus-tx-plugin/test/Plugin/Errors/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Errors/Spec.hs @@ -16,10 +16,10 @@ module Plugin.Errors.Spec where import Test.Tasty.Extras -import PlutusCore.Test +import PlutusCore.Test (goldenUPlc) import PlutusTx.Builtins qualified as Builtins -import PlutusTx.Code -import PlutusTx.Plugin +import PlutusTx.Code (CompiledCode) +import PlutusTx.Plugin.Utils (plc) import PlutusTx.Test () import Data.Proxy @@ -33,19 +33,23 @@ import GHC.Num.Integer {- HLINT ignore -} errors :: TestNested -errors = testNestedGhc "Errors" [ - goldenUPlc "machInt" machInt - -- FIXME: This fails differently in nix, possibly due to slightly different optimization settings - -- , goldenPlc "negativeInt" negativeInt - , goldenUPlc "caseInt" caseInt - , goldenUPlc "stringLiteral" stringLiteral - , goldenUPlc "recursiveNewtype" recursiveNewtype - , goldenUPlc "mutualRecursionUnfoldingsLocal" mutualRecursionUnfoldingsLocal - , goldenUPlc "literalCaseInt" literalCaseInt - , goldenUPlc "literalCaseBs" literalCaseBs - , goldenUPlc "literalAppendBs" literalAppendBs - , goldenUPlc "literalCaseOther" literalCaseOther - ] +errors = testNestedGhc "Errors" + [ goldenUPlc "machInt" machInt + -- FIXME: This fails differently in nix, possibly due to slightly different optimization settings + -- , goldenPlc "negativeInt" negativeInt + , goldenUPlc "caseInt" caseInt + , goldenUPlc "stringLiteral" stringLiteral + , goldenUPlc "recursiveNewtype" recursiveNewtype + , goldenUPlc "mutualRecursionUnfoldingsLocal" mutualRecursionUnfoldingsLocal + , goldenUPlc "literalCaseInt" literalCaseInt + , goldenUPlc "literalCaseBs" literalCaseBs + , goldenUPlc "literalAppendBs" literalAppendBs + , goldenUPlc "literalCaseOther" literalCaseOther + , goldenUPlc "rangeEnumFromTo" rangeEnumFromTo + , goldenUPlc "rangeEnumFromThenTo" rangeEnumFromThenTo + , goldenUPlc "rangeEnumFrom" rangeEnumFrom + , goldenUPlc "rangeEnumFromThen" rangeEnumFromThen + ] machInt :: CompiledCode Int machInt = plc (Proxy @"machInt") (1::Int) @@ -95,3 +99,17 @@ instance Eq AType where literalCaseOther :: CompiledCode (AType -> AType) literalCaseOther = plc (Proxy @"literalCaseOther") (\x -> case x of { "abc" -> ""; x -> x}) + +-- Tests for literal ranges (and the corresponding methods in GHC.Enum). These +-- should all fail with informative error messages. +rangeEnumFromTo :: CompiledCode [Integer] +rangeEnumFromTo = plc (Proxy @"rangeEnumFromTo") [1..50] + +rangeEnumFromThenTo :: CompiledCode [Integer] +rangeEnumFromThenTo = plc (Proxy @"rangeEnumFromThenTo") [1,7..50] + +rangeEnumFrom :: CompiledCode [Integer] +rangeEnumFrom = plc (Proxy @"rangeEnumFrom") [1..] + +rangeEnumFromThen :: CompiledCode [Integer] +rangeEnumFromThen = plc (Proxy @"rangeEnumFromThen") [1,5..] diff --git a/plutus-tx-plugin/test/TH/Spec.hs b/plutus-tx-plugin/test/TH/Spec.hs index 948ca612444..a8ee6e2ef81 100644 --- a/plutus-tx-plugin/test/TH/Spec.hs +++ b/plutus-tx-plugin/test/TH/Spec.hs @@ -35,18 +35,18 @@ someData :: (BuiltinData, BuiltinData, BuiltinData) someData = (toBuiltinData (One 1), toBuiltinData Two, toBuiltinData (Three ())) tests :: TestNested -tests = testNestedGhc "TH" [ - goldenPir "simple" simple - , goldenPir "power" powerPlc - , goldenPir "and" andPlc - , goldenEvalCek "all" [allPlc] - , goldenEvalCek "convertString" [convertString] - , goldenEvalCekLog "traceDirect" [traceDirect] - , goldenEvalCekLog "tracePrelude" [tracePrelude] - , goldenEvalCekLog "traceRepeatedly" [traceRepeatedly] - -- want to see the raw structure, so using Show - , nestedGoldenVsDoc "someData" "" (pretty $ Haskell.show someData) - ] +tests = testNestedGhc "TH" + [ goldenPir "simple" simple + , goldenPir "power" powerPlc + , goldenPir "and" andPlc + , goldenEvalCek "all" [allPlc] + , goldenEvalCek "convertString" [convertString] + , goldenEvalCekLog "traceDirect" [traceDirect] + , goldenEvalCekLog "tracePrelude" [tracePrelude] + , goldenEvalCekLog "traceRepeatedly" [traceRepeatedly] + -- want to see the raw structure, so using Show + , nestedGoldenVsDoc "someData" "" (pretty $ Haskell.show someData) + ] simple :: CompiledCode (Bool -> Integer) simple = $$(compile [|| \(x::Bool) -> if x then (1::Integer) else (2::Integer) ||]) diff --git a/plutus-tx/changelog.d/20231109_113820_kenneth.mackenzie_better_range_errors.md b/plutus-tx/changelog.d/20231109_113820_kenneth.mackenzie_better_range_errors.md new file mode 100644 index 00000000000..947046d14ea --- /dev/null +++ b/plutus-tx/changelog.d/20231109_113820_kenneth.mackenzie_better_range_errors.md @@ -0,0 +1,6 @@ + +### Added + +- A more informative error message when the plugin encounters a literal range +- PlutusTx.enumFromThenTO for ranges like [1,5..101] + diff --git a/plutus-tx/src/PlutusTx/Enum.hs b/plutus-tx/src/PlutusTx/Enum.hs index 4da575559f2..f51f4392fbb 100644 --- a/plutus-tx/src/PlutusTx/Enum.hs +++ b/plutus-tx/src/PlutusTx/Enum.hs @@ -26,8 +26,12 @@ class Enum a where toEnum :: Integer -> a -- | Convert to an 'Integer'. fromEnum :: a -> Integer - -- | Construct a list from the given range. + -- | Construct a list from the given range (corresponds to [a..b]). enumFromTo :: a -> a -> [a] + -- | Construct a list from the given range (corresponds to [a,b..c]). This + -- has the same semantics as the Haskell version,so if a==b and c>=b then you + -- get an infinite list, which you probably don't want in Plutus Core. + enumFromThenTo :: a -> a -> a -> [a] instance Enum Integer where {-# INLINABLE succ #-} @@ -43,9 +47,24 @@ instance Enum Integer where fromEnum x = x {-# INLINABLE enumFromTo #-} - enumFromTo x y - | x > y = [] - | otherwise = x : enumFromTo (succ x) y + enumFromTo x lim + | x > lim = [] + | otherwise = x : enumFromTo (succ x) lim + + {-# INLINABLE enumFromThenTo #-} + enumFromThenTo x y lim = + if delta >= 0 + then up_list x + else dn_list x + where delta = subtractInteger y x + up_list x1 = + if x1 > lim + then [] + else x1 : up_list (addInteger x1 delta) + dn_list x1 = + if x1 < lim + then [] + else x1 : dn_list (addInteger x1 delta) instance Enum () where {-# INLINABLE succ #-} @@ -64,6 +83,10 @@ instance Enum () where {-# INLINABLE enumFromTo #-} enumFromTo _ _ = [()] + {-# INLINABLE enumFromThenTo #-} + -- enumFromThenTo () () () is an infinite list of ()'s, so this isn't too useful. + enumFromThenTo x y lim = map toEnum (enumFromThenTo (fromEnum x) (fromEnum y) (fromEnum lim)) + instance Enum Bool where {-# INLINABLE succ #-} succ False = True @@ -83,7 +106,10 @@ instance Enum Bool where fromEnum True = 1 {-# INLINABLE enumFromTo #-} - enumFromTo x y = map toEnum (enumFromTo (fromEnum x) (fromEnum y)) + enumFromTo x lim = map toEnum (enumFromTo (fromEnum x) (fromEnum lim)) + + {-# INLINABLE enumFromThenTo #-} + enumFromThenTo x y lim = map toEnum (enumFromThenTo (fromEnum x) (fromEnum y) (fromEnum lim)) instance Enum Ordering where {-# INLINABLE succ #-} @@ -109,3 +135,7 @@ instance Enum Ordering where {-# INLINABLE enumFromTo #-} enumFromTo x y = map toEnum (enumFromTo (fromEnum x) (fromEnum y)) + + {-# INLINABLE enumFromThenTo #-} + enumFromThenTo x y lim = map toEnum (enumFromThenTo (fromEnum x) (fromEnum y) (fromEnum lim)) + diff --git a/plutus-tx/test/Spec.hs b/plutus-tx/test/Spec.hs index 8548bce7b53..026e45e7892 100644 --- a/plutus-tx/test/Spec.hs +++ b/plutus-tx/test/Spec.hs @@ -8,8 +8,10 @@ import Codec.CBOR.FlatTerm qualified as FlatTerm import Codec.Serialise (deserialiseOrFail, serialise) import Codec.Serialise qualified as Serialise import Control.Exception (ErrorCall, catch) +import Control.Monad (unless) import Data.ByteString qualified as BS import Data.Either (isLeft) +import Data.List (intercalate) import Data.Word (Word64) import Hedgehog (MonadGen, Property, PropertyT, annotateShow, assert, forAll, property, tripping) import Hedgehog.Gen qualified as Gen @@ -27,7 +29,7 @@ import Show.Spec qualified import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.Extras (runTestNestedIn) import Test.Tasty.Hedgehog (testPropertyNamed) -import Test.Tasty.HUnit (Assertion, testCase, (@?=)) +import Test.Tasty.HUnit (Assertion, assertFailure, testCase, (@?=)) main :: IO () main = defaultMain tests @@ -252,7 +254,7 @@ dropByteStringTests = testGroup "dropByteString" enumTests :: TestTree enumTests = testGroup "Enum" - [ enumFromToTests ] + [ enumFromToTests, enumFromThenToTests ] enumFromToTests :: TestTree enumFromToTests = testGroup "enumFromTo" @@ -260,3 +262,50 @@ enumFromToTests = testGroup "enumFromTo" , testCase "enumFromTo 2 (-2) == []" $ enumFromTo @Integer 2 (-2) @?= [] , testCase "enumFromTo 42 42 == [42]" $ enumFromTo @Integer 42 42 @?= [42] ] + +enumFromThenToTests :: TestTree +enumFromThenToTests = testGroup "enumFromThenTo" + [ testCase "enumFromThenTo 1 2 100 == [1..100]" $ enumFromThenTo @Integer 1 2 100 @?=* [1..100] + , testCase "enumFromThenTo 1 2 100 == [1,2..100]" $ enumFromThenTo @Integer 1 2 100 @?=* [1,2..100] + , testCase "enumFromThenTo 100 99 1 == [100,99..1]" $ enumFromThenTo @Integer 100 99 1 @?=* [100,99..1] + , testCase "enumFromThenTo 100 17 (-700) == [100,17..(-700)]" $ enumFromThenTo @Integer 100 17 (-700) @?=* [100,17..(-700)] + , testCase "enumFromThenTo 0 5 99 == [0,5..99]" $ enumFromThenTo @Integer 0 5 99 @?=* [0,5..99] + , testCase "enumFromThenTo 0 5 100 == [0,5..100]" $ enumFromThenTo @Integer 0 5 100 @?=* [0,5..100] + , testCase "enumFromThenTo 0 5 101 == [0,5..101]" $ enumFromThenTo @Integer 0 5 101 @?=* [0,5..101] + , testCase "enumFromThenTo 100 95 0 == [100,95..0]" $ enumFromThenTo @Integer 100 95 0 @?=* [100,95..0] + , testCase "enumFromThenTo 100 95 (-9) == [100,95..(-9)]" $ enumFromThenTo @Integer 100 95 (-9) @?=* [100,95..(-9)] + , testCase "enumFromThenTo 100 95 (-10) == [100,95..(-10)]" $ enumFromThenTo @Integer 100 95 (-10) @?=* [100,95..(-10)] + , testCase "enumFromThenTo 100 95 (-11) == [100,95..(-11)]" $ enumFromThenTo @Integer 100 95 (-11) @?=* [100,95..(-11)] + , testCase "enumFromThenTo 42 42 41 == []" $ enumFromThenTo @Integer 42 42 41 @?=* [] + , testCase "enumFromThenTo 42 42 42 == [42*]" $ enumFromThenTo @Integer 42 42 42 @?=* [42,42..42] + , testCase "enumFromThenTo 42 42 43 == [42*]" $ enumFromThenTo @Integer 42 42 43 @?=* [42,42..43] + , testCase "enumFromThenTo False False False == [False*]" $ enumFromThenTo False False False @?=* [False, False .. False] + , testCase "enumFromThenTo False False True == [False*]" $ enumFromThenTo False False True @?=* [False, False .. True ] + , testCase "enumFromThenTo False True False == [False]" $ enumFromThenTo False True False @?=* [False, True .. False] + , testCase "enumFromThenTo False True True == [False,True]" $ enumFromThenTo False True True @?=* [False, True .. True ] + , testCase "enumFromThenTo True False False == [True,False]" $ enumFromThenTo True False False @?=* [True, False .. False] + , testCase "enumFromThenTo True False True == [True]" $ enumFromThenTo True False True @?=* [True, False .. True ] + , testCase "enumFromThenTo True True False == []" $ enumFromThenTo True True False @?=* [True, True .. False] + , testCase "enumFromThenTo True True True == [True*]" $ enumFromThenTo True True True @?=* [True, True .. True ] + , testCase "enumFromThenTo () () () == [()*]" $ enumFromThenTo () () () @?=* [(),()..()] + ] + {- Check (approximately) that two possibly infinite lists are equal. We can get infinite lists from + `enumFromThenTo`, both legitimately and because of implementation errors (which are exactly + what we're testing for here). If we just use @?= then (a) it won't terminate if we give it + two equal infinite lists, and (b) if it fails and one of the lists is infinite then it'll try + to generate an infinite error message, again leading to non-termination. To deal with this, + if an argument has more than 1000 elements then we assume it's infinite and just include an + initial segment in any error message, and when we're comparing two such "infinite" lists we + just compare the first 1000 elements. The only infinite lists that enumFromThenTo can + generate are of the form [x,x,x,...], so this is definitely a safe strategy in this context. + -} + where l1 @?=* l2 = + case (possiblyInfinite l1, possiblyInfinite l2) of + (False, False) -> l1 @?= l2 + (True, False) -> failWith (showInit l1) (show l2) + (False, True) -> failWith (show l1) (showInit l2) + (True, True) -> unless (take 1000 l1 == take 1000 l2) (failWith (showInit l1) (showInit l2)) + where possiblyInfinite l = drop 1000 l /= [] + showInit l = "[" ++ intercalate "," (fmap show (take 5 l)) ++ ",...]" + failWith expected actual = assertFailure ("expected: " ++ expected ++ "\n but got: " ++ actual) +