helm/www/lambdadelta/bin/xhtbl/xhtbl.ml

   1 module A = Arg
   2 module F = Filename
   3 module L = List
   4
   5 module O  = Options
   6 module TP = TextParser
   7 module TL = TextLexer
   8 module TU = TextUnparser
   9 module P1 = Pass1
  10 module P2 = Pass2
  11 module P3 = Pass3
  12 module M  = Matrix
  13 module XU = XmlUnparser
  14
  15 let help    = "Usage: xhtbl [ -LX | -O <dir> | -d0 | -d1 | -d2 | -e1 | -e2 | -p0 | -p1 | -p2 | <file> ]*"
  16 let help_L  = " Output lexer tokens"
  17 let help_O  = "<dir>  Set this output directory"
  18 let help_X  = " Clear all options"
  19 let help_d0 = " Output table contents after phase zero (parsing)"
  20 let help_d1 = " Output table contents after phase one (sizing)"
  21 let help_d2 = " Output table contents after phase two (filling)"
  22 let help_e1 = " Disabled"
  23 let help_e2 = " Output debug information during phase two (filling)"
  24 let help_p0 = " Process until phase zero (parsing)"
  25 let help_p1 = " Process until phase one (sizing)"
  26 let help_p2 = " Process until phase two (filling)"
  27
  28 let hook = "xhtbl"
  29
  30 let includes, tables = ref [], ref []
  31
  32 let set_output_dir s = O.output_dir := s
  33
  34 let process_directive och bname (name, table, css) =
  35    tables := name :: !tables;
  36    if !O.d0 then TU.debug table;
  37    if not !O.p0 then begin
  38       let size = P1.process table in
  39       if !O.d1 then TU.debug table;
  40       if not !O.p1 then begin
  41          let matrix = M.make size in
  42          let _ = P2.process table matrix in
  43          if !O.d2 then TU.debug table;
  44          if not !O.p2 then P3.process css matrix;
  45          let name = if name = "" then bname else name in
  46          XU.output och name matrix
  47       end
  48    end
  49
  50 let process_file fname =
  51    let bname = F.chop_extension (F.basename fname) in
  52    let ich = open_in fname in
  53    let lexbuf = Lexing.from_channel ich in
  54    let ds = TP.script TL.token lexbuf in
  55    close_in ich; includes := bname :: !includes;
  56    let och = XU.open_out true bname in
  57    L.iter (process_directive och bname) ds;
  58    XU.close_out och
  59
  60 let main () =
  61    A.parse [
  62       "-L", A.Set O.debug_lexer, help_L;
  63       "-O", A.String set_output_dir, help_O;
  64       "-X", A.Unit O.clear, help_X;
  65       "-d0", A.Set O.d0, help_d0;
  66       "-d1", A.Set O.d1, help_d1;
  67       "-d2", A.Set O.d2, help_d2;
  68       "-e1", A.Set O.e1, help_e1;
  69       "-e2", A.Set O.e2, help_e2;
  70       "-p0", A.Set O.p0, help_p0;
  71       "-p1", A.Set O.p1, help_p1;
  72       "-p2", A.Set O.p2, help_p2;
  73    ] process_file help;
  74    XU.write_hook hook !includes !tables
  75
  76 let _ = main ()