Merge from diff ocaml3100/ocaml3102: cvs update -j ocaml3100 -j ocaml3102 -kkcducetrunk

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

2 files changed, 20 insertions, 26 deletions

diff --git a/parsing/location.ml b/parsing/location.ml
index b1ec04e006..9921053e6a 100644
--- a/parsing/location.ml
+++ b/parsing/location.ml
@@ -70,9 +70,10 @@ let status = ref Terminfo.Uninitialised
 
 let num_loc_lines = ref 0 (* number of lines already printed after input *)
 
-(* Highlight the location using standout mode. *)
+(* Highlight the locations using standout mode. *)
 
 let highlight_terminfo ppf num_lines lb loc1 loc2 =
+  Format.pp_print_flush ppf ();  (* avoid mixing Format and normal output *)
   (* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *)
   let pos0 = -lb.lex_abs_pos in
   (* Do nothing if the buffer does not contain the whole phrase. *)
@@ -125,7 +126,7 @@ let highlight_dumb ppf lb loc =
   Format.fprintf ppf "Characters %i-%i:@."
                  loc.loc_start.pos_cnum loc.loc_end.pos_cnum;
   (* Print the input, underlining the location *)
-  print_string "  ";
+  Format.pp_print_string ppf "  ";
   let line = ref 0 in
   let pos_at_bol = ref 0 in
   for pos = 0 to end_pos do
@@ -133,34 +134,34 @@ let highlight_dumb ppf lb loc =
     if c <> '\n' then begin
       if !line = !line_start && !line = !line_end then
         (* loc is on one line: print whole line *)
-        print_char c
+        Format.pp_print_char ppf c
       else if !line = !line_start then
         (* first line of multiline loc: print ... before loc_start *)
         if pos < loc.loc_start.pos_cnum
-        then print_char '.'
-        else print_char c
+        then Format.pp_print_char ppf '.'
+        else Format.pp_print_char ppf c
       else if !line = !line_end then
         (* last line of multiline loc: print ... after loc_end *)
         if pos < loc.loc_end.pos_cnum
-        then print_char c
-        else print_char '.'
+        then Format.pp_print_char ppf c
+        else Format.pp_print_char ppf '.'
       else if !line > !line_start && !line < !line_end then
         (* intermediate line of multiline loc: print whole line *)
-        print_char c
+        Format.pp_print_char ppf c
     end else begin
       if !line = !line_start && !line = !line_end then begin
         (* loc is on one line: underline location *)
-        print_string "\n  ";
+        Format.fprintf ppf "@.  ";
         for i = !pos_at_bol to loc.loc_start.pos_cnum - 1 do
-          print_char ' '
+          Format.pp_print_char ppf ' '
         done;
         for i = loc.loc_start.pos_cnum to loc.loc_end.pos_cnum - 1 do
-          print_char '^'
+          Format.pp_print_char ppf '^'
         done
       end;
       if !line >= !line_start && !line <= !line_end then begin
-        print_char '\n';
-        if pos < loc.loc_end.pos_cnum then print_string "  "
+        Format.fprintf ppf "@.";
+        if pos < loc.loc_end.pos_cnum then Format.pp_print_string ppf "  "
       end;
       incr line;
       pos_at_bol := pos + 1;
diff --git a/parsing/parser.mly b/parsing/parser.mly
index cb6b65f94d..01f49f3d51 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -597,8 +597,8 @@ structure_item:
       { match $3 with
           [{ppat_desc = Ppat_any}, exp] -> mkstr(Pstr_eval exp)
         | _ -> mkstr(Pstr_value($2, List.rev $3)) }
-  | EXTERNAL val_ident_colon core_type EQUAL primitive_declaration
-      { mkstr(Pstr_primitive($2, {pval_type = $3; pval_prim = $5})) }
+  | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
+      { mkstr(Pstr_primitive($2, {pval_type = $4; pval_prim = $6})) }
   | TYPE type_declarations
       { mkstr(Pstr_type(List.rev $2)) }
   | EXCEPTION UIDENT constructor_arguments
@@ -663,10 +663,10 @@ signature:
   | signature signature_item SEMISEMI           { $2 :: $1 }
 ;
 signature_item:
-    VAL val_ident_colon core_type
-      { mksig(Psig_value($2, {pval_type = $3; pval_prim = []})) }
-  | EXTERNAL val_ident_colon core_type EQUAL primitive_declaration
-      { mksig(Psig_value($2, {pval_type = $3; pval_prim = $5})) }
+    VAL val_ident COLON core_type
+      { mksig(Psig_value($2, {pval_type = $4; pval_prim = []})) }
+  | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
+      { mksig(Psig_value($2, {pval_type = $4; pval_prim = $6})) }
   | TYPE type_declarations
       { mksig(Psig_type(List.rev $2)) }
   | EXCEPTION UIDENT constructor_arguments
@@ -824,8 +824,6 @@ concrete_method :
       { $3, $2, ghexp(Pexp_poly ($4, None)), symbol_rloc () }
   | METHOD private_flag label COLON poly_type EQUAL seq_expr
       { $3, $2, ghexp(Pexp_poly($7,Some $5)), symbol_rloc () }
-  | METHOD private_flag LABEL poly_type EQUAL seq_expr
-      { $3, $2, ghexp(Pexp_poly($6,Some $4)), symbol_rloc () }
 ;
 
 /* Class types */
@@ -1583,11 +1581,6 @@ val_ident:
     LIDENT                                      { $1 }
   | LPAREN operator RPAREN                      { $2 }
 ;
-val_ident_colon:
-    LIDENT COLON                                { $1 }
-  | LPAREN operator RPAREN COLON                { $2 }
-  | LABEL                                       { $1 }
-;
 operator:
     PREFIXOP                                    { $1 }
   | INFIXOP0                                    { $1 }