[Caml-list] Re: [Ocaml-lib-devel] pMap.ml

[Markus Mottl <markus@oefai.at>]

[-- Attachment #1: Type: text/plain, Size: 2292 bytes --]

On Mon, 06 Oct 2003, Michal Moskal wrote:
> On Mon, Oct 06, 2003 at 01:33:18PM +0200, Nicolas Cannasse wrote:
> > Manipulating references is most of the time quite a pain, and make the code
> > quite ugly.
> > I understand in some cases the need of pure functional data structure (Coq
> > code proof) but in the "average user" cases that target ExtLib, having a
> > mutable structure is surely better. For example I often use an Hashtable
> > where a Map would be better for theses two reasons :
> > - no need to define a module type (this is corrected by this polymorphic
> > version)
> > - the hashtable is mutable ! means, easy to use.
> 
> FWIW implementing mutable map on top of non-mutable one is easier and
> more efficient then vice versa. Just need to use ref. Otherwise you need
> to do some copy() tricks.

I completely agree with Michal here: it's essentially impossible to get
rid of the imperativeness of a datastructure unless you use some tricks
like monads that hide the state. Probably not what the "average user"
wants to work with :-)

On Mon, 06 Oct 2003, Richard Jones wrote:
> Hashtbls are much easier to use than Maps precisely for the reasons he
> has outlined. They'd be even better if the language offered syntactic
> support for them (but this just reflects my Perl background), eg:

Note that you can always easily implement the functionality of Hashtbls
using (purely functional) Maps and references - but not easily the other
way round! See attachment for an implementation. I haven't tested the
Hashtbl-code, but have used type annotations to have the code verified
a bit more tightly. Furthermore, I have updated pMap.ml, because, as I
have found out, its functional interface was incompatible with the on
in Map and also lacked functions.

On Mon, 06 Oct 2003, Claudio Sacerdoti Coen wrote:
>  Most of the time, mutable means non-reentrant.
>  This point should never be forgot when considering pros and cons
>  of an implementation. Expecially when dealing with proposed
>  "standard" libraries for a multi-threaded programming language.

Which is another very good argument against impure structures that don't
benefit from impurity in terms of efficiency...

Regards,
Markus

-- 
Markus Mottl          http://www.oefai.at/~markus          markus@oefai.at

[-- Attachment #2: pMap.ml --]
[-- Type: text/plain, Size: 4271 bytes --]

(*
 * pMap - Polymorphic maps
 * Copyright (C) 2003 Markus Mottl
 *
 * 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)

type ('k, 'v) map =
  | Empty
  | Node of ('k, 'v) map * 'k * 'v * ('k, 'v) map * int

type ('k, 'v) t =
  {
    cmp : 'k -> 'k -> int;
    map : ('k, 'v) map;
  }

let height = function
  | Node (_, _, _, _, h) -> h
  | Empty -> 0

let make l k v r = Node (l, k, v, r, max (height l) (height r) + 1)

let bal l k v r =
  let hl = height l in
  let hr = height r in
  if hl > hr + 2 then
    match l with
    | Node (ll, lk, lv, lr, _) ->
        if height ll >= height lr then make ll lk lv (make lr k v r)
        else
          (match lr with
          | Node (lrl, lrk, lrv, lrr, _) ->
              make (make ll lk lv lrl) lrk lrv (make lrr k v r)
          | Empty -> assert false)
    | Empty -> assert false
  else if hr > hl + 2 then
    match r with
    | Node (rl, rk, rv, rr, _) ->
        if height rr >= height rl then make (make l k v rl) rk rv rr
        else
          (match rl with
          | Node (rll, rlk, rlv, rlr, _) ->
              make (make l k v rll) rlk rlv (make rlr rk rv rr)
          | Empty -> assert false)
    | Empty -> assert false
  else Node (l, k, v, r, max hl hr + 1)

let rec merge t1 t2 =
  match t1, t2 with
  | Node (l1, k1, v1, r1, _), Node (l2, k2, v2, r2, _) ->
      bal l1 k1 v1 (bal (merge r1 l2) k2 v2 r2)
  | Empty, t -> t
  | t, Empty -> t

let create cmp = { cmp = cmp; map = Empty }
let empty = { cmp = compare; map = Empty }

let add x d { cmp = cmp; map = map } =
  let rec loop = function
    | Node (l, k, v, r, h) ->
        let c = cmp x k in
        if c = 0 then Node (l, x, d, r, h)
        else if c < 0 then
          let nl = loop l in
          bal nl k v r
        else
          let nr = loop r in
          bal l k v nr
    | Empty -> Node (Empty, x, d, Empty, 1) in
  { cmp = cmp; map = loop map }

let find x { cmp = cmp; map = map } =
  let rec loop = function
    | Node (l, k, v, r, _) ->
        let c = cmp x k in
        if c < 0 then loop l
        else if c > 0 then loop r
        else v
    | Empty -> raise Not_found in
  loop map

let remove x { cmp = cmp; map = map } =
  let rec loop = function
    | Node (l, k, v, r, _) ->
        let c = cmp x k in
        if c = 0 then merge l r else
        if c < 0 then bal (loop l) k v r else bal l k v (loop r)
    | Empty -> Empty in
  { cmp = cmp; map = loop map }

let mem x { cmp = cmp; map = map } =
  let rec loop = function
    | Node (l, k, v, r, _) ->
        let c = cmp x k in
        c = 0 || loop (if c < 0 then l else r)
    | Empty -> false in
  loop map

let iter f { map = map } =
  let rec loop = function
    | Empty -> ()
    | Node (l, k, v, r, _) -> loop l; f k v; loop r in
  loop map

let map f { cmp = cmp; map = map } =
  let rec loop = function
    | Empty -> Empty
    | Node (l, k, v, r, h) -> Node (loop l, k, f v, loop r, h) in
  { cmp = cmp; map = loop map }

let mapi f { cmp = cmp; map = map } =
  let rec loop = function
    | Empty -> Empty
    | Node (l, k, v, r, h) -> Node (loop l, k, f k v, loop r, h) in
  { cmp = cmp; map = loop map }

let fold f { cmp = cmp; map = map } acc =
  let rec loop acc = function
    | Empty -> acc
    | Node (l, k, v, r, _) -> loop l (f k v (loop r acc)) in
  loop acc map

let enum m =
  let rec to_list acc = function
    | Empty -> acc
    | Node (l, k, v, r, _) -> to_list ((k, v) :: to_list acc r) l in
  ExtList.List.enum (to_list [] m.map)

let uncurry_add (k, v) m = add k v m
let of_enum ?(cmp = compare) e = Enum.fold uncurry_add (create cmp) e

[-- Attachment #3: hashtbl.ml --]
[-- Type: text/plain, Size: 1399 bytes --]

type ('k, 'v) t = ('k, 'v list ref) PMap.t ref

let create () : ('k, 'v) t = ref PMap.empty
let clear (m_ref : ('k, 'v) t) : unit = m_ref := PMap.empty

let add (m_ref : ('k, 'v) t) (x : 'k) (d : 'v) : unit =
  try
    let vlst_ref = PMap.find x !m_ref in
    vlst_ref := d :: !vlst_ref
  with Not_found -> m_ref := PMap.add x (ref [d]) !m_ref

let copy_ref r = ref !r
let copy (m_ref : ('k, 'v) t) : ('k, 'v) t = ref (PMap.map copy_ref !m_ref)
let find (m_ref : ('k, 'v) t) (x : 'k) : 'v = List.hd !(PMap.find x !m_ref)
let find_all m_ref x : 'v list = !(PMap.find x !m_ref)
let mem (m_ref : ('k, 'v) t) (x : 'k) : bool = PMap.mem x !m_ref

let remove (m_ref : ('k, 'v) t) (x : 'k) : unit =
  try
    let vlst_ref = PMap.find x !m_ref in
    match !vlst_ref with
    | [_] -> m_ref := PMap.remove x !m_ref
    | _ :: rest -> vlst_ref := rest
    | [] -> assert false
  with Not_found -> ()

let replace (m_ref : ('a, 'b) t) x d =
  try
    let vlst_ref = PMap.find x !m_ref in
    vlst_ref := d :: List.tl !vlst_ref
  with Not_found -> m_ref := PMap.add x (ref [d]) !m_ref

let iter (f : 'k -> 'v -> unit) (m_ref : ('k, 'v) t) : unit =
  let f' k vlst_ref = List.iter (f k) !vlst_ref in
  PMap.iter f' !m_ref

let fold (f : 'k -> 'v -> 'a -> 'a) (m_ref : ('k, 'v) t) (acc : 'a) : 'a =
  let f' k vlst_ref acc =
    List.fold_left (fun acc v -> f k v acc) acc !vlst_ref in
  PMap.fold f' !m_ref acc