objective categorical abstract machine language personal data server
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

Optimize in-memory repo parsing

futur.blue a8ebf991 a4e4a7b7

verified
+90 -21
+80
mist/lib/mst.ml
··· 118 118 let%lwt result = Lazy.force lazy_opt_lwt in 119 119 f result 120 120 121 + (* extracts leaves from a block map *) 122 + let leaves_from_blocks (blocks : Block_map.t) (root : Cid.t) : 123 + (string * Cid.t) list = 124 + let leaves = ref [] in 125 + let stack = Stack.create () in 126 + Stack.push (root, "") stack ; 127 + while not (Stack.is_empty stack) do 128 + let cid, prefix = Stack.pop stack in 129 + match Block_map.get cid blocks with 130 + | None -> 131 + () (* missing block probably a record *) 132 + | Some bytes -> ( 133 + try 134 + let node = decode_block_raw bytes in 135 + (* proess left subtree *) 136 + ( match node.l with 137 + | Some left_cid -> 138 + Stack.push (left_cid, prefix) stack 139 + | None -> 140 + () ) ; 141 + (* process entries in reverse order so they come out in correct order *) 142 + let last_key = ref prefix in 143 + List.iter 144 + (fun (entry : entry_raw) -> 145 + let key_prefix = 146 + if entry.p = 0 then "" 147 + else if entry.p <= String.length !last_key then 148 + String.sub !last_key 0 entry.p 149 + else !last_key 150 + in 151 + let full_key = key_prefix ^ Bytes.to_string entry.k in 152 + last_key := full_key ; 153 + leaves := (full_key, entry.v) :: !leaves ; 154 + (* push right subtree to stack *) 155 + match entry.t with 156 + | Some right_cid -> 157 + Stack.push (right_cid, full_key) stack 158 + | None -> 159 + () ) 160 + node.e 161 + with Invalid_argument _ -> () ) 162 + done ; 163 + List.sort (fun (k1, _) (k2, _) -> String.compare k1 k2) !leaves 164 + 165 + (* extracts just mst node cids (non-leaf blocks) from a block map *) 166 + let mst_node_cids_from_blocks (blocks : Block_map.t) (root : Cid.t) : Cid.t list 167 + = 168 + let nodes = ref [] in 169 + let visited = ref Cid.Set.empty in 170 + let stack = Stack.create () in 171 + Stack.push root stack ; 172 + while not (Stack.is_empty stack) do 173 + let cid = Stack.pop stack in 174 + if not (Cid.Set.mem cid !visited) then ( 175 + visited := Cid.Set.add cid !visited ; 176 + match Block_map.get cid blocks with 177 + | None -> 178 + () 179 + | Some bytes -> ( 180 + try 181 + let node = decode_block_raw bytes in 182 + nodes := cid :: !nodes ; 183 + (* add all children to stack *) 184 + ( match node.l with 185 + | Some left_cid -> 186 + Stack.push left_cid stack 187 + | None -> 188 + () ) ; 189 + List.iter 190 + (fun (entry : entry_raw) -> 191 + match entry.t with 192 + | Some right_cid -> 193 + Stack.push right_cid stack 194 + | None -> 195 + () ) 196 + node.e 197 + with Invalid_argument _ -> () ) ) 198 + done ; 199 + !nodes 200 + 121 201 module type Intf = sig 122 202 module Store : Writable_blockstore 123 203
+10 -21
pegasus/lib/repository.ml
··· 592 592 failwith ("invalid commit: " ^ e) 593 593 in 594 594 if commit.did <> t.did then failwith "did does not match commit did" ; 595 - (* create in-memory mst to walk *) 596 - let mem_bs = Mist.Storage.Memory_blockstore.create ~blocks:all_blocks () in 597 - let mem_mst : Mem_mst.t = {blockstore= mem_bs; root= commit.data} in 598 - let%lwt leaves = Mem_mst.leaves_of_root mem_mst in 599 - let leaf_cids = 600 - List.fold_left 601 - (fun acc (_, cid) -> Cid.Set.add cid acc) 602 - Cid.Set.empty leaves 603 - in 604 - (* get mst nodes by filtering out leaves and commit from all blocks *) 595 + let leaves = Mist.Mst.leaves_from_blocks all_blocks commit.data in 605 596 let mst_node_cids = 606 - Block_map.keys all_blocks 607 - |> List.filter (fun cid -> 608 - (not (Cid.equal cid root)) && not (Cid.Set.mem cid leaf_cids) ) 597 + Mist.Mst.mst_node_cids_from_blocks all_blocks commit.data 609 598 in 610 599 (* collect mst node blocks for insert *) 611 600 let mst_blocks = ··· 620 609 in 621 610 (* collect record data for insert *) 622 611 let since = Tid.now () in 623 - let blob_refs : (string * Cid.t) list ref = ref [] in 624 - let record_data = 625 - List.map 626 - (fun (path, cid) -> 612 + let record_data, blob_refs = 613 + List.fold_left 614 + (fun (acc_data, acc_refs) (path, cid) -> 627 615 match Block_map.get cid all_blocks with 628 616 | Some data -> 629 617 let record = Lex.of_cbor data in ··· 631 619 Util.find_blob_refs record 632 620 |> List.map (fun (br : Mist.Blob_ref.t) -> (path, br.ref)) 633 621 in 634 - blob_refs := record_refs @ !blob_refs ; 635 - (path, cid, data, since) 622 + ( (path, cid, data, since) :: acc_data 623 + , List.rev_append record_refs acc_refs ) 636 624 | None -> 637 625 failwith ("missing record block: " ^ Cid.to_string cid) ) 638 - leaves 626 + ([], []) leaves 639 627 in 628 + let record_data = List.rev record_data in 640 629 let%lwt _ = 641 630 Util.use_pool t.db.db (fun conn -> 642 631 Util.transact conn (fun () -> ··· 645 634 let$! () = User_store.Bulk.put_blocks mst_blocks conn in 646 635 let$! () = 647 636 [%rapper execute {sql| DELETE FROM records |sql}] () conn 648 - in 637 + in 649 638 let$! () = User_store.Bulk.put_records record_data conn in 650 639 let$! () = User_store.Bulk.put_blob_refs !blob_refs conn in 651 640 Lwt.return_ok () ) )