[Builtins] Add the 'dropList' builtin

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

@@ -1,10 +1,12 @@
 -- editorconfig-checker-disable-file
 {-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE DeriveAnyClass        #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE InstanceSigs          #-}
 {-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE MagicHash             #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
@@ -46,6 +48,10 @@ import Data.Text.Encoding (decodeUtf8', encodeUtf8)
 import Flat hiding (from, to)
 import Flat.Decoder (Get, dBEBits8)
 import Flat.Encoder as Flat (Encoding, NumBits, eBits)
+#if MIN_VERSION_base(4,15,0)
+import GHC.Num.Integer (Integer (..))
+#endif
+import GHC.Types (Int (..))
 import NoThunks.Class (NoThunks)
 import Prettyprinter (viaShow)
 
@@ -104,6 +110,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
@@ -1557,6 +1564,30 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where
             nullListDenotation
             (runCostingFunOneArgument . paramNullList)
 
+    toBuiltinMeaning _semvar DropList =
+        let dropListDenotation :: Integer -> 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 _ ->
+#if MIN_VERSION_base(4,15,0)
+                        fromValueOf uniListA <$> case i of
+                            IS i# -> pure $ drop (I# i#) xs
+                            IP _ -> case drop maxBound xs of
+                               []  -> pure []
+                               _ ->
+                                   throwing _StructuralUnliftingError
+                                       "Panic: unreachable clause executed"
+                            IN _ -> pure xs
+#else
+                        throwing _StructuralUnliftingError "'dropList' is not supported on GHC-8.10"
+#endif
+                    _ -> 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
@@ -2187,6 +2218,8 @@ instance Flat DefaultFun where
               CaseList                        -> 88
               CaseData                        -> 89
 
+              DropList                        -> 90
+
     decode = go =<< decodeBuiltin
         where go 0  = pure AddInteger
               go 1  = pure SubtractInteger
@@ -2278,6 +2311,7 @@ instance Flat DefaultFun where
               go 87 = pure ExpModInteger
               go 88 = pure CaseList
               go 89 = pure CaseData
+              go 90 = 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

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

plutus-ledger-api/src/PlutusLedgerApi/Common/Versions.hs

@@ -128,7 +128,8 @@ builtinsIntroducedIn = Map.fromList [
           ]),
   ((PlutusV3, futurePV), Set.fromList [
           ExpModInteger,
-          CaseList, CaseData
+          CaseList, CaseData,
+          DropList
           ])
   ]
 

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

@@ -234,6 +234,7 @@ builtinNames = [
     , 'Builtins.mkNilData
     , 'Builtins.mkNilPairData
     , 'Builtins.mkCons
+    , 'Builtins.drop
 
     , ''Builtins.BuiltinData
     , 'Builtins.chooseData
@@ -413,6 +414,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/src/PlutusTx/Builtins.hs

@@ -82,6 +82,7 @@ module PlutusTx.Builtins (
                          , headMaybe
                          , BI.head
                          , BI.tail
+                         , BI.drop
                          , uncons
                          , unsafeUncons
                          -- * Tracing

plutus-tx/src/PlutusTx/Builtins/Internal.hs

@@ -29,6 +29,7 @@ import Data.Data (Data)
 import Data.Foldable qualified as Foldable
 import Data.Hashable (Hashable (..))
 import Data.Kind (Type)
+import Data.List qualified as Haskell
 import Data.Text as Text (Text, empty)
 import Data.Text.Encoding as Text (decodeUtf8, encodeUtf8)
 import GHC.Generics (Generic)
@@ -408,6 +409,10 @@ chooseList :: BuiltinList a -> b -> b -> b
 chooseList (BuiltinList [])    b1 _ = b1
 chooseList (BuiltinList (_:_)) _ b2 = b2
 
+{-# OPAQUE drop #-}
+drop :: Integer -> BuiltinList a -> BuiltinList a
+drop i (BuiltinList xs) = BuiltinList (Haskell.genericDrop i xs)
+
 {-# OPAQUE caseList' #-}
 caseList' :: forall a r . r -> (a -> BuiltinList a -> r) -> BuiltinList a -> r
 caseList' nilCase _        (BuiltinList [])       = nilCase