tools/ocamlpp.ml4

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