~ubuntu-branches/ubuntu/lucid/camomile/lucid

« back to all changes in this revision

Viewing changes to public/subText.ml

  • Committer: Bazaar Package Importer
  • Author(s): Sylvain Le Gall
  • Date: 2005-12-03 01:18:55 UTC
  • Revision ID: james.westby@ubuntu.com-20051203011855-qzvwlld1xyqnl62t
Tags: upstream-0.6.3
ImportĀ upstreamĀ versionĀ 0.6.3

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
(* $Id: subText.ml,v 1.2 2004/09/04 16:08:40 yori Exp $ *)
 
2
(* Copyright 2002, 2003 Yamagata Yoriyuki. distributed with LGPL *)
 
3
 
 
4
module type Type = sig
 
5
  type t
 
6
 
 
7
  val get : t -> int -> UChar.t
 
8
 
 
9
  val init : int -> (int -> UChar.t) -> t
 
10
  val length : t -> int
 
11
 
 
12
  type index
 
13
  val look : t -> index -> UChar.t
 
14
  val nth : t -> int -> index
 
15
  val first : t -> index
 
16
  val last : t -> index
 
17
 
 
18
  val next : t -> index -> index
 
19
  val prev : t -> index -> index
 
20
  val move : t -> index -> int -> index
 
21
  val out_of_range : t -> index -> bool
 
22
  val compare_index : t -> index -> index -> int
 
23
      
 
24
  val iter : (UChar.t -> unit) -> t -> unit
 
25
  val compare : t -> t -> int
 
26
 
 
27
  module Buf : sig
 
28
    type buf
 
29
    val create : int -> buf
 
30
    val contents : buf -> t
 
31
    val clear : buf -> unit
 
32
    val reset : buf -> unit
 
33
    val add_char : buf -> UChar.t -> unit
 
34
    val add_string : buf -> t -> unit
 
35
    val add_buffer : buf -> buf -> unit
 
36
  end      
 
37
 
 
38
  type ur_text
 
39
  type ur_index
 
40
 
 
41
  val refer : ur_text -> ur_index -> ur_index -> t
 
42
  val excerpt : t -> ur_text
 
43
  val context : t -> ur_text * ur_index * ur_index
 
44
  val ur_index_of : t -> index -> ur_index
 
45
end
 
46
 
 
47
module Make (Text : UnicodeString.Type) = struct
 
48
 
 
49
  type t = Text.t * Text.index * Text.index
 
50
  type index = Text.index
 
51
 
 
52
  let out_of_range (t, i0, j) i =
 
53
    if Text.compare_index t i0 i > 0 then true else
 
54
    if Text.compare_index t i j >= 0 then true else
 
55
    Text.out_of_range t i
 
56
 
 
57
  let look ((t, _, _) as s) i = 
 
58
    if out_of_range s i then failwith "SubText.look" else
 
59
    Text.look t i
 
60
 
 
61
  let next (t, _, j) i = Text.next t i
 
62
 
 
63
  let prev (t, j, _) i = Text.prev t i
 
64
 
 
65
  let move ((t, _, _) as s) i n = Text.move t i n
 
66
 
 
67
  let nth ((t, i, _) as s) n = move s i n
 
68
 
 
69
  let first (t, i, _) = i
 
70
 
 
71
  let last (t, _, i) = Text.prev t i
 
72
 
 
73
  let compare_index (t, _, _) i j = Text.compare_index t i j
 
74
 
 
75
  let get s n = look s (nth s n)
 
76
 
 
77
  let init len f =
 
78
    let t = Text.init len f in
 
79
    (t, Text.nth t 0, Text.next t (Text.last t))
 
80
 
 
81
  let length (t, i, j) = 
 
82
    let rec loop i n =
 
83
      if Text.compare_index t i j >= 0 then n else
 
84
      loop (Text.next t i) (n + 1) in
 
85
    loop i 0
 
86
 
 
87
  let iter proc (t, i, j) = 
 
88
    let rec loop i =
 
89
      if Text.compare_index t i j >= 0 then () else begin
 
90
        proc (Text.look t i);
 
91
        loop (Text.next t i)
 
92
      end in
 
93
    loop i
 
94
 
 
95
  let compare (t1, i1, j1) (t2, i2, j2) =
 
96
    let rec loop i1 i2 =
 
97
      if Text.compare_index t1 i1 j1 >= 0 then
 
98
        if Text.compare_index t2 i2 j2 >= 0 then 0 else ~-1
 
99
      else if Text.compare_index t2 i2 j2 >= 0 then 1 else
 
100
      let sgn = UChar.compare (Text.look t1 i1) (Text.look t2 i2) in
 
101
      if sgn = 0 then
 
102
        loop (Text.next t1  i1) (Text.next t2 i2)
 
103
      else sgn in
 
104
    loop i1 i2
 
105
 
 
106
  module Buf = struct
 
107
    include Text.Buf
 
108
 
 
109
    let add_string buf s = iter (add_char buf) s
 
110
 
 
111
    let contents buf =
 
112
      let t = Text.Buf.contents buf in
 
113
      (t, Text.nth t 0, Text.next t (Text.last t))
 
114
  end
 
115
 
 
116
  type ur_text = Text.t
 
117
  type ur_index = Text.index
 
118
 
 
119
  let refer t i j = (t, i, j)
 
120
 
 
121
  let excerpt s =
 
122
    let buf = Buf.create 0 in
 
123
    Buf.add_string buf s;
 
124
    Text.Buf.contents buf
 
125
 
 
126
  let context s = s
 
127
 
 
128
  let ur_index_of _ i = i
 
129
end