1 files changed, 48 insertions, 11 deletions
diff --git a/camlp4/lib/stdpp.ml b/camlp4/lib/stdpp.ml
index bdd8cb9d2..a89cb15d8 100644
--- a/camlp4/lib/stdpp.ml
+++ b/camlp4/lib/stdpp.ml
@@ -23,20 +23,57 @@ value raise_with_loc loc exc =
 value line_of_loc fname (bp, ep) =
   try
     let ic = open_in_bin fname in
-    let rec loop lin col cnt =
-      if cnt < bp then
-        let (lin, col) =
-          match input_char ic with
-          [ '\n' -> (lin + 1, 0)
-          | _ -> (lin, col + 1) ]
-        in
-        loop lin col (cnt + 1)
-      else (lin, col, col + ep - bp)
+    let strm = Stream.of_channel ic in
+    let rec loop fname lin =
+      let rec not_a_line_dir col =
+        parser cnt
+          [: `c; s :] ->
+            if cnt < bp then
+              if c = '\n' then loop fname (lin + 1)
+              else not_a_line_dir (col + 1) s
+            else
+              let col = col - (cnt - bp) in
+              (fname, lin, col, col + ep - bp)
+      in
+      let rec a_line_dir str n col =
+        parser
+        [ [: `'\n' :] -> loop str n
+        | [: `_; s :] -> a_line_dir str n (col + 1) s ]
+      in
+      let rec spaces col =
+        parser
+        [ [: `' '; s :] -> spaces (col + 1) s
+        | [: :] -> col ]
+      in
+      let rec check_string str n col =
+        parser
+        [ [: `'"'; col = spaces (col + 1); s :] -> a_line_dir str n col s
+        | [: `c when c <> '\n'; s :] ->
+            check_string (str ^ String.make 1 c) n (col + 1) s
+        | [: a = not_a_line_dir col :] -> a ]
+      in
+      let check_quote n col =
+        parser
+        [ [: `'"'; s :] -> check_string "" n (col + 1) s
+        | [: a = not_a_line_dir col :] -> a ]
+      in
+      let rec check_num n col =
+        parser
+        [ [: `('0'..'9' as c); s :] ->
+            check_num (10 * n + Char.code c - Char.code '0') (col + 1) s
+        | [: col = spaces col; s :] -> check_quote n col s ]
+      in
+      let begin_line =
+        parser
+        [ [: `'#'; col = spaces 1; s :] -> check_num 0 col s
+        | [: a = not_a_line_dir 0 :] -> a ]
+      in
+      begin_line strm
     in
-    let r = try loop 1 0 0 with [ End_of_file -> (1, bp, ep) ] in
+    let r = try loop fname 1 with [ Stream.Failure -> (fname, 1, bp, ep) ] in
     do { close_in ic; r }
   with
-  [ Sys_error _ -> (1, bp, ep) ]
+  [ Sys_error _ -> (fname, 1, bp, ep) ]
 ;
 
 value loc_name = ref "loc";