diff options
Diffstat (limited to 'camlp4/ocaml_src/lib/stdpp.ml')
| -rw-r--r-- | camlp4/ocaml_src/lib/stdpp.ml | 104 |
1 files changed, 46 insertions, 58 deletions
diff --git a/camlp4/ocaml_src/lib/stdpp.ml b/camlp4/ocaml_src/lib/stdpp.ml index d91ee78c07..ab80b24a99 100644 --- a/camlp4/ocaml_src/lib/stdpp.ml +++ b/camlp4/ocaml_src/lib/stdpp.ml @@ -12,7 +12,7 @@ (* This file has been generated by program: do not edit! *) -exception Exc_located of (int * int) * exn;; +exception Exc_located of Token.flocation * exn;; let raise_with_loc loc exc = match exc with @@ -21,79 +21,67 @@ let raise_with_loc loc exc = ;; let line_of_loc fname (bp, ep) = + bp.Lexing.pos_fname, bp.Lexing.pos_lnum, + bp.Lexing.pos_cnum - bp.Lexing.pos_bol, + ep.Lexing.pos_cnum - bp.Lexing.pos_bol +;; + +(* +value line_of_loc fname (bp, ep) = try let ic = open_in_bin fname in let strm = Stream.of_channel ic in let rec loop fname lin = - let rec not_a_line_dir col (strm__ : _ Stream.t) = - let cnt = Stream.count strm__ in - match Stream.peek strm__ with - Some c -> - Stream.junk strm__; - let s = strm__ in + 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 - | _ -> raise Stream.Failure + else + let col = col - (cnt - bp) in + (fname, lin, col, col + ep - bp) in - let rec a_line_dir str n col (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '\n' -> Stream.junk strm__; loop str n - | Some _ -> Stream.junk strm__; a_line_dir str n (col + 1) strm__ - | _ -> raise Stream.Failure + 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 (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ' ' -> Stream.junk strm__; spaces (col + 1) strm__ - | _ -> col + let rec spaces col = + parser + [ [: `' '; s :] -> spaces (col + 1) s + | [: :] -> col ] in - let rec check_string str n col (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '\"' -> - Stream.junk strm__; - let col = - try spaces (col + 1) strm__ with - Stream.Failure -> raise (Stream.Error "") - in - a_line_dir str n col strm__ - | Some c when c <> '\n' -> - Stream.junk strm__; - check_string (str ^ String.make 1 c) n (col + 1) strm__ - | _ -> not_a_line_dir col strm__ + 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 (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '\"' -> Stream.junk strm__; check_string "" n (col + 1) strm__ - | _ -> not_a_line_dir col strm__ + 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 (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ('0'..'9' as c) -> - Stream.junk strm__; - check_num (10 * n + Char.code c - Char.code '0') (col + 1) strm__ - | _ -> let col = spaces col strm__ in check_quote n col strm__ + 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 (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '#' -> - Stream.junk strm__; - let col = - try spaces 1 strm__ with - Stream.Failure -> raise (Stream.Error "") - in - check_num 0 col strm__ - | _ -> not_a_line_dir 0 strm__ + 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 fname 1 with - Stream.Failure -> fname, 1, bp, ep - in - close_in ic; r + let r = try loop fname 1 with [ Stream.Failure -> (fname, 1, bp, ep) ] in + do { close_in ic; r } with - Sys_error _ -> fname, 1, bp, ep -;; + [ Sys_error _ -> (fname, 1, bp, ep) ] +; +*) let loc_name = ref "loc";; |