hphp/hack/src/hhbc/semdiff/semdiff.ml

   1 (**
   2  * Copyright (c) 2017, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the BSD-style license found in the
   6  * LICENSE file in the "hack" directory of this source tree. An additional grant
   7  * of patent rights can be found in the PATENTS file in the same directory.
   8  *
   9 *)
  10 open Hhas_parser
  11 open Diff
  12
  13 type options = {
  14   files : string * string;
  15   similarity : bool;
  16 }
  17
  18 let die str =
  19   let oc = stderr in
  20   output_string oc str;
  21   close_out oc;
  22   exit 2
  23
  24 let parse_options () =
  25   let similarity = ref false in
  26   let purpose = "Hhas differencing tool" in
  27   let usage =
  28     Printf.sprintf "%s\nUsage: %s file1 file2\n" purpose Sys.argv.(0)
  29   in
  30   let options =
  31     [ ("--similarity"
  32       , Arg.Set similarity
  33       , " Only displays the similarity percentage on STDOUT"
  34       );
  35     ] in
  36   let options = Arg.align ~limit:25 options in
  37   let files = ref [] in
  38   Arg.parse options (fun file -> files := file::!files) usage;
  39   match !files with
  40   | [x; y] ->
  41     { files = (x, y)
  42     ; similarity = !similarity
  43     }
  44   | _ -> die usage
  45
  46 let parse_file program_parser filename =
  47   let channel = open_in filename in (* TODO: error handling *)
  48
  49   let lexer = Lexing.from_channel channel in
  50   let prog =
  51     try program_parser lexer
  52       with Parsing.Parse_error -> (
  53         Printf.eprintf "Parsing of file failed\n";
  54         raise Parsing.Parse_error
  55         )
  56   in
  57   close_in channel;
  58   prog
  59
  60 let run options =
  61   let program_parser = program Hhas_lexer.read in
  62   let prog1 = parse_file program_parser (fst options.files) in
  63   let prog2 = parse_file program_parser (snd options.files) in
  64   let _ = Rhl.adata1_ref := Hhas_program.adata prog1 in
  65   let _ = Rhl.adata2_ref := Hhas_program.adata prog2 in
  66
  67   let (d,(s,e)) = program_comparer.comparer prog1 prog2 in
  68   let similarity = (100.0 *. (1.0 -. float_of_int d /. float_of_int (s+1))) in
  69   if options.similarity
  70   then Printf.printf "%.2f" similarity
  71   else (Printf.printf
  72     "distance = %d\nsize = %d\nsimilarity =%.2f%%\nedits=\n%s" d s similarity e;
  73     print_endline defaultstring) (* make sure the colors are back to normal *)
  74
  75 (* command line driver *)
  76 let _ =
  77   if ! Sys.interactive
  78   then ()
  79   else
  80     (* On windows, setting 'binary mode' avoids to output CRLF on
  81        stdout.  The 'text mode' would not hurt the user in general, but
  82        it breaks the testsuite where the output is compared to the
  83        expected one (i.e. in given file without CRLF). *)
  84     set_binary_mode_out stdout true;
  85     let options = parse_options () in
  86     Unix.handle_unix_error run options