├── doc ├── mset.pdf ├── mset.bib └── mset.tex ├── coqdoc ├── coqdoc.sty ├── mset_doc.pdf ├── toc.html ├── coqdoc.css └── MSetWithDups.html ├── .gitignore ├── Makefile ├── README.md ├── MSetWithDups.v ├── MSetListWithDups.v ├── LICENSE └── MSetFoldWithAbort.v /doc/mset.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fireeye/MSetsExtra/master/doc/mset.pdf -------------------------------------------------------------------------------- /coqdoc/coqdoc.sty: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fireeye/MSetsExtra/master/coqdoc/coqdoc.sty -------------------------------------------------------------------------------- /coqdoc/mset_doc.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fireeye/MSetsExtra/master/coqdoc/mset_doc.pdf -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *Theory.* 2 | *.a 3 | *.o 4 | *.cmo 5 | *.cmi 6 | *.cmx 7 | *.cma 8 | *.cmxa 9 | a.out 10 | *.so 11 | *.native 12 | *.byte 13 | _build 14 | *.glob 15 | *.vo 16 | *.d 17 | *~ 18 | *.aux 19 | *.out 20 | *.toc 21 | *.log 22 | *.bbl 23 | *.blg 24 | *.fls 25 | *.bkp 26 | *.dvi 27 | *.bak 28 | *.deps 29 | *.dir-locals.el 30 | *.fdb_latexmk 31 | *.top 32 | -------------------------------------------------------------------------------- /doc/mset.bib: -------------------------------------------------------------------------------- 1 | @inproceedings{lammich10itp, 2 | author = {Peter Lammich and 3 | Andreas Lochbihler}, 4 | title = {{The Isabelle Collections Framework}}, 5 | booktitle = {{ITP} 2010, Edinburgh, UK, July 11-14, 2010. Proceedings}, 6 | pages = {339--354}, 7 | year = 2010, 8 | url = {http://dx.doi.org/10.1007/978-3-642-14052-5_24}, 9 | doi = {10.1007/978-3-642-14052-5_24}, 10 | timestamp = {Tue, 10 Aug 2010 14:34:07 +0200}, 11 | biburl = {http://dblp.uni-trier.de/rec/bib/conf/itp/LammichL10}, 12 | bibsource = {dblp computer science bibliography, http://dblp.org} 13 | } 14 | 15 | @Manual{coq, 16 | title = {The Coq proof assistant reference manual}, 17 | author = {\mbox{The Coq development team}}, 18 | note = {Version~8.4}, 19 | organization = {INRIA}, 20 | year = {2012}, 21 | url = "http://coq.inria.fr" 22 | } 23 | 24 | @Book{coqart, 25 | author = "Bertot, Yves and Cast\'eran, Pierre", 26 | title = "Interactive Theorem Proving and Program Development. Coq'Art: The Calculus of Inductive Constructions", 27 | series = "Texts in Theoretical Computer Science", 28 | year = "2004", 29 | publisher = "Springer Verlag" 30 | } 31 | 32 | @Manual{fireeye-coq-sets, 33 | title = {Efficiently Executable Sets Extension: Source Code and Documentation}, 34 | author = {FireEye Formal Methods Team}, 35 | organization = {FireEye Technologie Deutschland GmbH}, 36 | month = may, 37 | year = 2016, 38 | note = {Available at \url{https://github.com/fireeye/MSetsExtra}}} 39 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # File: Makefile 2 | # 3 | # Author: FireEye, Inc. - Formal Methods Team 4 | 5 | COQINCLUDES=-I . 6 | COQC=coqtop -q $(COQINCLUDES) -batch -compile 7 | COQDOC=coqdoc 8 | COQDEP=coqdep $(COQINCLUDES) 9 | COQFILES=\ 10 | MSetWithDups.v \ 11 | MSetFoldWithAbort.v \ 12 | MSetIntervals.v \ 13 | MSetListWithDups.v 14 | 15 | 16 | ####################################### 17 | ########## GLOBAL RULES ############### 18 | 19 | .DEFAULT_GOAL: all 20 | 21 | .PHONY: all coqhtml coqtex clean doc 22 | 23 | 24 | proof: $(COQFILES:.v=.vo) 25 | doc: coqhtml coqtex doc/main.tex 26 | all: proof doc 27 | 28 | 29 | 30 | ####################################### 31 | ########## COQ RULES ################## 32 | 33 | %.vo %.glob: %.v 34 | $(COQC) $* 35 | 36 | %.v.d: %.v 37 | $(COQDEP) "$<" > "$@" || ( RV=$$?; rm -f "$@"; exit $${RV} ) 38 | 39 | CLEAN_TARGETS := clean clean_doc clean_coq 40 | 41 | ifeq (,$(filter $(CLEAN_TARGETS),$(MAKECMDGOALS))) 42 | -include $(addsuffix .d,$(COQFILES)) 43 | .SECONDARY: $(addsuffix .d,$(COQFILES)) 44 | endif 45 | 46 | ####################################### 47 | ########## DOCUMENTATION ############# 48 | 49 | coqhtml: 50 | mkdir -p coqdoc 51 | $(COQDOC) -toc --html -g -d coqdoc $(COQFILES) 52 | 53 | coqtex: 54 | mkdir -p coqdoc 55 | $(COQDOC) -toc --latex -g -o coqdoc/mset_doc.tex $(COQFILES) 56 | cd coqdoc; pdflatex mset_doc.tex 57 | cd coqdoc; pdflatex mset_doc.tex 58 | 59 | %.html: %.md 60 | pandoc -N $< -o $@ 61 | 62 | %.pdf: %.md 63 | pandoc -N $< -o $@ 64 | 65 | doc/mset.pdf: doc/mset.tex doc/mset.bib 66 | cd doc; pdflatex mset.tex 67 | cd doc; bibtex mset 68 | cd doc; pdflatex mset.tex 69 | cd doc; pdflatex mset.tex 70 | 71 | ####################################### 72 | ########## CLEANING RULES ############# 73 | 74 | clean_coq: 75 | rm -f $(COQFILES:.v=.v.d) $(COQFILES:.v=.vo) $(COQFILES:.v=.glob) 76 | 77 | clean_doc: 78 | rm -rf coqdoc 79 | rm -f readme.html readme.pdf 80 | 81 | clean_tex: 82 | cd doc; rm -f *.ps *~ *.dvi *.aux *.log *.idx *.toc *.nav *.out *.snm *.flc *.vrb *.bbl *.blg 83 | 84 | clean: clean_coq clean_doc clean_tex 85 | rm -f *~ 86 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Efficiently Executable Sets Library 2 | 3 | Coq (as of version 8.4pl6) provides the module `MSetInterface` which 4 | contains interfaces for sets. There are implementations using sorted 5 | and unsorted lists (both without duplicates) as well as AVL and RBT 6 | trees for these interfaces. While these implementations - particularly 7 | the ones based on binary trees - extract to reasonably efficient code, 8 | at FireEye we nevertheless were struggling with performance 9 | issues. 10 | 11 | This directory contains extensions to Coq's set library that helped 12 | us, i.e. the FireEye Formal Methods team (formal-methods@fireeye.com), 13 | solve these performance issues. 14 | 15 | There are the following files 16 | 17 | - `MSetWithDups.v` (interface definitions for `MSetListWithDups.v`) 18 | - `MSetListWithDups.v` (unsorted Lists with duplicates) 19 | - `MSetIntervals.v` (sets implemented as intervals of integers) 20 | - `MSetFoldWithAbort.v` (efficient fold operation) 21 | 22 | - `readme.md` (this readme) 23 | - `LICENSE` (license information, LGPL 2.1) 24 | - `Makefile` 25 | - `doc/*` (high level documentation) 26 | - `coqdoc/*` (generated coqdoc documentation) 27 | 28 | 29 | The `Makefile` provided is set up to generate documentation as well as 30 | process Coq files. The default target `proof` just processes the Coq 31 | files. For convenience coqdoc and a pdf version of top-level 32 | documentation is part of the repository. If you want to rebuild them 33 | use target `doc` or target `all`. 34 | 35 | 36 | ## Interval Sets 37 | 38 | The file `MSetIntervals.v` contains an implementation of `WSetOn`, 39 | which is backed by a sorted list of integer intervals. It is very 40 | space efficient for large sets that can be represented by a small 41 | number of large intervals. There are instantiations of this set for 42 | the element types `Z`, `N` and `nat`. Further instantiation can be 43 | easily created by the user. 44 | 45 | 46 | ## Unsorted Lists With Duplicates 47 | 48 | The file `MSetListWithDups.v` contains an implementation of sets as 49 | unsorted lists with duplicates. It has has an O(1) `add` operation and 50 | an O(n) `union` operation. The price for this is that we allow duplicates 51 | and `fold` is allowed to visit elements multiple times. It is the users 52 | responsibility to use this set implementation carefully and avoid adding 53 | the same element over and over again. Otherwise, a lot of space is used and 54 | performance of operations like `filter` might become arbitrarily bad. 55 | 56 | Since `fold` is allowed to visit elements multiple times, this set 57 | implementation cannot instantiate the standard weak set interfaces 58 | (e.g. `WSetOn`). Therefore, the file `MSetWithDups.v` provides 59 | specialized interfaces for it and establishes the connection of these 60 | interfaces with `WSetOn`. 61 | 62 | 63 | ## Fold With Abort 64 | 65 | Folding over all elements of a set is a core operation, which has 66 | close ties to the concept of iterators in languages like C++. However, 67 | while iterators allow early abort, this is not possible with 68 | the standard fold operation. As a result, many efficient iterator 69 | algorithms become inefficient when implemented via folding. 70 | 71 | _Fold with abort_ operations are an 72 | answer to this issue. `MSetFoldWithAbort.v` provides interfaces for a family of such 73 | fold with abort operations and use these operations to define operation like a 74 | very efficient filter or existence check. The interfaces 75 | are instantiated for all of Coq's current set implementations, i.e. for 76 | AVL trees, RBT trees, sorted lists and unsorted lists without duplicates. 77 | _Fold with abort_ can exploit the binary tree structure. Therefore the binary 78 | search tree implementation can skip the most work. Sorted lists are good as well, 79 | since the ordering can be used for aborting. For unsorted lists, operations like 80 | `filter` are not optimized, but at least operations like existence checks can 81 | abort early. 82 | -------------------------------------------------------------------------------- /doc/mset.tex: -------------------------------------------------------------------------------- 1 | \documentclass[a4paper,10pt,oneside]{article} 2 | 3 | \usepackage[utf8]{inputenc} 4 | \usepackage[a4paper]{geometry} 5 | \usepackage{hyperref} 6 | \usepackage{url} 7 | \usepackage{color} 8 | \usepackage{natbib} 9 | %\usepackage{todonotes} 10 | 11 | \newcommand{\comment}[1]{\todo{\textcolor{red}{#1}}} 12 | \newcommand{\commentTT}[1]{\todo{\textcolor{blue}{TT: #1}}} 13 | \newcommand{\commentHT}[1]{\todo{\textcolor{green}{HT: #1}}} 14 | \newcommand{\commentJM}[1]{\todo{\textcolor{yellow}{JM: #1}}} 15 | 16 | \newcommand{\code}[1]{\texttt{#1}} 17 | 18 | \title{Efficiently Executable Sets used by FireEye} 19 | 20 | \author{FireEye Formal Methods Team Dresden% 21 | % respect EU directive 2003/58/EC ;- 22 | \footnote{\url{formal-methods@FireEye.com}, FireEye Technologie Deutschland GmbH, Wilsdruffer Strasse 27, 01067 Dresden, Germany, Amtsgericht Dresden HRB 33246, Geschäftsführer: Alexa King, Mark Hegarty}} 23 | \date{1st July 2016} 24 | 25 | \begin{document} 26 | \maketitle 27 | 28 | \section{Introduction} 29 | 30 | 31 | 32 | FireEye provides cybersecurity solutions for detecting, preventing and 33 | resolving cyber-attacks. In 34 | order to increase the confidence in many of our products we perform proofs of security-critical software 35 | components in parallel with development of the components themselves. 36 | We 37 | carry out the proofs in a Coq~\cite{coq} model that follows the structure of the 38 | implementation, but is much more abstract. The resulting gap is 39 | bridged by model-based testing. 40 | 41 | Our testing framework is developed in OCaml and hinges on Coq's code 42 | extraction to obtain an executable version of the model. We execute 43 | millions of test cases, each with a state comprising thousands of 44 | objects. Thus, performance is a critical aspect: we need to fine-tune 45 | the used data structures based on the frequency of the operations 46 | performed. 47 | 48 | Coq's sets library, while well-suited for mathematical reasoning, 49 | proved to be a bottleneck for our testing framework. In this note, we 50 | describe an extension of this library that drastically improves its 51 | usefulness in our development. 52 | 53 | \section{Fine Tuned Set Implementations for Code Extraction} 54 | 55 | Coq (as of version 8.4pl6) provides the module \code{MSetInterface} 56 | which contains interfaces for sets. There are implementations using 57 | sorted and unsorted lists (both without duplicates) as well as AVL and 58 | RBT trees for these interfaces. While these 59 | implementations---particularly the ones based on binary trees--- 60 | extract to reasonably efficient code, we nevertheless were struggling with performance 61 | issues. Profiling revealed several problems related to the extracted 62 | set code: large sets of integers use a lot of space; slow insert and 63 | union operations are a huge issue for one of our algorithms and a slow 64 | specialised filter operation for another one. In the following we 65 | explain how we solved each of these challenges by providing general 66 | purpose extensions to Coq's sets library as well as special purpose 67 | set implementations. 68 | 69 | 70 | \paragraph{Interval Sets} 71 | In our setting, we need large sets of integers. They contain either 72 | only very few integers or nearly all the integers between 0 and 73 | 65535. The AVL 74 | tree set implementation was time efficient, but used large amounts of 75 | memory and, when marshalled, disc-space. By providing a set 76 | instantiation\footnote{module \code{MSetIntervals}} that uses lists of 77 | intervals internally, we could shrink the memory and disc-space 78 | requirements drastically. 79 | 80 | 81 | \paragraph{Lists with Duplicates} 82 | Some of our algorithms collect a set of results by adding single 83 | results and combining result sets. They guarantee that results are not 84 | added multiple times to a set. For such requirements, lists are an 85 | efficient, commonly used datastructure. However, lists don't provide a 86 | high-level set view. On the other hand, all standard Coq set 87 | implementations are inefficient for our use case, because they perform 88 | an expensive membership test when inserting elements. 89 | 90 | We provide an implementation of the set interfaces using lists with 91 | duplicates\footnote{module \code{MSetListWithDups}} and we allow 92 | fold to visit the same element multiple times. To achieve 93 | this, we removed the requirement that the element lists contain no 94 | duplicates from Coq's set interface \code{WSetsOn}\footnote{see new 95 | interface \code{WSetsOnWithDups}}. 96 | 97 | 98 | \paragraph{Fold With Abort} 99 | Folding over all elements of a set is a core operation, which has 100 | close ties to the concept of iterators in languages like C++. However, 101 | while iterators allow early abort, this is not possible with 102 | the standard fold operation. As a result, many efficient iterator 103 | algorithms become inefficient when implemented via folding. 104 | 105 | Fold with abort operations (see e.\,g.~\cite{lammich10itp}) are an 106 | answer to this issue. We provide interfaces for a family of such 107 | \emph{fold with abort} operations and use these operations to define 108 | very efficient filter and existence check operations. The interfaces 109 | are instantiated for all of Coq's set implementations. 110 | 111 | In our application, we use large sets of intervals implemented via AVL 112 | trees. Using fold with abort operations, we can very efficiently find 113 | all intervals overlapping with a given interval. 114 | 115 | 116 | \section{Conclusion} 117 | 118 | One of our typical test cases used to spend about 90 s in Coq 119 | extracted code (and 25 s in extra code). By using lists with 120 | duplicates, the runtime of the Coq extracted code could be reduced to 121 | about 9 s. Using interval sets reduced the overall disc-space required 122 | to store a test result to just about a quarter (while marginally 123 | improving the runtime). Finally, using fold with abort operations 124 | reduced the needed runtime to less than a second for the Coq extracted 125 | code. We believe that the set implementations used to achieve these 126 | improvements are useful in general and therefore provide them to the 127 | community~\cite{fireeye-coq-sets}. 128 | 129 | The issues described here for the set interfaces are an instance of a more 130 | general issue we have encountered at FireEye. Many of Coq's libraries 131 | are aimed at theorem proving and provide good mathematical 132 | abstractions. However, they fall short of providing efficiently 133 | executable extracted code. We believe that this is an important 134 | deficiency of the Coq library and we would be delighted if the work 135 | presented here calls attention to this problem and becomes a first 136 | step towards providing a comprehensive library fine-tuned for code 137 | extraction. 138 | 139 | 140 | \bibliographystyle{plain} 141 | \bibliography{mset} 142 | 143 | 144 | 145 | \end{document} 146 | 147 | %%% Local Variables: 148 | %%% mode: latex 149 | %%% TeX-master: t 150 | %%% End: 151 | -------------------------------------------------------------------------------- /coqdoc/toc.html: -------------------------------------------------------------------------------- 1 | 3 | 4 | 5 | 6 | 7 | Table of contents 8 | 9 | 10 | 11 | 12 |
13 | 14 | 16 | 17 |
18 | 19 |
20 |

Library MSetWithDups

 21 | 37 |

Library MSetFoldWithAbort

 38 | 101 |

Library MSetIntervals

 102 | 229 |

Library MSetListWithDups

 230 | 249 |
250 |
This page has been generated by coqdoc 251 |
252 | 253 |
254 | 255 | 256 | -------------------------------------------------------------------------------- /MSetWithDups.v: -------------------------------------------------------------------------------- 1 | (* 2 | * Efficiently Executable Sets Library 3 | * Author: FireEye, Inc. - Formal Methods Team 4 | * 5 | * Copyright (C) 2016 FireEye Technologie Deutschland GmbH 6 | * 7 | * This library is free software; you can redistribute it and/or 8 | * modify it under the terms of the GNU Lesser General Public 9 | * License as published by the Free Software Foundation; either 10 | * version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This library is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | * Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public 18 | * License along with this library. 19 | * If not, see . 20 | *) 21 | 22 | (** * Signature for weak sets which may contain duplicates 23 | 24 | The interface [WSetsOn] demands that [elements] returns a list 25 | without duplicates and that the fold function iterates over this 26 | result. Another potential problem is that the function [cardinal] 27 | is supposed to return the length of the elements list. 28 | 29 | Therefore, implementations that store duplicates internally and for 30 | which the fold function would visit elements multiple times are 31 | ruled out. Such implementations might be desirable for performance 32 | reasons, though. One such (sometimes useful) example are unsorted 33 | lists with duplicates. They have a very efficient insert and union 34 | operation. If they are used in such a way that not too many 35 | membership tests happen and that not too many duplicates 36 | accumulate, it might be a very efficient datastructure. 37 | 38 | In order to allow efficient weak set implementations that use 39 | duplicates internally, we provide new module types in this 40 | file. There is [WSetsOnWithDups], which is a proper subset of 41 | [WSetsOn]. It just removes the problematic properties of [elements] 42 | and [cardinal]. 43 | 44 | Since one is of course interested in specifying the cardinality 45 | and in computing a list of elements without duplicates, there is 46 | also an extension [WSetsOnWithDupsExtra] of [WSetsOnWithDups]. This 47 | extension introduces a new operation [elements_dist], which is a 48 | version of [elements] without duplicates. This allows to 49 | specify [cardinality] with respect to [elements_dist]. 50 | *) 51 | 52 | Require Import Coq.MSets.MSetInterface. 53 | Require Import ssreflect. 54 | 55 | (** ** WSetsOnWithDups 56 | 57 | The module type [WSetOnWithDups] is a proper subset of [WSetsOn]; 58 | the problematic parameters [cardinal_spec] and [elements_spec2w] 59 | are missing. 60 | 61 | We use this approach to be as noninvasive as possible. If we had the 62 | liberty to modify the existing MSet library, it might be better to 63 | define WSetsOnWithDups as below and define WSetOn by adding the two 64 | extra parameters. 65 | *) 66 | Module Type WSetsOnWithDups (E : DecidableType). 67 | Include WOps E. 68 | 69 | Parameter In : elt -> t -> Prop. 70 | Declare Instance In_compat : Proper (E.eq==>eq==>iff) In. 71 | 72 | Definition Equal s s' := forall a : elt, In a s <-> In a s'. 73 | Definition Subset s s' := forall a : elt, In a s -> In a s'. 74 | Definition Empty s := forall a : elt, ~ In a s. 75 | Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. 76 | Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x. 77 | 78 | Notation "s [=] t" := (Equal s t) (at level 70, no associativity). 79 | Notation "s [<=] t" := (Subset s t) (at level 70, no associativity). 80 | 81 | Definition eq : t -> t -> Prop := Equal. 82 | Include IsEq. (** [eq] is obviously an equivalence, for subtyping only *) 83 | Include HasEqDec. 84 | 85 | Section Spec. 86 | Variable s s': t. 87 | Variable x y : elt. 88 | Variable f : elt -> bool. 89 | Notation compatb := (Proper (E.eq==>Logic.eq)) (only parsing). 90 | 91 | Parameter mem_spec : mem x s = true <-> In x s. 92 | Parameter equal_spec : equal s s' = true <-> s[=]s'. 93 | Parameter subset_spec : subset s s' = true <-> s[<=]s'. 94 | Parameter empty_spec : Empty empty. 95 | Parameter is_empty_spec : is_empty s = true <-> Empty s. 96 | Parameter add_spec : In y (add x s) <-> E.eq y x \/ In y s. 97 | Parameter remove_spec : In y (remove x s) <-> In y s /\ ~E.eq y x. 98 | Parameter singleton_spec : In y (singleton x) <-> E.eq y x. 99 | Parameter union_spec : In x (union s s') <-> In x s \/ In x s'. 100 | Parameter inter_spec : In x (inter s s') <-> In x s /\ In x s'. 101 | Parameter diff_spec : In x (diff s s') <-> In x s /\ ~In x s'. 102 | Parameter fold_spec : forall (A : Type) (i : A) (f : elt -> A -> A), 103 | fold f s i = fold_left (flip f) (elements s) i. 104 | Parameter filter_spec : compatb f -> 105 | (In x (filter f s) <-> In x s /\ f x = true). 106 | Parameter for_all_spec : compatb f -> 107 | (for_all f s = true <-> For_all (fun x => f x = true) s). 108 | Parameter exists_spec : compatb f -> 109 | (exists_ f s = true <-> Exists (fun x => f x = true) s). 110 | Parameter partition_spec1 : compatb f -> 111 | fst (partition f s) [=] filter f s. 112 | Parameter partition_spec2 : compatb f -> 113 | snd (partition f s) [=] filter (fun x => negb (f x)) s. 114 | Parameter elements_spec1 : InA E.eq x (elements s) <-> In x s. 115 | Parameter choose_spec1 : choose s = Some x -> In x s. 116 | Parameter choose_spec2 : choose s = None -> Empty s. 117 | 118 | End Spec. 119 | 120 | End WSetsOnWithDups. 121 | 122 | 123 | (** ** WSetsOnWithDupsExtra 124 | 125 | [WSetsOnWithDupsExtra] introduces [elements_dist] in order to 126 | specify cardinality and in order to get an operation similar to 127 | the original behavior of [elements]. *) 128 | Module Type WSetsOnWithDupsExtra (E : DecidableType). 129 | Include WSetsOnWithDups E. 130 | 131 | (** An operation for getting an elements list without duplicates *) 132 | Parameter elements_dist : t -> list elt. 133 | 134 | Parameter elements_dist_spec1 : forall x s, InA E.eq x (elements_dist s) <-> 135 | InA E.eq x (elements s). 136 | 137 | Parameter elements_dist_spec2w : forall s, NoDupA E.eq (elements_dist s). 138 | 139 | 140 | (** Cardinality can then be specified with respect to [elements_dist]. *) 141 | Parameter cardinal_spec : forall s, cardinal s = length (elements_dist s). 142 | End WSetsOnWithDupsExtra. 143 | 144 | 145 | (** ** WSetOn to WSetsOnWithDupsExtra 146 | 147 | Since [WSetsOnWithDupsExtra] is morally a weaker version of [WSetsOn] 148 | that allows the fold operation to visit elements multiple time, we can write then 149 | following conversion. *) 150 | 151 | Module WSetsOn_TO_WSetsOnWithDupsExtra (E : DecidableType) (W : WSetsOn E) <: 152 | WSetsOnWithDupsExtra E. 153 | 154 | Include W. 155 | 156 | Definition elements_dist := W.elements. 157 | 158 | Lemma elements_dist_spec1 : forall x s, InA E.eq x (elements_dist s) <-> 159 | InA E.eq x (elements s). 160 | Proof. done. Qed. 161 | 162 | Lemma elements_dist_spec2w : forall s, NoDupA E.eq (elements_dist s). 163 | Proof. apply elements_spec2w. Qed. 164 | 165 | End WSetsOn_TO_WSetsOnWithDupsExtra. 166 | 167 | 168 | -------------------------------------------------------------------------------- /coqdoc/coqdoc.css: -------------------------------------------------------------------------------- 1 | body { padding: 0px 0px; 2 | margin: 0px 0px; 3 | background-color: white } 4 | 5 | #page { display: block; 6 | padding: 0px; 7 | margin: 0px; 8 | padding-bottom: 10px; } 9 | 10 | #header { display: block; 11 | position: relative; 12 | padding: 0; 13 | margin: 0; 14 | vertical-align: middle; 15 | border-bottom-style: solid; 16 | border-width: thin } 17 | 18 | #header h1 { padding: 0; 19 | margin: 0;} 20 | 21 | 22 | /* Contents */ 23 | 24 | #main{ display: block; 25 | padding: 10px; 26 | font-family: sans-serif; 27 | font-size: 100%; 28 | line-height: 100% } 29 | 30 | #main h1 { line-height: 95% } /* allow for multi-line headers */ 31 | 32 | #main a.idref:visited {color : #416DFF; text-decoration : none; } 33 | #main a.idref:link {color : #416DFF; text-decoration : none; } 34 | #main a.idref:hover {text-decoration : none; } 35 | #main a.idref:active {text-decoration : none; } 36 | 37 | #main a.modref:visited {color : #416DFF; text-decoration : none; } 38 | #main a.modref:link {color : #416DFF; text-decoration : none; } 39 | #main a.modref:hover {text-decoration : none; } 40 | #main a.modref:active {text-decoration : none; } 41 | 42 | #main .keyword { color : #cf1d1d } 43 | #main { color: black } 44 | 45 | .section { background-color: rgb(60%,60%,100%); 46 | padding-top: 13px; 47 | padding-bottom: 13px; 48 | padding-left: 3px; 49 | margin-top: 5px; 50 | margin-bottom: 5px; 51 | font-size : 175% } 52 | 53 | h2.section { background-color: rgb(80%,80%,100%); 54 | padding-left: 3px; 55 | padding-top: 12px; 56 | padding-bottom: 10px; 57 | font-size : 130% } 58 | 59 | h3.section { background-color: rgb(90%,90%,100%); 60 | padding-left: 3px; 61 | padding-top: 7px; 62 | padding-bottom: 7px; 63 | font-size : 115% } 64 | 65 | h4.section { 66 | /* 67 | background-color: rgb(80%,80%,80%); 68 | max-width: 20em; 69 | padding-left: 5px; 70 | padding-top: 5px; 71 | padding-bottom: 5px; 72 | */ 73 | background-color: white; 74 | padding-left: 0px; 75 | padding-top: 0px; 76 | padding-bottom: 0px; 77 | font-size : 100%; 78 | font-weight : bold; 79 | text-decoration : underline; 80 | } 81 | 82 | #main .doc { margin: 0px; 83 | font-family: sans-serif; 84 | font-size: 100%; 85 | line-height: 125%; 86 | max-width: 40em; 87 | color: black; 88 | padding: 10px; 89 | background-color: #90bdff } 90 | 91 | .inlinecode { 92 | display: inline; 93 | /* font-size: 125%; */ 94 | color: #666666; 95 | font-family: monospace } 96 | 97 | .doc .inlinecode { 98 | display: inline; 99 | font-size: 120%; 100 | color: rgb(30%,30%,70%); 101 | font-family: monospace } 102 | 103 | .doc .inlinecode .id { 104 | color: rgb(30%,30%,70%); 105 | } 106 | 107 | .inlinecodenm { 108 | display: inline; 109 | color: #444444; 110 | } 111 | 112 | .doc .code { 113 | display: inline; 114 | font-size: 120%; 115 | color: rgb(30%,30%,70%); 116 | font-family: monospace } 117 | 118 | .comment { 119 | display: inline; 120 | font-family: monospace; 121 | color: rgb(50%,50%,80%); 122 | } 123 | 124 | .code { 125 | display: block; 126 | /* padding-left: 15px; */ 127 | font-size: 110%; 128 | font-family: monospace; 129 | } 130 | 131 | table.infrule { 132 | border: 0px; 133 | margin-left: 50px; 134 | margin-top: 10px; 135 | margin-bottom: 10px; 136 | } 137 | 138 | td.infrule { 139 | font-family: monospace; 140 | text-align: center; 141 | /* color: rgb(35%,35%,70%); */ 142 | padding: 0px; 143 | line-height: 100%; 144 | } 145 | 146 | tr.infrulemiddle hr { 147 | margin: 1px 0 1px 0; 148 | } 149 | 150 | .infrulenamecol { 151 | color: rgb(60%,60%,60%); 152 | font-size: 80%; 153 | padding-left: 1em; 154 | padding-bottom: 0.1em 155 | } 156 | 157 | /* Pied de page */ 158 | 159 | #footer { font-size: 65%; 160 | font-family: sans-serif; } 161 | 162 | /* Identifiers: ) */ 163 | 164 | .id { display: inline; } 165 | 166 | .id[title="constructor"] { 167 | color: rgb(60%,0%,0%); 168 | } 169 | 170 | .id[title="var"] { 171 | color: rgb(40%,0%,40%); 172 | } 173 | 174 | .id[title="variable"] { 175 | color: rgb(40%,0%,40%); 176 | } 177 | 178 | .id[title="definition"] { 179 | color: rgb(0%,40%,0%); 180 | } 181 | 182 | .id[title="abbreviation"] { 183 | color: rgb(0%,40%,0%); 184 | } 185 | 186 | .id[title="lemma"] { 187 | color: rgb(0%,40%,0%); 188 | } 189 | 190 | .id[title="instance"] { 191 | color: rgb(0%,40%,0%); 192 | } 193 | 194 | .id[title="projection"] { 195 | color: rgb(0%,40%,0%); 196 | } 197 | 198 | .id[title="method"] { 199 | color: rgb(0%,40%,0%); 200 | } 201 | 202 | .id[title="inductive"] { 203 | color: rgb(0%,0%,80%); 204 | } 205 | 206 | .id[title="record"] { 207 | color: rgb(0%,0%,80%); 208 | } 209 | 210 | .id[title="class"] { 211 | color: rgb(0%,0%,80%); 212 | } 213 | 214 | .id[title="keyword"] { 215 | color : #cf1d1d; 216 | /* color: black; */ 217 | } 218 | 219 | /* Deprecated rules using the 'type' attribute of (not xhtml valid) */ 220 | 221 | .id[type="constructor"] { 222 | color: rgb(60%,0%,0%); 223 | } 224 | 225 | .id[type="var"] { 226 | color: rgb(40%,0%,40%); 227 | } 228 | 229 | .id[type="variable"] { 230 | color: rgb(40%,0%,40%); 231 | } 232 | 233 | .id[type="definition"] { 234 | color: rgb(0%,40%,0%); 235 | } 236 | 237 | .id[type="abbreviation"] { 238 | color: rgb(0%,40%,0%); 239 | } 240 | 241 | .id[type="lemma"] { 242 | color: rgb(0%,40%,0%); 243 | } 244 | 245 | .id[type="instance"] { 246 | color: rgb(0%,40%,0%); 247 | } 248 | 249 | .id[type="projection"] { 250 | color: rgb(0%,40%,0%); 251 | } 252 | 253 | .id[type="method"] { 254 | color: rgb(0%,40%,0%); 255 | } 256 | 257 | .id[type="inductive"] { 258 | color: rgb(0%,0%,80%); 259 | } 260 | 261 | .id[type="record"] { 262 | color: rgb(0%,0%,80%); 263 | } 264 | 265 | .id[type="class"] { 266 | color: rgb(0%,0%,80%); 267 | } 268 | 269 | .id[type="keyword"] { 270 | color : #cf1d1d; 271 | /* color: black; */ 272 | } 273 | 274 | .inlinecode .id { 275 | color: rgb(0%,0%,0%); 276 | } 277 | 278 | 279 | /* TOC */ 280 | 281 | #toc h2 { 282 | padding: 10px; 283 | background-color: rgb(60%,60%,100%); 284 | } 285 | 286 | #toc li { 287 | padding-bottom: 8px; 288 | } 289 | 290 | /* Index */ 291 | 292 | #index { 293 | margin: 0; 294 | padding: 0; 295 | width: 100%; 296 | } 297 | 298 | #index #frontispiece { 299 | margin: 1em auto; 300 | padding: 1em; 301 | width: 60%; 302 | } 303 | 304 | .booktitle { font-size : 140% } 305 | .authors { font-size : 90%; 306 | line-height: 115%; } 307 | .moreauthors { font-size : 60% } 308 | 309 | #index #entrance { 310 | text-align: center; 311 | } 312 | 313 | #index #entrance .spacer { 314 | margin: 0 30px 0 30px; 315 | } 316 | 317 | #index #footer { 318 | position: absolute; 319 | bottom: 0; 320 | } 321 | 322 | .paragraph { 323 | height: 0.75em; 324 | } 325 | 326 | ul.doclist { 327 | margin-top: 0em; 328 | margin-bottom: 0em; 329 | } 330 | -------------------------------------------------------------------------------- /MSetListWithDups.v: -------------------------------------------------------------------------------- 1 | (* 2 | * Efficiently Executable Sets Library 3 | * Author: FireEye, Inc. - Formal Methods Team 4 | * 5 | * Copyright (C) 2016 FireEye Technologie Deutschland GmbH 6 | * 7 | * This library is free software; you can redistribute it and/or 8 | * modify it under the terms of the GNU Lesser General Public 9 | * License as published by the Free Software Foundation; either 10 | * version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This library is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | * Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public 18 | * License along with this library. 19 | * If not, see . 20 | *) 21 | 22 | (** * Weak sets implemented as lists with duplicates 23 | 24 | This file contains an implementation of the weak set interface 25 | [WSetsOnWithDupsExtra]. As a datatype unsorted lists are used 26 | that might contain duplicates. 27 | 28 | This implementation is useful, if one needs very efficient 29 | insert and union operation, and can guarantee that one does not 30 | add too many duplicates. The operation [elements_dist] is implemented 31 | by sorting the list first. Therefore this instantiation can only 32 | be used if the element type is ordered. 33 | *) 34 | 35 | 36 | Require Export MSetInterface. 37 | Require Import ssreflect. 38 | Require Import List OrdersFacts OrdersLists. 39 | Require Import Sorting Permutation. 40 | Require Import MSetWithDups. 41 | 42 | 43 | 44 | 45 | (** ** Removing duplicates from sorted lists 46 | 47 | The following module [RemoveDupsFromSorted] defines an operation 48 | [remove_dups_from_sortedA] that removes duplicates from a sorted 49 | list. In order to talk about sorted lists, the element type needs 50 | to be ordered. 51 | 52 | This function is combined with a sort function to get a function 53 | [remove_dups_by_sortingA] to sort unsorted lists and then remove 54 | duplicates. *) 55 | Module RemoveDupsFromSorted (Import X:OrderedType). 56 | 57 | 58 | (** First, we need some infrastructure for our ordered type *) 59 | Module Import MX := OrderedTypeFacts X. 60 | 61 | Module Import XTotalLeBool <: TotalLeBool. 62 | Definition t := X.t. 63 | Definition leb x y := 64 | match X.compare x y with 65 | | Lt => true 66 | | Eq => true 67 | | Gt => false 68 | end. 69 | 70 | Infix "<=?" := leb (at level 35). 71 | 72 | Theorem leb_total : forall (a1 a2 : t), (a1 <=? a2 = true) \/ (a2 <=? a1 = true). 73 | Proof. 74 | intros a1 a2. 75 | unfold leb. 76 | rewrite (compare_antisym a1 a2). 77 | case (X.compare a1 a2); rewrite /=; tauto. 78 | Qed. 79 | 80 | Definition le x y := (leb x y = true). 81 | End XTotalLeBool. 82 | 83 | Lemma eqb_eq_alt : forall x y, eqb x y = true <-> eq x y. 84 | Proof. 85 | intros x y. 86 | rewrite eqb_alt -compare_eq_iff. 87 | case (compare x y) => //. 88 | Qed. 89 | 90 | 91 | 92 | (** Now we can define our main function *) 93 | Fixpoint remove_dups_from_sortedA_aux (acc : list t) (l : list t) : list t := 94 | match l with 95 | | nil => List.rev' acc 96 | | x :: xs => 97 | match xs with 98 | | nil => List.rev' (x :: acc) 99 | | y :: ys => 100 | if eqb x y then 101 | remove_dups_from_sortedA_aux acc xs 102 | else 103 | remove_dups_from_sortedA_aux (x::acc) xs 104 | end 105 | end. 106 | 107 | Definition remove_dups_from_sortedA := remove_dups_from_sortedA_aux (nil : list t). 108 | 109 | (** We can prove some technical lemmata *) 110 | Lemma remove_dups_from_sortedA_aux_alt : forall (l : list X.t) acc, 111 | remove_dups_from_sortedA_aux acc l = 112 | List.rev acc ++ (remove_dups_from_sortedA l). 113 | Proof. 114 | unfold remove_dups_from_sortedA. 115 | induction l as [| x xs IH] => acc. { 116 | rewrite /remove_dups_from_sortedA_aux /rev' -!rev_alt /= app_nil_r //. 117 | } { 118 | rewrite /=. 119 | case_eq xs. { 120 | rewrite /rev' -!rev_alt //. 121 | } { 122 | move => y ys H_xs_eq. 123 | rewrite -!H_xs_eq !(IH acc) !(IH (x :: acc)) (IH (x::nil)). 124 | case (eqb x y) => //. 125 | rewrite /= -app_assoc //. 126 | } 127 | } 128 | Qed. 129 | 130 | Lemma remove_dups_from_sortedA_alt : 131 | forall (l : list t), 132 | remove_dups_from_sortedA l = 133 | match l with 134 | | nil => nil 135 | | x :: xs => 136 | match xs with 137 | | nil => l 138 | | y :: ys => 139 | if eqb x y then 140 | remove_dups_from_sortedA xs 141 | else 142 | x :: remove_dups_from_sortedA xs 143 | end 144 | end. 145 | Proof. 146 | case. { 147 | done. 148 | } { 149 | intros x xs. 150 | rewrite /remove_dups_from_sortedA /= /rev' /=. 151 | case xs => //. 152 | move => y ys. 153 | rewrite !remove_dups_from_sortedA_aux_alt /= //. 154 | } 155 | Qed. 156 | 157 | Lemma remove_dups_from_sortedA_hd : 158 | forall x xs, 159 | exists (x':t) xs', 160 | remove_dups_from_sortedA (x :: xs) = 161 | (x' :: xs') /\ (eqb x x' = true). 162 | Proof. 163 | intros x xs. 164 | move : x; 165 | induction xs as [| y ys IH] => x. { 166 | rewrite remove_dups_from_sortedA_alt. 167 | exists x, nil. 168 | split; first reflexivity. 169 | rewrite eqb_alt compare_refl //. 170 | } { 171 | rewrite remove_dups_from_sortedA_alt. 172 | case_eq (eqb x y); last first. { 173 | move => _. 174 | exists x, (remove_dups_from_sortedA (y :: ys)). 175 | split; first reflexivity. 176 | rewrite eqb_alt compare_refl //. 177 | } { 178 | move => H_eqb_xy. 179 | move : (IH y) => {IH} [x'] [xs'] [->] H_eqb_yx'. 180 | exists x', xs'. 181 | split; first done. 182 | move : H_eqb_xy H_eqb_yx'. 183 | rewrite !eqb_eq_alt. 184 | apply MX.eq_trans. 185 | } 186 | } 187 | Qed. 188 | 189 | 190 | (** Finally we get our main result for removing duplicates from sorted lists *) 191 | Lemma remove_dups_from_sortedA_spec : 192 | forall (l : list t), 193 | Sorted le l -> 194 | let l' := remove_dups_from_sortedA l in ( 195 | 196 | Sorted lt l' /\ 197 | NoDupA eq l' /\ 198 | (forall x, InA eq x l <-> InA eq x l')). 199 | Proof. 200 | simpl. 201 | induction l as [| x xs IH]. { 202 | rewrite remove_dups_from_sortedA_alt. 203 | done. 204 | } { 205 | rewrite remove_dups_from_sortedA_alt. 206 | move : IH. 207 | case xs => {xs}. { 208 | move => _. 209 | split; last split. { 210 | apply Sorted_cons => //. 211 | } { 212 | apply NoDupA_singleton. 213 | } { 214 | done. 215 | } 216 | } { 217 | move => y ys IH H_sorted_x_y_ys. 218 | apply Sorted_inv in H_sorted_x_y_ys as [H_sorted_y_ys H_hd_rel]. 219 | apply HdRel_inv in H_hd_rel. 220 | 221 | have : exists y' ys', 222 | remove_dups_from_sortedA (y :: ys) = y' :: ys' /\ 223 | eqb y y' = true. { 224 | apply remove_dups_from_sortedA_hd => //. 225 | } 226 | move => [y'] [ys'] [H_yys'_intro] /eqb_eq_alt H_eq_y_y'. 227 | 228 | move : (IH H_sorted_y_ys). 229 | rewrite !H_yys'_intro. 230 | move => {IH} [IH1] [IH2] IH3. 231 | 232 | case_eq (eqb x y). { 233 | rewrite eqb_eq_alt => H_eq_x_y. 234 | split => //. 235 | split => //. 236 | move => x'. 237 | rewrite InA_cons IH3. 238 | split; last tauto. 239 | move => [] //. 240 | move => H_eq_x'_x. 241 | apply InA_cons_hd. 242 | apply eq_trans with (y := x) => //. 243 | apply eq_trans with (y := y) => //. 244 | } 245 | move => H_neqb_x_y. 246 | 247 | have H_sorted : Sorted lt (x :: y' :: ys'). { 248 | apply Sorted_cons => //. 249 | apply HdRel_cons. 250 | rewrite -compare_lt_iff. 251 | suff : (compare x y = Lt). { 252 | setoid_rewrite compare_compat; eauto; 253 | apply eq_refl. 254 | } 255 | move : H_hd_rel H_neqb_x_y. 256 | rewrite eqb_alt /le /leb. 257 | case (compare x y) => //. 258 | } 259 | split; last split. { 260 | assumption. 261 | } { 262 | apply NoDupA_cons => //. 263 | 264 | move => /InA_alt [x'] [H_eq_xx'] H_in_x'. 265 | have : Forall (lt x) (y' :: ys'). { 266 | apply Sorted_extends => //. 267 | rewrite /Relations_1.Transitive. 268 | by apply lt_trans. 269 | } 270 | rewrite Forall_forall => H_forall. 271 | move : (H_forall _ H_in_x') => {H_forall}. 272 | move : H_eq_xx'. 273 | rewrite -compare_lt_iff -compare_eq_iff. 274 | move => -> //. 275 | } { 276 | move => x0. 277 | rewrite !(InA_cons eq x0 x) IH3 //. 278 | } 279 | } 280 | } 281 | Qed. 282 | 283 | 284 | 285 | (** Next, we combine it with sorting *) 286 | Module Import XSort := Sort XTotalLeBool. 287 | 288 | Definition remove_dups_by_sortingA (l : list t) : list t := 289 | remove_dups_from_sortedA (XSort.sort l). 290 | 291 | Lemma remove_dups_by_sortingA_spec : 292 | forall (l : list t), 293 | let l' := remove_dups_by_sortingA l in ( 294 | 295 | Sorted lt l' /\ 296 | NoDupA eq l' /\ 297 | (forall x, InA eq x l <-> InA eq x l')). 298 | Proof. 299 | intro l. 300 | 301 | suff : (forall x : X.t, InA eq x (sort l) <-> InA eq x l) /\ 302 | Sorted le (sort l). { 303 | 304 | unfold remove_dups_by_sortingA. 305 | move : (remove_dups_from_sortedA_spec (sort l)). 306 | simpl. 307 | move => H_spec [H_in_sort H_sorted_sort]. 308 | move : (H_spec H_sorted_sort). 309 | move => [H1] [H2] H3. 310 | split => //. 311 | split => //. 312 | move => x. 313 | rewrite -H_in_sort H3 //. 314 | } 315 | 316 | split. { 317 | have H_in_sort : forall x, List.In x (XSort.sort l) <-> List.In x l. { 318 | intros x. 319 | have H_perm := (XSort.Permuted_sort l). 320 | split; apply Permutation_in => //. 321 | by apply Permutation_sym. 322 | } 323 | 324 | intros x. 325 | rewrite !InA_alt. 326 | setoid_rewrite H_in_sort => //. 327 | } { 328 | 329 | move : (LocallySorted_sort l). 330 | rewrite /is_true /le /leb //. 331 | } 332 | Qed. 333 | 334 | End RemoveDupsFromSorted. 335 | 336 | 337 | (** ** Operations Module 338 | 339 | With removing duplicates defined, we can implement 340 | the operations for our set implementation easily. 341 | *) 342 | 343 | Module Ops (X:OrderedType) <: WOps X. 344 | 345 | Module RDFS := RemoveDupsFromSorted X. 346 | Module Import MX := OrderedTypeFacts X. 347 | 348 | Definition elt := X.t. 349 | Definition t := list elt. 350 | 351 | Definition empty : t := nil. 352 | 353 | Definition is_empty (l : t) := match l with nil => true | _ => false end. 354 | Fixpoint mem (x : elt) (s : t) : bool := 355 | match s with 356 | | nil => false 357 | | y :: l => 358 | match X.compare x y with 359 | Eq => true 360 | | _ => mem x l 361 | end 362 | end. 363 | 364 | Definition add x (s : t) := x :: s. 365 | Definition singleton (x : elt) := x :: nil. 366 | 367 | Fixpoint rev_filter_aux acc (f : elt -> bool) s := 368 | match s with 369 | nil => acc 370 | | (x :: xs) => rev_filter_aux (if (f x) then (x :: acc) else acc) f xs 371 | end. 372 | Definition rev_filter := rev_filter_aux nil. 373 | 374 | Definition filter (f : elt -> bool) (s : t) : t := rev_filter f s. 375 | 376 | Definition remove x s := 377 | rev_filter (fun y => match X.compare x y with Eq => false | _ => true end) s. 378 | 379 | Definition union (s1 s2 : t) : t := 380 | List.rev_append s2 s1. 381 | 382 | Definition inter (s1 s2 : t) : t := 383 | rev_filter (fun y => mem y s2) s1. 384 | 385 | Definition elements (x : t) : list elt := x. 386 | 387 | Definition elements_dist (x : t) : list elt := 388 | RDFS.remove_dups_by_sortingA x. 389 | 390 | Definition fold {B : Type} (f : elt -> B -> B) (s : t) (i : B) : B := 391 | fold_left (flip f) (elements s) i. 392 | 393 | Definition diff (s s' : t) : t := fold remove s' s. 394 | 395 | Definition subset (s s' : t) : bool := 396 | List.forallb (fun x => mem x s') s. 397 | 398 | Definition equal (s s' : t) : bool := andb (subset s s') (subset s' s). 399 | 400 | Fixpoint for_all (f : elt -> bool) (s : t) : bool := 401 | match s with 402 | | nil => true 403 | | x :: l => if f x then for_all f l else false 404 | end. 405 | 406 | Fixpoint exists_ (f : elt -> bool) (s : t) : bool := 407 | match s with 408 | | nil => false 409 | | x :: l => if f x then true else exists_ f l 410 | end. 411 | 412 | Fixpoint partition_aux (a1 a2 : t) (f : elt -> bool) (s : t) : t * t := 413 | match s with 414 | | nil => (a1, a2) 415 | | x :: l => 416 | if f x then partition_aux (x :: a1) a2 f l else 417 | partition_aux a1 (x :: a2) f l 418 | end. 419 | 420 | Definition partition := partition_aux nil nil. 421 | 422 | Definition cardinal (s : t) : nat := length (elements_dist s). 423 | 424 | Definition choose (s : t) : option elt := 425 | match s with 426 | | nil => None 427 | | x::_ => Some x 428 | end. 429 | 430 | End Ops. 431 | 432 | 433 | (** ** Main Module 434 | 435 | Using these operations, we can define the main functor. For this, 436 | we need to prove that the provided operations do indeed satisfy 437 | the weak set interface. This is mostly straightforward and 438 | unsurprising. The only interesting part is that removing 439 | duplicates from a sorted list behaves as expected. This has 440 | however already been proved in module [RemoveDupsFromSorted]. 441 | *) 442 | Module Make (E:OrderedType) <: WSetsOnWithDupsExtra E. 443 | Include Ops E. 444 | Import MX. 445 | 446 | (** ** Proofs of set operation specifications. *) 447 | (** Logical predicates *) 448 | Definition In x (s : t) := SetoidList.InA E.eq x s. 449 | 450 | Instance In_compat : Proper (E.eq==>eq==>iff) In. 451 | Proof. repeat red. intros. rewrite H H0. auto. Qed. 452 | 453 | Definition Equal s s' := forall a : elt, In a s <-> In a s'. 454 | Definition Subset s s' := forall a : elt, In a s -> In a s'. 455 | Definition Empty s := forall a : elt, ~ In a s. 456 | Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. 457 | Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x. 458 | 459 | Notation "s [=] t" := (Equal s t) (at level 70, no associativity). 460 | Notation "s [<=] t" := (Subset s t) (at level 70, no associativity). 461 | 462 | Definition eq : t -> t -> Prop := Equal. 463 | Lemma eq_equiv : Equivalence eq. 464 | Proof. 465 | constructor. { 466 | done. 467 | } { 468 | by constructor; rewrite H. 469 | } { 470 | by constructor; rewrite H H0. 471 | } 472 | Qed. 473 | 474 | 475 | (** Specifications of set operators *) 476 | 477 | Notation compatb := (Proper (E.eq==>Logic.eq)) (only parsing). 478 | 479 | Lemma mem_spec : forall s x, mem x s = true <-> In x s. 480 | Proof. 481 | induction s as [| y s' IH]. { 482 | move => x. 483 | rewrite /= /In InA_nil. 484 | split => //. 485 | } { 486 | move => x. 487 | rewrite /= /In InA_cons. 488 | move : (MX.compare_eq_iff x y). 489 | case (E.compare x y). { 490 | tauto. 491 | } { 492 | rewrite IH; intuition; inversion H. 493 | } { 494 | rewrite IH; intuition; inversion H. 495 | } 496 | } 497 | Qed. 498 | 499 | Lemma subset_spec : forall s s', subset s s' = true <-> s[<=]s'. 500 | Proof. 501 | intros s s'. 502 | rewrite /subset forallb_forall /Subset /In. 503 | split. { 504 | move => H z /InA_alt [] x [H_z_eq] H_in. 505 | move : (H _ H_in). 506 | rewrite mem_spec. 507 | setoid_replace z with x => //. 508 | } { 509 | move => H z H_in. 510 | rewrite mem_spec. 511 | apply H, In_InA => //. 512 | apply E.eq_equiv. 513 | } 514 | Qed. 515 | 516 | Lemma equal_spec : forall s s', equal s s' = true <-> s[=]s'. 517 | Proof. 518 | intros s s'. 519 | rewrite /Equal /equal Bool.andb_true_iff !subset_spec /Subset. 520 | split. { 521 | move => [H1 H2] a. 522 | split. 523 | - by apply H1. 524 | - by apply H2. 525 | } { 526 | move => H. 527 | split; move => a; rewrite H //. 528 | } 529 | Qed. 530 | 531 | 532 | Lemma eq_dec : forall x y : t, {eq x y} + {~ eq x y}. 533 | Proof. 534 | intros x y. 535 | change ({Equal x y}+{~Equal x y}). 536 | destruct (equal x y) eqn:H; [left|right]; 537 | rewrite <- equal_spec; congruence. 538 | Qed. 539 | 540 | Lemma empty_spec : Empty empty. 541 | Proof. rewrite /Empty /empty /In. move => a /InA_nil //. Qed. 542 | 543 | Lemma is_empty_spec : forall s, is_empty s = true <-> Empty s. 544 | Proof. 545 | rewrite /is_empty /Empty /In. 546 | case; split => //. { 547 | move => _ a. 548 | rewrite InA_nil //. 549 | } { 550 | move => H; contradiction (H a). 551 | apply InA_cons_hd. 552 | apply Equivalence_Reflexive. 553 | } 554 | Qed. 555 | 556 | Lemma add_spec : forall s x y, In y (add x s) <-> E.eq y x \/ In y s. 557 | Proof. 558 | intros s x y. 559 | rewrite /add /In InA_cons //. 560 | Qed. 561 | 562 | Lemma singleton_spec : forall x y, In y (singleton x) <-> E.eq y x. 563 | Proof. 564 | intros x y. 565 | rewrite /singleton /In InA_cons. 566 | split. { 567 | move => [] // /InA_nil //. 568 | } { 569 | by left. 570 | } 571 | Qed. 572 | 573 | Hint Resolve (@Equivalence_Reflexive _ _ E.eq_equiv). 574 | Hint Immediate (@Equivalence_Symmetric _ _ E.eq_equiv). 575 | Hint Resolve (@Equivalence_Transitive _ _ E.eq_equiv). 576 | 577 | Lemma rev_filter_aux_spec : forall s acc x f, compatb f -> 578 | (In x (rev_filter_aux acc f s) <-> (In x s /\ f x = true) \/ (In x acc)). 579 | Proof. 580 | intros s acc x f H_compat. 581 | move : x acc. 582 | induction s as [| y s' IH]. { 583 | intros x acc. 584 | rewrite /rev_filter_aux /In InA_nil. 585 | tauto. 586 | } { 587 | intros x acc. 588 | rewrite /= IH /In. 589 | case_eq (f y) => H_fy; rewrite !InA_cons; intuition. { 590 | left. 591 | split; first by left. 592 | setoid_replace x with y => //. 593 | } { 594 | contradict H1. 595 | setoid_replace x with y => //. 596 | by rewrite H_fy. 597 | } 598 | } 599 | Qed. 600 | 601 | Lemma filter_spec : forall s x f, compatb f -> 602 | (In x (filter f s) <-> In x s /\ f x = true). 603 | Proof. 604 | intros s x f H_compat. 605 | rewrite /filter /rev_filter rev_filter_aux_spec /In InA_nil. 606 | tauto. 607 | Qed. 608 | 609 | Lemma remove_spec : forall s x y, In y (remove x s) <-> In y s /\ ~E.eq y x. 610 | Proof. 611 | intros s x y. 612 | rewrite /remove /rev_filter. 613 | have H_compat : compatb ((fun y0 : elt => 614 | match E.compare x y0 with 615 | | Eq => false 616 | | _ => true 617 | end)). { 618 | repeat red; intros. 619 | setoid_replace x0 with y0 => //. 620 | } 621 | rewrite rev_filter_aux_spec /In InA_nil. 622 | have -> : (E.eq y x <-> E.eq x y). { 623 | split; move => ?; by apply Equivalence_Symmetric. 624 | } 625 | rewrite -compare_eq_iff. 626 | case (E.compare x y). { 627 | intuition. 628 | } { 629 | intuition. 630 | inversion H0. 631 | } { 632 | intuition. 633 | inversion H0. 634 | } 635 | Qed. 636 | 637 | 638 | Lemma union_spec : forall s s' x, In x (union s s') <-> In x s \/ In x s'. 639 | Proof. 640 | intros s s' x. 641 | rewrite /union /In rev_append_rev InA_app_iff InA_rev; tauto. 642 | Qed. 643 | 644 | Lemma inter_spec : forall s s' x, In x (inter s s') <-> In x s /\ In x s'. 645 | Proof. 646 | intros s s' x. 647 | have H_compat : compatb (fun y : elt => mem y s'). { 648 | repeat red; intros. 649 | suff : ( mem x0 s' = true <-> mem y s' = true). { 650 | case (mem y s'), (mem x0 s'); intuition. 651 | } 652 | rewrite !mem_spec /In. 653 | setoid_replace x0 with y => //. 654 | } 655 | rewrite /inter rev_filter_aux_spec mem_spec /In InA_nil. 656 | tauto. 657 | Qed. 658 | 659 | 660 | 661 | Lemma fold_spec : forall s (A : Type) (i : A) (f : elt -> A -> A), 662 | fold f s i = fold_left (flip f) (elements s) i. 663 | Proof. done. Qed. 664 | 665 | Lemma elements_spec1 : forall s x, InA E.eq x (elements s) <-> In x s. 666 | Proof. 667 | intros s x. 668 | rewrite /elements /In //. 669 | Qed. 670 | 671 | Lemma diff_spec : forall s s' x, In x (diff s s') <-> In x s /\ ~In x s'. 672 | Proof. 673 | intros s s' x. 674 | rewrite /diff fold_spec -(elements_spec1 s'). 675 | move : s. 676 | induction (elements s') as [| y ys IH] => s. { 677 | rewrite InA_nil /=; tauto. 678 | } { 679 | rewrite /= IH InA_cons /flip remove_spec. 680 | tauto. 681 | } 682 | Qed. 683 | 684 | Lemma cardinal_spec : forall s, cardinal s = length (elements_dist s). 685 | Proof. rewrite /cardinal //. Qed. 686 | 687 | Lemma for_all_spec : forall s f, compatb f -> 688 | (for_all f s = true <-> For_all (fun x => f x = true) s). 689 | Proof. 690 | intros s f H_compat. 691 | rewrite /For_all. 692 | induction s as [| x xs IH]. { 693 | rewrite /= /In. 694 | split => //. 695 | move => _ x /InA_nil //. 696 | } { 697 | rewrite /=. 698 | case_eq (f x) => H_fx. { 699 | rewrite IH. 700 | split. { 701 | move => H x' /InA_cons []. { 702 | move => -> //. 703 | } { 704 | apply H. 705 | } 706 | } { 707 | move => H x' H_in. 708 | apply H. 709 | apply InA_cons. 710 | by right. 711 | } 712 | } { 713 | split => //. 714 | move => H. 715 | suff : f x = true. { 716 | rewrite H_fx //. 717 | } 718 | apply H. 719 | apply InA_cons_hd. 720 | done. 721 | } 722 | } 723 | Qed. 724 | 725 | Lemma exists_spec : forall s f, compatb f -> 726 | (exists_ f s = true <-> Exists (fun x => f x = true) s). 727 | Proof. 728 | intros s f H_compat. 729 | rewrite /Exists. 730 | induction s as [| x xs IH]. { 731 | rewrite /= /In. 732 | split => //. 733 | move => [x] [] /InA_nil //. 734 | } { 735 | rewrite /=. 736 | case_eq (f x) => H_fx. { 737 | split => // _. 738 | exists x. 739 | split => //. 740 | apply InA_cons_hd. 741 | done. 742 | } { 743 | rewrite IH. 744 | split. { 745 | move => [x'] [H_in] H_fx'. 746 | exists x'. 747 | split => //. 748 | apply InA_cons. 749 | by right. 750 | } { 751 | move => [x'] [] /InA_cons []. { 752 | move => ->. 753 | rewrite H_fx //. 754 | } { 755 | by exists x'. 756 | } 757 | } 758 | } 759 | } 760 | Qed. 761 | 762 | Lemma partition_aux_spec : forall a1 a2 s f, 763 | (partition_aux a1 a2 f s = (rev_filter_aux a1 f s, rev_filter_aux a2 (fun x => negb (f x)) s)). 764 | Proof. 765 | move => a1 a2 s f. 766 | move : a1 a2. 767 | induction s as [| x xs IH]. { 768 | rewrite /partition_aux /rev_filter_aux //. 769 | } { 770 | intros a1 a2. 771 | rewrite /= IH. 772 | case (f x) => //. 773 | 774 | } 775 | Qed. 776 | 777 | Lemma partition_spec1 : forall s f, compatb f -> 778 | fst (partition f s) [=] filter f s. 779 | Proof. 780 | move => s f _. 781 | rewrite /partition partition_aux_spec /fst /filter /rev_filter //. 782 | Qed. 783 | 784 | Lemma partition_spec2 : forall s f, compatb f -> 785 | snd (partition f s) [=] filter (fun x => negb (f x)) s. 786 | Proof. 787 | move => s f _. 788 | rewrite /partition partition_aux_spec /snd /filter /rev_filter //. 789 | Qed. 790 | 791 | Lemma choose_spec1 : forall s x, choose s = Some x -> In x s. 792 | Proof. 793 | move => [] // y s' x [->]. 794 | rewrite /In. 795 | apply InA_cons_hd. 796 | apply Equivalence_Reflexive. 797 | Qed. 798 | 799 | Lemma choose_spec2 : forall s, choose s = None -> Empty s. 800 | Proof. move => [] // _ a. rewrite /In InA_nil //. Qed. 801 | 802 | Lemma elements_dist_spec_full : 803 | forall s, 804 | Sorted E.lt (elements_dist s) /\ 805 | NoDupA E.eq (elements_dist s) /\ 806 | (forall x, InA E.eq x (elements_dist s) <-> InA E.eq x (elements s)). 807 | Proof. 808 | move => s. 809 | rewrite /elements_dist /elements. 810 | move : (RDFS.remove_dups_by_sortingA_spec s). 811 | simpl. 812 | firstorder. 813 | Qed. 814 | 815 | Lemma elements_dist_spec1 : forall x s, InA E.eq x (elements_dist s) <-> 816 | InA E.eq x (elements s). 817 | Proof. intros; apply elements_dist_spec_full. Qed. 818 | 819 | Lemma elements_dist_spec2w : forall s, NoDupA E.eq (elements_dist s). 820 | Proof. intros; apply elements_dist_spec_full. Qed. 821 | 822 | End Make. 823 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 2.1, February 1999 3 | 4 | Copyright (C) 1991, 1999 Free Software Foundation, Inc. 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | [This is the first released version of the Lesser GPL. It also counts 10 | as the successor of the GNU Library Public License, version 2, hence 11 | the version number 2.1.] 12 | 13 | Preamble 14 | 15 | The licenses for most software are designed to take away your 16 | freedom to share and change it. By contrast, the GNU General Public 17 | Licenses are intended to guarantee your freedom to share and change 18 | free software--to make sure the software is free for all its users. 19 | 20 | This license, the Lesser General Public License, applies to some 21 | specially designated software packages--typically libraries--of the 22 | Free Software Foundation and other authors who decide to use it. You 23 | can use it too, but we suggest you first think carefully about whether 24 | this license or the ordinary General Public License is the better 25 | strategy to use in any particular case, based on the explanations below. 26 | 27 | When we speak of free software, we are referring to freedom of use, 28 | not price. Our General Public Licenses are designed to make sure that 29 | you have the freedom to distribute copies of free software (and charge 30 | for this service if you wish); that you receive source code or can get 31 | it if you want it; that you can change the software and use pieces of 32 | it in new free programs; and that you are informed that you can do 33 | these things. 34 | 35 | To protect your rights, we need to make restrictions that forbid 36 | distributors to deny you these rights or to ask you to surrender these 37 | rights. These restrictions translate to certain responsibilities for 38 | you if you distribute copies of the library or if you modify it. 39 | 40 | For example, if you distribute copies of the library, whether gratis 41 | or for a fee, you must give the recipients all the rights that we gave 42 | you. You must make sure that they, too, receive or can get the source 43 | code. If you link other code with the library, you must provide 44 | complete object files to the recipients, so that they can relink them 45 | with the library after making changes to the library and recompiling 46 | it. And you must show them these terms so they know their rights. 47 | 48 | We protect your rights with a two-step method: (1) we copyright the 49 | library, and (2) we offer you this license, which gives you legal 50 | permission to copy, distribute and/or modify the library. 51 | 52 | To protect each distributor, we want to make it very clear that 53 | there is no warranty for the free library. Also, if the library is 54 | modified by someone else and passed on, the recipients should know 55 | that what they have is not the original version, so that the original 56 | author's reputation will not be affected by problems that might be 57 | introduced by others. 58 | 59 | Finally, software patents pose a constant threat to the existence of 60 | any free program. We wish to make sure that a company cannot 61 | effectively restrict the users of a free program by obtaining a 62 | restrictive license from a patent holder. Therefore, we insist that 63 | any patent license obtained for a version of the library must be 64 | consistent with the full freedom of use specified in this license. 65 | 66 | Most GNU software, including some libraries, is covered by the 67 | ordinary GNU General Public License. This license, the GNU Lesser 68 | General Public License, applies to certain designated libraries, and 69 | is quite different from the ordinary General Public License. We use 70 | this license for certain libraries in order to permit linking those 71 | libraries into non-free programs. 72 | 73 | When a program is linked with a library, whether statically or using 74 | a shared library, the combination of the two is legally speaking a 75 | combined work, a derivative of the original library. The ordinary 76 | General Public License therefore permits such linking only if the 77 | entire combination fits its criteria of freedom. The Lesser General 78 | Public License permits more lax criteria for linking other code with 79 | the library. 80 | 81 | We call this license the "Lesser" General Public License because it 82 | does Less to protect the user's freedom than the ordinary General 83 | Public License. It also provides other free software developers Less 84 | of an advantage over competing non-free programs. These disadvantages 85 | are the reason we use the ordinary General Public License for many 86 | libraries. However, the Lesser license provides advantages in certain 87 | special circumstances. 88 | 89 | For example, on rare occasions, there may be a special need to 90 | encourage the widest possible use of a certain library, so that it becomes 91 | a de-facto standard. To achieve this, non-free programs must be 92 | allowed to use the library. A more frequent case is that a free 93 | library does the same job as widely used non-free libraries. In this 94 | case, there is little to gain by limiting the free library to free 95 | software only, so we use the Lesser General Public License. 96 | 97 | In other cases, permission to use a particular library in non-free 98 | programs enables a greater number of people to use a large body of 99 | free software. For example, permission to use the GNU C Library in 100 | non-free programs enables many more people to use the whole GNU 101 | operating system, as well as its variant, the GNU/Linux operating 102 | system. 103 | 104 | Although the Lesser General Public License is Less protective of the 105 | users' freedom, it does ensure that the user of a program that is 106 | linked with the Library has the freedom and the wherewithal to run 107 | that program using a modified version of the Library. 108 | 109 | The precise terms and conditions for copying, distribution and 110 | modification follow. Pay close attention to the difference between a 111 | "work based on the library" and a "work that uses the library". The 112 | former contains code derived from the library, whereas the latter must 113 | be combined with the library in order to run. 114 | 115 | GNU LESSER GENERAL PUBLIC LICENSE 116 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 117 | 118 | 0. This License Agreement applies to any software library or other 119 | program which contains a notice placed by the copyright holder or 120 | other authorized party saying it may be distributed under the terms of 121 | this Lesser General Public License (also called "this License"). 122 | Each licensee is addressed as "you". 123 | 124 | A "library" means a collection of software functions and/or data 125 | prepared so as to be conveniently linked with application programs 126 | (which use some of those functions and data) to form executables. 127 | 128 | The "Library", below, refers to any such software library or work 129 | which has been distributed under these terms. A "work based on the 130 | Library" means either the Library or any derivative work under 131 | copyright law: that is to say, a work containing the Library or a 132 | portion of it, either verbatim or with modifications and/or translated 133 | straightforwardly into another language. (Hereinafter, translation is 134 | included without limitation in the term "modification".) 135 | 136 | "Source code" for a work means the preferred form of the work for 137 | making modifications to it. For a library, complete source code means 138 | all the source code for all modules it contains, plus any associated 139 | interface definition files, plus the scripts used to control compilation 140 | and installation of the library. 141 | 142 | Activities other than copying, distribution and modification are not 143 | covered by this License; they are outside its scope. The act of 144 | running a program using the Library is not restricted, and output from 145 | such a program is covered only if its contents constitute a work based 146 | on the Library (independent of the use of the Library in a tool for 147 | writing it). Whether that is true depends on what the Library does 148 | and what the program that uses the Library does. 149 | 150 | 1. You may copy and distribute verbatim copies of the Library's 151 | complete source code as you receive it, in any medium, provided that 152 | you conspicuously and appropriately publish on each copy an 153 | appropriate copyright notice and disclaimer of warranty; keep intact 154 | all the notices that refer to this License and to the absence of any 155 | warranty; and distribute a copy of this License along with the 156 | Library. 157 | 158 | You may charge a fee for the physical act of transferring a copy, 159 | and you may at your option offer warranty protection in exchange for a 160 | fee. 161 | 162 | 2. You may modify your copy or copies of the Library or any portion 163 | of it, thus forming a work based on the Library, and copy and 164 | distribute such modifications or work under the terms of Section 1 165 | above, provided that you also meet all of these conditions: 166 | 167 | a) The modified work must itself be a software library. 168 | 169 | b) You must cause the files modified to carry prominent notices 170 | stating that you changed the files and the date of any change. 171 | 172 | c) You must cause the whole of the work to be licensed at no 173 | charge to all third parties under the terms of this License. 174 | 175 | d) If a facility in the modified Library refers to a function or a 176 | table of data to be supplied by an application program that uses 177 | the facility, other than as an argument passed when the facility 178 | is invoked, then you must make a good faith effort to ensure that, 179 | in the event an application does not supply such function or 180 | table, the facility still operates, and performs whatever part of 181 | its purpose remains meaningful. 182 | 183 | (For example, a function in a library to compute square roots has 184 | a purpose that is entirely well-defined independent of the 185 | application. Therefore, Subsection 2d requires that any 186 | application-supplied function or table used by this function must 187 | be optional: if the application does not supply it, the square 188 | root function must still compute square roots.) 189 | 190 | These requirements apply to the modified work as a whole. If 191 | identifiable sections of that work are not derived from the Library, 192 | and can be reasonably considered independent and separate works in 193 | themselves, then this License, and its terms, do not apply to those 194 | sections when you distribute them as separate works. But when you 195 | distribute the same sections as part of a whole which is a work based 196 | on the Library, the distribution of the whole must be on the terms of 197 | this License, whose permissions for other licensees extend to the 198 | entire whole, and thus to each and every part regardless of who wrote 199 | it. 200 | 201 | Thus, it is not the intent of this section to claim rights or contest 202 | your rights to work written entirely by you; rather, the intent is to 203 | exercise the right to control the distribution of derivative or 204 | collective works based on the Library. 205 | 206 | In addition, mere aggregation of another work not based on the Library 207 | with the Library (or with a work based on the Library) on a volume of 208 | a storage or distribution medium does not bring the other work under 209 | the scope of this License. 210 | 211 | 3. You may opt to apply the terms of the ordinary GNU General Public 212 | License instead of this License to a given copy of the Library. To do 213 | this, you must alter all the notices that refer to this License, so 214 | that they refer to the ordinary GNU General Public License, version 2, 215 | instead of to this License. (If a newer version than version 2 of the 216 | ordinary GNU General Public License has appeared, then you can specify 217 | that version instead if you wish.) Do not make any other change in 218 | these notices. 219 | 220 | Once this change is made in a given copy, it is irreversible for 221 | that copy, so the ordinary GNU General Public License applies to all 222 | subsequent copies and derivative works made from that copy. 223 | 224 | This option is useful when you wish to copy part of the code of 225 | the Library into a program that is not a library. 226 | 227 | 4. You may copy and distribute the Library (or a portion or 228 | derivative of it, under Section 2) in object code or executable form 229 | under the terms of Sections 1 and 2 above provided that you accompany 230 | it with the complete corresponding machine-readable source code, which 231 | must be distributed under the terms of Sections 1 and 2 above on a 232 | medium customarily used for software interchange. 233 | 234 | If distribution of object code is made by offering access to copy 235 | from a designated place, then offering equivalent access to copy the 236 | source code from the same place satisfies the requirement to 237 | distribute the source code, even though third parties are not 238 | compelled to copy the source along with the object code. 239 | 240 | 5. A program that contains no derivative of any portion of the 241 | Library, but is designed to work with the Library by being compiled or 242 | linked with it, is called a "work that uses the Library". Such a 243 | work, in isolation, is not a derivative work of the Library, and 244 | therefore falls outside the scope of this License. 245 | 246 | However, linking a "work that uses the Library" with the Library 247 | creates an executable that is a derivative of the Library (because it 248 | contains portions of the Library), rather than a "work that uses the 249 | library". The executable is therefore covered by this License. 250 | Section 6 states terms for distribution of such executables. 251 | 252 | When a "work that uses the Library" uses material from a header file 253 | that is part of the Library, the object code for the work may be a 254 | derivative work of the Library even though the source code is not. 255 | Whether this is true is especially significant if the work can be 256 | linked without the Library, or if the work is itself a library. The 257 | threshold for this to be true is not precisely defined by law. 258 | 259 | If such an object file uses only numerical parameters, data 260 | structure layouts and accessors, and small macros and small inline 261 | functions (ten lines or less in length), then the use of the object 262 | file is unrestricted, regardless of whether it is legally a derivative 263 | work. (Executables containing this object code plus portions of the 264 | Library will still fall under Section 6.) 265 | 266 | Otherwise, if the work is a derivative of the Library, you may 267 | distribute the object code for the work under the terms of Section 6. 268 | Any executables containing that work also fall under Section 6, 269 | whether or not they are linked directly with the Library itself. 270 | 271 | 6. As an exception to the Sections above, you may also combine or 272 | link a "work that uses the Library" with the Library to produce a 273 | work containing portions of the Library, and distribute that work 274 | under terms of your choice, provided that the terms permit 275 | modification of the work for the customer's own use and reverse 276 | engineering for debugging such modifications. 277 | 278 | You must give prominent notice with each copy of the work that the 279 | Library is used in it and that the Library and its use are covered by 280 | this License. You must supply a copy of this License. If the work 281 | during execution displays copyright notices, you must include the 282 | copyright notice for the Library among them, as well as a reference 283 | directing the user to the copy of this License. Also, you must do one 284 | of these things: 285 | 286 | a) Accompany the work with the complete corresponding 287 | machine-readable source code for the Library including whatever 288 | changes were used in the work (which must be distributed under 289 | Sections 1 and 2 above); and, if the work is an executable linked 290 | with the Library, with the complete machine-readable "work that 291 | uses the Library", as object code and/or source code, so that the 292 | user can modify the Library and then relink to produce a modified 293 | executable containing the modified Library. (It is understood 294 | that the user who changes the contents of definitions files in the 295 | Library will not necessarily be able to recompile the application 296 | to use the modified definitions.) 297 | 298 | b) Use a suitable shared library mechanism for linking with the 299 | Library. A suitable mechanism is one that (1) uses at run time a 300 | copy of the library already present on the user's computer system, 301 | rather than copying library functions into the executable, and (2) 302 | will operate properly with a modified version of the library, if 303 | the user installs one, as long as the modified version is 304 | interface-compatible with the version that the work was made with. 305 | 306 | c) Accompany the work with a written offer, valid for at 307 | least three years, to give the same user the materials 308 | specified in Subsection 6a, above, for a charge no more 309 | than the cost of performing this distribution. 310 | 311 | d) If distribution of the work is made by offering access to copy 312 | from a designated place, offer equivalent access to copy the above 313 | specified materials from the same place. 314 | 315 | e) Verify that the user has already received a copy of these 316 | materials or that you have already sent this user a copy. 317 | 318 | For an executable, the required form of the "work that uses the 319 | Library" must include any data and utility programs needed for 320 | reproducing the executable from it. However, as a special exception, 321 | the materials to be distributed need not include anything that is 322 | normally distributed (in either source or binary form) with the major 323 | components (compiler, kernel, and so on) of the operating system on 324 | which the executable runs, unless that component itself accompanies 325 | the executable. 326 | 327 | It may happen that this requirement contradicts the license 328 | restrictions of other proprietary libraries that do not normally 329 | accompany the operating system. Such a contradiction means you cannot 330 | use both them and the Library together in an executable that you 331 | distribute. 332 | 333 | 7. You may place library facilities that are a work based on the 334 | Library side-by-side in a single library together with other library 335 | facilities not covered by this License, and distribute such a combined 336 | library, provided that the separate distribution of the work based on 337 | the Library and of the other library facilities is otherwise 338 | permitted, and provided that you do these two things: 339 | 340 | a) Accompany the combined library with a copy of the same work 341 | based on the Library, uncombined with any other library 342 | facilities. This must be distributed under the terms of the 343 | Sections above. 344 | 345 | b) Give prominent notice with the combined library of the fact 346 | that part of it is a work based on the Library, and explaining 347 | where to find the accompanying uncombined form of the same work. 348 | 349 | 8. You may not copy, modify, sublicense, link with, or distribute 350 | the Library except as expressly provided under this License. Any 351 | attempt otherwise to copy, modify, sublicense, link with, or 352 | distribute the Library is void, and will automatically terminate your 353 | rights under this License. However, parties who have received copies, 354 | or rights, from you under this License will not have their licenses 355 | terminated so long as such parties remain in full compliance. 356 | 357 | 9. You are not required to accept this License, since you have not 358 | signed it. However, nothing else grants you permission to modify or 359 | distribute the Library or its derivative works. These actions are 360 | prohibited by law if you do not accept this License. Therefore, by 361 | modifying or distributing the Library (or any work based on the 362 | Library), you indicate your acceptance of this License to do so, and 363 | all its terms and conditions for copying, distributing or modifying 364 | the Library or works based on it. 365 | 366 | 10. Each time you redistribute the Library (or any work based on the 367 | Library), the recipient automatically receives a license from the 368 | original licensor to copy, distribute, link with or modify the Library 369 | subject to these terms and conditions. You may not impose any further 370 | restrictions on the recipients' exercise of the rights granted herein. 371 | You are not responsible for enforcing compliance by third parties with 372 | this License. 373 | 374 | 11. If, as a consequence of a court judgment or allegation of patent 375 | infringement or for any other reason (not limited to patent issues), 376 | conditions are imposed on you (whether by court order, agreement or 377 | otherwise) that contradict the conditions of this License, they do not 378 | excuse you from the conditions of this License. If you cannot 379 | distribute so as to satisfy simultaneously your obligations under this 380 | License and any other pertinent obligations, then as a consequence you 381 | may not distribute the Library at all. For example, if a patent 382 | license would not permit royalty-free redistribution of the Library by 383 | all those who receive copies directly or indirectly through you, then 384 | the only way you could satisfy both it and this License would be to 385 | refrain entirely from distribution of the Library. 386 | 387 | If any portion of this section is held invalid or unenforceable under any 388 | particular circumstance, the balance of the section is intended to apply, 389 | and the section as a whole is intended to apply in other circumstances. 390 | 391 | It is not the purpose of this section to induce you to infringe any 392 | patents or other property right claims or to contest validity of any 393 | such claims; this section has the sole purpose of protecting the 394 | integrity of the free software distribution system which is 395 | implemented by public license practices. Many people have made 396 | generous contributions to the wide range of software distributed 397 | through that system in reliance on consistent application of that 398 | system; it is up to the author/donor to decide if he or she is willing 399 | to distribute software through any other system and a licensee cannot 400 | impose that choice. 401 | 402 | This section is intended to make thoroughly clear what is believed to 403 | be a consequence of the rest of this License. 404 | 405 | 12. If the distribution and/or use of the Library is restricted in 406 | certain countries either by patents or by copyrighted interfaces, the 407 | original copyright holder who places the Library under this License may add 408 | an explicit geographical distribution limitation excluding those countries, 409 | so that distribution is permitted only in or among countries not thus 410 | excluded. In such case, this License incorporates the limitation as if 411 | written in the body of this License. 412 | 413 | 13. The Free Software Foundation may publish revised and/or new 414 | versions of the Lesser General Public License from time to time. 415 | Such new versions will be similar in spirit to the present version, 416 | but may differ in detail to address new problems or concerns. 417 | 418 | Each version is given a distinguishing version number. If the Library 419 | specifies a version number of this License which applies to it and 420 | "any later version", you have the option of following the terms and 421 | conditions either of that version or of any later version published by 422 | the Free Software Foundation. If the Library does not specify a 423 | license version number, you may choose any version ever published by 424 | the Free Software Foundation. 425 | 426 | 14. If you wish to incorporate parts of the Library into other free 427 | programs whose distribution conditions are incompatible with these, 428 | write to the author to ask for permission. For software which is 429 | copyrighted by the Free Software Foundation, write to the Free 430 | Software Foundation; we sometimes make exceptions for this. Our 431 | decision will be guided by the two goals of preserving the free status 432 | of all derivatives of our free software and of promoting the sharing 433 | and reuse of software generally. 434 | 435 | NO WARRANTY 436 | 437 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO 438 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 439 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR 440 | OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY 441 | KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE 442 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 443 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 444 | LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME 445 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 446 | 447 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN 448 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY 449 | AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU 450 | FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR 451 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 452 | LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 453 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 454 | FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 455 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 456 | DAMAGES. 457 | 458 | END OF TERMS AND CONDITIONS 459 | 460 | How to Apply These Terms to Your New Libraries 461 | 462 | If you develop a new library, and you want it to be of the greatest 463 | possible use to the public, we recommend making it free software that 464 | everyone can redistribute and change. You can do so by permitting 465 | redistribution under these terms (or, alternatively, under the terms of the 466 | ordinary General Public License). 467 | 468 | To apply these terms, attach the following notices to the library. It is 469 | safest to attach them to the start of each source file to most effectively 470 | convey the exclusion of warranty; and each file should have at least the 471 | "copyright" line and a pointer to where the full notice is found. 472 | 473 | 474 | Copyright (C) 475 | 476 | This library is free software; you can redistribute it and/or 477 | modify it under the terms of the GNU Lesser General Public 478 | License as published by the Free Software Foundation; either 479 | version 2.1 of the License, or (at your option) any later version. 480 | 481 | This library is distributed in the hope that it will be useful, 482 | but WITHOUT ANY WARRANTY; without even the implied warranty of 483 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 484 | Lesser General Public License for more details. 485 | 486 | You should have received a copy of the GNU Lesser General Public 487 | License along with this library; if not, write to the Free Software 488 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 489 | 490 | Also add information on how to contact you by electronic and paper mail. 491 | 492 | You should also get your employer (if you work as a programmer) or your 493 | school, if any, to sign a "copyright disclaimer" for the library, if 494 | necessary. Here is a sample; alter the names: 495 | 496 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 497 | library `Frob' (a library for tweaking knobs) written by James Random Hacker. 498 | 499 | , 1 April 1990 500 | Ty Coon, President of Vice 501 | 502 | That's all there is to it! 503 | -------------------------------------------------------------------------------- /MSetFoldWithAbort.v: -------------------------------------------------------------------------------- 1 | (* 2 | * Efficiently Executable Sets Library 3 | * Author: FireEye, Inc. - Formal Methods Team 4 | * 5 | * Copyright (C) 2016 FireEye Technologie Deutschland GmbH 6 | * 7 | * This library is free software; you can redistribute it and/or 8 | * modify it under the terms of the GNU Lesser General Public 9 | * License as published by the Free Software Foundation; either 10 | * version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This library is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | * Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public 18 | * License along with this library. 19 | * If not, see . 20 | *) 21 | 22 | (** * Fold with abort for sets 23 | 24 | This file provided an efficient fold operation for set interfaces. 25 | The standard fold iterates over all elements of the set. The 26 | efficient one - called [foldWithAbort] - is allowed to skip 27 | certain elements and thereby abort early. 28 | *) 29 | 30 | 31 | Require Export MSetInterface. 32 | Require Import ssreflect. 33 | Require Import MSetWithDups. 34 | Require Import Int. 35 | Require Import MSetGenTree MSetAVL MSetRBT. 36 | Require Import MSetList MSetWeakList. 37 | 38 | 39 | (** ** Fold With Abort Operations 40 | 41 | We want to provide an efficient folding operation. Efficieny is 42 | gained by aborting the folding early, if we know that continuing 43 | would not have an effect any more. Formalising this leads to the following 44 | specification of [foldWithAbort]. *) 45 | 46 | 47 | Definition foldWithAbortType 48 | elt (** element type of set *) 49 | t (** type of set *) 50 | A (** return type *) := 51 | (elt -> A -> A) -> (** f *) 52 | (elt -> A -> bool) -> (** f_abort *) 53 | t -> (** input set *) 54 | A -> (** base value *) 55 | A. 56 | 57 | 58 | Definition foldWithAbortSpecPred {elt t : Type} 59 | (In : elt -> t -> Prop) 60 | (fold : forall {A : Type}, (elt -> A -> A) -> t -> A -> A) 61 | (foldWithAbort : forall {A : Type}, foldWithAbortType elt t A) : Prop := 62 | 63 | forall 64 | (A : Type) 65 | (** result type *) 66 | 67 | (i i' : A) 68 | (** base values for foldWithAbort and fold *) 69 | 70 | (f : elt -> A -> A) (f' : elt -> A -> A) 71 | (** fold functions for foldWithAbort and fold *) 72 | 73 | (f_abort : elt -> A -> bool) 74 | (** abort function *) 75 | 76 | (s : t) (** sets to fold over *) 77 | 78 | (P : A -> A -> Prop) (** equivalence relation on results *), 79 | 80 | (** [P] is an equivalence relation *) 81 | Equivalence P -> 82 | 83 | (** [f] is for the elements of [s] compatible with the equivalence relation P *) 84 | (forall st st' e, In e s -> P st st' -> P (f e st) (f e st')) -> 85 | 86 | (** [f] and [f'] agree for the elements of [s] *) 87 | (forall e st, In e s -> (P (f e st) (f' e st))) -> 88 | 89 | (** [f_abort] is OK, i.e. all other elements can be skipped without 90 | leaving the equivalence relation. *) 91 | (forall e1 st, 92 | In e1 s -> f_abort e1 st = true -> 93 | (forall st' e2, P st st' -> 94 | In e2 s -> e2 <> e1 -> 95 | P st (f e2 st'))) -> 96 | 97 | (** The base values are in equivalence relation *) 98 | P i i' -> 99 | 100 | (** The results are in equivalence relation *) 101 | P (foldWithAbort f f_abort s i) (fold f' s i'). 102 | 103 | 104 | (** The specification of folding for ordered sets (as represented by 105 | interface [Sets]) demands that elements are visited in increasing 106 | order. For ordered sets we can therefore abort folding based on 107 | the weaker knowledge that greater elements have no effect on the 108 | result. The following definition captures this. *) 109 | 110 | Definition foldWithAbortGtType 111 | elt (** element type of set *) 112 | t (** type of set *) 113 | A (** return type *) := 114 | (elt -> A -> A) -> (** f *) 115 | (elt -> A -> bool) -> (** f_gt *) 116 | t -> (** input set *) 117 | A -> (** base value *) 118 | A. 119 | 120 | 121 | Definition foldWithAbortGtSpecPred {elt t : Type} 122 | (lt : elt -> elt -> Prop) 123 | (In : elt -> t -> Prop) 124 | (fold : forall {A : Type}, (elt -> A -> A) -> t -> A -> A) 125 | (foldWithAbortGt : forall {A : Type}, foldWithAbortType elt t A) : Prop := 126 | 127 | forall 128 | (A : Type) 129 | (** result type *) 130 | 131 | (i i' : A) 132 | (** base values for foldWithAbort and fold *) 133 | 134 | (f : elt -> A -> A) (f' : elt -> A -> A) 135 | (** fold functions for foldWithAbort and fold *) 136 | 137 | (f_gt : elt -> A -> bool) 138 | (** abort function *) 139 | 140 | (s : t) (** sets to fold over *) 141 | 142 | (P : A -> A -> Prop) (** equivalence relation on results *), 143 | 144 | 145 | (** [P] is an equivalence relation *) 146 | Equivalence P -> 147 | 148 | (** [f] is for the elements of [s] compatible with the equivalence relation P *) 149 | (forall st st' e, In e s -> P st st' -> P (f e st) (f e st')) -> 150 | 151 | (** [f] and [f'] agree for the elements of [s] *) 152 | (forall e st, In e s -> (P (f e st) (f' e st))) -> 153 | 154 | (** [f_abort] is OK, i.e. all other elements can be skipped without 155 | leaving the equivalence relation. *) 156 | (forall e1 st, 157 | In e1 s -> f_gt e1 st = true -> 158 | (forall st' e2, P st st' -> 159 | In e2 s -> lt e1 e2 -> 160 | P st (f e2 st'))) -> 161 | 162 | (** The base values are in equivalence relation *) 163 | P i i' -> 164 | 165 | (** The results are in equivalence relation *) 166 | P (foldWithAbortGt f f_gt s i) (fold f' s i'). 167 | 168 | 169 | 170 | (** For ordered sets, we can safely skip elements at the end 171 | based on the knowledge that they are all greater than the current element. 172 | This leads to serious performance improvements for operations like 173 | filtering. It is tempting to try the symmetric operation and skip elements at 174 | the beginning based on the knowledge that they are too small to be interesting. 175 | So, we would like to start late as well as abort early. 176 | 177 | This is indeed a very natural and efficient operation for set implementations 178 | based on binary search trees (i.e. the AVL and RBT sets). We can completely symmetrically 179 | to skipping greater elements also skip smaller elements. This leads to the following 180 | specification. *) 181 | 182 | Definition foldWithAbortGtLtType 183 | elt (** element type of set *) 184 | t (** type of set *) 185 | A (** return type *) := 186 | (elt -> A -> bool) -> (** f_lt *) 187 | (elt -> A -> A) -> (** f *) 188 | (elt -> A -> bool) -> (** f_gt *) 189 | t -> (** input set *) 190 | A -> (** base value *) 191 | A. 192 | 193 | 194 | Definition foldWithAbortGtLtSpecPred {elt t : Type} 195 | (lt : elt -> elt -> Prop) 196 | (In : elt -> t -> Prop) 197 | (fold : forall {A : Type}, (elt -> A -> A) -> t -> A -> A) 198 | (foldWithAbortGtLt : forall {A : Type}, foldWithAbortGtLtType elt t A) : Prop := 199 | 200 | forall 201 | (A : Type) 202 | (** result type *) 203 | 204 | (i i' : A) 205 | (** base values for foldWithAbort and fold *) 206 | 207 | (f : elt -> A -> A) (f' : elt -> A -> A) 208 | (** fold functions for foldWithAbort and fold *) 209 | 210 | (f_lt f_gt : elt -> A -> bool) 211 | (** abort functions *) 212 | 213 | (s : t) (** sets to fold over *) 214 | 215 | (P : A -> A -> Prop) (** equivalence relation on results *), 216 | 217 | 218 | (** [P] is an equivalence relation *) 219 | Equivalence P -> 220 | 221 | (** [f] is for the elements of [s] compatible with the equivalence relation P *) 222 | (forall st st' e, In e s -> P st st' -> P (f e st) (f e st')) -> 223 | 224 | (** [f] and [f'] agree for the elements of [s] *) 225 | (forall e st, In e s -> (P (f e st) (f' e st))) -> 226 | 227 | (** [f_lt] is OK, i.e. smaller elements can be skipped without 228 | leaving the equivalence relation. *) 229 | (forall e1 st, 230 | In e1 s -> f_lt e1 st = true -> 231 | (forall st' e2, P st st' -> 232 | In e2 s -> lt e2 e1 -> 233 | P st (f e2 st'))) -> 234 | 235 | (** [f_gt] is OK, i.e. greater elements can be skipped without 236 | leaving the equivalence relation. *) 237 | (forall e1 st, 238 | In e1 s -> f_gt e1 st = true -> 239 | (forall st' e2, P st st' -> 240 | In e2 s -> lt e1 e2 -> 241 | P st (f e2 st'))) -> 242 | 243 | (** The base values are in equivalence relation *) 244 | P i i' -> 245 | 246 | (** The results are in equivalence relation *) 247 | P (foldWithAbortGtLt f_lt f f_gt s i) (fold f' s i'). 248 | 249 | 250 | 251 | (** We are interested in folding with abort mainly for runtime 252 | performance reasons of extracted code. The argument functions 253 | [f_lt], [f_gt] and [f] of [foldWithAbortGtLt] often share a large, 254 | comparably expensive part of their computation. 255 | 256 | In order to further improve runtime performance, therefore another 257 | version [foldWithAbortPrecompute f_precompute f_lt f f_gt] that 258 | uses an extra function [f_precompute] to allows to compute the 259 | commonly used parts of these functions only once. This leads to 260 | the following definitions. *) 261 | 262 | 263 | Definition foldWithAbortPrecomputeType 264 | elt (** element type of set *) 265 | t (** type of set *) 266 | A (** return type *) 267 | B (** type of precomputed results *) := 268 | 269 | (elt -> B) -> (** f_precompute *) 270 | (elt -> B -> A -> bool) -> (** f_lt *) 271 | (elt -> B -> A -> A) -> (** f *) 272 | (elt -> B -> A -> bool) -> (** f_gt *) 273 | t -> (** input set *) 274 | A -> (** base value *) 275 | A. 276 | 277 | (** The specification is similar to the one without precompute, 278 | but uses [f_precompute] so avoid doing computations multiple times *) 279 | Definition foldWithAbortPrecomputeSpecPred {elt t : Type} 280 | (lt : elt -> elt -> Prop) 281 | (In : elt -> t -> Prop) 282 | (fold : forall {A : Type}, (elt -> A -> A) -> t -> A -> A) 283 | (foldWithAbortPrecompute : forall {A B : Type}, foldWithAbortPrecomputeType elt t A B) : Prop := 284 | 285 | forall 286 | (A B : Type) 287 | (** result type *) 288 | 289 | (i i' : A) 290 | (** base values for foldWithAbortPrecompute and fold *) 291 | 292 | (f_precompute : elt -> B) 293 | (** precompute function *) 294 | 295 | (f : elt -> B -> A -> A) (f' : elt -> A -> A) 296 | (** fold functions for foldWithAbortPrecompute and fold *) 297 | 298 | (f_lt f_gt : elt -> B -> A -> bool) 299 | (** abort functions *) 300 | 301 | (s : t) (** sets to fold over *) 302 | 303 | (P : A -> A -> Prop) (** equivalence relation on results *), 304 | 305 | 306 | (** [P] is an equivalence relation *) 307 | Equivalence P -> 308 | 309 | (** [f] is for the elements of [s] compatible with the equivalence relation P *) 310 | (forall st st' e, In e s -> P st st' -> P (f e (f_precompute e) st) (f e (f_precompute e) st')) -> 311 | 312 | (** [f] and [f'] agree for the elements of [s] *) 313 | (forall e st, In e s -> (P (f e (f_precompute e) st) (f' e st))) -> 314 | 315 | (** [f_lt] is OK, i.e. smaller elements can be skipped without 316 | leaving the equivalence relation. *) 317 | (forall e1 st, 318 | In e1 s -> f_lt e1 (f_precompute e1) st = true -> 319 | (forall st' e2, P st st' -> 320 | In e2 s -> lt e2 e1 -> 321 | P st (f e2 (f_precompute e2) st'))) -> 322 | 323 | (** [f_gt] is OK, i.e. greater elements can be skipped without 324 | leaving the equivalence relation. *) 325 | (forall e1 st, 326 | In e1 s -> f_gt e1 (f_precompute e1) st = true -> 327 | (forall st' e2, P st st' -> 328 | In e2 s -> lt e1 e2 -> 329 | P st (f e2 (f_precompute e2) st'))) -> 330 | 331 | (** The base values are in equivalence relation *) 332 | P i i' -> 333 | 334 | (** The results are in equivalence relation *) 335 | P (foldWithAbortPrecompute f_precompute f_lt f f_gt s i) (fold f' s i'). 336 | 337 | 338 | (** *** Module Types *) 339 | 340 | (** We now define a module type for [foldWithAbort]. This module 341 | type demands only the existence of the precompute version, since 342 | the other ones can be easily defined via this most efficient one. *) 343 | 344 | Module Type HasFoldWithAbort (E : OrderedType) (Import C : WSetsOnWithDups E). 345 | 346 | Parameter foldWithAbortPrecompute : forall {A B : Type}, 347 | foldWithAbortPrecomputeType elt t A B. 348 | 349 | Parameter foldWithAbortPrecomputeSpec : 350 | foldWithAbortPrecomputeSpecPred E.lt In (@fold) (@foldWithAbortPrecompute). 351 | 352 | End HasFoldWithAbort. 353 | 354 | 355 | (** ** Derived operations 356 | 357 | Using these efficient fold operations, many operations can 358 | be implemented efficiently. We provide lemmata and efficient implementations 359 | of useful algorithms via module [HasFoldWithAbortOps]. *) 360 | 361 | Module HasFoldWithAbortOps (E : OrderedType) (C : WSetsOnWithDups E) 362 | (FT : HasFoldWithAbort E C). 363 | 364 | Import FT. 365 | Import C. 366 | 367 | (** *** First lets define the other folding with abort variants *) 368 | 369 | Definition foldWithAbortGtLt {A} f_lt (f : (elt -> A -> A)) f_gt := 370 | foldWithAbortPrecompute (fun _ => tt) (fun e _ st => f_lt e st) 371 | (fun e _ st => f e st) (fun e _ st => f_gt e st). 372 | 373 | Lemma foldWithAbortGtLtSpec : 374 | foldWithAbortGtLtSpecPred E.lt In (@fold) (@foldWithAbortGtLt). 375 | Proof. 376 | rewrite /foldWithAbortGtLt /foldWithAbortGtLtSpecPred. 377 | intros A i i' f f' f_lt f_gt s P. 378 | move => H_f_compat H_ff' H_lt H_gt H_ii'. 379 | apply foldWithAbortPrecomputeSpec => //. 380 | Qed. 381 | 382 | 383 | Definition foldWithAbortGt {A} (f : (elt -> A -> A)) f_gt := 384 | foldWithAbortPrecompute (fun _ => tt) (fun _ _ _ => false) 385 | (fun e _ st => f e st) (fun e _ st => f_gt e st). 386 | 387 | Lemma foldWithAbortGtSpec : 388 | foldWithAbortGtSpecPred E.lt In (@fold) (@foldWithAbortGt). 389 | Proof. 390 | rewrite /foldWithAbortGt /foldWithAbortGtSpecPred. 391 | intros A i i' f f' f_gt s P. 392 | move => H_f_compat H_ff' H_gt H_ii'. 393 | apply foldWithAbortPrecomputeSpec => //. 394 | Qed. 395 | 396 | Definition foldWithAbort {A} (f : (elt -> A -> A)) f_abort := 397 | foldWithAbortPrecompute (fun _ => tt) (fun e _ st => f_abort e st) 398 | (fun e _ st => f e st) (fun e _ st => f_abort e st). 399 | 400 | Lemma foldWithAbortSpec : 401 | foldWithAbortSpecPred In (@fold) (@foldWithAbort). 402 | Proof. 403 | rewrite /foldWithAbort /foldWithAbortGtSpecPred. 404 | intros A i i' f f' f_abort s P. 405 | move => H_equiv_P H_f_compat H_ff' H_abort H_ii'. 406 | have H_lt_neq: (forall e1 e2, E.lt e1 e2 -> e1 <> e2). { 407 | move => e1 e2 H_lt H_e12_eq. 408 | rewrite H_e12_eq in H_lt. 409 | have : ( Irreflexive E.lt) by apply StrictOrder_Irreflexive. 410 | rewrite /Irreflexive /Reflexive /complement => H. 411 | eapply H, H_lt. 412 | } 413 | apply foldWithAbortPrecomputeSpec => //; ( 414 | move => e1 st H_in_e1 H_abort_e1 st' e2 H_P H_in_e2 /H_lt_neq H_lt; 415 | apply (H_abort e1 st H_in_e1 H_abort_e1 st' e2 H_P H_in_e2); 416 | by auto 417 | ). 418 | Qed. 419 | 420 | 421 | (** *** Specialisations for equality *) 422 | 423 | (** Let's provide simplified specifications, which use equality instead 424 | of an arbitrary equivalence relation on results. *) 425 | Lemma foldWithAbortPrecomputeSpec_Equal : forall (A B : Type) (i : A) (f_pre : elt -> B) 426 | (f : elt -> B -> A -> A) (f' : elt -> A -> A) (f_lt f_gt : elt -> B -> A -> bool) (s : t), 427 | 428 | (forall e st, In e s -> (f e (f_pre e) st = f' e st)) -> 429 | 430 | (* Less is OK *) 431 | (forall e1 st, 432 | In e1 s -> f_lt e1 (f_pre e1) st = true -> 433 | (forall e2, In e2 s -> E.lt e2 e1 -> 434 | (f e2 (f_pre e2) st = st))) -> 435 | 436 | (* Greater is OK *) 437 | (forall e1 st, 438 | In e1 s -> f_gt e1 (f_pre e1) st = true -> 439 | (forall e2, In e2 s -> E.lt e1 e2 -> 440 | (f e2 (f_pre e2) st = st))) -> 441 | 442 | (foldWithAbortPrecompute f_pre f_lt f f_gt s i) = (fold f' s i). 443 | Proof. 444 | intros A B i f_pre f f' f_lt f_gt s H_f' H_lt H_gt. 445 | 446 | eapply (foldWithAbortPrecomputeSpec A B i i f_pre f f'); eauto. { 447 | apply eq_equivalence. 448 | } { 449 | move => st1 st2 e H_in -> //. 450 | } { 451 | move => e1 st H_e1_in H_do_smaller st' e2 <-. 452 | move : (H_lt e1 st H_e1_in H_do_smaller e2). 453 | intuition. 454 | } { 455 | move => e1 st H_e1_in H_do_greater st' e2 <-. 456 | move : (H_gt e1 st H_e1_in H_do_greater e2). 457 | intuition. 458 | } 459 | Qed. 460 | 461 | Lemma foldWithAbortGtLtSpec_Equal : forall (A : Type) (i : A) 462 | (f : elt -> A -> A) (f' : elt -> A -> A) (f_lt f_gt : elt -> A -> bool) (s : t), 463 | 464 | (forall e st, In e s -> (f e st = f' e st)) -> 465 | 466 | (* Less is OK *) 467 | (forall e1 st, 468 | In e1 s -> f_lt e1 st = true -> 469 | (forall e2, In e2 s -> E.lt e2 e1 -> 470 | (f e2 st = st))) -> 471 | 472 | (* Greater is OK *) 473 | (forall e1 st, 474 | In e1 s -> f_gt e1 st = true -> 475 | (forall e2, In e2 s -> E.lt e1 e2 -> 476 | (f e2 st = st))) -> 477 | 478 | (foldWithAbortGtLt f_lt f f_gt s i) = (fold f' s i). 479 | Proof. 480 | intros A i f f' f_lt f_gt s H_f' H_lt H_gt. 481 | 482 | eapply (foldWithAbortGtLtSpec A i i f f'); eauto. { 483 | apply eq_equivalence. 484 | } { 485 | move => st1 st2 e H_in -> //. 486 | } { 487 | move => e1 st H_e1_in H_do_smaller st' e2 <-. 488 | move : (H_lt e1 st H_e1_in H_do_smaller e2). 489 | intuition. 490 | } { 491 | move => e1 st H_e1_in H_do_greater st' e2 <-. 492 | move : (H_gt e1 st H_e1_in H_do_greater e2). 493 | intuition. 494 | } 495 | Qed. 496 | 497 | 498 | Lemma foldWithAbortGtSpec_Equal : forall (A : Type) (i : A) 499 | (f : elt -> A -> A) (f' : elt -> A -> A) (f_gt : elt -> A -> bool) (s : t), 500 | 501 | (forall e st, In e s -> (f e st = f' e st)) -> 502 | 503 | (* Greater is OK *) 504 | (forall e1 st, 505 | In e1 s -> f_gt e1 st = true -> 506 | (forall e2, In e2 s -> E.lt e1 e2 -> 507 | (f e2 st = st))) -> 508 | 509 | (foldWithAbortGt f f_gt s i) = (fold f' s i). 510 | Proof. 511 | intros A i f f' f_gt s H_f' H_gt. 512 | 513 | eapply (foldWithAbortGtSpec A i i f f'); eauto. { 514 | apply eq_equivalence. 515 | } { 516 | move => st1 st2 e H_in -> //. 517 | } { 518 | move => e1 st H_e1_in H_do_greater st' e2 <-. 519 | move : (H_gt e1 st H_e1_in H_do_greater e2). 520 | intuition. 521 | } 522 | Qed. 523 | 524 | Lemma foldWithAbortSpec_Equal : forall (A : Type) (i : A) 525 | (f : elt -> A -> A) (f' : elt -> A -> A) (f_abort : elt -> A -> bool) (s : t), 526 | 527 | (forall e st, In e s -> (f e st = f' e st)) -> 528 | 529 | (* Abort is OK *) 530 | (forall e1 st, 531 | In e1 s -> f_abort e1 st = true -> 532 | (forall e2, In e2 s -> e1 <> e2 -> 533 | (f e2 st = st))) -> 534 | 535 | (foldWithAbort f f_abort s i) = (fold f' s i). 536 | Proof. 537 | intros A i f f' f_abort s H_f' H_abort. 538 | 539 | eapply (foldWithAbortSpec A i i f f'); eauto. { 540 | apply eq_equivalence. 541 | } { 542 | move => st1 st2 e H_in -> //. 543 | } { 544 | move => e1 st H_e1_in H_do_abort st' e2 <-. 545 | move : (H_abort e1 st H_e1_in H_do_abort e2). 546 | intuition. 547 | } 548 | Qed. 549 | 550 | 551 | (** *** FoldWithAbortSpecArgs *) 552 | 553 | (** While folding, we are often interested in skipping elements that do not 554 | satisfy a certain property [P]. This needs expressing in terms of 555 | skips of smaller of larger elements in order to be done efficiently by 556 | our folding functions. Formally, this leads to the definition 557 | of [foldWithAbortSpecForPred]. 558 | 559 | Given a [FoldWithAbortSpecArg] for a predicate [P] and a 560 | set [s], many operations can be implemented efficiently. Below we will provide 561 | efficient versions of [filter], [choose], [exists], [forall] and more. 562 | *) 563 | Record FoldWithAbortSpecArg {B} := { 564 | fwasa_f_pre : (elt -> B); (** The precompute function *) 565 | fwasa_f_lt : (elt -> B -> bool); (** f_lt without state argument *) 566 | fwasa_f_gt : (elt -> B -> bool); (** f_gt without state argument *) 567 | fwasa_P' : (elt -> B -> bool) (** the predicate P *) 568 | }. 569 | 570 | (** [foldWithAbortSpecForPred s P fwasa] holds, if 571 | the argument [fwasa] fits the predicate [P] for set [s]. *) 572 | Definition foldWithAbortSpecArgsForPred {A : Type} 573 | (s : t) (P : elt -> bool) (fwasa : @FoldWithAbortSpecArg A) := 574 | 575 | (** the predicate [P'] coincides for [s] and the given precomputation with [P] *) 576 | (forall e, In e s -> (fwasa_P' fwasa e (fwasa_f_pre fwasa e) = P e)) /\ 577 | 578 | (** If [fwasa_f_lt] holds, all elements smaller than the current one 579 | don't satisfy predicate P. *) 580 | (forall e1, 581 | In e1 s -> fwasa_f_lt fwasa e1 (fwasa_f_pre fwasa e1) = true -> 582 | (forall e2, In e2 s -> E.lt e2 e1 -> (P e2 = false))) /\ 583 | 584 | (** If [fwasa_f_gt] holds, all elements greater than the current one 585 | don't satisfy predicate P. *) 586 | (forall e1, 587 | In e1 s -> fwasa_f_gt fwasa e1 (fwasa_f_pre fwasa e1) = true -> 588 | (forall e2, In e2 s -> E.lt e1 e2 -> (P e2 = false))). 589 | 590 | 591 | 592 | (** *** Filter with abort *) 593 | Definition filter_with_abort {B} (fwasa : @FoldWithAbortSpecArg B) s := 594 | @foldWithAbortPrecompute t B (fwasa_f_pre fwasa) (fun e p _ => fwasa_f_lt fwasa e p) 595 | (fun e e_pre s => if fwasa_P' fwasa e e_pre then add e s else s) 596 | (fun e p _ => fwasa_f_gt fwasa e p) s empty. 597 | 598 | Lemma filter_with_abort_spec {B} : forall fwasa P s, 599 | @foldWithAbortSpecArgsForPred B s P fwasa -> 600 | Proper (E.eq ==> Logic.eq) P -> 601 | Equal (filter_with_abort fwasa s) 602 | (filter P s). 603 | Proof. 604 | unfold foldWithAbortSpecArgsForPred. 605 | move => [] f_pre f_lt f_gt P' P s /=. 606 | move => [H_f'] [H_lt] H_gt H_proper. 607 | rewrite /filter_with_abort /=. 608 | 609 | have -> : (foldWithAbortPrecompute f_pre (fun e p _ => f_lt e p) 610 | (fun (e : elt) (e_pre : B) (s0 : t) => 611 | if P' e e_pre then add e s0 else s0) (fun e p _ => f_gt e p) s empty = 612 | (fold (fun e s0 => if P e then add e s0 else s0) s empty)). { 613 | apply foldWithAbortPrecomputeSpec_Equal. { 614 | intros e st H_e_in. 615 | rewrite H_f' //. 616 | } { 617 | intros e1 st H_e1_in H_f_lt_eq e2 H_e2_in H_lt_e2_e1. 618 | rewrite (H_f' _ H_e2_in). 619 | suff -> : (P e2 = false) by done. 620 | apply (H_lt e1); eauto. 621 | } { 622 | intros e1 st H_e1_in H_f_gt_eq e2 H_e2_in H_gt_e2_e1. 623 | rewrite (H_f' _ H_e2_in). 624 | suff -> : (P e2 = false) by done. 625 | apply (H_gt e1); eauto. 626 | } 627 | } 628 | 629 | rewrite /Equal => e. 630 | rewrite fold_spec. 631 | setoid_rewrite filter_spec => //. 632 | 633 | suff -> : forall acc, In e 634 | (fold_left 635 | (flip (fun (e0 : elt) (s0 : t) => if P e0 then add e0 s0 else s0)) 636 | (elements s) acc) <-> (InA E.eq e (elements s) /\ P e = true) \/ (In e acc). { 637 | rewrite elements_spec1. 638 | suff : (~In e empty) by tauto. 639 | apply empty_spec. 640 | } 641 | induction (elements s) as [| x xs IH] => acc. { 642 | rewrite /= InA_nil. tauto. 643 | } { 644 | rewrite /= /flip IH InA_cons. 645 | case_eq (P x). { 646 | rewrite add_spec. 647 | intuition. 648 | left. 649 | rewrite H0. 650 | split => //. 651 | left. 652 | apply Equivalence_Reflexive. 653 | } { 654 | intuition. 655 | contradict H2. 656 | setoid_rewrite H1. 657 | by rewrite H. 658 | } 659 | } 660 | Qed. 661 | 662 | (** *** Choose with abort *) 663 | Definition choose_with_abort {B} (fwasa : @FoldWithAbortSpecArg B) s := 664 | foldWithAbortPrecompute (fwasa_f_pre fwasa) 665 | (fun e p st => match st with None => (fwasa_f_lt fwasa e p) | _ => true end) 666 | (fun e e_pre st => match st with None => 667 | if (fwasa_P' fwasa e e_pre) then Some e else None | _ => st end) 668 | 669 | (fun e p st => match st with None => (fwasa_f_gt fwasa e p) | _ => true end) 670 | s None. 671 | 672 | Lemma choose_with_abort_spec {B} : forall fwasa P s, 673 | @foldWithAbortSpecArgsForPred B s P fwasa -> 674 | Proper (E.eq ==> Logic.eq) P -> 675 | (match (choose_with_abort fwasa s) with 676 | | None => (forall e, In e s -> P e = false) 677 | | Some e => In e s /\ (P e = true) 678 | end). 679 | Proof. 680 | rewrite /foldWithAbortSpecArgsForPred. 681 | move => [] f_pre f_lt f_gt P' P s /=. 682 | move => [H_f'] [H_lt] H_gt H_proper. 683 | 684 | set fwasa := {| 685 | fwasa_f_pre := f_pre; 686 | fwasa_f_lt := f_lt; 687 | fwasa_f_gt := f_gt; 688 | fwasa_P' := P' |}. 689 | 690 | suff : (match (choose_with_abort fwasa s) with 691 | | None => (forall e, InA E.eq e (elements s) -> P e = false) 692 | | Some e => InA E.eq e (elements s) /\ (P e = true) 693 | end). { 694 | case (choose_with_abort fwasa s). { 695 | move => e. 696 | rewrite elements_spec1 //. 697 | } { 698 | move => H e H_in. 699 | apply H. 700 | rewrite elements_spec1 //. 701 | } 702 | } 703 | 704 | have -> : (choose_with_abort fwasa s = 705 | (fold (fun e st => 706 | match st with 707 | | None => if P e then Some e else None 708 | | _ => st end) s None)). { 709 | apply foldWithAbortPrecomputeSpec_Equal. { 710 | intros e st H_e_in. 711 | case st => //=. 712 | rewrite H_f' //. 713 | } { 714 | move => e1 [] //= H_e1_in H_f_lt_eq e2 H_e2_in H_lt_e2_e1. 715 | rewrite (H_f' _ H_e2_in). 716 | case_eq (P e2) => // H_P_e2. 717 | contradict H_P_e2. 718 | apply not_true_iff_false, (H_lt e1); auto. 719 | } { 720 | move => e1 [] //= H_e1_in H_f_gt_eq e2 H_e2_in H_gt_e2_e1. 721 | rewrite (H_f' _ H_e2_in). 722 | case_eq (P e2) => // H_P_e2. 723 | contradict H_P_e2. 724 | apply not_true_iff_false, (H_gt e1); auto. 725 | } 726 | } 727 | 728 | rewrite fold_spec /flip. 729 | induction (elements s) as [| x xs IH]. { 730 | rewrite /=. 731 | move => e /InA_nil //. 732 | } { 733 | case_eq (P x) => H_Px; rewrite /= H_Px. { 734 | have -> : forall xs, fold_left (fun (x0 : option elt) (y : elt) => 735 | match x0 with | Some _ => x0 | None => if P y then Some y else None 736 | end) xs (Some x) = Some x. { 737 | move => ys. 738 | induction ys => //. 739 | } 740 | split; last assumption. 741 | apply InA_cons_hd. 742 | apply E.eq_equiv. 743 | } { 744 | move : IH. 745 | case (fold_left 746 | (fun (x0 : option elt) (y : elt) => 747 | match x0 with | Some _ => x0 | None => if P y then Some y else None 748 | end) xs None). { 749 | 750 | move => e [H_e_in] H_Pe. 751 | split; last assumption. 752 | apply InA_cons_tl => //. 753 | } { 754 | move => H_e_nin e H_e_in. 755 | have : (InA E.eq e xs \/ (E.eq e x)). { 756 | inversion H_e_in; tauto. 757 | } 758 | move => []. { 759 | apply H_e_nin. 760 | } { 761 | move => -> //. 762 | } 763 | } 764 | } 765 | } 766 | Qed. 767 | 768 | 769 | (** *** Exists and Forall with abort *) 770 | Definition exists_with_abort {B} (fwasa : @FoldWithAbortSpecArg B) s := 771 | match choose_with_abort fwasa s with 772 | | None => false 773 | | Some _ => true 774 | end. 775 | 776 | Lemma exists_with_abort_spec {B} : forall fwasa P s, 777 | @foldWithAbortSpecArgsForPred B s P fwasa -> 778 | Proper (E.eq ==> Logic.eq) P -> 779 | (exists_with_abort fwasa s = 780 | exists_ P s). 781 | Proof. 782 | intros fwasa P s H_fwasa H_proper. 783 | apply Logic.eq_sym. 784 | rewrite /exists_with_abort. 785 | move : (choose_with_abort_spec _ _ _ H_fwasa H_proper). 786 | case (choose_with_abort fwasa s). { 787 | move => e [H_e_in] H_Pe. 788 | rewrite exists_spec /Exists. 789 | by exists e. 790 | } { 791 | move => H_not_ex. 792 | apply not_true_iff_false. 793 | rewrite exists_spec /Exists. 794 | move => [e] [H_in] H_pe. 795 | move : (H_not_ex e H_in). 796 | rewrite H_pe //. 797 | } 798 | Qed. 799 | 800 | 801 | (** Negation leads to forall. *) 802 | Definition forall_with_abort {B} fwasa s := 803 | negb (@exists_with_abort B fwasa s). 804 | 805 | Lemma forall_with_abort_spec {B} : forall fwasa s P, 806 | @foldWithAbortSpecArgsForPred B s P fwasa -> 807 | Proper (E.eq ==> Logic.eq) P -> 808 | (forall_with_abort fwasa s = 809 | for_all (fun e => negb (P e)) s). 810 | Proof. 811 | intros fwasa s P H_ok H_proper. 812 | rewrite /forall_with_abort exists_with_abort_spec; auto. 813 | 814 | rewrite eq_iff_eq_true negb_true_iff -not_true_iff_false. 815 | rewrite exists_spec. 816 | setoid_rewrite for_all_spec; last solve_proper. 817 | 818 | rewrite /Exists /For_all. 819 | split. { 820 | move => H_pre x H_x_in. 821 | rewrite negb_true_iff -not_true_iff_false => H_Px. 822 | apply H_pre. 823 | by exists x. 824 | } { 825 | move => H_pre [x] [H_x_in] H_P_x. 826 | move : (H_pre x H_x_in). 827 | rewrite H_P_x. 828 | done. 829 | } 830 | Qed. 831 | 832 | End HasFoldWithAbortOps. 833 | 834 | 835 | 836 | (** ** Modules Types For Sets with Fold with Abort *) 837 | Module Type WSetsWithDupsFoldA. 838 | Declare Module E : OrderedType. 839 | Include WSetsOnWithDups E. 840 | Include HasFoldWithAbort E. 841 | Include HasFoldWithAbortOps E. 842 | End WSetsWithDupsFoldA. 843 | 844 | Module Type WSetsWithFoldA <: WSets. 845 | Declare Module E : OrderedType. 846 | Include WSetsOn E. 847 | Include HasFoldWithAbort E. 848 | Include HasFoldWithAbortOps E. 849 | End WSetsWithFoldA. 850 | 851 | Module Type SetsWithFoldA <: Sets. 852 | Declare Module E : OrderedType. 853 | Include SetsOn E. 854 | Include HasFoldWithAbort E. 855 | Include HasFoldWithAbortOps E. 856 | End SetsWithFoldA. 857 | 858 | 859 | (** ** Implementations *) 860 | 861 | (** *** GenTree implementation 862 | Finally, provide such a fold with abort operation for generic trees. *) 863 | Module MakeGenTreeFoldA (Import E : OrderedType) (Import I:InfoTyp) 864 | (Import Raw:Ops E I) 865 | (M : MSetGenTree.Props E I Raw). 866 | 867 | Fixpoint foldWithAbort_Raw {A B: Type} (f_pre : E.t -> B) f_lt (f: E.t -> B -> A -> A) f_gt t (base: A) : A := 868 | match t with 869 | | Raw.Leaf => base 870 | | Raw.Node _ l x r => 871 | let x_pre := f_pre x in 872 | let st0 := if f_lt x x_pre base then base else foldWithAbort_Raw f_pre f_lt f f_gt l base in 873 | let st1 := f x x_pre st0 in 874 | let st2 := if f_gt x x_pre st1 then st1 else foldWithAbort_Raw f_pre f_lt f f_gt r st1 in 875 | st2 876 | end. 877 | 878 | Lemma foldWithAbort_RawSpec : forall (A B : Type) (i i' : A) (f_pre : E.t -> B) 879 | (f : E.t -> B -> A -> A) (f' : E.t -> A -> A) (f_lt f_gt : E.t -> B -> A -> bool) (s : Raw.tree) 880 | (P : A -> A -> Prop), 881 | 882 | (M.bst s) -> 883 | Equivalence P -> 884 | (forall st st' e, M.In e s -> P st st' -> P (f e (f_pre e) st) (f e (f_pre e) st')) -> 885 | (forall e st, M.In e s -> P (f e (f_pre e) st) (f' e st)) -> 886 | 887 | (* Less is OK *) 888 | (forall e1 st, 889 | M.In e1 s -> f_lt e1 (f_pre e1) st = true -> 890 | (forall st' e2, P st st' -> 891 | M.In e2 s -> E.lt e2 e1 -> 892 | P st (f e2 (f_pre e2) st'))) -> 893 | 894 | (* Greater is OK *) 895 | (forall e1 st, 896 | M.In e1 s -> f_gt e1 (f_pre e1) st = true -> 897 | (forall st' e2, P st st' -> 898 | M.In e2 s -> E.lt e1 e2 -> 899 | P st (f e2 (f_pre e2) st'))) -> 900 | 901 | P i i' -> 902 | P (foldWithAbort_Raw f_pre f_lt f f_gt s i) (fold f' s i'). 903 | Proof. 904 | intros A B i i' f_pre f f' f_lt f_gt s P. 905 | move => H_bst H_equiv_P H_P_f H_f' H_RL H_RG. 906 | 907 | set base := s. 908 | 909 | move : i i'. 910 | have : (forall e, M.In e base -> M.In e s). { 911 | rewrite /In /base //. 912 | } 913 | have : M.bst base. { 914 | apply H_bst. 915 | } 916 | move : base. 917 | clear H_bst. 918 | 919 | induction base as [|c l IHl e r IHr] using M.tree_ind. { 920 | rewrite /foldWithAbort_Raw /Raw.fold. 921 | move => _ _ i i' //. 922 | } { 923 | move => H_bst H_sub i i' H_P_ii'. 924 | 925 | have [H_bst_l [H_bst_r [H_lt_tree_l H_gt_tree_r]]]: 926 | M.bst l /\ M.bst r /\ M.lt_tree e l /\ M.gt_tree e r. { 927 | inversion H_bst. done. 928 | } 929 | 930 | have H_sub_l : (forall e0 : E.t, M.In e0 l -> M.In e0 s /\ E.lt e0 e). { 931 | intros e0 H_in_l. 932 | split; last by apply H_lt_tree_l. 933 | eapply H_sub. 934 | rewrite /M.In M.In_node_iff. 935 | tauto. 936 | } 937 | move : (IHl H_bst_l) => {IHl} IHl {H_bst_l} {H_lt_tree_l}. 938 | have H_sub_r : (forall e0 : E.t, M.In e0 r -> M.In e0 s /\ E.lt e e0). { 939 | intros e0 H_in_r. 940 | split; last by apply H_gt_tree_r. 941 | eapply H_sub. 942 | rewrite /M.In M.In_node_iff. 943 | tauto. 944 | } 945 | move : (IHr H_bst_r) => {IHr} IHr {H_bst_r} {H_gt_tree_r}. 946 | have H_in_e : M.In e s. { 947 | eapply H_sub. 948 | rewrite /M.In M.In_node_iff. 949 | right; left. 950 | apply Equivalence_Reflexive. 951 | } 952 | move => {H_sub}. 953 | 954 | rewrite /=. 955 | set st0 := if f_lt e (f_pre e) i then i else foldWithAbort_Raw f_pre f_lt f f_gt l i. 956 | set st0' := Raw.fold f' l i'. 957 | set st1 := f e (f_pre e) st0. 958 | set st1' := f' e st0'. 959 | set st2 := if f_gt e (f_pre e) st1 then st1 else foldWithAbort_Raw f_pre f_lt f f_gt r st1. 960 | set st2' := Raw.fold f' r st1'. 961 | 962 | have H_P_st0 : P st0 st0'. { 963 | rewrite /st0 /st0'. 964 | case_eq (f_lt e (f_pre e) i). { 965 | move => H_fl_eq. 966 | move : H_P_ii' H_sub_l. 967 | move : H_equiv_P H_f' (H_RL _ _ H_in_e H_fl_eq). 968 | rewrite /M.lt_tree. clear. 969 | move => H_equiv_P H_f' H_RL. 970 | move : i'. 971 | induction l as [|c l IHl e' r IHr] using M.tree_ind. { 972 | done. 973 | } { 974 | intros i' H_P_ii' H_sub_l. 975 | rewrite /=. 976 | apply IHr; last first. { 977 | move => y H_y_in. 978 | apply H_sub_l. 979 | rewrite /M.In M.In_node_iff. tauto. 980 | } 981 | have [] : (M.In e' s /\ E.lt e' e). { 982 | apply H_sub_l. 983 | rewrite /M.In M.In_node_iff. 984 | right; left. 985 | apply Equivalence_Reflexive. 986 | } 987 | move => H_e'_in H_lt_in. 988 | suff H_P_i : (P i (f e' (f_pre e') (fold f' l i'))). { 989 | eapply Equivalence_Transitive; first apply H_P_i. 990 | by apply H_f'. 991 | } 992 | eapply H_RL => //. 993 | apply IHl; last first. { 994 | move => y H_y_in. 995 | apply H_sub_l. 996 | rewrite /M.In M.In_node_iff. tauto. 997 | } 998 | assumption. 999 | } 1000 | } { 1001 | move => _. 1002 | apply IHl => //. 1003 | eapply H_sub_l. 1004 | } 1005 | } 1006 | have H_P_st1 : P st1 st1'. { 1007 | rewrite /st1 /st1'. 1008 | rewrite -H_f' //. 1009 | apply H_P_f => //. 1010 | } 1011 | have H_P_st2 : P st2 st2'. { 1012 | rewrite /st2 /st2'. 1013 | clearbody st1 st1'. 1014 | case_eq (f_gt e (f_pre e) st1). { 1015 | move => H_gt_eq. 1016 | move : H_P_st1 H_sub_r. 1017 | move : H_equiv_P (H_RG _ _ H_in_e H_gt_eq) H_f'. 1018 | unfold M.gt_tree. clear. 1019 | move => H_equiv_P H_RG H_f'. 1020 | move : st1'. 1021 | induction r as [|c l IHl e' r IHr] using M.tree_ind. { 1022 | done. 1023 | } { 1024 | intros st1' H_P_st1 H_sub_r. 1025 | rewrite /=. 1026 | apply IHr; last first. { 1027 | move => y H_y_in. 1028 | apply H_sub_r. 1029 | rewrite /M.In M.In_node_iff. tauto. 1030 | } 1031 | have [] : (M.In e' s /\ E.lt e e'). { 1032 | apply H_sub_r. 1033 | rewrite /M.In M.In_node_iff. 1034 | right; left. 1035 | apply Equivalence_Reflexive. 1036 | } 1037 | move => H_e'_in H_lt_ee'. 1038 | suff H_P_st1_aux : (P st1 (f e' (f_pre e') (fold f' l st1'))). { 1039 | eapply Equivalence_Transitive; first apply H_P_st1_aux. 1040 | by apply H_f'. 1041 | } 1042 | eapply H_RG => //. 1043 | apply IHl; last first. { 1044 | move => y H_y_in. 1045 | apply H_sub_r. 1046 | rewrite /M.In M.In_node_iff. tauto. 1047 | } 1048 | assumption. 1049 | } 1050 | } { 1051 | move => _. 1052 | apply IHr => //. 1053 | eapply H_sub_r. 1054 | } 1055 | } 1056 | done. 1057 | } 1058 | Qed. 1059 | End MakeGenTreeFoldA. 1060 | 1061 | 1062 | (** *** AVL implementation 1063 | The generic tree implementation naturally leads to an AVL one. *) 1064 | 1065 | Module MakeAVLSetsWithFoldA (X : OrderedType) <: SetsWithFoldA with Module E := X. 1066 | Include MSetAVL.Make X. 1067 | Include MakeGenTreeFoldA X Z_as_Int Raw Raw. 1068 | 1069 | Definition foldWithAbortPrecompute {A B: Type} f_pre f_lt (f: elt -> B -> A -> A) f_gt t (base: A) : A := 1070 | foldWithAbort_Raw f_pre f_lt f f_gt (t.(this)) base. 1071 | 1072 | Lemma foldWithAbortPrecomputeSpec : foldWithAbortPrecomputeSpecPred X.lt In fold (@foldWithAbortPrecompute). 1073 | Proof. 1074 | intros A B i i' f_pre f f' f_lt f_gt s P. 1075 | move => H_P_f H_f' H_RL H_RG H_P_ii'. 1076 | 1077 | rewrite /foldWithAbortPrecompute /fold. 1078 | apply foldWithAbort_RawSpec => //. 1079 | case s. rewrite /this /Raw.Ok //. 1080 | Qed. 1081 | 1082 | Include HasFoldWithAbortOps X. 1083 | 1084 | End MakeAVLSetsWithFoldA. 1085 | 1086 | 1087 | (** *** RBT implementation 1088 | The generic tree implementation naturally leads to an RBT one. *) 1089 | Module MakeRBTSetsWithFoldA (X : OrderedType) <: SetsWithFoldA with Module E := X. 1090 | Include MSetRBT.Make X. 1091 | Include MakeGenTreeFoldA X Color Raw Raw. 1092 | 1093 | Definition foldWithAbortPrecompute {A B: Type} f_pre f_lt (f: elt -> B -> A -> A) f_gt t (base: A) : A := 1094 | foldWithAbort_Raw f_pre f_lt f f_gt (t.(this)) base. 1095 | 1096 | Lemma foldWithAbortPrecomputeSpec : foldWithAbortPrecomputeSpecPred X.lt In fold (@foldWithAbortPrecompute). 1097 | Proof. 1098 | intros A B i i' f_pre f f' f_lt f_gt s P. 1099 | move => H_P_f H_f' H_RL H_RG H_P_ii'. 1100 | 1101 | rewrite /foldWithAbortPrecompute /fold. 1102 | apply foldWithAbort_RawSpec => //. 1103 | case s. rewrite /this /Raw.Ok //. 1104 | Qed. 1105 | 1106 | Include HasFoldWithAbortOps X. 1107 | 1108 | End MakeRBTSetsWithFoldA. 1109 | 1110 | 1111 | (** ** Sorted Lists Implementation *) 1112 | Module MakeListSetsWithFoldA (X : OrderedType) <: SetsWithFoldA with Module E := X. 1113 | Include MSetList.Make X. 1114 | 1115 | Fixpoint foldWithAbortRaw {A B: Type} (f_pre : X.t -> B) (f_lt : X.t -> B -> A -> bool) 1116 | (f: X.t -> B -> A -> A) (f_gt : X.t -> B -> A -> bool) (t : list X.t) (acc : A) : A := 1117 | match t with 1118 | | nil => acc 1119 | | x :: xs => ( 1120 | let pre_x := f_pre x in 1121 | let acc := f x (pre_x) acc in 1122 | if (f_gt x pre_x acc) then 1123 | acc 1124 | else 1125 | foldWithAbortRaw f_pre f_lt f f_gt xs acc 1126 | ) 1127 | end. 1128 | 1129 | Definition foldWithAbortPrecompute {A B: Type} f_pre f_lt f f_gt t acc := 1130 | @foldWithAbortRaw A B f_pre f_lt f f_gt t.(this) acc. 1131 | 1132 | Lemma foldWithAbortPrecomputeSpec : foldWithAbortPrecomputeSpecPred X.lt In fold (@foldWithAbortPrecompute). 1133 | Proof. 1134 | intros A B i i' f_pre f f' f_lt f_gt. 1135 | move => [] l H_is_ok_l P H_equiv_P. 1136 | rewrite /fold /foldWithAbortPrecompute /In /this /Raw.In /Raw.fold. 1137 | move => H_P_f H_f' H_RL H_RG. 1138 | 1139 | set base := l. 1140 | move : i i'. 1141 | have : (forall e, InA X.eq e base -> InA X.eq e l). { 1142 | rewrite /base //. 1143 | } 1144 | have : sort X.lt base. { 1145 | rewrite Raw.isok_iff /base //. 1146 | } 1147 | clear H_is_ok_l. 1148 | 1149 | induction base as [| x xs IH]. { 1150 | by simpl. 1151 | } 1152 | move => H_sort H_in_xxs i i' Pii' /=. 1153 | 1154 | have [H_sort_xs H_hd_rel {H_sort}] : Sorted X.lt xs /\ HdRel X.lt x xs. { 1155 | by inversion H_sort. 1156 | } 1157 | 1158 | move : H_hd_rel. 1159 | rewrite (Raw.ML.Inf_alt x H_sort_xs) => H_lt_xs. 1160 | 1161 | have H_x_in_l : InA X.eq x l. { 1162 | apply H_in_xxs. 1163 | apply InA_cons_hd. 1164 | apply X.eq_equiv. 1165 | } 1166 | have H_in_xs : (forall e : X.t, InA X.eq e xs -> InA X.eq e l). { 1167 | intros e H_in. 1168 | apply H_in_xxs, InA_cons_tl => //. 1169 | } 1170 | 1171 | have H_P_next : P (f x (f_pre x) i) (flip f' i' x). { 1172 | rewrite /flip -H_f' //. 1173 | apply H_P_f => //. 1174 | } 1175 | 1176 | case_eq (f_gt x (f_pre x) (f x (f_pre x) i)); last first. { 1177 | move => _. 1178 | apply IH => //. 1179 | } { 1180 | move => H_gt. 1181 | suff H_suff : (forall st, P (f x (f_pre x) i) st -> 1182 | P (f x (f_pre x) i) (fold_left (flip f') xs st)). { 1183 | apply H_suff => //. 1184 | } 1185 | move : H_in_xs H_lt_xs. 1186 | 1187 | clear IH H_in_xxs H_sort_xs. 1188 | move : (H_RG x _ H_x_in_l H_gt) => H_RG_x. 1189 | induction xs as [| x' xs' IH']. { 1190 | done. 1191 | } { 1192 | intros H_in_xs H_lt_xs st H_P_st. 1193 | rewrite /=. 1194 | have H_x'_in_l : InA X.eq x' l. { 1195 | apply H_in_xs. 1196 | apply InA_cons_hd, X.eq_equiv. 1197 | } 1198 | apply IH'. { 1199 | intros e H. 1200 | apply H_in_xs, InA_cons_tl => //. 1201 | } { 1202 | intros e H. 1203 | apply H_lt_xs, InA_cons_tl => //. 1204 | } { 1205 | rewrite /flip -H_f' //. 1206 | apply H_RG_x => //. 1207 | apply H_lt_xs. 1208 | apply InA_cons_hd, X.eq_equiv. 1209 | } 1210 | } 1211 | } 1212 | Qed. 1213 | 1214 | Include HasFoldWithAbortOps X. 1215 | 1216 | End MakeListSetsWithFoldA. 1217 | 1218 | 1219 | (** *** Unsorted Lists without Dups Implementation *) 1220 | Module MakeWeakListSetsWithFoldA (X : OrderedType) <: WSetsWithFoldA with Module E := X. 1221 | Module Raw := MSetWeakList.MakeRaw X. 1222 | Module E := X. 1223 | Include WRaw2SetsOn E Raw. 1224 | 1225 | Fixpoint foldWithAbortRaw {A B: Type} (f_pre : X.t -> B) (f_lt : X.t -> B -> A -> bool) 1226 | (f: X.t -> B -> A -> A) (f_gt : X.t -> B -> A -> bool) (t : list X.t) (acc : A) : A := 1227 | match t with 1228 | | nil => acc 1229 | | x :: xs => ( 1230 | let pre_x := f_pre x in 1231 | let acc := f x (pre_x) acc in 1232 | if (f_gt x pre_x acc) && (f_lt x pre_x acc) then 1233 | acc 1234 | else 1235 | foldWithAbortRaw f_pre f_lt f f_gt xs acc 1236 | ) 1237 | end. 1238 | 1239 | Definition foldWithAbortPrecompute {A B: Type} f_pre f_lt f f_gt t acc := 1240 | @foldWithAbortRaw A B f_pre f_lt f f_gt t.(this) acc. 1241 | 1242 | Lemma foldWithAbortPrecomputeSpec : foldWithAbortPrecomputeSpecPred X.lt In fold (@foldWithAbortPrecompute). 1243 | Proof. 1244 | intros A B i i' f_pre f f' f_lt f_gt. 1245 | move => [] l H_is_ok_l P H_P_equiv. 1246 | rewrite /fold /foldWithAbortPrecompute /In /this /Raw.In /Raw.fold. 1247 | move => H_P_f H_f' H_RL H_RG. 1248 | 1249 | set base := l. 1250 | move : i i'. 1251 | have : (forall e, InA X.eq e base -> InA X.eq e l). { 1252 | rewrite /base //. 1253 | } 1254 | have : NoDupA X.eq base. { 1255 | apply H_is_ok_l. 1256 | } 1257 | clear H_is_ok_l. 1258 | 1259 | induction base as [| x xs IH]. { 1260 | by simpl. 1261 | } 1262 | move => H_nodup_xxs H_in_xxs i i' Pii' /=. 1263 | 1264 | have [H_nin_x_xs H_nodup_xs {H_nodup_xxs}] : ~ InA X.eq x xs /\ NoDupA X.eq xs. { 1265 | by inversion H_nodup_xxs. 1266 | } 1267 | 1268 | have H_x_in_l : InA X.eq x l. { 1269 | apply H_in_xxs. 1270 | apply InA_cons_hd. 1271 | apply X.eq_equiv. 1272 | } 1273 | have H_in_xs : (forall e : X.t, InA X.eq e xs -> InA X.eq e l). { 1274 | intros e H_in. 1275 | apply H_in_xxs, InA_cons_tl => //. 1276 | } 1277 | 1278 | have H_P_next : P (f x (f_pre x) i) (flip f' i' x). { 1279 | rewrite /flip -H_f' //. 1280 | apply H_P_f => //. 1281 | } 1282 | 1283 | case_eq (f_gt x (f_pre x) (f x (f_pre x) i) && 1284 | f_lt x (f_pre x) (f x (f_pre x) i)); last first. { 1285 | move => _. 1286 | apply IH => //. 1287 | } { 1288 | move => /andb_true_iff [H_gt H_lt]. 1289 | suff H_suff : (forall st, P (f x (f_pre x) i) st -> 1290 | P (f x (f_pre x) i) (fold_left (flip f') xs st)). { 1291 | apply H_suff => //. 1292 | } 1293 | 1294 | have H_neq_xs : forall e, List.In e xs -> X.lt x e \/ X.lt e x. { 1295 | intros e H_in. 1296 | 1297 | move : (X.compare_spec x e). 1298 | case (X.compare x e) => H_cmp; inversion H_cmp. { 1299 | contradict H_nin_x_xs. 1300 | rewrite InA_alt. 1301 | by exists e. 1302 | } { 1303 | by left. 1304 | } { 1305 | by right. 1306 | } 1307 | } 1308 | move : H_in_xs H_neq_xs. 1309 | 1310 | clear IH H_in_xxs H_nodup_xs. 1311 | move : (H_RG x _ H_x_in_l H_gt) => H_RG_x. 1312 | move : (H_RL x _ H_x_in_l H_lt) => H_RL_x. 1313 | induction xs as [| x' xs' IH']. { 1314 | done. 1315 | } { 1316 | intros H_in_xs H_neq_xs st H_P_st. 1317 | rewrite /=. 1318 | have H_x'_in_xxs' : List.In x' (x' :: xs'). { 1319 | simpl; by left. 1320 | } 1321 | have H_x'_in_l : InA X.eq x' l. { 1322 | apply H_in_xs. 1323 | apply InA_cons_hd, X.eq_equiv. 1324 | } 1325 | apply IH'. { 1326 | intros H. 1327 | apply H_nin_x_xs, InA_cons_tl => //. 1328 | } { 1329 | intros e H. 1330 | apply H_in_xs, InA_cons_tl => //. 1331 | } { 1332 | intros e H. 1333 | apply H_neq_xs, in_cons => //. 1334 | } { 1335 | rewrite /flip -H_f' //. 1336 | move : (H_neq_xs x' H_x'_in_xxs') => [] H_cmp. { 1337 | apply H_RG_x => //. 1338 | } { 1339 | apply H_RL_x => //. 1340 | } 1341 | } 1342 | } 1343 | } 1344 | Qed. 1345 | 1346 | Include HasFoldWithAbortOps X. 1347 | 1348 | End MakeWeakListSetsWithFoldA. 1349 | 1350 | -------------------------------------------------------------------------------- /coqdoc/MSetWithDups.html: -------------------------------------------------------------------------------- 1 | 3 | 4 | 5 | 6 | 7 | MSetWithDups 8 | 9 | 10 | 11 | 12 |
13 | 14 | 16 | 17 |
18 | 19 |

Library MSetWithDups

20 | 21 |
22 | 23 |
24 |
25 | 26 |
27 |

Signature for weak sets which may contain duplicates

28 | 29 | 30 |
31 | 32 | The interface WSetsOn demands that elements returns a list 33 | without duplicates and that the fold function iterates over this 34 | result. Another potential problem is that the function cardinal 35 | is supposed to return the length of the elements list. 36 | 37 |
38 | 39 | Therefore, implementations that store duplicates internally and for 40 | which the fold function would visit elements multiple times are 41 | ruled out. Such implementations might be desirable for performance 42 | reasons, though. One such (sometimes useful) example are unsorted 43 | lists with duplicates. They have a very efficient insert and union 44 | operation. If they are used in such a way that not too many 45 | membership tests happen and that not too many duplicates 46 | accumulate, it might be a very efficient datastructure. 47 | 48 |
49 | 50 | In order to allow efficient weak set implementations that use 51 | duplicates internally, we provide new module types in this 52 | file. There is WSetsOnWithDups, which is a proper subset of 53 | WSetsOn. It just removes the problematic properties of elements 54 | and cardinal. 55 | 56 |
57 | 58 | Since one is of course interested in specifying the cardinality 59 | and in computing a list of elements without duplicates, there is 60 | also an extension WSetsOnWithDupsExtra of WSetsOnWithDups. This 61 | extension introduces a new operation elements_dist, which is a 62 | version of elements without duplicates. This allows to 63 | specify cardinality with respect to elements_dist. 64 | 65 |
66 |
67 | 68 |
69 | Require Import Coq.MSets.MSetInterface.
70 | Require Import ssreflect.
71 | 72 |
73 |
74 | 75 |
76 |

WSetsOnWithDups

77 | 78 | 79 |
80 | 81 | The module type WSetOnWithDups is a proper subset of WSetsOn; 82 | the problematic parameters cardinal_spec and elements_spec2w 83 | are missing. 84 | 85 |
86 | 87 | We use this approach to be as noninvasive as possible. If we had the 88 | liberty to modify the existing MSet library, it might be better to 89 | define WSetsOnWithDups as below and define WSetOn by adding the two 90 | extra parameters. 91 | 92 |
93 |
94 | Module Type WSetsOnWithDups (E : DecidableType).
95 |   Include WOps E.
96 | 97 |
98 |   Parameter In : elt -> t -> Prop.
99 |   Declare Instance In_compat : Proper (E.eq==>eq==>iff) In.
100 | 101 |
102 |   Definition Equal s s´ := forall a : elt, In a s <-> In a s´.
103 |   Definition Subset s s´ := forall a : elt, In a s -> In a s´.
104 |   Definition Empty s := forall a : elt, ~ In a s.
105 |   Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x.
106 |   Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x.
107 | 108 |
109 |   Notation "s [=] t" := (Equal s t) (at level 70, no associativity).
110 |   Notation "s [<=] t" := (Subset s t) (at level 70, no associativity).
111 | 112 |
113 |   Definition eq : t -> t -> Prop := Equal.
114 |   Include IsEq.
115 | 116 |
117 | eq is obviously an equivalence, for subtyping only 118 |
119 |
120 |   Include HasEqDec.
121 | 122 |
123 |   Section Spec.
124 |   Variable s s´: t.
125 |   Variable x y : elt.
126 |   Variable f : elt -> bool.
127 |   Notation compatb := (Proper (E.eq==>Logic.eq)) (only parsing).
128 | 129 |
130 |   Parameter mem_spec : mem x s = true <-> In x s.
131 |   Parameter equal_spec : equal s s´ = true <-> s[=]s´.
132 |   Parameter subset_spec : subset s s´ = true <-> s[<=]s´.
133 |   Parameter empty_spec : Empty empty.
134 |   Parameter is_empty_spec : is_empty s = true <-> Empty s.
135 |   Parameter add_spec : In y (add x s) <-> E.eq y x \/ In y s.
136 |   Parameter remove_spec : In y (remove x s) <-> In y s /\ ~E.eq y x.
137 |   Parameter singleton_spec : In y (singleton x) <-> E.eq y x.
138 |   Parameter union_spec : In x (union s s´) <-> In x s \/ In x s´.
139 |   Parameter inter_spec : In x (inter s s´) <-> In x s /\ In x s´.
140 |   Parameter diff_spec : In x (diff s s´) <-> In x s /\ ~In x s´.
141 |   Parameter fold_spec : forall (A : Type) (i : A) (f : elt -> A -> A),
142 |     fold f s i = fold_left (flip f) (elements s) i.
143 |   Parameter filter_spec : compatb f ->
144 |     (In x (filter f s) <-> In x s /\ f x = true).
145 |   Parameter for_all_spec : compatb f ->
146 |     (for_all f s = true <-> For_all (fun x => f x = true) s).
147 |   Parameter exists_spec : compatb f ->
148 |     (exists_ f s = true <-> Exists (fun x => f x = true) s).
149 |   Parameter partition_spec1 : compatb f ->
150 |     fst (partition f s) [=] filter f s.
151 |   Parameter partition_spec2 : compatb f ->
152 |     snd (partition f s) [=] filter (fun x => negb (f x)) s.
153 |   Parameter elements_spec1 : InA E.eq x (elements s) <-> In x s.
154 |   Parameter choose_spec1 : choose s = Some x -> In x s.
155 |   Parameter choose_spec2 : choose s = None -> Empty s.
156 | 157 |
158 |   End Spec.
159 | 160 |
161 | End WSetsOnWithDups.
162 | 163 |
164 |
165 | 166 |
167 |

WSetsOnWithDupsExtra

168 | 169 | 170 |
171 | 172 | WSetsOnWithDupsExtra introduces elements_dist in order to 173 | specify cardinality and in order to get an operation similar to 174 | the original behavior of elements. 175 |
176 |
177 | Module Type WSetsOnWithDupsExtra (E : DecidableType).
178 |   Include WSetsOnWithDups E.
179 | 180 |
181 |
182 | 183 |
184 | An operation for getting an elements list without duplicates 185 |
186 |
187 |   Parameter elements_dist : t -> list elt.
188 | 189 |
190 |   Parameter elements_dist_spec1 : forall x s, InA E.eq x (elements_dist s) <->
191 |                                               InA E.eq x (elements s).
192 | 193 |
194 |   Parameter elements_dist_spec2w : forall s, NoDupA E.eq (elements_dist s).
195 | 196 |
197 |
198 | 199 |
200 | Cardinality can then be specified with respect to elements_dist. 201 |
202 |
203 |   Parameter cardinal_spec : forall s, cardinal s = length (elements_dist s).
204 | End WSetsOnWithDupsExtra.
205 | 206 |
207 |
208 | 209 |
210 |

WSetOn to WSetsOnWithDupsExtra

211 | 212 | 213 |
214 | 215 | Since WSetsOnWithDupsExtra is morally a weaker version of WSetsOn 216 | that allows the fold operation to visit elements multiple time, we can write then 217 | following conversion. 218 |
219 |
220 | 221 |
222 | Module WSetsOn_TO_WSetsOnWithDupsExtra (E : DecidableType) (W : WSetsOn E) <:
223 |   WSetsOnWithDupsExtra E.
224 | 225 |
226 |   Include W.
227 | 228 |
229 |   Definition elements_dist := W.elements.
230 | 231 |
232 |   Lemma elements_dist_spec1 : forall x s, InA E.eq x (elements_dist s) <->
233 |                                           InA E.eq x (elements s).
234 | 235 |
236 |   Lemma elements_dist_spec2w : forall s, NoDupA E.eq (elements_dist s).
237 | 238 |
239 | End WSetsOn_TO_WSetsOnWithDupsExtra.
240 | 241 |
242 |
243 |
244 | 245 | 248 | 249 |
250 | 251 | 252 | --------------------------------------------------------------------------------