summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDaniel de Rauglaudre <daniel.de_rauglaudre@inria.fr>2002-02-03 05:52:15 +0000
committerDaniel de Rauglaudre <daniel.de_rauglaudre@inria.fr>2002-02-03 05:52:15 +0000
commit544e933c4a430372734fc64d5470fdb50ed29cdf (patch)
tree08e003d5fdb7210bd481bdaeca64c851aa08f56b
parent3aec22d7b1efb5135d2bd30000155f3a887f2cdf (diff)
-
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4345 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
-rw-r--r--camlp4/CHANGES4
-rw-r--r--camlp4/camlp4/argl.ml23
-rw-r--r--camlp4/lib/stdpp.ml21
-rw-r--r--camlp4/lib/stdpp.mli8
-rw-r--r--camlp4/ocaml_src/camlp4/argl.ml28
-rw-r--r--camlp4/ocaml_src/lib/stdpp.ml24
-rw-r--r--camlp4/ocaml_src/lib/stdpp.mli8
-rw-r--r--camlp4/ocpp/ocpp.ml17
8 files changed, 64 insertions, 69 deletions
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 "";