Compact Ptr

IntersectMBO · Feb 3, 2022 · 92c338c · 92c338c
1 parent dc242c9
commit 92c338c
Show file tree

Hide file tree

Showing 8 changed files with 52 additions and 20 deletions.
diff --git a/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Examples/Consensus.hs b/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Examples/Consensus.hs
@@ -15,11 +15,7 @@ import Cardano.Ledger.Alonzo.Translation ()
 import Cardano.Ledger.Alonzo.Tx (IsValid (..), ValidatedTx (..))
 import Cardano.Ledger.Alonzo.TxBody (TxBody (..), TxOut (..))
 import Cardano.Ledger.Alonzo.TxWitness (RdmrPtr (..), Redeemers (..), TxDats (..), TxWitness (..))
-import Cardano.Ledger.BaseTypes
-  ( NonNegativeInterval,
-    StrictMaybe (..),
-    boundRational,
-  )
+import Cardano.Ledger.BaseTypes (NonNegativeInterval, StrictMaybe (..), boundRational)
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Core (TxBody)
 import Cardano.Ledger.Crypto (StandardCrypto)

diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs
@@ -17,7 +17,7 @@ import qualified Cardano.Chain.Common as Byron
 import qualified Cardano.Chain.UTxO as Byron
 import qualified Cardano.Crypto.Hash as Crypto
 import qualified Cardano.Crypto.Hashing as Hashing
-import Cardano.Ledger.BaseTypes (BlocksMade (..))
+import Cardano.Ledger.BaseTypes (BlocksMade (..), TxIx (..))
 import Cardano.Ledger.Coin (CompactForm (CompactCoin))
 import Cardano.Ledger.CompactAddress (CompactAddr (UnsafeCompactAddr))
 import qualified Cardano.Ledger.Crypto as CC

diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Types.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Types.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE DuplicateRecordFields #-}
-
 module Cardano.Ledger.Shelley.API.Types
   ( module X,
   )
@@ -11,14 +9,19 @@ import Cardano.Ledger.Address as X
   )
 import Cardano.Ledger.BHeaderView as X (isOverlaySlot)
 import Cardano.Ledger.BaseTypes as X
-  ( Globals (..),
+  ( CertIx,
+    Globals (..),
     Network (..),
     Nonce (..),
     Port (..),
     ProtVer (..),
     StrictMaybe (..),
-    TxIx (..),
+    TxIx,
+    certIxFromIntegral,
+    certIxToInt,
     epochInfo,
+    txIxFromIntegral,
+    txIxToInt,
   )
 -- TODO deprecate these?
 

diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs
@@ -243,7 +243,7 @@ delegsTransition = do
       isDelegationRegistered ?!: id
 
       -- It is impossible to have 4294967295 number of certificates in a
-      -- trabsaction, thus partial function is justified.
+      -- transaction, therefore partial function is justified.
       let ptr = Ptr slot txIx (mkCertIxPartial $ toInteger $ length gamma)
       trans @(Core.EraRule "DELPL" era) $
         TRC (DelplEnv slot ptr pp acnt, dpstate', c)

diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs
@@ -49,6 +49,7 @@ import Cardano.Ledger.BaseTypes
     NonNegativeInterval,
     PositiveInterval,
     PositiveUnitInterval,
+    TxIx (..),
     UnitInterval,
     Url,
     mkActiveSlotCoeff,

diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs
@@ -51,12 +51,10 @@ module Cardano.Ledger.BaseTypes
     -- * Indices
     TxIx (..),
     txIxToInt,
-    txIxFromInteger,
     txIxFromIntegral,
     mkTxIxPartial,
     CertIx (..),
     certIxToInt,
-    certIxFromInteger,
     certIxFromIntegral,
     mkCertIxPartial,
 

diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/CompactAddress.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/CompactAddress.hs
@@ -33,7 +33,6 @@ import Cardano.Ledger.Address
     toWord7,
     word7sToWord64,
   )
-import qualified Cardano.Ledger.Address as Address (isBootstrapRedeemer)
 import Cardano.Ledger.BaseTypes (CertIx (..), TxIx (..), word8ToNetwork)
 import Cardano.Ledger.Credential
   ( Credential (KeyHashObj, ScriptHashObj),

diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Credential.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Credential.hs
@@ -6,19 +6,24 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Cardano.Ledger.Credential
   ( Credential (KeyHashObj, ScriptHashObj),
     GenesisCredential (..),
     PaymentCredential,
-    Ptr (..),
+    Ptr (Ptr),
+    ptrSlotNo,
+    ptrTxIx,
+    ptrCertIx,
     StakeCredential,
     StakeReference (..),
   )
 where
 
 import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen)
-import Cardano.Ledger.BaseTypes (CertIx, TxIx, invalidKey)
+import Cardano.Ledger.BaseTypes (CertIx (..), TxIx (..), invalidKey)
 import qualified Cardano.Ledger.Crypto as CC (Crypto)
 import Cardano.Ledger.Hashes (ScriptHash)
 import Cardano.Ledger.Keys
@@ -36,9 +41,10 @@ import Cardano.Ledger.Slot (SlotNo (..))
 import Control.DeepSeq (NFData)
 import Data.Aeson (FromJSON (..), FromJSONKey, ToJSON (..), ToJSONKey, (.:), (.=))
 import qualified Data.Aeson as Aeson
+import Data.Bits
 import Data.Foldable (asum)
 import Data.Typeable (Typeable)
-import Data.Word (Word8)
+import Data.Word (Word64, Word8)
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks (..))
 import Quiet
@@ -94,11 +100,41 @@ data StakeReference crypto
 
 instance NoThunks (StakeReference crypto)
 
--- | Pointer to a slot, transaction index and index in certificate list.
-data Ptr = Ptr !SlotNo !TxIx !CertIx
+-- | Pointer to a slot number, transaction index and an index in certificate
+-- list. We expect that `SlotNo` will fit into `Word32` for a very long time,
+-- because we can assume that the rate at which it is incremented isn't going to
+-- icrease in the near future. Therefore with current rate we should be fine for
+-- about a 150 years. I suggest to remove this optimization in about a
+-- hundred years or thereabouts, so around a year 2122 would be good.
+--
+-- Compaction works in a following manner. Total 8 bytes: first 4 bytes are for
+-- SlotNo (s0-s3), followed by 2 bytes for CertIx (c0-c1) and 2 more bytes for TxIx (t0-t1).
+--
+-- @@@
+--
+-- ┏━━┯━━┯━━┯━━┯━━┯━━┯━━┯━━┓
+-- ┃s3 s2 s1 s0┊c1 c0┊t1 t0┃
+-- ┗━━┷━━┷━━┷━━┷━━┷━━┷━━┷━━┛
+--
+-- @@@
+newtype Ptr = PtrCompact Word64
   deriving (Show, Eq, Ord, Generic, NFData, NoThunks)
   deriving (ToCBOR, FromCBOR) via CBORGroup Ptr
 
+-- | With this pattern synonym we can recover actual values from compacted version of `Ptr`.
+pattern Ptr :: SlotNo -> TxIx -> CertIx -> Ptr
+pattern Ptr slotNo txIx certIx <-
+  (viewPtr -> (slotNo, txIx, certIx))
+  where
+    Ptr (SlotNo slotNo) (TxIx txIx) (CertIx certIx) =
+      PtrCompact ((slotNo `shiftL` 32) .|. (fromIntegral txIx `shiftL` 16) .|. fromIntegral certIx)
+
+{-# COMPLETE Ptr #-}
+
+viewPtr :: Ptr -> (SlotNo, TxIx, CertIx)
+viewPtr (PtrCompact ptr) =
+  (SlotNo (ptr `shiftR` 32), TxIx (fromIntegral (ptr `shiftR` 16)), CertIx (fromIntegral ptr))
+
 ptrSlotNo :: Ptr -> SlotNo
 ptrSlotNo (Ptr sn _ _) = sn
 
@@ -108,7 +144,6 @@ ptrTxIx (Ptr _ txIx _) = txIx
 ptrCertIx :: Ptr -> CertIx
 ptrCertIx (Ptr _ _ cIx) = cIx
 
-
 instance
   (Typeable kr, CC.Crypto crypto) =>
   ToCBOR (Credential kr crypto)