Remove the unused restoring of the PPX context

Every caller drops the context without restoring it, so the cookie store was never filled. PPXs still receive an empty cookies field.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01WZbCuRQ1Tn31bnKzLj5e72
Signed-off-by: Christoph Knittel <ck@cca.io>

Author: cknitt

changes/remove-ppx-context-restore.internal.md

@@ -0,0 +1 @@
+- Remove the unused restoring of the PPX context, including the cookie store. https://github.com/rescript-lang/rescript/pull/8859

compiler/bsc/rescript_compiler_main.ml

@@ -116,8 +116,7 @@ let reprint_source_file sourcefile =
         exit 1);
       Res_compmisc.init_path ();
       parse_result.parsetree
-      |> Cmd_ppx_apply.apply_rewriters ~restore:false
-           ~tool_name:Js_config.tool_name Ml
+      |> Cmd_ppx_apply.apply_rewriters ~tool_name:Js_config.tool_name Ml
       |> Ppx_entry.rewrite_implementation
       |> Res_printer.print_implementation ~width:100
            ~comments:parse_result.comments
@@ -132,8 +131,7 @@ let reprint_source_file sourcefile =
         exit 1);
       Res_compmisc.init_path ();
       parse_result.parsetree
-      |> Cmd_ppx_apply.apply_rewriters ~restore:false
-           ~tool_name:Js_config.tool_name Mli
+      |> Cmd_ppx_apply.apply_rewriters ~tool_name:Js_config.tool_name Mli
       |> Ppx_entry.rewrite_signature
       |> Res_printer.print_interface ~width:100 ~comments:parse_result.comments
       |> print_endline

compiler/core/cmd_ppx_apply.ml

@@ -93,7 +93,7 @@ let rewrite kind ppxs ast =
     out
   | _ -> assert false
 
-let apply_rewriters_str ?(restore = true) ~tool_name ast =
+let apply_rewriters_str ~tool_name ast =
   match !Clflags.all_ppx with
   | [] ->
     if !Js_config.test_ast_conversion then
@@ -103,9 +103,9 @@ let apply_rewriters_str ?(restore = true) ~tool_name ast =
     ast
     |> Ast_mapper.add_ppx_context_str ~tool_name
     |> rewrite Ml ppxs |> Ml_binary.ast0_to_structure
-    |> Ast_mapper.drop_ppx_context_str ~restore
+    |> Ast_mapper.drop_ppx_context_str
 
-let apply_rewriters_sig ?(restore = true) ~tool_name ast =
+let apply_rewriters_sig ~tool_name ast =
   match !Clflags.all_ppx with
   | [] ->
     if !Js_config.test_ast_conversion then
@@ -115,10 +115,10 @@ let apply_rewriters_sig ?(restore = true) ~tool_name ast =
     ast
     |> Ast_mapper.add_ppx_context_sig ~tool_name
     |> rewrite Mli ppxs |> Ml_binary.ast0_to_signature
-    |> Ast_mapper.drop_ppx_context_sig ~restore
+    |> Ast_mapper.drop_ppx_context_sig
 
-let apply_rewriters ?restore ~tool_name (type a) (kind : a Ml_binary.kind)
-    (ast : a) : a =
+let apply_rewriters ~tool_name (type a) (kind : a Ml_binary.kind) (ast : a) : a
+    =
   match kind with
-  | Ml_binary.Ml -> apply_rewriters_str ?restore ~tool_name ast
-  | Ml_binary.Mli -> apply_rewriters_sig ?restore ~tool_name ast
+  | Ml_binary.Ml -> apply_rewriters_str ~tool_name ast
+  | Ml_binary.Mli -> apply_rewriters_sig ~tool_name ast

compiler/core/js_implementation.ml

@@ -64,8 +64,7 @@ let interface ~parser ppf ?outputprefix fname =
   in
   Res_compmisc.init_path ();
   parser fname
-  |> Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name:Js_config.tool_name
-       Mli
+  |> Cmd_ppx_apply.apply_rewriters ~tool_name:Js_config.tool_name Mli
   |> Ppx_entry.rewrite_signature
   |> print_if_pipe ppf Clflags.dump_parsetree Printast.interface
   |> print_if_pipe ppf Clflags.dump_source Pprintast.signature
@@ -151,8 +150,7 @@ let implementation ~parser ppf ?outputprefix fname =
   in
   Res_compmisc.init_path ();
   parser fname
-  |> Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name:Js_config.tool_name
-       Ml
+  |> Cmd_ppx_apply.apply_rewriters ~tool_name:Js_config.tool_name Ml
   |> Ppx_entry.rewrite_implementation
   |> print_if_pipe ppf Clflags.dump_parsetree Printast.implementation
   |> print_if_pipe ppf Clflags.dump_source Pprintast.structure

compiler/ml/ast_mapper.ml

@@ -612,13 +612,6 @@ let rec extension_of_error {loc; msg; if_highlight; sub} =
        ]
       @ List.map (fun ext -> Str.extension (extension_of_error ext)) sub) )
 
-module String_map = Map.Make (struct
-  type t = string
-  let compare = compare
-end)
-
-let cookies = ref String_map.empty
-
 module Ppx_context = struct
   open Longident
   open Asttypes
@@ -641,18 +634,6 @@ module Ppx_context = struct
       Exp.construct (lid "::") (Location.mknoloc [f x; make_list f rest])
     | [] -> Exp.construct (lid "[]") (Location.mknoloc [])
 
-  let make_pair f1 f2 (x1, x2) = Exp.tuple [f1 x1; f2 x2]
-
-  let get_cookies () =
-    {
-      lid = lid "cookies";
-      x =
-        make_list
-          (make_pair make_string (fun x -> x))
-          (String_map.bindings !cookies);
-      opt = false;
-    }
-
   let mk fields =
     ( {txt = "ocaml.ppx.context"; loc = Location.none},
       Parsetree.PStr [Str.eval (Exp.record fields None)] )
@@ -677,98 +658,24 @@ module Ppx_context = struct
           opt = false;
         };
         {lid = lid "debug"; x = make_bool !Clflags.debug; opt = false};
-        get_cookies ();
+        (* The compiler doesn't read back the cookies a PPX sets. *)
+        {lid = lid "cookies"; x = make_list Fun.id []; opt = false};
       ]
     in
     mk fields
-
-  let get_fields = function
-    | PStr
-        [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_record (fields, None)}, [])}]
-      ->
-      fields
-    | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context] syntax"
-
-  let restore fields =
-    let field name payload =
-      let rec get_string = function
-        | {pexp_desc = Pexp_constant (Pconst_string payload)} ->
-          String_literal.string_semantic payload
-        | _ ->
-          raise_errorf
-            "Internal error: invalid [@@@ocaml.ppx.context { %s }] string \
-             syntax"
-            name
-      and get_bool pexp =
-        match pexp with
-        | {
-         pexp_desc = Pexp_construct ({txt = Longident.Lident "true"}, {txt = []});
-        } ->
-          true
-        | {
-         pexp_desc =
-           Pexp_construct ({txt = Longident.Lident "false"}, {txt = []});
-        } ->
-          false
-        | _ ->
-          raise_errorf
-            "Internal error: invalid [@@@ocaml.ppx.context { %s }] bool syntax"
-            name
-      and get_list elem = function
-        | {
-            pexp_desc =
-              Pexp_construct ({txt = Longident.Lident "::"}, {txt = [exp; rest]});
-          } ->
-          elem exp :: get_list elem rest
-        | {
-            pexp_desc =
-              Pexp_construct ({txt = Longident.Lident "[]"}, {txt = []});
-          } ->
-          []
-        | _ ->
-          raise_errorf
-            "Internal error: invalid [@@@ocaml.ppx.context { %s }] list syntax"
-            name
-      and get_pair f1 f2 = function
-        | {pexp_desc = Pexp_tuple [e1; e2]} -> (f1 e1, f2 e2)
-        | _ ->
-          raise_errorf
-            "Internal error: invalid [@@@ocaml.ppx.context { %s }] pair syntax"
-            name
-      in
-      match name with
-      | "include_dirs" -> Clflags.include_dirs := get_list get_string payload
-      | "load_path" -> Config.load_path := get_list get_string payload
-      | "open_modules" -> Clflags.open_modules := get_list get_string payload
-      | "debug" -> Clflags.debug := get_bool payload
-      | "cookies" ->
-        let l = get_list (get_pair get_string (fun x -> x)) payload in
-        cookies :=
-          List.fold_left
-            (fun s (k, v) -> String_map.add k v s)
-            String_map.empty l
-      | _ -> ()
-    in
-    List.iter
-      (function
-        | {lid = {txt = Lident name}; x} -> field name x
-        | _ -> ())
-      fields
 end
 
 let ppx_context = Ppx_context.make
 
-let drop_ppx_context_str ~restore = function
-  | {pstr_desc = Pstr_attribute ({Location.txt = "ocaml.ppx.context"}, a)}
+let drop_ppx_context_str = function
+  | {pstr_desc = Pstr_attribute ({Location.txt = "ocaml.ppx.context"}, _)}
     :: items ->
-    if restore then Ppx_context.restore (Ppx_context.get_fields a);
     items
   | items -> items
 
-let drop_ppx_context_sig ~restore = function
-  | {psig_desc = Psig_attribute ({Location.txt = "ocaml.ppx.context"}, a)}
+let drop_ppx_context_sig = function
+  | {psig_desc = Psig_attribute ({Location.txt = "ocaml.ppx.context"}, _)}
     :: items ->
-    if restore then Ppx_context.restore (Ppx_context.get_fields a);
     items
   | items -> items
 

compiler/ml/ast_mapper.mli

@@ -114,12 +114,9 @@ val add_ppx_context_sig :
   tool_name:string -> Parsetree.signature -> Parsetree.signature
 (** Same as [add_ppx_context_str], but for signatures. *)
 
-val drop_ppx_context_str :
-  restore:bool -> Parsetree.structure -> Parsetree.structure
-(** Drop the ocaml.ppx.context attribute from a structure.  If
-    [restore] is true, also restore the associated data in the current
-    process. *)
-
-val drop_ppx_context_sig :
-  restore:bool -> Parsetree.signature -> Parsetree.signature
+val drop_ppx_context_str : Parsetree.structure -> Parsetree.structure
+(** Drop the ocaml.ppx.context attribute from a structure. The compiler does
+    not take back any of its data, such as cookies a PPX set. *)
+
+val drop_ppx_context_sig : Parsetree.signature -> Parsetree.signature
 (** Same as [drop_ppx_context_str], but for signatures. *)

tests/ounit_tests/ounit_ast_mapper0_tests.ml

@@ -28,6 +28,54 @@ let record_pat0 attrs =
 let map_pat0 pat =
   Ast_mapper_from0.default_mapper.pat Ast_mapper_from0.default_mapper pat
 
+(* The [ocaml.ppx.context] attribute a PPX receives. *)
+let ppx_context_fields0 ast0 =
+  match ast0 with
+  | Ml_binary.Impl
+      ({
+         Parsetree0.pstr_desc =
+           Pstr_attribute
+             ( {txt = "ocaml.ppx.context"},
+               PStr
+                 [
+                   {
+                     pstr_desc =
+                       Pstr_eval ({pexp_desc = Pexp_record (fields, None)}, _);
+                   };
+                 ] );
+       }
+      :: _) ->
+    fields
+  | _ -> assert_failure "the structure starts with the PPX context"
+
+let test_ppx_context_on_the_wire _ =
+  let structure =
+    Ast_mapper.add_ppx_context_str ~tool_name:"rescript"
+      [
+        Ast_helper.Str.eval
+          (Ast_helper.Exp.constant (Pconst_integer ("1", None)));
+      ]
+  in
+  let fields =
+    ppx_context_fields0 (Ml_binary.to_ast0 Ml_binary.Ml structure)
+    |> List.map (fun (({txt} : Longident.t Location.loc), value) ->
+        (Longident.last txt, value))
+  in
+  OUnit.assert_equal ~printer:(String.concat ", ")
+    [
+      "tool_name";
+      "include_dirs";
+      "load_path";
+      "open_modules";
+      "debug";
+      "cookies";
+    ]
+    (List.map fst fields);
+  (match List.assoc "cookies" fields with
+  | {Parsetree0.pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> ()
+  | _ -> assert_failure "the PPX gets no cookies");
+  OUnit.assert_equal 1 (List.length (Ast_mapper.drop_ppx_context_str structure))
+
 let test_removed_open_pattern_is_rejected_from_ast0 _ =
   let pat =
     Ast_helper0.Pat.open_ ~loc
@@ -2126,4 +2174,5 @@ let suites =
          >:: test_field_runtime_name_keeps_ppx_order_on_the_wire;
          "constructor_runtime_tag_reaches_ast0_as_an_attribute"
          >:: test_constructor_runtime_tag_reaches_ast0_as_an_attribute;
+         "ppx_context_on_the_wire" >:: test_ppx_context_on_the_wire;
        ]