Evil mutable arrays

IntersectMBO · Jun 8, 2021 · 1b3b253 · 1b3b253
1 parent 9e65c7c
commit 1b3b253
Show file tree

Hide file tree

Showing 3 changed files with 10 additions and 10 deletions.
diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs
@@ -26,7 +26,6 @@ import           Data.Functor.Identity
 import           Data.Text.Prettyprint.Doc
 import           PlutusPrelude
 
-import           Data.Word
 import qualified PlutusCore.Constant                    as TPLC
 import qualified PlutusCore.Core                        as TPLC
 import           PlutusCore.Evaluation.Machine.ExBudget
@@ -36,7 +35,7 @@ import qualified PlutusCore.Name                        as TPLC
 import           Universe
 
 -- | A global name ('GName') or an underlying name.
-data GName name = GName {-# UNPACK #-} !Word64 | NName !name
+data GName name = GName {-# UNPACK #-} !Int | NName !name
     deriving stock (Show, Eq, Ord, Generic)
     deriving anyclass (NFData)
 

diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs
@@ -72,6 +72,7 @@ import           Data.DList                                               (DList
 import qualified Data.DList                                               as DList
 import           Data.Hashable                                            (Hashable)
 import qualified Data.Kind                                                as GHC
+import qualified Data.Primitive.Array                                     as PrimArray
 import           Data.Proxy
 import           Data.STRef
 import           Data.Semigroup                                           (stimes)
@@ -206,7 +207,7 @@ data CekValue uni fun =
 
 type CekValEnv uni fun = UniqueMap TermUnique (CekValue uni fun)
 
-type CekGValEnv uni fun s = STArray.STArray s Word64 (CekValue uni fun)
+type CekGValEnv uni fun s = PrimArray.MutableArray s (CekValue uni fun)
 
 -- | The CEK machine is parameterized over a @spendBudget@ function that has (roughly) the same type
 -- as the one from the 'SpendBudget' class (and so the @SpendBudget@ instance for 'CekM'
@@ -547,13 +548,13 @@ runCekM
     => MachineParameters CekMachineCosts CekValue uni fun
     -> ExBudgetMode cost uni fun
     -> Bool
-    -> Word64
+    -> Int
     -> (forall s. GivenCekReqs uni fun s => CekM uni fun s a)
     -> (Either (CekEvaluationException uni fun) a, cost, [String])
 runCekM (MachineParameters costs runtime) (ExBudgetMode getExBudgetInfo) emitting gmax a = runST $ do
     exBudgetMode <- getExBudgetInfo
     mayLogsRef <- if emitting then Just <$> newSTRef DList.empty else pure Nothing
-    arr <- STArray.newArray_ (0, gmax)
+    arr <- PrimArray.newArray (gmax+1) undefined
     let ?cekRuntime = runtime
         ?cekEmitter = mayLogsRef
         ?cekBudgetSpender = _exBudgetModeSpender exBudgetMode
@@ -574,7 +575,7 @@ runCekM (MachineParameters costs runtime) (ExBudgetMode getExBudgetInfo) emittin
 -- and the environment the value is defined in.
 extendEnv :: (GivenCekGEnv uni fun s) => GName Name -> CekValue uni fun -> CekValEnv uni fun -> CekM uni fun s (CekValEnv uni fun)
 extendEnv (NName n) v e = pure $ insertByName n v e
-extendEnv (GName n) v e = CekCarryingM $ STArray.writeArray ?cekGEnv n v >> pure e
+extendEnv (GName n) v e = CekCarryingM $ PrimArray.writeArray ?cekGEnv n v >> pure e
 
 --{-# INLINE lookupVarName #-}
 -- | Look up a variable name in the environment.
@@ -583,7 +584,7 @@ lookupVarName v@(NName n) varEnv =
     case lookupName n varEnv of
         Nothing  -> throwingWithCause _MachineError OpenTermEvaluatedMachineError $ Just (Var () v)
         Just val -> pure val
-lookupVarName (GName w) _ = CekCarryingM $ STArray.readArray ?cekGEnv w
+lookupVarName (GName w) _ = CekCarryingM $ PrimArray.readArray ?cekGEnv w
 
 -- | Take pieces of a possibly partial builtin application and either create a 'CekValue' using
 -- 'makeKnown' or a partial builtin application depending on whether the built-in function is

diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Globalify.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Globalify.hs
@@ -49,10 +49,10 @@ globalifyProgram (Program x v t) = Program x v $ globalifyTerm t
 globalifyTerm :: Term TPLC.Name uni fun ann -> Term (GName TPLC.Name) uni fun ann
 globalifyTerm t = flip runReader (0, mempty) $ gatherGlobals $ runQuote $ rename t
 
-maxGlobal :: Term (GName name) uni fun a -> Word64
+maxGlobal :: Term (GName name) uni fun a -> Int
 maxGlobal t = getMax $ foldMapOf (cosmosOf termSubterms) (\case {LamAbs _ (GName w) _  -> Max w; _ -> Max 0}) t
 
-gatherGlobals :: forall m uni fun ann . (m ~ Reader (Word64, TPLC.UniqueMap TPLC.TermUnique Word64)) => Term TPLC.Name uni fun ann -> m (Term (GName TPLC.Name) uni fun ann)
+gatherGlobals :: forall m uni fun ann . (m ~ Reader (Int, TPLC.UniqueMap TPLC.TermUnique Int)) => Term TPLC.Name uni fun ann -> m (Term (GName TPLC.Name) uni fun ann)
 -- See Note [Globalifying]
 -- This is the key part!
 gatherGlobals (Apply x l r) = Apply x <$> gatherGlobals l <*> rewriteGlobals r
@@ -65,7 +65,7 @@ gatherGlobals (Force x b) = Force x <$> gatherGlobals b
 -- This is just the non-recursive bits
 gatherGlobals t = rewriteGlobals t
 
-rewriteGlobals :: Term TPLC.Name uni fun ann -> Reader (Word64, TPLC.UniqueMap TPLC.TermUnique Word64) (Term (GName TPLC.Name) uni fun ann)
+rewriteGlobals :: Term TPLC.Name uni fun ann -> Reader (Int, TPLC.UniqueMap TPLC.TermUnique Int) (Term (GName TPLC.Name) uni fun ann)
 rewriteGlobals t = do
     m <- asks snd
     let go n  =