Merge pull request facebookarchive#162 from yunxing/reasonfmt

Add an option in reasonfmt: "-heuristics-file"

README.md

@@ -58,7 +58,7 @@ ocamlopt -pp reasonfmt -intf myFile.rei
 ocamlfind ocamlc -package reason ...
 ```
 
-Convert Your Project to Reason:
+Convert Your Project from OCaml to Reason:
 ------------------------------------------------------------
 `Reason` includes a program `reasonfmt` which will parse and print and
 convert various syntaxes. You can specify which syntax to parse, and
@@ -67,6 +67,65 @@ you can convert your `ocaml` project to `Reason` by processing each file
 with the command `reasonfmt -parse ml -print re yourFile.ml`. Execute
 `reasonfmt -help` for more options.
 
+### Removing `[@implicit_arity]`
+
+The converted Reason code may attach `[@implicit_arity]` to constructors like `C 1 2 [@implicit_arity]`.
+This is due to the fact that OCaml has the ambiguous syntax where a multi-arguments
+constructor is expecting argument in a tuple form. So at parsing time we don't
+know if `C (1, 2)` in OCaml should be translated to `C (1, 2)` or `C 1 2` in Reason.
+By default, we will convert it to `C 1 2 [@implicit_arity]`, which tells the compiler
+this can be either `C 1 2` or `C (1, 2)`.
+
+To prevent `[@implicit_arity]` from being generated, one can supply `-assume-explicit-arity`
+to `reasonfmt`. This forces the formatter to generate `C 1 2` instead of `C 1 2 [@implicit_arity]`.
+
+However, since `C 1 2` requires multiple arugments, it may fail the compilation if it is actually
+a constructor with a single tuple as an arugment (e.g., `Some`).
+We already have some internal exception rules to cover the common constructors who requires a single tuple
+as argument so that they will be converted correctly (e.g., `Some (1, 2)` will be converted
+to `Some (1, 2)` instead of `Some 1 2`, which doesn't compile).
+
+To provide your own exception list, create a line-separated file that contains all constructors (without module prefix)
+in your project that expects a single tuple as argument, and use `-heuristics-file <filename>`
+to tell `reasonfmt` that all constructors
+listed in the file will be treated as constructor with a single tuple as argument:
+```
+> cat heuristics.txt
+TupleConstructor
+And
+Or
+
+> cat test.ml
+type tm = TupleConstructor of (int * int) | MultiArgumentsConstructor of int * int
+
+let _ = TupleConstructor(1, 2)
+let _ = MultiArgumentsConstructor(1, 2)
+
+module Test = struct
+  type a = | And of (int * int) | Or of (int * int)
+end;;
+
+let _ = Test.And (1, 2)
+let _ = Test.Or (1, 2)
+let _ = Some (1, 2)
+
+> reasonfmt -heuristics-file ./heuristics.txt -assume-explicit-arity -parse ml -print re test.ml
+type tm = | TupleConstructor of (int, int) | MultiArgumentsConstructor of int int;
+
+let a = TupleConstructor (1, 2);
+
+let b = MultiArgumentsConstructor 1 2;
+
+let module Test = {type a = | And of (int, int) | Or of (int, int);};
+
+Test.And (1, 2);
+
+Test.Or (1, 2);
+
+Some (1, 2);
+
+```
+
 
 Upgrading Existing Source Code After Changing Parse/Printing:
 ------------------------------------------------------------

formatTest/formatOutput.re

@@ -6674,14 +6674,11 @@ let result =
 let nested_match =
   fun | A (B | C | D | E) => 3;
 
-let some = Some 1 2 3 [@implicit_arity];
+let some = Some (1, 2, 3);
 
-let nestedSome =
-  Some 1 2 (Some 1 2 3 [@implicit_arity])
-  [@implicit_arity];
+let nestedSome = Some (1, 2, Some (1, 2, 3));
 
-let nestedSomeSimple =
-  Some (Some 1 2 3 [@implicit_arity]);
+let nestedSomeSimple = Some (Some (1, 2, 3));
 
 let module EM = {exception E of int int;};
 

formatTest/test.sh

@@ -42,14 +42,15 @@ touch ./customMLFormatOutput.re
 
 echo "" > ./customMLFormatOutput.re
 
-shopt -s nullglob # prevent file from being set to "./customMLFiles/*.ml"
+shopt -s nullglob # prevent the variable 'file' from being set to "./customMLFiles/*.ml"
 for file in ./customMLFiles/*.ml
 do
   ../reasonfmt_impl.native -print-width 50 -parse ml -print re "$file" 2>&1 >> ./customMLFormatOutput.re
 done
 
 idempotent_test ./customMLFormatOutput.re
 
+
 for file in ./typeCheckedTests/*.re
 do
   ocamlc -c -pp ../reasonfmt_impl.native -intf-suffix .rei -impl "$file"
@@ -64,6 +65,10 @@ done
 ocamlc -c -pp ../reasonfmt_impl.native -intf-suffix .rei -impl ./typeCheckedTests/mlSyntax.re
 ../reasonfmt_impl.native -parse ml -print re ./typeCheckedTests/mlVariants.ml > ./typeCheckedTests/mlVariants.re
 ocamlc -c -pp ../reasonfmt_impl.native -intf-suffix .rei -impl ./typeCheckedTests/mlVariants.re
+
+../reasonfmt_impl.native -heuristics-file ./typeCheckedTests/arity.txt -assume-explicit-arity -parse ml -print re ./typeCheckedTests/arityConversion.ml > ./typeCheckedTests/arityConversion.re
+ocamlc -c -pp ../reasonfmt_impl.native -intf-suffix .rei -impl ./typeCheckedTests/arityConversion.re 2>&1 | ../reason_error_reporter.native
+
 # Remove the generated .re version too
 rm ./typeCheckedTests/mlSyntax.re
 rm ./typeCheckedTests/mlVariants.re

formatTest/typeCheckedTests/arity.txt

@@ -0,0 +1,3 @@
+And
+TupleConstructor
+Or

formatTest/typeCheckedTests/arityConversion.ml

@@ -0,0 +1,14 @@
+Some (1, 2, 3)
+
+type bcd = TupleConstructor of (int * int) | MultiArgumentsConstructor of int * int
+
+let a = TupleConstructor(1, 2)
+let b = MultiArgumentsConstructor(1, 2)
+
+module Test = struct
+  type a = | And of (int * int) | Or of (int * int)
+end;;
+
+let _ = Test.And (1, 2)
+let _ = Test.Or (1, 2)
+let _ = Some 1

formatTest/typeCheckedTests/arityConversion.re

@@ -0,0 +1,15 @@
+Some (1, 2, 3);
+
+type tm = | TupleConstructor of (int, int) | MultiArgumentsConstructor of int int;
+
+let a = TupleConstructor (1, 2);
+
+let b = MultiArgumentsConstructor 1 2;
+
+let module Test = {type a = | And of (int, int) | Or of (int, int);};
+
+Test.And (1, 2);
+
+Test.Or (1, 2);
+
+Some (1, 2);

src/reasonfmt_impl.ml

@@ -29,59 +29,72 @@ let reasonBinaryParser chan =
  * effectively m17n's parser.
  *)
 let () =
-  let (filename, load_path, prnt, prse, intf, print_width, use_stdin, recoverable, assumeExplicitArity) =
-    let filename = ref "" in
-    let prnt = ref None in
-    let prse = ref None in
-    let use_stdin = ref false in
-    let intf = ref None in
-    let recoverable = ref false in
-    let assumeExplicitArity = ref false in
-    let print_width = ref None in
-    let load_path = ref [] in
-    Arg.parse [
-        "-I", Arg.String (fun x -> load_path := x :: !load_path), "<path> add <path> to load path";
-        "-ignore", Arg.Unit ignore, "ignored";
-        "-is-interface-pp", Arg.Bool (fun x -> intf := Some x), "<interface> parse AST as <interface> (either true or false)";
-        "-use-stdin", Arg.Bool (fun x -> use_stdin := x), "<use_stdin> parse AST from <use_stdin> (either true, false). You still must provide a file name even if using stdin for errors to be reported";
-        "-recoverable", Arg.Bool (fun x -> recoverable := x), "Enable recoverable parser";
-        "-assume-explicit-arity", Arg.Unit (fun () -> assumeExplicitArity := true), "If a constructor's argument is a tuple, always interpret it as multiple arguments";
-        "-parse", Arg.String (fun x -> prse := Some x), "<parse> parse AST as <parse> (either 'ml', 're', 'binary_reason(for interchange between Reason versions')";
-        (* Use a print option of "none" to simply perform a parsing validation -
-         * useful for IDE error messages etc.*)
-        "-print", Arg.String (fun x -> prnt := Some x), "<print> print AST in <print> (either 'ml', 're', 'binary(default - for compiler input)', 'binary_reason(for interchange between Reason versions)', 'none')";
-        "-print-width", Arg.Int (fun x -> print_width := Some x), "<print-width> wrapping width for printing the AST";
-      ]
-      (fun arg -> filename := arg)
-      "Reason: Meta Language Utility";
-    (!filename, load_path, !prnt, !prse, !intf, !print_width, !use_stdin, !recoverable, !assumeExplicitArity)
+  let filename = ref "" in
+  let prnt = ref None in
+  let prse = ref None in
+  let use_stdin = ref false in
+  let intf = ref None in
+  let recoverable = ref false in
+  let assumeExplicitArity = ref false in
+  let heuristics_file = ref None in
+  let print_width = ref None in
+  let () = Arg.parse [
+    "-ignore", Arg.Unit ignore, "ignored";
+    "-is-interface-pp", Arg.Bool (fun x -> intf := Some x), "<interface>, parse AST as <interface> (either true or false)";
+    "-use-stdin", Arg.Bool (fun x -> use_stdin := x), "<use_stdin>, parse AST from <use_stdin> (either true, false). You still must provide a file name even if using stdin for errors to be reported";
+    "-recoverable", Arg.Bool (fun x -> recoverable := x), "Enable recoverable parser";
+    "-assume-explicit-arity", Arg.Unit (fun () -> assumeExplicitArity := true), "If a constructor's argument is a tuple, always interpret it as multiple arguments";
+    "-parse", Arg.String (fun x -> prse := Some x), "<parse>, parse AST as <parse> (either 'ml', 're', 'binary_reason(for interchange between Reason versions')";
+    (* Use a print option of "none" to simply perform a parsing validation -
+     * useful for IDE error messages etc.*)
+    "-print", Arg.String (fun x -> prnt := Some x), "<print>, print AST in <print> (either 'ml', 're', 'binary(default - for compiler input)', 'binary_reason(for interchange between Reason versions)', 'none')";
+    "-print-width", Arg.Int (fun x -> print_width := Some x), "<print-width>, wrapping width for printing the AST";
+    "-heuristics-file", Arg.String (fun x -> heuristics_file := Some x),
+    "<path>, load path as a heuristics file to specify whtich constructors are defined with multi-arguments. Mostly used in removing [@implicit_arity] introduced from OCaml conversion.\n\t\texample.txt:\n\t\tConstructor1\n\t\tConstructor2";
+  ]
+  (fun arg -> filename := arg)
+  "Reason: Meta Language Utility"
   in
-  let print_width = match print_width with
-      | None -> default_print_width
-      | Some x -> x
+  let filename = !filename in
+  let print_width = match !print_width with
+    | None -> default_print_width
+    | Some x -> x
+  in
+  let constructorLists = match !heuristics_file with
+    | None -> []
+    | Some file ->
+      let list = ref [] in
+      let chan = open_in file in
+      try
+        while true; do
+          list := input_line chan :: !list
+        done; []
+      with End_of_file ->
+        close_in chan;
+        List.rev !list
   in
   let chan =
-    match use_stdin with
+    match !use_stdin with
       | true -> stdin
       | false ->
           let file_chan = open_in filename in
           seek_in file_chan 0;
           file_chan
   in
-  let _ = if recoverable then
+  let _ = if !recoverable then
     Reason_config.configure ~r:true
   in
   Location.input_name := filename;
   let lexbuf = Lexing.from_channel chan in
   Location.init lexbuf filename;
-  let intf = match intf with
+  let intf = match !intf with
     | None when (Filename.check_suffix filename ".rei" || Filename.check_suffix filename ".mli") -> true
     | None -> false
     | Some b -> b
   in
   try
     if intf then (
-      let ((ast, comments), parsedAsML, parsedAsInterface) = match prse with
+      let ((ast, comments), parsedAsML, parsedAsInterface) = match !prse with
         | None -> (defaultInterfaceParserFor filename) lexbuf
         | Some "binary_reason" -> reasonBinaryParser chan
         | Some "ml" -> ((Reason_toolchain.ML.canonical_interface_with_comments lexbuf), true, true)
@@ -95,9 +108,10 @@ let () =
           raise (Invalid_config ("The file parsed does not appear to be an interface file.")) in
       let _ = Reason_pprint_ast.configure
           ~width: print_width
-          ~assumeExplicitArity
+          ~assumeExplicitArity: !assumeExplicitArity
+          ~constructorLists
       in
-      let thePrinter = match prnt with
+      let thePrinter = match !prnt with
         | Some "binary_reason" -> fun comments ast -> (
           (* Our special format for interchange between reason should keep the
            * comments separate.  This is not compatible for input into the
@@ -126,7 +140,7 @@ let () =
       in
       thePrinter comments ast
     ) else (
-      let ((ast, comments), parsedAsML, parsedAsInterface) = match prse with
+      let ((ast, comments), parsedAsML, parsedAsInterface) = match !prse with
         | None -> (defaultImplementationParserFor filename) lexbuf
         | Some "binary_reason" -> reasonBinaryParser chan
         | Some "ml" -> ((Reason_toolchain.ML.canonical_implementation_with_comments lexbuf), true, false)
@@ -139,9 +153,10 @@ let () =
           raise (Invalid_config ("The file parsed does not appear to be an implementation file.")) in
       let _ = Reason_pprint_ast.configure
           ~width: print_width
-          ~assumeExplicitArity
+          ~assumeExplicitArity: !assumeExplicitArity
+          ~constructorLists
       in
-      let thePrinter = match prnt with
+      let thePrinter = match !prnt with
         | Some "binary_reason" -> fun comments ast -> (
           (* Our special format for interchange between reason should keep the
            * comments separate.  This is not compatible for input into the