Reason V4 [Stacked Diff 4/n #2619] [Make merlin and rtop respect late…

…st syntax by default]

src/reason-merlin/ocamlmerlin_reason.cppo.ml

@@ -3,6 +3,12 @@ open Extend_protocol.Reader
 let () =
  Reason_config.recoverable := true
 
+(* Merlin integration will by default print types according to the package
+ * version. The reason is that when printing, we don't have original source
+ * files which include the version attribute. It is often just printing a
+ * type segment *)
+(* Somehow putting print version = 3.8 up here impacts the *parse* behavior!
+ * How? *)
 module Reason_reader = struct
  type t = buffer
 
@@ -44,6 +50,9 @@ module Reason_reader = struct
  fun () -> Lazy.force fmt
 
  let pretty_print ppf =
+ let print_version = Reason_version.latest_version_for_package in
+ let () = Reason_version.print_version.major <- print_version.major in
+ let () = Reason_version.print_version.minor <- print_version.minor in
  let open Reason_toolchain in
  function
  | Pretty_core_type x ->

src/reason-parser/reason_oprint.cppo.ml

@@ -163,8 +163,14 @@ let parenthesize_if_neg ppf fmt v isneg =
 
 
 let print_out_value ppf tree =
- let rec print_tree_1 ppf =
- function
+ let rec print_tree_1 ppf outcome =
+ let tag =
+ if Reason_version.print_supports Reason_version.HashVariantsColonMethodCallStarClassTypes then
+ "#"
+ else
+ "`"
+ in
+ match outcome with
  (* for the next few cases, please see context at https:https://github.com/facebook/reason/pull/1516#issuecomment-337069150 *)
  | Oval_constr (name, [Oval_constr ((Oide_ident { printed_name = "()" }), [])]) ->
  (* for normal variants, but sugar Foo(()) to Foo() *)
@@ -177,10 +183,10 @@ let print_out_value ppf tree =
  (print_tree_list print_tree_1 ",") params
  | Oval_variant (name, Some (Oval_constr ((Oide_ident { printed_name = "()" }), []))) ->
  (* for polymorphic variants, but sugar `foo(()) to `foo() *)
- fprintf ppf "@[<2>`%s()@]" name
+ fprintf ppf "@[<2>%s%s()@]" tag name
  | Oval_variant (name, Some param) ->
  (* for polymorphic variants *)
- fprintf ppf "@[<2>`%s(%a)@]" name print_constr_param param
+ fprintf ppf "@[<2>%s%s(%a)@]" tag name print_constr_param param
  | tree -> print_simple_tree ppf tree
  and print_constr_param ppf = function
  | Oval_int i -> parenthesize_if_neg ppf "%i" i (i < 0)
@@ -206,7 +212,13 @@ let print_out_value ppf tree =
  | Oval_array tl ->
  fprintf ppf "@[<2>[|%a|]@]" (print_tree_list print_tree_1 ",") tl
  | Oval_constr (name, []) -> print_ident ppf name
- | Oval_variant (name, None) -> fprintf ppf "`%s" name
+ | Oval_variant (name, None) ->
+ let opn =
+ if Reason_version.print_supports
+ Reason_version.HashVariantsColonMethodCallStarClassTypes then "#"
+ else "`"
+ in
+ fprintf ppf "%s%s" opn name
  | Oval_stuff s -> pp_print_string ppf s
  | Oval_record fel ->
  fprintf ppf "@[<1>{%a}@]" (cautious (print_fields true)) fel
@@ -249,8 +261,12 @@ let rec print_list pr sep ppf =
  | [a] -> pr ppf a
  | a :: l -> pr ppf a; sep ppf; print_list pr sep ppf l
 
-let pr_present =
- print_list (fun ppf s -> fprintf ppf "`%s" s) (fun ppf -> fprintf ppf "@ ")
+let pr_present () =
+ if Reason_version.print_supports
+ Reason_version.HashVariantsColonMethodCallStarClassTypes then
+ print_list (fun ppf s -> fprintf ppf "#%s" s) (fun ppf -> fprintf ppf "@ ")
+ else
+ print_list (fun ppf s -> fprintf ppf "`%s" s) (fun ppf -> fprintf ppf "@ ")
 
 let pr_vars =
  print_list (fun ppf s -> fprintf ppf "'%s" s) (fun ppf -> fprintf ppf "@ ")
@@ -266,8 +282,7 @@ let get_label lbl =
  Optional (String.sub lbl 1 @@ String.length lbl - 1)
  else Labeled lbl
 
-let rec print_out_type ppf =
- function
+let rec print_out_type ppf outcome = match outcome with
  | Otyp_alias (ty, s) ->
  fprintf ppf "@[%a@ as '%s@]" print_out_type ty s
  | Otyp_poly (sl, ty) ->
@@ -305,7 +320,7 @@ and print_out_type_1 ~uncurried ppf =
  in
  pp_open_box ppf 0;
  let (args, result) = collect_args [] x in
- let should_wrap_with_parens =
+ let should_wrap =
  (* uncurried arguments are always wrapped in parens *)
  if uncurried then true
  else match args with
@@ -315,10 +330,15 @@ and print_out_type_1 ~uncurried ppf =
  | ["", _] -> false
  | _ -> true
  in
- if should_wrap_with_parens then pp_print_string ppf "(";
+
+ let opn, close =
+ if Reason_version.print_supports AngleBracketTypes then "<", ">"
+ else "(", ")"
+ in
+ if should_wrap then pp_print_string ppf opn;
  if uncurried then fprintf ppf ".@ ";
  print_list print_arg (fun ppf -> fprintf ppf ",@ ") ppf args;
- if should_wrap_with_parens then pp_print_string ppf ")";
+ if should_wrap then pp_print_string ppf close;
 
  pp_print_string ppf " =>";
  pp_print_space ppf ();
@@ -442,7 +462,7 @@ and print_simple_out_type ppf =
  let print_present ppf =
  function
  None | Some [] -> ()
- | Some l -> fprintf ppf "@;<1 -2>> @[<hov>%a@]" pr_present l
+ | Some l -> fprintf ppf "@;<1 -2>> @[<hov>%a@]" (pr_present ()) l
  in
  let print_fields ppf =
  function
@@ -490,13 +510,20 @@ and print_row_field ppf (l, opt_amp, tyl) =
  let pr_of ppf =
  if opt_amp then fprintf ppf " &@ "
  else fprintf ppf "" in
+ let tag =
+ if Reason_version.print_supports Reason_version.HashVariantsColonMethodCallStarClassTypes then
+ "#"
+ else
+ "`"
+ in
  let parens = match tyl with
  | [ (Otyp_tuple _) ] -> false (* tuples already have parentheses *)
  (* [< `Ok(string & int) ] ----> string & int
  * [< `Ok(string) ] -----> string *)
  | _::_ -> true
  | _ -> false in
- fprintf ppf "@[<hv 2>`%s%t%s%a%s@]"
+ fprintf ppf "@[<hv 2>%s%s%t%s%a%s@]"
+ tag
  l
  pr_of
  (if parens then "(" else "")
@@ -516,19 +543,23 @@ and print_out_wrap_type ppf =
  | (Otyp_constr (_, _::_)) as ty ->
  print_out_type ppf ty
  | ty -> print_simple_out_type ppf ty
-and print_typargs ppf =
- function
- [] -> ()
+and print_typargs ppf args =
+ let opn, close =
+ if Reason_version.print_supports AngleBracketTypes then "<", ">"
+ else "(", ")"
+ in
+ match args with
+ | [] -> ()
  | [ty1] ->
- pp_print_string ppf "(";
+ pp_print_string ppf opn;
  print_out_wrap_type ppf ty1;
- pp_print_string ppf ")"
+ pp_print_string ppf close
  | tyl ->
- pp_print_string ppf "(";
+ pp_print_string ppf opn;
  pp_open_box ppf 1;
  print_typlist print_out_wrap_type "," ppf tyl;
  pp_close_box ppf ();
- pp_print_string ppf ")"
+ pp_print_string ppf close
 
 let out_type = ref print_out_type
 
@@ -736,14 +767,19 @@ and print_out_type_decl kwd ppf td =
  td.otype_cstrs
  in
  let type_defined ppf =
+ let opn, close =
+ if Reason_version.print_supports AngleBracketTypes then "<", ">" else "(", ")"
+ in
  match td.otype_params with
  [] -> pp_print_string ppf td.otype_name
- | [param] -> fprintf ppf "@[%s(%a)@]" td.otype_name type_parameter param
+ | [param] -> fprintf ppf "@[%s%s%a%s@]" td.otype_name opn type_parameter param close
  | _ ->
- fprintf ppf "@[%s(@[%a@])@]"
+ fprintf ppf "@[%s%s@[%a@]%s@]"
  td.otype_name
+ opn
  (print_list type_parameter (fun ppf -> fprintf ppf ",@ "))
  td.otype_params
+ close
  in
  let print_manifest ppf =
  function

src/refmttype/reason_format_type.ml

@@ -6,6 +6,16 @@
  *)
 
 
+let () = Reason_pprint_ast.configure
+ (* This can be made pluggable in the future. *)
+ ~width:80
+ ~assumeExplicitArity:false
+ ~constructorLists:[]
+
+let print_version = Reason_version.latest_version_for_package
+let () = Reason_version.print_version.major <- print_version.major
+let () = Reason_version.print_version.minor <- print_version.minor
+
 (* No String.split in stdlib... *)
 let split str ~by =
  let rec split' str ~by accum =

src/refmttype/reason_type_of_ocaml_type.ml

@@ -5,13 +5,6 @@
  * LICENSE file in the root directory of this source tree.
  *)
 
-
-let () = Reason_pprint_ast.configure
- (* This can be made pluggable in the future. *)
- ~width:80
- ~assumeExplicitArity:false
- ~constructorLists:[]
-
 let reasonFormatter = Reason_pprint_ast.createFormatter ()
 
 (* "Why would you ever pass in some of these to print into Reason?"

src/rtop/rtop.ml

@@ -4,22 +4,30 @@ let () = try Topdirs.dir_directory (Sys.getenv "OCAML_TOPLEVEL_PATH") with | Not
 
 let () = UTop.require ["reason.easy_format"; "reason";]
 
+let print_version = Reason_version.latest_version_for_package
+let () = Reason_version.cli_arg_parse_version.major <- print_version.major
+let () = Reason_version.cli_arg_parse_version.minor <- print_version.minor
+let () = Reason_version.print_version.major <- print_version.major
+let () = Reason_version.print_version.minor <- print_version.minor
+
 let () = Reason_toploop.main ()
 
 let () = Reason_utop.init_reason ()
 
 let () = print_string
-"
- ___ _______ ________ _ __
- / _ \\/ __/ _ | / __/ __ \\/ |/ /
- / , _/ _// __ |_\\ \\/ /_/ / /
- /_/|_/___/_/ |_/___/\\____/_/|_/
+{|
+ _ __ ___ __ _ ___ ___ _ __
+ | '__/ _ \/ _` / __|/ _ \| '_ \
+ | | | __/ (_| \__ \ (_) | | | |
+ |_| \___|\__,_|___/\___/|_| |_|
+
+ (syntax version 3.8)
 
- Execute statements/let bindings. Hit <enter> after the semicolon. Ctrl-d to quit.
+  Semicolon submits statements. Ctrl-d to quit.
 
- > let myVar = \"Hello Reason!\";
- > let myList: list(string) = [\"first\", \"second\"];
- > #use \"./src/myFile.re\"; /* loads the file into here */
-"
+ > let myVar = "Hello Reason!";
+ > let myList: list<string> = ["first", "second"];
+ > #use "./src/myFile.re"; /* loads the file into here */
+|}
 
-let () = UTop_main.main ()
+let () = UTop_main.main ()