Source file `json.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
(*********************************************************************************)
(*                Higlo                                                          *)
(*                                                                               *)
(*    Copyright (C) 2014-2021 Institut National de Recherche en Informatique     *)
(*    et en Automatique. All rights reserved.                                    *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU Lesser General Public License version        *)
(*    3 as published by the Free Software Foundation.                            *)
(*                                                                               *)
(*    This program 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 Library General Public License for more details.                       *)
(*                                                                               *)
(*    You should have received a copy of the GNU Lesser General Public           *)
(*    License along with this program; if not, write to the Free Software        *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*                                                                               *)
(*********************************************************************************)

open Lang

let lexeme lb = Sedlexing.(Utf8.lexeme lb, lexeme_length lb);;
let sedlexeme = Sedlexing.Utf8.lexeme;;

let digit = [%sedlex.regexp? ('0'..'9') | '_']
let hex = [%sedlex.regexp? digit | ('A'..'F') | ('a'..'f')]
let integer = [%sedlex.regexp? Plus(digit)]
let decimal = [%sedlex.regexp? Star('0'..'9'), '.', Plus('0'..'9')]
let exponent = [%sedlex.regexp? ('e'|'E'), Opt('+'|'-'), Plus('0'..'9')]
let double = [%sedlex.regexp?
    Plus('0'..'9'), '.', Star('0'..'9'), exponent
  | '.', Plus('0'..'9'), exponent
  | Plus('0'..'9'), exponent]
let integer_positive = [%sedlex.regexp? '+',integer]
let decimal_positive = [%sedlex.regexp? '+',decimal]
let double_positive = [%sedlex.regexp? '+',double]
let integer_negative = [%sedlex.regexp? '-',integer]
let decimal_negative = [%sedlex.regexp? '-',decimal]
let double_negative = [%sedlex.regexp? '-',double]

let binary = [%sedlex.regexp? "0b", Plus('0' | '1')]
let octal = [%sedlex.regexp? "0o", Plus('0'..'7')]
let hexa = [%sedlex.regexp? "0x", Plus(hex)]

let numeric = [%sedlex.regexp?
    integer_positive | decimal_positive | double_positive
  | integer_negative | decimal_negative | double_negative
  | integer | decimal | double | binary | octal | hexa]

let boolean = [%sedlex.regexp? "true" | "false"]
let echar = [%sedlex.regexp? 't' | 'b' | 'n' | 'r' | 'f' | '\\' | '"' | '\'']

let escaped_char = [%sedlex.regexp? '\\', echar]
let string = [%sedlex.regexp? '"', Star(Compl(0x22) | escaped_char), '"']
let char = [%sedlex.regexp? "'", (Compl(0x27) | escaped_char ), "'"]

let space = [%sedlex.regexp? Plus(' '|'\n'|'\t'|'\r')]

let capchar = [%sedlex.regexp? 'A'..'Z']
let lowchar = [%sedlex.regexp? 'a'..'z']
let idchar = [%sedlex.regexp? lowchar | capchar | '_' | digit]

let id = [%sedlex.regexp? ('_'|lowchar), Star(idchar)]

let obj_field = [%sedlex.regexp? (id|string),Opt(space),":"]

let rec main lexbuf = match%sedlex lexbuf with
| '{' | '}' -> [Symbol(0, lexeme lexbuf)]
| '[' | ']' -> [Symbol(0, lexeme lexbuf)]
| ',' -> [Symbol(0, lexeme lexbuf)]
| space -> [Text (lexeme lexbuf)]
| numeric -> [Numeric (lexeme lexbuf)]
| boolean -> [Constant (lexeme lexbuf)]
| obj_field -> Sedlexing.rollback lexbuf ; obj_field lexbuf
| id -> [Keyword (1,lexeme lexbuf)]
| string -> [String (lexeme lexbuf)]
| char -> [String (lexeme lexbuf)]
| eof -> []
| any -> [Text (lexeme lexbuf)]
| _ -> failwith "Invalid state"

and obj_field lexbuf = match%sedlex lexbuf with
| id | string ->
  let t = Keyword (1,lexeme lexbuf) in
  t :: obj_field lexbuf
| space ->
  let t = Text (lexeme lexbuf) in
  t :: obj_field lexbuf
| ':' -> [Symbol(0, lexeme lexbuf)]
| _ -> Sedlexing.rollback lexbuf; main lexbuf

let () = Lang.register_lang "json" main