package plebeia
Functional storage using Merkle Patricia tree
Install
Dune Dependency
Authors
Maintainers
Sources
plebeia-2.0.2.tar.gz
md5=aecc184507170faed53e543195687233
sha512=9799144ea7ebc997681353136393815ac73040e2ae5227f2787c1331bb393dbd318b1fa3ae8d075b383cda4fe7584b80f7f32a4aa99c870a0bd2d76e91024bf5
doc/src/plebeia.test_utils/do_random.ml.html
Source file do_random.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318
open Plebeia open Helper open Cursor open Node module Flat = struct let gen_segment = Gen.(segment @@ int_range (3,5)) let do_random ?(no_commit=false) st sz c dumb = let segs = ref SegmentSet.empty in let add_seg seg = segs := SegmentSet.add seg !segs in let del_seg seg = segs := SegmentSet.remove seg !segs in let pick_seg st = let segs = SegmentSet.elements !segs in let len = List.length segs in if len < 20 then gen_segment st else let pos = RS.int st (List.length segs) in List.nth segs pos in let rev_ops = ref [] in let add_op o = rev_ops := o :: !rev_ops in let rec f c dumb i = if i = sz then (c, dumb) else let (c, dumb) = let op = match RS.int st (if no_commit then 7 else 8) with | 0 -> `Insert (gen_segment st, Gen.value st) | 1 -> `Upsert (gen_segment st, Gen.value st) | 2 -> `Subtree (gen_segment st) | 7 -> `Commit | _ -> `Delete (pick_seg st) in begin match op with | `Insert (sg, v) -> Format.eprintf "insert %a %a@." Segment.pp sg Value.pp v | `Upsert (sg, v) -> Format.eprintf "upsert %a %a@." Segment.pp sg Value.pp v | `Subtree sg -> Format.eprintf "subtree %a@." Segment.pp sg | `Commit -> Format.eprintf "commit@." | `Delete sg -> Format.eprintf "delete %a@." Segment.pp sg end; match op with | `Insert (seg, v) -> begin match insert c seg v, Dumb.insert dumb seg v with | Ok c, Ok dumb -> compare_trees dumb c; let Cursor (_, n, context, _) = c in (* check the invariants of the node *) validate_node context n; add_op op; add_seg seg; (c, dumb) | Error _, Error _ -> (c, dumb) | _ -> assert false end | `Upsert (seg, v) -> begin match upsert c seg v, Dumb.upsert dumb seg v with | Ok c, Ok dumb -> compare_trees dumb c; let Cursor (_, n, context, _) = c in (* check the invariants of the node *) validate_node context n; add_op op; add_seg seg; (c, dumb) | Error _, Error _ -> (c, dumb) | _ -> assert false end | `Subtree seg -> begin match create_subtree c seg, Dumb.create_subtree dumb seg with | Ok c, Ok dumb -> compare_trees dumb c; let Cursor (_, n, context, _) = c in (* check the invariants of the node *) validate_node context n; add_op op; add_seg seg; (c, dumb) | Error _, Error _ -> (c, dumb) | _ -> assert false end | `Delete seg -> begin match delete c seg, Dumb.delete dumb seg with | Ok c, Ok dumb -> compare_trees dumb c; let Cursor (_, n, context, _) = c in (* check the invariants of the node *) validate_node context n; add_op op; del_seg seg; (c, dumb) | Error _, Error _ -> (c, dumb) | _ -> assert false end | `Commit -> let Cursor(_, _, context, info), i, _ = from_Ok @@ Cursor_storage.write_top_cursor c in let v = Node_storage.read_node context i Not_Extender in add_op op; (_Cursor (_Top, View v, context, info), dumb) in f c dumb (i+1) in let (c,_) = f c dumb 0 in (List.rev !rev_ops, Cursor_storage.read_fully ~reset_index:false c) end module Deep = struct (* We cannot compare with Dumb *) let gen_segments = gen_segments (1,5) 3 let do_random st sz c = let rev_ops = ref [] in let add_op o = rev_ops := o :: !rev_ops in let rec f c i = if i = sz then c else let c = let rec get_op () = match RS.int st 8 with | 0 -> `Insert (gen_segments st, Gen.value st) | 1 -> `Upsert (gen_segments st, Gen.value st) | 2 -> `Subtree (gen_segments st) | 3 -> `Commit | 4 -> begin match random_segs_to_bud_or_leaf st c with | None -> get_op () | Some segs -> let segs' = gen_segments st in `Copy (segs, segs') end | _ -> match random_segs_to_bud_or_leaf st c with | None -> get_op () | Some segs -> `Delete segs in let op = get_op () in match op with | `Insert (segs, v) -> (* Format.eprintf "Insert at %s@." @@ string_of_segs segs; *) begin match Deep.insert c segs v with | Ok c -> add_op op; check_cursor_is_top c; c | Error _ -> c end | `Upsert (segs, v) -> (* Format.eprintf "Upsert at %s@." @@ string_of_segs segs; *) begin match Deep.upsert c segs v with | Ok c -> add_op op; check_cursor_is_top c; c | Error _ -> c end | `Subtree segs -> (* Format.eprintf "Create_subtree at %s@." @@ string_of_segs segs; *) begin match Deep.create_subtree ~create_subtrees:true c segs with | Ok c -> add_op op; check_cursor_is_top c; c | Error _ -> c end | `Delete segs -> (* Format.eprintf "Delete at %s@." @@ string_of_segs segs; *) begin match Deep.delete c segs with | Ok c -> add_op op; check_cursor_is_top c; c | Error _ -> c end | `Copy (segs, segs') -> begin match Deep.copy ~create_subtrees:true c segs segs' with | Ok c -> add_op op; check_cursor_is_top c; c | Error _ -> c end | `Commit -> let Cursor(_, _, context, info), i, _ = from_Ok @@ Cursor_storage.write_top_cursor c in let v = Node_storage.read_node context i Not_Extender in add_op op; _Cursor (_Top, View v, context, info) in f c (i+1) in let c = f c 0 in (c, List.rev !rev_ops) end module Vc = struct open Lwt.Syntax module Deep = Plebeia.Deep let debug = false let gen_segments = gen_segments (1,5) 3 let do_random rng sz vc = let commits = Queue.create () in let rec f parent c i = if i = sz then Lwt.return c else let op = let rec get_op () = match RS.int rng 8 with | 0 -> `Insert (gen_segments rng, Gen.value rng) | 1 -> `Upsert (gen_segments rng, Gen.value rng) | 2 -> `Subtree (gen_segments rng) | 3 -> begin match random_segs_to_bud_or_leaf rng c with | None -> get_op () | Some segs -> let segs' = gen_segments rng in `Copy (segs, segs') end | 4 | 5 -> begin match random_segs_to_bud_or_leaf rng c with | None -> get_op () | Some segs -> `Delete segs end | 6 -> `Commit | 7 -> if Queue.length commits > 0 then `Checkout (Queue.take commits) else get_op () | _ -> assert false in get_op () in let* c, parent = match op with | `Insert (segs, v) -> if debug then Format.eprintf "Insert at %a@." Segment.pp_segments segs; Lwt.return begin match Deep.insert c segs v with | Ok c -> check_cursor_is_top c; c, parent | Error _ -> c, parent end | `Upsert (segs, v) -> if debug then Format.eprintf "Upsert at %a@." Segment.pp_segments segs; Lwt.return begin match Deep.upsert c segs v with | Ok c -> check_cursor_is_top c; c, parent | Error _ -> c, parent end | `Subtree segs -> if debug then Format.eprintf "Create_subtree at %a@." Segment.pp_segments segs; Lwt.return begin match Deep.create_subtree ~create_subtrees:true c segs with | Ok c -> check_cursor_is_top c; c, parent | Error _ -> c, parent end | `Delete segs -> if debug then Format.eprintf "Delete at %a@." Segment.pp_segments segs; Lwt.return begin match Deep.delete c segs with | Ok c -> check_cursor_is_top c; c, parent | Error _ -> c, parent end | `Copy (segs, segs') -> if debug then Format.eprintf "Copy %a %a@." Segment.pp_segments segs Segment.pp_segments segs'; Lwt.return begin match Deep.copy ~create_subtrees:true c segs segs' with | Ok c -> check_cursor_is_top c; c, parent | Error _ -> c, parent end | `Commit -> if debug then Format.eprintf "Commit@."; let* c, _, commit = from_Ok_lwt @@ Vc.commit ~parent ~hash_override:None vc c in Queue.add commit.hash commits; Lwt.return (c, parent) | `Checkout commit_hash -> if debug then Format.eprintf "Checkout %a@." Commit_hash.pp commit_hash; let* res = Vc.checkout vc commit_hash in match res with | None -> assert false | Some c -> Lwt.return (c, Some commit_hash) in f parent c (i+1) in f None (Vc.empty vc) 0 end
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>