chore: port to ppxlib

nix/default.nix

@@ -24,6 +24,8 @@ ocamlPackages.buildDunePackage {
     cppo
     fix
     ppx_derivers
+    ppxlib
+    dune-build-info
   ];
 
 }

src/reason-merlin/ocamlmerlin_reason.cppo.ml

@@ -10,13 +10,17 @@ module Reason_reader = struct
 
   let structure str =
     let str =
-      Reason_syntax_util.(apply_mapper_to_structure str (backport_letopt_mapper remove_stylistic_attrs_mapper))
+      str
+      |> Reason_syntax_util.(apply_mapper_to_structure remove_stylistic_attrs_mapper)
+      |> Reason_syntax_util.(apply_mapper_to_structure backport_letopt_mapper)
     in
     Structure (Reason_toolchain.To_current.copy_structure str)
 
   let signature sg =
     let sg =
-      Reason_syntax_util.(apply_mapper_to_signature sg (backport_letopt_mapper remove_stylistic_attrs_mapper))
+      sg
+      |> Reason_syntax_util.(apply_mapper_to_signature remove_stylistic_attrs_mapper)
+      |> Reason_syntax_util.(apply_mapper_to_signature backport_letopt_mapper)
     in
     Signature (Reason_toolchain.To_current.copy_signature sg)
 

src/reason-parser-tests/testOprint.cppo.ml

@@ -20,9 +20,10 @@
  *)
 
 open Reason_omp
+module Ast = Ast_414
 
-module Convert = Reason_omp.Convert (Reason_omp.OCaml_411) (Reason_omp.OCaml_current)
-module ConvertBack = Reason_omp.Convert (Reason_omp.OCaml_current) (Reason_omp.OCaml_411)
+module Convert = Reason_omp.Convert (Reason_omp.OCaml_414) (Reason_omp.OCaml_current)
+module ConvertBack = Reason_omp.Convert (Reason_omp.OCaml_current) (Reason_omp.OCaml_414)
 
 let main () =
   let filename = "./TestTest.ml" in
@@ -39,7 +40,6 @@ let main () =
   Env.set_unit_name modulename;
 
   let ast = impl lexbuf in
-  let ast = Convert.copy_structure ast in
   let env = Compmisc.initial_env() in
 #if OCAML_VERSION >= (4,13,0)
   let { Typedtree.structure = typedtree; _ } =
@@ -48,7 +48,7 @@ let main () =
 #endif
     Typemod.type_implementation modulename modulename modulename env ast in
   let tree = Printtyp.tree_of_signature typedtree.Typedtree.str_type in
-  let phrase = (Ast_411.Outcometree.Ophr_signature
+  let phrase = (Ast.Outcometree.Ophr_signature
     (List.map (fun item -> (ConvertBack.copy_out_sig_item item, None)) tree)
   ) in
   let fmt = Format.str_formatter in

src/reason-parser/dune

@@ -151,4 +151,8 @@
   reason_parser_explain_raw
   reason_parser_explain
   reason_parser_recover)
- (libraries reason.ocaml-migrate-parsetree menhirLib reason.easy_format))
+ (libraries
+  reason.ocaml-migrate-parsetree
+  menhirLib
+  reason.easy_format
+  ppxlib))

src/reason-parser/reason_heuristics.ml

@@ -1,7 +1,7 @@
-open Reason_omp
+open Ppxlib
 
 let is_punned_labelled_expression e lbl =
-  let open Ast_411.Parsetree in
+  let open Parsetree in
   match e.pexp_desc with
   | Pexp_ident { txt }
   | Pexp_constraint ({pexp_desc = Pexp_ident { txt }}, _)
@@ -17,11 +17,11 @@ let is_punned_labelled_expression e lbl =
  * where the sum of the string contents and identifier names are less than the print width
  *)
 let funAppCallbackExceedsWidth ~printWidth ~args ~funExpr () =
-  let open Ast_411.Parsetree in
-  let open Ast_411.Asttypes in
+  let open Parsetree in
+  let open Asttypes in
   let funLen = begin match funExpr.pexp_desc with
     | Pexp_ident ident ->
-       let identList = Longident.flatten ident.txt in
+       let identList = Longident.flatten_exn ident.txt in
        let lengthOfDots = List.length identList - 1 in
        let len = List.fold_left (fun acc curr ->
          acc + (String.length curr)) lengthOfDots identList in
@@ -39,7 +39,7 @@ let funAppCallbackExceedsWidth ~printWidth ~args ~funExpr () =
       | (label, ({ pexp_desc = Pexp_ident ident } as e)) ->
         let identLen = List.fold_left (fun acc curr ->
           acc + (String.length curr)
-        ) len (Longident.flatten ident.txt) in
+        ) len (Longident.flatten_exn ident.txt) in
         begin match label with
         | Nolabel -> aux (len - identLen) args
         | Labelled s when is_punned_labelled_expression e s ->
@@ -88,17 +88,17 @@ let singleTokenPatternOmmitTrail txt = String.length txt < 4
  *  -> setTimeout((.) => Js.log("hola"), 1000);
  *)
 let bsExprCanBeUncurried expr =
-  match Ast_411.Parsetree.(expr.pexp_desc) with
+  match Parsetree.(expr.pexp_desc) with
   | Pexp_fun _
   | Pexp_apply _ -> true
   | _ -> false
 
 let isUnderscoreIdent expr =
-  match Ast_411.Parsetree.(expr.pexp_desc) with
+  match Parsetree.(expr.pexp_desc) with
   | Pexp_ident ({txt = Lident "_"}) -> true
   | _ -> false
 
-let isPipeFirst e = match Ast_411.Parsetree.(e.pexp_desc) with
+let isPipeFirst e = match Parsetree.(e.pexp_desc) with
   | Pexp_ident({txt = Longident.Lident("|.")}) -> true
   | Pexp_apply(
     {pexp_desc = Pexp_ident({txt = Longident.Lident("|.")})},
@@ -107,7 +107,7 @@ let isPipeFirst e = match Ast_411.Parsetree.(e.pexp_desc) with
   | _ -> false
 
 let isUnderscoreApplication expr =
-  let open Ast_411.Parsetree in
+  let open Parsetree in
   match expr with
   | {pexp_attributes = []; pexp_desc = Pexp_fun(
         Nolabel,
@@ -125,7 +125,7 @@ let isUnderscoreApplication expr =
  * An application with pipe first inside jsx children requires special treatment.
  * Jsx children don't allow expression application, hence we need the braces
  * preserved in this case. *)
-let isPipeFirstWithNonSimpleJSXChild e = match Ast_411.Parsetree.(e.pexp_desc) with
+let isPipeFirstWithNonSimpleJSXChild e = match Parsetree.(e.pexp_desc) with
   | Pexp_apply(
     {pexp_desc = Pexp_ident({txt = Longident.Lident("|.")})},
       [Nolabel, {pexp_desc = Pexp_apply(_)}; _]

src/reason-parser/reason_oprint.cppo.ml

@@ -84,12 +84,8 @@
   patching the right parts, through the power of types(tm)
 *)
 
-#ifdef BS_NO_COMPILER_PATCH
-open Reason_omp
-open Ast_411
-#endif
-
 open Format
+module Outcometree = Reason_omp.Ast_414.Outcometree
 open Outcometree
 
 exception Ellipsis
@@ -463,15 +459,15 @@ and print_simple_out_type ppf =
       fprintf ppf "@[<1>%a@]" print_out_type ty;
   | Otyp_abstract | Otyp_open
   | Otyp_sum _ | Otyp_record _ | Otyp_manifest (_, _) -> ()
-  | Otyp_module (p, n, tyl) ->
+
+  | Otyp_module (p, ntyls) ->
       fprintf ppf "@[<1>(module %a" print_ident p;
       let first = ref true in
-      List.iter2
-        (fun s t ->
+      List.iter
+        (fun (s, t) ->
           let sep = if !first then (first := false; "with") else "and" in
-          fprintf ppf " %s type %s = %a" sep s print_out_type t
-        )
-        n tyl;
+          fprintf ppf " %s type %s = %a" sep s print_out_type t)
+        ntyls;
       fprintf ppf ")@]"
   | Otyp_attribute (t, attr) ->
         fprintf ppf "@[<1>(%a [@@%s])@]" print_out_type t attr.oattr_name
@@ -532,15 +528,12 @@ and print_typargs ppf =
 
 let out_type = ref print_out_type
 
-(* Class types *)
 let variance = function
- (* co, contra *)
- | false, false -> ""
- | true, true -> ""
- | true, false -> "+"
- | false, true -> "-"
+ | Reason_omp.Ast_414.Asttypes.NoVariance -> ""
+ | Covariant -> "+"
+ | Contravariant -> "-"
 
-let type_parameter ppf (ty, var) =
+let type_parameter ppf (ty, (var, _)) =
   fprintf ppf "%s%s"
     (variance var)
     (if ty = "_" then ty else "'"^ty)
@@ -648,13 +641,19 @@ and print_out_signature ppf =
         match items with
             Osig_typext(ext, Oext_next) :: items ->
               gather_extensions
-                ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc)
+                ( { ocstr_name = ext.oext_name;
+                    ocstr_args = ext.oext_args;
+                    ocstr_return_type = ext.oext_ret_type;
+                  } :: acc)
                 items
           | _ -> (List.rev acc, items)
       in
       let exts, items =
         gather_extensions
-          [(ext.oext_name, ext.oext_args, ext.oext_ret_type)]
+          [ { ocstr_name = ext.oext_name
+            ; ocstr_args = ext.oext_args
+            ; ocstr_return_type = ext.oext_ret_type
+            } ]
           items
       in
       let te =
@@ -682,7 +681,11 @@ and print_out_sig_item ppf =
         print_out_class_type clt
   | Osig_typext (ext, Oext_exception) ->
       fprintf ppf "@[<2>exception %a@]"
-        print_out_constr (ext.oext_name, ext.oext_args, ext.oext_ret_type)
+        print_out_constr
+        { ocstr_name = ext.oext_name
+        ; ocstr_args = ext.oext_args
+        ; ocstr_return_type = ext.oext_ret_type
+        }
   | Osig_typext (ext, _) ->
       print_out_extension_constructor ppf ext
   | Osig_modtype (name, Omty_abstract) ->
@@ -766,8 +769,8 @@ and print_out_type_decl kwd ppf td =
     | _ -> td.otype_type
   in
   let print_private ppf = function
-    Asttypes.Private -> fprintf ppf " pri"
-  | Asttypes.Public -> ()
+    Reason_omp.Ast_414.Asttypes.Private -> fprintf ppf " pri"
+  | Public -> ()
   in
   let print_out_tkind ppf = function
   | Otyp_abstract -> ()
@@ -791,7 +794,7 @@ and print_out_type_decl kwd ppf td =
     print_out_tkind ty
     print_constraints
 
-and print_out_constr ppf (name, tyl,ret_type_opt) =
+and print_out_constr ppf {ocstr_name =name; ocstr_args = tyl; ocstr_return_type = ret_type_opt} =
   match ret_type_opt with
   | None ->
       begin match tyl with
@@ -844,8 +847,12 @@ and print_out_extension_constructor ppf ext =
   in
   fprintf ppf "@[<hv 2>type %t +=%s@;<1 2>%a@]"
     print_extended_type
-    (if ext.oext_private = Asttypes.Private then " pri" else "")
-    print_out_constr (ext.oext_name, ext.oext_args, ext.oext_ret_type)
+    (if ext.oext_private = Reason_omp.Ast_414.Asttypes.Private then " pri" else "")
+    print_out_constr
+    { ocstr_name = ext.oext_name
+    ; ocstr_args = ext.oext_args
+    ; ocstr_return_type = ext.oext_ret_type
+    }
 
 and print_out_type_extension ppf te =
   let print_extended_type ppf =
@@ -867,7 +874,7 @@ and print_out_type_extension ppf te =
   in
   fprintf ppf "@[<hv 2>type %t +=%s@;<1 2>%a@]"
     print_extended_type
-    (if te.otyext_private = Asttypes.Private then " pri" else "")
+    (if te.otyext_private = Reason_omp.Ast_414.Asttypes.Private then " pri" else "")
     (print_list print_out_constr (fun ppf -> fprintf ppf "@ | "))
     te.otyext_constructors
 
@@ -890,13 +897,13 @@ let rec print_items ppf =
         match items with
             (Osig_typext(ext, Oext_next), None) :: items ->
               gather_extensions
-                ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc)
+                ({ocstr_name = ext.oext_name; ocstr_args = ext.oext_args; ocstr_return_type = ext.oext_ret_type} :: acc)
                 items
           | _ -> (List.rev acc, items)
       in
       let exts, items =
         gather_extensions
-          [(ext.oext_name, ext.oext_args, ext.oext_ret_type)]
+          [{ ocstr_name = ext.oext_name; ocstr_args = ext.oext_args; ocstr_return_type = ext.oext_ret_type}]
           items
       in
       let te =