Repository: coq/coq
Pull request #20328: Fix Extraction Flag changes being deleted by the Extraction Optimize summary
Author: login: SkySkimmer
Labels: name: kind: fix
description: This fixes a bug or incorrect documentation.
Created: 2025-03-05T16:50:10Z | Merged: 2025-03-27T10:23:32Z


Fix #7302


Linked issue #7302: Qed resets Extraction Flag
<!-- Thank you for your contribution.
     Please complete the following information when reporting a bug. -->

#### Version

<!-- You can get this information by running `coqtop -v`. -->

```
% coqtop -v
The Coq Proof Assistant, version 8.8.0 (April 2018)
compiled on Apr 18 2018 16:50:51 with OCaml 4.06.1
```

#### Operating system

```
% lsb_release -a
No LSB modules are available.
Distributor ID:	Debian
Description:	Debian GNU/Linux 9.4 (stretch)
Release:	9.4
Codename:	stretch
```

#### Description of the problem

<!-- It is helpful to provide enough information so that we can reproduce the bug.
     In particular, please include a code example which produces it.
     If the example is small, you can include it here between ``` ```.
     Otherwise, please provide a link to a repository, a gist (https://gist.github.com)
     or drag-and-drop a `.zip` archive. -->

I found that Extraction Flag (documented in the thesis Letouzey2004) is reset
at Qed command in Coq 8.8.

```
% coqc -v
The Coq Proof Assistant, version 8.8.0 (April 2018)
compiled on Apr 18 2018 16:50:51 with OCaml 4.06.1
% cat tst.v 
Require Extraction.

Test Extraction Flag. (* 495 *)
Set Extraction Flag 1007. (* 495(default) + 512(let) *)
Test Extraction Flag.

Definition b : bool.
Proof.
  exact true.
  Test Extraction Flag.
Qed.

Test Extraction Flag.
% coqc tst.v                   
Current value of Extraction Flag is 495
Current value of Extraction Flag is 1007
Current value of Extraction Flag is 1007
Current value of Extraction Flag is 495
Current value of Extraction Flag is 495
% 
```

The default value of the flag is 495 and I set it to 1007.
But it is reset to default in the definition of b.
I checked it in CoqIDE and the reset happens at Qed command.

Note that Coq 8.7.2 doesn't reset the flag as:

```
% ~/.opam/4.05.0/bin/coqc -v
The Coq Proof Assistant, version 8.7.2 (March 2018)
compiled on Mar 13 2018 2:25:05 with OCaml 4.05.0
% ~/.opam/4.05.0/bin/coqc tst.v
Current value of Extraction Flag is 495
Current value of Extraction Flag is 1007
Current value of Extraction Flag is 1007
Current value of Extraction Flag is 1007
Current value of Extraction Flag is 1007
%
```

Linked issue comments: user: login: ejgallego
created_at: 2018-04-19T11:40:10Z
body: Likely the classification of the command has changed and it is not classified as a side effect anymore. Note that relying on side effects inside proofs is fragile tho.
author_association: CONTRIBUTOR
user: login: Zimmi48
created_at: 2018-04-19T12:48:53Z
body: 8c9166435d6926babf697c3f575a8653f465cc76 is the first bad commit
```
commit 8c9166435d6926babf697c3f575a8653f465cc76
Author: Emilio Jesus Gallego Arias <e+git@x80.org>
Date:   Fri Dec 1 19:13:04 2017 +0100

    [summary] Allow typed projections from global state + rework of internals.
    
    In the transition towards a less global state handling we have the
    necessity of mix imperative setting [notably for the modules/section
    code] and functional handling of state [notably in the STM].
    
    In that scenario, it is very convenient to have typed access to the
    Coq's `summary`. Thus, I reify the API to support typed access to the
    `summary`, and implement such access in a couple of convenient places.
    
    We also update some internal datatypes to simplify the `frozen` data
    type. We also remove the use of hashes as it doesn't really make
    things faster, and most operations are now over `Maps` anyways.
    
    I believe this goes in line with recent work by @ppedrot.
    
    We also deprecate the non-typed accessors, which were only supposed to
    be used in the STM, which is now ported to the finer primitives.
```
author_association: MEMBER
user: login: Zimmi48
created_at: 2018-04-19T12:49:54Z
body: > Note that relying on side effects inside proofs is fragile tho.

This example does not rely on side-effects inside proofs. The value of the option was changed before starting a proof and is reset at Qed-time.
author_association: MEMBER
user: login: Zimmi48
created_at: 2018-04-19T12:52:40Z
body: @ejgallego Are you OK with the assignation?
author_association: MEMBER
user: login: ejgallego
created_at: 2018-04-19T12:55:51Z
body: Oh indeed I misunderstood, thanks @Zimmi48 . I am OK looking at this.
author_association: CONTRIBUTOR
user: login: ejgallego
created_at: 2018-05-03T19:50:25Z
body: IMO this is a bug in extraction; code is:
```ocaml
let int_flag_init = 1 + 2 + 4 + 8 (*+ 16*) + 32 + 64 + 128 + 256 (*+ 512 + 1024*)

let int_flag_ref = ref int_flag_init
let opt_flag_ref = ref (flag_of_int int_flag_init)

let chg_flag n = int_flag_ref := n; opt_flag_ref := flag_of_int n

let optims () = !opt_flag_ref

let _ = declare_bool_option
	  {optdepr = false;
	   optname = "Extraction Optimize";
	   optkey = ["Extraction"; "Optimize"];
	   optread = (fun () -> not (Int.equal !int_flag_ref 0));
	   optwrite = (fun b -> chg_flag (if b then int_flag_init else 0))}

let _ = declare_int_option
          { optdepr = false;
            optname = "Extraction Flag";
            optkey = ["Extraction";"Flag"];
            optread = (fun _ -> Some !int_flag_ref);
            optwrite = (function
                          | None -> chg_flag 0
                          | Some i -> chg_flag (max i 0))}
```
So as you can see, `Extraction Optimize` will overwrite the value of `Extraction Flag`.

It worked before as the summary handling code restored things in the order they were declared, thus the flag was overwritten twice, with the final value being the good one. But note that in 8.7 then we had the reverse bug, of `Extraction Flag` overwriting the `Extraction Optimize` setting. Needless to say relying on the order of global static declarations is quite fragile.

In 8.8, summary entries are stored in a map so the order is not specified [it happens to be alphabetical], thus the overwriting is reversed.

I am not and expect in extraction code so I dunno what would be the best way to fix this.
author_association: CONTRIBUTOR
user: login: Zimmi48
created_at: 2018-05-03T20:16:14Z
body: @letouzey You might want to take over this extraction related bug.
author_association: MEMBER
user: login: Zimmi48
created_at: 2018-06-09T13:49:49Z
body: Note BTW that this command is not documented in the refman.
I'm removing the milestone. @letouzey put one that corresponds to your schedule.
author_association: MEMBER

Diff:
diff --git a/library/goptions.ml b/library/goptions.ml
index f3f3bf818915..13ef604f1603 100644
--- a/library/goptions.ml
+++ b/library/goptions.ml
@@ -318,15 +318,18 @@ let option_object name stage act =
     classify_function = classify_option;
   }
 
-let declare_option ?(preprocess = fun x -> x) ~kind
+let declare_option ?(preprocess = fun x -> x) ?(no_summary=false) ~kind
   { optstage=stage; optdepr=depr; optkey=key; optread=read; optwrite=write } =
   check_key key;
-  let default = read() in
-  let () = Summary.declare_summary (nickname key)
-      { stage;
-        Summary.freeze_function = read;
-        Summary.unfreeze_function = write;
-        Summary.init_function = (fun () -> write default) }
+  let () =
+    if not no_summary then begin
+      let default = read() in
+      Summary.declare_summary (nickname key)
+        { stage;
+          Summary.freeze_function = read;
+          Summary.unfreeze_function = write;
+          Summary.init_function = (fun () -> write default) }
+    end
   in
   let change =
       let options : option_locality * _ -> obj =
diff --git a/library/goptions.mli b/library/goptions.mli
index 3425375ebe89..8844b5a126b7 100644
--- a/library/goptions.mli
+++ b/library/goptions.mli
@@ -137,8 +137,13 @@ type 'a option_sig = {
 (** The [preprocess] function is triggered before setting the option. It can be
     used to emit a warning on certain values, and clean-up the final value.
 
+    By default [no_summary:false], and declare_option declares a
+    summary entry to synchronize the backing state by calling read and write.
+    If you pass [no_summary:true] you must handle synchronization separately.
+
     [StringOptKind] should be preferred to [StringKind] because it supports "Unset". *)
-val declare_option   : ?preprocess:('a -> 'a) -> kind:'a option_kind -> 'a option_sig -> unit
+val declare_option   : ?preprocess:('a -> 'a) -> ?no_summary:bool ->
+  kind:'a option_kind -> 'a option_sig -> unit
 
 val declare_append_only_option : ?preprocess:(string -> string) -> sep:string ->
   string option_sig -> unit
diff --git a/plugins/extraction/table.ml b/plugins/extraction/table.ml
index 7fe4d857b01e..46aa8ac5c0ea 100644
--- a/plugins/extraction/table.ml
+++ b/plugins/extraction/table.ml
@@ -606,21 +606,22 @@ let chg_flag n = int_flag_ref := n; opt_flag_ref := flag_of_int n
 
 let optims () = !opt_flag_ref
 
-let () = declare_bool_option
-          {optstage = Summary.Stage.Interp;
-           optdepr = None;
-           optkey = ["Extraction"; "Optimize"];
-           optread = (fun () -> not (Int.equal !int_flag_ref 0));
-           optwrite = (fun b -> chg_flag (if b then int_flag_init else 0))}
+let () = declare_option ~kind:BoolKind
+    ~no_summary:true (* synchronization handled by Extraction Flag *)
+    {optstage = Summary.Stage.Interp;
+     optdepr = None;
+     optkey = ["Extraction"; "Optimize"];
+     optread = (fun () -> not (Int.equal !int_flag_ref 0));
+     optwrite = (fun b -> chg_flag (if b then int_flag_init else 0))}
 
 let () = declare_int_option
-          { optstage = Summary.Stage.Interp;
-            optdepr = None;
-            optkey = ["Extraction";"Flag"];
-            optread = (fun _ -> Some !int_flag_ref);
-            optwrite = (function
-                          | None -> chg_flag 0
-                          | Some i -> chg_flag (max i 0))}
+    { optstage = Summary.Stage.Interp;
+      optdepr = None;
+      optkey = ["Extraction";"Flag"];
+      optread = (fun _ -> Some !int_flag_ref);
+      optwrite = (function
+        | None -> chg_flag 0
+        | Some i -> chg_flag (max i 0))}
 
 (* This option controls whether "dummy lambda" are removed when a
    toplevel constant is defined. *)


Reviews:
user: login: ppedrot
state: COMMENTED
author_association: MEMBER
submitted_at: 2025-03-06T05:50:59Z
user: login: SkySkimmer
state: COMMENTED
author_association: CONTRIBUTOR
submitted_at: 2025-03-06T09:56:28Z
user: login: ppedrot
state: COMMENTED
author_association: MEMBER
submitted_at: 2025-03-06T12:49:13Z
user: login: ejgallego
body: I think this is similar to the discussion we had recently, this API allows user-facing options to break a core vernac invariant, and will lead to misuse.

Let's fix options dependencies with a safe API please.


state: DISMISSED
author_association: CONTRIBUTOR
submitted_at: 2025-03-08T14:25:39Z
user: login: ppedrot
body: I think this is subpar but well...
state: APPROVED
author_association: MEMBER
submitted_at: 2025-03-24T13:57:14Z

Review comments:
diff_hunk: @@ -137,8 +137,13 @@ type 'a option_sig = {
 (** The [preprocess] function is triggered before setting the option. It can be
     used to emit a warning on certain values, and clean-up the final value.
 
+    By default [no_summary:false], and declare_option declares a
+    summary entry to synchronize the backing state by calling read and write.
+    If you pass [no_summary:true] you must handle synchronization separately.
+
     [StringOptKind] should be preferred to [StringKind] because it supports "Unset". *)
-val declare_option   : ?preprocess:('a -> 'a) -> kind:'a option_kind -> 'a option_sig -> unit
+val declare_option   : ?preprocess:('a -> 'a) -> ?no_summary:bool ->
+  kind:'a option_kind -> 'a option_sig -> unit
path: library/goptions.mli
user: login: ppedrot
body: I think it would be more principled to take a `'a Summary.Dyn.tag option` rather than a boolean, this would make the dependency explicit in the code. But that would also require returning the tag in the Goption API.
created_at: 2025-03-06T05:50:58Z
author_association: MEMBER
diff_hunk: @@ -137,8 +137,13 @@ type 'a option_sig = {
 (** The [preprocess] function is triggered before setting the option. It can be
     used to emit a warning on certain values, and clean-up the final value.
 
+    By default [no_summary:false], and declare_option declares a
+    summary entry to synchronize the backing state by calling read and write.
+    If you pass [no_summary:true] you must handle synchronization separately.
+
     [StringOptKind] should be preferred to [StringKind] because it supports "Unset". *)
-val declare_option   : ?preprocess:('a -> 'a) -> kind:'a option_kind -> 'a option_sig -> unit
+val declare_option   : ?preprocess:('a -> 'a) -> ?no_summary:bool ->
+  kind:'a option_kind -> 'a option_sig -> unit
path: library/goptions.mli
user: login: SkySkimmer
body: Ths is nonsense, the backing state doesn't have type `'a` 
created_at: 2025-03-06T09:56:28Z
author_association: CONTRIBUTOR
diff_hunk: @@ -137,8 +137,13 @@ type 'a option_sig = {
 (** The [preprocess] function is triggered before setting the option. It can be
     used to emit a warning on certain values, and clean-up the final value.
 
+    By default [no_summary:false], and declare_option declares a
+    summary entry to synchronize the backing state by calling read and write.
+    If you pass [no_summary:true] you must handle synchronization separately.
+
     [StringOptKind] should be preferred to [StringKind] because it supports "Unset". *)
-val declare_option   : ?preprocess:('a -> 'a) -> kind:'a option_kind -> 'a option_sig -> unit
+val declare_option   : ?preprocess:('a -> 'a) -> ?no_summary:bool ->
+  kind:'a option_kind -> 'a option_sig -> unit
path: library/goptions.mli
user: login: ppedrot
body: Well, you can get it via a projection.
created_at: 2025-03-06T12:49:13Z
author_association: MEMBER

PR comments:
user: login: SkySkimmer
created_at: 2025-03-08T15:20:09Z
body: I'm not willing to make some complicated API for this when we can have this simple solution. If plugins have bugs those bugs can get fixed, it's not that important.
author_association: CONTRIBUTOR
user: login: ppedrot
created_at: 2025-03-27T10:23:30Z
body: @coqbot merge now
author_association: MEMBER