Drop the Tx API for simplicity

Author: polytypic

README.md

@@ -300,154 +300,6 @@ module Op = struct
         else run (CASN (loc, { before; after; casn }, NIL, NIL)) rest
 end
 
-let update_as0 g loc f casn post_commit l r =
-  let state = Atomic.get loc.state in
-  let before = eval state in
-  let after = f before in
-  let state =
-    if before == after && is_obstruction_free casn then state
-    else { before; after; casn }
-  in
-  ((casn, CASN (loc, state, l, r), post_commit), g before)
-  [@@inline]
-
-let update_as g loc f casn post_commit state' l r =
-  let state = Obj.magic state' in
-  if is_cmp casn state then
-    let before = eval state in
-    let after = f before in
-    let state = if before == after then state else { before; after; casn } in
-    ((casn, CASN (loc, state, l, r), post_commit), g before)
-  else
-    let current = state.after in
-    ( (casn, CASN (loc, { state with after = f current }, l, r), post_commit),
-      g current )
-  [@@inline]
-
-let update_as g loc f (casn, cass, post_commit) =
-  let x = loc.id in
-  match cass with
-  | NIL -> update_as0 g loc f casn post_commit NIL NIL
-  | CASN (a, _, NIL, _) as cass when x < a.id ->
-      update_as0 g loc f casn post_commit NIL cass
-  | CASN (a, _, _, NIL) as cass when a.id < x ->
-      update_as0 g loc f casn post_commit cass NIL
-  | CASN (loc', state', l, r) when Obj.magic loc' == loc ->
-      update_as g loc f casn post_commit state' l r
-  | _ -> (
-      match splay ~hit_parent:false x cass with
-      | l, Miss, r -> update_as0 g loc f casn post_commit l r
-      | l, Hit (_loc', state'), r ->
-          update_as g loc f casn post_commit state' l r)
-  [@@inline]
-
-let attempt (mode : Mode.t) tx =
-  let casn = Atomic.make (mode :> status) in
-  match tx (casn, NIL, Action.noop) with
-  | (_, NIL, post_commit), result -> Action.run post_commit result
-  | (_, CASN (loc, state, NIL, NIL), post_commit), result ->
-      if is_cmp casn state then Action.run post_commit result
-      else
-        let before = state.before in
-        state.before <- state.after;
-        if cas loc before state then Action.run post_commit result else exit ()
-  | (_, cass, post_commit), result ->
-      if determine_for_owner casn cass then Action.run post_commit result
-      else exit ()
-
-let rec commit backoff mode tx =
-  match attempt mode tx with
-  | result -> result
-  | exception Mode.Interference ->
-      let backoff = Backoff.once backoff in
-      commit backoff Mode.lock_free tx
-  | exception Exit ->
-      let backoff = Backoff.once backoff in
-      commit backoff mode tx
-
-module Tx = struct
-  type log = casn * cass * Action.t
-  type 'a t = log -> log * 'a
-
-  let get loc log = update_as Fun.id loc Fun.id log
-  let get_as f loc log = update_as f loc Fun.id log
-  let set loc after log = update_as ignore loc (fun _ -> after) log
-  let update loc f log = update_as Fun.id loc f log
-  let modify loc f log = update_as ignore loc f log
-
-  let compare_and_swap loc before after log =
-    update_as Fun.id loc
-      (fun actual -> if actual == before then after else actual)
-      log
-
-  let exchange_as g loc after log = update_as g loc (fun _ -> after) log
-  let exchange loc after log = update_as Fun.id loc (fun _ -> after) log
-  let fetch_and_add loc n log = update_as Fun.id loc (( + ) n) log
-  let incr loc log = update_as ignore loc inc log
-  let decr loc log = update_as ignore loc dec log
-  let update_as g loc f log = update_as g loc f log
-
-  let swap l1 l2 log =
-    let log, x1 = get l1 log in
-    let log, x2 = exchange l2 x1 log in
-    set l1 x2 log
-
-  let return value log = (log, value)
-  let delay uxt log = uxt () log
-
-  let post_commit action (casn, cass, post_commit) =
-    ((casn, cass, Action.append action post_commit), ())
-
-  let is_in_log loc ((casn, cass, post_commit) as log) =
-    let x = loc.id in
-    match cass with
-    | NIL -> (log, false)
-    | CASN (a, _, NIL, _) when x < a.id -> (log, false)
-    | CASN (a, _, _, NIL) when a.id < x -> (log, false)
-    | CASN (a, _, _, _) when Obj.magic a == loc -> (log, true)
-    | cass -> (
-        match splay ~hit_parent:true loc.id cass with
-        | l, Hit (a, s), r ->
-            ((casn, CASN (a, s, l, r), post_commit), Obj.magic a == loc)
-        | _, Miss, _ -> impossible ())
-
-  let ( let* ) xt xyt log =
-    let log, x = xt log in
-    xyt x log
-
-  let ( and* ) xt yt log =
-    let log, x = xt log in
-    let log, y = yt log in
-    (log, (x, y))
-
-  let ( let+ ) xt xy log =
-    let log, x = xt log in
-    (log, xy x)
-
-  let ( and+ ) = ( and* )
-
-  let ( >> ) ut xt log =
-    let log, _ = ut log in
-    xt log
-
-  let ( >>. ) ut x log =
-    let log, _ = ut log in
-    (log, x)
-
-  let ( >>= ) = ( let* )
-  let map xy xt = ( let+ ) xt xy
-
-  let try_in eyt xyt xt log =
-    match xt log with log, x -> xyt x log | exception e -> eyt e log
-
-  let ( <|> ) lhs rhs log = try lhs log with Exit -> rhs log
-  let forget = exit
-  let attempt ?(mode = Mode.lock_free) tx = attempt mode tx
-
-  let commit ?(backoff = Backoff.default) ?(mode = Mode.obstruction_free) tx =
-    commit backoff mode tx
-end
-
 module Xt = struct
   type 'x t = {
     casn : casn;
@@ -573,15 +425,4 @@ module Xt = struct
     [@@inline]
 
   let attempt ?(mode = Mode.lock_free) tx = attempt mode tx.tx [@@inline]
-
-  let of_tx tx ~xt =
-    let (_, cass, post_commit), x = tx (xt.casn, xt.cass, xt.post_commit) in
-    xt.cass <- cass;
-    xt.post_commit <- post_commit;
-    x
-
-  let to_tx tx (casn, cass, post_commit) =
-    let xt = { casn; cass; post_commit } in
-    let x = tx.tx ~xt in
-    ((xt.casn, xt.cass, xt.post_commit), x)
 end