diff --git a/camlp4/CHANGES b/camlp4/CHANGES index d27b1bf64..c4eecc2ec 100644 --- a/camlp4/CHANGES +++ b/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). diff --git a/camlp4/camlp4/argl.ml b/camlp4/camlp4/argl.ml index df62270e5..066710480 100644 --- a/camlp4/camlp4/argl.ml +++ b/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 () } diff --git a/camlp4/lib/stdpp.ml b/camlp4/lib/stdpp.ml index 3593ceca5..bdd8cb9d2 100644 --- a/camlp4/lib/stdpp.ml +++ b/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"; diff --git a/camlp4/lib/stdpp.mli b/camlp4/lib/stdpp.mli index ce956d58e..a5f3f2828 100644 --- a/camlp4/lib/stdpp.mli +++ b/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] *) - diff --git a/camlp4/ocaml_src/camlp4/argl.ml b/camlp4/ocaml_src/camlp4/argl.ml index 6c50c734b..b7d01ff9d 100644 --- a/camlp4/ocaml_src/camlp4/argl.ml +++ b/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) ;; diff --git a/camlp4/ocaml_src/lib/stdpp.ml b/camlp4/ocaml_src/lib/stdpp.ml index c4f28e6af..0830e6842 100644 --- a/camlp4/ocaml_src/lib/stdpp.ml +++ b/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";; diff --git a/camlp4/ocaml_src/lib/stdpp.mli b/camlp4/ocaml_src/lib/stdpp.mli index 21ed83206..7ce86bc01 100644 --- a/camlp4/ocaml_src/lib/stdpp.mli +++ b/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] *) - diff --git a/camlp4/ocpp/ocpp.ml b/camlp4/ocpp/ocpp.ml index 1bc913a82..f36f12414 100644 --- a/camlp4/ocpp/ocpp.ml +++ b/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 "";