Improve SplitMap deserialization. Make interning stricter

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs

@@ -121,7 +121,7 @@ import Cardano.Ledger.Val
     isZero,
   )
 import Control.DeepSeq (NFData (..), rwhnf)
-import Control.Monad (guard)
+import Control.Monad (guard, (<$!>))
 import Data.Bits
 import Data.Coders
 import Data.Maybe (fromMaybe)
@@ -616,7 +616,7 @@ instance
           TxOut_AddrHash28_AdaOnly_DataHash32 cred addr28Extra ada dataHash32 ->
             TxOut_AddrHash28_AdaOnly_DataHash32 (interns credsInterns cred) addr28Extra ada dataHash32
           txOut -> txOut
-    internTxOut <$> case lenOrIndef of
+    internTxOut <$!> case lenOrIndef of
       Nothing -> do
         a <- fromCBOR
         cv <- decodeNonNegative

libs/cardano-data/src/Data/Coders.hs

@@ -260,6 +260,26 @@ decodeCollectionWithLen lenOrIndef el = do
         False -> pure (n, reverse acc)
         True -> action >>= \v -> loop (n + 1, (v : acc)) condition action
 
+decodeAccWithLen ::
+  Decoder s (Maybe Int) ->
+  (a -> b -> b) ->
+  b ->
+  Decoder s a ->
+  Decoder s (Int, b)
+decodeAccWithLen lenOrIndef combine acc0 action = do
+  mLen <- lenOrIndef
+  let condition = case mLen of
+        Nothing -> const <$> decodeBreakOr
+        Just len -> pure (>= len)
+      loop !i !acc = do
+        shouldStop <- condition
+        if shouldStop i
+          then pure (i, acc)
+          else do
+            v <- action
+            loop (i + 1) (v `combine` acc)
+  loop 0 acc0
+
 encodeFoldable :: (ToCBOR a, Foldable f) => f a -> Encoding
 encodeFoldable = encodeFoldableEncoder toCBOR
 
@@ -344,7 +364,18 @@ decodeMap :: Ord a => Decoder s a -> Decoder s b -> Decoder s (Map.Map a b)
 decodeMap decodeKey decodeValue = decodeMapByKey decodeKey (const decodeValue)
 
 decodeSplitMap :: SplitMap.Split a => Decoder s a -> Decoder s b -> Decoder s (SplitMap.SplitMap a b)
-decodeSplitMap decodeKey decodeValue = decodeMapByKey decodeKey (const decodeValue)
+decodeSplitMap decodeKey decodeValue =
+  snd
+    <$> decodeAccWithLen
+      decodeMapLenOrIndef
+      (uncurry SplitMap.insert)
+      SplitMap.empty
+      decodeInlinedPair
+  where
+    decodeInlinedPair = do
+      !key <- decodeKey
+      !value <- decodeValue
+      pure (key, value)
 
 decodeMapByKey ::
   (Exts.IsList t, Exts.Item t ~ (k, v)) =>

libs/cardano-data/src/Data/Sharing.hs

@@ -28,7 +28,7 @@ module Data.Sharing
 where
 
 import Cardano.Binary (Decoder, FromCBOR (..), decodeListLen, dropMap)
-import Control.Monad (void)
+import Control.Monad (void, (<$!>))
 import Control.Monad.Trans
 import Control.Monad.Trans.State.Strict
 import Data.BiMap (BiMap (..), biMapFromMap)
@@ -221,7 +221,7 @@ instance (Ord a, Ord b, FromCBOR a, FromCBOR b) => FromSharedCBOR (BiMap b a b)
   getShare (MkBiMap m1 m2) = (internsFromMap m1, internsFromMap m2)
 
 -- | Share every item in a functor, have deserializing it
-fromShareCBORfunctor :: (FromCBOR (f b), Functor f) => Interns b -> Decoder s (f b)
+fromShareCBORfunctor :: (FromCBOR (f b), Monad f) => Interns b -> Decoder s (f b)
 fromShareCBORfunctor kis = do
   sm <- fromCBOR
-  pure (interns kis <$> sm)
+  pure (interns kis <$!> sm)