[Builtins] Add the 'dropList' builtin

plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs

@@ -103,6 +103,7 @@ data DefaultFun
     | HeadList
     | TailList
     | NullList
+    | DropList
     -- Data
     -- See Note [Pattern matching on built-in types].
     -- It is convenient to have a "choosing" function for a data type that has more than two
@@ -1543,6 +1544,18 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where
             nullListDenotation
             (runCostingFunOneArgument . paramNullList)
 
+    toBuiltinMeaning _semvar DropList =
+        let dropListDenotation :: Int -> SomeConstant uni [a] -> BuiltinResult (Opaque val [a])
+            dropListDenotation i (SomeConstant (Some (ValueOf uniListA xs))) = do
+                -- See Note [Operational vs structural errors within builtins].
+                case uniListA of
+                    DefaultUniList _ -> pure . fromValueOf uniListA $ drop i xs
+                    _ -> throwing _StructuralUnliftingError "Expected a list but got something else"
+            {-# INLINE dropListDenotation #-}
+        in makeBuiltinMeaning
+            dropListDenotation
+            (runCostingFunTwoArguments . unimplementedCostingFun)
+
     -- Data
     toBuiltinMeaning _semvar ChooseData =
         let chooseDataDenotation :: Data -> a -> a -> a -> a -> a -> a
@@ -2144,6 +2157,8 @@ instance Flat DefaultFun where
 
               ExpModInteger           -> 87
 
+              DropList -> 88
+
     decode = go =<< decodeBuiltin
         where go 0  = pure AddInteger
               go 1  = pure SubtractInteger
@@ -2233,6 +2248,7 @@ instance Flat DefaultFun where
               go 85 = pure FindFirstSetBit
               go 86 = pure Ripemd_160
               go 87 = pure ExpModInteger
+              go 88 = pure DropList
               go t  = fail $ "Failed to decode builtin tag, got: " ++ show t
 
     size _ n = n + builtinTagWidth

plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/DropList.plc.golden

@@ -0,0 +1 @@
+all a. integer -> list a -> list a

plutus-core/plutus-ir/src/PlutusIR/Transform/RewriteRules/CommuteFnWithConst.hs

@@ -144,3 +144,4 @@ isCommutative = \case
   CountSetBits                    -> False
   FindFirstSetBit                 -> False
   ExpModInteger           -> False
+  DropList -> False

plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs

@@ -233,6 +233,7 @@ builtinNames = [
     , 'Builtins.mkNilData
     , 'Builtins.mkNilPairData
     , 'Builtins.mkCons
+    , 'Builtins.drop
 
     , ''Builtins.BuiltinData
     , 'Builtins.chooseData
@@ -410,6 +411,7 @@ defineBuiltinTerms = do
             PLC.MkNilData -> defineBuiltinInl 'Builtins.mkNilData
             PLC.MkNilPairData -> defineBuiltinInl 'Builtins.mkNilPairData
             PLC.MkCons -> defineBuiltinInl 'Builtins.mkCons
+            PLC.DropList -> defineBuiltinInl 'Builtins.drop
 
             -- Data
             PLC.ChooseData -> defineBuiltinInl 'Builtins.chooseData

plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt.pir.golden

@@ -13,9 +13,9 @@ program
             in
             trace
               {unit -> integer}
-              "entering addInteger-131"
+              "entering addInteger-133"
               (\(thunk : unit) ->
-                 trace {integer} "exiting addInteger-131" (addInteger x y))
+                 trace {integer} "exiting addInteger-133" (addInteger x y))
               ()
     ~addInt : integer -> integer -> integer
       = \(x : integer) ->
@@ -24,9 +24,9 @@ program
           in
           trace
             {unit -> integer -> integer}
-            "entering addInt-128"
+            "entering addInt-130"
             (\(thunk : unit) ->
-               trace {integer -> integer} "exiting addInt-128" (addInteger x))
+               trace {integer -> integer} "exiting addInt-130" (addInteger x))
             ()
   in
   addInt)

plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt3.eval.golden

@@ -1 +1 @@
-[entering addInt-128, exiting addInt-128]
+[entering addInt-130, exiting addInt-130]

plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch1.eval.golden

@@ -1,6 +1,6 @@
-[ entering runIdentity-131
-, exiting runIdentity-131
-, entering newtypeFunction-139
-, exiting newtypeFunction-139
-, entering `$fFoldableIdentity`-133
-, exiting `$fFoldableIdentity`-133 ]
+[ entering runIdentity-133
+, exiting runIdentity-133
+, entering newtypeFunction-141
+, exiting newtypeFunction-141
+, entering `$fFoldableIdentity`-135
+, exiting `$fFoldableIdentity`-135 ]

plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch2.eval.golden

@@ -1 +1 @@
-[entering obscuredFunction-129, exiting obscuredFunction-129]
+[entering obscuredFunction-131, exiting obscuredFunction-131]

plutus-tx-plugin/test/Plugin/Profiling/9.6/fact4.eval.golden

@@ -1,36 +1,36 @@
-[ entering fact-128
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, entering subtractInteger-152
-, exiting subtractInteger-152
-, entering fact-128
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, entering subtractInteger-152
-, exiting subtractInteger-152
-, entering fact-128
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, entering subtractInteger-152
-, exiting subtractInteger-152
-, entering fact-128
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, entering subtractInteger-152
-, exiting subtractInteger-152
-, entering fact-128
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, exiting fact-128
-, entering multiplyInteger-146
-, exiting multiplyInteger-146
-, exiting fact-128
-, entering multiplyInteger-146
-, exiting multiplyInteger-146
-, exiting fact-128
-, entering multiplyInteger-146
-, exiting multiplyInteger-146
-, exiting fact-128
-, entering multiplyInteger-146
-, exiting multiplyInteger-146
-, exiting fact-128 ]
+[ entering fact-130
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, entering subtractInteger-154
+, exiting subtractInteger-154
+, entering fact-130
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, entering subtractInteger-154
+, exiting subtractInteger-154
+, entering fact-130
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, entering subtractInteger-154
+, exiting subtractInteger-154
+, entering fact-130
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, entering subtractInteger-154
+, exiting subtractInteger-154
+, entering fact-130
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, exiting fact-130
+, entering multiplyInteger-148
+, exiting multiplyInteger-148
+, exiting fact-130
+, entering multiplyInteger-148
+, exiting multiplyInteger-148
+, exiting fact-130
+, entering multiplyInteger-148
+, exiting multiplyInteger-148
+, exiting fact-130
+, entering multiplyInteger-148
+, exiting multiplyInteger-148
+, exiting fact-130 ]

plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden

@@ -13,9 +13,9 @@ program
             in
             trace
               {unit -> integer}
-              "entering addInteger-150"
+              "entering addInteger-152"
               (\(thunk : unit) ->
-                 trace {integer} "exiting addInteger-150" (addInteger x y))
+                 trace {integer} "exiting addInteger-152" (addInteger x y))
               ()
     data Bool | Bool_match where
       True : Bool
@@ -33,11 +33,11 @@ program
             in
             trace
               {unit -> Bool}
-              "entering equalsInteger-135"
+              "entering equalsInteger-137"
               (\(thunk : unit) ->
                  trace
                    {Bool}
-                   "exiting equalsInteger-135"
+                   "exiting equalsInteger-137"
                    (let
                      !b : bool = equalsInteger x y
                    in
@@ -55,11 +55,11 @@ program
             in
             trace
               {unit -> integer}
-              "entering subtractInteger-156"
+              "entering subtractInteger-158"
               (\(thunk : unit) ->
                  trace
                    {integer}
-                   "exiting subtractInteger-156"
+                   "exiting subtractInteger-158"
                    (subtractInteger x y))
               ()
   in
@@ -71,11 +71,11 @@ program
           in
           trace
             {unit -> integer}
-            "entering fib-128"
+            "entering fib-130"
             (\(thunk : unit) ->
                trace
                  {integer}
-                 "exiting fib-128"
+                 "exiting fib-130"
                  (Bool_match
                     (equalsInteger n 0)
                     {all dead. integer}

plutus-tx-plugin/test/Plugin/Profiling/9.6/fib4.eval.golden

@@ -1,74 +1,74 @@
-[ entering fib-128
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, entering subtractInteger-156
-, exiting subtractInteger-156
-, entering fib-128
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, entering subtractInteger-156
-, exiting subtractInteger-156
-, entering fib-128
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, entering subtractInteger-156
-, exiting subtractInteger-156
-, entering fib-128
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, exiting fib-128
-, entering subtractInteger-156
-, exiting subtractInteger-156
-, entering fib-128
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, exiting fib-128
-, entering addInteger-150
-, exiting addInteger-150
-, exiting fib-128
-, entering subtractInteger-156
-, exiting subtractInteger-156
-, entering fib-128
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, exiting fib-128
-, entering addInteger-150
-, exiting addInteger-150
-, exiting fib-128
-, entering subtractInteger-156
-, exiting subtractInteger-156
-, entering fib-128
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, entering subtractInteger-156
-, exiting subtractInteger-156
-, entering fib-128
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, exiting fib-128
-, entering subtractInteger-156
-, exiting subtractInteger-156
-, entering fib-128
-, entering equalsInteger-135
-, exiting equalsInteger-135
-, exiting fib-128
-, entering addInteger-150
-, exiting addInteger-150
-, exiting fib-128
-, entering addInteger-150
-, exiting addInteger-150
-, exiting fib-128 ]
+[ entering fib-130
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, entering subtractInteger-158
+, exiting subtractInteger-158
+, entering fib-130
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, entering subtractInteger-158
+, exiting subtractInteger-158
+, entering fib-130
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, entering subtractInteger-158
+, exiting subtractInteger-158
+, entering fib-130
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, exiting fib-130
+, entering subtractInteger-158
+, exiting subtractInteger-158
+, entering fib-130
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, exiting fib-130
+, entering addInteger-152
+, exiting addInteger-152
+, exiting fib-130
+, entering subtractInteger-158
+, exiting subtractInteger-158
+, entering fib-130
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, exiting fib-130
+, entering addInteger-152
+, exiting addInteger-152
+, exiting fib-130
+, entering subtractInteger-158
+, exiting subtractInteger-158
+, entering fib-130
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, entering subtractInteger-158
+, exiting subtractInteger-158
+, entering fib-130
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, exiting fib-130
+, entering subtractInteger-158
+, exiting subtractInteger-158
+, entering fib-130
+, entering equalsInteger-137
+, exiting equalsInteger-137
+, exiting fib-130
+, entering addInteger-152
+, exiting addInteger-152
+, exiting fib-130
+, entering addInteger-152
+, exiting addInteger-152
+, exiting fib-130 ]