merge branch 4.02 from rev 16205 to rev 16238

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@16296 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

Changes

@@ -194,13 +194,23 @@ OCaml 4.02.3:
 -------------
 
 Bug fixes:
+- PR#6908: Top-level custom printing for GADTs: interface change in 4.02.2
+  (Grégoire Henry, report by Jeremy Yallop)
 - PR#6919: corrupted final_table
   (ygrek)
+- PR#6926: Regression: ocamldoc lost unattached comment
+  (Damien Doligez, report by François Bobot)
 - PR#6930: Aliased result type of GADT constructor results in assertion failure
   (Jacques Garrigue)
 
+Feature wishes:
+- PR#6691: install .cmt[i] files for stdlib and compiler-libs
+  (David Sheets, request by Gabriel Radanne)
+- GPR#37: New primitive: caml_alloc_dummy_function
+  (Hugo Heuzard)
+
 OCaml 4.02.2 (17 Jun 2015):
----------------------------
+-------------
 
 (Changes that can break existing programs are marked with a "*")
 

VERSION

@@ -1,4 +1,4 @@
-4.03.0+dev9-2015-07-22
+4.03.0+dev10-2015-07-29
 
 # The version string is the first line of this file.
 # It must be in the format described in stdlib/sys.mli

byterun/caml/misc.h

@@ -65,8 +65,10 @@ typedef char * addr;
 extern "C" {
 #endif
 
-/* GC timing hooks. These can be assigned by the user. The hook functions
-   must not allocate or change the heap in any way. */
+/* GC timing hooks. These can be assigned by the user.
+   [caml_minor_gc_begin_hook] must not allocate nor change any heap value.
+   The others can allocate and even call back to OCaml code.
+*/
 typedef void (*caml_timing_hook) (void);
 extern caml_timing_hook caml_major_slice_begin_hook, caml_major_slice_end_hook;
 extern caml_timing_hook caml_minor_gc_begin_hook, caml_minor_gc_end_hook;

byterun/finalise.c

@@ -126,6 +126,7 @@ void caml_final_do_calls (void)
   if (running_finalisation_function) return;
 
   if (to_do_hd != NULL){
+    if (caml_finalise_begin_hook != NULL) (*caml_finalise_begin_hook) ();
     caml_gc_message (0x80, "Calling finalisation functions.\n", 0);
     while (1){
       while (to_do_hd != NULL && to_do_hd->size == 0){
@@ -144,6 +145,7 @@ void caml_final_do_calls (void)
       if (Is_exception_result (res)) caml_raise (Extract_exception (res));
     }
     caml_gc_message (0x80, "Done calling finalisation functions.\n", 0);
+    if (caml_finalise_end_hook != NULL) (*caml_finalise_end_hook) ();
   }
 }
 

byterun/major_gc.c

@@ -149,7 +149,6 @@ static void mark_slice (intnat work)
   int marking_closure = 0;
 #endif
 
-  if (caml_major_slice_begin_hook != NULL) (*caml_major_slice_begin_hook) ();
   caml_gc_message (0x40, "Marking %ld words\n", work);
   caml_gc_message (0x40, "Subphase = %ld\n", caml_gc_subphase);
   gray_vals_ptr = gray_vals_cur;
@@ -322,7 +321,6 @@ static void mark_slice (intnat work)
     }
   }
   gray_vals_cur = gray_vals_ptr;
-  if (caml_major_slice_end_hook != NULL) (*caml_major_slice_end_hook) ();
 }
 
 static void sweep_slice (intnat work)
@@ -330,7 +328,6 @@ static void sweep_slice (intnat work)
   char *hp;
   header_t hd;
 
-  if (caml_major_slice_begin_hook != NULL) (*caml_major_slice_begin_hook) ();
   caml_gc_message (0x40, "Sweeping %ld words\n", work);
   while (work > 0){
     if (caml_gc_sweep_hp < limit){
@@ -369,7 +366,6 @@ static void sweep_slice (intnat work)
       }
     }
   }
-  if (caml_major_slice_end_hook != NULL) (*caml_major_slice_end_hook) ();
 }
 
 /* The main entry point for the GC.  Called after each minor GC.
@@ -424,6 +420,8 @@ intnat caml_major_collection_slice (intnat howmuch)
      This slice will either mark MS words or sweep SS words.
   */
 
+  if (caml_major_slice_begin_hook != NULL) (*caml_major_slice_begin_hook) ();
+
   if (caml_gc_phase == Phase_idle) start_cycle ();
 
   p = (double) caml_allocated_words * 3.0 * (100 + caml_percent_free)
@@ -471,6 +469,7 @@ intnat caml_major_collection_slice (intnat howmuch)
   caml_allocated_words = 0;
   caml_dependent_allocated = 0;
   caml_extra_heap_resources = 0.0;
+  if (caml_major_slice_end_hook != NULL) (*caml_major_slice_end_hook) ();
   return computed_work;
 }
 

byterun/minor_gc.c

@@ -285,9 +285,7 @@ CAMLexport void caml_minor_collection (void)
   caml_major_collection_slice (0);
   caml_force_major_slice = 0;
 
-  if (caml_finalise_begin_hook != NULL) (*caml_finalise_begin_hook) ();
   caml_final_do_calls ();
-  if (caml_finalise_end_hook != NULL) (*caml_finalise_end_hook) ();
 
   caml_empty_minor_heap ();
 }

ocamldoc/odoc_sig.ml

@@ -572,12 +572,20 @@ module Analyser =
                 assoc_com
                 ele.Parsetree.psig_desc
             in
-            f (acc_eles @ (ele_comments @ elements))
-              new_env
-              (ele.Parsetree.psig_loc.Location.loc_end.Lexing.pos_cnum + maybe_more)
+            let new_pos =
+              match ele.Parsetree.psig_desc with
+              | Parsetree.Psig_attribute ({Asttypes.txt = "ocaml.text"}, _) -> last_pos
+                  (* This "signature item" is actually a doc comment; the item is ignored
+                     but don't skip the comment. *)
+              | _ ->
+                 (ele.Parsetree.psig_loc.Location.loc_end.Lexing.pos_cnum + maybe_more)
                    (* for the comments of constructors in types,
                       which are after the constructor definition and can
                       go beyond ele.Parsetree.psig_loc.Location.loc_end.Lexing.pos_cnum *)
+            in
+            f (acc_eles @ (ele_comments @ elements))
+              new_env
+              new_pos
               q
       in
       f [] env last_pos sig_item_list

tools/.depend

@@ -56,8 +56,6 @@ ocamldep.cmx : ../driver/pparse.cmx ../parsing/parsetree.cmi \
     ../parsing/parser.cmx ../parsing/parse.cmx ../utils/misc.cmx \
     ../parsing/longident.cmx ../parsing/location.cmx ../parsing/lexer.cmx \
     depend.cmx ../utils/config.cmx ../driver/compenv.cmx ../utils/clflags.cmx
-ocamlmklib.cmo : ocamlmklibconfig.cmo
-ocamlmklib.cmx : ocamlmklibconfig.cmx
 ocamlmklibconfig.cmo :
 ocamlmklibconfig.cmx :
 ocamlmktop.cmo : ../utils/ccomp.cmi

toplevel/topdirs.ml

@@ -259,15 +259,17 @@ let match_printer_type ppf desc =
   let printer_type_new = printer_type ppf "printer_type_new" in
   let printer_type_old = printer_type ppf "printer_type_old" in
   Ctype.init_def(Ident.current_time());
-  match extract_target_parameters desc.val_type with
-  | None ->
-     (try
-        (match_simple_printer_type ppf desc printer_type_new, false)
-      with Ctype.Unify _ ->
-        (match_simple_printer_type ppf desc printer_type_old, true))
-  | Some (path, args) ->
-     (* only 'new' style is available for generic printers *)
-     match_generic_printer_type ppf desc path args printer_type_new, false
+  try
+    (match_simple_printer_type ppf desc printer_type_new, false)
+  with Ctype.Unify _ ->
+    try
+      (match_simple_printer_type ppf desc printer_type_old, true)
+    with Ctype.Unify _ as exn ->
+      match extract_target_parameters desc.val_type with
+      | None -> raise exn
+      | Some (path, args) ->
+          (match_generic_printer_type ppf desc path args printer_type_new,
+           false)
 
 let find_printer_type ppf lid =
   try