blob: 723274c4adc1714ed8bf8cd8d0ea64cd70562212 (
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
|
(***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
{
let first_item = ref false
let command_beginning = ref 0
let add_semicolon () =
if !first_item
then first_item := false
else print_string "; "
let print_unescaped_string s =
let l = String.length s in
let i = ref 0 in
while !i < l do
if s.[!i] = '\\'
&& !i+1 < l
&& (let c = s.[!i+1] in c = '{' || c = '`') (* ` *)
then i := !i+1;
print_char s.[!i];
i := !i + 1
done
}
rule main = parse
"`" { command_beginning := Lexing.lexeme_start lexbuf;
first_item := true;
print_char '(';
command lexbuf;
print_char ')';
main lexbuf }
| "\\`"
{ print_string "`"; main lexbuf }
| eof { () }
| _ { print_char(Lexing.lexeme_char lexbuf 0); main lexbuf }
and command = parse
"`" { () }
| eof { prerr_string "Unterminated `...` at character ";
prerr_int !command_beginning;
prerr_newline();
exit 2 }
| "{" [^ '}'] * "}"
{ let s = Lexing.lexeme lexbuf in
add_semicolon();
print_string (String.sub s 1 (String.length s - 2));
command lexbuf }
| ( [^ '`' '{' '\\'] |
'\\' ['\\' '"' 'n' 't' 'b' 'r' '`' '{' ] |
'\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] |
'\\' ('\n' | "\r\n")) +
{ let s = Lexing.lexeme lexbuf in
add_semicolon();
(* Optimise one-character strings *)
if String.length s = 1 && s.[0] <> '\\' && s.[0] <> '\''
|| String.length s = 2 && s.[0] = '\\' && s.[1] <> '`' && s.[1]<>'{'
(* ` *)
then begin
print_string "emit_char '";
print_unescaped_string s;
print_string "'"
end else begin
print_string "emit_string \"";
print_unescaped_string s;
print_string "\""
end;
command lexbuf }
{
let _ = main(Lexing.from_channel stdin)
let _ = exit (0)
}
|
