tools/ocamlpp.ml4

   1 open Str
   2
   3 let outch = ref stdout
   4
   5 (*
   6 let gen dest_filename =
   7
   8   let basename = Filename.basename dest_filename in
   9   let directory = Filename.dirname dest_filename in
  10   let dirname = Filename.basename directory in
  11   let up_directory = Filename.dirname directory in
  12   let templates = Filename.concat up_directory "template" in
  13   let template, keyword =
  14     let keyword = ref "" in
  15     let template = ref "" in
  16     try
  17       let len = String.length basename in
  18       for i = 0 to len - 1 do
  19         match basename.[i] with
  20           'A' ..'Z' ->
  21             template := "template" ^ (String.sub basename i (len-i));
  22             keyword := String.sub basename 0 i;
  23             !keyword.[0] <- Char.uppercase !keyword.[0];
  24             raise Exit
  25         | _ -> ()
  26       done;
  27       assert false
  28     with Exit -> !template, !keyword
  29   in
  30
  31   (*
  32   prerr_endline (Printf.sprintf "FILE [%s]" dest_filename);
  33   prerr_endline (Printf.sprintf "Replace [%s] by [%s]" "Template" keyword);
  34 *)
  35
  36   let ts = "Template" in
  37   let ts_len = String.length ts in
  38
  39   let full_template = Filename.concat templates template in
  40   let ic = open_in full_template in
  41   let oc = open_out dest_filename in
  42
  43   let rec iter_line i =
  44     let line = input_line ic in
  45
  46     let buf = Buffer.create 100 in
  47     let len = String.length line in
  48 (*    Printf.printf "LINE [%d]" len; print_newline (); *)
  49     if len >= ts_len then
  50       let rec iter i =
  51 (*        Printf.printf "[%d]" i; print_newline (); *)
  52         if i <=  len - ts_len then
  53           if line.[i] = 'T' && String.sub line i ts_len = ts then begin
  54               Buffer.add_string buf keyword;
  55               iter (i+ts_len)
  56             end else begin
  57               Buffer.add_char buf line.[i];
  58               iter (i+1)
  59             end
  60         else
  61           Buffer.add_string buf (String.sub line i (len-i))
  62       in
  63       iter 0;
  64       output_string oc (Buffer.contents buf);
  65     else
  66       output_string oc line;
  67     output_char oc '\n';
  68     iter_line (i+1)
  69   in
  70   try
  71     Printf.fprintf oc "(*\n\n WARNING: this file is automatically generated from: \n\t%s\n\n*)\n\n" full_template;
  72     Printf.fprintf oc "# 1 \"%s\"\n" full_template;
  73
  74     iter_line 0
  75   with End_of_file ->
  76       close_out oc;
  77       close_in ic
  78
  79 let depend dest_filename =
  80   if Sys.file_exists dest_filename then begin
  81       let dest_filename = String.sub dest_filename 0 (String.length dest_filename - 1) in
  82       let basename = Filename.basename dest_filename in
  83       let directory = Filename.dirname dest_filename in
  84       let dirname = Filename.basename directory in
  85       let up_directory = Filename.dirname directory in
  86       let templates = Filename.concat up_directory "template" in
  87       let template, keyword =
  88         let keyword = ref "" in
  89         let template = ref "" in
  90         try
  91           let len = String.length basename in
  92           for i = 0 to len - 1 do
  93             match basename.[i] with
  94               'A' ..'Z' ->
  95                 template := "template" ^ (String.sub basename i (len-i));
  96                 keyword := String.sub basename 0 i;
  97                 !keyword.[0] <- Char.uppercase !keyword.[0];
  98                 raise Exit
  99             | _ -> ()
 100           done;
 101           assert false
 102         with Exit -> !template, !keyword
 103       in
 104       let full_template = Filename.concat templates template in
 105
 106       Printf.printf "%s: %s\n" dest_filename full_template
 107     end
 108 *)
 109
 110 type command =
 111   Include of string * (Str.regexp * string) list
 112 | Line of int * string
 113 | Regexps of (Str.regexp * string) list
 114   (*
 115 | Define of string
 116 | Ifdef of string
 117 | Else
 118 | Endif
 119 *)
 120
 121 type env = {
 122     regexps : (Str.regexp * string) list;
 123     defines : string list;
 124     ifs : bool list;
 125   }
 126
 127 let new_env = { regexps = []; defines = []; ifs = [] }
 128
 129 open Genlex
 130 let lexer = make_lexer [
 131     "include"; "where"; "and" ;
 132     "define"; "enddef";
 133     "ifdef"; "else"; "endif";
 134     "=" ; "#" ]
 135
 136 let rec parse_line = parser
 137     [< 'Kwd "#"; key = parse_key >] -> key
 138
 139 and parse_key = parser
 140     [< 'Kwd "include"; 'String filename; regexps = parse_where >] ->
 141     Include (filename, regexps)
 142 | [< 'Int line; 'String filename >] ->
 143     Line (line, filename)
 144 | [< 'Kwd "where"; 'String reg; 'Kwd "="; 'String templ;
 145       regexps = parse_where >] ->
 146     Regexps ( (Str.regexp reg, templ) :: regexps)
 147
 148 and parse_where = parser
 149     [< 'Kwd "where"; 'String reg; 'Kwd "="; 'String templ;
 150       regexps = parse_where >] ->
 151     (Str.regexp reg, templ) :: regexps
 152 |   [< 'Kwd "and"; 'String reg; 'Kwd "="; 'String templ;
 153       regexps = parse_where >] ->
 154     (Str.regexp reg, templ) :: regexps
 155 | [< >] -> []
 156
 157 let rec preprocess filename env =
 158   let ic = open_in filename in
 159
 160   let line_warning line =
 161     Printf.fprintf !outch "(*\n\n WARNING: this file is automatically generated from: \n\t%s\n\n*)\n\n" filename;
 162     Printf.fprintf !outch "# %d \"%s\"\n" (line+1) filename;
 163   in
 164
 165   let rec iter_line i env =
 166     let line = input_line ic in
 167
 168     let line = iter_regexps line env.regexps in
 169
 170     let len = String.length line in
 171     let env =
 172       if len > 1 && line.[0] = '#' then begin
 173           begin
 174             let s = Stream.of_string line in
 175             try
 176               match parse_line (lexer s) with
 177                 Include (filename, regexps2) ->
 178                   preprocess filename
 179                     { env with regexps = regexps2 @ env.regexps };
 180                   line_warning (i+1);
 181                   env
 182               | Line (line, filename) ->
 183                   Printf.fprintf !outch "# %d \"%s\"\n" line filename;
 184                   env
 185               | Regexps regexps2 ->
 186                   line_warning (i+1);
 187                   { env with regexps = regexps2 @ env.regexps }
 188             with
 189             | e ->
 190                 Printf.fprintf stderr "Line [%s]:\n"
 191                   (String.escaped line);
 192                 Printf.fprintf stderr "Error %s in \"%s\" line %d (%d)\n"
 193                   (Printexc.to_string e) filename i (Stream.count s + 1);
 194                 exit 2
 195           end;
 196         end else begin
 197           output_string !outch line;
 198           output_char !outch '\n';
 199           env
 200         end
 201     in
 202     iter_line (i+1) env
 203
 204   and iter_regexps line regexps =
 205     match regexps with
 206       [] -> line
 207     | (reg, templ) :: regexps ->
 208 (*        Printf.fprintf stderr "Checking replacement for %s\n" templ; *)
 209         let line = Str.global_replace reg templ line in
 210         iter_regexps line regexps
 211   in
 212   try
 213     line_warning 0;
 214     iter_line 0 env
 215   with End_of_file ->
 216       close_in ic
 217
 218 let pp filename = preprocess filename new_env
 219
 220 let add_depend  filedep filename depends =
 221   if not (List.mem filename !depends) then begin
 222       Printf.fprintf !outch "%s: %s\n" filedep filename;
 223       depends := filename :: !depends
 224     end
 225
 226 let rec dep filedep filename env depends =
 227   let ic = open_in filename in
 228
 229   let rec iter_line i env =
 230     let line = input_line ic in
 231
 232     let line = iter_regexps line env.regexps in
 233
 234     let len = String.length line in
 235     let env =
 236       if len > 1 && line.[0] = '#' then begin
 237           let s = Stream.of_string line in
 238           try
 239             match parse_line (lexer s) with
 240               Include (filename, regexps2) ->
 241                 add_depend filedep filename depends;
 242                 dep filedep filename
 243                   { env with regexps = regexps2 @ env.regexps } depends;
 244                 env
 245             | Line (line, filename) ->
 246                 add_depend filedep filename depends;
 247                 env
 248             | Regexps regexps2 ->
 249                 { env with regexps = regexps2 @ env.regexps }
 250           with
 251           | e ->
 252               Printf.fprintf stderr "Line [%s]:\n"
 253                 (String.escaped line);
 254               Printf.fprintf stderr "Error \"%s\" line %d (%d)\n"
 255                 filename i (Stream.count s + 1);
 256               exit 2
 257         end
 258       else env
 259     in
 260     iter_line (i+1) env
 261
 262   and iter_regexps line regexps =
 263     match regexps with
 264       [] -> line
 265     | (reg, templ) :: regexps ->
 266         let line = Str.global_replace reg templ line in
 267         iter_regexps line regexps
 268   in
 269   try
 270     ignore (iter_line 0 env)
 271   with End_of_file ->
 272       close_in ic
 273
 274 let depend filename =
 275   if Sys.file_exists filename then
 276     if Filename.check_suffix filename ".mlt" then
 277       let filedep = (Filename.chop_suffix filename ".mlt") ^ ".ml" in
 278       dep filedep filename new_env (ref [])
 279     else begin
 280         Printf.fprintf stderr "Don't know what to do with %s\n" filename;
 281         exit 2
 282       end
 283
 284 let () =
 285   Arg.parse
 286     [
 287 (*    "-gen", Arg.String gen, " <filename> : generate filename"; *)
 288     "-pp", Arg.String pp, " <filename> : preprocess filename";
 289     "-o", Arg.String (fun s -> outch := open_out s), " <filename> : output filename (influences subsequent options)";
 290   ] depend "";
 291   close_out !outch
 292