Skip to content

Commit

Permalink
Drastically speed up ByteCompareSpec
Browse files Browse the repository at this point in the history
Old:
```
theories/ByteCompareSpec.vo (real: 113.67, user: 111.75, sys: 1.57, mem: 1287536 ko)
```
New:
```
COQC theories/ByteCompareSpec.v
theories/ByteCompareSpec.vo (real: 9.46, user: 8.89, sys: 0.26, mem: 442460 ko)
```

The new file is also compatible with COQNATIVE, taking only seconds
rather than dozens of minutes or more.
  • Loading branch information
JasonGross committed Sep 30, 2023
1 parent 601b9dc commit e931533
Showing 1 changed file with 26 additions and 7 deletions.
33 changes: 26 additions & 7 deletions utils/theories/ByteCompareSpec.v
Original file line number Diff line number Diff line change
@@ -1,24 +1,43 @@
From Coq Require Import Strings.Byte NArith.
From Coq Require Import Strings.Byte NArith Eqdep_dec.
From MetaCoq.Utils Require Import ReflectEq ByteCompare.
From Equations Require Import Equations.

Import EqNotations.

Derive NoConfusion for comparison.

Section ByteNoConf.
Local Ltac solve_noconf ::= idtac.
(** The NoConfusion definition is quite large, so we define a much more compact version of it that is nevertheless convertible *)
Definition eta_byte {A} (f : forall b : byte, A b) (b : byte) : A b
:= Eval cbv in
ltac:(pose (f b) as v; destruct b; let val := (eval cbv in v) in exact val).
Definition uneta_byte {A f b} : @eta_byte A f b = f b
:= match b with x00 | _ => eq_refl end.
Definition NoConfusion_byte_alt : byte -> byte -> Prop
:= eta_byte (fun b1 b2 => eta_byte (fun b2 => if Byte.eqb b1 b2 then True else False) b2).
Derive NoConfusion for byte.
Next Obligation.
destruct a; abstract (destruct b; try exact (False_ind _ H); exact eq_refl).
Defined.
change (NoConfusion_byte a b) with (NoConfusion_byte_alt a b) in *.
cbv [NoConfusion_byte_alt] in *; apply byte_dec_bl.
lazymatch goal with H : eta_byte ?f ?a ?b |- _ => pose proof (f_equal (fun F => F b) (@uneta_byte _ f a)) as H' end.
cbv beta in *.
lazymatch goal with H : _ = eta_byte ?f ?a |- _ => pose proof (eq_trans H (@uneta_byte _ f a)) as H''; clear H end.
lazymatch goal with H : eta_byte ?f ?a ?b |- _ => pose proof (rew [fun T : Prop => T] H'' in H); clear H H'' end.
cbv beta in *.
destruct Byte.eqb; [ reflexivity | exfalso; assumption ].
Qed.
Next Obligation.
destruct b; cbn; exact I.
Defined.
Next Obligation.
destruct a; abstract (destruct b; try (exact (False_ind _ e)); destruct e; exact eq_refl).
Defined.
change (NoConfusion_byte a b) with (NoConfusion_byte_alt a b) in *.
lazymatch goal with |- ?f _ _ ?g = ?e => generalize g; revert e end; intros e g; subst; revert e.
destruct b; vm_compute; intros []; reflexivity.
Qed.
Next Obligation.
destruct b; cbn; exact eq_refl.
Defined.
apply UIP_dec, byte_eq_dec.
Qed.
End ByteNoConf.

Lemma reflect_equiv P Q b : P <-> Q -> Bool.reflect P b -> Bool.reflect Q b.
Expand Down

0 comments on commit e931533

Please sign in to comment.