Source file store_impl.ml

(* POMAP - Library for manipulating partially ordered maps

   Copyright (C) 2001-2002 Markus Mottl (OEFAI) email: markus.mottl@gmail.com
   WWW: http://www.ocaml.info

   This library is free software; you can redistribute it and/or modify it under
   the terms of the GNU Lesser General Public License as published by the Free
   Software Foundation; either version 2.1 of the License, or (at your option)
   any later version.

   This library is distributed in the hope that it will be useful, but WITHOUT
   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
   details.

   You should have received a copy of the GNU Lesser General Public License
   along with this library; if not, write to the Free Software Foundation, Inc.,
   51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *)

open Store_intf

module IntIx = struct
  type t = int
  type gen = int

  module Set = Ptset

  module Map = Map.Make (struct
    type t = int

    let compare x y = x - y
  end)

  let start = 0
  let next_ix gen = gen
  let next n = (n, n + 1)
  let remove_ix gen n = max gen (n + 1)
  let int_of_ix n = n
end

module Make (Ix : INDEX) = struct
  module Ix = Ix

  type 'a t = Ix.gen * 'a Ix.Map.t

  let empty = (Ix.start, Ix.Map.empty)
  let is_empty (_, m) = Ix.Map.is_empty m
  let count _ _ n = n + 1
  let cardinal (_, m) = Ix.Map.fold count m 0
  let next_ix (gen, _) = Ix.next_ix gen

  let singleton el =
    let ix, gen = Ix.next Ix.start in
    (ix, (gen, Ix.Map.add ix el Ix.Map.empty))

  let add el (gen, m) =
    let ix, new_gen = Ix.next gen in
    (ix, (new_gen, Ix.Map.add ix el m))

  let find el (_, m) = Ix.Map.find el m
  let update ix el (gen, m) = (Ix.remove_ix gen ix, Ix.Map.add ix el m)
  let remove ix (gen, m) = (gen, Ix.Map.remove ix m)
  let iter f (_, m) = Ix.Map.iter (fun _ el -> f el) m
  let iteri f (_, m) = Ix.Map.iter f m
  let map f (gen, m) = (gen, Ix.Map.map f m)
  let mapi f (gen, m) = (gen, Ix.Map.mapi f m)
  let fold f (_, m) acc = Ix.Map.fold (fun _ el acc -> f el acc) m acc
  let foldi f (_, m) acc = Ix.Map.fold f m acc
  let cons_tpl ix el acc = (ix, el) :: acc
  let to_list s = foldi cons_tpl s []

  let choose (_, m) =
    let x_ref = ref (Obj.magic 0) in
    let act ix el =
      x_ref := (ix, el);
      raise Exit
    in
    try
      Ix.Map.iter act m;
      raise Not_found
    with Exit -> !x_ref

  let filter p (gen, m) =
    let coll ix el acc = if p ix el then acc else Ix.Map.remove ix acc in
    (gen, Ix.Map.fold coll m m)

  let partition p (gen, m) =
    let coll ix el (yes, no) =
      if p ix el then (yes, Ix.Map.remove ix no) else (Ix.Map.remove ix yes, no)
    in
    let yes, no = Ix.Map.fold coll m (m, m) in
    ((gen, yes), (gen, no))

  let eq_classes eq (gen, m) =
    let rec coll acc ix el = function
      | [] -> (el, Ix.Map.add ix el Ix.Map.empty) :: acc
      | ((eq_el, eq_m) as ec) :: ecs ->
          if eq el eq_el then
            (eq_el, Ix.Map.add ix el eq_m) :: List.rev_append acc ecs
          else coll (ec :: acc) ix el ecs
    in
    let ecs = Ix.Map.fold (coll []) m [] in
    List.rev_map (fun (eq_el, eq_m) -> (eq_el, (gen, eq_m))) ecs

  let get_ix_map (_, m) = m
end

module IntStore = Make (IntIx)