summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lex/lexgen.ml4
-rw-r--r--otherlibs/bigarray/bigarray.mli6
-rw-r--r--otherlibs/dynlink/dynlink.mli2
-rw-r--r--otherlibs/graph/graphics.mli4
-rw-r--r--otherlibs/labltk/compiler/printer.ml80
-rw-r--r--otherlibs/num/big_int.mli6
-rw-r--r--otherlibs/systhreads/condition.mli4
-rw-r--r--otherlibs/systhreads/event.mli4
8 files changed, 63 insertions, 47 deletions
diff --git a/lex/lexgen.ml b/lex/lexgen.ml
index a8bf51449..035e3fe6c 100644
--- a/lex/lexgen.ml
+++ b/lex/lexgen.ml
@@ -523,8 +523,8 @@ let encode_lexdef def =
Extension to tagged automata.
Confer
Ville Larikari
- ``NFAs with Tagged Transitions, their Conversion to Deterministic
- Automata and Application to Regular Expressions''.
+ 'NFAs with Tagged Transitions, their Conversion to Deterministic
+ Automata and Application to Regular Expressions'.
Symposium on String Processing and Information Retrieval (SPIRE 2000),
http://kouli.iki.fi/~vlaurika/spire2000-tnfa.ps
(See also)
diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli
index a14a5e4fc..eb9f3c5c3 100644
--- a/otherlibs/bigarray/bigarray.mli
+++ b/otherlibs/bigarray/bigarray.mli
@@ -14,7 +14,7 @@
(** Large, multi-dimensional, numerical arrays.
This module implements multi-dimensional arrays of integers and
- floating-point numbers, thereafter referred to as ``big arrays''.
+ floating-point numbers, thereafter referred to as 'big arrays'.
The implementation allows efficient sharing of large numerical
arrays between OCaml code and C or Fortran numerical libraries.
@@ -331,7 +331,7 @@ module Genarray :
= "caml_ba_slice"
(** Extract a sub-array of lower dimension from the given big array
by fixing one or several of the first (left-most) coordinates.
- [Genarray.slice_left a [|i1; ... ; iM|]] returns the ``slice''
+ [Genarray.slice_left a [|i1; ... ; iM|]] returns the 'slice'
of [a] obtained by setting the first [M] coordinates to
[i1], ..., [iM]. If [a] has [N] dimensions, the slice has
dimension [N - M], and the element at coordinates
@@ -349,7 +349,7 @@ module Genarray :
= "caml_ba_slice"
(** Extract a sub-array of lower dimension from the given big array
by fixing one or several of the last (right-most) coordinates.
- [Genarray.slice_right a [|i1; ... ; iM|]] returns the ``slice''
+ [Genarray.slice_right a [|i1; ... ; iM|]] returns the 'slice'
of [a] obtained by setting the last [M] coordinates to
[i1], ..., [iM]. If [a] has [N] dimensions, the slice has
dimension [N - M], and the element at coordinates
diff --git a/otherlibs/dynlink/dynlink.mli b/otherlibs/dynlink/dynlink.mli
index b43fa359f..4ced87606 100644
--- a/otherlibs/dynlink/dynlink.mli
+++ b/otherlibs/dynlink/dynlink.mli
@@ -68,7 +68,7 @@ val default_available_units: unit -> unit
val allow_unsafe_modules : bool -> unit
(** Govern whether unsafe object files are allowed to be
- dynamically linked. A compilation unit is ``unsafe'' if it contains
+ dynamically linked. A compilation unit is 'unsafe' if it contains
declarations of external functions, which can break type safety.
By default, dynamic linking of unsafe object files is
not allowed. In native code, this function does nothing; object files
diff --git a/otherlibs/graph/graphics.mli b/otherlibs/graph/graphics.mli
index 5e81edb07..e1dce5263 100644
--- a/otherlibs/graph/graphics.mli
+++ b/otherlibs/graph/graphics.mli
@@ -235,7 +235,7 @@ type image
Externally, images are represented as matrices of colors. *)
val transp : color
-(** In matrices of colors, this color represent a ``transparent''
+(** In matrices of colors, this color represent a 'transparent'
point: when drawing the corresponding image, all pixels on the
screen corresponding to a transparent pixel in the image will
not be modified, while other points will be set to the color
@@ -333,7 +333,7 @@ external sound : int -> int -> unit = "caml_gr_sound"
val auto_synchronize : bool -> unit
(** By default, drawing takes place both on the window displayed
- on screen, and in a memory area (the ``backing store'').
+ on screen, and in a memory area (the 'backing store').
The backing store image is used to re-paint the on-screen
window when necessary.
diff --git a/otherlibs/labltk/compiler/printer.ml b/otherlibs/labltk/compiler/printer.ml
index fe33ada36..e8bfeaa1f 100644
--- a/otherlibs/labltk/compiler/printer.ml
+++ b/otherlibs/labltk/compiler/printer.ml
@@ -22,7 +22,7 @@ let escape_string s =
let more = ref 0 in
for i = 0 to String.length s - 1 do
match s.[i] with
- | '\\' | '"' -> incr more
+ | '\\' | '\"' | '\'' -> incr more
| _ -> ()
done;
if !more = 0 then s else
@@ -31,45 +31,52 @@ let escape_string s =
for i = 0 to String.length s - 1 do
let c = s.[i] in
match c with
- | '\\' | '"' -> res.[!j] <- '\\'; incr j; res.[!j] <- c; incr j
+ | '\\' | '\"' |'\'' -> res.[!j] <- '\\'; incr j; res.[!j] <- c; incr j
| _ -> res.[!j] <- c; incr j
done;
- res;;
+ res
+;;
-let escape_char c = if c = '\'' then "\\'" else String.make 1 c;;
+let escape_char c = if c = '\'' then "\\\'" else String.make 1 c;;
let print_quoted_string s = printf "\"%s\"" (escape_string s);;
-let print_quoted_char c = printf "'%s'" (escape_char c);;
+let print_quoted_char c = printf "\'%s\'" (escape_char c);;
let print_quoted_int i =
- if i < 0 then printf "(%d)" i else printf "%d" i;;
+ if i < 0 then printf "(%d)" i else printf "%d" i
+;;
let print_quoted_float f =
- if f <= 0.0 then printf "(%f)" f else printf "%f" f;;
+ if f <= 0.0 then printf "(%f)" f else printf "%f" f
+;;
(* Iterators *)
let print_list f l =
- printf "@[<1>[";
- let rec pl = function
- | [] -> printf "@;<0 -1>]@]"
- | [x] -> f x; pl []
- | x :: xs -> f x; printf ";@ "; pl xs in
- pl l;;
+ printf "@[<1>[";
+ let rec pl = function
+ | [] -> printf "@;<0 -1>]@]"
+ | [x] -> f x; pl []
+ | x :: xs -> f x; printf ";@ "; pl xs in
+ pl l
+;;
let print_array f v =
- printf "@[<2>[|";
- let l = Array.length v in
- if l >= 1 then f v.(0);
- if l >= 2 then
- for i = 1 to l - 1 do
- printf ";@ "; f v.(i)
- done;
- printf "@;<0 -1>|]@]";;
+ printf "@[<2>[|";
+ let l = Array.length v in
+ if l >= 1 then f v.(0);
+ if l >= 2 then
+ for i = 1 to l - 1 do
+ printf ";@ "; f v.(i)
+ done;
+ printf "@;<0 -1>|]@]"
+;;
let print_option f = function
| None -> print_string "None"
- | Some x -> printf "@[<1>Some@ "; f x; printf "@]";;
+ | Some x -> printf "@[<1>Some@ "; f x; printf "@]"
+;;
let print_bool = function
- | true -> print_string "true" | _ -> print_string "false";;
+ | true -> print_string "true" | _ -> print_string "false"
+;;
let print_poly x = print_string "<poly>";;
@@ -97,7 +104,8 @@ let rec print_mltype = function
printf "@[<1>(%s@ " "Function"; print_mltype m; printf ")@]"
| As (m, s) ->
printf "@[<1>(%s@ " "As"; printf "@[<1>("; print_mltype m; printf ",@ ";
- print_quoted_string s; printf ")@]"; printf ")@]";;
+ print_quoted_string s; printf ")@]"; printf ")@]"
+;;
let rec print_template = function
| StringArg s ->
@@ -111,12 +119,14 @@ let rec print_template = function
| OptionalArgs (s, l_t, l_t0) ->
printf "@[<1>(%s@ " "OptionalArgs"; printf "@[<1>(";
print_quoted_string s; printf ",@ "; print_list print_template l_t;
- printf ",@ "; print_list print_template l_t0; printf ")@]"; printf ")@]";;
+ printf ",@ "; print_list print_template l_t0; printf ")@]"; printf ")@]"
+;;
(* Sorts of components *)
let rec print_component_type = function
| Constructor -> printf "Constructor" | Command -> printf "Command"
- | External -> printf "External";;
+ | External -> printf "External"
+;;
(* Full definition of a component *)
let rec print_fullcomponent = function
@@ -128,13 +138,15 @@ let rec print_fullcomponent = function
printf ";@]@ "; printf "@[<1>var_name =@ "; print_quoted_string s0;
printf ";@]@ "; printf "@[<1>template =@ "; print_template t;
printf ";@]@ "; printf "@[<1>result =@ "; print_mltype m; printf ";@]@ ";
- printf "@[<1>safe =@ "; print_bool b; printf ";@]@ "; printf "@,}@]";;
+ printf "@[<1>safe =@ "; print_bool b; printf ";@]@ "; printf "@,}@]"
+;;
(* components are given either in full or abbreviated *)
let rec print_component = function
| Full f -> printf "@[<1>(%s@ " "Full"; print_fullcomponent f; printf ")@]"
| Abbrev s ->
- printf "@[<1>(%s@ " "Abbrev"; print_quoted_string s; printf ")@]";;
+ printf "@[<1>(%s@ " "Abbrev"; print_quoted_string s; printf ")@]"
+;;
(* A type definition *)
(*
@@ -142,7 +154,8 @@ let rec print_component = function
an additional argument of type Widget.
*)
let rec print_parser_arity = function
- | OneToken -> printf "OneToken" | MultipleToken -> printf "MultipleToken";;
+ | OneToken -> printf "OneToken" | MultipleToken -> printf "MultipleToken"
+;;
let rec print_type_def = function
{parser_arity = p; constructors = l_f; subtypes = l_t_s_l_f;
@@ -159,10 +172,12 @@ let rec print_type_def = function
l_t_s_l_f;
printf ";@]@ "; printf "@[<1>requires_widget_context =@ "; print_bool b;
printf ";@]@ "; printf "@[<1>variant =@ "; print_bool b0; printf ";@]@ ";
- printf "@,}@]";;
+ printf "@,}@]"
+;;
let rec print_module_type = function
- | Widget -> printf "Widget" | Family -> printf "Family";;
+ | Widget -> printf "Widget" | Family -> printf "Family"
+;;
let rec print_module_def = function
{module_type = m; commands = l_f; externals = l_f0; } ->
@@ -170,4 +185,5 @@ let rec print_module_def = function
printf ";@]@ "; printf "@[<1>commands =@ ";
print_list print_fullcomponent l_f; printf ";@]@ ";
printf "@[<1>externals =@ "; print_list print_fullcomponent l_f0;
- printf ";@]@ "; printf "@,}@]";;
+ printf ";@]@ "; printf "@,}@]"
+;;
diff --git a/otherlibs/num/big_int.mli b/otherlibs/num/big_int.mli
index 46621f941..fc75153ef 100644
--- a/otherlibs/num/big_int.mli
+++ b/otherlibs/num/big_int.mli
@@ -155,13 +155,13 @@ val float_of_big_int : big_int -> float
(** {6 Bit-oriented operations} *)
val and_big_int : big_int -> big_int -> big_int
- (** Bitwise logical ``and''.
+ (** Bitwise logical 'and'.
The arguments must be positive or zero. *)
val or_big_int : big_int -> big_int -> big_int
- (** Bitwise logical ``or''.
+ (** Bitwise logical 'or'.
The arguments must be positive or zero. *)
val xor_big_int : big_int -> big_int -> big_int
- (** Bitwise logical ``exclusive or''.
+ (** Bitwise logical 'exclusive or'.
The arguments must be positive or zero. *)
val shift_left_big_int : big_int -> int -> big_int
(** [shift_left_big_int b n] returns [b] shifted left by [n] bits.
diff --git a/otherlibs/systhreads/condition.mli b/otherlibs/systhreads/condition.mli
index 2d5bcde1f..9e005dc66 100644
--- a/otherlibs/systhreads/condition.mli
+++ b/otherlibs/systhreads/condition.mli
@@ -14,8 +14,8 @@
(** Condition variables to synchronize between threads.
Condition variables are used when one thread wants to wait until another
- thread has finished doing something: the former thread ``waits'' on the
- condition variable, the latter thread ``signals'' the condition when it
+ thread has finished doing something: the former thread 'waits' on the
+ condition variable, the latter thread 'signals' the condition when it
is done. Condition variables should always be protected by a mutex.
The typical use is (if [D] is a shared data structure, [m] its mutex,
and [c] is a condition variable):
diff --git a/otherlibs/systhreads/event.mli b/otherlibs/systhreads/event.mli
index 769cd4999..8352ca1fc 100644
--- a/otherlibs/systhreads/event.mli
+++ b/otherlibs/systhreads/event.mli
@@ -62,13 +62,13 @@ val guard : (unit -> 'a event) -> 'a event
operation. *)
val sync : 'a event -> 'a
-(** ``Synchronize'' on an event: offer all the communication
+(** 'Synchronize' on an event: offer all the communication
possibilities specified in the event to the outside world,
and block until one of the communications succeed. The result
value of that communication is returned. *)
val select : 'a event list -> 'a
-(** ``Synchronize'' on an alternative of events.
+(** 'Synchronize' on an alternative of events.
[select evl] is shorthand for [sync(choose evl)]. *)
val poll : 'a event -> 'a option