ocaml/tools/cvt_emit.mll

80 lines
2.5 KiB
OCaml

(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $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 }
| 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'] ) +
{ 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)
}