(* Copyright 2005-2007 Berke DURAK, INRIA Rocquencourt.

This file is part of Dose2.

Dose2 is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

Dose2 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 Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>. *)

open Io;;
open Fragments;;
open Channels;;

let fp = Printf.fprintf;;

type 'channel printer = {
  print : 'a . 'channel -> ('a, 'channel, unit) format -> 'a;
  flush : 'channel -> unit
};;

(*** do_output *)
let do_output printer channel =
  let fp = printer.print
  and oc = channel
  in
  let space = ref true in
  let need_space () =
    if not !space then
      begin
        fp oc " ";
        space := false
      end
    else
      ()
  in
  let no_space () = space := false in
  let space_ok () = space := true in
  create_io_out
    ~write_token:
      begin function
      | Int x -> need_space (); fp oc "%d" x; no_space ()
      | Int64 x -> need_space (); fp oc "%LdL" x; no_space ()
      | Char x -> fp oc "%C" x; space_ok ()
      | String x -> fp oc "%S" x; space_ok ()
      | Float x -> need_space (); fp oc "%F" x; no_space ()
      | Bool x -> need_space (); fp oc "%b" x; no_space ()
      | Tag t ->
          if is_tag_voluminous t then
            begin
              need_space ();
              fp oc "%s" (string_of_tag t);
              no_space ()
            end
          else
            begin
              fp oc "%s" (string_of_tag t);
              space_ok ()
            end
      | Constructor x ->
          let y = String.copy x in
          y.[0] <- Char.uppercase x.[0];
          need_space ();
          fp oc "%s" y;
          no_space ();
      | Field x ->
          need_space ();
          if is_word_reserved x then
            fp oc "_%s" x
          else
            fp oc "%s" x;
          no_space ()
      | EOF -> ()
      end
    ~flush:(fun () -> printer.flush oc)
    ()
;;
(* ***)
(*** out_of_channel *)
let out_of_channel ~out_channel () = do_output { print = Printf.fprintf; flush = Pervasives.flush } out_channel;;
(* ***)
(*** out_of_buffer *)
let out_of_buffer ~buffer () = do_output { print = Printf.bprintf; flush = ignore } buffer;;
(* ***)
(*** in_of_lexbuf *)
let in_of_lexbuf ~lexbuf () =
  let l = lexbuf in
  let token = ref None in
  let peek_token () =
    match !token with
    | None ->
      let t = Lexer.token l in
      token := Some t;
      t
    | Some t -> t
  in
  create_io_in
    ~peek_token
    ~read_token:
      begin fun () ->
        let t = peek_token () in
        token := None;
        t
      end
    ()
;;
(* ***)
