-

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

camlp4/CHANGES

@@ -1,7 +1,9 @@
 Camlp4 Version 3.04+5
 ---------------------
 
-- [01 Fev 02] Fixed bug in token.ml: the location function provided by
+- [03 Feb 02] Added function Stdpp.line_of_loc returning the line and
+  columns positions from a character location and a file.
+- [01 Feb 02] Fixed bug in token.ml: the location function provided by
   lexer_func_of_parser, lexer_func_of_ocamllex and make_stream_and_location
   could raise Invalid_argument "Array.make" for big files if the number
   of read tokens overflows the maximum arrays size (Sys.max_array_length).

camlp4/camlp4/argl.ml

@@ -62,24 +62,6 @@ value rec parse_aux spec_list anon_fun =
       else do { (anon_fun s : unit); parse_aux spec_list anon_fun sl } ]
 ;
 
-value line_of_loc fname (bp, ep) =
-  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)
-  in
-  let r =
-    try loop 1 0 0 with e -> do { try close_in ic with _ -> (); raise e }
-  in
-  do { try close_in ic with _ -> (); r }
-;
-
 value loc_fmt =
   match Sys.os_type with
   [ "MacOS" ->
@@ -89,7 +71,7 @@ value loc_fmt =
 
 value print_location loc =
   if Pcaml.input_file.val <> "-" then
-    let (line, bp, ep) = line_of_loc Pcaml.input_file.val loc in
+    let (line, bp, ep) = Stdpp.line_of_loc Pcaml.input_file.val loc in
     eprintf loc_fmt Pcaml.input_file.val line bp ep
   else eprintf "At location %d-%d\n" (fst loc) (snd loc)
 ;
@@ -118,8 +100,7 @@ value process pa pr getdir =
                 | (loc, "directory", Some <:expr< $str:s$ >>) ->
                     Odyl_main.directory s
                 | (loc, _, _) ->
-                    Stdpp.raise_with_loc loc
-                      (Stream.Error "bad directive") ]
+                    Stdpp.raise_with_loc loc (Stream.Error "bad directive") ]
             | None -> () ];
             pl @ loop ()
           }

camlp4/lib/stdpp.ml

@@ -5,7 +5,7 @@
 (*                                                                     *)
 (*        Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
-(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
+(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
 (*  Automatique.  Distributed only by permission.                      *)
 (*                                                                     *)
 (***********************************************************************)
@@ -20,4 +20,23 @@ value raise_with_loc loc exc =
   | _ -> raise (Exc_located 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)
+    in
+    let r = try loop 1 0 0 with [ End_of_file -> (1, bp, ep) ] in
+    do { close_in ic; r }
+  with
+  [ Sys_error _ -> (1, bp, ep) ]
+;
+
 value loc_name = ref "loc";

camlp4/lib/stdpp.mli

@@ -5,7 +5,7 @@
 (*                                                                     *)
 (*        Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
-(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
+(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
 (*  Automatique.  Distributed only by permission.                      *)
 (*                                                                     *)
 (***********************************************************************)
@@ -25,7 +25,11 @@ value raise_with_loc : (int * int) -> exn -> 'a;
     (* [raise_with_loc loc e], if [e] is already the exception [Exc_located],
        re-raise it, else raise the exception [Exc_located loc e]. *)
 
+value line_of_loc : string -> (int * int) -> (int * int * int);
+    (* [line_of_loc fname loc] reads the file [fname] up to the
+       location [loc] and returns the line number and the characters
+       location in the line *)
+
 value loc_name : ref string;
     (* Name of the location variable used in grammars and in the predefined
        quotations for OCaml syntax trees. Default: [loc] *)
-

camlp4/ocaml_src/camlp4/argl.ml

@@ -66,32 +66,6 @@ let rec parse_aux spec_list anon_fun =
       else begin (anon_fun s : unit); parse_aux spec_list anon_fun sl end
 ;;
 
-let line_of_loc fname (bp, ep) =
-  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
-  in
-  let r =
-    try loop 1 0 0 with
-      e ->
-        begin try close_in ic with
-          _ -> ()
-        end;
-        raise e
-  in
-  begin try close_in ic with
-    _ -> ()
-  end;
-  r
-;;
-
 let loc_fmt =
   match Sys.os_type with
     "MacOS" ->
@@ -102,7 +76,7 @@ let loc_fmt =
 
 let print_location loc =
   if !(Pcaml.input_file) <> "-" then
-    let (line, bp, ep) = line_of_loc !(Pcaml.input_file) loc in
+    let (line, bp, ep) = Stdpp.line_of_loc !(Pcaml.input_file) loc in
     eprintf loc_fmt !(Pcaml.input_file) line bp ep
   else eprintf "At location %d-%d\n" (fst loc) (snd loc)
 ;;

camlp4/ocaml_src/lib/stdpp.ml

@@ -5,7 +5,7 @@
 (*                                                                     *)
 (*        Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
-(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
+(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
 (*  Automatique.  Distributed only by permission.                      *)
 (*                                                                     *)
 (***********************************************************************)
@@ -20,4 +20,26 @@ let raise_with_loc loc exc =
   | _ -> raise (Exc_located (loc, exc))
 ;;
 
+let 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
+    in
+    let r =
+      try loop 1 0 0 with
+        End_of_file -> 1, bp, ep
+    in
+    close_in ic; r
+  with
+    Sys_error _ -> 1, bp, ep
+;;
+
 let loc_name = ref "loc";;

camlp4/ocaml_src/lib/stdpp.mli

@@ -5,7 +5,7 @@
 (*                                                                     *)
 (*        Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
-(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
+(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
 (*  Automatique.  Distributed only by permission.                      *)
 (*                                                                     *)
 (***********************************************************************)
@@ -25,7 +25,11 @@ val raise_with_loc : int * int -> exn -> 'a;;
     (* [raise_with_loc loc e], if [e] is already the exception [Exc_located],
        re-raise it, else raise the exception [Exc_located loc e]. *)
 
+val line_of_loc : string -> int * int -> int * int * int;;
+    (* [line_of_loc fname loc] reads the file [fname] up to the
+       location [loc] and returns the line number and the characters
+       location in the line *)
+
 val loc_name : string ref;;
     (* Name of the location variable used in grammars and in the predefined
        quotations for OCaml syntax trees. Default: [loc] *)
-

camlp4/ocpp/ocpp.ml

@@ -5,7 +5,7 @@
 (*                                                                     *)
 (*        Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt     *)
 (*                                                                     *)
-(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
+(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
 (*  Automatique.  Distributed only by permission.                      *)
 (*                                                                     *)
 (***********************************************************************)
@@ -102,16 +102,6 @@ and inside_string cs =
 
 value copy_quot cs = do { copy cs; flush stdout; };
 
-value find_line (bp, ep) ic =
-  find 0 1 0 where rec find i line col =
-    match try Some (input_char ic) with [ End_of_file -> None ] with
-    [ Some x ->
-        if i == bp then (line, col, col + ep - bp)
-        else if x == '\n' then find (succ i) (succ line) 0
-        else find (succ i) line (succ col)
-    | None -> (line, 0, col) ]
-;
-
 value loc_fmt =
   match Sys.os_type with
   [ "MacOS" ->
@@ -120,9 +110,8 @@ value loc_fmt =
 ;
 
 value print_location loc file =
-  let ic = open_in_bin file in
-  let (line, c1, c2) = find_line loc ic in
-  do { close_in ic; Printf.eprintf loc_fmt file line c1 c2; flush stderr; }
+  let (line, c1, c2) = Stdpp.line_of_loc file loc in
+  do { Printf.eprintf loc_fmt file line c1 c2; flush stderr; }
 ;
 
 value file = ref "";