Allow setting and getting from empty paths in the sparse ledger

src/lib/mina_base/pending_coinbase.ml

@@ -766,7 +766,13 @@ module Make_str (A : Wire_types.Concrete) = struct
             Type_equal.t ) =
         Type_equal.T
 
-      module M = Sparse_ledger_lib.Sparse_ledger.Make (Hash) (Stack_id) (Stack)
+      module M =
+        Sparse_ledger_lib.Sparse_ledger.Make (Hash) (Stack_id)
+          (struct
+            include Stack
+
+            let empty = lazy empty
+          end)
 
       [%%define_locally
       M.(of_hash, get_exn, path_exn, set_exn, find_index, add_path, merkle_root)]

src/lib/mina_base/sparse_ledger_base.ml

@@ -28,6 +28,8 @@ module Account = struct
   include Account
 
   let data_hash = Fn.compose Ledger_hash.of_digest Account.digest
+
+  let empty = lazy empty
 end
 
 module Global_state = struct
@@ -68,9 +70,10 @@ module L = struct
 
   let location_of_account : t -> Account_id.t -> location option =
    fun t id ->
-     match M.find_index !t id with
-     | None -> None
-     | Some loc ->
+    match M.find_index !t id with
+    | None ->
+        None
+    | Some loc ->
         let account = M.get_exn !t loc in
         if Public_key.Compressed.(equal empty account.public_key) then None
         else Some loc
@@ -96,7 +99,7 @@ module L = struct
     | None ->
         let loc, new_t = M.allocate_index !t id in
         t := new_t ;
-        let account' = create_account loc Account.empty in
+        let account' = create_account loc (Lazy.force Account.empty) in
         (`Added, account', loc)
     | Some loc ->
         let account = M.get_exn !t loc in
@@ -227,7 +230,9 @@ let handler t =
                 index
             | None ->
                 let index, new_ledger = allocate_index !ledger pk in
-                let new_ledger = set_exn new_ledger index Account.empty in
+                let new_ledger =
+                  set_exn new_ledger index (Lazy.force Account.empty)
+                in
                 ledger := new_ledger ;
                 index
           in

src/lib/sparse_ledger_lib/dune

@@ -13,6 +13,8 @@
    bin_prot.shape
    result
    ppx_version.runtime
+   ;; local libraries
+   empty_hashes
  )
  (preprocess
   (pps ppx_jane ppx_compare ppx_deriving_yojson ppx_version))

src/lib/sparse_ledger_lib/sparse_ledger.ml

@@ -100,6 +100,8 @@ end) (Account : sig
   type t [@@deriving equal, sexp, yojson]
 
   val data_hash : t -> Hash.t
+
+  val empty : t Lazy.t
 end) : sig
   include
     S
@@ -109,6 +111,14 @@ end) : sig
 
   val hash : (Hash.t, Account.t) Tree.t -> Hash.t
 end = struct
+  let empty_hash =
+    lazy
+      (Empty_hashes.extensible_cache
+         (module Hash)
+         ~init_hash:(Account.data_hash (Lazy.force Account.empty)) )
+
+  let empty_hash i = (Lazy.force empty_hash) i
+
   type t = (Hash.t, Account_id.t, Account.t) T.t [@@deriving sexp, yojson]
 
   let of_hash ~depth ~current_location (hash : Hash.t) =
@@ -215,6 +225,8 @@ end = struct
       | false, Node (_, l, r) ->
           let go_right = ith_bit idx i in
           if go_right then go (i - 1) r else go (i - 1) l
+      | _, Hash h when Hash.equal h (empty_hash i) ->
+          Lazy.force Account.empty
       | _ ->
           let expected_kind = if i < 0 then "n account" else " node" in
           let kind =
@@ -244,6 +256,14 @@ end = struct
             if go_right then (l, go (i - 1) r) else (go (i - 1) l, r)
           in
           Node (Hash.merge ~height:i (hash l) (hash r), l, r)
+      | false, Hash h when Hash.equal h (empty_hash i) ->
+          let inner =
+            if i > 0 then Tree.Hash (empty_hash (i - 1))
+            else Tree.Account (Lazy.force Account.empty)
+          in
+          go i (Node (h, inner, inner))
+      | true, Hash h when Hash.equal h (empty_hash i) ->
+          Tree.Account acct
       | _ ->
           let expected_kind = if i < 0 then "n account" else " node" in
           let kind =
@@ -269,6 +289,12 @@ end = struct
         match tree with
         | Tree.Account _ ->
             failwithf "Sparse_ledger.path: Bad depth at index %i." idx ()
+        | Hash h when Hash.equal h (empty_hash i) ->
+            let inner =
+              if i > 0 then Tree.Hash (empty_hash (i - 1))
+              else Tree.Account (Lazy.force Account.empty)
+            in
+            go acc i (Tree.Node (h, inner, inner))
         | Hash _ ->
             failwithf "Sparse_ledger.path: Dead end at index %i." idx ()
         | Node (_, l, r) ->
@@ -283,6 +309,27 @@ type ('hash, 'key, 'account) t = ('hash, 'key, 'account) T.t [@@deriving yojson]
 
 let%test_module "sparse-ledger-test" =
   ( module struct
+    module Account = struct
+      module T = struct
+        type t = { name : string; favorite_number : int }
+        [@@deriving bin_io, equal, sexp, yojson]
+      end
+
+      include T
+
+      let key { name; _ } = name
+
+      let data_hash t = Md5.digest_string (Binable.to_string (module T) t)
+
+      let gen =
+        let open Quickcheck.Generator.Let_syntax in
+        let%map name = String.quickcheck_generator
+        and favorite_number = Int.quickcheck_generator in
+        { name; favorite_number }
+
+      let empty = lazy { name = ""; favorite_number = 0 }
+    end
+
     module Hash = struct
       type t = Core_kernel.Md5.t [@@deriving sexp, compare]
 
@@ -307,25 +354,6 @@ let%test_module "sparse-ledger-test" =
           ~f:Md5.digest_string
     end
 
-    module Account = struct
-      module T = struct
-        type t = { name : string; favorite_number : int }
-        [@@deriving bin_io, equal, sexp, yojson]
-      end
-
-      include T
-
-      let key { name; _ } = name
-
-      let data_hash t = Md5.digest_string (Binable.to_string (module T) t)
-
-      let gen =
-        let open Quickcheck.Generator.Let_syntax in
-        let%map name = String.quickcheck_generator
-        and favorite_number = Int.quickcheck_generator in
-        { name; favorite_number }
-    end
-
     module Account_id = struct
       type t = string [@@deriving sexp, equal, yojson]
     end