diff options
author | ckeller <ckeller@users.noreply.github.com> | 2019-01-28 23:19:12 +0100 |
---|---|---|
committer | GitHub <noreply@github.com> | 2019-01-28 23:19:12 +0100 |
commit | 7021c53d4ecf97c82ccebb6bb45f5305d8b482ea (patch) | |
tree | ba7537e1e813cabf9ee0d910f845c71fa5f446e7 /src/classes | |
parent | 36548d6634864a131cc83ce21491c797163de305 (diff) | |
download | smtcoq-7021c53d4ecf97c82ccebb6bb45f5305d8b482ea.tar.gz smtcoq-7021c53d4ecf97c82ccebb6bb45f5305d8b482ea.zip |
Merge from LFSC (#26)
* Showing models as coq counter examples in tactic without constructing coq terms
* also read models when calling cvc4 with a file (deactivated because cvc4 crashes)
* Show counter examples with variables in the order they are quantified in the Coq goal
* Circumvent issue with ocamldep
* fix issue with dependencies
* fix issue with dependencies
* Translation and OCaml support for extract, zero_extend, sign_extend
* Show run times of components
* print time on stdout instead
* Tests now work with new version (master) of CVC4
* fix small printing issue
* look for date on mac os x
* proof of valid_check_bbShl: some cases to prove.
* full proof of "left shift checker".
* full proof of "rigth shift checker".
* Support translation of terms bvlshr, bvshl but LFSC rules do not exists at the moment
Bug fix for bitvector extract (inverted arguments)
* Typo
* More modularity on the format of traces depending on the version of coq
* More straightforward definitions in Int63Native_standard
* Use the Int31 library with coq-8.5
* Use the most efficient operations of Int31
* Improved performance with coq-8.5
* Uniform treatment of sat and smt tactics
* Hopefully solved the problem with universes for the tactic
* Updated the installation instructions
* Holes for unsupported bit blasting rules
* Cherry-picking from smtcoq/smtcoq
* bug fix hole for bitblast
* Predefined arrays are not required anymore
* fix issue with coq bbT and bitof construction from ocaml
* bug fix in smtAtom for uninterpreted functions
fix verit test file
* fix issue with smtlib2 extract parsing
* It looks like we still need the PArray function instances for some examples (see vmcai_bytes.smt2)
* Solver specific reification:
Each solver has a list of supported theories which is passed to Atom.of_coq, this function creates uninterpreted functions / sorts for unsupported features.
* show counter-examples with const_farray instead of const for constant array definitions
* Vernacular commands to debug checkers.
Verit/Lfsc_Checker_Debug will always fail, reporting the first proof step of the certificate that failed be checked
* Update INSTALL.md
* show smtcoq proof when converting
* (Hopefully) repared the universes problems
* Corrected a bug with holes in proofs
* scripts for tests:
create a folder "work" under "lfsc/tests/", locate the benchmarks there.
create a folder "results" under "lfsc/tests/work/" in which you'll find the results of ./cvc4tocoq.
* make sure to give correct path for your benchs...
* Checker for array extensionality modulo symmetry of equality
* fix oversight with bitvectors larger than 63 bits
* some printing functions for smt2 ast
* handle smtlib2 files with more complicated equivalence with (= ... )
* revert: ./cvc4tocoq does not output lfsc proofs...
* bug fix one input was ignored
* Don't show verit translation of LFSC proof if environment variable DONTSHOWVERIT is set
(e.g. put export DONTSHOWVERIT="" in your .bashrc or .bashprofile)
* Also sort names of introduced variables when showing counter-example
* input files for which SMTCoq retuns false.
* input files for which SMTCoq retuns false.
* use debug checker for debug file
* More efficient debug checker
* better approximate number of failing step of certificate in debug checker
* fix mistake in ml4
* very first attempt to support goals in Prop
* bvs: comparison predicates in Prop and their <-> proofs with the ones in bool
farrays: equality predicate in Prop and its <-> proof with the one in bool.
* unit, Bool, Z, Pos: comparison and equality predicates in Prop.
* a typo fixed.
* an example of array equality in Prop (converted into Bool by hand)...
TODO: enhance the search space of cvc4 tactic.
* first version of cvc4' tactic: "solves" the goals in Prop.
WARNING: supports only bv and array goals and might not be complete
TODO: add support for lia goals
* cvc4' support for lia
WARNING: might not be complete!
* small fix in cvc4' and some variations of examples
* small fix + support for goals in Bool and Bool = true + use of solve tactical
WARNING: does not support UF and INT63 goals in Prop
* cvc4': better arrangement
* cvc4': Prop2Bool by context search...
* cvc4': solve tactial added -> do not modify unsolved goals.
* developer documentation for the smtcoq repo
* cvc4': rudimentary support for uninterpreted function goals in Prop.
* cvc4': support for goals with Leibniz equality...
WARNING: necessary use of "Grab Existential Variables." to instantiate variable types for farrays!
* cvc4': Z.lt adapted + better support from verit...
* cvc4': support for Z.le, Z.ge, Z.gt.
* Try arrays with default value (with a constructor for constant arrays), but extensionality is not provable
* cvc4': support for equality over uninterpreted types
* lfsc demo: goals in Coq's Prop.
* lfsc demo: goals in Bool.
* Fix issue with existential variables generated by prop2bool.
- prop2bool tactic exported by SMTCoq
- remove useless stuff
* update usage and installation instructions
* Update INSTALL.md
* highlighting
* the tactic: bool2prop.
* clean up
* the tactic smt: very first version.
* smt: return unsolved goals in Prop.
* Show when a certificate cannot be checked when running the tactic instead of at Qed
* Tactic improvements
- Handle negation/True/False in prop/bool conversions tactic.
- Remove alias for farray (this caused problem for matching on this type in tactics).
- Tactic `smt` that combines cvc4 and veriT.
- return subgoals in prop
* test change header
* smt: support for negated goals + some reorganization.
* conflicts resolved + some reorganization.
* a way to solve the issue with ambiguous coercions.
* reorganization.
* small change.
* another small change.
* developer documentation of the tactics.
* developer guide: some improvements.
* developer guide: some more improvements.
* developer guide: some more improvements.
* developer guide: some more improvements.
* pass correct environment for conversion + better error messages
* cleaning
* ReflectFacts added.
* re-organizing developers' guide.
* re-organizing developers' guide.
* re-organizing developers' guide.
* removing unused maps.
* headers.
* artifact readme getting started...
* first attempt
* second...
* third...
* 4th...
* 5th...
* 6th...
* 7th...
* 8th...
* 9th...
* 10th...
* 11th...
* 12th...
* 13th...
* 14th...
* 15th...
* 16th...
* 17th...
* Update artifact.md
Use links to lfsc repository like in the paper
* 18th...
* 19th...
* 20th...
* 21st...
* 22nd...
* 23rd...
* 24th...
* 25th...
* 26th...
* 27th...
* 28th...
* Update artifact.md
Small reorganization
* minor edits
* More minor edits
* revised description of tactics
* Final pass
* typo
* name changed: artifact-readme.md
* file added...
* passwd chaged...
* links...
* removal
* performance statement...
* typos...
* the link to the artifact image updated...
* suggestions by Guy...
* aux files removed...
* clean-up...
* clean-up...
* some small changes...
* small fix...
* additional information on newly created files after running cvc4tocoq script...
* some small fix...
* another small fix...
* typo...
* small fix...
* another small fix...
* fix...
* link to the artifact image...
* We do not want to force vm_cast for the Theorem commands
* no_check variants of the tactics
* TODO: a veriT test does not work anymore
* Compiles with both versions of Coq
* Test of the tactics in real conditions
* Comment on this case study
* an example for the FroCoS paper.
* Fix smt tactic that doesn't return cvc4's subgoals
* readme modifications
* readme modifications 2
* small typo in readme.
* small changes in readme.
* small changes in readme.
* typo in readme.
* Sync with https://github.com/LFSC/smtcoq
* Port to Coq 8.6
* README
* README
* INSTALL
* Missing file
* Yves' proposition for installation instructions
* Updated link to CVC4
* Compiles again with native-coq
* Compiles with both versions of Coq
* Command to bypass typechecking when generating a zchaff theorem
* Solved bug on cuts from Hole
* Counter-models for uninterpreted sorts (improves issue #13)
* OCaml version note (#15)
* update .gitignore
* needs OCaml 4.04.0
* Solving merge issues (under progress)
* Make SmtBtype compile
* Compilation of SmtForm under progress
* Make SmtForm compile
* Make SmtCertif compile
* Make SmtTrace compile
* Make SatAtom compile
* Make smtAtom compile
* Make CnfParser compile
* Make Zchaff compile
* Make VeritSyntax compile
* Make VeritParser compile
* Make lfsc/tosmtcoq compile
* Make smtlib2_genconstr compile
* smtCommand under progress
* smtCommands and verit compile again
* lfsc compiles
* ml4 compiles
* Everything compiles
* All ZChaff unit tests and most verit unit tests (but taut5 and un_menteur) go through
* Most LFSC tests ok; some fail due to the problem of verit; a few fail due to an error "Not_found" to investigate
* Authors and headings
* Compiles with native-coq
* Typo
Diffstat (limited to 'src/classes')
-rw-r--r-- | src/classes/SMT_classes.v | 173 | ||||
-rw-r--r-- | src/classes/SMT_classes_instances.v | 600 |
2 files changed, 773 insertions, 0 deletions
diff --git a/src/classes/SMT_classes.v b/src/classes/SMT_classes.v new file mode 100644 index 0000000..5f79faf --- /dev/null +++ b/src/classes/SMT_classes.v @@ -0,0 +1,173 @@ +(**************************************************************************) +(* *) +(* SMTCoq *) +(* Copyright (C) 2011 - 2019 *) +(* *) +(* See file "AUTHORS" for the list of authors *) +(* *) +(* This file is distributed under the terms of the CeCILL-C licence *) +(* *) +(**************************************************************************) + + +Require Import Bool OrderedType. + +(** This file defines a number of typeclasses which are useful to build the + terms of SMT (in particular arrays indexed by instances of these + classes). *) + + +(** Boolean equality to decidable equality *) +Definition eqb_to_eq_dec : + forall T (eqb : T -> T -> bool) (eqb_spec : forall x y, eqb x y = true <-> x = y) (x y : T), + { x = y } + { x <> y }. + intros. + case_eq (eqb x y); intro. + left. apply eqb_spec; auto. + right. red. intro. apply eqb_spec in H0. rewrite H in H0. now contradict H0. + Defined. + + +(** Types with a Boolean equality that reflects in Leibniz equality *) +Class EqbType T := { + eqb : T -> T -> bool; + eqb_spec : forall x y, eqb x y = true <-> x = y +}. + + +(** Types with a decidable equality *) +Class DecType T := { + eq_refl : forall x : T, x = x; + eq_sym : forall x y : T, x = y -> y = x; + eq_trans : forall x y z : T, x = y -> y = z -> x = z; + eq_dec : forall x y : T, { x = y } + { x <> y } +}. + + +Hint Immediate eq_sym. +Hint Resolve eq_refl eq_trans. + +(** Types equipped with Boolean equality are decidable *) +Instance EqbToDecType T `(EqbType T) : DecType T. +Proof. + destruct H. + split; auto. + intros; subst; auto. + apply (eqb_to_eq_dec _ eqb0); auto. +Defined. + + +(** Class of types with a partial order *) +Class OrdType T := { + lt: T -> T -> Prop; + lt_trans : forall x y z : T, lt x y -> lt y z -> lt x z; + lt_not_eq : forall x y : T, lt x y -> ~ eq x y + (* compare : forall x y : T, Compare lt eq x y *) +}. + +Hint Resolve lt_not_eq lt_trans. + + +Global Instance StrictOrder_OrdType T `(OrdType T) : + StrictOrder (lt : T -> T -> Prop). +Proof. + split. + unfold Irreflexive, Reflexive, complement. + intros. apply lt_not_eq in H0; auto. + unfold Transitive. intros x y z. apply lt_trans. +Qed. + +(** Augment class of partial order with a compare function to obtain a total + order *) +Class Comparable T {ot:OrdType T} := { + compare : forall x y : T, Compare lt eq x y +}. + + +(** Class of inhabited types *) +Class Inhabited T := { + default_value : T +}. + +(** * CompDec: Merging all previous classes *) + +Class CompDec T := { + ty := T; + Eqb :> EqbType ty; + Decidable := EqbToDecType ty Eqb; + Ordered :> OrdType ty; + Comp :> @Comparable ty Ordered; + Inh :> Inhabited ty +}. + + +Instance ord_of_compdec t `{c: CompDec t} : (OrdType t) := + let (_, _, _, ord, _, _) := c in ord. + +Instance inh_of_compdec t `{c: CompDec t} : (Inhabited t) := + let (_, _, _, _, _, inh) := c in inh. + +Instance comp_of_compdec t `{c: CompDec t} : @Comparable t (ord_of_compdec t). +destruct c; trivial. +Defined. + +Instance eqbtype_of_compdec t `{c: CompDec t} : EqbType t := + let (_, eqbtype, _, _, _, inh) := c in eqbtype. + +Instance dec_of_compdec t `{c: CompDec t} : DecType t := + let (_, _, dec, _, _, inh) := c in dec. + + +Definition type_compdec {ty:Type} (cd : CompDec ty) := ty. + +Definition eqb_of_compdec {t} (c : CompDec t) : t -> t -> bool := + match c with + | {| ty := ty; Eqb := {| eqb := eqb |} |} => eqb + end. + + +Lemma compdec_eq_eqb {T:Type} {c : CompDec T} : forall x y : T, + x = y <-> eqb_of_compdec c x y = true. +Proof. + destruct c. destruct Eqb0. + simpl. intros. rewrite eqb_spec0. reflexivity. +Qed. + +Hint Resolve + ord_of_compdec + inh_of_compdec + comp_of_compdec + eqbtype_of_compdec + dec_of_compdec : typeclass_instances. + + +Record typ_compdec : Type := Typ_compdec { + te_carrier : Type; + te_compdec : CompDec te_carrier +}. + +Section CompDec_from. + + Variable T : Type. + Variable eqb' : T -> T -> bool. + Variable lt' : T -> T -> Prop. + Variable d : T. + + Hypothesis eqb_spec' : forall x y : T, eqb' x y = true <-> x = y. + Hypothesis lt_trans': forall x y z : T, lt' x y -> lt' y z -> lt' x z. + Hypothesis lt_neq': forall x y : T, lt' x y -> x <> y. + + Variable compare': forall x y : T, Compare lt' eq x y. + + Program Instance CompDec_from : (CompDec T) := {| + Eqb := {| eqb := eqb' |}; + Ordered := {| lt := lt'; lt_trans := lt_trans' |}; + Comp := {| compare := compare' |}; + Inh := {| default_value := d |} + |}. + + + Definition typ_compdec_from : typ_compdec := + Typ_compdec T CompDec_from. + +End CompDec_from. diff --git a/src/classes/SMT_classes_instances.v b/src/classes/SMT_classes_instances.v new file mode 100644 index 0000000..d6180a0 --- /dev/null +++ b/src/classes/SMT_classes_instances.v @@ -0,0 +1,600 @@ +(**************************************************************************) +(* *) +(* SMTCoq *) +(* Copyright (C) 2011 - 2019 *) +(* *) +(* See file "AUTHORS" for the list of authors *) +(* *) +(* This file is distributed under the terms of the CeCILL-C licence *) +(* *) +(**************************************************************************) + + +Require Import Bool OrderedType BinPos ZArith. +Require Import Int63. +Require Import State BVList. +Require Structures. +Require Export SMT_classes. + + +Section Unit. + + Let eqb : unit -> unit -> bool := fun _ _ => true. + + Let lt : unit -> unit -> Prop := fun _ _ => False. + + Instance unit_ord : OrdType unit. + Proof. exists lt; unfold lt; trivial. + intros; contradict H; trivial. + Defined. + + Instance unit_eqbtype : EqbType unit. + Proof. + exists eqb. intros. destruct x, y. unfold eqb. split; trivial. + Defined. + + Instance unit_comp : @Comparable unit unit_ord. + Proof. + split. intros. destruct x, y. + apply OrderedType.EQ; trivial. + Defined. + + Instance unit_inh : Inhabited unit := {| default_value := tt |}. + + Instance unit_compdec : CompDec unit := {| + Eqb := unit_eqbtype; + Ordered := unit_ord; + Comp := unit_comp; + Inh := unit_inh + |}. + + + + Definition unit_typ_compdec := Typ_compdec unit unit_compdec. + + + Lemma eqb_eq_unit : forall x y, eqb x y <-> x = y. + Proof. intros. split; case x; case y; unfold eqb; intros; now auto. + Qed. + +End Unit. + + +Section Bool. + + Definition ltb_bool x y := negb x && y. + + Definition lt_bool x y := ltb_bool x y = true. + + Instance bool_ord : OrdType bool. + Proof. + exists lt_bool. + intros x y z. + case x; case y; case z; intros; simpl; subst; auto. + intros x y. + case x; case y; intros; simpl in H; easy. + Defined. + + Instance bool_eqbtype : EqbType bool := + {| eqb := Bool.eqb; eqb_spec := eqb_true_iff |}. + + Instance bool_dec : DecType bool := + EqbToDecType _ bool_eqbtype. + + Instance bool_comp: Comparable bool. + Proof. + constructor. + intros x y. + case_eq (ltb_bool x y). + intros. + apply OrderedType.LT. + unfold lt, bool_ord, lt_bool. auto. + case_eq (Bool.eqb x y). + intros. + apply OrderedType.EQ. + apply Bool.eqb_prop. auto. + intros. + apply OrderedType.GT. + unfold lt, bool_ord, lt_bool. auto. + case x in *; case y in *; auto. + Defined. + + Instance bool_inh : Inhabited bool := {| default_value := false|}. + + Instance bool_compdec : CompDec bool := {| + Eqb := bool_eqbtype; + Ordered := bool_ord; + Comp := bool_comp; + Inh := bool_inh + |}. + + + Lemma ltb_bool_iff_lt: forall x y, ltb_bool x y = true <-> lt_bool x y. + Proof. intros x y; split; intro H; + case_eq x; case_eq y; intros; subst; compute in *; easy. + Qed. + +End Bool. + + +Section Z. + + Require Import OrderedTypeEx. + + Instance Z_ord : OrdType Z. + Proof. + exists Z_as_OT.lt. + exact Z_as_OT.lt_trans. + exact Z_as_OT.lt_not_eq. + Defined. + + Instance Z_eqbtype : EqbType Z := + {| eqb := Z.eqb; eqb_spec := Z.eqb_eq |}. + + (* Instance Z_eqbtype : EqbType Z := *) + (* {| eqb := Zeq_bool; eqb_spec := fun x y => symmetry (Zeq_is_eq_bool x y) |}. *) + + Instance Z_dec : DecType Z := + EqbToDecType _ Z_eqbtype. + + + Instance Z_comp: Comparable Z. + Proof. + constructor. + apply Z_as_OT.compare. + Defined. + + + Instance Z_inh : Inhabited Z := {| default_value := 0%Z |}. + + + Instance Z_compdec : CompDec Z := {| + Eqb := Z_eqbtype; + Ordered := Z_ord; + Comp := Z_comp; + Inh := Z_inh + |}. + + (** lt and eq predicates in Prop and their equivalences with the ones in bool *) + Definition eqP_Z x y := if Z.eqb x y then True else False. + Definition ltP_Z x y := if Z.ltb x y then True else False. + Definition leP_Z x y := if Z.leb x y then True else False. + Definition gtP_Z x y := if Z.gtb x y then True else False. + Definition geP_Z x y := if Z.geb x y then True else False. + + Lemma eq_Z_B2P: forall x y, Z.eqb x y = true <-> eqP_Z x y. + Proof. intros x y; split; intro H. + unfold eqP_Z; now rewrite H. + unfold eqP_Z in H. + case_eq ((x =? y)%Z ); intros; try now subst. + rewrite H0 in H. now contradict H. + Qed. + + Lemma lt_Z_B2P: forall x y, Z.ltb x y = true <-> ltP_Z x y. + Proof. intros x y; split; intro H. + unfold ltP_Z; now rewrite H. + unfold ltP_Z in H. + case_eq ((x <? y)%Z ); intros; try now subst. + rewrite H0 in H. now contradict H. + Qed. + + Lemma le_Z_B2P: forall x y, Z.leb x y = true <-> leP_Z x y. + Proof. intros x y; split; intro H. + unfold leP_Z; now rewrite H. + unfold leP_Z in H. + case_eq ((x <=? y)%Z ); intros; try now subst. + rewrite H0 in H. now contradict H. + Qed. + + Lemma gt_Z_B2P: forall x y, Z.gtb x y = true <-> gtP_Z x y. + Proof. intros x y; split; intro H. + unfold gtP_Z; now rewrite H. + unfold gtP_Z in H. + case_eq ((x >? y)%Z ); intros; try now subst. + rewrite H0 in H. now contradict H. + Qed. + + Lemma ge_Z_B2P: forall x y, Z.geb x y = true <-> geP_Z x y. + Proof. intros x y; split; intro H. + unfold geP_Z; now rewrite H. + unfold geP_Z in H. + case_eq ((x >=? y)%Z ); intros; try now subst. + rewrite H0 in H. now contradict H. + Qed. + + Lemma lt_Z_B2P': forall x y, ltP_Z x y <-> Z.lt x y. + Proof. intros x y; split; intro H. + unfold ltP_Z in H. + case_eq ((x <? y)%Z ); intros; rewrite H0 in H; try easy. + now apply Z.ltb_lt in H0. + apply lt_Z_B2P. + now apply Z.ltb_lt. + Qed. + + Lemma le_Z_B2P': forall x y, leP_Z x y <-> Z.le x y. + Proof. intros x y; split; intro H. + unfold leP_Z in H. + case_eq ((x <=? y)%Z ); intros; rewrite H0 in H; try easy. + now apply Z.leb_le in H0. + apply le_Z_B2P. + now apply Z.leb_le. + Qed. + + Lemma gt_Z_B2P': forall x y, gtP_Z x y <-> Z.gt x y. + Proof. intros x y; split; intro H. + unfold gtP_Z in H. + case_eq ((x >? y)%Z ); intros; rewrite H0 in H; try easy. + now apply Zgt_is_gt_bool in H0. + apply gt_Z_B2P. + now apply Zgt_is_gt_bool. + Qed. + + Lemma ge_Z_B2P': forall x y, geP_Z x y <-> Z.ge x y. + Proof. intros x y; split; intro H. + unfold geP_Z in H. + case_eq ((x >=? y)%Z ); intros; rewrite H0 in H; try easy. + rewrite Z.geb_leb in H0. rewrite le_Z_B2P in H0. + apply le_Z_B2P' in H0. now apply Z.ge_le_iff. + apply ge_Z_B2P. + rewrite Z.geb_leb. rewrite le_Z_B2P. + apply le_Z_B2P'. now apply Z.ge_le_iff. + Qed. + + Lemma leibniz_eq_Z_B2P: forall x y, eqP_Z x y <-> Logic.eq x y. + Proof. intros x y; split; intro H. + unfold eqP_Z in H. case_eq ((x =? y)%Z); intros. + now apply Z.eqb_eq in H0. rewrite H0 in H. now contradict H. + rewrite H. unfold eqP_Z. now rewrite Z.eqb_refl. + Qed. + +End Z. + + +Section Nat. + + Require Import OrderedTypeEx. + + Instance Nat_ord : OrdType nat. + Proof. + + exists Nat_as_OT.lt. + exact Nat_as_OT.lt_trans. + exact Nat_as_OT.lt_not_eq. + Defined. + + Instance Nat_eqbtype : EqbType nat := + {| eqb := Structures.nat_eqb; eqb_spec := Structures.nat_eqb_eq |}. + + Instance Nat_dec : DecType nat := + EqbToDecType _ Nat_eqbtype. + + + Instance Nat_comp: Comparable nat. + Proof. + constructor. + apply Nat_as_OT.compare. + Defined. + + + Instance Nat_inh : Inhabited nat := {| default_value := O%nat |}. + + + Instance Nat_compdec : CompDec nat := {| + Eqb := Nat_eqbtype; + Ordered := Nat_ord; + Comp := Nat_comp; + Inh := Nat_inh + |}. + +End Nat. + + +Section Positive. + + + Require Import OrderedTypeEx. + + Instance Positive_ord : OrdType positive. + Proof. + exists Positive_as_OT.lt. + exact Positive_as_OT.lt_trans. + exact Positive_as_OT.lt_not_eq. + Defined. + + Instance Positive_eqbtype : EqbType positive := + {| eqb := Pos.eqb; eqb_spec := Pos.eqb_eq |}. + + Instance Positive_dec : DecType positive := + EqbToDecType _ Positive_eqbtype. + + Instance Positive_comp: Comparable positive. + Proof. + constructor. + apply Positive_as_OT.compare. + Defined. + + Instance Positive_inh : Inhabited positive := {| default_value := 1%positive |}. + + Instance Positive_compdec : CompDec positive := {| + Eqb := Positive_eqbtype; + Ordered := Positive_ord; + Comp := Positive_comp; + Inh := Positive_inh + |}. + + +End Positive. + + +Section BV. + + Import BITVECTOR_LIST. + + + Instance BV_ord n : OrdType (bitvector n). + Proof. + exists (fun a b => (bv_ult a b)). + unfold bv_ult, RAWBITVECTOR_LIST.bv_ult. + intros x y z; destruct x, y, z. + simpl. rewrite wf0, wf1, wf2. rewrite N.eqb_refl. simpl. + apply RAWBITVECTOR_LIST.ult_list_trans. + intros x y; destruct x, y. + simpl. + intros. unfold not. + intros. rewrite H0 in H. + unfold bv_ult, bv in *. + unfold RAWBITVECTOR_LIST.bv_ult, RAWBITVECTOR_LIST.size in H. + rewrite N.eqb_refl in H. + apply RAWBITVECTOR_LIST.ult_list_not_eq in H. + apply H. easy. + Defined. + + Instance BV_eqbtype n : EqbType (bitvector n) := + {| eqb := @bv_eq n; + eqb_spec := @bv_eq_reflect n |}. + + Instance BV_dec n : DecType (bitvector n) := + EqbToDecType _ (BV_eqbtype n). + + + Instance BV_comp n: Comparable (bitvector n). + Proof. + constructor. + intros x y. + case_eq (bv_ult x y). + intros. + apply OrderedType.LT. + unfold lt, BV_ord. auto. + case_eq (bv_eq x y). + intros. + apply OrderedType.EQ. + apply bv_eq_reflect. auto. + intros. + apply OrderedType.GT. + unfold lt, BV_ord. auto. + destruct (BV_ord n). + unfold bv_ult. + unfold bv_eq, RAWBITVECTOR_LIST.bv_eq, + RAWBITVECTOR_LIST.bits in H. + unfold bv_ult, RAWBITVECTOR_LIST.bv_ult in H0. + unfold is_true. + + unfold RAWBITVECTOR_LIST.bv_ult, RAWBITVECTOR_LIST.size. + destruct x, y. simpl in *. + unfold RAWBITVECTOR_LIST.size in *. + rewrite wf0, wf1 in *. + rewrite N.eqb_refl in *. + + apply RAWBITVECTOR_LIST.nlt_be_neq_gt. + rewrite !List.rev_length. + apply (f_equal (N.to_nat)) in wf0. + apply (f_equal (N.to_nat)) in wf1. + rewrite Nnat.Nat2N.id in wf0, wf1. + now rewrite wf0, wf1. + unfold RAWBITVECTOR_LIST.ult_list in H0. easy. + now apply RAWBITVECTOR_LIST.rev_neq in H. + Defined. + + Instance BV_inh n : Inhabited (bitvector n) := + {| default_value := zeros n |}. + + + Instance BV_compdec n: CompDec (bitvector n) := {| + Eqb := BV_eqbtype n; + Ordered := BV_ord n; + Comp := BV_comp n; + Inh := BV_inh n + |}. + +End BV. + + + +Section FArray. + + Require Import FArray. + + Instance FArray_ord key elt + `{key_ord: OrdType key} + `{elt_ord: OrdType elt} + `{elt_dec: DecType elt} + `{elt_inh: Inhabited elt} + `{key_comp: @Comparable key key_ord} : OrdType (farray key elt). + Proof. + exists (@lt_farray key elt key_ord key_comp elt_ord elt_inh). + apply lt_farray_trans. + unfold not. + intros. + apply lt_farray_not_eq in H. + apply H. + rewrite H0. + apply eqfarray_refl. auto. + Defined. + + Instance FArray_eqbtype key elt + `{key_ord: OrdType key} + `{elt_ord: OrdType elt} + `{elt_eqbtype: EqbType elt} + `{key_comp: @Comparable key key_ord} + `{elt_comp: @Comparable elt elt_ord} + `{elt_inh: Inhabited elt} + : EqbType (farray key elt). + Proof. + exists FArray.equal. + intros. + split. + apply FArray.equal_eq. + intros. subst. apply eq_equal. apply eqfarray_refl. + apply EqbToDecType. auto. + Defined. + + + Instance FArray_dec key elt + `{key_ord: OrdType key} + `{elt_ord: OrdType elt} + `{elt_eqbtype: EqbType elt} + `{key_comp: @Comparable key key_ord} + `{elt_comp: @Comparable elt elt_ord} + `{elt_inh: Inhabited elt} + : DecType (farray key elt) := + EqbToDecType _ (FArray_eqbtype key elt). + + + Instance FArray_comp key elt + `{key_ord: OrdType key} + `{elt_ord: OrdType elt} + `{elt_eqbtype: EqbType elt} + `{key_comp: @Comparable key key_ord} + `{elt_inh: Inhabited elt} + `{elt_comp: @Comparable elt elt_ord} : Comparable (farray key elt). + Proof. + constructor. + intros. + destruct (compare_farray key_comp (EqbToDecType _ elt_eqbtype) elt_comp x y). + - apply OrderedType.LT. auto. + - apply OrderedType.EQ. + specialize (@eq_equal key elt key_ord key_comp elt_ord elt_comp elt_inh x y). + intros. + apply H in e. + now apply equal_eq in e. + - apply OrderedType.GT. auto. + Defined. + + Instance FArray_inh key elt + `{key_ord: OrdType key} + `{elt_inh: Inhabited elt} : Inhabited (farray key elt) := + {| default_value := FArray.empty key_ord elt_inh |}. + + + Program Instance FArray_compdec key elt + `{key_compdec: CompDec key} + `{elt_compdec: CompDec elt} : + CompDec (farray key elt) := + {| + Eqb := FArray_eqbtype key elt; + Ordered := FArray_ord key elt; + (* Comp := FArray_comp key elt ; *) + Inh := FArray_inh key elt + |}. + + Next Obligation. + constructor. + destruct key_compdec, elt_compdec. + simpl in *. + unfold lt_farray. + intros. simpl. + unfold EqbToDecType. simpl. + case_eq (compare x y); intros. + apply OrderedType.LT. + destruct (compare x y); try discriminate H; auto. + apply OrderedType.EQ. + destruct (compare x y); try discriminate H; auto. + apply OrderedType.GT. + destruct (compare y x); try discriminate H; auto; clear H. + Defined. + +End FArray. + + +Section Int63. + + Local Open Scope int63_scope. + + Let int_lt x y := + if Int63Native.ltb x y then True else False. + + Instance int63_ord : OrdType int. + Proof. + exists int_lt; unfold int_lt. + - intros x y z. + case_eq (x < y); intro; + case_eq (y < z); intro; + case_eq (x < z); intro; + simpl; try easy. + contradict H1. + rewrite not_false_iff_true. + rewrite Int63Axioms.ltb_spec in *. + exact (Z.lt_trans _ _ _ H H0). + - intros x y. + case_eq (x < y); intro; simpl; try easy. + intros. + rewrite Int63Axioms.ltb_spec in *. + rewrite <- Int63Properties.to_Z_eq. + exact (Z.lt_neq _ _ H). + Defined. + + Instance int63_eqbtype : EqbType int := + {| eqb := Int63Native.eqb; eqb_spec := Int63Properties.eqb_spec |}. + + Instance int63_dec : DecType int := + EqbToDecType _ int63_eqbtype. + + + Instance int63_comp: Comparable int. + Proof. + constructor. + intros x y. + case_eq (x < y); intro; + case_eq (x == y); intro; unfold lt in *; simpl. + - rewrite Int63Properties.eqb_spec in H0. + contradict H0. + assert (int_lt x y). unfold int_lt. + rewrite H; trivial. + remember lt_not_eq. unfold lt in *. simpl in n. + exact (n _ _ H0). + - apply LT. unfold int_lt. rewrite H; trivial. + - apply EQ. rewrite Int63Properties.eqb_spec in H0; trivial. + - apply GT. unfold int_lt. + case_eq (y < x); intro; simpl; try easy. + specialize (leb_ltb_eqb x y); intro. + contradict H2. + rewrite leb_negb_gtb. rewrite H1. simpl. + red. intro. symmetry in H2. + rewrite orb_true_iff in H2. destruct H2; contradict H2. + rewrite H. auto. + rewrite H0. auto. + Defined. + + + Instance int63_inh : Inhabited int := {| default_value := 0 |}. + + Instance int63_compdec : CompDec int := {| + Eqb := int63_eqbtype; + Ordered := int63_ord; + Comp := int63_comp; + Inh := int63_inh + |}. + + +End Int63. + + +Hint Resolve unit_ord bool_ord Z_ord Positive_ord BV_ord FArray_ord : typeclass_instances. +Hint Resolve unit_eqbtype bool_eqbtype Z_eqbtype Positive_eqbtype BV_eqbtype FArray_eqbtype : typeclass_instances. +Hint Resolve bool_dec Z_dec Positive_dec BV_dec FArray_dec : typeclass_instances. +Hint Resolve unit_comp bool_comp Z_comp Positive_comp BV_comp FArray_comp : typeclass_instances. +Hint Resolve unit_inh bool_inh Z_inh Positive_inh BV_inh FArray_inh : typeclass_instances. +Hint Resolve unit_compdec bool_compdec Z_compdec Positive_compdec BV_compdec FArray_compdec : typeclass_instances. + +Hint Resolve int63_ord int63_inh int63_eqbtype int63_dec int63_comp int63_compdec + : typeclass_instances. |