diff --git a/src/lib/merkle_ledger/database.ml b/src/lib/merkle_ledger/database.ml
index 92d41962bf7..9de0bc7f356 100644
--- a/src/lib/merkle_ledger/database.ml
+++ b/src/lib/merkle_ledger/database.ml
@@ -693,32 +693,12 @@ module Make (Inputs : Inputs_intf) :
         Location.Hash (Location.to_path_exn location)
       else location
     in
-    assert (Location.is_hash location) ;
-    let rev_locations, rev_directions =
-      let rec loop k loc_acc dir_acc =
-        if Location.height ~ledger_depth:mdb.depth k >= mdb.depth then
-          (loc_acc, dir_acc)
-        else
-          let sibling = Location.sibling k in
-          let sibling_dir = Location.last_direction (Location.to_path_exn k) in
-          loop (Location.parent k) (sibling :: loc_acc) (sibling_dir :: dir_acc)
-      in
-      loop location [] []
-    in
-    let rev_hashes = get_hash_batch mdb rev_locations in
-    let rec loop directions hashes acc =
-      match (directions, hashes) with
-      | [], [] ->
-          acc
-      | direction :: directions, hash :: hashes ->
-          let dir =
-            Direction.map direction ~left:(`Left hash) ~right:(`Right hash)
-          in
-          loop directions hashes (dir :: acc)
-      | _ ->
-          failwith "Mismatched lengths"
+    let dependency_locs, dependency_dirs =
+      List.unzip (Location.merkle_path_dependencies_exn location)
     in
-    loop rev_directions rev_hashes []
+    let dependency_hashes = get_hash_batch mdb dependency_locs in
+    List.map2_exn dependency_dirs dependency_hashes ~f:(fun dir hash ->
+        Direction.map dir ~left:(`Left hash) ~right:(`Right hash) )
 
   let merkle_path_at_addr_exn t addr = merkle_path t (Location.Hash addr)
 
diff --git a/src/lib/merkle_ledger/location.ml b/src/lib/merkle_ledger/location.ml
index 0c56b8327b4..8c2e6105f2b 100644
--- a/src/lib/merkle_ledger/location.ml
+++ b/src/lib/merkle_ledger/location.ml
@@ -147,6 +147,20 @@ module T = struct
     | Right ->
         (sibling, base)
 
+  let merkle_path_dependencies_exn (location : t) : (t * Direction.t) list =
+    let rec loop k acc =
+      if Addr.depth k = 0 then acc
+      else
+        let sibling = Hash (Addr.sibling k) in
+        let sibling_dir = last_direction k in
+        loop (Addr.parent_exn k) ((sibling, sibling_dir) :: acc)
+    in
+    match location with
+    | Hash addr ->
+        List.rev (loop addr [])
+    | _ ->
+        failwith "can only get merkle path dependencies of a hash location"
+
   type location = t [@@deriving sexp, compare]
 
   include Comparable.Make (struct
diff --git a/src/lib/merkle_ledger/location_intf.ml b/src/lib/merkle_ledger/location_intf.ml
index ee0508a0049..15cbe61d40e 100644
--- a/src/lib/merkle_ledger/location_intf.ml
+++ b/src/lib/merkle_ledger/location_intf.ml
@@ -48,5 +48,7 @@ module type S = sig
 
   val order_siblings : t -> 'a -> 'a -> 'a * 'a
 
+  val merkle_path_dependencies_exn : t -> (t * Direction.t) list
+
   include Comparable.S with type t := t
 end