Prepare for 5.2 AST bump

src/reason-parser/reason_heuristics.ml

@@ -87,7 +87,7 @@ let singleTokenPatternOmmitTrail txt = String.length txt < 4
  *)
 let bsExprCanBeUncurried expr =
   match Parsetree.(expr.pexp_desc) with
-  | Pexp_fun _ | Pexp_apply _ -> true
+  | Pexp_function (_ :: _, _, _) | Pexp_apply _ -> true
   | _ -> false
 
 let isUnderscoreIdent expr =
@@ -107,11 +107,8 @@ let isUnderscoreApplication expr =
   match expr with
   | { pexp_attributes = []
     ; pexp_desc =
-        Pexp_fun
-          ( Nolabel
-          , None
-          , { ppat_desc = Ppat_var { txt = "__x" }; ppat_attributes = [] }
-          , _ )
+        Pexp_function
+          ({ pparam_desc = Pparam_val (Nolabel, None, { ppat_desc = Ppat_var { txt = "__x" }; ppat_attributes = [] }); _ } :: _, _, _)
     } ->
     true
   | _ -> false

src/reason-parser/reason_parser.mly

@@ -549,15 +549,22 @@ let process_underscore_application args =
             (* build `doStuff(3, __x, 7)` *)
             let innerApply = {arg2 with pexp_desc = Pexp_apply(arg2, args)} in
             (* build `__x => doStuff(3, __x, 7)` *)
+            (* TODO: Could this make use of max arity functions? *)
+            let param : Ppxlib.function_param =
+              { pparam_desc = Pparam_val (Nolabel, None, pattern); pparam_loc = loc }
+            in
             let innerFun =
-              mkexp (Pexp_fun (Nolabel, None, pattern, innerApply)) ~loc
+              mkexp (Pexp_function ([param], None, Pfunction_body innerApply)) ~loc
             in
             (* build `5 |. (__x => doStuff(3, __x, 7))` *)
             {exp_apply with pexp_desc =
               Pexp_apply(pipeExp, [Nolabel, arg1; Nolabel, innerFun])
             }
         | _ ->
-          mkexp (Pexp_fun (Nolabel, None, pattern, exp_apply)) ~loc
+          let param : Ppxlib.function_param =
+            { pparam_desc = Pparam_val (Nolabel, None, pattern); pparam_loc = loc }
+          in
+          mkexp (Pexp_function ([param], None, Pfunction_body exp_apply)) ~loc
         end
     | None ->
         exp_apply in
@@ -734,9 +741,9 @@ let varify_constructors var_names t =
                  { obj with pof_desc = pof_desc' }) lst, o)
       | Ptyp_class (longident, lst) ->
           Ptyp_class (longident, List.map loop lst)
-      | Ptyp_alias(core_type, string) ->
-          check_variable var_names t.ptyp_loc string;
-          Ptyp_alias(loop core_type, string)
+      | Ptyp_alias(core_type, lbl) ->
+          check_variable var_names t.ptyp_loc lbl.txt;
+          Ptyp_alias(loop core_type, lbl)
       | Ptyp_variant(row_field_list, flag, lbl_lst_option) ->
           Ptyp_variant(List.map loop_row_field row_field_list,
                        flag, lbl_lst_option)
@@ -747,6 +754,7 @@ let varify_constructors var_names t =
           Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst)
       | Ptyp_extension (s, arg) ->
           Ptyp_extension (s, arg)
+      | Ptyp_open (m, c) -> Ptyp_open (m, c)
     in
     {t with ptyp_desc = desc}
   and loop_row_field  =
@@ -2961,7 +2969,7 @@ mark_position_exp
    *)
   | FUN optional_expr_extension match_cases(expr) %prec below_BAR
     { let loc = mklocation $startpos $endpos in
-      $2 ~loc (mkexp (Pexp_function $3)) }
+    $2 ~loc (mkexp (Pexp_function ([], None, (Pfunction_cases ($3, loc, []))))) }
   | SWITCH optional_expr_extension simple_expr_no_constructor
     LBRACE match_cases(seq_expr(SEMI?)) RBRACE
     { let loc = mklocation $startpos $endpos in
@@ -4515,7 +4523,7 @@ mark_position_typ
   (
     core_type2
     { $1 }
-  | core_type2 AS QUOTE ident
+  | core_type2 AS QUOTE as_loc(ident)
     { mktyp(Ptyp_alias($1, $4)) }
   ) {$1};
 

src/reason-parser/reason_pprint_ast.ml

@@ -159,7 +159,7 @@ let expression_immediate_extension_sugar x =
   | None -> None, x
   | Some (name, expr) ->
     (match expr.pexp_desc with
-    | Pexp_for _ | Pexp_while _ | Pexp_ifthenelse _ | Pexp_function _
+    | Pexp_for _ | Pexp_while _ | Pexp_ifthenelse _ | Pexp_function ([], _, Pfunction_cases _)
     | Pexp_newtype _ | Pexp_try _ | Pexp_match _ ->
       Some name, expr
     | _ -> None, x)
@@ -251,8 +251,8 @@ let same_ast_modulo_varification_and_extensions t1 t2 =
       for_all2' tester lst1 lst2 && o1 = o2
     | Ptyp_class (longident1, lst1), Ptyp_class (longident2, lst2) ->
       longident_same longident1 longident2 && for_all2' loop lst1 lst2
-    | Ptyp_alias (core_type1, string1), Ptyp_alias (core_type2, string2) ->
-      loop core_type1 core_type2 && string_equal string1 string2
+    | Ptyp_alias (core_type1, lbl1), Ptyp_alias (core_type2, lbl2) ->
+      loop core_type1 core_type2 && string_equal lbl1.txt lbl2.txt
     | ( Ptyp_variant (row_field_list1, flag1, lbl_lst_option1)
       , Ptyp_variant (row_field_list2, flag2, lbl_lst_option2) ) ->
       for_all2' rowFieldEqual row_field_list1 row_field_list2
@@ -2665,7 +2665,7 @@ let createFormatter () =
                 (label
                    ~space:true
                    (self#core_type ct)
-                   (makeList ~postSpace:true [ atom "as"; atom ("'" ^ s) ]))
+                   (makeList ~postSpace:true [ atom "as"; atom ("'" ^ s.txt) ]))
             | _ -> self#core_type2 x
 
         method type_with_label (lbl, c, uncurried) =
@@ -3452,6 +3452,7 @@ let createFormatter () =
               | Ptyp_extension e -> self#extension e
               | Ptyp_arrow (_, _, _) | Ptyp_alias (_, _) | Ptyp_poly (_, _) ->
                 makeList ~wrap:("(", ")") ~break:IfNeed [ self#core_type x ]
+              | Ptyp_open _ -> failwith "Unsupported local open"
             in
             source_map ~loc:x.ptyp_loc result
         (* TODO: ensure that we have a form of desugaring that protects *)
@@ -4208,7 +4209,7 @@ let createFormatter () =
                     (List.map self#item_attribute attrs)
                 in
                 makeSpacedBreakableInlineList [ formattedAttrs; constant ])
-            | { pexp_desc = Pexp_fun _ } -> self#formatPexpFun e
+            | { pexp_desc = Pexp_function (_ :: _, _, _) } -> self#formatPexpFun e
             | x -> self#unparseExpr x
           in
           source_map ~loc:e.pexp_loc itm
@@ -4511,17 +4512,21 @@ let createFormatter () =
             | _ -> expr
           in
           match x.pexp_desc with
-          | Pexp_fun
-              ( Nolabel
-              , None
-              , { ppat_desc = Ppat_var { txt = "__x" } }
-              , ({ pexp_desc = Pexp_apply _ } as e) ) ->
+          | Pexp_function
+              ( [ { pparam_desc = Pparam_val (Nolabel, None, { ppat_desc = Ppat_var { txt = "__x" } }); _ } ]
+              , _constraint_
+              , Pfunction_body ({ pexp_desc = Pexp_apply _ } as e)
+              ) ->
             process_application e
-          | Pexp_fun (l, eo, p, e) ->
-            let e_processed = self#process_underscore_application e in
-            if e == e_processed
-            then x
-            else { x with pexp_desc = Pexp_fun (l, eo, p, e_processed) }
+          | Pexp_function (params, constraint_, e) -> (
+            match e with
+            | Pfunction_cases _ -> x
+            | Pfunction_body e ->
+              let e_processed = self#process_underscore_application e in
+              if e == e_processed
+              then x
+              else { x with pexp_desc = Pexp_function (params, constraint_, Pfunction_body e_processed) }
+          )
           | _ -> x
 
         method unparseExprRecurse x =
@@ -5264,7 +5269,7 @@ let createFormatter () =
              with
             | [ x ] -> x
             | xs -> makeList xs)
-          | { pexp_desc = Pexp_fun _ } ->
+          | { pexp_desc = Pexp_function (_ :: _, _, _) } ->
             self#formatPexpFun ~prefix:(atom "...") ~wrap:("{", "}") expr
           | _ ->
             (* Currently spreading a list must be wrapped in { }.
@@ -5428,13 +5433,13 @@ let createFormatter () =
                     (makeList [ atom lbl; atom "=" ])
                     (self#simplifyUnparseExpr ~wrap:("{", "}") expression)
                 | Pexp_record _ | Pexp_construct _ | Pexp_array _ | Pexp_tuple _
-                | Pexp_match _ | Pexp_extension _ | Pexp_function _ ->
+                | Pexp_match _ | Pexp_extension _ | Pexp_function ([], _, Pfunction_cases _) ->
                   label
                     (makeList [ atom lbl; atom "=" ])
                     (self#dont_preserve_braces#simplifyUnparseExpr
                        ~wrap:("{", "}")
                        expression)
-                | Pexp_fun _ ->
+                | Pexp_function (_ :: _, _, _) ->
                   let propName = makeList [ atom lbl; atom "=" ] in
                   self#formatPexpFun
                     ~wrap:("{", "}")
@@ -5870,6 +5875,10 @@ let createFormatter () =
           let uncurried =
             try Hashtbl.find uncurriedTable x.pexp_loc with Not_found -> false
           in
+          let extract_from_params param = match param.pparam_desc with
+            | Pparam_val (lbl, eo, pat) -> `Value (lbl, eo, pat)
+            | Pparam_newtype newtype -> `Type newtype
+          in
           let rec extract_args xx =
             let { Reason_attributes.stdAttrs } =
               Reason_attributes.partitionAttributes
@@ -5880,10 +5889,19 @@ let createFormatter () =
             then [], xx
             else
               match xx.pexp_desc with
-              (* label * expression option * pattern * expression *)
-              | Pexp_fun (l, eo, p, e) ->
-                let args, ret = extract_args e in
-                `Value (l, eo, p) :: args, ret
+              | Pexp_function (params, constraint_, body) -> (
+                let vs = List.map extract_from_params params in
+                match constraint_ with
+                | Some _ -> vs, xx
+                | None -> (
+                  match body with
+                  | Pfunction_cases _ as c ->
+                    vs, { xx with pexp_desc = Pexp_function ([], None, c) }
+                  | Pfunction_body e ->
+                    let args, ret = extract_args e in
+                    vs @ args, ret
+                )
+              )
               | Pexp_newtype (newtype, e) ->
                 let args, ret = extract_args e in
                 `Type newtype :: args, ret
@@ -6932,9 +6950,9 @@ let createFormatter () =
           (* Pexp_function, on the other hand, doesn't need wrapping in parens
              in most cases anymore, since `fun` is not ambiguous anymore (we
              print Pexp_fun as ES6 functions). *)
-          | Pexp_function l ->
+          | Pexp_function ([], _constraint_, Pfunction_cases (cases, _loc, _attrs)) ->
             let prec = Custom funToken in
-            let expr = self#patternFunction ?extension x.pexp_loc l in
+            let expr = self#patternFunction ?extension x.pexp_loc cases in
             Some
               (SpecificInfixPrecedence
                  ( { reducePrecedence = prec; shiftPrecedence = prec }
@@ -6944,7 +6962,7 @@ let createFormatter () =
                printing breaks for them. *)
             let itm =
               match x.pexp_desc with
-              | Pexp_fun _ | Pexp_newtype _ ->
+              | Pexp_function (_ :: _, _, _) | Pexp_newtype _ ->
                 (* let uncurried = *)
                 let args, ret = self#curriedPatternsAndReturnVal x in
                 (match args with
@@ -7584,13 +7602,13 @@ let createFormatter () =
               match x.pexp_desc with
               (* The only reason Pexp_fun must also be wrapped in parens is that
                  its => token will be confused with the match token. *)
-              | Pexp_fun _ when pipe || semi ->
+              | Pexp_function (_ :: _, _, _) when pipe || semi ->
                 Some (self#reset#simplifyUnparseExpr x)
-              | Pexp_function l when pipe || semi ->
+              | Pexp_function ([], _constraint_, Pfunction_cases (cases, loc, _attrs)) when pipe || semi ->
                 Some
                   (formatPrecedence
                      ~loc:x.pexp_loc
-                     (self#reset#patternFunction x.pexp_loc l))
+                     (self#reset#patternFunction loc cases))
               | Pexp_apply _ ->
                 (match self#simple_get_application x with
                 (* If it's the simple form of application. *)
@@ -9129,7 +9147,7 @@ let createFormatter () =
               (makeTup argsList)
               []
               ([ self#moduleExpressionToFormattedApplicationItems return ], None)
-          | Pmod_apply _ -> self#moduleExpressionToFormattedApplicationItems x
+          | Pmod_apply _ | Pmod_apply_unit _ -> self#moduleExpressionToFormattedApplicationItems x
           | Pmod_extension (s, e) -> self#payload "%" s e
           | Pmod_unpack _ | Pmod_ident _ | Pmod_constraint _ | Pmod_structure _
             ->
@@ -9721,12 +9739,12 @@ let createFormatter () =
           let categorizeFunApplArgs args =
             let reverseArgs = List.rev args in
             match reverseArgs with
-            | ((_, { pexp_desc = Pexp_fun _ }) as callback) :: args
+            | ((_, { pexp_desc = Pexp_function (_ :: _, _, _) }) as callback) :: args
               when []
                    == List.filter
                         (fun (_, e) ->
                            match e.pexp_desc with
-                           | Pexp_fun _ -> true
+                           | Pexp_function (_ :: _, _, _) -> true
                            | _ -> false)
                         args
                    (* default to normal formatting if there's more than one

src/reason-parser/reason_syntax_util.cppo.ml

@@ -383,8 +383,8 @@ let map_core_type f typ =
         , closed_flag)
     | Ptyp_class (lid, typs) ->
       Ptyp_class (map_lident f lid, typs)
-    | Ptyp_alias (typ, s) ->
-      Ptyp_alias (typ, f s)
+    | Ptyp_alias (typ, lbl) ->
+      Ptyp_alias (typ, { lbl with txt = f lbl.txt })
     | Ptyp_variant (rfs, closed, lbls) ->
       Ptyp_variant (List.map (function
         | { prf_desc = Rtag (lbl, b, cts) } as prf ->
@@ -420,8 +420,13 @@ class identifier_mapper f =
         match expr with
         | { pexp_desc = Pexp_ident lid } ->
           { expr with pexp_desc = Pexp_ident (map_lid lid) }
-        | { pexp_desc = Pexp_fun (label, eo, pat, e) } when !rename_labels ->
-          { expr with pexp_desc = Pexp_fun (map_label label, eo, pat, e) }
+        | { pexp_desc = Pexp_function (params, constraint_, body) } when !rename_labels ->
+          let new_params = List.map (function
+            | { pparam_desc = Pparam_val (lbl, eo, pat); _ } as v ->
+              { v with pparam_desc = Pparam_val (map_label lbl, eo, pat) }
+            | v -> v) params
+          in
+          { expr with pexp_desc = Pexp_function (new_params, constraint_, body) }
         | { pexp_desc = Pexp_apply (e, args) } when !rename_labels ->
           { expr with
             pexp_desc = Pexp_apply (e, List.map (fun (label, e) ->

test/ocaml_identifiers.t/run.t

@@ -113,4 +113,4 @@ Format OCaml identifiers file
       y;
     });
 
-  let newType = (type method, ()) => ();
+  let newType = (type method_, ()) => ();