« back to all changes in this revision
Viewing changes to lib/lexer.mll
- browse files at revision 12
- compare with another revision
- download diff
- download tarball
- view history from revision 12
- Committer: Package Import Robot
- Author(s): Stéphane Glondu
- Date: 2013-12-03 21:36:45 UTC
- mfrom: (11.1.1 experimental)
- Revision ID: package-import@ubuntu.com-20131203213645-h1if1c6hxual8p11
Tags: 109.20.00-2
* Team upload
* Upload to unstable
* Upload to unstable
- files added:
- .gitignore
- lib_test_ounit
- vim
- vim/syntax
- files removed:
- .hg_archival.txt
- doc
- files modified:
- Makefile
added
removed
lib/lexer.mll
1
1
{
2
(*****************************************************************************
3
* Sexplib *
4
* *
5
* Copyright (C) 2005- Jane Street Holding, LLC *
6
* Contact: opensource@janestreet.com *
7
* WWW: http://www.janestreet.com/ocaml *
8
* Author: Markus Mottl *
9
* *
10
* This library is free software; you can redistribute it and/or *
11
* modify it under the terms of the GNU Lesser General Public *
12
* License as published by the Free Software Foundation; either *
13
* version 2 of the License, or (at your option) any later version. *
14
* *
15
* This library is distributed in the hope that it will be useful, *
16
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
17
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
18
* Lesser General Public License for more details. *
19
* *
20
* You should have received a copy of the GNU Lesser General Public *
21
* License along with this library; if not, write to the Free Software *
22
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *
23
* *
24
*****************************************************************************)
25
26
2
(** Lexer: Lexer Specification for S-expressions *)
27
3
28
4
open Printf
29
5
open Lexing
30
open Parser
31
6
32
7
let char_for_backslash = function
33
| 'n' -> '\n'
34
| 't' -> '\t'
35
| 'b' -> '\b'
36
| 'r' -> '\r'
37
| c -> c
8
| 'n' -> '\010'
9
| 'r' -> '\013'
10
| 'b' -> '\008'
11
| 't' -> '\009'
12
| c -> c
38
13
39
let double_nl = "\013\010"
14
let lf = '\010'
40
15
41
16
let dec_code c1 c2 c3 =
42
17
100 * (Char.code c1 - 48) + 10 * (Char.code c2 - 48) + (Char.code c3 - 48)
54
29
else d2 - 48 in
55
30
val1 * 16 + val2
56
31
57
let found_newline lexbuf diff =
58
let curr_p = lexbuf.lex_curr_p in
32
let found_newline ({ lex_curr_p; _ } as lexbuf) diff =
59
33
lexbuf.lex_curr_p <-
60
34
{
61
curr_p with
62
pos_lnum = curr_p.pos_lnum + 1;
63
pos_bol = max 1 (curr_p.pos_cnum - diff);
35
lex_curr_p with
36
pos_lnum = lex_curr_p.pos_lnum + 1;
37
pos_bol = lex_curr_p.pos_cnum - diff;
64
38
}
65
39
66
let get_lexeme_len lexbuf = lexbuf.lex_curr_pos - lexbuf.lex_start_pos
40
(* same length computation as in [Lexing.lexeme] *)
41
let lexeme_len { lex_start_pos; lex_curr_pos; _ } = lex_curr_pos - lex_start_pos
42
43
let main_failure lexbuf msg =
44
let { pos_lnum; pos_bol; pos_cnum; pos_fname = _ } = lexeme_start_p lexbuf in
45
let msg =
46
sprintf
47
"Sexplib.Lexer.main: %s at line %d char %d"
48
msg pos_lnum (pos_cnum - pos_bol)
49
in
50
failwith msg
51
52
module type T = sig
53
module Quoted_string_buffer : sig
54
type t
55
val create : int -> t
56
val add_char : t -> char -> unit
57
val add_substring : t -> string -> int -> int -> unit
58
val add_lexeme : t -> lexbuf -> unit
59
val clear : t -> unit
60
val of_buffer : Buffer.t -> t
61
end
62
module Token : sig
63
type t
64
val lparen : t
65
val rparen : t
66
val eof : t
67
val simple_string : string -> t
68
val hash_semi : t
69
val quoted_string : Lexing.position -> Quoted_string_buffer.t -> t
70
type s = Quoted_string_buffer.t -> Lexing.lexbuf -> t
71
val comment : string -> main:s -> s
72
val block_comment : Lexing.position -> main:s -> s
73
end
74
end
75
76
module Make (X : T) : sig
77
val main : ?buf:Buffer.t -> Lexing.lexbuf -> X.Token.t
78
end = struct (* BEGIN FUNCTOR BODY CONTAINING GENERATED CODE *)
79
open X
67
80
}
68
81
69
let newline = ('\010' | '\013' | "\013\010")
70
let space = [' ' '\009' '\012']
71
let whitespace = [' ' '\010' '\013' '\009' '\012']
72
let backslash_escapes = ['\\' '"' '\'' 'n' 't' 'b' 'r']
82
let lf = '\010'
83
let lf_cr = ['\010' '\013']
84
let dos_newline = "\013\010"
85
let blank = [' ' '\009' '\012']
86
let unquoted = [^ ';' '(' ')' '"'] # blank # lf_cr
87
let digit = ['0'-'9']
88
let hexdigit = digit | ['a'-'f' 'A'-'F']
89
90
let unquoted_start =
91
unquoted # ['#' '|'] | '#' unquoted # ['|'] | '|' unquoted # ['#']
73
92
74
93
rule main buf = parse
75
| newline { found_newline lexbuf 1; main buf lexbuf }
76
| space+ | ';' [^ '\n' '\r']* { main buf lexbuf }
77
| '(' { LPAREN }
78
| ')' { RPAREN }
94
| lf | dos_newline { found_newline lexbuf 0;
95
main buf lexbuf }
96
| blank+ { main buf lexbuf }
97
| (';' (_ # lf_cr)*) as text { Token.comment text ~main buf lexbuf }
98
| '(' { Token.lparen }
99
| ')' { Token.rparen }
79
100
| '"'
80
101
{
81
scan_string buf lexbuf;
82
let str = Buffer.contents buf in
83
Buffer.clear buf;
84
STRING str
85
}
86
| ([^ ';' '(' ')' '"'] # whitespace)+ as str { STRING str }
87
| eof { EOF }
102
let pos = Lexing.lexeme_start_p lexbuf in
103
Quoted_string_buffer.add_lexeme buf lexbuf;
104
scan_string buf pos lexbuf;
105
let tok = Token.quoted_string pos buf in
106
Quoted_string_buffer.clear buf;
107
tok
108
}
109
| "#;" { Token.hash_semi }
110
| "#|"
111
{
112
let pos = Lexing.lexeme_start_p lexbuf in
113
Quoted_string_buffer.add_lexeme buf lexbuf;
114
scan_block_comment buf [pos] lexbuf;
115
let tok = Token.block_comment pos ~main buf lexbuf in
116
Quoted_string_buffer.clear buf;
117
tok
118
}
119
| "|#" { main_failure lexbuf "illegal end of comment" }
120
| "#" "#"+ "|" unquoted* (* unquoted_start can match ##, so ##| (which should be
121
refused) would not not be parsed by this case if the regexp
122
on the left was not there *)
123
| "|" "|"+ "#" unquoted*
124
| unquoted_start unquoted* ("#|" | "|#") unquoted*
125
{ main_failure lexbuf "comment tokens in unquoted atom" }
126
| "#" | "|" | unquoted_start unquoted* as str { Token.simple_string str }
127
| eof { Token.eof }
88
128
89
and scan_string buf = parse
90
| '"' { () }
91
| '\\' ['\010' '\013'] [' ' '\009']*
92
{
93
let len = get_lexeme_len lexbuf in
94
found_newline lexbuf (len - 2);
95
scan_string buf lexbuf
96
}
97
| '\\' "\013\010" [' ' '\009']*
98
{
99
let len = get_lexeme_len lexbuf in
100
found_newline lexbuf (len - 3);
101
scan_string buf lexbuf
102
}
103
| '\\' (backslash_escapes as c)
104
{
105
Buffer.add_char buf (char_for_backslash c);
106
scan_string buf lexbuf
107
}
108
| '\\' (['0'-'9'] as c1) (['0'-'9'] as c2) (['0'-'9'] as c3)
129
and scan_string buf start = parse
130
| '"' { Quoted_string_buffer.add_lexeme buf lexbuf; () }
131
| '\\' lf [' ' '\t']*
132
{
133
let len = lexeme_len lexbuf - 2 in
134
found_newline lexbuf len;
135
Quoted_string_buffer.add_lexeme buf lexbuf;
136
scan_string buf start lexbuf
137
}
138
| '\\' dos_newline [' ' '\t']*
139
{
140
let len = lexeme_len lexbuf - 3 in
141
found_newline lexbuf len;
142
Quoted_string_buffer.add_lexeme buf lexbuf;
143
scan_string buf start lexbuf
144
}
145
| '\\' (['\\' '\'' '"' 'n' 't' 'b' 'r' ' '] as c)
146
{
147
Quoted_string_buffer.add_char buf (char_for_backslash c);
148
Quoted_string_buffer.add_lexeme buf lexbuf;
149
scan_string buf start lexbuf
150
}
151
| '\\' (digit as c1) (digit as c2) (digit as c3)
109
152
{
110
153
let v = dec_code c1 c2 c3 in
111
154
if v > 255 then (
112
let pos = lexbuf.lex_curr_p in
155
let { pos_lnum; pos_bol; pos_cnum; pos_fname = _ } = lexeme_end_p lexbuf in
113
156
let msg =
114
157
sprintf
115
158
"Sexplib.Lexer.scan_string: \
116
159
illegal escape at line %d char %d: `\\%c%c%c'"
117
pos.pos_lnum (pos.pos_cnum - pos.pos_bol - 3)
160
pos_lnum (pos_cnum - pos_bol - 3)
118
161
c1 c2 c3 in
119
162
failwith msg);
120
Buffer.add_char buf (Char.chr v);
121
scan_string buf lexbuf
163
Quoted_string_buffer.add_char buf (Char.chr v);
164
Quoted_string_buffer.add_lexeme buf lexbuf;
165
scan_string buf start lexbuf
122
166
}
123
| '\\' 'x' (['0'-'9' 'a'-'f' 'A'-'F'] as c1) (['0'-'9' 'a'-'f' 'A'-'F'] as c2)
167
| '\\' 'x' (hexdigit as c1) (hexdigit as c2)
124
168
{
125
169
let v = hex_code c1 c2 in
126
if v > 255 then (
127
let pos = lexbuf.lex_curr_p in
128
let msg =
129
sprintf
130
"Sexplib.Lexer.scan_string: \
131
illegal escape at line %d char %d: `\\x%c%c'"
132
pos.pos_lnum (pos.pos_cnum - pos.pos_bol - 3)
133
c1 c2 in
134
failwith msg);
135
Buffer.add_char buf (Char.chr v);
136
scan_string buf lexbuf
170
Quoted_string_buffer.add_char buf (Char.chr v);
171
Quoted_string_buffer.add_lexeme buf lexbuf;
172
scan_string buf start lexbuf
137
173
}
138
174
| '\\' (_ as c)
139
175
{
140
Buffer.add_char buf '\\';
141
Buffer.add_char buf c;
142
scan_string buf lexbuf
143
}
144
| ['\010' '\013'] as c
145
{
146
found_newline lexbuf 1;
147
Buffer.add_char buf c;
148
scan_string buf lexbuf
149
}
150
| "\013\010"
151
{
152
found_newline lexbuf 2;
153
Buffer.add_string buf double_nl;
154
scan_string buf lexbuf
155
}
156
| [^ '\\' '"']+
176
Quoted_string_buffer.add_char buf '\\';
177
Quoted_string_buffer.add_char buf c;
178
Quoted_string_buffer.add_lexeme buf lexbuf;
179
scan_string buf start lexbuf
180
}
181
| lf
182
{
183
found_newline lexbuf 0;
184
Quoted_string_buffer.add_char buf lf;
185
Quoted_string_buffer.add_lexeme buf lexbuf;
186
scan_string buf start lexbuf
187
}
188
| ([^ '\\' '"'] # lf)+
157
189
{
158
190
let ofs = lexbuf.lex_start_pos in
159
191
let len = lexbuf.lex_curr_pos - ofs in
160
Buffer.add_substring buf lexbuf.lex_buffer ofs len;
161
scan_string buf lexbuf
162
}
163
| eof { failwith "Sexplib.Lexer.scan_string: unterminated string" }
164
165
{
166
let main ?buf =
167
let buf =
168
match buf with
169
| None -> Buffer.create 64
170
| Some buf -> Buffer.clear buf; buf
171
in
172
main buf
192
Quoted_string_buffer.add_substring buf lexbuf.lex_buffer ofs len;
193
Quoted_string_buffer.add_lexeme buf lexbuf;
194
scan_string buf start lexbuf
195
}
196
| eof
197
{
198
let msg =
199
sprintf
200
"Sexplib.Lexer.scan_string: unterminated string at line %d char %d"
201
start.pos_lnum (start.pos_cnum - start.pos_bol)
202
in
203
failwith msg
204
}
205
206
and scan_block_comment buf locs = parse
207
| ('#'* | '|'*) lf
208
{ Quoted_string_buffer.add_lexeme buf lexbuf;
209
found_newline lexbuf 0; scan_block_comment buf locs lexbuf }
210
| (('#'* | '|'*) [^ '"' '#' '|'] # lf)+
211
{ Quoted_string_buffer.add_lexeme buf lexbuf;
212
scan_block_comment buf locs lexbuf }
213
| ('#'* | '|'*) '"'
214
{
215
Quoted_string_buffer.add_lexeme buf lexbuf;
216
let cur = lexeme_end_p lexbuf in
217
let start = { cur with pos_cnum = cur.pos_cnum - 1 } in
218
scan_string buf start lexbuf;
219
scan_block_comment buf locs lexbuf
220
}
221
| '#'+ '|'
222
{
223
Quoted_string_buffer.add_lexeme buf lexbuf;
224
let cur = lexeme_end_p lexbuf in
225
let start = { cur with pos_cnum = cur.pos_cnum - 2 } in
226
scan_block_comment buf (start :: locs) lexbuf
227
}
228
| '|'+ '#'
229
{
230
Quoted_string_buffer.add_lexeme buf lexbuf;
231
match locs with
232
| [_] -> () (* the comment is finished *)
233
| _ :: (_ :: _ as t) -> scan_block_comment buf t lexbuf
234
| [] -> assert false (* impossible *)
235
}
236
| eof
237
{
238
match locs with
239
| [] -> assert false
240
| { pos_lnum; pos_bol; pos_cnum; pos_fname = _ } :: _ ->
241
let msg =
242
sprintf "Sexplib.Lexer.scan_block_comment: \
243
unterminated block comment at line %d char %d"
244
pos_lnum (pos_cnum - pos_bol)
245
in
246
failwith msg
247
}
248
249
{ (* RESUME FUNCTOR BODY CONTAINING GENERATED CODE *)
250
251
let main ?buf =
252
let buf =
253
match buf with
254
| None -> Quoted_string_buffer.create 64
255
| Some buf ->
256
Buffer.clear buf;
257
Quoted_string_buffer.of_buffer buf
258
in
259
main buf
260
261
end (* END FUNCTOR BODY CONTAINING GENERATED CODE *)
262
263
module Vanilla =
264
Make (struct
265
module Quoted_string_buffer = struct
266
include Buffer
267
let add_lexeme _ _ = ()
268
let of_buffer b = b
269
end
270
module Token = struct
271
open Parser
272
type t = token
273
type s = Quoted_string_buffer.t -> Lexing.lexbuf -> t
274
let eof = EOF
275
let lparen = LPAREN
276
let rparen = RPAREN
277
let hash_semi = HASH_SEMI
278
let simple_string x = STRING x
279
let quoted_string _ buf = STRING (Buffer.contents buf)
280
let block_comment _pos ~main buf lexbuf =
281
main buf lexbuf
282
let comment _text ~main buf lexbuf =
283
main buf lexbuf (* skip and continue lexing *)
284
end
285
end)
286
287
module With_layout =
288
Make (struct
289
module Quoted_string_buffer = struct
290
type t = {
291
contents : Buffer.t;
292
lexeme : Buffer.t;
293
}
294
let create n = {contents = Buffer.create n; lexeme = Buffer.create n}
295
let of_buffer contents = { contents; lexeme = Buffer.create 64 }
296
let add_char t ch = Buffer.add_char t.contents ch
297
let add_substring t str ofs len = Buffer.add_substring t.contents str ofs len
298
let add_lexeme t lexbuf = Buffer.add_string t.lexeme (Lexing.lexeme lexbuf)
299
let clear t = Buffer.clear t.lexeme; Buffer.clear t.contents
300
end
301
module Token = struct
302
open Parser_with_layout
303
type t = token
304
type s = Quoted_string_buffer.t -> Lexing.lexbuf -> t
305
let eof = EOF
306
let lparen = LPAREN
307
let rparen = RPAREN
308
let hash_semi = HASH_SEMI
309
let simple_string x = STRING (x, None)
310
let quoted_string pos {Quoted_string_buffer.contents; lexeme} =
311
STRING (Buffer.contents contents, Some (pos, Buffer.contents lexeme))
312
let block_comment pos ~main:_ {Quoted_string_buffer.contents = _; lexeme} _lexbuf =
313
COMMENT (Buffer.contents lexeme, Some pos)
314
let comment text ~main:_ _buf _lexbuf =
315
COMMENT (text, None)
316
end
317
end)
318
319
let main = Vanilla.main
320
let main_with_layout = With_layout.main
321
173
322
}
Loggerhead is a web-based interface for Breezy
Version: 2.0.1