open Str
    
(*
let gen dest_filename =
  
  let basename = Filename.basename dest_filename in
  let directory = Filename.dirname dest_filename in
  let dirname = Filename.basename directory in
  let up_directory = Filename.dirname directory in 
  let templates = Filename.concat up_directory "template" in
  let template, keyword =
    let keyword = ref "" in
    let template = ref "" in
    try
      let len = String.length basename in
      for i = 0 to len - 1 do
        match basename.[i] with
          'A' ..'Z' -> 
            template := "template" ^ (String.sub basename i (len-i)); 
            keyword := String.sub basename 0 i;
            !keyword.[0] <- Char.uppercase !keyword.[0];
            raise Exit
        | _ -> ()
      done;
      assert false
    with Exit -> !template, !keyword
  in        

  (*
  prerr_endline (Printf.sprintf "FILE [%s]" dest_filename);  
  prerr_endline (Printf.sprintf "Replace [%s] by [%s]" "Template" keyword);  
*)
  
  let ts = "Template" in
  let ts_len = String.length ts in
  
  let full_template = Filename.concat templates template in
  let ic = open_in full_template in
  let oc = open_out dest_filename in
  
  let rec iter_line i =
    let line = input_line ic in
    
    let buf = Buffer.create 100 in
    let len = String.length line in
(*    Printf.printf "LINE [%d]" len; print_newline (); *)
    if len >= ts_len then
      let rec iter i =
(*        Printf.printf "[%d]" i; print_newline (); *)
        if i <=  len - ts_len then 
          if line.[i] = 'T' && String.sub line i ts_len = ts then begin
              Buffer.add_string buf keyword;
              iter (i+ts_len)
            end else begin
              Buffer.add_char buf line.[i];
              iter (i+1)
            end
        else
          Buffer.add_string buf (String.sub line i (len-i))
      in
      iter 0;
      output_string oc (Buffer.contents buf);
    else
      output_string oc line;
    output_char oc '\n';
    iter_line (i+1)
  in  
  try
    Printf.fprintf oc "(*\n\n WARNING: this file is automatically generated from: \n\t%s\n\n*)\n\n" full_template;
    Printf.fprintf oc "# 1 \"%s\"\n" full_template;
    
    iter_line 0
  with End_of_file ->
      close_out oc;
      close_in ic

let depend dest_filename =
  if Sys.file_exists dest_filename then begin
      let dest_filename = String.sub dest_filename 0 (String.length dest_filename - 1) in
      let basename = Filename.basename dest_filename in
      let directory = Filename.dirname dest_filename in
      let dirname = Filename.basename directory in
      let up_directory = Filename.dirname directory in 
      let templates = Filename.concat up_directory "template" in
      let template, keyword =
        let keyword = ref "" in
        let template = ref "" in
        try
          let len = String.length basename in
          for i = 0 to len - 1 do
            match basename.[i] with
              'A' ..'Z' -> 
                template := "template" ^ (String.sub basename i (len-i)); 
                keyword := String.sub basename 0 i;
                !keyword.[0] <- Char.uppercase !keyword.[0];
                raise Exit
            | _ -> ()
          done;
          assert false
        with Exit -> !template, !keyword
      in        
      let full_template = Filename.concat templates template in
      
      Printf.printf "%s: %s\n" dest_filename full_template
    end
*)
    
type command =
  Include of string * (Str.regexp * string) list 
| Line of int * string
| Regexps of (Str.regexp * string) list
  (*
| Define of string
| Ifdef of string
| Else
| Endif
*)
  
type env = {
    regexps : (Str.regexp * string) list;
    defines : string list;
    ifs : bool list;
  }

let new_env = { regexps = []; defines = []; ifs = [] }
  
open Genlex
let lexer = make_lexer [ 
    "include"; "where"; "and" ; 
    "define"; "enddef";
    "ifdef"; "else"; "endif";
    "=" ; "#" ]
  
let rec parse_line = parser
    [< 'Kwd "#"; key = parse_key >] -> key
    
and parse_key = parser
    [< 'Kwd "include"; 'String filename; regexps = parse_where >] ->
    Include (filename, regexps)
| [< 'Int line; 'String filename >] -> 
    Line (line, filename)
| [< 'Kwd "where"; 'String reg; 'Kwd "="; 'String templ; 
      regexps = parse_where >] ->
    Regexps ( (Str.regexp reg, templ) :: regexps)

and parse_where = parser
    [< 'Kwd "where"; 'String reg; 'Kwd "="; 'String templ; 
      regexps = parse_where >] ->
    (Str.regexp reg, templ) :: regexps
|   [< 'Kwd "and"; 'String reg; 'Kwd "="; 'String templ; 
      regexps = parse_where >] ->
    (Str.regexp reg, templ) :: regexps
| [< >] -> []

let rec preprocess filename env =
  let ic = open_in filename in
  
  let line_warning line =
    Printf.fprintf stdout "(*\n\n WARNING: this file is automatically generated from: \n\t%s\n\n*)\n\n" filename;
    Printf.fprintf stdout "# %d \"%s\"\n" (line+1) filename;  
  in
  
  let rec iter_line i env =
    let line = input_line ic in
    
    let line = iter_regexps line env.regexps in    
    
    let len = String.length line in
    let env = 
      if len > 1 && line.[0] = '#' then begin
          begin
            let s = Stream.of_string line in
            try
              match parse_line (lexer s) with
                Include (filename, regexps2) -> 
                  preprocess filename
                    { env with regexps = regexps2 @ env.regexps };
                  line_warning (i+1);
                  env
              | Line (line, filename) ->
                  Printf.fprintf stdout "# %d \"%s\"\n" line filename;
                  env
              | Regexps regexps2 ->
                  line_warning (i+1);
                  { env with regexps = regexps2 @ env.regexps }
            with 
            | e ->
                Printf.fprintf stderr "Line [%s]:\n"
                  (String.escaped line);
                Printf.fprintf stderr "Error %s in \"%s\" line %d (%d)\n" 
                  (Printexc.to_string e) filename i (Stream.count s + 1);
                exit 2
          end;
        end else begin
          output_string stdout line;
          output_char stdout '\n';
          env
        end
    in
    iter_line (i+1) env
    
  and iter_regexps line regexps =
    match regexps with
      [] -> line
    | (reg, templ) :: regexps ->
(*        Printf.fprintf stderr "Checking replacement for %s\n" templ; *)
        let line = Str.global_replace reg templ line in
        iter_regexps line regexps
  in  
  try
    line_warning 0;
    iter_line 0 env
  with End_of_file ->
      close_in ic

let pp filename = preprocess filename new_env

let add_depend  filedep filename depends =
  if not (List.mem filename !depends) then begin
      Printf.fprintf stdout "%s: %s\n" filedep filename;
      depends := filename :: !depends
    end
  
let rec dep filedep filename env depends =
  let ic = open_in filename in
  
  let rec iter_line i env =
    let line = input_line ic in
    
    let line = iter_regexps line env.regexps in    
    
    let len = String.length line in
    let env =
      if len > 1 && line.[0] = '#' then begin
          let s = Stream.of_string line in
          try
            match parse_line (lexer s) with
              Include (filename, regexps2) -> 
                add_depend filedep filename depends;
                dep filedep filename 
                  { env with regexps = regexps2 @ env.regexps } depends;
                env
            | Line (line, filename) ->
                add_depend filedep filename depends;
                env
            | Regexps regexps2 ->
                { env with regexps = regexps2 @ env.regexps }
          with 
          | e ->
              Printf.fprintf stderr "Line [%s]:\n"
                (String.escaped line);
              Printf.fprintf stderr "Error \"%s\" line %d (%d)\n" 
                filename i (Stream.count s + 1);
              exit 2
        end
      else env
    in
    iter_line (i+1) env
    
  and iter_regexps line regexps =
    match regexps with
      [] -> line
    | (reg, templ) :: regexps ->
        let line = Str.global_replace reg templ line in
        iter_regexps line regexps
  in  
  try    
    ignore (iter_line 0 env)
  with End_of_file ->
      close_in ic

let depend filename = 
  if Sys.file_exists filename then
    if Filename.check_suffix filename ".mlt" then
      let filedep = (Filename.chop_suffix filename ".mlt") ^ ".ml" in
      dep filedep filename new_env (ref [])
    else begin
        Printf.fprintf stderr "Don't know what to do with %s\n" filename;
        exit 2
      end
      
let _ =
  Arg.parse 
    [
(*    "-gen", Arg.String gen, " <filename> : generate filename"; *)
    "-pp", Arg.String pp, " <filename> : preprocess filename";
  ] depend ""