Make 'Constr' a list back

plutus-core/plutus-core/src/PlutusCore/Compiler/Erase.hs

@@ -16,7 +16,7 @@ eraseTerm (TyInst ann term _)      = UPLC.Force ann (eraseTerm term)
 eraseTerm (Unwrap _ term)          = eraseTerm term
 eraseTerm (IWrap _ _ _ term)       = eraseTerm term
 eraseTerm (Error ann _)            = UPLC.Error ann
-eraseTerm (Constr ann _ i args)    = UPLC.Constr ann i (fromList $ fmap eraseTerm args)
+eraseTerm (Constr ann _ i args)    = UPLC.Constr ann i (fmap eraseTerm args)
 eraseTerm (Case ann _ arg cs)      = UPLC.Case ann (eraseTerm arg) (fromList $ fmap eraseTerm cs)
 
 eraseProgram :: Program tyname name uni fun ann -> UPLC.Program name uni fun ann

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Flat.hs

@@ -128,7 +128,7 @@ encodeTerm = \case
     Force    ann t      -> encodeTermTag 5 <> encode ann <> encodeTerm t
     Error    ann        -> encodeTermTag 6 <> encode ann
     Builtin  ann bn     -> encodeTermTag 7 <> encode ann <> encode bn
-    Constr   ann i es   -> encodeTermTag 8 <> encode ann <> encode i <> encodeListWith encodeTerm (V.toList es)
+    Constr   ann i es   -> encodeTermTag 8 <> encode ann <> encode i <> encodeListWith encodeTerm es
     Case     ann arg cs -> encodeTermTag 9 <> encode ann <> encodeTerm arg <> encodeListWith encodeTerm (V.toList cs)
 
 decodeTerm
@@ -163,7 +163,7 @@ decodeTerm version builtinPred = go
                 Just e  -> fail e
         handleTerm 8 = do
             unless (version >= PLC.plcVersion110) $ fail $ "'constr' is not allowed before version 1.1.0, this program has version: " ++ (show $ pretty version)
-            Constr   <$> decode <*> decode <*> (V.fromList <$> decodeListWith go)
+            Constr   <$> decode <*> decode <*> decodeListWith go
         handleTerm 9 = do
             unless (version >= PLC.plcVersion110) $ fail $ "'case' is not allowed before version 1.1.0, this program has version: " ++ (show $ pretty version)
             Case     <$> decode <*> go <*> (V.fromList <$> decodeListWith go)
@@ -193,7 +193,7 @@ sizeTerm tm sz =
     Force    ann t      -> size ann $ sizeTerm t sz'
     Error    ann        -> size ann sz'
     Builtin  ann bn     -> size ann $ size bn sz'
-    Constr   ann i es   -> size ann $ size i $ sizeListWith sizeTerm (V.toList es) sz'
+    Constr   ann i es   -> size ann $ size i $ sizeListWith sizeTerm es sz'
     Case     ann arg cs -> size ann $ sizeTerm arg $ sizeListWith sizeTerm (V.toList cs) sz'
 
 -- | An encoder for programs.

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs

@@ -85,7 +85,7 @@ data Term name uni fun ann
     -- TODO: worry about overflow, maybe use an Integer
     -- TODO: try spine-strict list or strict list or vector
     -- See Note [Constr tag type]
-    | Constr !ann !Word64 !(Vector (Term name uni fun ann))
+    | Constr !ann !Word64 ![Term name uni fun ann]
     | Case !ann !(Term name uni fun ann) !(Vector (Term name uni fun ann))
     deriving stock (Functor, Generic)
 
@@ -123,7 +123,7 @@ instance TermLike (Term name uni fun) TPLC.TyName name uni fun where
     unwrap   = const id
     iWrap    = \_ _ _ -> id
     error    = \ann _ -> Error ann
-    constr   = \ann _ i es -> Constr ann i (fromList es)
+    constr   = \ann _ i es -> Constr ann i es
     kase     = \ann _ arg cs -> Case ann arg (fromList cs)
 
 instance TPLC.HasConstant (Term name uni fun ()) where

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs

@@ -85,7 +85,6 @@ import UntypedPlutusCore.Evaluation.Machine.Cek.CekMachineCosts (CekMachineCosts
                                                                  CekMachineCostsBase (..))
 import UntypedPlutusCore.Evaluation.Machine.Cek.StepCounter
 
-import Control.Lens ((^?))
 import Control.Lens.Review
 import Control.Monad (unless, when)
 import Control.Monad.Catch
@@ -97,7 +96,6 @@ import Data.DList qualified as DList
 import Data.Functor.Identity
 import Data.Hashable (Hashable)
 import Data.Kind qualified as GHC
-import Data.List.Extras (wix)
 import Data.Proxy
 import Data.Semigroup (stimes)
 import Data.Text (Text)
@@ -538,11 +536,11 @@ dischargeCekValue = \case
     -- or (b) it's needed for an error message.
     -- @term@ is fully discharged, so we can return it directly without any further discharging.
     VBuiltin _ term _                    -> term
-    VConstr i es                         -> Constr () i (fmap dischargeCekValue $ stack2vec es)
+    VConstr i es                         -> Constr () i (fmap dischargeCekValue $ stack2list es)
       where
-        stack2vec = go mempty
+        stack2list = go []
         go acc EmptyStack           = acc
-        go acc (ConsStack arg rest) = go (arg `V.cons` acc) rest
+        go acc (ConsStack arg rest) = go (arg : acc) rest
 
 instance (PrettyUni uni, Pretty fun) => PrettyBy PrettyConfigPlc (CekValue uni fun ann) where
     prettyBy cfg = prettyBy cfg . dischargeCekValue
@@ -573,7 +571,7 @@ data Context uni fun ann
     | FrameForce !(Context uni fun ann)
     -- ^ @(force _)@
     -- See Note [Accumulators for terms]
-    | FrameConstr !(CekValEnv uni fun ann) {-# UNPACK #-} !Word64 !(V.Vector (NTerm uni fun ann)) !(ArgStack uni fun ann) !(Context uni fun ann)
+    | FrameConstr !(CekValEnv uni fun ann) {-# UNPACK #-} !Word64 ![NTerm uni fun ann] !(ArgStack uni fun ann) !(Context uni fun ann)
     -- ^ @(constr i V0 ... Vj-1 _ Nj ... Nn)@
     | FrameCases !(CekValEnv uni fun ann) !(V.Vector (NTerm uni fun ann)) !(Context uni fun ann)
     -- ^ @(case _ C0 .. Cn)@
@@ -720,9 +718,10 @@ enterComputeCek = computeCek
     -- s ; ρ ▻ constr I T0 .. Tn  ↦  s , constr I _ (T1 ... Tn, ρ) ; ρ ▻ T0
     computeCek !ctx !env (Constr _ i es) = do
         stepAndMaybeSpend BConstr
-        case V.uncons es of
-          Just (t, rest) -> computeCek (FrameConstr env i rest EmptyStack ctx) env t
-          Nothing        -> returnCek ctx $ VConstr i EmptyStack
+        case es of
+          (t : rest) -> computeCek (FrameConstr env i rest EmptyStack ctx) env t
+          []         -> returnCek ctx $ VConstr i EmptyStack
+    -- s ; ρ ▻ case S C0 ... Cn  ↦  s , case _ (C0 ... Cn, ρ) ; ρ ▻ S
     -- s ; ρ ▻ case S C0 ... Cn  ↦  s , case _ (C0 ... Cn, ρ) ; ρ ▻ S
     computeCek !ctx !env (Case _ scrut cs) = do
         stepAndMaybeSpend BCase
@@ -764,9 +763,9 @@ enterComputeCek = computeCek
     -- s , constr I V0 ... Vj-1 _ (Tj+1 ... Tn, ρ) ◅ Vj  ↦  s , constr i V0 ... Vj _ (Tj+2... Tn, ρ)  ; ρ ▻ Tj+1
     returnCek (FrameConstr env i todo done ctx) e = do
         let done' = ConsStack e done
-        case V.uncons todo of
-          Just (next, todo') -> computeCek (FrameConstr env i todo' done' ctx) env next
-          Nothing            -> returnCek ctx $ VConstr i done'
+        case todo of
+          (next : todo') -> computeCek (FrameConstr env i todo' done' ctx) env next
+          _              -> returnCek ctx $ VConstr i done'
     -- s , case _ (C0 ... CN, ρ) ◅ constr i V1 .. Vm  ↦  s , [_ V1 ... Vm] ; ρ ▻ Ci
     returnCek (FrameCases env cs ctx) e = case e of
         -- TODO: handle word/int conversion better

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs

@@ -57,7 +57,6 @@ import UntypedPlutusCore.Evaluation.Machine.Cek.StepCounter
 
 import Control.Lens hiding (Context)
 import Control.Monad
-import Data.List.Extras (wix)
 import Data.Proxy
 import Data.RandomAccessList.Class qualified as Env
 import Data.Semigroup (stimes)
@@ -99,7 +98,7 @@ data Context uni fun ann
     | FrameAwaitFunTerm ann !(CekValEnv uni fun ann) !(NTerm uni fun ann) !(Context uni fun ann) -- ^ @[_ N]@
     | FrameAwaitFunValue ann !(CekValue uni fun ann) !(Context uni fun ann)
     | FrameForce ann !(Context uni fun ann)                                               -- ^ @(force _)@
-    | FrameConstr ann !(CekValEnv uni fun ann) {-# UNPACK #-} !Word64 !(V.Vector (NTerm uni fun ann)) !(ArgStack uni fun ann) !(Context uni fun ann)
+    | FrameConstr ann !(CekValEnv uni fun ann) {-# UNPACK #-} !Word64 ![NTerm uni fun ann] !(ArgStack uni fun ann) !(Context uni fun ann)
     | FrameCases ann !(CekValEnv uni fun ann) !(V.Vector (NTerm uni fun ann)) !(Context uni fun ann)
     | NoFrame
 
@@ -153,9 +152,9 @@ computeCek !ctx !_ (Builtin _ bn) = do
 -- s ; ρ ▻ constr I T0 .. Tn  ↦  s , constr I _ (T1 ... Tn, ρ) ; ρ ▻ T0
 computeCek !ctx !env (Constr ann i es) = do
     stepAndMaybeSpend BConstr
-    case V.uncons es of
-        Just (t, rest) -> computeCek (FrameConstr ann env i rest EmptyStack ctx) env t
-        Nothing        -> returnCek ctx $ VConstr i EmptyStack
+    case es of
+        t : rest -> computeCek (FrameConstr ann env i rest EmptyStack ctx) env t
+        []       -> returnCek ctx $ VConstr i EmptyStack
 -- s ; ρ ▻ case S C0 ... Cn  ↦  s , case _ (C0 ... Cn, ρ) ; ρ ▻ S
 computeCek !ctx !env (Case ann scrut cs) = do
     stepAndMaybeSpend BCase
@@ -191,9 +190,9 @@ returnCek (FrameAwaitFunValue _ arg ctx) fun =
 -- s , constr I V0 ... Vj-1 _ (Tj+1 ... Tn, ρ) ◅ Vj  ↦  s , constr i V0 ... Vj _ (Tj+2... Tn, ρ)  ; ρ ▻ Tj+1
 returnCek (FrameConstr ann env i todo done ctx) e = do
     let done' = ConsStack e done
-    case V.uncons todo of
-        Just (next, todo') -> computeCek (FrameConstr ann env i todo' done' ctx) env next
-        Nothing            -> returnCek ctx $ VConstr i done'
+    case todo of
+        next : todo' -> computeCek (FrameConstr ann env i todo' done' ctx) env next
+        []           -> returnCek ctx $ VConstr i done'
 -- s , case _ (C0 ... CN, ρ) ◅ constr i V1 .. Vm  ↦  s , [_ V1 ... Vm] ; ρ ▻ Ci
 returnCek (FrameCases ann env cs ctx) e = case e of
     (VConstr i args) -> case (V.!?) cs (fromIntegral i) of

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Parser.hs

@@ -75,7 +75,7 @@ errorTerm = withSpan $ \sp ->
 constrTerm :: Parser PTerm
 constrTerm = withSpan $ \sp ->
     inParens $ do
-      res <- UPLC.Constr sp <$> (symbol "constr" *> lexeme Lex.decimal) <*> (V.fromList <$> many term)
+      res <- UPLC.Constr sp <$> (symbol "constr" *> lexeme Lex.decimal) <*> many term
       whenVersion (\v -> v < plcVersion110) $ fail "'constr' is not allowed before version 1.1.0"
       pure res
 

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs

@@ -7,14 +7,14 @@ module UntypedPlutusCore.Transform.CaseReduce
 import PlutusCore.MkPlc
 import UntypedPlutusCore.Core
 
-import Control.Lens (transformOf, (^?))
-import Data.List.Extras
+import Control.Lens (transformOf)
 import Data.Vector qualified as V
 
 caseReduce :: Term name uni fun a -> Term name uni fun a
 caseReduce = transformOf termSubterms processTerm
 
 processTerm :: Term name uni fun a -> Term name uni fun a
 processTerm = \case
-    Case ann (Constr _ i args) cs | Just c <- (V.!?) cs (fromIntegral i) -> mkIterApp c ((ann,) <$> (V.toList args))
+    Case ann (Constr _ i args) cs | Just c <- (V.!?) cs (fromIntegral i) ->
+        mkIterApp c ((ann,) <$> args)
     t                                                     -> t

plutus-core/untyped-plutus-core/test/Analysis/Spec.hs

@@ -4,7 +4,6 @@ module Analysis.Spec where
 
 import Test.Tasty.Extras
 
-import Data.Vector qualified as V
 import PlutusCore qualified as PLC
 import PlutusCore.MkPlc
 import PlutusCore.Pretty (prettyPlcReadableDef)
@@ -27,7 +26,7 @@ dangerTerm = runQuote $ do
   -- The UPLC term type is strict, so it's hard to hide an undefined in there
   -- Take advantage of the fact that it's still using lazy lists for constr
   -- arguments for now.
-  pure $ Apply () (Apply () (Var () n) (Var () m)) (Constr () 1 (V.fromList [undefined]))
+  pure $ Apply () (Apply () (Var () n) (Var () m)) (Constr () 1 [undefined])
 
 letFun :: Term Name PLC.DefaultUni PLC.DefaultFun ()
 letFun = runQuote $ do

plutus-core/untyped-plutus-core/test/Generators.hs

@@ -58,7 +58,7 @@ compareTerm (Force _ t ) (Force _ t')         = compareTerm t t'
 compareTerm (Delay _ t ) (Delay _ t')         = compareTerm t t'
 compareTerm (Constant _ x) (Constant _ y)     = x == y
 compareTerm (Builtin _ bi) (Builtin _ bi')    = bi == bi'
-compareTerm (Constr _ i es) (Constr _ i' es') = i == i' && maybe False (all (uncurry compareTerm)) (zipExact (V.toList es) (V.toList es'))
+compareTerm (Constr _ i es) (Constr _ i' es') = i == i' && maybe False (all (uncurry compareTerm)) (zipExact es es')
 compareTerm (Case _ arg cs) (Case _ arg' cs') = compareTerm arg arg' && maybe False (all (uncurry compareTerm)) (zipExact (V.toList cs) (V.toList cs'))
 compareTerm (Error _ ) (Error _ )             = True
 compareTerm _ _                               = False

plutus-core/untyped-plutus-core/test/Transform/Simplify.hs

@@ -66,7 +66,7 @@ caseOfCase3 = runQuote $ do
   xs <- freshName "xs"
   f <- freshName "f"
   let ite = Force () (Builtin () PLC.IfThenElse)
-      true = Constr () 0 (V.fromList [Var () x, Var () xs])
+      true = Constr () 0 [Var () x, Var () xs]
       false = Constr () 1 mempty
       altTrue = Var () f
       altFalse = mkConstant @Integer () 2