BuiltinArray + functions in Plutus Core

plutus-core/cost-model/create-cost-model/BuiltinMemoryModels.hs

@@ -110,6 +110,9 @@ builtinMemoryModels = BuiltinCostModelBase
   , paramHeadList                        = Id $ ModelOneArgumentConstantCost    32
   , paramTailList                        = Id $ ModelOneArgumentConstantCost    32
   , paramNullList                        = Id $ ModelOneArgumentConstantCost    32
+  , paramLengthArray                     = Id $ ModelOneArgumentConstantCost    99
+  , paramListToArray                     = Id $ ModelOneArgumentConstantCost    99
+  , paramIndexArray                      = Id $ ModelTwoArgumentsConstantCost   99
   , paramChooseData                      = Id $ ModelSixArgumentsConstantCost   32
   , paramConstrData                      = Id $ ModelTwoArgumentsConstantCost   32
   , paramMapData                         = Id $ ModelOneArgumentConstantCost    32

plutus-core/cost-model/create-cost-model/CreateBuiltinCostModel.hs

@@ -75,6 +75,9 @@ builtinCostModelNames = BuiltinCostModelBase
   , paramHeadList                        = "headListModel"
   , paramTailList                        = "tailListModel"
   , paramNullList                        = "nullListModel"
+  , paramLengthArray                     = "lengthArrayModel"
+  , paramListToArray                     = "listToArrayModel"
+  , paramIndexArray                      = "indexArrayModel"
   , paramChooseData                      = "chooseDataModel"
   , paramConstrData                      = "constrDataModel"
   , paramMapData                         = "mapDataModel"
@@ -209,6 +212,10 @@ createBuiltinCostModel bmfile rfile = do
   paramHeadList                        <- getParams readCF1 paramHeadList
   paramTailList                        <- getParams readCF1 paramTailList
   paramNullList                        <- getParams readCF1 paramNullList
+  -- Arrays
+  paramLengthArray                     <- getParams readCF1 paramLengthArray
+  paramListToArray                     <- getParams readCF1 paramListToArray
+  paramIndexArray                      <- getParams readCF2 paramIndexArray
   -- Data
   paramChooseData                      <- getParams readCF6 paramChooseData
   paramConstrData                      <- getParams readCF2 paramConstrData

plutus-core/cost-model/data/builtinCostModelA.json

@@ -698,6 +698,36 @@
             "type": "constant_cost"
         }
     },
+    "lengthArray" : {
+        "cpu": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        },
+        "memory": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        }
+    },
+    "listToArray": {
+        "cpu": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        },
+        "memory": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        }
+    },
+    "indexArray": {
+        "cpu": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        },
+        "memory": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        }
+    },
     "quotientInteger": {
         "cpu": {
             "arguments": {

plutus-core/cost-model/data/builtinCostModelB.json

@@ -698,6 +698,36 @@
             "type": "constant_cost"
         }
     },
+    "lengthArray" : {
+        "cpu": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        },
+        "memory": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        }
+    },
+    "listToArray": {
+        "cpu": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        },
+        "memory": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        }
+    },
+    "indexArray": {
+        "cpu": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        },
+        "memory": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        }
+    },
     "quotientInteger": {
         "cpu": {
             "arguments": {

plutus-core/cost-model/data/builtinCostModelC.json

@@ -707,6 +707,36 @@
             "type": "constant_cost"
         }
     },
+    "lengthArray" : {
+        "cpu": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        },
+        "memory": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        }
+    },
+    "listToArray": {
+        "cpu": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        },
+        "memory": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        }
+    },
+    "indexArray": {
+        "cpu": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        },
+        "memory": {
+            "arguments": 99999999999999,
+            "type": "constant_cost"
+        }
+    },
     "quotientInteger": {
         "cpu": {
             "arguments": {

plutus-core/plutus-core.cabal

@@ -217,6 +217,7 @@ library
   other-modules:
     Data.Aeson.Flatten
     Data.Functor.Foldable.Monadic
+    Data.Vector.Orphans
     PlutusCore.Builtin.HasConstant
     PlutusCore.Builtin.KnownKind
     PlutusCore.Builtin.KnownType
@@ -341,7 +342,7 @@ library
     , time
     , transformers
     , unordered-containers
-    , vector
+    , vector                      ^>=0.13.2
     , witherable
 
   if impl(ghc <9.0)
@@ -376,7 +377,7 @@ test-suite plutus-core-test
   default-language: Haskell2010
   build-depends:
     , aeson
-    , base                             >=4.9   && <5
+    , base                             >=4.9     && <5
     , bytestring
     , containers
     , data-default-class
@@ -400,6 +401,7 @@ test-suite plutus-core-test
     , text
     , th-lift-instances
     , th-utilities
+    , vector                           ^>=0.13.2
 
 test-suite untyped-plutus-core-test
   import:         lang
@@ -815,6 +817,7 @@ library plutus-core-testlib
     , tasty-hedgehog
     , tasty-hunit
     , text
+    , vector
 
 -- This wraps up the use of the certifier library
 -- so we can present a consistent inteface whether we

plutus-core/plutus-core/src/Data/Vector/Orphans.hs

@@ -0,0 +1,16 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Data.Vector.Orphans () where
+
+import Data.Hashable (Hashable (hashWithSalt))
+import Data.Vector.Strict qualified as Strict
+import Flat (Flat (..))
+import Flat.Instances.Vector ()
+
+instance (Hashable a) => Hashable (Strict.Vector a) where
+  hashWithSalt = Strict.foldl' hashWithSalt
+
+instance (Flat a) => Flat (Strict.Vector a) where
+  size = size . Strict.toLazy -- Strict to Lazy is O(1)
+  encode = encode . Strict.toLazy
+  decode = Strict.fromLazy <$> decode -- Strict from Lazy is O(1)

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

@@ -43,6 +43,8 @@ import Data.ByteString.Lazy qualified as BSL
 import Data.Ix (Ix)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8', encodeUtf8)
+import Data.Vector.Strict (Vector)
+import Data.Vector.Strict qualified as Vector
 import Flat hiding (from, to)
 import Flat.Decoder (Get, dBEBits8)
 import Flat.Encoder as Flat (Encoding, NumBits, eBits)
@@ -104,6 +106,10 @@ data DefaultFun
     | HeadList
     | TailList
     | NullList
+    -- Arrays
+    | LengthArray
+    | ListToArray
+    | IndexArray
     -- 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
@@ -1547,13 +1553,47 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where
         let nullListDenotation :: SomeConstant uni [a] -> BuiltinResult Bool
             nullListDenotation (SomeConstant (Some (ValueOf uniListA xs))) =
                 case uniListA of
-                    DefaultUniList _argUni -> pure $ null xs
+                    DefaultUniList _uniA -> pure $ null xs
                     _ -> throwing _StructuralUnliftingError "Expected a list but got something else"
             {-# INLINE nullListDenotation #-}
         in makeBuiltinMeaning
             nullListDenotation
             (runCostingFunOneArgument . paramNullList)
 
+    toBuiltinMeaning _semvar LengthArray =
+      let lengthArrayDenotation :: SomeConstant uni (Vector a) -> BuiltinResult Int
+          lengthArrayDenotation (SomeConstant (Some (ValueOf uni vec))) =
+            case uni of
+              DefaultUniArray _uniA -> pure $ Vector.length vec
+              _ -> throwing _StructuralUnliftingError "Expected an array but got something else"
+          {-# INLINE lengthArrayDenotation #-}
+        in makeBuiltinMeaning lengthArrayDenotation (runCostingFunOneArgument . paramLengthArray)
+
+    toBuiltinMeaning _semvar ListToArray =
+      let listToArrayDenotation :: SomeConstant uni [a] -> BuiltinResult (Opaque val (Vector a))
+          listToArrayDenotation (SomeConstant (Some (ValueOf uniListA xs))) =
+            case uniListA of
+              DefaultUniList uniA -> pure $ fromValueOf (DefaultUniArray uniA) $ Vector.fromList xs
+              _ -> throwing _StructuralUnliftingError  "Expected an array but got something else"
+          {-# INLINE listToArrayDenotation #-}
+        in makeBuiltinMeaning listToArrayDenotation (runCostingFunOneArgument . paramListToArray)
+
+    toBuiltinMeaning _semvar IndexArray =
+      let indexArrayDenotation :: SomeConstant uni (Vector a) -> Int -> BuiltinResult (Opaque val a)
+          indexArrayDenotation (SomeConstant (Some (ValueOf uni vec))) n =
+            case uni of
+              DefaultUniArray arg -> do
+                case vec Vector.!? n of
+                  Nothing -> fail "Array index out of bounds"
+                  Just el -> pure $ fromValueOf arg el
+              _ ->
+                    -- See Note [Structural vs operational errors within builtins].
+                    -- The arguments are going to be printed in the "cause" part of the error
+                    -- message, so we don't need to repeat them here.
+                throwing _StructuralUnliftingError "Expected an array but got something else"
+          {-# INLINE indexArrayDenotation #-}
+        in makeBuiltinMeaning indexArrayDenotation (runCostingFunTwoArguments . paramIndexArray)
+
     -- Data
     toBuiltinMeaning _semvar ChooseData =
         let chooseDataDenotation :: Data -> a -> a -> a -> a -> a -> a
@@ -2183,6 +2223,10 @@ instance Flat DefaultFun where
               CaseList                        -> 88
               CaseData                        -> 89
 
+              LengthArray                     -> 90
+              ListToArray                     -> 91
+              IndexArray                      -> 92
+
     decode = go =<< decodeBuiltin
         where go 0  = pure AddInteger
               go 1  = pure SubtractInteger
@@ -2274,6 +2318,9 @@ instance Flat DefaultFun where
               go 87 = pure ExpModInteger
               go 88 = pure CaseList
               go 89 = pure CaseData
+              go 90 = pure LengthArray
+              go 91 = pure ListToArray
+              go 92 = pure IndexArray
               go t  = fail $ "Failed to decode builtin tag, got: " ++ show t
 
     size _ n = n + builtinTagWidth