WIP

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

@@ -1583,13 +1583,14 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where
           indexArrayDenotation (SomeConstant (Some (ValueOf uni vec))) n =
             case uni of
               DefaultUniArray arg -> do
-                unless (n >= 0 && n < Vector.length vec) $
-                    -- 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.
-                    fail "Array index out of bounds"
-                pure $ fromValueOf arg $ vec Vector.! n
-              _ -> throwing _StructuralUnliftingError "Expected an array but got something else"
+                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)
 

plutus-core/plutus-core/src/PlutusCore/Parser/Builtin.hs

@@ -84,7 +84,7 @@ conList uniA = trailingWhitespace . inBrackets $
 
 -- | Parser for arrays.
 conArray :: DefaultUni (Esc a) -> Parser (Vector a)
-conArray = fmap Vector.fromList . conList
+conArray uniA = Vector.fromList <$> conList uniA
 
 -- | Parser for pairs.
 conPair :: DefaultUni (Esc a) -> DefaultUni (Esc b) -> Parser (a, b)

plutus-core/plutus-ir/src/PlutusIR/Compiler/Definitions.hs

@@ -167,7 +167,7 @@ wrapWithDefs ::
 wrapWithDefs x tds body =
   let toValue k = fst <$> Map.lookup k tds
       wrapDefScc acc scc =
-        let bs = catMaybes $ toValue <$> Graph.vertexList scc
+        let bs = mapMaybe toValue (Graph.vertexList scc)
          in mkLet x (if Graph.isAcyclic scc then NonRec else Rec) bs acc
    in -- process from the inside out
       Foldable.foldl' wrapDefScc body (defSccs tds)

plutus-tx-plugin/plutus-tx-plugin.cabal

@@ -115,6 +115,7 @@ test-suite plutus-tx-plugin-tests
   hs-source-dirs:     test
   main-is:            Spec.hs
   other-modules:
+    Array.Spec
     AsData.Budget.Spec
     AsData.Budget.Types
     AssocMap.Spec

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

@@ -18,6 +18,8 @@ module PlutusTx.Compiler.Builtins (
     , lookupBuiltinType
     , errorFunc) where
 
+import Debug.Trace qualified as Debug
+
 import PlutusTx.Builtins.HasOpaque qualified as Builtins
 import PlutusTx.Builtins.Internal qualified as Builtins
 
@@ -239,6 +241,11 @@ builtinNames = [
     , 'Builtins.mkNilPairData
     , 'Builtins.mkCons
 
+    , ''Builtins.BuiltinArray
+    , 'Builtins.lengthOfArray
+    , 'Builtins.listToArray
+    , 'Builtins.indexArray
+
     , ''Builtins.BuiltinData
     , 'Builtins.chooseData
     , 'Builtins.caseData'
@@ -303,7 +310,7 @@ builtinNames = [
 
 defineBuiltinTerm :: CompilingDefault uni fun m ann => Ann -> TH.Name -> PIRTerm uni fun -> m ()
 defineBuiltinTerm ann name term = do
-    ghcId <- lookupGhcId name
+    ghcId <- lookupGhcId $ Debug.traceShowId name
     var <- compileVarFresh ann ghcId
     binfo <- asks ccBuiltinsInfo
     -- See Note [Builtin terms and values]
@@ -314,7 +321,7 @@ defineBuiltinTerm ann name term = do
 -- | Add definitions for all the builtin types to the environment.
 defineBuiltinType :: forall uni fun m ann. Compiling uni fun m ann => TH.Name -> PIRType uni -> m ()
 defineBuiltinType name ty = do
-    tc <- lookupGhcTyCon name
+    tc <- lookupGhcTyCon $ Debug.traceShowId name
     var <- compileTcTyVarFresh tc
     PIR.defineType (LexName $ GHC.getName tc) (PIR.Def var ty) mempty
     -- these are all aliases for now
@@ -460,6 +467,11 @@ defineBuiltinTerms = do
             PLC.MkNilPairData -> defineBuiltinInl 'Builtins.mkNilPairData
             PLC.MkCons -> defineBuiltinInl 'Builtins.mkCons
 
+            -- Arrays
+            PLC.LengthArray -> defineBuiltinInl 'Builtins.lengthOfArray
+            PLC.ListToArray -> defineBuiltinInl 'Builtins.listToArray
+            PLC.IndexArray -> defineBuiltinInl 'Builtins.indexArray
+
             -- Data
             PLC.ChooseData -> defineBuiltinInl 'Builtins.chooseData
             PLC.EqualsData -> defineBuiltinInl 'Builtins.equalsData
@@ -597,9 +609,7 @@ defineBuiltinTerms = do
 
             PLC.ExpModInteger -> defineBuiltinInl 'Builtins.expModInteger
 
-defineBuiltinTypes
-    :: CompilingDefault uni fun m ann
-    => m ()
+defineBuiltinTypes :: CompilingDefault uni fun m ann => m ()
 defineBuiltinTypes = do
     defineBuiltinType ''Builtins.BuiltinByteString . ($> annMayInline) $ PLC.toTypeAst $ Proxy @BS.ByteString
     defineBuiltinType ''Integer . ($> annMayInline) $ PLC.toTypeAst $ Proxy @Integer
@@ -609,6 +619,7 @@ defineBuiltinTypes = do
     defineBuiltinType ''Builtins.BuiltinData . ($> annMayInline) $ PLC.toTypeAst $ Proxy @PLC.Data
     defineBuiltinType ''Builtins.BuiltinPair . ($> annMayInline) $ PLC.TyBuiltin () (PLC.SomeTypeIn PLC.DefaultUniProtoPair)
     defineBuiltinType ''Builtins.BuiltinList . ($> annMayInline) $ PLC.TyBuiltin () (PLC.SomeTypeIn PLC.DefaultUniProtoList)
+    defineBuiltinType ''Builtins.BuiltinArray . ($> annMayInline) $ PLC.TyBuiltin () (PLC.SomeTypeIn PLC.DefaultUniProtoArray)
     defineBuiltinType ''Builtins.BuiltinBLS12_381_G1_Element . ($> annMayInline) $ PLC.toTypeAst $ Proxy @BLS12_381.G1.Element
     defineBuiltinType ''Builtins.BuiltinBLS12_381_G2_Element . ($> annMayInline) $ PLC.toTypeAst $ Proxy @BLS12_381.G2.Element
     defineBuiltinType ''Builtins.BuiltinBLS12_381_MlResult . ($> annMayInline) $ PLC.toTypeAst $ Proxy @BLS12_381.Pairing.MlResult

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

@@ -18,6 +18,8 @@
 -- | Functions for compiling GHC Core expressions into Plutus Core terms.
 module PlutusTx.Compiler.Expr (compileExpr, compileExprWithDefs, compileDataConRef) where
 
+import Debug.Trace qualified as Debug
+
 import GHC.Builtin.Names qualified as GHC
 import GHC.Builtin.Types.Prim qualified as GHC
 import GHC.ByteCode.Types qualified as GHC
@@ -767,6 +769,7 @@ compileExpr e = traceCompilation 2 ("Compiling expr:" GHC.<+> GHC.ppr e) $ do
   -- TODO: Maybe share this to avoid repeated lookups. Probably cheap, though.
   builtinIntegerTyCon <- lookupGhcTyCon ''BI.BuiltinInteger
   builtinBoolTyCon <- lookupGhcTyCon ''BI.BuiltinBool
+  builtinArrayTyCon <- lookupGhcTyCon ''BI.BuiltinArray
   builtinDataTyCon <- lookupGhcTyCon ''Builtins.BuiltinData
   builtinPairTyCon <- lookupGhcTyCon ''BI.BuiltinPair
   stringTyName <- lookupGhcName ''Builtins.BuiltinString

plutus-tx-plugin/test/Array/Spec.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE BlockArguments    #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE TypeApplications  #-}
+{-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-}
+-- {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:dump-compilation-trace #-}
+
+module Array.Spec where
+
+import PlutusCore (someValue)
+import PlutusTx (CompiledCode, getPlcNoAnn)
+import PlutusTx.Builtins (listToArray)
+import PlutusTx.TH (compile)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.Extras (embed)
+import Test.Tasty.HUnit (testCase, (@?=))
+import UntypedPlutusCore (DefaultFun, DefaultUni, NamedDeBruijn, Program (_progTerm),
+                          Term (Constant))
+
+smokeTests :: TestTree
+smokeTests =
+  testGroup "Array" [testListToArray]
+
+testListToArray :: TestTree
+testListToArray = testCase "Array" do
+  term compiledArray @?= Constant () (someValue [1 :: Integer, 2, 3])
+ where
+  compiledArray =
+    $$( compile
+          [||
+          let xs :: [Integer]
+              xs = [1, 2, 3]
+           in xs
+          ||]
+      )
+
+term :: CompiledCode a -> Term NamedDeBruijn DefaultUni DefaultFun ()
+term = _progTerm . getPlcNoAnn

plutus-tx-plugin/test/Spec.hs

@@ -1,5 +1,6 @@
 module Main (main) where
 
+import Array.Spec qualified as Array
 import AsData.Budget.Spec qualified as AsData.Budget
 import AssocMap.Spec qualified as AssocMap
 import Blueprint.Tests qualified
@@ -49,4 +50,5 @@ tests =
     , embed Unicode.tests
     , embed AssocMap.propertyTests
     , embed List.propertyTests
+    , embed Array.smokeTests
     ]

plutus-tx/src/PlutusTx/Builtins.hs

@@ -86,6 +86,11 @@ module PlutusTx.Builtins (
                          , BI.tail
                          , uncons
                          , unsafeUncons
+                         -- * Arrays
+                         , BI.BuiltinArray
+                         , BI.listToArray
+                         , BI.lengthOfArray
+                         , BI.indexArray
                          -- * Tracing
                          , trace
                          -- * BLS12_381

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

@@ -18,7 +18,7 @@ import PlutusTx.Builtins.Internal
 import Data.ByteString (ByteString)
 import Data.Kind qualified as GHC
 import Data.Text (Text)
-import Data.Vector.Strict (Vector)
+import Data.Vector.Strict qualified as Strict
 
 {- Note [useToOpaque and useFromOpaque]
 It used to be possible to use 'toBuiltin'/'fromBuiltin' within a smart contract, but this is no
@@ -92,9 +92,12 @@ instance HasFromBuiltin a => HasFromBuiltin (BuiltinList a) where
     type FromBuiltin (BuiltinList a) = [FromBuiltin a]
     fromBuiltin (BuiltinList xs) = map fromBuiltin xs
 
-instance HasToBuiltin a => HasToBuiltin (Vector a) where
-    type ToBuiltin (Vector a) = BuiltinArray (ToBuiltin a)
-    toBuiltin = useToOpaque (BuiltinArray . map toBuiltin)
+instance HasToBuiltin a => HasToBuiltin (Strict.Vector a) where
+    type ToBuiltin (Strict.Vector a) = BuiltinArray (ToBuiltin a)
+    toBuiltin = useToOpaque (BuiltinArray . fmap toBuiltin)
+instance HasFromBuiltin a => HasFromBuiltin (BuiltinArray a) where
+    type FromBuiltin (BuiltinArray a) = Strict.Vector (FromBuiltin a)
+    fromBuiltin (BuiltinArray xs) = fmap fromBuiltin xs
 
 instance (HasToBuiltin a, HasToBuiltin b) => HasToBuiltin (a, b) where
     type ToBuiltin (a, b) = BuiltinPair (ToBuiltin a) (ToBuiltin b)

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

@@ -31,6 +31,8 @@ import Data.Hashable (Hashable (..))
 import Data.Kind (Type)
 import Data.Text as Text (Text, empty)
 import Data.Text.Encoding as Text (decodeUtf8, encodeUtf8)
+import Data.Vector.Strict (Vector)
+import Data.Vector.Strict qualified as Vector
 import GHC.Generics (Generic)
 import PlutusCore.Bitwise qualified as Bitwise
 import PlutusCore.Builtin (BuiltinResult (..))
@@ -551,6 +553,30 @@ serialiseData :: BuiltinData -> BuiltinByteString
 serialiseData (BuiltinData b) = BuiltinByteString $ BSL.toStrict $ serialise b
 {-# OPAQUE serialiseData #-}
 
+{-
+ARRAY
+-}
+
+data BuiltinArray a = BuiltinArray ~(Vector a) deriving stock (Data)
+
+instance Haskell.Show a => Haskell.Show (BuiltinArray a) where
+    show (BuiltinArray v) = show v
+instance Haskell.Eq a => Haskell.Eq (BuiltinArray a) where
+    (==) (BuiltinArray v) (BuiltinArray v') = (==) v v'
+instance Haskell.Ord a => Haskell.Ord (BuiltinArray a) where
+    compare (BuiltinArray v) (BuiltinArray v') = compare v v'
+
+lengthOfArray :: BuiltinArray a -> BuiltinInteger
+lengthOfArray (BuiltinArray v) = toInteger (Vector.length v)
+{-# OPAQUE lengthOfArray #-}
+
+listToArray :: [a] -> BuiltinArray a
+listToArray l = BuiltinArray (Vector.fromList l)
+{-# OPAQUE listToArray #-}
+
+indexArray :: BuiltinArray a -> BuiltinInteger -> a
+indexArray (BuiltinArray v) i = v Vector.! fromInteger i
+{-# OPAQUE indexArray #-}
 
 {-
 BLS12_381

plutus-tx/src/PlutusTx/Lift/Class.hs

@@ -40,6 +40,7 @@ import Data.ByteString qualified as BS
 import Data.Kind qualified as GHC
 import Data.Proxy
 import Data.Text qualified as T
+import Data.Vector.Strict qualified as Strict
 import GHC.TypeLits (ErrorMessage (..), TypeError)
 
 -- We do not use qualified import because the whole module contains off-chain code
@@ -180,6 +181,16 @@ instance (HasFromBuiltin arep, uni `PLC.HasTermLevel` [FromBuiltin arep]) =>
         Lift uni (BuiltinList arep) where
     lift = liftBuiltin . fromBuiltin
 
+-- See Note [Lift and Typeable instances for builtins]
+instance uni `PLC.HasTypeLevel` Strict.Vector => Typeable uni BuiltinArray where
+    typeRep _ = typeRepBuiltin (Proxy @Strict.Vector)
+
+-- See Note [Lift and Typeable instances for builtins]
+instance ( HasFromBuiltin arep
+         , uni `PLC.HasTermLevel` Strict.Vector (FromBuiltin arep)
+         ) => Lift uni (BuiltinArray arep) where
+    lift = liftBuiltin . fromBuiltin
+
 instance uni `PLC.HasTypeLevel` (,) => Typeable uni BuiltinPair where
     typeRep _ = typeRepBuiltin (Proxy @(,))