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
|
{
type v =
| ID of string
| STRING of string
| MULT of string list
| NONE
type stanza = (string * v) list
type t = stanza list
let string_buffer =
Buffer.create 128
let rec make_value lex_value lb =
match lex_value lb with
| `NL -> NONE
| `STRING s ->
begin
match make_value lex_value lb with
| NONE ->
STRING s
| STRING s2 ->
MULT [ s ; s2 ]
| MULT sl ->
MULT (s :: sl)
| ID _ ->
failwith "Basic_io_lexer: value"
end
| `ID id ->
match lex_value lb with
| `NL -> ID id
| _ -> failwith "Basic_io_lexer: value"
}
let id = ['a'-'f' '0'-'9']*
let ident = ['a'-'z' '_']+
let ws = [' ' '\t']+
let nl = [ '\n' ]
rule lex = parse
| ws { lex lexbuf }
| ident as k { let v = make_value lex_value lexbuf in
`TOK (k, v) }
| nl { `END_OF_STANZA }
| eof { `EOF }
and nl = parse
| ws { nl lexbuf }
| nl { () }
and lex_value = parse
| ws { lex_value lexbuf }
| nl { `NL }
| '[' (id as id) ']' { `ID id }
| '"' { Buffer.clear string_buffer ;
`STRING (string lexbuf) }
and string = parse
| '"' { Buffer.contents string_buffer }
| '\\' ['"' '\\'] { Buffer.add_char
string_buffer
(Lexing.lexeme_char lexbuf 1) ;
string lexbuf }
| [^ '"' '\\']+ { let off = lexbuf.Lexing.lex_start_pos in
let len = lexbuf.Lexing.lex_curr_pos - off in
Buffer.add_substring
string_buffer
lexbuf.Lexing.lex_buffer
off len ;
string lexbuf }
{
let rec _get_stanza acc lb =
match lex lb with
| `TOK ((k, _) as v) ->
_get_stanza (v :: acc) lb
| `END_OF_STANZA when acc = [] ->
_get_stanza acc lb
| `EOF
| `END_OF_STANZA as e ->
e, List.rev acc
let get_stanza lb =
match _get_stanza [] lb with
| `EOF, [] ->
None
| _, st ->
Some st
let rec _parse acc lb =
match _get_stanza [] lb with
| `EOF, [] ->
List.rev acc
| `EOF, st ->
List.rev (st :: acc)
| `END_OF_STANZA, st ->
assert (st <> []) ;
_parse (st :: acc) lb
let parse lb =
_parse [] lb
let string_of_elem = function
| MULT (s :: _)
| STRING s
| ID s -> s
| MULT []
| NONE -> ""
}
|
