Block Forging Fragmentation

I went down a rabbit hole to figure out why transactions are taking longer than normal, even when there is space in the blocks being forged. The code to build a block can be found here

which then calls this function

takeLargestPrefixThatFits ::
     TxLimits blk
  => TxLimits.Overrides blk
  -> TickedLedgerState blk
  -> [Validated (GenTx blk)]
  -> [Validated (GenTx blk)]
takeLargestPrefixThatFits overrides ledger txs =
    Measure.take TxLimits.txMeasure capacity txs
    capacity =
        (TxLimits.txsBlockCapacity ledger)

and Measure.Take can be found here

take :: Measure a => (e -> a) -> a -> [e] -> [e]
take measure limit =
    go zero
    go !tot = \case
      []   -> []
      e:es ->
          if tot' <= limit
          then e : go tot' es
          else []
          tot' = plus tot (measure e)

It looks as if the transactions are grabbed in order until they can’t fit any more. This would be logical if all transactions were of equal size, but if the next transaction in the list is half the blocksize, then the logic will say “I can’t fit the next transaction, so it must be full”. This obviously is worse than having a full block because block space is being wasted when smaller subsequent transactions can be used. Is anyone aware of any plans to fix this issue? This seems like a no brainer way to help fix some of the transaction congestion going on right now.