[Camomile-commits] camomile/internal identity.ml,NONE,1.1

[<yo...@us...>]

Update of /cvsroot/camomile/camomile/internal
In directory usw-pr-cvs1:/tmp/cvs-serv13481

Added Files:
	identity.ml 
Log Message:
First try.


--- NEW FILE: identity.ml ---
(* $Id: identity.ml,v 1.1 2002/08/05 01:50:21 yori Exp $ *)
(* Copyright 2002 Yamagata Yoriyuki *)

type point = int

let count = ref 0

let new_point () =
  incr count;
  if !count < 0 then failwith "Too many points created." else !count

type block = int * int

exception Out_of_range

let new_block n =
  assert (n > 0);
  let n1 = !count in
  let n2 = !count + n - 1 in
  if n2 < 0 then failwith "Too many points created." else begin
    count := !count + n;
    let enum i = if i >= 0 && i < n then n1 + i else assert false in
    ((n1, n2), enum)
  end

module P = struct type t = int let compare = (-) end
module IDef = Interval.Make(P)
module I = IDef.Type

module Set :
  sig
    type t
    val create : unit -> t
    val clear :  t -> unit
    val mem :  t -> point -> bool
    val add_point : t -> point -> unit
    val add_block : t -> block -> unit
    val remove_point : t -> point -> unit
    val remove_block : t -> block -> unit
    val is_empty : t -> bool
  end =
  struct
    module S = IDef.Set
    type t = S.t

    let create = S.create
    let clear = S.clear
    let is_empty = S.is_empty

    let mem = S.mem

    let add_point s n = S.add s (I.Point n)
    let add_block s (n1, n2) = S.add s (I.Range (n1, I.Closed, n2, I.Closed))

    let remove_point s n = S.remove s (I.Point n)
    let remove_block s (n1, n2) = 
      S.remove s (I.Range (n1, I.Closed, n2, I.Closed))
  end

module Map : 
    sig
      type 'a t
      val create : unit -> 'a t
      val clear :  'a t -> unit
      val find : 'a t -> point -> 'a
      val mem : 'a t -> point -> bool
      val add_point : 'a t -> point -> 'a -> unit
      val add_block : 'a t -> block -> (point -> 'a) -> unit
      val remove_point : 'a t -> point -> unit
      val remove_block : 'a t -> block -> unit
      val is_empty : 'a t -> bool
      val map : (point -> 'a -> 'b) -> 'a t ->  'b t
    end =
  struct
    module M = IDef.Map

    type 'a t = 'a M.t

    let create = M.create
    let clear = M.clear
    let is_empty = M.is_empty
    let find = M.find
    let mem = M.mem
    let map = M.map

    let add_point s n v = M.add s (I.Point n) (M.Const v)
    let add_block s (n1, n2) f = 
      M.add s (I.Range (n1, I.Closed, n2, I.Closed)) (M.Func f)

    let remove_point s n = M.remove s (I.Point n)
    let remove_block s (n1, n2) = 
      M.remove s (I.Range (n1, I.Closed, n2, I.Closed))

  end