Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

merge changes between 3.10.2 and the end of branch 3.10

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@9079 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information...
commit 805cfb82f241002c65b8af195baf5d8ce8811fc5 1 parent 0cc473d
doligez authored
View
16 bytecomp/translclass.ml
@@ -607,12 +607,20 @@ let transl_class ids cl_id arity pub_meths cl vflag =
let meth_ids = get_class_meths cl in
let subst env lam i0 new_ids' =
let fv = free_variables lam in
+ (* prerr_ids "cl_id =" [cl_id]; prerr_ids "fv =" (IdentSet.elements fv); *)
let fv = List.fold_right IdentSet.remove !new_ids' fv in
- let fv = IdentSet.filter (fun id -> List.mem id new_ids) fv in
- (* need to handle methods specially (PR#3576) *)
- let fm = IdentSet.diff (free_methods lam) meth_ids in
- let fv = IdentSet.union fv fm in
+ (* We need to handle method ids specially, as they do not appear
+ in the typing environment (PR#3576, PR#4560) *)
+ (* very hacky: we add and remove free method ids on the fly,
+ depending on the visit order... *)
+ method_ids :=
+ IdentSet.diff (IdentSet.union (free_methods lam) !method_ids) meth_ids;
+ (* prerr_ids "meth_ids =" (IdentSet.elements meth_ids);
+ prerr_ids "method_ids =" (IdentSet.elements !method_ids); *)
+ let new_ids = List.fold_right IdentSet.add new_ids !method_ids in
+ let fv = IdentSet.inter fv new_ids in
new_ids' := !new_ids' @ IdentSet.elements fv;
+ (* prerr_ids "new_ids' =" !new_ids'; *)
let i = ref (i0-1) in
List.fold_left
(fun subst id ->
View
2  bytecomp/translobj.ml
@@ -123,6 +123,7 @@ let transl_store_label_init glob size f arg =
let wrapping = ref false
let top_env = ref Env.empty
let classes = ref []
+let method_ids = ref IdentSet.empty
let oo_add_class id =
classes := id :: !classes;
@@ -138,6 +139,7 @@ let oo_wrap env req f x =
cache_required := req;
top_env := env;
classes := [];
+ method_ids := IdentSet.empty;
let lambda = f x in
let lambda =
List.fold_left
View
2  bytecomp/translobj.mli
@@ -24,5 +24,7 @@ val transl_label_init: lambda -> lambda
val transl_store_label_init:
Ident.t -> int -> ('a -> lambda) -> 'a -> int * lambda
+val method_ids: IdentSet.t ref (* reset when starting a new wrapper *)
+
val oo_wrap: Env.t -> bool -> ('a -> lambda) -> 'a -> lambda
val oo_add_class: Ident.t -> Env.t * bool
View
6 driver/optcompile.ml
@@ -113,6 +113,8 @@ let implementation ppf sourcefile outputprefix =
let inputfile = Pparse.preprocess sourcefile in
let env = initial_env() in
Compilenv.reset ?packname:!Clflags.for_package modulename;
+ let cmxfile = outputprefix ^ ".cmx" in
+ let objfile = outputprefix ^ ext_obj in
try
if !Clflags.print_types then ignore(
Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
@@ -129,11 +131,13 @@ let implementation ppf sourcefile outputprefix =
+++ Simplif.simplify_lambda
+++ print_if ppf Clflags.dump_lambda Printlambda.lambda
++ Asmgen.compile_implementation outputprefix ppf;
- Compilenv.save_unit_info (outputprefix ^ ".cmx");
+ Compilenv.save_unit_info cmxfile;
end;
Warnings.check_fatal ();
Pparse.remove_preprocessed inputfile
with x ->
+ remove_file objfile;
+ remove_file cmxfile;
Pparse.remove_preprocessed_if_ast inputfile;
raise x
View
2  ocamlbuild/Makefile
@@ -43,7 +43,7 @@ ppcache:
$(OCAMLBUILD) ppcache.byte ppcache.native
doc:
$(OCAMLBUILD) ocamlbuild.docdir/index.html
- ln -sf $(BUILDDIR)/ocamlbuild.docdir doc
+ ln -s -f $(BUILDDIR)/ocamlbuild.docdir doc
else
all byte native: ocamlbuild.byte.start
mkdir -p boot
View
36 otherlibs/bigarray/bigarray.mli
@@ -227,7 +227,7 @@ module Genarray :
Big arrays returned by [Genarray.create] are not initialized:
the initial values of array elements is unspecified.
- [Genarray.create] raises [Invalid_arg] if the number of dimensions
+ [Genarray.create] raises [Invalid_argument] if the number of dimensions
is not in the range 1 to 16 inclusive, or if one of the dimensions
is negative. *)
@@ -243,7 +243,7 @@ module Genarray :
big array [a]. The first dimension corresponds to [n = 0];
the second dimension corresponds to [n = 1]; the last dimension,
to [n = Genarray.num_dims a - 1].
- Raise [Invalid_arg] if [n] is less than 0 or greater or equal than
+ Raise [Invalid_argument] if [n] is less than 0 or greater or equal than
[Genarray.num_dims a]. *)
external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
@@ -262,7 +262,7 @@ module Genarray :
and strictly less than the corresponding dimensions of [a].
If [a] has Fortran layout, the coordinates must be greater or equal
than 1 and less or equal than the corresponding dimensions of [a].
- Raise [Invalid_arg] if the array [a] does not have exactly [N]
+ Raise [Invalid_argument] if the array [a] does not have exactly [N]
dimensions, or if the coordinates are outside the array bounds.
If [N > 3], alternate syntax is provided: you can write
@@ -280,7 +280,7 @@ module Genarray :
The array [a] must have exactly [N] dimensions, and all coordinates
must lie inside the array bounds, as described for [Genarray.get];
- otherwise, [Invalid_arg] is raised.
+ otherwise, [Invalid_argument] is raised.
If [N > 3], alternate syntax is provided: you can write
[a.{i1, i2, ..., iN} <- v] instead of
@@ -304,7 +304,7 @@ module Genarray :
array [a].
[Genarray.sub_left] applies only to big arrays in C layout.
- Raise [Invalid_arg] if [ofs] and [len] do not designate
+ Raise [Invalid_argument] if [ofs] and [len] do not designate
a valid sub-array of [a], that is, if [ofs < 0], or [len < 0],
or [ofs + len > Genarray.nth_dim a 0]. *)
@@ -324,7 +324,7 @@ module Genarray :
array [a].
[Genarray.sub_right] applies only to big arrays in Fortran layout.
- Raise [Invalid_arg] if [ofs] and [len] do not designate
+ Raise [Invalid_argument] if [ofs] and [len] do not designate
a valid sub-array of [a], that is, if [ofs < 1], or [len < 0],
or [ofs + len > Genarray.nth_dim a (Genarray.num_dims a - 1)]. *)
@@ -343,7 +343,7 @@ module Genarray :
the original array share the same storage space.
[Genarray.slice_left] applies only to big arrays in C layout.
- Raise [Invalid_arg] if [M >= N], or if [[|i1; ... ; iM|]]
+ Raise [Invalid_argument] if [M >= N], or if [[|i1; ... ; iM|]]
is outside the bounds of [a]. *)
external slice_right:
@@ -361,7 +361,7 @@ module Genarray :
the original array share the same storage space.
[Genarray.slice_right] applies only to big arrays in Fortran layout.
- Raise [Invalid_arg] if [M >= N], or if [[|i1; ... ; iM|]]
+ Raise [Invalid_argument] if [M >= N], or if [[|i1; ... ; iM|]]
is outside the bounds of [a]. *)
external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit
@@ -458,14 +458,14 @@ module Array1 : sig
[x] must be greater or equal than [0] and strictly less than
[Array1.dim a] if [a] has C layout. If [a] has Fortran layout,
[x] must be greater or equal than [1] and less or equal than
- [Array1.dim a]. Otherwise, [Invalid_arg] is raised. *)
+ [Array1.dim a]. Otherwise, [Invalid_argument] is raised. *)
external set: ('a, 'b, 'c) t -> int -> 'a -> unit = "%caml_ba_set_1"
(** [Array1.set a x v], also written [a.{x} <- v],
stores the value [v] at index [x] in [a].
[x] must be inside the bounds of [a] as described in
{!Bigarray.Array1.get};
- otherwise, [Invalid_arg] is raised. *)
+ otherwise, [Invalid_argument] is raised. *)
external sub: ('a, 'b, 'c) t -> int -> int -> ('a, 'b, 'c) t
= "caml_ba_sub"
@@ -539,14 +539,14 @@ module Array2 :
returns the element of [a] at coordinates ([x], [y]).
[x] and [y] must be within the bounds
of [a], as described for {!Bigarray.Genarray.get};
- otherwise, [Invalid_arg] is raised. *)
+ otherwise, [Invalid_argument] is raised. *)
external set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit = "%caml_ba_set_2"
(** [Array2.set a x y v], or alternatively [a.{x,y} <- v],
stores the value [v] at coordinates ([x], [y]) in [a].
[x] and [y] must be within the bounds of [a],
as described for {!Bigarray.Genarray.set};
- otherwise, [Invalid_arg] is raised. *)
+ otherwise, [Invalid_argument] is raised. *)
external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
= "caml_ba_sub"
@@ -645,7 +645,7 @@ module Array3 :
returns the element of [a] at coordinates ([x], [y], [z]).
[x], [y] and [z] must be within the bounds of [a],
as described for {!Bigarray.Genarray.get};
- otherwise, [Invalid_arg] is raised. *)
+ otherwise, [Invalid_argument] is raised. *)
external set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit
= "%caml_ba_set_3"
@@ -653,7 +653,7 @@ module Array3 :
stores the value [v] at coordinates ([x], [y], [z]) in [a].
[x], [y] and [z] must be within the bounds of [a],
as described for {!Bigarray.Genarray.set};
- otherwise, [Invalid_arg] is raised. *)
+ otherwise, [Invalid_argument] is raised. *)
external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
= "caml_ba_sub"
@@ -754,17 +754,17 @@ external genarray_of_array3 :
val array1_of_genarray : ('a, 'b, 'c) Genarray.t -> ('a, 'b, 'c) Array1.t
(** Return the one-dimensional big array corresponding to the given
- generic big array. Raise [Invalid_arg] if the generic big array
+ generic big array. Raise [Invalid_argument] if the generic big array
does not have exactly one dimension. *)
val array2_of_genarray : ('a, 'b, 'c) Genarray.t -> ('a, 'b, 'c) Array2.t
(** Return the two-dimensional big array corresponding to the given
- generic big array. Raise [Invalid_arg] if the generic big array
+ generic big array. Raise [Invalid_argument] if the generic big array
does not have exactly two dimensions. *)
val array3_of_genarray : ('a, 'b, 'c) Genarray.t -> ('a, 'b, 'c) Array3.t
(** Return the three-dimensional big array corresponding to the given
- generic big array. Raise [Invalid_arg] if the generic big array
+ generic big array. Raise [Invalid_argument] if the generic big array
does not have exactly three dimensions. *)
@@ -784,7 +784,7 @@ val reshape : ('a, 'b, 'c) Genarray.t -> int array -> ('a, 'b, 'c) Genarray.t
The returned big array must have exactly the same number of
elements as the original big array [b]. That is, the product
of the dimensions of [b] must be equal to [i1 * ... * iN].
- Otherwise, [Invalid_arg] is raised. *)
+ Otherwise, [Invalid_argument] is raised. *)
val reshape_1 : ('a, 'b, 'c) Genarray.t -> int -> ('a, 'b, 'c) Array1.t
(** Specialized version of {!Bigarray.reshape} for reshaping to
View
4 otherlibs/threads/Makefile
@@ -84,10 +84,10 @@ marshal.cmi: $(LIB)/marshal.cmi
ln -s $(LIB)/marshal.cmi marshal.cmi
unix.mli: $(UNIXLIB)/unix.mli
- ln -sf $(UNIXLIB)/unix.mli unix.mli
+ ln -s -f $(UNIXLIB)/unix.mli unix.mli
unix.cmi: $(UNIXLIB)/unix.cmi
- ln -sf $(UNIXLIB)/unix.cmi unix.cmi
+ ln -s -f $(UNIXLIB)/unix.cmi unix.cmi
unix.cmo: unix.mli unix.cmi $(UNIXLIB)/unixLabels.cmo
$(CAMLC) ${COMPFLAGS} -c unix.ml
View
8 parsing/lexer.mll
@@ -136,9 +136,11 @@ let char_for_decimal_code lexbuf i =
let c = 100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) +
10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) +
(Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48) in
- if (c < 0 || c > 255) && not (in_comment ())
- then raise (Error(Illegal_escape (Lexing.lexeme lexbuf),
- Location.curr lexbuf))
+ if (c < 0 || c > 255) then
+ if in_comment ()
+ then 'x'
+ else raise (Error(Illegal_escape (Lexing.lexeme lexbuf),
+ Location.curr lexbuf))
else Char.chr c
let char_for_hexadecimal_code lexbuf i =
View
7 stdlib/lexing.mli
@@ -62,10 +62,11 @@ type lexbuf =
The lexer buffer holds the current state of the scanner, plus
a function to refill the buffer from the input.
- Note that the lexing engine will only change the [pos_cnum] field
+ At each token, the lexing engine will copy [lex_curr_p] to
+ [lex_start_p], then change the [pos_cnum] field
of [lex_curr_p] by updating it with the number of characters read
- since the start of the [lexbuf]. The other fields are copied
- without change by the lexing engine. In order to keep them
+ since the start of the [lexbuf]. The other fields are left
+ unchanged by the lexing engine. In order to keep them
accurate, they must be initialised before the first use of the
lexbuf, and updated by the relevant lexer actions (i.e. at each
end of line -- see also [new_line]).
View
82 stdlib/string.mli
@@ -13,37 +13,47 @@
(* $Id$ *)
-(** String operations. *)
+(** String operations.
+ Given a string [s] of length [l], we call character number in [s]
+ the index of a character in [s]. Indexes start at [0], and we will
+ call a character number valid in [s] if it falls within the range
+ [[0...l-1]]. A position is the point between two characters or at
+ the beginning or end of the string. We call a position valid
+ in [s] if it falls within the range [[0...l]]. Note that character
+ number [n] is between positions [n] and [n+1].
+
+ Two parameters [start] and [len] are said to designate a valid
+ substring of [s] if [len >= 0] and [start] and [start+len] are
+ valid positions in [s].
+ *)
external length : string -> int = "%string_length"
(** Return the length (number of characters) of the given string. *)
external get : string -> int -> char = "%string_safe_get"
(** [String.get s n] returns character number [n] in string [s].
- The first character is character number 0.
- The last character is character number [String.length s - 1].
You can also write [s.[n]] instead of [String.get s n].
- Raise [Invalid_argument "index out of bounds"]
- if [n] is outside the range 0 to [(String.length s - 1)]. *)
+ Raise [Invalid_argument] if [n] not a valid character number in [s]. *)
external set : string -> int -> char -> unit = "%string_safe_set"
(** [String.set s n c] modifies string [s] in place,
replacing the character number [n] by [c].
You can also write [s.[n] <- c] instead of [String.set s n c].
- Raise [Invalid_argument "index out of bounds"]
- if [n] is outside the range 0 to [(String.length s - 1)]. *)
+
+ Raise [Invalid_argument] if [n] is not a valid character number in [s]. *)
external create : int -> string = "caml_create_string"
(** [String.create n] returns a fresh string of length [n].
The string initially contains arbitrary characters.
- Raise [Invalid_argument] if [n < 0] or [n > Sys.max_string_length].
-*)
+
+ Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *)
val make : int -> char -> string
(** [String.make n c] returns a fresh string of length [n],
filled with the character [c].
+
Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}.*)
val copy : string -> string
@@ -51,16 +61,16 @@ val copy : string -> string
val sub : string -> int -> int -> string
(** [String.sub s start len] returns a fresh string of length [len],
- containing the characters number [start] to [start + len - 1]
- of string [s].
+ containing the substring of [s] that starts at position [start] and
+ has length [len].
+
Raise [Invalid_argument] if [start] and [len] do not
- designate a valid substring of [s]; that is, if [start < 0],
- or [len < 0], or [start + len > ]{!String.length}[ s]. *)
+ designate a valid substring of [s]. *)
val fill : string -> int -> int -> char -> unit
(** [String.fill s start len c] modifies string [s] in place,
- replacing the characters number [start] to [start + len - 1]
- by [c].
+ replacing [len] characters by [c], starting at [start].
+
Raise [Invalid_argument] if [start] and [len] do not
designate a valid substring of [s]. *)
@@ -69,7 +79,8 @@ val blit : string -> int -> string -> int -> int -> unit
from string [src], starting at character number [srcoff], to
string [dst], starting at character number [dstoff]. It works
correctly even if [src] and [dst] are the same string,
- and the source and destination chunks overlap.
+ and the source and destination intervals overlap.
+
Raise [Invalid_argument] if [srcoff] and [len] do not
designate a valid substring of [src], or if [dstoff] and [len]
do not designate a valid substring of [dst]. *)
@@ -91,25 +102,33 @@ val escaped : string -> string
not a copy. *)
val index : string -> char -> int
-(** [String.index s c] returns the position of the leftmost
+(** [String.index s c] returns the character number of the first
occurrence of character [c] in string [s].
+
Raise [Not_found] if [c] does not occur in [s]. *)
val rindex : string -> char -> int
-(** [String.rindex s c] returns the position of the rightmost
+(** [String.rindex s c] returns the character number of the last
occurrence of character [c] in string [s].
+
Raise [Not_found] if [c] does not occur in [s]. *)
val index_from : string -> int -> char -> int
-(** Same as {!String.index}, but start
- searching at the character position given as second argument.
- [String.index s c] is equivalent to [String.index_from s 0 c].*)
+(** [String.index_from s i c] returns the character number of the
+ first occurrence of character [c] in string [s] after position [i].
+ [String.index s c] is equivalent to [String.index_from s 0 c].
+
+ Raise [Invalid_argument] if [i] is not a valid position in [s].
+ Raise [Not_found] if [c] does not occur in [s] after position [i]. *)
val rindex_from : string -> int -> char -> int
-(** Same as {!String.rindex}, but start
- searching at the character position given as second argument.
+(** [String.rindex_from s i c] returns the character number of the
+ last occurrence of character [c] in string [s] before position [i+1].
[String.rindex s c] is equivalent to
- [String.rindex_from s (String.length s - 1) c]. *)
+ [String.rindex_from s (String.length s - 1) c].
+
+ Raise [Invalid_argument] if [i+1] is not a valid position in [s].
+ Raise [Not_found] if [c] does not occur in [s] before position [i+1]. *)
val contains : string -> char -> bool
(** [String.contains s c] tests if character [c]
@@ -117,15 +136,18 @@ val contains : string -> char -> bool
val contains_from : string -> int -> char -> bool
(** [String.contains_from s start c] tests if character [c]
- appears in the substring of [s] starting from [start] to the end
- of [s].
- Raise [Invalid_argument] if [start] is not a valid index of [s]. *)
+ appears in [s] after position [start].
+ [String.contains s c] is equivalent to
+ [String.contains_from s 0 c].
+
+ Raise [Invalid_argument] if [start] is not a valid position in [s]. *)
val rcontains_from : string -> int -> char -> bool
(** [String.rcontains_from s stop c] tests if character [c]
- appears in the substring of [s] starting from the beginning
- of [s] to index [stop].
- Raise [Invalid_argument] if [stop] is not a valid index of [s]. *)
+ appears in [s] before position [stop+1].
+
+ Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid
+ position in [s]. *)
val uppercase : string -> string
(** Return a copy of the argument, with all lowercase letters
View
40 typing/ctype.ml
@@ -1471,6 +1471,9 @@ let mkvariant fields closed =
{row_fields = fields; row_closed = closed; row_more = newvar();
row_bound = (); row_fixed = false; row_name = None })
+(* force unification in Reither when one side has as non-conjunctive type *)
+let rigid_variants = ref false
+
(**** Unification ****)
(* Return whether [t0] occurs in [ty]. Objects are also traversed. *)
@@ -1819,7 +1822,8 @@ and unify_row_field env fixed1 fixed2 l f1 f2 =
| Reither(c1, tl1, m1, e1), Reither(c2, tl2, m2, e2) ->
if e1 == e2 then () else
let redo =
- (m1 || m2) &&
+ (m1 || m2 ||
+ !rigid_variants && (List.length tl1 = 1 || List.length tl2 = 1)) &&
begin match tl1 @ tl2 with [] -> false
| t1 :: tl ->
if c1 || c2 then raise (Unify []);
@@ -2241,6 +2245,12 @@ let matches env ty ty' =
(* Equivalence between parameterized types *)
(*********************************************)
+let expand_head_rigid env ty =
+ let old = !rigid_variants in
+ rigid_variants := true;
+ let ty' = expand_head_unif env ty in
+ rigid_variants := old; ty'
+
let normalize_subst subst =
if List.exists
(function {desc=Tlink _}, _ | _, {desc=Tlink _} -> true | _ -> false)
@@ -2265,8 +2275,8 @@ let rec eqtype rename type_pairs subst env t1 t2 =
| (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
()
| _ ->
- let t1' = expand_head_unif env t1 in
- let t2' = expand_head_unif env t2 in
+ let t1' = expand_head_rigid env t1 in
+ let t2' = expand_head_rigid env t2 in
(* Expansion may have changed the representative of the types... *)
let t1' = repr t1' and t2' = repr t2' in
if t1' == t2' then () else
@@ -2320,10 +2330,9 @@ and eqtype_list rename type_pairs subst env tl1 tl2 =
and eqtype_fields rename type_pairs subst env ty1 ty2 =
let (fields2, rest2) = flatten_fields ty2 in
(* Try expansion, needed when called from Includecore.type_manifest *)
- try match try_expand_head env rest2 with
+ match expand_head_rigid env rest2 with
{desc=Tobject(ty2,_)} -> eqtype_fields rename type_pairs subst env ty1 ty2
- | _ -> raise Cannot_expand
- with Cannot_expand ->
+ | _ ->
let (fields1, rest1) = flatten_fields ty1 in
let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
eqtype rename type_pairs subst env rest1 rest2;
@@ -2346,10 +2355,9 @@ and eqtype_kind k1 k2 =
and eqtype_row rename type_pairs subst env row1 row2 =
(* Try expansion, needed when called from Includecore.type_manifest *)
- try match try_expand_head env (row_more row2) with
+ match expand_head_rigid env (row_more row2) with
{desc=Tvariant row2} -> eqtype_row rename type_pairs subst env row1 row2
- | _ -> raise Cannot_expand
- with Cannot_expand ->
+ | _ ->
let row1 = row_repr row1 and row2 = row_repr row2 in
let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
if row1.row_closed <> row2.row_closed
@@ -2790,6 +2798,10 @@ let rec build_subtype env visited loops posi level t =
ty1, tl1
| _ -> raise Not_found
in
+ (* Fix PR4505: do not set ty to Tvar when it appears in tl1,
+ as this occurence might break the occur check.
+ XXX not clear whether this correct anyway... *)
+ if List.exists (deep_occur ty) tl1 then raise Not_found;
ty.desc <- Tvar;
let t'' = newvar () in
let loops = (ty, t'') :: loops in
@@ -3168,8 +3180,8 @@ let rec normalize_type_rec env ty =
| Tvariant row ->
let row = row_repr row in
let fields = List.map
- (fun (l,f) ->
- let f = row_field_repr f in l,
+ (fun (l,f0) ->
+ let f = row_field_repr f0 in l,
match f with Reither(b, ty::(_::_ as tyl), m, e) ->
let tyl' =
List.fold_left
@@ -3178,10 +3190,8 @@ let rec normalize_type_rec env ty =
then tyl else ty::tyl)
[ty] tyl
in
- if List.length tyl' <= List.length tyl then
- let f = Reither(b, List.rev tyl', m, ref None) in
- set_row_field e f;
- f
+ if f != f0 || List.length tyl' < List.length tyl then
+ Reither(b, List.rev tyl', m, e)
else f
| _ -> f)
row.row_fields in
View
14 typing/oprint.ml
@@ -55,11 +55,13 @@ let float_repres f =
| FP_infinite ->
if f < 0.0 then "neg_infinity" else "infinity"
| _ ->
- let s1 = Printf.sprintf "%.12g" f in
- if f = float_of_string s1 then valid_float_lexeme s1 else
- let s2 = Printf.sprintf "%.15g" f in
- if f = float_of_string s2 then valid_float_lexeme s2 else
- Printf.sprintf "%.18g" f
+ let float_val =
+ let s1 = Printf.sprintf "%.12g" f in
+ if f = float_of_string s1 then s1 else
+ let s2 = Printf.sprintf "%.15g" f in
+ if f = float_of_string s2 then s2 else
+ Printf.sprintf "%.18g" f
+ in valid_float_lexeme float_val
let parenthesize_if_neg ppf fmt v isneg =
if isneg then pp_print_char ppf '(';
@@ -340,7 +342,7 @@ and print_out_sig_item ppf =
| Osig_modtype (name, mty) ->
fprintf ppf "@[<2>module type %s =@ %a@]" name !out_module_type mty
| Osig_module (name, mty, rs) ->
- fprintf ppf "@[<2>%s %s :@ %a@]"
+ fprintf ppf "@[<2>%s %s :@ %a@]"
(match rs with Orec_not -> "module"
| Orec_first -> "module rec"
| Orec_next -> "and")
View
2  typing/typemod.ml
@@ -888,7 +888,7 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
(str, coercion)
end else begin
check_nongen_schemes finalenv str;
- normalize_signature finalenv sg;
+ normalize_signature finalenv simple_sg;
let coercion =
Includemod.compunit sourcefile sg
"(inferred signature)" simple_sg in
View
2  win32caml/inria.h
@@ -63,7 +63,7 @@
#include "editbuffer.h"
#include "history.h"
-#if _MSC_VER <= 1200
+#if _MSC_VER <= 1200 && !defined(__MINGW32__)
#define GetWindowLongPtr GetWindowLong
#define SetWindowLongPtr SetWindowLong
#define DWLP_USER DWL_USER
Please sign in to comment.
Something went wrong with that request. Please try again.