Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Revu le module Buffer. 

Utilise Buffer dans Printf.sprintf; ajout Printf.bprintf.
Ajout Map.mem.


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2309 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Xavier Leroy 1999-02-25 10:26:38 +00:00
parent d654e2fa88
commit a5eb7789fd
11 changed files with 180 additions and 287 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
stdlib/.depend
View File

@ -1,11 +1,13 @@
format.cmi: buffer.cmi
genlex.cmi: stream.cmi
parsing.cmi: lexing.cmi obj.cmi
printf.cmi: buffer.cmi
arg.cmo: array.cmi list.cmi printf.cmi string.cmi sys.cmi arg.cmi
arg.cmx: array.cmx list.cmx printf.cmx string.cmx sys.cmx arg.cmi
array.cmo: list.cmi array.cmi
array.cmx: list.cmx array.cmi
buffer.cmo: char.cmi obj.cmi pervasives.cmi string.cmi buffer.cmi
buffer.cmx: char.cmx obj.cmx pervasives.cmx string.cmx buffer.cmi
buffer.cmo: string.cmi buffer.cmi
buffer.cmx: string.cmx buffer.cmi
callback.cmo: obj.cmi callback.cmi
callback.cmx: obj.cmx callback.cmi
char.cmo: char.cmi
@ -14,10 +16,8 @@ digest.cmo: string.cmi digest.cmi
digest.cmx: string.cmx digest.cmi
filename.cmo: pervasives.cmi string.cmi sys.cmi filename.cmi
filename.cmx: pervasives.cmx string.cmx sys.cmx filename.cmi
format.cmo: obj.cmi string.cmi format.cmi
format.cmx: obj.cmx string.cmx format.cmi
format_sprintf.cmo: obj.cmi string.cmi format_sprintf.cmi
format_sprintf.cmx: obj.cmx string.cmx format_sprintf.cmi
format.cmo: buffer.cmi obj.cmi string.cmi format.cmi
format.cmx: buffer.cmx obj.cmx string.cmx format.cmi
gc.cmo: printf.cmi gc.cmi
gc.cmx: printf.cmx gc.cmi
genlex.cmo: char.cmi hashtbl.cmi list.cmi stream.cmi string.cmi genlex.cmi
@ -46,8 +46,8 @@ pervasives.cmo: pervasives.cmi
pervasives.cmx: pervasives.cmi
printexc.cmo: obj.cmi printf.cmi string.cmi sys.cmi printexc.cmi
printexc.cmx: obj.cmx printf.cmx string.cmx sys.cmx printexc.cmi
printf.cmo: list.cmi obj.cmi string.cmi printf.cmi
printf.cmx: list.cmx obj.cmx string.cmx printf.cmi
printf.cmo: buffer.cmi obj.cmi string.cmi printf.cmi
printf.cmx: buffer.cmx obj.cmx string.cmx printf.cmi
queue.cmo: queue.cmi
queue.cmx: queue.cmi
random.cmo: array.cmi char.cmi digest.cmi string.cmi random.cmi

2
stdlib/Makefile
View File

@ -13,7 +13,7 @@ OBJS=pervasives.cmo list.cmo char.cmo string.cmo array.cmo sys.cmo \
hashtbl.cmo sort.cmo filename.cmo marshal.cmo obj.cmo \
lexing.cmo parsing.cmo \
set.cmo map.cmo stack.cmo queue.cmo stream.cmo \
printf.cmo buffer.cmo format.cmo arg.cmo printexc.cmo gc.cmo \
buffer.cmo printf.cmo format.cmo arg.cmo printexc.cmo gc.cmo \
digest.cmo random.cmo oo.cmo genlex.cmo callback.cmo weak.cmo \
lazy.cmo

2
stdlib/Makefile.Mac
View File

@ -7,7 +7,7 @@ OBJS = pervasives.cmo list.cmo char.cmo string.cmo array.cmo sys.cmo
hashtbl.cmo sort.cmo filename.cmo marshal.cmo obj.cmo ¶
lexing.cmo parsing.cmo ¶
set.cmo map.cmo stack.cmo queue.cmo stream.cmo ¶
printf.cmo format.cmo arg.cmo printexc.cmo gc.cmo ¶
buffer.cmo printf.cmo format.cmo arg.cmo printexc.cmo gc.cmo ¶
digest.cmo random.cmo oo.cmo genlex.cmo callback.cmo weak.cmo ¶
lazy.cmo

2
stdlib/Makefile.nt
View File

@ -11,7 +11,7 @@ OBJS=pervasives.cmo list.cmo char.cmo string.cmo array.cmo sys.cmo \
hashtbl.cmo sort.cmo filename.cmo marshal.cmo obj.cmo \
lexing.cmo parsing.cmo \
set.cmo map.cmo stack.cmo queue.cmo stream.cmo \
printf.cmo buffer.cmo format.cmo arg.cmo printexc.cmo gc.cmo \
buffer.cmo printf.cmo format.cmo arg.cmo printexc.cmo gc.cmo \
digest.cmo random.cmo oo.cmo genlex.cmo callback.cmo weak.cmo \
lazy.cmo

197
stdlib/buffer.ml
View File

@ -2,7 +2,7 @@
(* *)
(* Objective Caml *)
(* *)
(* Pierre Weis, projet Cristal, INRIA Rocquencourt *)
(* Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1999 Institut National de Recherche en Informatique et *)
(* en Automatique. Distributed only by permission. *)
@ -15,176 +15,57 @@ type t =
{mutable buffer : string;
mutable position : int;
mutable length : int;
mutable out_chan : out_channel option;
initial_buffer : string};;
initial_buffer : string}
let create n =
let s = String.create n in
{buffer = s; position = 0; length = String.length s; out_chan = None;
initial_buffer = s};;
{buffer = s; position = 0; length = String.length s; initial_buffer = s}
let contents b = String.sub b.buffer 0 b.position;;
let contents b = String.sub b.buffer 0 b.position
let length b = b.length;;
let length b = b.position
let position b = b.position;;
let clear b = b.position <- 0
let clear b = b.position <- 0;;
let reset b = clear b; b.buffer <- b.initial_buffer;;
let flush b =
match b.out_chan with
| None -> ()
| Some oc ->
Pervasives.output oc b.buffer 0 b.position;
clear b;;
let reset b = b.position <- 0; b.buffer <- b.initial_buffer
let resize b more =
flush b;
let len = b.length in
if b.position + more > len then
let new_len = if more < len then len + len else len + len + more in
let new_buffer = String.create new_len in
let len = b.length in
let new_len = ref len in
while b.position + more > !new_len do new_len := 2 * !new_len done;
let new_buffer = String.create !new_len in
String.blit b.buffer 0 new_buffer 0 b.position;
b.buffer <- new_buffer;
b.length <- new_len;;
b.length <- !new_len
(* Give_room is slightly different from resize, since it does not
flush systematically the buffer. *)
let give_room b l =
if b.position + l > b.length then resize b l;;
let add_char b c =
let pos = b.position in
if pos >= b.length then resize b 1;
b.buffer.[pos] <- c;
b.position <- pos + 1
let output_char b c =
let pos = b.position in
if pos >= b.length then resize b 1;
b.buffer.[pos] <- c;
b.position <- pos + 1;;
let add_substring b s offset len =
if offset < 0 || len < 0 || offset + len > String.length s
then invalid_arg "Buffer.add_substring";
let new_position = b.position + len in
if new_position > b.length then resize b len;
String.blit s offset b.buffer b.position len;
b.position <- new_position
let unsafe_output b s offset l =
let new_position = b.position + l in
if new_position > b.length then resize b l;
String.blit s offset b.buffer b.position l;
b.position <- new_position;;
let add_string b s =
let len = String.length s in
let new_position = b.position + len in
if new_position > b.length then resize b len;
String.blit s 0 b.buffer b.position len;
b.position <- new_position
let add_buffer b bs =
add_substring b bs.buffer 0 bs.position
let output_string b s = unsafe_output b s 0 (String.length s);;
let add_channel b ic len =
if b.position + len > b.length then resize b len;
really_input ic b.buffer b.position len;
b.position <- b.position + len
let output b s offset l =
if offset < 0 or offset + l > String.length s
then invalid_arg "Buffer.output"
else unsafe_output b s offset l;;
let output_buffer b bs = unsafe_output b bs.buffer 0 bs.position;;
let open_out b oc = b.out_chan <- Some oc;;
let close_out b =
match b.out_chan with
| None -> ()
| Some oc ->
Pervasives.output oc b.buffer 0 b.position;
reset b;
b.out_chan <- None;;
(* Input in buffers. *)
let really_input ic b len =
give_room b len;
Pervasives.really_input ic b.buffer b.position len;
b.position <- b.position + len;;
let input ic b len =
give_room b len;
let n = Pervasives.input ic b.buffer b.position len in
b.position <- b.position + n;
n;;
let read_in_channel ic b =
let len = in_channel_length ic in
really_input ic b len;;
(* The printf facility for buffers. *)
external format_int: string -> int -> string = "format_int"
external format_float: string -> float -> string = "format_float"
let bprintf b format =
let format = (Obj.magic format : string) in
let rec doprn start i =
if i >= String.length format then begin
if i > start then output b format start (i - start);
(Obj.magic ())
end else
if format.[i] != '%' then
doprn start (succ i)
else begin
if i > start then output b format start (i - start);
let j = skip_args (succ i) in
match format.[j] with
| '%' ->
doprn j (succ j)
| 's' ->
Obj.magic(dostring i j)
| 'c' ->
Obj.magic(fun c ->
output_char b c;
doprn (succ j) (succ j))
| 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
Obj.magic(doint i j)
| 'f' | 'e' | 'E' | 'g' | 'G' ->
Obj.magic(dofloat i j)
| 'b' ->
Obj.magic(fun bool ->
output_string b (string_of_bool bool);
doprn (succ j) (succ j))
| 'a' ->
Obj.magic(fun printer arg ->
printer b arg;
doprn (succ j) (succ j))
| 't' ->
Obj.magic(fun printer ->
printer b;
doprn (succ j) (succ j))
| c ->
invalid_arg ("bprintf: unknown format " ^ Char.escaped c)
end
and skip_args j =
match format.[j] with
| '0' .. '9' | ' ' | '.' | '-' -> skip_args (succ j)
| c -> j
and dostring i j s =
if j <= succ i then
output_string b s
else begin
let p =
try
int_of_string (String.sub format (succ i) (j - i - 1))
with _ ->
invalid_arg "bprintf: bad %s format" in
if p > 0 && String.length s < p then begin
output_string b (String.make (p - String.length s) ' ');
output_string b s
end else if p < 0 && String.length s < -p then begin
output_string b s;
output_string b (String.make (-p - String.length s) ' ')
end else
output_string b s
end;
doprn (succ j) (succ j)
and doint i j n =
let len = j - i in
let fmt = String.create (len + 2) in
String.blit format i fmt 0 len;
fmt.[len] <- 'l';
fmt.[len + 1] <- format.[j];
output_string b (format_int fmt n);
doprn (succ j) (succ j)
and dofloat i j f =
output_string b (format_float (String.sub format i (j - i + 1)) f);
doprn (succ j) (succ j)
in doprn 0 0;;
let output_buffer oc b =
output oc b.buffer 0 b.position

118
stdlib/buffer.mli
View File

@ -2,88 +2,64 @@
(* *)
(* Objective Caml *)
(* *)
(* Pierre Weis, projet Cristal, INRIA Rocquencourt *)
(* Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1999 Institut National de Recherche en Informatique et *)
(* en Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* Module [Buffer]: string buffers, automatically expanded as necessary.
Provide accumulative concatenation of strings in linear time,
instead of quadratic time.
Also a convenient abstraction of strings and channels
for input output. *)
(* Module [Buffer]: extensible string buffers *)
type t;;
(* This module implements string buffers that automatically expand
as necessary. It provides accumulative concatenation of strings
in quasi-linear time (instead of quadratic time when strings are
concatenated pairwise). *)
type t
(* The abstract type of buffers. *)
(* Basic operations on buffers. *)
val create : int -> t
(* [create n] returns a fresh buffer of length [n].
The length of the buffer is the maximum number of characters
that can be written in the buffer without extending the
buffer, and further calls to [reset] will shrink the buffer to
this initial length.
The initial contents of the buffer is not specified. *)
(* [create n] returns a fresh buffer, initially empty.
The [n] parameter is the initial size of the internal string
that holds the buffer contents. That string is automatically
reallocated when more than [n] characters are stored in the buffer,
but shrinks back to [n] characters when [reset] is called.
For best performance, [n] should be of the same order of magnitude
as the number of characters that are expected to be stored in
the buffer (for instance, 80 for a buffer that holds one output
line). Nothing bad will happen if the buffer grows beyond that
limit, however. In doubt, take [n = 16] for instance. *)
val contents : t -> string
(* Returns a copy of the actual contents of the buffer.
The writing position of the buffer is left unchanged. *)
(* Return a copy of the current contents of the buffer.
The buffer itself is unchanged. *)
val length : t -> int
(* [length b n] returns the actual length of buffer [b]. *)
val position : t -> int
(* Returns the actual writing position of the buffer. *)
(* Return the number of characters currently contained in the buffer. *)
val clear : t -> unit
(* Reset to zero the writing position of the buffer. *)
(* Empty the buffer. *)
val reset : t -> unit
(* [reset b] resets the buffer to its initial length and resets
to zero the writing position of the buffer. The underlying
storage character string of the buffer is restored to its
initial value. *)
(* The [printf] facility for buffers. *)
val bprintf : t -> ('a, t, unit) format -> 'a
(* [bprintf] has the same functionality as [fprintf] but material
is output on buffers. See the module [printf] for details. *)
(* Output function for buffers. *)
val output_string : t -> string -> unit
val output_char : t -> char -> unit
val output : t -> string -> int -> int -> unit
(* Similar to the usual functions from module [Pervasives],
but output is done on the buffer argument. *)
val output_buffer : t -> t -> unit
(* [output_buffer b1 b2] copies the contents of buffer [b2] into
the buffer [b1].
The writing position of buffer [b2] is left unchanged. *)
(* Connection between buffers and out channels. *)
val open_out : t -> out_channel -> unit
(* Connects the buffer to the given out channel.
Overflows or explicit flushes now cause the buffer to be
output on the given out channel. *)
val close_out : t -> unit
(* Flushes the buffer to its out channel, resets the buffer, then
suppresses the connection between the buffer and its out channel.
The out channel is not closed.
Nothing happens if the buffer is not connected to any out channel. *)
val flush : t -> unit
(* Outputs the contents of the buffer to its out channel, and resets
to zero the writing position of the buffer.
The out channel is not flushed.
Nothing happens if the buffer is not connected to any out channel. *)
(* Reading characters from input channels. *)
val input : in_channel -> t -> int -> int
(* [input ic b len] attempts to read [len] characters from input
channel [ic] and stores them in buffer [b].
It returns the actual number of characters read. *)
val really_input : in_channel -> t -> int -> unit
(* Same as the [input] function above, but using the input function
[Pervasives.really_input] instead of [Pervasives.input].
Raise [End_of_file] if the end of file is reached before [len]
characters have been read. *)
val read_in_channel : in_channel -> t -> unit
(* [Buffer.read_in_channel ic b] copies the entire contents of
input channel [ic] in buffer [b]. *)
(* Empty the buffer and deallocate the internal string holding the
buffer contents, replacing it with the initial internal string
of length [n] that was allocated by [create n].
For long-lived buffers that may have grown a lot, [reset] allows
faster reclaimation of the space used by the buffer. *)
val add_char : t -> char -> unit
(* [add_char b c] appends the character [c] at the end of
the buffer [b]. *)
val add_string : t -> string -> unit
(* [add_string b s] appends the string [s] at the end of
the buffer [b]. *)
val add_substring : t -> string -> int -> int -> unit
(* [add_substring b s ofs len] takes [len] characters from offset
[ofs] in string [s] and appends them at the end of the buffer [b]. *)
val add_buffer : t -> t -> unit
(* [add_buffer b1 b2] appends the current contents of buffer [b2]
at the end of buffer [b1]. [b2] is not modified. *)
val add_channel : t -> in_channel -> int -> unit
(* [add_channel b ic n] reads exactly [n] character from the
input channel [ic] and stores them at the end of buffer [b].
Raise [End_of_file] if the channel contains fewer than [n]
characters. *)
val output_buffer : out_channel -> t -> unit
(* [output_buffer oc b] writes the current contents of buffer [b]
on the output channel [oc]. *)

2
stdlib/format.ml
View File

@ -625,7 +625,7 @@ let formatter_of_out_channel oc =
make_formatter (output oc) (fun () -> flush oc);;
let formatter_of_buffer b =
make_formatter (Buffer.output b) (fun () -> Buffer.flush b);;
make_formatter (Buffer.add_substring b) (fun () -> ());;
let stdbuf = Buffer.create 512;;

8
stdlib/map.ml
View File

@ -25,6 +25,7 @@ module type S =
val add: key -> 'a -> 'a t -> 'a t
val find: key -> 'a t -> 'a
val remove: key -> 'a t -> 'a t
val mem: key -> 'a t -> bool
val iter: (key -> 'a -> unit) -> 'a t -> unit
val map: ('a -> 'b) -> 'a t -> 'b t
val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
@ -98,6 +99,13 @@ module Make(Ord: OrderedType) = struct
if c = 0 then d
else find x (if c < 0 then l else r)
let rec mem x = function
Empty ->
false
| Node(l, v, d, r, _) ->
let c = Ord.compare x v in
c = 0 || mem x (if c < 0 then l else r)
let rec merge t1 t2 =
match (t1, t2) with
(Empty, t) -> t

3
stdlib/map.mli
View File

@ -53,6 +53,9 @@ module type S =
val remove: key -> 'a t -> 'a t
(* [remove x m] returns a map containing the same bindings as
[m], except for [x] which is unbound in the returned map. *)
val mem: key -> 'a t -> bool
(* [mem x m] returns [true] if [m] contains a binding for [m],
and [false] otherwise. *)
val iter: (key -> 'a -> unit) -> 'a t -> unit
(* [iter f m] applies [f] to all bindings in map [m].
[f] receives the key as first argument, and the associated value

109
stdlib/printf.ml
View File

@ -93,73 +93,92 @@ let fprintf outchan format =
let printf fmt = fprintf stdout fmt
and eprintf fmt = fprintf stderr fmt
let sprintf format =
let bprintf_internal tostring buf format =
let format = (Obj.magic format : string) in
let rec doprn start i accu =
if i >= String.length format then begin
let res =
if i > start
then String.sub format start (i-start) :: accu
else accu in
Obj.magic(String.concat "" (List.rev res))
end else
if String.unsafe_get format i <> '%' then
doprn start (i+1) accu
else begin
let accu1 =
if i > start then
String.sub format start (i-start) :: accu
else accu in
let rec doprn i =
if i >= String.length format then
if tostring then Obj.magic (Buffer.contents buf) else Obj.magic ()
else begin
let c = String.unsafe_get format i in
if c <> '%' then begin
Buffer.add_char buf c;
doprn (succ i)
end else begin
let j = skip_args (succ i) in
match String.unsafe_get format j with
'%' ->
doprn j (succ j) accu1
Buffer.add_char buf '%';
doprn (succ j)
| 's' ->
Obj.magic(fun s ->
let accu2 =
if j <= i+1 then
s :: accu1
else begin
let p =
try
int_of_string (String.sub format (i+1) (j-i-1))
with _ ->
invalid_arg "sprintf: bad %s format" in
if p > 0 && String.length s < p then
s :: String.make (p - String.length s) ' ' :: accu1
else if p < 0 && String.length s < -p then
String.make (-p - String.length s) ' ' :: s :: accu1
else
s :: accu1
end in
doprn (succ j) (succ j) accu2)
if j <= i+1 then
Buffer.add_string buf s
else begin
let p =
try
int_of_string (String.sub format (i+1) (j-i-1))
with _ ->
invalid_arg "fprintf: bad %s format" in
if p > 0 && String.length s < p then begin
Buffer.add_string buf
(String.make (p - String.length s) ' ');
Buffer.add_string buf s
end else if p < 0 && String.length s < -p then begin
Buffer.add_string buf s;
Buffer.add_string buf
(String.make (-p - String.length s) ' ')
end else
Buffer.add_string buf s
end;
doprn (succ j))
| 'c' ->
Obj.magic(fun c ->
doprn (succ j) (succ j) (String.make 1 c :: accu1))
Buffer.add_char buf c;
doprn (succ j))
| 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
Obj.magic(fun n ->
doprn (succ j) (succ j)
(format_int (String.sub format i (j-i+1)) n :: accu1))
Buffer.add_string buf
(format_int (String.sub format i (j-i+1)) n);
doprn (succ j))
| 'f' | 'e' | 'E' | 'g' | 'G' ->
Obj.magic(fun f ->
doprn (succ j) (succ j)
(format_float (String.sub format i (j-i+1)) f :: accu1))
Buffer.add_string buf
(format_float (String.sub format i (j-i+1)) f);
doprn (succ j))
| 'b' ->
Obj.magic(fun b ->
doprn (succ j) (succ j) (string_of_bool b :: accu1))
Buffer.add_string buf (string_of_bool b);
doprn (succ j))
| 'a' ->
Obj.magic(fun printer arg ->
doprn (succ j) (succ j) (printer () arg :: accu1))
if tostring then
Obj.magic(fun printer arg ->
Buffer.add_string buf (printer () arg);
doprn(succ j))
else
Obj.magic(fun printer arg ->
printer buf arg;
doprn(succ j))
| 't' ->
Obj.magic(fun printer ->
doprn (succ j) (succ j) (printer () :: accu1))
if tostring then
Obj.magic(fun printer ->
Buffer.add_string buf (printer ());
doprn(succ j))
else
Obj.magic(fun printer ->
printer buf;
doprn(succ j))
| c ->
invalid_arg ("sprintf: unknown format")
end
end
and skip_args j =
match String.unsafe_get format j with
'0' .. '9' | ' ' | '.' | '-' -> skip_args (succ j)
| c -> j
in doprn 0 0 []
in doprn 0
let bprintf buf fmt = bprintf_internal false buf fmt
let sprintf fmt = bprintf_internal true (Buffer.create 16) fmt

8
stdlib/printf.mli
View File

@ -63,6 +63,12 @@ val eprintf: ('a, out_channel, unit) format -> 'a
(* Same as [fprintf], but output on [stderr]. *)
val sprintf: ('a, unit, string) format -> 'a
(* Same as [printf], but instead of printing on an output channel,
(* Same as [fprintf], but instead of printing on an output channel,
return a string containing the result of formatting
the arguments. *)
val bprintf: Buffer.t -> ('a, Buffer.t, unit) format -> 'a
(* Same as [fprintf], but instead of printing on an output channel,
append the formatted arguments to the given extensible buffer
(see module [Buffer]). *)