← Back to branch summary

~ubuntu-branches/ubuntu/hoary/scilab/hoary

« back to all changes in this revision

Viewing changes to ocaml/graphNodeSet.ml

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2005-01-09 22:58:21 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20050109225821-473xr8vhgugxxx5j
Tags: 3.0-12
http://bugs.debian.org/255869
changed configure.in to build scilab's own malloc.o, closes: #255869

Show diffs side-by-side

added added

removed removed

Lines of Context:
ocaml/graphNodeSet.ml
 
1
(* Functorial interface *)
 
2
 
 
3
let hash_param = Hashtbl.hash_param
 
4
 
 
5
let hash x = hash_param 10 100 x
 
6
 
 
7
module type HashableType =
 
8
  sig
 
9
    type t
 
10
    val hash: t -> int
 
11
  end
 
12
 
 
13
module type S =
 
14
  sig
 
15
    type elt
 
16
    type 'a t
 
17
    val create:
 
18
      int -> ('a -> elt -> bool) -> ('a -> int) -> ('a -> int -> elt) -> 'a t
 
19
    val find_or_add: 'a -> 'a t -> elt
 
20
    val iter: (elt -> unit) -> 'a t -> unit
 
21
  end
 
22
 
 
23
module Make(H: HashableType): (S with type elt = H.t) =
 
24
  struct
 
25
 
 
26
    type elt = H.t
 
27
 
 
28
    type 'a t =
 
29
      {
 
30
        equal : 'a -> elt -> bool;        (* equality function      *)
 
31
        hash : 'a -> int;                 (* hash function          *)
 
32
        create : 'a -> int -> elt;        (* creation function      *)
 
33
        mutable max_len : int;            (* max length of a bucket *)
 
34
        mutable data : elt Weak.t array   (* the buckets            *)
 
35
      }
 
36
 
 
37
    let create initial_size equalfun hashfun createfun =
 
38
      let s = if initial_size < 1 then 1 else initial_size in
 
39
      let s = if s > Sys.max_array_length then Sys.max_array_length else s in
 
40
      {
 
41
        equal = equalfun;
 
42
        hash = hashfun;
 
43
        create = createfun;
 
44
        max_len = 3;
 
45
        data = Array.init s (function n -> Weak.create 3)
 
46
      }
 
47
 
 
48
    let rec insert_from buckt some_elt n =
 
49
      if n < 0 then failwith "Insertion error" else
 
50
      match Weak.get buckt n with
 
51
        | None -> Weak.set buckt n some_elt
 
52
        | _ -> insert_from buckt some_elt (n - 1)
 
53
 
 
54
    let resize s =
 
55
      let odata = s.data in
 
56
      let osize = Array.length odata in
 
57
      let nsize = min (2 * osize + 1) Sys.max_array_length in
 
58
      begin
 
59
        s.max_len <- 2 * s.max_len;
 
60
        let ndata = Array.init nsize (function n -> Weak.create s.max_len) in
 
61
        let insert_bucket buckt =
 
62
          for i = 0 to Weak.length buckt - 1 do
 
63
            match Weak.get buckt i with
 
64
                | None -> ()
 
65
                | Some elt as some_elt ->
 
66
                    insert_from
 
67
                      ndata.((H.hash elt land max_int) mod nsize)
 
68
                      some_elt
 
69
                      (s.max_len - 1)
 
70
          done
 
71
        in
 
72
          for i = 0 to osize - 1 do
 
73
              insert_bucket odata.(i)
 
74
          done;
 
75
          s.data <- ndata;
 
76
      end
 
77
 
 
78
    let rec bucket_too_long n bucket =
 
79
      if n < 0 then true else
 
80
      match Weak.get bucket n with
 
81
        | None -> false
 
82
        | _ -> bucket_too_long (n - 1) bucket
 
83
 
 
84
    let find_or_add elt_as_atoms s =
 
85
      let equalfun = s.equal
 
86
      and hash = s.hash elt_as_atoms land max_int
 
87
      and createfun = s.create in
 
88
      let rec add' bucket n option_pos =
 
89
        if n < 0 then match option_pos with
 
90
          | None ->
 
91
              resize s;
 
92
              add' s.data.(hash mod (Array.length s.data)) (s.max_len - 1) None
 
93
          | Some pos ->
 
94
              let elt = createfun elt_as_atoms hash in
 
95
                Weak.set bucket pos (Some elt); elt
 
96
        else match Weak.get bucket n with
 
97
          | None ->
 
98
              begin match option_pos with
 
99
                | None -> add' bucket (n - 1) (Some n)
 
100
                | _ -> add' bucket (n - 1) option_pos
 
101
              end
 
102
          | Some elt when equalfun elt_as_atoms elt -> elt
 
103
          | _ -> add' bucket (n - 1) option_pos
 
104
      in add' s.data.(hash mod (Array.length s.data)) (s.max_len - 1) None
 
105
 
 
106
    let iter f s =
 
107
      let iter_bucket bucket =
 
108
        for i = 0 to Weak.length bucket - 1 do
 
109
          match Weak.get bucket i with
 
110
            | None -> ()
 
111
            | Some elt -> f elt
 
112
        done
 
113
      in Array.iter iter_bucket s.data
 
114
 
 
115
  end