https://github.com/charguer/ocaml
Tip revision: 57dcb6376b811cbf5574309846636b86d870a8b6 authored by Alain Frisch on 21 October 2009, 14:00:43 UTC
Initial commit on this branch.
Initial commit on this branch.
Tip revision: 57dcb63
cvt_emit.mll
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* 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'] ) +
{ 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)
}