Merge pull request #594 from janestreet/ppxlib.end

NathanReb · web-flow · commit a5be80d4c9f0 · 2025-09-16T11:03:55.000+02:00
Add `@@@ppxlib.inline.end`, deprecate `@@@deriving.end`
diff --git a/CHANGES.md b/CHANGES.md
@@ -23,6 +23,8 @@ unreleased
 
 - Expose `Ppxlib.Location.Error.t = Astlib.Location.Error.t` (#593, @ceastlund)
 
+- Add `@@@ppxlib.inline.end`, deprecate `@@@deriving.end`. (#594, @ceastlund)
+
 0.36.1 (2025-07-10)
 -------------------
 
diff --git a/src/code_matcher.ml b/src/code_matcher.ml
@@ -3,13 +3,25 @@ open! Import
 module Format = Stdlib.Format
 module Filename = Stdlib.Filename
 
-(* TODO: make the "deriving." depend on the matching attribute name. *)
+let allow_deriving_end = ref true
+
+(* TODO: make the "deriving." or other prefix depend on the matching attribute name. *)
 let end_marker_sig =
-  Attribute.Floating.declare "deriving.end" Signature_item
+  Attribute.Floating.declare "ppxlib.inline.end" Signature_item
     Ast_pattern.(pstr nil)
     ()
 
 let end_marker_str =
+  Attribute.Floating.declare "ppxlib.inline.end" Structure_item
+    Ast_pattern.(pstr nil)
+    ()
+
+let deprecated_end_marker_sig =
+  Attribute.Floating.declare "deriving.end" Signature_item
+    Ast_pattern.(pstr nil)
+    ()
+
+let deprecated_end_marker_str =
   Attribute.Floating.declare "deriving.end" Structure_item
     Ast_pattern.(pstr nil)
     ()
@@ -24,6 +36,7 @@ module Make (M : sig
 
   val get_loc : t -> Location.t
   val end_marker : (t, unit) Attribute.Floating.t
+  val deprecated_end_marker : (t, unit) Attribute.Floating.t
 
   module Transform (T : T1) : sig
     val apply :
@@ -51,10 +64,27 @@ struct
               [] )
       | x :: l -> (
           match Attribute.Floating.convert_res [ M.end_marker ] x with
-          | Ok None -> loop (x :: acc) l
           | Ok (Some ()) -> Ok (List.rev acc, (M.get_loc x).loc_start)
           | Error e -> Error e
-          | exception Failure _ -> loop (x :: acc) l)
+          | (exception Failure _) | Ok None -> (
+              match
+                Attribute.Floating.convert_res [ M.deprecated_end_marker ] x
+              with
+              | Ok (Some ()) ->
+                  if !allow_deriving_end then
+                    Ok (List.rev acc, (M.get_loc x).loc_start)
+                  else
+                    Error
+                      ( Location.Error.createf ~loc:(M.get_loc x)
+                          "ppxlib: [@@@@@@%s] is deprecated, please use \
+                           [@@@@@@%s]. If you need the deprecated attribute \
+                           temporarily, pass [-allow-deriving-end] to the ppx \
+                           driver)."
+                          (Attribute.Floating.name M.deprecated_end_marker)
+                          (Attribute.Floating.name M.end_marker),
+                        [] )
+              | Error e -> Error e
+              | (exception Failure _) | Ok None -> loop (x :: acc) l))
     in
     loop [] l
 
@@ -170,6 +200,7 @@ module Str = Make (struct
 
   let get_loc x = x.pstr_loc
   let end_marker = end_marker_str
+  let deprecated_end_marker = deprecated_end_marker_str
 
   module Transform (T : T1) = struct
     let apply o = o#structure_item
@@ -188,6 +219,7 @@ module Sig = Make (struct
 
   let get_loc x = x.psig_loc
   let end_marker = end_marker_sig
+  let deprecated_end_marker = deprecated_end_marker_sig
 
   module Transform (T : T1) = struct
     let apply o = o#signature_item
diff --git a/src/code_matcher.mli b/src/code_matcher.mli
@@ -39,3 +39,8 @@ val match_signature :
   signature ->
   unit
 (** Same for signatures *)
+
+val allow_deriving_end : bool ref
+(** The legacy attribute [@@@deriving.end] is disabled by default, and
+    superseded by [@@@ppxlib.inline.end]. It can be enabled by setting
+    [allow_deriving_end := true]. See [-allow-deriving-end] in [Driver]. *)
diff --git a/src/driver.ml b/src/driver.ml
@@ -1339,6 +1339,9 @@ let shared_args =
     ( "-raise-embedded-errors",
       Arg.Set raise_embedded_errors_flag,
       " Raise the first embedded error found in the processed AST" );
+    ( "-allow-deriving-end",
+      Arg.Bool (( := ) Code_matcher.allow_deriving_end),
+      " Whether to allow [@@@deriving.end], which will soon be deprecated." );
   ]
 
 let () =
diff --git a/test/deriving/inline/example/ppx_deriving_example.ml b/test/deriving/inline/example/ppx_deriving_example.ml
@@ -13,4 +13,4 @@ include struct
     [%foo]
 end [@@ocaml.doc "@inline"]
 
-[@@@deriving.end]
+[@@@inline.end]
diff --git a/test/driver/run_as_ppx_rewriter/run.t b/test/driver/run_as_ppx_rewriter/run.t
@@ -64,6 +64,7 @@ The only possible usage is [extra_args] <infile> <outfile>...
     -cookie NAME=EXPR           Set the cookie NAME to EXPR
     --cookie                    Same as -cookie
     -raise-embedded-errors      Raise the first embedded error found in the processed AST
+    -allow-deriving-end         Whether to allow [@@@deriving.end], which will soon be deprecated.
     -help                       Display this list of options
     --help                      Display this list of options
   [2]
@@ -86,5 +87,6 @@ The only exception is consulting help
     -cookie NAME=EXPR           Set the cookie NAME to EXPR
     --cookie                    Same as -cookie
     -raise-embedded-errors      Raise the first embedded error found in the processed AST
+    -allow-deriving-end         Whether to allow [@@@deriving.end], which will soon be deprecated.
     -help                       Display this list of options
     --help                      Display this list of options
diff --git a/test/error_embedding/run.t b/test/error_embedding/run.t
@@ -87,3 +87,28 @@ Flag `-raise-embedded-errors` raises the first embedded error in the AST.
                            ^^^^^^^^^^^
   Error: error 1
   [1]
+
+Undeprecated `[@@@deriving.end]` runs just fine.
+
+  $ echo "type t [@@deriving_inline a_string] [@@@deriving.end]" > embedded_error.ml
+  $ ./deriver.exe embedded_error.ml -diff-cmd "diff -u --label source --label derived"
+  type t[@@deriving_inline a_string]
+  [@@@deriving.end ]
+  --- source
+  +++ derived
+  @@ -1 +1,4 @@
+  -type t [@@deriving_inline a_string] [@@@deriving.end]
+  +type t [@@deriving_inline a_string] 
+  +let _ = fun (_ : t) -> ()
+  +let _ = "derived_string"
+  +[@@@deriving.end]
+  [1]
+
+Deprecated `[@@@deriving.end]` produces an error.
+
+  $ echo "type t [@@deriving_inline a_string] [@@@deriving.end]" > embedded_error.ml
+  $ ./deriver.exe embedded_error.ml -allow-deriving-end false
+  [%%ocaml.error
+    "ppxlib: [@@@deriving.end] is deprecated, please use [@@@ppxlib.inline.end]. If you need the deprecated attribute temporarily, pass [-allow-deriving-end] to the ppx driver)."]
+  type t[@@deriving_inline a_string]
+  [@@@deriving.end ]

Original file line number	Diff line number	Diff line change
`@@ -1339,6 +1339,9 @@ let shared_args =`
`1339`	`1339`	`( "-raise-embedded-errors",`
`1340`	`1340`	`Arg.Set raise_embedded_errors_flag,`
`1341`	`1341`	`" Raise the first embedded error found in the processed AST" );`
	`1342`	`+ ( "-allow-deriving-end",`
	`1343`	`+ Arg.Bool (( := ) Code_matcher.allow_deriving_end),`
	`1344`	`+ " Whether to allow [@@@deriving.end], which will soon be deprecated." );`
`1342`	`1345`	`]`
`1343`	`1346`
`1344`	`1347`	`let () =`