https://github.com/charguer/ocaml
Tip revision: 4548f1e68f99a1eead460251a20ebfe2b3e736f4 authored by Alain Frisch on 14 December 2010, 08:38:03 UTC
Allow implicit coercion on type with free variables (if subtyping does not unify variables).
Allow implicit coercion on type with free variables (if subtyping does not unify variables).
Tip revision: 4548f1e
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)
}