From 056690707e94147c6470c9a5a13ddf85cf001015 Mon Sep 17 00:00:00 2001
From: Damien Doligez <damien.doligez-inria.fr>
Date: Jul 11 2013 15:51:25 +0000
Subject: PR#5765: ocamllex doesn't preserve line directives


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

---

diff --git a/Changes b/Changes
index 15c32b2..ee8c54d 100644
--- a/Changes
+++ b/Changes
@@ -95,6 +95,7 @@ Bug fixes:
 - PR#5752: missing dependencies at byte-code link with mlpack
 - PR#5758: Compiler bug when matching on floats
 - PR#5763: ocamlbuild does not give correct flags when running menhir
+- PR#5765: ocamllex doesn't preserve line directives
 - PR#5772: problem with marshaling of mutually-recursive functions
 - PR#5775: several bug fixes for tools/pprintast.ml
 - PR#5784: -dclambda option is ignored
diff --git a/lex/common.ml b/lex/common.ml
index d52cbb9..36f8225 100644
--- a/lex/common.ml
+++ b/lex/common.ml
@@ -68,9 +68,9 @@ let copy_chars =
     "Win32" | "Cygwin" -> copy_chars_win32
   | _       -> copy_chars_unix
 
-let copy_chunk sourcefile ic oc trl loc add_parens =
+let copy_chunk ic oc trl loc add_parens =
   if loc.start_pos < loc.end_pos || add_parens then begin
-    fprintf oc "# %d \"%s\"\n" loc.start_line sourcefile;
+    fprintf oc "# %d \"%s\"\n" loc.start_line loc.loc_file;
     if add_parens then begin
       for _i = 1 to loc.start_col - 1 do output_char oc ' ' done;
       output_char oc '(';
@@ -122,7 +122,7 @@ let output_tag_access oc = function
   | Sum (a,i) ->
       fprintf oc "(%a + %d)" output_base_mem a i
 
-let output_env sourcefile ic oc tr env =
+let output_env ic oc tr env =
   let pref = ref "let" in
   match env with
   | [] -> ()
@@ -138,7 +138,7 @@ let output_env sourcefile ic oc tr env =
       List.iter
         (fun ((x,pos),v) ->
           fprintf oc "%s\n" !pref ;
-          copy_chunk sourcefile ic oc tr pos false ;
+          copy_chunk ic oc tr pos false ;
           begin match v with
           | Ident_string (o,nstart,nend) ->
               fprintf oc
diff --git a/lex/common.mli b/lex/common.mli
index f85baa0..c71febe 100644
--- a/lex/common.mli
+++ b/lex/common.mli
@@ -14,13 +14,12 @@ type line_tracker;;
 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 -> bool -> unit
 val output_mem_access : out_channel -> int -> unit
 val output_memory_actions :
   string -> out_channel -> Lexgen.memory_action list -> unit
 val output_env :
-    string -> in_channel -> out_channel -> line_tracker ->
+    in_channel -> out_channel -> line_tracker ->
       (Lexgen.ident * Lexgen.ident_info) list -> unit
 val output_args : out_channel -> string list -> unit
 
diff --git a/lex/lexer.mll b/lex/lexer.mll
index 699c859..8fc472e 100644
--- a/lex/lexer.mll
+++ b/lex/lexer.mll
@@ -166,12 +166,13 @@ rule main = parse
     }
   | '{'
     { let p = Lexing.lexeme_end_p lexbuf in
+      let f = p.Lexing.pos_fname in
       let n1 = p.Lexing.pos_cnum
       and l1 = p.Lexing.pos_lnum
       and s1 = p.Lexing.pos_bol in
       brace_depth := 1;
       let n2 = handle_lexical_error action lexbuf in
-      Taction({start_pos = n1; end_pos = n2;
+      Taction({loc_file = f; start_pos = n1; end_pos = n2;
                start_line = l1; start_col = n1 - s1}) }
   | '='  { Tequal }
   | '|'  { Tor }
diff --git a/lex/output.ml b/lex/output.ml
index ae1df0e..d99f2f9 100644
--- a/lex/output.ml
+++ b/lex/output.ml
@@ -92,8 +92,8 @@ let output_entry sourcefile ic oc oci e =
     (fun (num, env, loc) ->
       fprintf oc "  | ";
       fprintf oc "%d ->\n" num;
-      output_env sourcefile ic oc oci env;
-      copy_chunk sourcefile ic oc oci loc true;
+      output_env ic oc oci env;
+      copy_chunk ic oc oci loc true;
       fprintf oc "\n")
     e.auto_actions;
   fprintf oc "  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; \
@@ -123,7 +123,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 false;
+  copy_chunk ic oc oci header false;
   output_tables oc tables;
   begin match entry_points with
     [] -> ()
@@ -134,4 +134,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 false
+  copy_chunk ic oc oci trailer false
diff --git a/lex/outputbis.ml b/lex/outputbis.ml
index 57851ab..7e8cba6 100644
--- a/lex/outputbis.ml
+++ b/lex/outputbis.ml
@@ -165,8 +165,8 @@ let output_entry sourcefile ic oc tr e =
     (fun (num, env, loc) ->
       fprintf oc "  | ";
       fprintf oc "%d ->\n" num;
-      output_env sourcefile ic oc tr env ;
-      copy_chunk sourcefile ic oc tr loc true;
+      output_env ic oc tr env ;
+      copy_chunk ic oc tr loc true;
       fprintf oc "\n")
     e.auto_actions;
   fprintf oc "  | _ -> raise (Failure \"lexing: empty token\")\n\n\n"
@@ -176,7 +176,7 @@ let output_entry sourcefile ic oc tr e =
 
 let output_lexdef sourcefile ic oc tr header entry_points transitions trailer =
 
-  copy_chunk sourcefile ic oc tr header false;
+  copy_chunk ic oc tr header false;
   output_automata oc transitions ;
   begin match entry_points with
     [] -> ()
@@ -187,4 +187,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 false
+  copy_chunk ic oc tr trailer false
diff --git a/lex/parser.mly b/lex/parser.mly
index fe8260d..b42cced 100644
--- a/lex/parser.mly
+++ b/lex/parser.mly
@@ -74,7 +74,8 @@ header:
     Taction
         { $1 }
   | /*epsilon*/
-        { { start_pos = 0; end_pos = 0; start_line = 1; start_col = 0 } }
+        { { loc_file = ""; start_pos = 0; end_pos = 0; start_line = 1;
+            start_col = 0 } }
 ;
 named_regexps:
     named_regexps Tlet Tident Tequal regexp
@@ -162,6 +163,7 @@ regexp:
         {let p1 = Parsing.rhs_start_pos 3
          and p2 = Parsing.rhs_end_pos 3 in
          let p = {
+           loc_file = p1.Lexing.pos_fname ;
            start_pos = p1.Lexing.pos_cnum ;
            end_pos = p2.Lexing.pos_cnum ;
            start_line = p1.Lexing.pos_lnum ;
diff --git a/lex/syntax.ml b/lex/syntax.ml
index afa6ac3..72f101e 100644
--- a/lex/syntax.ml
+++ b/lex/syntax.ml
@@ -15,11 +15,13 @@
 
 (* The shallow abstract syntax *)
 
-type location =
-    { start_pos: int;
-      end_pos: int;
-      start_line: int;
-      start_col: int }
+type location = {
+  loc_file : string;
+  start_pos : int;
+  end_pos : int;
+  start_line : int;
+  start_col : int;
+}
 
 type regular_expression =
     Epsilon
diff --git a/lex/syntax.mli b/lex/syntax.mli
index d186f12..55c3c11 100644
--- a/lex/syntax.mli
+++ b/lex/syntax.mli
@@ -12,11 +12,13 @@
 
 (* The shallow abstract syntax *)
 
-type location =
-    { start_pos: int;
-      end_pos: int;
-      start_line: int;
-      start_col: int }
+type location = {
+  loc_file : string;
+  start_pos : int;
+  end_pos : int;
+  start_line : int;
+  start_col : int;
+}
 
 type regular_expression =
     Epsilon