Make code more backward-compatible with existing ppxes

Author: ncik-roberts

ocaml/parsing/pprintast.ml

@@ -1424,7 +1424,7 @@ and pp_print_pexp_function ctxt sep f x =
      makes the pretty-printing a bit prettier. *)
   match Jane_syntax.Expression.of_ast x with
   | Some (Jexp_n_ary_function (params, c, body), []) ->
-      function_params_then_body ctxt f params c body ~delimiter:"="
+      function_params_then_body ctxt f params c body ~delimiter:sep
   | Some (Jexp_layout (Lexp_newtype (str, lay, e)), []) ->
       pp f "@[(type@ %s :@ %a)@]@ %a"
         str.txt
@@ -1438,6 +1438,10 @@ and pp_print_pexp_function ctxt sep f x =
     match x.pexp_desc with
     | Pexp_newtype (str,e) ->
       pp f "(type@ %s)@ %a" str.txt (pp_print_pexp_function ctxt sep) e
+    | Pexp_fun (a, b, c, body) ->
+      pp f "%a@;%a"
+        (label_exp ctxt) (a, b, c)
+        (pp_print_pexp_function ctxt sep) body
     | _ ->
        pp f "%s@;%a" sep (expression ctxt) x
 
@@ -2023,13 +2027,13 @@ and function_constraint
       (core_type ctxt) ty2
 
 and function_params_then_body ctxt f params constraint_ body ~delimiter =
-  let pp_params f () =
+  let pp_params f =
     match params with
     | [] -> ()
     | _ :: _ -> pp f "%a@;" (list (function_param ctxt) ~sep:"@ ") params
   in
-  pp f "%a%a%s@;%a"
-    pp_params ()
+  pp f "%t%a%s@;%a"
+    pp_params
     (option (function_constraint ctxt) ~first:"@;") constraint_
     delimiter
     (function_body (under_functionrhs ctxt)) body
@@ -2057,11 +2061,10 @@ and n_ary_function_expr
         (function_body ctxt) body
         (function_constraint ctxt) constraint_
     | _ :: _, _ ->
-      pp f "@[<2>fun@;%a@]"
-        (fun f () ->
+      pp f "@[<2>fun@;%t@]"
+        (fun f ->
           function_params_then_body
             ctxt f params constraint_ body ~delimiter:"->")
-        ()
 
 let toplevel_phrase f x =
   match x with

ocaml/typing/typecore.ml

@@ -3756,10 +3756,18 @@ let rec type_approx env sexp ty_expected =
   | Some (jexp, _attrs) -> type_approx_aux_jane_syntax ~loc env jexp ty_expected
   | None      -> match sexp.pexp_desc with
     Pexp_let (_, _, e) -> type_approx env e ty_expected
-  | Pexp_fun _ ->
-      Misc.fatal_error "[type_approx] didn't expect [Pexp_fun]"
-  | Pexp_function _ ->
-      Misc.fatal_error "[type_approx] didn't expect [Pexp_function]"
+  | Pexp_fun (lbl, def, pat, body) ->
+      let open Jane_syntax.N_ary_functions in
+      type_approx_function ~loc env
+        [ { pparam_desc = Pparam_val (lbl, def, pat);
+            pparam_loc = pat.ppat_loc
+          }
+        ]
+        None (Pfunction_body body) ty_expected
+  | Pexp_function cases ->
+      let open Jane_syntax.N_ary_functions in
+      type_approx_function ~loc
+        env [] None (Pfunction_cases (cases, sexp.pexp_loc, [])) ty_expected
   | Pexp_match (_, {pc_rhs=e}::_) -> type_approx env e ty_expected
   | Pexp_try (e, _) -> type_approx env e ty_expected
   | Pexp_tuple l ->