Module Store.AbsorbingSource

An absorbing structure in a store.

Absorbing structures are used-defined structures that behave very much like store references, except that the logic to "capture" the current value of the reference and to "restore" past or future values is user-defined.

The push-only queue that logs some events that we used to document Free structures above can also be presented as an absorbing interface, which is more efficient: only the first push of a sequence of pushes requires Store book-keeping, until the next capture.

  module Log = struct
    type 'a s = 'a Stack.t
    type 'a t = 'a s Store.Absorbing.t
  
    type 'a op = {elems: 'a list}
    type anti = {len: int}
    type 'a descr = ('a s, 'a op, anti) Store.Absorbing.descr
  
    let capture s = {len = Stack.length s}
  
    let rollback s anti =
      let len = Stack.length s in
      for _ = anti.len to len - 1 do
        Stack.drop s
      done
  
    let undo s anti =
      let len = Stack.length s in
      let rec collect acc = function
        | 0 -> acc
        | n -> collect (Stack.pop s :: acc) (n - 1)
      in
      {elems = collect [] (len - anti.len)}
  
    let redo s op =
      let before_len = Stack.length s in
      List.iter (fun x -> Stack.push x s) op.elems;
      { len = before_len }
  
    let descr : 'a descr = {
      capture;
      rollback;
      undo;
      redo;
    }
  
    let create () =
      Store.Absorbing.make descr (Stack.create ())
        
    let log store (s : 'a t) (event : 'a) =
      let stack = Store.Absorbing.get s in
      Store.Absorbing.modify store s;
      Stack.push event stack
    
    let events (s : 'a t) : 'a list =
      let stack = Store.Absorbing.get s in
      Stack.fold (fun acc x -> x::acc) [] stack
  end