pga/pga.ml

open Types
open Stringify

let main () =
  let usage status =
    prerr_endline ("usage: " ^ Sys.argv.(0) ^ " command [args]");
    prerr_endline "command:";
    prerr_endline "  help         show this help page";
    prerr_endline "  echo TERM    pretty-print a program";
    prerr_endline "  utf8 TERM    print a program in UTF-8 format";
    prerr_endline "  latex TERM   print latex source for a program";
    prerr_endline "  norm TERM    get the norm of a program";
    prerr_endline "  i I TERM     get the Ith instruction of a program";
    prerr_endline "  canon1 TERM  transform to first canonical form";
    prerr_endline "  canon2 TERM  transform to second canonical form";
    prerr_endline "  eq TERM TERM check for instruction-row equivalence";
    prerr_endline "  dot TERM     generate Dot code for a flow graph";
    prerr_endline "input program syntax:";
    prerr_endline "  - write star (*) instead of omega sign";
    prerr_endline "  - write dollar sign ($) instead of pound sign";
    prerr_endline "";
    prerr_endline "A single TERM argument may also be omitted and passed on";
    prerr_endline "stdin instead for convenient use of UNIX pipes, e.g.:";
    prerr_endline "$ ./pga canon1 '(a)*;!' | ./pga dot | dot -T png | display";
    exit status
  in

  let argc = Array.length Sys.argv in
  if argc = 1 then usage 1;

  let input_term i =
    let lexbuf =
      if argc > i
        then Lexing.from_string Sys.argv.(i)
        else Lexing.from_channel stdin
    in
    Parse.parse_with_error lexbuf
  in

  begin
    try
      match Sys.argv.(1) with
      | "help" ->
        usage 0
      | "echo" ->
        print_endline (string_of_program_ascii (input_term 2))
      | "utf8" ->
        print_endline (string_of_program_utf8 (input_term 2))
      | "latex" ->
        print_endline (string_of_program_latex (input_term 2))
      | "norm" ->
        print_endline (string_of_natural (Congruence.norm (input_term 2)))
      | "i" | "canon1" | "canon2" | "eq" | "dot" ->
        raise (Failure "not implemented")
      | _ ->
        usage 1
    with
    | Fatal_error msg ->
      prerr_endline msg;
      exit 1
    | Ins_error (i, msg) ->
      prerr_endline ("error on " ^ string_of_ins_ascii i ^ ": " ^ msg);
      exit 1
    | Program_error (p, msg) ->
      prerr_endline ("error on " ^ string_of_program_ascii p ^ ": " ^ msg);
      exit 1
  end;

  exit 0

let () = main ()