blob: 243751581d85c03c197d7c2e71e1ef6ed38972a9 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* String operations *)
external length : string -> int = "%string_length"
external get : string -> int -> char = "%string_safe_get"
external set : string -> int -> char -> unit = "%string_safe_set"
external create: int -> string = "create_string"
external unsafe_get : string -> int -> char = "%string_unsafe_get"
external unsafe_set : string -> int -> char -> unit = "%string_unsafe_set"
external unsafe_blit : string -> int -> string -> int -> int -> unit
= "blit_string" "noalloc"
external unsafe_fill : string -> int -> int -> char -> unit
= "fill_string" "noalloc"
let make n c =
let s = create n in
unsafe_fill s 0 n c;
s
let copy s =
let len = length s in
let r = create len in
unsafe_blit s 0 r 0 len;
r
let sub s ofs len =
if ofs < 0 or len < 0 or ofs + len > length s
then invalid_arg "String.sub"
else begin
let r = create len in
unsafe_blit s ofs r 0 len;
r
end
let fill s ofs len c =
if ofs < 0 or len < 0 or ofs + len > length s
then invalid_arg "String.fill"
else unsafe_fill s ofs len c
let blit s1 ofs1 s2 ofs2 len =
if len < 0 or ofs1 < 0 or ofs1 + len > length s1
or ofs2 < 0 or ofs2 + len > length s2
then invalid_arg "String.blit"
else unsafe_blit s1 ofs1 s2 ofs2 len
let concat sep l =
match l with
[] -> ""
| hd :: tl ->
let num = ref 0 and len = ref 0 in
List.iter (fun s -> incr num; len := !len + length s) l;
let r = create (!len + length sep * (!num - 1)) in
unsafe_blit hd 0 r 0 (length hd);
let pos = ref(length hd) in
List.iter
(fun s ->
unsafe_blit sep 0 r !pos (length sep);
pos := !pos + length sep;
unsafe_blit s 0 r !pos (length s);
pos := !pos + length s)
tl;
r
external is_printable: char -> bool = "is_printable"
external char_code: char -> int = "%identity"
external char_chr: int -> char = "%identity"
let escaped s =
let n = ref 0 in
for i = 0 to length s - 1 do
n := !n +
(match unsafe_get s i with
'"' | '\\' | '\n' | '\t' -> 2
| c -> if is_printable c then 1 else 4)
done;
if !n = length s then s else begin
let s' = create !n in
n := 0;
for i = 0 to length s - 1 do
begin
match unsafe_get s i with
('"' | '\\') as c ->
unsafe_set s' !n '\\'; incr n; unsafe_set s' !n c
| '\n' ->
unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'n'
| '\t' ->
unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 't'
| c ->
if is_printable c then
unsafe_set s' !n c
else begin
let a = char_code c in
unsafe_set s' !n '\\';
incr n;
unsafe_set s' !n (char_chr (48 + a / 100));
incr n;
unsafe_set s' !n (char_chr (48 + (a / 10) mod 10));
incr n;
unsafe_set s' !n (char_chr (48 + a mod 10))
end
end;
incr n
done;
s'
end
let map f s =
let l = length s in
if l = 0 then s else begin
let r = create l in
for i = 0 to l - 1 do unsafe_set r i (f(unsafe_get s i)) done;
r
end
let uppercase s = map Char.uppercase s
let lowercase s = map Char.uppercase s
let apply1 f s =
if length s = 0 then s else begin
let r = copy s in
unsafe_set r 0 (f(unsafe_get s 0));
r
end
let capitalize s = apply1 Char.uppercase s
let uncapitalize s = apply1 Char.lowercase s
|
