TMP

Signed-off-by: Nathan Rebours <[email protected]>

CHANGES.md

@@ -1,6 +1,11 @@
 unreleased
 ----------
 
+- Add a `--use-compiler-pp` flag to the standalone driver. This flag
+ can be set when the driver outputs source code to make it use the compiler's
+ `Pprintast` instead of ppxlib's.
+ (#555, @NathanReb)
+
 0.34.0 (2025-01-06)
 -------------------
 

astlib/astlib.ml

@@ -94,6 +94,15 @@ module Compiler_pprintast = struct
 
   let structure_item fmt t = structure fmt [t]
   let signature_item fmt t = signature fmt [t]
+
+  exception Unavailable
+
+  (*IF_NOT_AT_LEAST 414 let class_field _fmt _t = raise Unavailable *)
+  (*IF_NOT_AT_LEAST 414 let class_type_field _fmt _t = raise Unavailable *)
+  (*IF_NOT_AT_LEAST 414 let class_expr _fmt _t = raise Unavailable *)
+  (*IF_NOT_AT_LEAST 414 let class_type _fmt _t = raise Unavailable *)
+  (*IF_NOT_AT_LEAST 414 let module_type _fmt _t = raise Unavailable *)
+  (*IF_NOT_AT_LEAST 414 let module_expr _fmt _t = raise Unavailable *)
 end
 
 let init_error_reporting_style_using_env_vars () =

src/driver.ml

@@ -1421,7 +1421,7 @@ let standalone_args =
     ( "--keywords",
       Arg.String (fun s -> keywords := Some s),
       "<version+list> Same as -keywords" );
-    ( "--use-compiler-pprint",
+    ( "--use-compiler-pp",
       Arg.Set use_compiler_pprint,
       "Force migrating the AST back to the compiler's version before printing \
        it as source code using the compiler's Pprintast utilities." );

test/driver/compiler-pp/driver.ml

@@ -0,0 +1,36 @@
+open Ppxlib
+
+let existential ~loc =
+  let lident = {loc; txt = Longident.parse "Constructor"} in
+  let pattern =
+    { ppat_loc = loc
+    ; ppat_loc_stack = []
+    ; ppat_attributes = []
+    ; ppat_desc =
+        Ppat_construct (lident, (Some ([{loc; txt = "a"}], [%pat? _])))
+    }
+  in
+  [%stri let f x = match x with [%p pattern] -> ()]
+
+let named_existential =
+  Context_free.Rule.extension
+    (Extension.V3.declare
+       "named_existentials"
+       Extension.Context.structure_item
+       Ast_pattern.(pstr nil)
+       (fun ~ctxt ->
+          let loc = Expansion_context.Extension.extension_point_loc ctxt in
+          existential ~loc))
+
+let () =
+  Driver.V2.register_transformation ~rules:[named_existential] "named_existentials"
+
+let str_type_decl =
+  Deriving.Generator.V2.make_noarg
+    (fun ~ctxt _type_decl ->
+       let loc = Expansion_context.Deriver.derived_item_loc ctxt in
+       [existential ~loc])
+
+let _ = Deriving.add ~str_type_decl "named_existentials"
+
+let () = Driver.standalone ()

test/driver/compiler-pp/dune

@@ -0,0 +1,11 @@
+(executable
+ (name driver)
+ (enabled_if
+  (< %{ocaml_version} "4.13"))
+ (libraries ppxlib)
+ (preprocess (pps ppxlib.metaquot)))
+
+(cram
+ (enabled_if
+  (< %{ocaml_version} "4.13"))
+ (deps driver.exe))

test/driver/compiler-pp/run.t

@@ -0,0 +1,65 @@
+The --use-compiler-pp flag can be used when using the driver's source code
+output, either directly are when generating a .corrected file, to force
+printing the AST as source using the installed compiler's printer.
+
+Our driver has a deriver and an extension that produces a pattern-matching with
+named existentials.
+
+This feature has been introduced in 4.13 so the syntax is unsupported before that.
+
+If we run the driver in source output mode, without the `--use-compiler-pp` flag,
+it will successfully print out the source using the 4.13 syntax. If we're running
+on an older compiler, like we are for this test, that can be troublesome.
+
+If instead we use the flag, this will force the migration thus causing an error as
+named existentials can't be migrated down to 4.12.
+
+Let's consider the following file:
+
+  $ cat > test.ml << EOF
+  > [%%named_existentials]
+  > EOF
+
+Running the driver will generate a function with a single pattern matching in it:
+
+  $ ./driver.exe test.ml
+  let f x = match x with | Constructor (type a) _ -> ()
+
+Now if we run it with `--use-compiler-pp`, we should get the migration error:
+
+  $ ./driver.exe --use-compiler-pp test.ml
+  File "test.ml", line 1, characters 0-22:
+  1 | [%%named_existentials]
+      ^^^^^^^^^^^^^^^^^^^^^^
+  Error: migration error: existentials in pattern-matching is not supported before OCaml 4.13
+  [1]
+
+This should also work for correction based code gen:
+
+  $ cat > test_inline.ml << EOF
+  > type t = int
+  > [@@deriving_inline named_existentials]
+  > [@@@end]
+  > EOF
+
+If we run the driver without `--use-compiler-pp`:
+
+  $ ./driver.exe test_inline.ml -diff-cmd -
+  type t = int[@@deriving_inline named_existentials]
+  [@@@end ]
+  $ cat test_inline.ml.ppx-corrected
+  type t = int
+  [@@deriving_inline named_existentials]
+  let _ = fun (_ : t) -> ()
+  let f x = match x with | Constructor (type a) _ -> ()
+  let _ = f
+  [@@@end]
+
+and with the flag:
+
+  $ ./driver.exe test_inline.ml -diff-cmd - --use-compiler-pp
+  File "test_inline.ml", lines 1-2, characters 0-38:
+  1 | type t = int
+  2 | [@@deriving_inline named_existentials]
+  Error: migration error: existentials in pattern-matching is not supported before OCaml 4.13
+  [1]