Revert "Keep track of currency/token lengths in builtin Value (#7349)" (#7370)

Author: zliu41

plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs

@@ -25,7 +25,6 @@ import PlutusCore.Evaluation.Machine.ExMemory
 import PlutusCore.Value (Value)
 import PlutusCore.Value qualified as Value
 
-import Control.Arrow ((&&&))
 import Data.ByteString qualified as BS
 import Data.Functor
 import Data.Map.Strict qualified as Map
@@ -375,37 +374,22 @@ instance ExMemoryUsage Data where
             B b        -> memoryUsage b
 
 instance ExMemoryUsage Value where
-  memoryUsage = memoryUsage . ValueTotalSize
+    memoryUsage = singletonRose . fromIntegral . Value.totalSize
 
-
-{-| Measure the size of a `Value` by its `Value.totalSize`, multiplied by
-the length of the longest currency symbol or token name plus 1.
--}
-newtype ValueTotalSize = ValueTotalSize {unValueTotalSize :: Value}
+-- | Measure the size of a `Value` by its `Value.totalSize`.
+newtype ValueTotalSize = ValueTotalSize { unValueTotalSize :: Value }
 
 instance ExMemoryUsage ValueTotalSize where
-  memoryUsage =
-    singletonRose
-      . fromInteger
-      . uncurry (*)
-      . (toInteger . Value.totalSize &&& toInteger . (+1) . Value.maxKeyLength)
-      . unValueTotalSize
-
-{-| Measure the size of a `Value` by taking the max of
-(size of the outer map, size of the largest inner map), multiplied by
-the length of the longest currency symbol or token name plus 1.
--}
-newtype ValueOuterOrMaxInner = ValueOuterOrMaxInner {unValueOuterOrMaxInner :: Value}
+    memoryUsage = singletonRose . fromIntegral . Value.totalSize . unValueTotalSize
+
+-- | Measure the size of a `Value` by taking the max of
+-- (size of the outer map, size of the largest inner map).
+newtype ValueOuterOrMaxInner = ValueOuterOrMaxInner { unValueOuterOrMaxInner :: Value }
 
 instance ExMemoryUsage ValueOuterOrMaxInner where
-  memoryUsage =
-    singletonRose
-      . fromInteger
-      . uncurry (*)
-      . ( toInteger . (+1) . Value.maxKeyLength
-            &&& (toInteger . uncurry max . (Map.size . Value.unpack &&& Value.maxInnerSize))
-        )
-      . unValueOuterOrMaxInner
+    memoryUsage (ValueOuterOrMaxInner v) = singletonRose (fromIntegral size)
+      where
+        size = Map.size (Value.unpack v) `max` Value.maxInnerSize v
 
 {- Note [Costing constant-size types]
 The memory usage of each of the BLS12-381 types is constant, so we may be able

plutus-core/plutus-core/src/PlutusCore/Value.hs

@@ -14,7 +14,6 @@ module PlutusCore.Value (
   toFlatList,
   totalSize,
   maxInnerSize,
-  maxKeyLength,
   insertCoin,
   deleteCoin,
   lookupCoin,
@@ -29,7 +28,6 @@ import Control.DeepSeq (NFData)
 import Data.Bifunctor
 import Data.Bitraversable
 import Data.ByteString (ByteString)
-import Data.ByteString qualified as B
 import Data.ByteString.Base64 qualified as Base64
 import Data.Functor
 import Data.Hashable (Hashable)
@@ -62,10 +60,6 @@ data Value
 
       Invariant: all values are positive.
       -}
-      !(IntMap Int)
-      {- ^ Map from length to the number of `ByteString`s of that length
-      (across both outer and inner maps).
-      -}
       {-# UNPACK #-} !Int
       {-^ Total size, i.e., sum total of inner map sizes. This avoids recomputing
       the total size during the costing of operations like `unionValue`.
@@ -78,7 +72,7 @@ data Value
 The map is guaranteed to not contain empty inner map or zero amount.
 -}
 unpack :: Value -> NestedMap
-unpack (Value v _ _ _) = v
+unpack (Value v _ _) = v
 {-# INLINE unpack #-}
 
 {-| Pack a map from (currency symbol, token name) to amount into a `Value`.
@@ -91,19 +85,11 @@ pack = pack' . normalize
 
 -- | Like `pack` but does not normalize.
 pack' :: NestedMap -> Value
-pack' v = Value v sizes lens size
+pack' v = Value v sizes size
  where
-  (sizes, lens, size) = Map.foldrWithKey' alg (mempty, mempty, 0) v
-  alg currency inner (ss, ls, s) =
-    ( incCount (Map.size inner) ss
-    , IntMap.unionWith
-        (+)
-        (incCount (B.length currency) ls)
-        ( Map.foldrWithKey'
-            (\token _ -> incCount (B.length token))
-            mempty
-            inner
-        )
+  (sizes, size) = Map.foldl' alg (mempty, 0) v
+  alg (ss, s) inner =
+    ( IntMap.alter (maybe (Just 1) (Just . (+ 1))) (Map.size inner) ss
     , s + Map.size inner
     )
 {-# INLINEABLE pack' #-}
@@ -112,20 +98,16 @@ pack' v = Value v sizes lens size
 contained in the `Value`.
 -}
 totalSize :: Value -> Int
-totalSize (Value _ _ _ size) = size
+totalSize (Value _ _ size) = size
 {-# INLINE totalSize #-}
 
 -- | Size of the largest inner map.
 maxInnerSize :: Value -> Int
-maxInnerSize (Value _ sizes _ _) = maybe 0 fst (IntMap.lookupMax sizes)
+maxInnerSize (Value _ sizes _) = maybe 0 fst (IntMap.lookupMax sizes)
 {-# INLINE maxInnerSize #-}
 
--- | Maximum `ByteString` length, across both outer and inner maps.
-maxKeyLength :: Value -> Int
-maxKeyLength (Value _ _ lens _) = maybe 0 fst (IntMap.lookupMax lens)
-
 empty :: Value
-empty = Value mempty mempty mempty 0
+empty = Value mempty mempty 0
 {-# INLINE empty #-}
 
 toList :: Value -> [(ByteString, [(ByteString, Integer)])]
@@ -155,60 +137,47 @@ instance Pretty Value where
 the size of the largest inner map.
 -}
 insertCoin :: ByteString -> ByteString -> Integer -> Value -> Value
-insertCoin currency token amt v@(Value outer sizes lens size)
+insertCoin currency token amt v@(Value outer sizes size)
   | amt == 0 = deleteCoin currency token v
   | otherwise =
-      let (r, outer') = Map.alterF f currency outer
-          (sizes', lens', size') = case r of
-            Just (old, currencyInserted) ->
-              ( updateSizes old (old + 1) sizes
-              , (if currencyInserted then incCount (B.length currency) else id)
-                  (incCount (B.length token) lens)
-              , size + 1
-              )
-            Nothing -> (sizes, lens, size)
-       in Value outer' sizes' lens' size'
+      let (mold, outer') = Map.alterF f currency outer
+          (sizes', size') = case mold of
+            Just old -> (updateSizes old (old + 1) sizes, size + 1)
+            Nothing  -> (sizes, size)
+       in Value outer' sizes' size'
  where
   f
     :: Maybe (Map ByteString Integer)
-    -> ( -- Just (old size of inner map, whether it is a new currency)
-         -- if the total size grows by 1, otherwise Nothing
-         Maybe (Int, Bool)
+    -> ( -- Just (old size of inner map) if the total size grows by 1, otherwise Nothing
+         Maybe Int
        , Maybe (Map ByteString Integer)
        )
   f = \case
-    Nothing -> (Just (0, True), Just (Map.singleton token amt))
+    Nothing -> (Just 0, Just (Map.singleton token amt))
     Just inner ->
       let (isJust -> exists, inner') = Map.insertLookupWithKey (\_ _ _ -> amt) token amt inner
-       in (if exists then Nothing else Just (Map.size inner, False), Just inner')
+       in (if exists then Nothing else Just (Map.size inner), Just inner')
 {-# INLINEABLE insertCoin #-}
 
 -- | \(O(\log \max(m, k))\)
 deleteCoin :: ByteString -> ByteString -> Value -> Value
-deleteCoin currency token (Value outer sizes lens size) = Value outer' sizes' lens' size'
+deleteCoin currency token (Value outer sizes size) = Value outer' sizes' size'
  where
-  (r, outer') = Map.alterF f currency outer
-  (sizes', lens', size') = case r of
-    Just (old, currencyDeleted) ->
-      ( updateSizes old (old - 1) sizes
-      , (if currencyDeleted then decLen (B.length currency) else id) (decLen (B.length token) lens)
-      , size - 1
-      )
-    Nothing -> (sizes, lens, size)
+  (mold, outer') = Map.alterF f currency outer
+  (sizes', size') = case mold of
+    Just old -> (updateSizes old (old - 1) sizes, size - 1)
+    Nothing  -> (sizes, size)
   f
     :: Maybe (Map ByteString Integer)
-    -> ( -- Just (old size of inner map, whether a currency is deleted)
-         -- if the total size shrinks by 1, otherwise Nothing
-         Maybe (Int, Bool)
+    -> ( -- Just (old size of inner map) if the total size shrinks by 1, otherwise Nothing
+         Maybe Int
        , Maybe (Map ByteString Integer)
        )
   f = \case
     Nothing -> (Nothing, Nothing)
     Just inner ->
       let (amt, inner') = Map.updateLookupWithKey (\_ _ -> Nothing) token inner
-       in ( amt $> (Map.size inner, Map.null inner')
-          , if Map.null inner' then Nothing else Just inner'
-          )
+       in (amt $> Map.size inner, if Map.null inner' then Nothing else Just inner')
 
 -- | \(O(\log \max(m, k))\)
 lookupCoin :: ByteString -> ByteString -> Value -> Integer
@@ -238,8 +207,9 @@ valueContains v = Map.foldrWithKey' go True . unpack
         )
 
 {-| The precise complexity is complicated, but an upper bound
-is \(O(n_{1} \log n_{2}) + O(n_{2})\), where \(n_{1}\) is the total size of the smaller
-value, and \(n_{2}\) is the total size of the bigger value.
+is \(O(n_{1} \log n_{2}) + O(m)\), where \(n_{1}\) is the total size of the smaller
+value, \(n_{2}\) is the total size of the bigger value, and \(m\) is the
+combined size of the outer maps.
 -}
 unionValue :: Value -> Value -> Value
 unionValue (unpack -> vA) (unpack -> vB) =
@@ -308,18 +278,9 @@ updateSizes old new = dec . inc
   inc =
     if new == 0
       then id
-      else incCount new
+      else IntMap.alter (maybe (Just 1) (Just . (+ 1))) new
   dec =
     if old == 0
       then id
       else IntMap.update (\n -> if n <= 1 then Nothing else Just (n - 1)) old
 {-# INLINEABLE updateSizes #-}
-
--- | Increment the count at the given key.
-incCount :: Int -> IntMap Int -> IntMap Int
-incCount = IntMap.alter (maybe (Just 1) (Just . (+ 1)))
-{-# INLINEABLE incCount #-}
-
-decLen :: Int -> IntMap Int -> IntMap Int
-decLen = IntMap.update (\n -> if n <= 1 then Nothing else Just (n - 1))
-{-# INLINEABLE decLen #-}

plutus-core/plutus-core/test/Value/Spec.hs

@@ -4,7 +4,6 @@
 
 module Value.Spec (tests) where
 
-import Data.ByteString qualified as B
 import Data.Foldable qualified as F
 import Data.Map.Strict qualified as Map
 import Data.Maybe
@@ -21,8 +20,7 @@ prop_packUnpackRoundtrip v = v === V.pack (V.unpack v)
 
 -- | Verifies that @pack@ correctly updates the sizes
 prop_packBookkeeping :: V.NestedMap -> Property
-prop_packBookkeeping = checkBookKeeping . V.pack
-
+prop_packBookkeeping = checkSizes . V.pack
 
 {-| Verifies that @pack@ preserves @Value@ invariants, i.e.,
 no empty inner map or zero amount.
@@ -36,7 +34,7 @@ prop_insertCoinBookkeeping v (ValueAmount amt) =
   forAll (genShortHex (V.totalSize v)) $ \currency ->
     forAll (genShortHex (V.totalSize v)) $ \token ->
       let v' = V.insertCoin currency token amt v
-       in checkBookKeeping v'
+       in checkSizes v'
 
 -- | Verifies that @insertCoin@ preserves @Value@ invariants
 prop_insertCoinPreservesInvariants :: Value -> ValueAmount -> Property
@@ -91,25 +89,15 @@ prop_containsAfterDeletion v =
   fl = V.toFlatList v
   vs = scanr (\(c, t, _) -> V.deleteCoin c t) v fl
 
-checkBookKeeping :: Value -> Property
-checkBookKeeping v =
+checkSizes :: Value -> Property
+checkSizes v =
   (expectedMaxInnerSize === actualMaxInnerSize)
     .&&. (expectedSize === actualSize)
-    .&&. (expectedMaxKeyLength === actualMaxKeyLength)
  where
   expectedMaxInnerSize = fromMaybe 0 . maximumMay $ Map.map Map.size (V.unpack v)
   actualMaxInnerSize = V.maxInnerSize v
   expectedSize = sum $ Map.map Map.size (V.unpack v)
   actualSize = V.totalSize v
-  expectedMaxKeyLength =
-    let maxOuter =
-          fromMaybe 0 . maximumMay $
-            [B.length k | k <- Map.keys (V.unpack v)]
-        maxInner =
-          fromMaybe 0 . maximumMay $
-            [B.length k | inner <- Map.elems (V.unpack v), k <- Map.keys inner]
-     in max maxOuter maxInner
-  actualMaxKeyLength = V.maxKeyLength v
 
 checkInvariants :: Value -> Property
 checkInvariants (V.unpack -> v) =