summaryrefslogtreecommitdiff
path: root/camlp4/ocaml_src/lib/stdpp.ml
blob: d91ee78c0787b3dd3853c00f685b938c3465ddb2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
(* camlp4r *)
(***********************************************************************)
(*                                                                     *)
(*                             Camlp4                                  *)
(*                                                                     *)
(*        Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt     *)
(*                                                                     *)
(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
(*  Automatique.  Distributed only by permission.                      *)
(*                                                                     *)
(***********************************************************************)

(* This file has been generated by program: do not edit! *)

exception Exc_located of (int * int) * exn;;

let raise_with_loc loc exc =
  match exc with
    Exc_located (_, _) -> raise exc
  | _ -> raise (Exc_located (loc, exc))
;;

let 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
            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
      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
      in
      let rec spaces col (strm__ : _ Stream.t) =
        match Stream.peek strm__ with
          Some ' ' -> Stream.junk strm__; spaces (col + 1) strm__
        | _ -> 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__
      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__
      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__
      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__
      in
      begin_line strm
    in
    let r =
      try loop fname 1 with
        Stream.Failure -> fname, 1, bp, ep
    in
    close_in ic; r
  with
    Sys_error _ -> fname, 1, bp, ep
;;

let loc_name = ref "loc";;