Better errors for literal ranges in PlutusTx (PLT-8174) (IntersectMBO…

…#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
mlabs-haskell · Nov 23, 2023 · b923816 · b923816
1 parent 98c5167
commit b923816
Show file tree

Hide file tree

Showing 30 changed files with 241 additions and 77 deletions.
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
@@ -1,2 +1,2 @@
-({cpu: 310936611
-| mem: 1245566})
+({cpu: 310959611
+| mem: 1245666})
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
@@ -1,2 +1,2 @@
-({cpu: 310775611
-| mem: 1244866})
+({cpu: 310798611
+| mem: 1244966})
diff --git a/...-tx-plugin/changelog.d/20231109_113944_kenneth.mackenzie_better_range_errors.md b/...-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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -0,0 +1 @@
+Error: Unsupported feature: Use of enumFrom or enumFromThen, possibly via range syntax. Unbounded ranges are not supported.
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
@@ -0,0 +1 @@
+Error: Unsupported feature: Use of enumFrom or enumFromThen, possibly via range syntax. Unbounded ranges are not supported.
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
@@ -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.
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
@@ -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.
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
@@ -0,0 +1 @@
+Error: Unsupported feature: Use of enumFrom or enumFromThen, possibly via range syntax. Unbounded ranges are not supported.
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
@@ -0,0 +1 @@
+Error: Unsupported feature: Use of enumFrom or enumFromThen, possibly via range syntax. Unbounded ranges are not supported.
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
@@ -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.
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
@@ -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.
diff --git 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..]
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1,3 @@
		### Added

		- A more informative error message when the plugin encounters a literal range.
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1 @@
		Error: Unsupported feature: Use of enumFrom or enumFromThen, possibly via range syntax. Unbounded ranges are not supported.