From 47834b053f2d48299c0ccb169759ccdd5c095ac0 Mon Sep 17 00:00:00 2001 From: Yunxing Dai Date: Tue, 8 Mar 2016 18:22:08 -0800 Subject: [PATCH] Add an option in reasonfmt "-heuristics-file" See updated README in the diff for details. --- README.md | 61 ++++++++++++- formatTest/formatOutput.re | 9 +- formatTest/test.sh | 7 +- formatTest/typeCheckedTests/arity.txt | 3 + .../typeCheckedTests/arityConversion.ml | 14 +++ .../typeCheckedTests/arityConversion.re | 15 +++ src/reasonfmt_impl.ml | 91 +++++++++++-------- 7 files changed, 154 insertions(+), 46 deletions(-) create mode 100644 formatTest/typeCheckedTests/arity.txt create mode 100644 formatTest/typeCheckedTests/arityConversion.ml create mode 100644 formatTest/typeCheckedTests/arityConversion.re diff --git a/README.md b/README.md index 839552e4be..1b1f9dc0b4 100644 --- a/README.md +++ b/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 ` +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: ------------------------------------------------------------ diff --git a/formatTest/formatOutput.re b/formatTest/formatOutput.re index 394908141d..4f839091fe 100644 --- a/formatTest/formatOutput.re +++ b/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;}; diff --git a/formatTest/test.sh b/formatTest/test.sh index 55a1163305..07608abb9b 100755 --- a/formatTest/test.sh +++ b/formatTest/test.sh @@ -42,7 +42,7 @@ 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 @@ -50,6 +50,7 @@ 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 diff --git a/formatTest/typeCheckedTests/arity.txt b/formatTest/typeCheckedTests/arity.txt new file mode 100644 index 0000000000..c91d2931cc --- /dev/null +++ b/formatTest/typeCheckedTests/arity.txt @@ -0,0 +1,3 @@ +And +TupleConstructor +Or diff --git a/formatTest/typeCheckedTests/arityConversion.ml b/formatTest/typeCheckedTests/arityConversion.ml new file mode 100644 index 0000000000..b5ad750b17 --- /dev/null +++ b/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 diff --git a/formatTest/typeCheckedTests/arityConversion.re b/formatTest/typeCheckedTests/arityConversion.re new file mode 100644 index 0000000000..11d5fbbe0c --- /dev/null +++ b/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); diff --git a/src/reasonfmt_impl.ml b/src/reasonfmt_impl.ml index bbb74d2753..fa85032e94 100644 --- a/src/reasonfmt_impl.ml +++ b/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), " add to load path"; - "-ignore", Arg.Unit ignore, "ignored"; - "-is-interface-pp", Arg.Bool (fun x -> intf := Some x), " parse AST as (either true or false)"; - "-use-stdin", Arg.Bool (fun x -> use_stdin := x), " parse AST from (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 AST as (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 AST in (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), " 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), ", parse AST as (either true or false)"; + "-use-stdin", Arg.Bool (fun x -> use_stdin := x), ", parse AST from (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 AST as (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 AST in (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), ", wrapping width for printing the AST"; + "-heuristics-file", Arg.String (fun x -> heuristics_file := Some x), + ", 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