(*********************************************************************************) |
(* Cameleon *)
(* *)
(* Copyright (C) 2005,2006 Institut National de Recherche en Informatique *)
(* et en Automatique. All rights reserved. *)
(* *)
(* This program is free software; you can redistribute it and/or modify *)
(* it under the terms of the GNU Library General Public License as *)
(* published by the Free Software Foundation; either version 2 of the *)
(* License, or any later version. *)
(* *)
(* This program is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
(* GNU Library General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Library General Public *)
(* License along with this program; if not, write to the Free Software *)
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *)
(* 02111-1307 USA *)
(* *)
(* Contact: Maxence.Guesdon@inria.fr *)
(* *)
(*********************************************************************************) |
open Template
open Format
let print_template = fun chan ->
let rec print = fun formatter -> function
| Tmpl_Text text -> begin
match List.rev (Str.split_delim (Str.regexp "\013?\n") text) with
| hd :: tl ->
List.iter
(fun s -> Format.fprintf formatter
"Pervasives.output_string tmpl__channel \"%s\\n\";@ "
(String.escaped s))
(List.rev tl);
if hd <> "" then
Format.fprintf formatter
"Pervasives.output_string tmpl__channel \"%s\";@ "
(String.escaped hd)
| _ ->
()
end
| Tmpl_Block (caml, ts) ->
Format.fprintf formatter
"@[<2>begin %s@ in@ %a@]@\nend;@\n"
caml
(fun formatter ts ->
List.iter (fun t -> print formatter t) ts)
ts
| Tmpl_Iter (symbol, list, ts) ->
Format.fprintf formatter "@[<2>begin@\n";
Format.fprintf formatter "@[<2>List.iter@\n";
Format.fprintf formatter "@[<2>(fun %s -> begin@\n%a@]"
symbol
(fun formatter () -> List.iter (fun t -> print formatter t) ts) ();
Format.fprintf formatter "end)@\n";
Format.fprintf formatter "%s@]@]@\n" list;
Format.fprintf formatter "end;@\n"
| Tmpl_If (caml, ts) ->
Format.fprintf formatter
"@[<2>if (%s) then begin@\n%a@\nend;@\n"
caml
(fun formatter () -> List.iter (fun t -> print formatter t) ts) ()
| Tmpl_For (symbol, ocaml, ts) ->
Format.fprintf formatter "@[<2>begin@\n";
Format.fprintf formatter "@[<2>let (min, max) = (%s)@ in @\n" ocaml;
Format.fprintf formatter "for %s = min to max do@\n%a@\ndone;"
symbol
(fun formatter () -> List.iter (fun t -> print formatter t) ts) ();
Format.fprintf formatter "@]@]@\n";
Format.fprintf formatter "end;@\n"
| Tmpl_Caml caml ->
Format.fprintf formatter "@[<2>begin@\n";
Format.fprintf formatter "@[<2>let string = (%s)@ in@\n" caml;
Format.fprintf formatter "Pervasives.output_string tmpl__channel string";
Format.fprintf formatter "@]@]@\n";
Format.fprintf formatter "end;@\n"
in
fun (Tmpl (init, template)) ->
let formatter = formatter_of_out_channel chan in
begin match init with
| None -> ()
| Some s -> Format.fprintf formatter "%s@\n@\n" s
end;
Format.fprintf formatter
"@[<2>let print = fun tmpl__env tmpl__channel ->@\n%a@]\n"
(fun formatter () -> List.iter (print formatter) template) ();
Format.pp_print_flush formatter
let of_lexbuf = fun lexbuf ->
let state = ref TmplLexer.LexText in
try
TmplLexer.line := 0;
TmplParser.main (TmplLexer.lex state) lexbuf
with
| TmplLexer.Lex_error -> raise Parsing.Parse_error
let of_channel = fun ?(close = true) channel ->
try
of_lexbuf (Lexing.from_channel channel)
with
| e -> begin
(try if close then Pervasives.close_in channel
with _ -> ());
raise e
end
let of_file = fun ~filename ->
let chan = Pervasives.open_in filename in
of_channel ~close:true chan