Source file batCharParser.ml

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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
(*
 * CharParser - Parsing character strings
 * Copyright (C) 2008 David Teller
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version,
 * with the special exception on linking described in file LICENSE.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)


open BatParserCo

(** {6 Entry point} *)
type position =
  {
    offset: int;
    line:   int
  }
let start_position =
  { offset = 1;
    line   = 1 }

let advance c p =
  if BatChar.is_newline c then ((*Printf.eprintf "[Have reached line %i]\n%!" (p.line + 1);*) { offset = 1; line = p.line + 1})
  else                      { (p) with offset = p.offset + 1}

let source_of_enum   s = Source.of_enum s start_position advance

let source_of_string s = source_of_enum (BatString.enum s)

let parse p s =
  run p (source_of_string s)

(*let parse_enum p e =
  let latest = ref "" in
  let lines  = lines_of (input_enum e) in
  let chars  = BatEnum.concat (BatEnum.from (fun () -> match get lines with
    | None   -> raise BatEnum.No_more_elements
    | Some l -> latest := l;
    String.enum l)) in
  let source = source_of_enum chars in
    match run p source with
      | Std.Ok _ as result -> result
      | Std.Error report   -> Std.Error (report, ?(*Furthest position*), ?(*List of labels at that point*), !latest)*)

(** {6 Utilities}*)
let char   c = label ("\"" ^ BatString.of_char c ^ "\"") (exactly c)

let string s = label ("\"" ^ s ^ "\"") (
    let len = String.length s in
    let rec aux i =
      if i < len then exactly s.[i] >>= fun _ -> aux (i+1)
      else return s
    in aux 0
  )

let case_char c =
  if BatChar.is_letter c then
    one_of
##V<5##  [Char.uppercase c;       Char.lowercase c]
##V>=5## [Char.uppercase_ascii c; Char.lowercase_ascii c]
  else char c

let case_string s = label ("case insensitive \"" ^ s ^ "\"") (
    let s'  =
##V<5##  String.lowercase
##V>=5## String.lowercase_ascii
        s in
    let len = String.length s'   in
    let rec aux i =
      if i < len then case_char s'.[i] >>= fun _ -> aux (i+1)
      else return s
    in aux 0
  )

let whitespace = satisfy BatChar.is_whitespace

let uppercase = label "upper case char" (satisfy BatChar.is_uppercase)
let lowercase = label "lower case char" (satisfy BatChar.is_lowercase)
let letter    = label "letter" (satisfy BatChar.is_letter)

let uppercase_latin1   = label "upper case char (possibly accentuated)"
    ( satisfy BatChar.is_uppercase_latin1 )

let lowercase_latin1   = label "lower case char (possibly accentuated)"
    ( satisfy BatChar.is_lowercase_latin1 )
let latin1    = label "letter (possibly accentuated)" (satisfy BatChar.is_latin1)

let digit = label "digit"
    ( satisfy BatChar.is_digit)

let hex = label "hex"
    ( satisfy (fun x -> ( '0' <= x && x <= '9' ) || ('a' <= x && x <= 'f') || ('A' <= x && x <= 'F')))

let not_char c = label ("anything but '" ^ BatString.of_char c ^ "'")
    (satisfy (fun x -> x <> c) (*>>=
                                 fun x -> Printf.eprintf "(%c)\n" x; return x*)
    )

let none_of l = label (
    BatString.of_list (BatVect.to_list (BatVect.append ']'
          (List.fold_left (fun acc x -> BatVect.append x acc)
             (BatVect.of_list (BatString.to_list "anything but ['"))
             l))))
    (none_of l)

let newline = satisfy BatChar.is_newline