(*
 * Copyright (c) 2005 Anil Madhavapeddy <anil@recoil.org>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *
 * $Id: spl_utils.ml,v 1.10 2006/02/06 22:25:03 avsm Exp $
 *)

(* Maintain a list of values to a key in a hashtable *)
let hashtbl_add_list h k v =
    try
        let i = Hashtbl.find h k in
        Hashtbl.replace h k (v :: i)
    with Not_found ->
        Hashtbl.add h k [v] 

(* Returns unique version of list, unsorted *)
let list_unique l =
  let h = Hashtbl.create 1 in
  List.iter (fun k -> Hashtbl.replace h k ()) l;
  Hashtbl.fold (fun k v a -> k :: a) h []

let may def fn = function |None -> def |Some x -> fn x

(* Chop a filename extension if it exists, otherwise do nothing *)
let safe_chop f =
    try
        Filename.chop_extension f
    with Invalid_argument _ -> f

let list_filter_map fn l =
    let x = List.map fn l in
    List.fold_left (fun a -> function |None -> a |Some x -> x::a) [] x

let string_of_file f =
    let fin = open_in f in
    let buf = Buffer.create 1 in
    begin try while true do
        Buffer.add_string buf (input_line fin);
        Buffer.add_char buf '\n';
    done with End_of_file -> close_in fin; end;
    Buffer.contents buf
    
(* Just use a global variable for recording our log level in here *)
module Logger = struct
    type level =
    |Quiet
    |Normal
    |Verbose
    
    let level = ref Normal
    
    let set_log_level l = level := l
    
    let logfn l s =
        let out () = prerr_endline s in
        match l with
        |Quiet -> out ()
        |Normal -> if !level != Quiet then out ()
        |Verbose -> if !level != Quiet && !level != Normal then out ()
        
    let log_quiet = logfn Quiet
    let log = logfn Normal
    let log_verbose = logfn Verbose
end

module Printer = struct    
    type env = {
        fn: int -> string -> unit;
        p: string -> unit;         (* printer function *)
        i: int;                    (* indent level *)
        nl: unit -> unit;          (* new line *)
    }

    let indent e = { e with i = succ e.i; p = e.fn (succ e.i) }

    let indent_fn e fn =
        let e = indent e in
        fn e

    let list_iter_indent e fn l =
        List.iter (indent_fn e fn) l

    let hashtbl_iter_indent e fn h =
        Hashtbl.iter (indent_fn e fn) h

    let init_printer ?(header=true) ?(comment=("(*","*)")) fout =
        let ind i s = String.make (i * 2) ' ' ^ s in
        let out i s = output_string fout ((ind i s) ^ "\n") in
        if header then
            out 0 (Printf.sprintf "%s This file has been auto-generated by the SPL compiler %s" (fst comment) (snd comment));
        {
            fn = out;
            i = 0;
            p = (out 0);
            nl = (fun (x:unit) -> out 0 "");
        }
end