gestion des locations avec -ml; meilleur parenthesage pour -dtypes

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

4 files changed, 27 insertions, 16 deletions

diff --git a/lex/common.ml b/lex/common.ml
index d50f3ba4c3..90b60894f2 100644
--- a/lex/common.ml
+++ b/lex/common.ml
@@ -68,12 +68,18 @@ let copy_chars =
     "Win32" | "Cygwin" -> copy_chars_win32
   | _       -> copy_chars_unix
 
-let copy_chunk sourcefile ic oc trl loc =
+let copy_chunk sourcefile ic oc trl loc add_parens =
   if loc.start_pos < loc.end_pos then begin
     fprintf oc "# %d \"%s\"\n" loc.start_line sourcefile;
-    for i = 1 to loc.start_col do output_char oc ' ' done;
+    if add_parens then begin
+      for i = 1 to loc.start_col - 1 do output_char oc ' ' done;
+      output_char oc '(';
+    end else begin
+      for i = 1 to loc.start_col do output_char oc ' ' done;
+    end;
     seek_in ic loc.start_pos;
     copy_chars ic oc loc.start_pos loc.end_pos;
+    if add_parens then output_char oc ')';
     update_tracker trl;
   end
 
diff --git a/lex/common.mli b/lex/common.mli
index c2e52cc31f..2647dfb8a6 100644
--- a/lex/common.mli
+++ b/lex/common.mli
@@ -15,7 +15,7 @@ val open_tracker : string -> out_channel -> line_tracker
 val close_tracker : line_tracker -> unit
 val copy_chunk :
   string ->
-  in_channel -> out_channel -> line_tracker -> Syntax.location -> unit
+  in_channel -> out_channel -> line_tracker -> Syntax.location -> bool -> unit
 val output_mem_access : out_channel -> int -> unit
 val output_memory_actions :
   string -> out_channel -> Lexgen.memory_action list -> unit
diff --git a/lex/output.ml b/lex/output.ml
index 26ede6f5af..40bd6c7ed3 100644
--- a/lex/output.ml
+++ b/lex/output.ml
@@ -94,10 +94,10 @@ let output_entry sourcefile ic oc oci e =
   List.iter
     (fun (num, env, loc) ->
       fprintf oc "  | ";
-      fprintf oc "%d -> (\n" num;
-      output_env oc env ;
-      copy_chunk sourcefile ic oc oci loc;
-      fprintf oc ")\n")
+      fprintf oc "%d ->\n" num;
+      output_env oc env;
+      copy_chunk sourcefile ic oc oci loc true;
+      fprintf oc "\n")
     e.auto_actions;
   fprintf oc "  | n -> lexbuf.Lexing.refill_buff lexbuf; \
                                 __ocaml_lex_%s_rec %alexbuf n\n\n"
@@ -125,7 +125,7 @@ let output_lexdef sourcefile ic oc oci header tables entry_points trailer =
     Printf.printf "%d additional bytes used for bindings\n" size_groups ;
   flush stdout;
   if Array.length tables.tbl_trans > 0x8000 then raise Table_overflow;
-  copy_chunk sourcefile ic oc oci header;
+  copy_chunk sourcefile ic oc oci header false;
   output_tables oc tables;
   begin match entry_points with
     [] -> ()
@@ -136,4 +136,4 @@ let output_lexdef sourcefile ic oc oci header tables entry_points trailer =
         entries;
       output_string oc ";;\n\n";
   end;
-  copy_chunk sourcefile ic oc oci trailer
+  copy_chunk sourcefile ic oc oci trailer false
diff --git a/lex/outputbis.ml b/lex/outputbis.ml
index 32c1e6ed90..be1c6af5d5 100644
--- a/lex/outputbis.ml
+++ b/lex/outputbis.ml
@@ -156,25 +156,30 @@ let output_automata oc auto =
 let output_entry sourcefile ic oc tr e =
   let init_num, init_moves = e.auto_initial_state in
   fprintf oc "%s %alexbuf =
- __ocaml_lex_init_lexbuf lexbuf %d; %a  match __ocaml_lex_state%d lexbuf with\n"
+  __ocaml_lex_init_lexbuf lexbuf %d; %a
+  let __ocaml_lex_result = __ocaml_lex_state%d lexbuf in
+  lexbuf.Lexing.lex_start_p <- lexbuf.Lexing.lex_curr_p;
+  lexbuf.Lexing.lex_curr_p <- {lexbuf.Lexing.lex_curr_p with
+    Lexing.pos_cnum = lexbuf.Lexing.lex_abs_pos + lexbuf.Lexing.lex_curr_pos};
+  match __ocaml_lex_result with\n"
       e.auto_name output_args e.auto_args
       e.auto_mem_size (output_memory_actions "  ") init_moves init_num ;
   List.iter
     (fun (num, env, loc) ->
       fprintf oc "  | ";
-      fprintf oc "%d -> (\n" num;
+      fprintf oc "%d ->\n" num;
       output_env oc env ;
-      copy_chunk sourcefile ic oc tr loc;
-      fprintf oc ")\n")
+      copy_chunk sourcefile ic oc tr loc true;
+      fprintf oc "\n")
     e.auto_actions;
-  fprintf oc "  | _ -> raise (Failure \"lexing: empty token\") \n\n\n"
+  fprintf oc "  | _ -> raise (Failure \"lexing: empty token\")\n\n\n"
 
 
 (* Main output function *)
 
 let output_lexdef sourcefile ic oc tr header entry_points transitions trailer =
 
-  copy_chunk sourcefile ic oc tr header;
+  copy_chunk sourcefile ic oc tr header false;
   output_automata oc transitions ;
   begin match entry_points with
     [] -> ()
@@ -185,4 +190,4 @@ let output_lexdef sourcefile ic oc tr header entry_points transitions trailer =
         entries;
       output_string oc ";;\n\n";
   end;
-  copy_chunk sourcefile ic oc tr trailer
+  copy_chunk sourcefile ic oc tr trailer false