From 74722cbf3560a298419d379076c2dd5bbb6b6763 Mon Sep 17 00:00:00 2001
From: Stephen Dolan <sdolan@janestreet.com>
Date: Fri, 19 Nov 2021 13:40:29 +0000
Subject: [PATCH] Add [@ocaml.principal] and [@ocaml.noprincipal] attributes,
 and use in oo.mli

---
 parsing/builtin_attributes.ml | 13 +++++++++++++
 stdlib/oo.mli                 |  2 ++
 2 files changed, 15 insertions(+)

diff --git a/parsing/builtin_attributes.ml b/parsing/builtin_attributes.ml
index cb211e152ed0..cc2390e5e2ae 100644
--- a/parsing/builtin_attributes.ml
+++ b/parsing/builtin_attributes.ml
@@ -338,6 +338,15 @@ let clflags_attribute_with_int_payload attr ~name clflags_ref =
     | None -> ()
   end
 
+let principal_attribute attr =
+  clflags_attribute_without_payload attr
+    ~name:"principal" Clflags.principal
+
+let noprincipal_attribute attr =
+  clflags_attribute_without_payload' attr
+    ~name:"noprincipal"
+    ~f:(fun () -> Clflags.principal := false)
+
 let nolabels_attribute attr =
   clflags_attribute_without_payload attr
     ~name:"nolabels" Clflags.classic
@@ -377,10 +386,14 @@ let afl_inst_ratio_attribute attr =
 
 let parse_standard_interface_attributes attr =
   warning_attribute attr;
+  principal_attribute attr;
+  noprincipal_attribute attr;
   nolabels_attribute attr
 
 let parse_standard_implementation_attributes attr =
   warning_attribute attr;
+  principal_attribute attr;
+  noprincipal_attribute attr;
   nolabels_attribute attr;
   inline_attribute attr;
   afl_inst_ratio_attribute attr;
diff --git a/stdlib/oo.mli b/stdlib/oo.mli
index 07befe924093..079f84d32c6a 100644
--- a/stdlib/oo.mli
+++ b/stdlib/oo.mli
@@ -18,6 +18,8 @@ open! Stdlib
 
 (** Operations on objects *)
 
+[@@@ocaml.noprincipal] (* preserve structure sharing in copy (PR#9767) *)
+
 val copy : (< .. > as 'a) -> 'a
 (** [Oo.copy o] returns a copy of object [o], that is a fresh
    object with the same methods and instance variables as [o]. *)