cleanup

src/baardskeerder.mli

@@ -25,8 +25,6 @@ type action =
   | Set of k * v
   | Delete of k
 
-type ('a,'b) result = | OK of 'a | NOK of 'b
-
 val init : string -> unit
 val make : string -> t
 val close : t -> unit

src/base.ml

@@ -32,10 +32,6 @@ type action =
   |Delete of k
 
 
-type ('a,'b) result =
-  | OK of 'a
-  | NOK of 'b
-
 type kp = k * pos
 
 let kpl2s l =

src/base_test.ml

@@ -1,3 +1,3 @@
 let ok_or_fail = function
-  | Base.OK () -> Mlog.return ()
-  | Base.NOK _ -> failwith "NOK"
+  | Ok () -> Mlog.return ()
+  | Error _ -> failwith "Error"

src/bsmgr.ml

@@ -152,8 +152,8 @@ let () =
       else
         let key = make_key i in
         delete key >>= function
-        | Base.OK () -> loop (i+1)
-        | Base.NOK k -> failwith (Printf.sprintf "%s not found" k)
+        | Ok () -> loop (i+1)
+        | Error k -> failwith (Printf.sprintf "%s not found" k)
     in
     loop 0
   in
@@ -165,7 +165,7 @@ let () =
         let rec loop i =
           let kn = b+ i in
           if i = m || kn >= n
-          then return (Base.OK ())
+          then return (Ok ())
           else
             let k = make_key kn in
             MyDBX.set tx k v >>= fun () ->
@@ -181,8 +181,8 @@ let () =
       then MyLog.sync db
       else
         set_tx i >>= function
-        | Base.OK () -> loop (i+m)
-        | Base.NOK k -> failwith (Printf.sprintf "NOK %s" k)
+        | Ok ()   -> loop (i+m)
+        | Error k -> failwith (Printf.sprintf "Error %s" k)
     in
     loop 0
   in

src/catchup.ml

@@ -10,19 +10,12 @@ module Catchup(L: LOG) = struct
   let (>>=) = L.bind
 
   let read_value log pos =
-    (L.read log pos) >>= (function
-      | Value v -> L.return v
-      | e -> failwith (Printf.sprintf "Catchup:%s is not a value" (entry2s e))
-     )
+    L.read log pos >>= fun e ->
+    L.return (get_value e)
 
   let read_commit log pos =
-    L.bind
-      (L.read log pos)
-      (function
-        | Commit c -> L.return c
-        | e -> failwith (Printf.sprintf "Catchup:%s is not commit" (entry2s e))
-      )
-
+    L.read log pos >>= fun e ->
+    L.return (get_commit e)
 
   let translate_caction log = function
     | CSet (k,vp) -> read_value log vp >>= fun v -> L.return (Set (k,v))
@@ -42,21 +35,20 @@ module Catchup(L: LOG) = struct
   let catchup (i0: int64) (f : 'a -> int64 -> action list -> 'a L.m) (a0:'a) (log : L.t) =
     let start = (i0, 0,false) in
     let rec go_back acc p =
-      L.bind
-        (L.read log p)
-        (function
-          | Commit c ->
-              let t0 = Commit.get_time c in
-              if t0 =>: start
-              then
-                let p' = Commit.get_previous c in
-                go_back (p::acc) p'
-              else
-                L.return acc
-          | NIL ->
-              L.return acc
-          | e -> failwith (Printf.sprintf "Catchup:%s is not commit" (entry2s e))
-        )
+      L.read log p >>= 
+      function
+      | Commit c ->
+         let t0 = Commit.get_time c in
+         if t0 =>: start
+         then
+           let p' = Commit.get_previous c in
+           go_back (p::acc) p'
+         else
+           L.return acc
+      | NIL ->
+         L.return acc
+      | Value _ | Leaf _ | Index _ as e -> Entry.wrong "commit|nil" e
+
     in
     go_back [] (L.last log) >>= fun ps ->
     match ps with

src/catchup_test.ml

@@ -8,11 +8,11 @@ module MDBX = DBX(Mlog)
 
 let (>>=) = Mlog.bind
 
-let ok_set tx ki vi = MDBX.set tx ki vi >>= fun () -> return (Base.OK ())
+let ok_set tx ki vi = MDBX.set tx ki vi >>= fun () -> return (Ok ())
 
 let ok_unit x = match x with
-  | Base.OK () -> Mlog.return ()
-  | Base.NOK _ -> failwith "should not happen"
+  | Ok () -> Mlog.return ()
+  | Error _ -> failwith "should not happen"
 
 let catchup1 () =
   let fn = "mlog" in

src/dbx.ml

@@ -49,11 +49,11 @@ module DBX(L:LOG) = struct
   let delete tx k =
     DBL._delete tx.log tx.slab k >>= fun r ->
     let r' = match r with
-      | OK _ ->
+      | Ok _ ->
           let a = CDelete k in
           let () = tx.cactions <- a :: tx.cactions in
-          OK ()
-      | NOK k -> NOK k
+          Ok ()
+      | Error k -> Error k
     in
     return r'
 
@@ -65,7 +65,7 @@ module DBX(L:LOG) = struct
     let tx = {log;slab;cactions = []} in
     f tx >>= fun txr ->
     match txr with
-      | OK a ->
+      | Ok _a ->
           let root = Slab.length tx.slab -1 in
           let previous = L.last log in
           let pos = Inner root in
@@ -77,7 +77,7 @@ module DBX(L:LOG) = struct
           let slab' = Slab.compact tx.slab in
           L.write log slab' >>= fun () ->
           return txr
-      | NOK k -> return txr
+      | Error _k -> return txr
 
 
 
@@ -93,15 +93,15 @@ module DBX(L:LOG) = struct
   let prefix_keys (tx:tx) (prefix : string) (max: int option) =
     PrL.prefix_keys tx.log tx.slab prefix max
 
-  let multi_delete (tx:tx) (keys: k list) : (int,k) Base.result L.m =
+  let multi_delete (tx:tx) (keys: k list) : (int,k) result L.m =
     let rec _inner (acc:int) keys = match keys with
-      | [] -> let r = OK acc in
+      | [] -> let r = Ok acc in
               return r
       | k :: keys ->
           begin
             delete tx k >>= function
-              | OK r   -> _inner (acc+1) keys
-              | NOK k  -> return (NOK k)
+              | Ok _r   -> _inner (acc+1) keys
+              | Error k  -> return (Error k)
           end
     in _inner 0 keys
 
@@ -110,19 +110,19 @@ module DBX(L:LOG) = struct
     let rec _inner tx acc : (int,Base.k) result L.m =
       prefix_keys tx prefix max >>= fun keys ->
       match keys with
-        | []   -> return (OK acc)
+        | []   -> return (Ok acc)
         | keys ->
             begin
               multi_delete tx keys >>= fun r ->
               match r with
-                | OK i ->
+                | Ok i ->
                     _inner tx (acc + i)
-                | r -> return r
+                | Error _ -> return r
             end
     in
     _inner tx 0 >>= function
-      | OK i -> return i
-      | NOK k -> failwith (Printf.sprintf "delete_prefix: %s" k)
+      | Ok i -> return i
+      | Error k -> failwith (Printf.sprintf "delete_prefix: %s" k)
 
   let log_update (log:L.t) ?(diff = true) (f: tx -> ('a,'b) result L.m) =
     let previous = L.last log in
@@ -134,7 +134,7 @@ module DBX(L:LOG) = struct
               else Commit.get_lookup lc
             in return lu
         | NIL -> return previous
-        | e -> failwith (Printf.sprintf "log_update: %s is not commit" (entry2s e))
+        | Value _ | Index _ | Leaf _ as e -> wrong "Commit|Nil" e
     in
     let now = L.now log in
     let fut = if diff then Time.next_major now else now in
@@ -144,7 +144,7 @@ module DBX(L:LOG) = struct
 
     _find_lookup () >>= fun lookup ->
     f tx >>= function
-      | OK x ->
+      | Ok x ->
           begin
             let sl = Slab.length tx.slab in
             if sl > 0
@@ -157,15 +157,15 @@ module DBX(L:LOG) = struct
                 let _ = Slab.add tx.slab c in
                 let slab' = Slab.compact tx.slab in
                 L.write log slab' >>= fun () ->
-                return (OK x)
+                return (Ok x)
               end
             else (* This is an empty transaction *)
               begin
                 L.read log previous >>=
                   begin function
                     | Commit lc -> return (Commit.get_pos lc)
                     | NIL       -> return (Inner (-1))
-                    | e -> failwith (Printf.sprintf "log_update %s is not a commit" (entry2s e))
+                    | Value _ | Leaf _ | Index _ as e -> wrong "commit|nil" e
                   end
                 >>= fun ppos ->
                 let commit = make_commit
@@ -179,16 +179,16 @@ module DBX(L:LOG) = struct
                 let _ = Slab.add tx.slab c in
                 let slab' = Slab.compact tx.slab in
                 L.write log slab' >>= fun () ->
-                return (OK x)
+                return (Ok x)
               end
           end
-      | NOK k -> return (NOK k)
+      | Error k -> return (Error k)
 
   let commit_last (log:L.t) =
     let pp = L.last log in
-    (L.read log pp >>= function
-      | Commit lc -> L.return lc
-      | e -> failwith (Printf.sprintf "_read_commit: %s is not commit" (entry2s e))
+    (L.read log pp >>= fun entry ->
+     let lc = get_commit entry in
+     L.return lc
     ) >>= fun lc ->
     let time = Commit.get_time lc in
     let slab = Slab.make time in
@@ -213,6 +213,6 @@ module DBX(L:LOG) = struct
           CaL.translate_cactions log cas >>= fun actions ->
           L.return (Some (i, actions, explicit))
       | NIL -> L.return None
-      | e -> failwith (Printf.sprintf "last_update: %s should be commit" (entry2s e))
+      | Value _ | Index _ | Leaf _ as e -> wrong "commit|nil" e
 
 end

src/dbx_test.ml

@@ -24,7 +24,6 @@ open Prefix
 module MDBX = DBX(Mlog)
 module MDB = DB(Mlog)
 module MPR = Prefix(Mlog)
-open Base
 open Base_test
 
 let (>>=) = Mlog.bind
@@ -37,7 +36,7 @@ let _setup () =
 
 let _ok_set tx k v =
   MDBX.set tx k v >>= fun () ->
-  Mlog.return (OK ())
+  Mlog.return (Ok ())
 
 let get_after_delete () =
   let mlog = _setup() in
@@ -49,7 +48,7 @@ let get_after_delete () =
     Mlog.return r
   in
   let v2 = MDBX.with_tx mlog test in
-  OUnit.assert_equal (NOK "a") v2
+  OUnit.assert_equal (Error "a") v2
 
 
 
@@ -59,7 +58,7 @@ let get_after_log_update () =
   and v = "A" in
   let _ = MDBX.log_update mlog (fun tx -> _ok_set tx k v) in
   let test = MDB.get mlog k in
-  OUnit.assert_equal (NOK k) test
+  OUnit.assert_equal (Error k) test
 
 let get_after_log_updates() =
   let mlog = _setup() in
@@ -73,7 +72,7 @@ let get_after_log_updates() =
   >>= ok_or_fail >>= fun () ->
   let test = MDB.get mlog k in
   Mlog.dump mlog;
-  OUnit.assert_equal (NOK k) test
+  OUnit.assert_equal (Error k) test
 
 let update_commit_get() =
   let mlog = _setup() in
@@ -84,12 +83,12 @@ let update_commit_get() =
   MDBX.commit_last mlog >>= fun () ->
   Mlog.dump mlog;
   MDB.get mlog k >>= fun vo2 ->
-  OUnit.assert_equal vo2 (OK v)
+  OUnit.assert_equal vo2 (Ok v)
 
 let delete_empty () =
   let mlog = _setup() in
   let k = "non-existing" in
-  OUnit.assert_equal (Base.NOK k) (MDBX.with_tx mlog (fun tx -> MDBX.delete tx k))
+  OUnit.assert_equal (Error k) (MDBX.with_tx mlog (fun tx -> MDBX.delete tx k))
 
 
 let delete_prefix () =
@@ -98,7 +97,7 @@ let delete_prefix () =
     (fun tx ->
       let rec loop i =
         if i = 16
-        then Mlog.return (OK ())
+        then Mlog.return (Ok ())
         else
           let k = Printf.sprintf "a%03i" i in
           let v = "X" in
@@ -112,16 +111,16 @@ let delete_prefix () =
   let prefix = "a00" in
   MDBX.with_tx mlog (fun tx ->
     MDBX.delete_prefix tx prefix
-    >>= fun c -> Mlog.return (OK c))
+    >>= fun c -> Mlog.return (Ok c))
   >>= function
-    | OK c -> OUnit.assert_equal ~printer:string_of_int 10 c
-    | NOK _ -> failwith "can't happen"
+    | Ok c -> OUnit.assert_equal ~printer:string_of_int 10 c
+    | Error _ -> failwith "can't happen"
 
 
 
 let log_nothing () =
   let mlog = _setup() in
-  let ok = OK () in
+  let ok = Ok () in
   let x = MDBX.log_update mlog (fun _ -> Mlog.return ok) in
   OUnit.assert_equal ok x;
   ()
@@ -130,18 +129,18 @@ let log_nothing () =
 let log_bug2() =
   let mlog = _setup() in
   let _ = MDBX.log_update mlog (fun tx -> _ok_set tx "k" "v") in
-  let ok = OK () in
+  let ok = Ok () in
   let _ = MDBX.log_update mlog (fun _ -> Mlog.return ok) in
   ()
 
 let log_bug3() =
   let mlog = _setup () in
   let _ = MDBX.log_update mlog ~diff:true (fun tx -> _ok_set tx "x" "X") in
-  let _ = MDBX.log_update mlog ~diff:true (fun _  -> Mlog.return (OK ())) in
+  let _ = MDBX.log_update mlog ~diff:true (fun _  -> Mlog.return (Ok ())) in
   MDBX.commit_last mlog >>= fun () ->
   Mlog.dump mlog;
   MDB.get mlog "x" >>= fun r ->
-  OUnit.assert_equal r (OK "X");
+  OUnit.assert_equal r (Ok "X");
   ()