├── src ├── Vellvm │ ├── static.v │ ├── Dominators │ │ ├── _tags │ │ ├── dom_list_tree_wf.v │ │ ├── README │ │ ├── reach.v │ │ ├── dom.sh │ │ ├── dom_list_df.v │ │ ├── pull_iter.v │ │ ├── main.ml │ │ ├── dom_decl.v │ │ ├── README-cpp12 │ │ ├── dom_list_tree.v │ │ └── dom_type.v │ ├── tactics.v │ ├── ott │ │ ├── ott_list.v │ │ ├── ott_list_support.v │ │ ├── ott_list_eq_dec.v │ │ ├── ott_list_repeat.v │ │ ├── ott_list_core.v │ │ ├── ott_list_flat_map.v │ │ ├── ott_list_mem.v │ │ ├── ott_list_nth.v │ │ ├── ott_list_distinct.v │ │ ├── ott_list_base.v │ │ ├── ott_list_takedrop.v │ │ └── ott_list_predicate.v │ ├── trace.v │ ├── datatype_base.v │ ├── README │ ├── vellvm.v │ ├── monad.v │ ├── vellvm_tactics.v │ └── dopsem.v ├── .gitignore ├── Interpreter │ ├── _tags │ └── main.ml └── Parser │ ├── _tags │ └── main.ml ├── .gitignore ├── patch ├── cpdtlib.patch └── metalib.patch ├── scripts ├── clone.sh └── fetch-libs.sh ├── .dir-locals.el ├── Makefile ├── README.md └── Make /src/Vellvm/static.v: -------------------------------------------------------------------------------- 1 | Require Export targetdata_props. 2 | Require Export typings_props. 3 | Require Export genericvalues_props. 4 | -------------------------------------------------------------------------------- /src/.gitignore: -------------------------------------------------------------------------------- 1 | **.vo 2 | **.v.d 3 | **.glob 4 | 5 | /src/Vellvm/syntax_base.v 6 | /src/Vellvm/typing_rules.v 7 | 8 | /lib/* 9 | 10 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | **.vo 2 | **.v.d 3 | **.glob 4 | 5 | /src/Vellvm/syntax_base.v 6 | /src/Vellvm/syntax_rules.v 7 | /src/Vellvm/typing_rules.v 8 | 9 | /lib/* 10 | 11 | Makefile.coq 12 | 13 | -------------------------------------------------------------------------------- /src/Interpreter/_tags: -------------------------------------------------------------------------------- 1 | <*.{byte,native}>: g++, use_llvm, use_llvm_analysis 2 | <*.{byte,native}>: use_llvm_executionengine, use_llvm_target, use_llvm_bitreader, use_llvm_bitwriter 3 | <*.{byte,native}>: use_llvm_scalar_opts, use_bindings 4 | <*.{byte,native}>: use_coqllvm 5 | -------------------------------------------------------------------------------- /src/Vellvm/Dominators/_tags: -------------------------------------------------------------------------------- 1 | <*.{d.byte,byte,native}>: g++, use_llvm, use_llvm_analysis 2 | <*.{d.byte,byte,native}>: use_llvm_executionengine, use_llvm_target, use_llvm_bitreader, use_llvm_bitwriter 3 | <*.{d.byte,byte,native}>: use_llvm_scalar_opts, use_bindings 4 | <*.{d.byte,byte,native}>: use_coqllvm 5 | -------------------------------------------------------------------------------- /src/Parser/_tags: -------------------------------------------------------------------------------- 1 | <*.{d.byte,byte,native}>: g++, use_llvm, use_llvm_analysis 2 | <*.{d.byte,byte,native}>: use_llvm_executionengine, use_llvm_target, use_llvm_bitreader, use_llvm_bitwriter 3 | <*.{d.byte,byte,native}>: use_llvm_scalar_opts, use_bindings 4 | <*.{d.byte,byte,native}>: use_coqllvm, use_eq_tv, use_sub_tv, use_str 5 | -------------------------------------------------------------------------------- /patch/cpdtlib.patch: -------------------------------------------------------------------------------- 1 | diff -ru lib/cpdtlib/CpdtTactics.v lib.patched/cpdtlib/CpdtTactics.v 2 | --- lib/cpdtlib/CpdtTactics.v 2014-02-02 12:48:22.000000000 -0500 3 | +++ lib.patched/cpdtlib/CpdtTactics.v 2014-08-30 00:39:34.506238146 -0400 4 | @@ -214,7 +214,7 @@ 5 | let x := fresh "x" in 6 | remember E as x; simpl in x; dependent destruction x; 7 | try match goal with 8 | - | [ H : _ = E |- _ ] => try rewrite <- H in *; clear H 9 | + | [ H : _ = E |- _ ] => rewrite <- H in *; clear H 10 | end. 11 | 12 | (** Nuke all hypotheses that we can get away with, without invalidating the goal statement. *) 13 | Only in lib/cpdtlib: DepList.v 14 | Only in lib/cpdtlib: LICENSE 15 | Only in lib/cpdtlib: MoreSpecif.v 16 | -------------------------------------------------------------------------------- /src/Vellvm/tactics.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Lists.List. 2 | Require Import Coq.Strings.String. 3 | 4 | Open Scope string_scope. 5 | Open Scope list_scope. 6 | 7 | (** ** Tactic definitions *) 8 | 9 | Tactic Notation "assert_eq" ident(x) constr(v) := 10 | let H := fresh in 11 | assert (x = v) as H by reflexivity; 12 | clear H. 13 | 14 | Tactic Notation "Case_aux" ident(x) constr(name) := 15 | first [ 16 | set (x := name); move x at top 17 | | assert_eq x name 18 | | fail 1 "because we are working on a different case." ]. 19 | 20 | Ltac Case name := Case_aux case name. 21 | Ltac SCase name := Case_aux subcase name. 22 | Ltac SSCase name := Case_aux subsubcase name. 23 | Ltac SSSCase name := Case_aux subsubsubcase name. 24 | Ltac SSSSCase name := Case_aux subsubsubsubcase name. 25 | 26 | -------------------------------------------------------------------------------- /scripts/clone.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | git svn clone https://webdav.seas.upenn.edu/svn/sol/vol --ignore-paths=\ 4 | "^(doc\ 5 | |Vminus\ 6 | |softbound_test\ 7 | |optimizations_test\ 8 | |extralibs\ 9 | |undef_tests\ 10 | |examples\ 11 | |misc\ 12 | |scripts\ 13 | |src/Parser/tvcases\ 14 | |src3.0/Parser/tvcases\ 15 | |src/Interpreter/testcases\ 16 | |src3.0/Interpreter/testcases\ 17 | |src/.metadata\ 18 | |src3.0/.metadata\ 19 | |src/Transforms/log\ 20 | |src3.0/Transforms/log\ 21 | |src/Transforms/testcases\ 22 | |src3.0/Transforms/testcases\ 23 | |src3.0/Vellvm/Dominators/worstcases\ 24 | |src3.0/Vellvm/Dominators/experiments\ 25 | |src3.0/Vellvm/Dominators/log\ 26 | |src3.0/llvm-3.0.src\ 27 | |src/Interpreter/report\ 28 | |src3.0/Interpreter/report\ 29 | |src/Vellvm/GraphBasics\ 30 | |src3.0/Vellvm/GraphBasics\ 31 | |src/Vminus\ 32 | |src3.0/Vminus\ 33 | |src/Extraction\ 34 | |src3.0/Extraction\ 35 | |src/Vellvm/compcert\ 36 | |src3.0/Vellvm/compcert\ 37 | |src3.0/Vellvm/Dominators/cpdt_tactics.v\ 38 | |src3.0/Vellvm/events.v\ 39 | )" 40 | -------------------------------------------------------------------------------- /.dir-locals.el: -------------------------------------------------------------------------------- 1 | ;; Specify coq-load path relative to project root 2 | ((coq-mode . ((eval . (flet ((pre (s) (concat 3 | (locate-dominating-file buffer-file-name 4 | ".dir-locals.el") 5 | s))) 6 | (setq coq-load-path 7 | `(,(pre "src/Vellvm") 8 | ,(pre "src/Vellvm/ott") 9 | ,(pre "src/Vellvm/Dominators") 10 | ,(pre "lib/compcert-1.9") 11 | ,(pre "lib/cpdtlib") 12 | ,(pre "lib/GraphBasics") 13 | ,(pre "lib/metalib-20090714") 14 | ,(pre "lib/Coq-Equations-8.4/src") 15 | (rec ,(pre "lib/Coq-Equations-8.4/theories") "Equations"))))) 16 | (coq-prog-args . ("-emacs-U" 17 | "-impredicative-set"))))) 18 | 19 | -------------------------------------------------------------------------------- /src/Vellvm/Dominators/dom_list_tree_wf.v: -------------------------------------------------------------------------------- 1 | Require Import Metatheory. 2 | Require Import syntax. 3 | Require Import infrastructure. 4 | Require Import dom_tree. 5 | Require Import dom_list. 6 | Require Import typings_props. 7 | Require Import typings. 8 | Import LLVMsyntax. 9 | Import LLVMinfra. 10 | Import LLVMtypings. 11 | 12 | (* Well-formed programs give well-formed dominator trees. *) 13 | Section wf_fdef__create_dom_tree_correct. 14 | 15 | Variable (S:system) (M:module) (f:fdef) (dt:@DTree l) (le:l). 16 | Hypothesis (Hwfdef: wf_fdef S M f) (Huniq: uniqFdef f) 17 | (Hcreate: AlgDom.create_dom_tree f = Some dt) 18 | (Hentry: getEntryLabel f = Some le). 19 | 20 | Lemma wf_fdef__dtree_edge_iff_idom: forall p0 ch0, 21 | is_dtree_edge eq_atom_dec dt p0 ch0 = true <-> 22 | (imm_domination f p0 ch0 /\ reachable f ch0). 23 | Proof. 24 | intros. 25 | eapply AlgDom.dtree_edge_iff_idom; unfold AlgDom.branchs_in_fdef; 26 | intros; eauto using entry_no_preds, branches_in_bound_fdef. 27 | Qed. 28 | 29 | Lemma wf_fdef__create_dom_tree__wf_dtree: 30 | ADProps.wf_dtree (successors f) le eq_atom_dec dt. 31 | Proof. 32 | intros. 33 | eapply AlgDom.create_dom_tree__wf_dtree; unfold AlgDom.branchs_in_fdef; 34 | intros; eauto using entry_no_preds, branches_in_bound_fdef. 35 | Qed. 36 | 37 | End wf_fdef__create_dom_tree_correct. 38 | -------------------------------------------------------------------------------- /src/Vellvm/ott/ott_list.v: -------------------------------------------------------------------------------- 1 | (* A supplemental list library to help ott users *) 2 | 3 | (* Definitions used by ott-generated output *) 4 | Require Export ott_list_core. 5 | 6 | (* Support library (non-list-related content) *) 7 | Require Export ott_list_support. 8 | 9 | (* Supplemental lemmas and tactics about basic functions (length, map, rev) *) 10 | Require Export ott_list_base. 11 | 12 | (* The take and drop functions, and lemmas and tactics about them 13 | (n = take n l ++ drop n l) /\ (length (take n l) = n) *) 14 | Require Export ott_list_takedrop. 15 | 16 | (* Supplemental lemmas about taking the nth element of a list *) 17 | Require Export ott_list_nth. 18 | 19 | (* Lemmas about [In], [list_mem] and [list_minus] *) 20 | Require Export ott_list_mem. 21 | 22 | (* Lemmas about [flat_map] *) 23 | Require Export ott_list_flat_map. 24 | 25 | (* Lemmas and tactics about [Forall_list], [Exists_list], [forall_list] 26 | and [exists_list] *) 27 | Require Export ott_list_predicate. 28 | 29 | (* The repeat function, and lemmas about it 30 | (length (repeat n x) = n) /\ (forall y, In y (repeat n x) -> x = y) *) 31 | Require Export ott_list_repeat. 32 | 33 | (* The [disjoint] function (test that two lists have no common element), 34 | the [all_distinct] function (test that a list has no repeated element), 35 | and lemmas about them *) 36 | Require Export ott_list_distinct. 37 | -------------------------------------------------------------------------------- /src/Vellvm/ott/ott_list_support.v: -------------------------------------------------------------------------------- 1 | (* Additional definitions and lemmas on lists *) 2 | 3 | Require Import Arith. 4 | Require Import Omega. 5 | 6 | 7 | 8 | (*** Support definitions and lemmas ***) 9 | 10 | Module List_lib_Arith. 11 | 12 | Lemma le_lt_dec_S : 13 | forall n m A (x y:A), 14 | (if le_lt_dec (S n) (S m) then x else y) = 15 | (if le_lt_dec n m then x else y). 16 | Proof. 17 | intros. destruct (le_lt_dec n m); destruct (le_lt_dec (S n) (S m)). 18 | reflexivity. elimtype False; omega. elimtype False; omega. reflexivity. 19 | Qed. 20 | 21 | End List_lib_Arith. 22 | 23 | 24 | 25 | Section functions. 26 | Set Implicit Arguments. 27 | Variables A B C D : Set. 28 | Definition compose (g:B->C) (f:A->B) x := g (f x). 29 | Definition compose2 (h:B->C->D) (f:A->B) (g:A->C) x y := h (f x) (g y). 30 | End functions. 31 | Hint Unfold compose compose2. 32 | 33 | 34 | 35 | Section option. 36 | Set Implicit Arguments. 37 | Variables A B : Set. 38 | 39 | Definition map_option (f:A->B) (xo:option A) : option B := 40 | match xo with 41 | | Some x => Some (f x) 42 | | None => None 43 | end. 44 | Definition map_error := map_option. 45 | 46 | Definition fold_option (f:A->B->B) (xo:option A) (y:B) : B := 47 | match xo with 48 | | Some x => f x y 49 | | None => y 50 | end. 51 | Definition fold_error := fold_option. 52 | End option. 53 | Hint Unfold map_option map_error fold_option fold_error. 54 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | OTT ?= ott 2 | 3 | COQLIBS=-I src/Vellvm -I src/Vellvm/ott -I src/Vellvm/Dominators \ 4 | -I lib/GraphBasics -I lib/compcert-1.9 -I lib/cpdtlib -I lib/metalib-20090714 \ 5 | -R lib/Coq-Equations-8.4/theories Equations -I lib/Coq-Equations-8.4/src 6 | MAKECOQ=make -f Makefile.coq COQLIBS="$(COQLIBS)" 7 | 8 | all: theories 9 | 10 | libs: lib/Coq-Equations-8.4 lib/metalib-20090714 11 | make -C lib/Coq-Equations-8.4 12 | make -C lib/metalib-20090714 13 | 14 | depend: Makefile.coq src/Vellvm/syntax_base.v src/Vellvm/typing_rules.v 15 | +$(MAKECOQ) depend 16 | 17 | theories: Makefile.coq src/Vellvm/syntax_base.v src/Vellvm/typing_rules.v 18 | +$(MAKECOQ) 19 | 20 | Makefile.coq: Make 21 | coq_makefile -f Make -o Makefile.coq 22 | 23 | %.vo: Makefile.coq src/Vellvm/syntax_base.v src/Vellvm/typing_rules.v 24 | +$(MAKECOQ) "$@" 25 | 26 | clean: 27 | rm -f src/Vellvm/syntax_base.v src/Vellvm/typing_rules.v 28 | make -f Makefile.coq clean 29 | 30 | src/Vellvm/syntax_base.v: src/Vellvm/syntax_base.ott 31 | cd src/Vellvm && \ 32 | $(OTT) -coq_expand_list_types false -i syntax_base.ott -o syntax_base.v 33 | 34 | src/Vellvm/typing_rules.v: src/Vellvm/syntax_base.ott src/Vellvm/typing_rules.ott 35 | cd src/Vellvm && \ 36 | $(OTT) -merge false -coq_expand_list_types false \ 37 | -i syntax_base.ott -o _tmp_syntax_base.v \ 38 | -i typing_rules.ott -o typing_rules.v && \ 39 | rm _tmp_syntax_base.v 40 | 41 | .PHONY: all clean theories libs 42 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Vellvm-Legacy 2 | 3 | This is a "sanitized" copy of the original Vellvm repo, not including 4 | publication sources, experiment results, and code, test cases, and benchmarks 5 | that we don't have the right to redistribute. Sources for the required modified 6 | third-party libraries have been removed from the history instead provided via 7 | patches. 8 | 9 | The modified OCaml bindings used for the Parser, Interpreter, and 10 | verified instrumentation/optimization passes have diverged significantly from 11 | what is availble with newer versions of LLVM and will not compile. Neither the 12 | bindings, SoftBound or Vmem2reg passes are currently included in the 13 | repository. It is possible to extract the interpreter, but there is currently no 14 | way to parse LLVM bitcode into a Vellvm AST. 15 | 16 | ## Dependencies 17 | 18 | - camlp4 (For equations plugin -- no longer included with OCaml as of 4.02) 19 | - Coq 8.4pl4, configured with `-usecamlp4` option 20 | - [ott 0.24](http://www.cl.cam.ac.uk/~pes20/ott/) 21 | 22 | ## Building 23 | 24 | 1. In the top-level directory of the repo, run `scripts/fetch-libs.sh` to 25 | download all third-party sources into lib/src, extract, and apply patches. 26 | 2. Run `make libs` to compile the Equations plugin and the metatheory 27 | library. If you get an error about grammar.cma, make sure your version of coq 28 | was compiled with the same version of OCaml in your path. 29 | 3. Run `make` to compile the Vellvm theories. 30 | -------------------------------------------------------------------------------- /src/Vellvm/trace.v: -------------------------------------------------------------------------------- 1 | (***********************************************************) 2 | (** trace and Trace *) 3 | 4 | Record Event : Set := mkEvent { }. 5 | 6 | Inductive trace : Set := 7 | | trace_nil : trace 8 | | trace_cons : Event -> trace -> trace 9 | . 10 | 11 | CoInductive Trace : Set := 12 | | Trace_cons : Event -> Trace -> Trace 13 | . 14 | 15 | Fixpoint trace_app (tr1 tr2:trace) : trace := 16 | match tr1 with 17 | | trace_nil => tr2 18 | | trace_cons e tr1' => trace_cons e (trace_app tr1' tr2) 19 | end. 20 | 21 | Fixpoint Trace_app (tr1:trace) (tr2:Trace) : Trace := 22 | match tr1 with 23 | | trace_nil => tr2 24 | | trace_cons e tr1' => Trace_cons e (Trace_app tr1' tr2) 25 | end. 26 | 27 | Lemma trace_app_nil__eq__trace : forall tr, 28 | trace_app tr trace_nil = tr. 29 | Proof. 30 | induction tr; simpl; auto. 31 | rewrite IHtr. auto. 32 | Qed. 33 | 34 | Lemma nil_app_trace__eq__trace : forall tr, 35 | trace_app trace_nil tr = tr. 36 | Proof. auto. Qed. 37 | 38 | Lemma trace_app_commute : forall tr1 tr2 tr3, 39 | trace_app tr1 (trace_app tr2 tr3) = trace_app (trace_app tr1 tr2) tr3. 40 | Proof. 41 | induction tr1; intros; simpl; auto. 42 | rewrite IHtr1. auto. 43 | Qed. 44 | 45 | Lemma nil_app_Trace__eq__Trace : forall tr, 46 | Trace_app trace_nil tr = tr. 47 | Proof. auto. Qed. 48 | 49 | Lemma Trace_app_commute : forall tr1 tr2 tr3, 50 | Trace_app tr1 (Trace_app tr2 tr3) = Trace_app (trace_app tr1 tr2) tr3. 51 | Proof. 52 | induction tr1; intros; simpl; auto. 53 | rewrite IHtr1. auto. 54 | Qed. 55 | 56 | -------------------------------------------------------------------------------- /src/Vellvm/Dominators/README: -------------------------------------------------------------------------------- 1 | The directory includes source code for the CPP12 submission. 2 | 3 | 1) cfg.v 4 | Basic definitions and properties of control-flow-graphs: vertices, arcs, 5 | successors, reachability and dominance. 6 | 7 | 2) reach.v 8 | Metatheory of reachablity. 9 | 10 | 3) dom_decl.v 11 | Metatheory of dominance. 12 | 13 | 4) dom_type.v 14 | The specification of dominance algorithm. 15 | 16 | 5) dom_set.v 17 | The Correctness of the AC algorithm. 18 | 19 | 6) dom_libs.v 20 | Definitions and properties used by the CHK algorithm. 21 | 22 | 7) dfs.v 23 | Depth-first-search. 24 | 25 | 7) push_iter.v 26 | The low-level design and metatheory of CHK algorithm. 27 | 28 | 8) dom_list.v 29 | The Correctness of the CHK algorithm. 30 | 31 | 9) dom_tree.v 32 | Basic definitions and properties of dominator trees constructions. 33 | 34 | 10) dom_list_tree.v 35 | The correctness of CHK-tree algorithm. 36 | 37 | 11) dom_set_tree.v 38 | The implementation of AC-tree algorithm. Note: we did not prove the correct 39 | of AC-tree fully. We implemented the algorithm to compare its performance 40 | with CHK-tree. 41 | 42 | Misc: 43 | 1) pull_iter.v 44 | This is an implementation of Kildall that, at each iteration, pulls 45 | information from the predeccessors of a node to the node. The Kildall 46 | algorithm we use push information from a node to its successors at each 47 | iteration. We implemented pull_iter.v to evaluate some design trade-offs of 48 | Kildall, do not present pull_iter.v in our paper submission. 49 | 50 | 2) cpdt_tactics.v 51 | Tactics copied from Adam Chlipala's book. 52 | 53 | -------------------------------------------------------------------------------- /scripts/fetch-libs.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -e 3 | 4 | LIB=./lib 5 | SRC=./src 6 | if [[ $OSTYPE =~ "darwin" ]]; then 7 | MKTEMP=gmktemp 8 | else 9 | MKTEMP=mktemp 10 | fi 11 | 12 | mkdir -p $LIB 13 | cd $LIB 14 | mkdir -p $SRC 15 | 16 | LIBS="https://github.com/mattam82/Coq-Equations/archive/8.4.zip,Coq-Equations-8.4.zip \ 17 | http://www.cis.upenn.edu/~plclub/metalib/dists/metalib-20090714.zip,metalib-20090714.zip \ 18 | http://adam.chlipala.net/cpdt/cpdtlib.tgz,cpdtlib.tgz \ 19 | http://coq.inria.fr/distrib/8.2/contribs/files/GraphBasics.tar.gz,GraphBasics.tgz \ 20 | http://compcert.inria.fr/release/compcert-1.9.tgz,compcert-1.9.tgz" 21 | 22 | prep_Coq-Equations-8.4() { 23 | unzip -qqo $SRC/$1 24 | patch -p1 < ../patch/equations.patch 25 | } 26 | 27 | prep_metalib-20090714() { 28 | unzip -qqo $SRC/$1 29 | patch -p1 < ../patch/metalib.patch 30 | } 31 | 32 | prep_cpdtlib() { 33 | tar xzf $SRC/$1 34 | patch -p1 < ../patch/cpdtlib.patch 35 | } 36 | 37 | prep_GraphBasics() { 38 | tar xzf $SRC/$1 39 | patch -p1 < ../patch/graphbasics.patch 40 | } 41 | 42 | prep_compcert-1.9() { 43 | TMP=$($MKTEMP -dp.) 44 | tar xzf $SRC/$1 45 | cp compcert-1.9/common/{AST,Errors,Memdata,Memory,Memtype,Values}.v \ 46 | compcert-1.9/lib/{Axioms,Coqlib,Floats,Integers,Intv,Iteration,Lattice,Maps,Ordered}.v \ 47 | compcert-1.9/backend/Kildall.v \ 48 | $TMP 49 | rm -r compcert-1.9 50 | mv $TMP compcert-1.9 51 | patch -p1 < ../patch/compcert.patch 52 | } 53 | 54 | for p in $LIBS; do 55 | u=${p%,*}; f=${p#*,} 56 | echo -n "Downloading $SRC/$f" 57 | if [ -f $SRC/$f ]; then 58 | echo " ... archive exists, skipping" 59 | else 60 | echo; curl -L# "$u" -o $SRC/$f 61 | fi 62 | 63 | d=${f%.*} 64 | echo -n "Extracting to $d" 65 | if [ -d $d ]; then 66 | echo " ... target dir exists, skipping" 67 | else 68 | eval prep_$d $f 69 | fi 70 | done 71 | 72 | echo "Done!" 73 | -------------------------------------------------------------------------------- /src/Vellvm/ott/ott_list_eq_dec.v: -------------------------------------------------------------------------------- 1 | (* Helper lemmas for {{coq-equality}} homs. *) 2 | 3 | Require Import List. 4 | Set Implicit Arguments. 5 | 6 | 7 | 8 | (* Help construct equality decision procedures (for {{coq-equality}} 9 | homs). We provide a transparent version of [List.list_eq_dec] from 10 | the Coq standard library. This transparent version is needed for 11 | types that contain a recursive call inside a list. Note that at the 12 | time of writing ott does not generate a workable proof in this case: 13 | you have to set up the induction manually and call [list_eq_dec] on 14 | your own (TODO: point to an example --- it's systematic but not easy). *) 15 | Lemma list_eq_dec : 16 | forall (A:Set) (* should be Type in coq >= V8.1 *) 17 | (eq_dec : forall (x y:A), {x = y} + {x <> y}), 18 | forall (x y:list A), {x = y} + {x <> y}. 19 | Proof. 20 | induction x as [| a l IHl]; destruct y as [| a0 l0]; auto with datatypes. 21 | destruct (eq_dec a a0) as [e| e]. 22 | destruct (IHl l0) as [e'| e']. 23 | left; rewrite e; rewrite e'; trivial. 24 | right; red in |- *; intro. 25 | apply e'; injection H; trivial. 26 | right; red in |- *; intro. 27 | apply e; injection H; trivial. 28 | Defined. 29 | 30 | (* While the Coq built-in "decide equality" tactic can decide equality on 31 | pairs on its own, adding the following lemmas in the hint database helps 32 | when lists of pairs are involved. *) 33 | Lemma pair_eq_dec : 34 | forall (A B:Set) (* should be Type in coq >= V8.1 *) 35 | (eqA:forall a a0:A, {a=a0}+{a<>a0}) 36 | (eqB:forall b b0:B, {b=b0}+{b<>b0}) 37 | (x y:A*B), {x=y}+{x<>y}. 38 | Proof. intros until 2; decide equality; auto. Qed. 39 | Hint Resolve pair_eq_dec : ott_coq_equality. 40 | 41 | (* With the following hint, the default {{coq-equality}} proof handles 42 | grammar types containing lists provided that no recursive call appears 43 | in a list. *) 44 | Hint Resolve list_eq_dec : ott_coq_equality. 45 | 46 | -------------------------------------------------------------------------------- /src/Vellvm/Dominators/reach.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Require Import ListSet. 3 | Require Import Coqlib. 4 | Require Import Metatheory. 5 | Require Import Maps. 6 | Require Import cfg. 7 | Require Import Dipaths. 8 | 9 | Require Import syntax. 10 | Require Import infrastructure. 11 | Require Import infrastructure_props. 12 | Import LLVMsyntax. 13 | Import LLVMinfra. 14 | 15 | (* This file proves more properties of reachability. *) 16 | Lemma reachable_has_entry: forall f l1 (Hrd: reachable f l1), 17 | getEntryBlock f <> None. 18 | Proof. 19 | intros. 20 | unfold reachable in Hrd. 21 | intro EQ. rewrite EQ in Hrd. inv Hrd. 22 | Qed. 23 | 24 | Lemma reachable_dec: forall (f:fdef) (l1:l), reachable f l1 \/ ~ reachable f l1. 25 | Proof. 26 | unfold reachable. 27 | intros. 28 | destruct (getEntryBlock f) as [[]|]. 29 | apply ACfg.reachable_dec. 30 | right. intro H. inv H. 31 | Qed. 32 | 33 | Lemma reachable_entrypoint: 34 | forall (f:fdef) l0 s0, 35 | getEntryBlock f = Some (l0, s0) -> 36 | reachable f l0. 37 | Proof. 38 | intros f l0 s0 Hentry. unfold reachable. 39 | rewrite Hentry. exists V_nil. exists A_nil. apply DW_null. 40 | eapply entry_in_vertexes; eauto. 41 | Qed. 42 | 43 | Module DecRD. 44 | 45 | Section RdSucc. 46 | 47 | Variable f:fdef. 48 | 49 | Lemma reachable_successors: 50 | forall l0 cs ps tmn l1 (Hinvx: vertexes_fdef f (index l1)), 51 | uniqFdef f -> 52 | blockInFdefB (l0, stmts_intro cs ps tmn) f -> 53 | In l1 (successors_terminator tmn) -> 54 | reachable f l0 -> 55 | reachable f l1. 56 | Proof. 57 | intros l0 cs ps tmn l1 Hinvx HuniqF HbInF Hin. 58 | unfold reachable. intro Hreach. 59 | remember (getEntryBlock f) as R. 60 | destruct R; auto. 61 | destruct b as [le ? ? ?]. 62 | destruct Hreach as [vl [al Hreach]]. 63 | exists (index l0::vl). exists (A_ends (index l1) (index l0)::al). 64 | apply DW_step; auto. 65 | eapply successor_in_arcs; eauto. 66 | Qed. 67 | 68 | End RdSucc. 69 | 70 | End DecRD. 71 | 72 | -------------------------------------------------------------------------------- /src/Vellvm/ott/ott_list_repeat.v: -------------------------------------------------------------------------------- 1 | (*** Constant list ***) 2 | 3 | Require Import Arith. 4 | Require Import List. 5 | Require Import Omega. 6 | Require Import ott_list_support. 7 | Require Import ott_list_base. 8 | Require Import ott_list_nth. 9 | Import List_lib_Arith. 10 | 11 | 12 | 13 | Section Lists. 14 | 15 | Variables A B C : Set. 16 | Implicit Types x : A. 17 | Implicit Types y : B. 18 | Implicit Types z : C. 19 | Implicit Types xs l : list A. 20 | Implicit Types ys : list B. 21 | Implicit Types zs : list C. 22 | Implicit Types f : A -> B. 23 | Implicit Types g : B -> C. 24 | Implicit Types m n : nat. 25 | Set Implicit Arguments. 26 | 27 | Fixpoint repeat n x {struct n} : list A := 28 | match n with 29 | | 0 => nil 30 | | S m => x :: repeat m x 31 | end. 32 | 33 | Lemma repeat_length : forall n x, length (repeat n x) = n. 34 | Proof. 35 | induction n; intros. reflexivity. simpl. rewrite IHn. reflexivity. 36 | Qed. 37 | 38 | Lemma repeat_app : 39 | forall n m x, repeat (n + m) x = repeat n x ++ repeat m x. 40 | Proof. 41 | induction n; simpl; intros. reflexivity. rewrite IHn. reflexivity. 42 | Qed. 43 | 44 | Lemma repeat_S : forall n x, repeat (S n) x = repeat n x ++ x::nil. 45 | Proof. 46 | intros. replace (S n) with (n+1). 2: omega. 47 | rewrite repeat_app. reflexivity. 48 | Qed. 49 | 50 | Lemma nth_error_repeat : 51 | forall m n x, 52 | nth_error (repeat n x) m = if le_lt_dec n m then error else value x. 53 | Proof. 54 | induction m; destruct n; intros; try reflexivity. 55 | simpl repeat. simpl nth_error. rewrite IHm. 56 | symmetry. apply le_lt_dec_S. 57 | Qed. 58 | 59 | Lemma nth_repeat : 60 | forall m n x, 61 | nth m (repeat n x) x = x. 62 | Proof. 63 | induction m; destruct n; intros; try reflexivity. 64 | simpl. rewrite IHm. reflexivity. 65 | Qed. 66 | 67 | Lemma nth_safe_repeat : 68 | forall m n x H, 69 | nth_safe (repeat n x) m H = x. 70 | Proof. 71 | intros. assert (value (nth_safe (repeat n x) m H) = value x). 72 | rewrite nth_safe_eq_nth_error. rewrite nth_error_repeat. 73 | rewrite repeat_length in H. 74 | destruct (le_lt_dec n m). elimtype False; omega. reflexivity. 75 | injection H0. tauto. 76 | Qed. 77 | 78 | End Lists. 79 | 80 | 81 | 82 | Hint Rewrite repeat_length repeat_app repeat_S : lists. 83 | Hint Rewrite nth_error_repeat nth_repeat nth_safe_repeat : lists. 84 | -------------------------------------------------------------------------------- /src/Vellvm/datatype_base.v: -------------------------------------------------------------------------------- 1 | Require Import ZArith. 2 | Require Import Coqlib. 3 | Require Import Floats. 4 | 5 | (* This file defines the data types for defining syntax. *) 6 | 7 | Local Open Scope nat_scope. 8 | 9 | Module Size. 10 | 11 | Definition t := nat. 12 | Definition dec : forall x y : t, {x=y} + {x<>y} := eq_nat_dec. 13 | Definition Zero : t := 0. 14 | Definition One : t := 1. 15 | Definition Two : t := 2. 16 | Definition Four : t := 4. 17 | Definition Eight : t := 8. 18 | Definition Sixteen : t := 16. 19 | Definition ThirtyTwo : t := 32. 20 | Definition SixtyFour : t := 64. 21 | Definition from_nat (i:nat) : t := i. 22 | Definition to_nat (i:t) : nat := i. 23 | Definition to_Z (i:t) : Z := Z_of_nat i. 24 | Definition from_Z (i:Z) : t := nat_of_Z i. 25 | Definition add (a b:t) : t := (a + b). 26 | Definition sub (a b:t) : t := (a - b). 27 | Definition mul (a b:t) : t := (a * b). 28 | Definition div (a b:t) : t := nat_of_Z ((Z_of_nat a) / (Z_of_nat b)). 29 | Definition gt (a b:t) : Prop := (a > b). 30 | Definition lt (a b:t) : Prop := (a < b). 31 | 32 | End Size. 33 | 34 | Module Align. 35 | 36 | Definition t := nat. 37 | Definition dec : forall x y : t, {x=y} + {x<>y} := eq_nat_dec. 38 | Definition Zero : t := 0. 39 | Definition One : t := 1. 40 | Definition Two : t := 2. 41 | Definition Four : t := 4. 42 | Definition Eight : t := 8. 43 | Definition Sixteen : t := 16. 44 | Definition ThirtyTwo : t := 32. 45 | Definition SixtyFour : t := 64. 46 | Definition from_nat (i:nat) : t := i. 47 | Definition to_nat (i:t) : nat := i. 48 | Definition to_Z (i:t) : Z := Z_of_nat i. 49 | Definition from_Z (i:Z) : t := nat_of_Z i. 50 | Definition add (a b:t) : t := (a + b). 51 | Definition sub (a b:t) : t := (a - b). 52 | Definition mul (a b:t) : t := (a * b). 53 | Definition div (a b:t) : t := nat_of_Z ((Z_of_nat a) / (Z_of_nat b)). 54 | Definition gt (a b:t) : Prop := (a > b). 55 | Definition lt (a b:t) : Prop := (a < b). 56 | 57 | End Align. 58 | 59 | Module INTEGER. 60 | 61 | Definition t := Z. 62 | Definition dec : forall x y : t, {x=y} + {x<>y} := zeq. 63 | Definition to_nat (i:t) : nat := nat_of_Z i. 64 | Definition to_Z (i:t) : Z := i. 65 | Definition of_Z (bitwidth:Z) (v:Z) (is_signed:bool) : t := v. 66 | 67 | End INTEGER. 68 | 69 | Module FLOAT. 70 | 71 | Definition t := float. 72 | Definition dec : forall x y : t, {x=y} + {x<>y} := Float.eq_dec. 73 | (* Definition Zero : t := Float.zero. *) 74 | 75 | End FLOAT. 76 | -------------------------------------------------------------------------------- /src/Parser/main.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Llvm 3 | 4 | let debug = false 5 | 6 | let metadata_to_file (md:Sub_tv_infer.flnbeps) (addr:Sub_tv_infer.fabes) 7 | (fn:string): unit = 8 | let fo = open_out_gen [Open_creat;Open_trunc;Open_wronly] 0o666 fn in 9 | List.iter (fun (fid, lnbeps) -> 10 | List.iter (fun (lb, nbeps) -> 11 | List.iter (fun (i, beps) -> 12 | List.iter (fun (((b, e), p),im) -> 13 | output_string fo (Printf.sprintf "%s %s %i %s %s %s %b\n" fid lb 14 | (Camlcoq.camlint_of_nat i) b e p im) 15 | ) beps 16 | ) nbeps 17 | ) lnbeps 18 | ) md; 19 | List.iter (fun (fid, abes) -> 20 | List.iter (fun (ab, ae) -> 21 | output_string fo (Printf.sprintf "%s entry 0 %s %s -1 true\n" fid ab ae) 22 | ) abes 23 | ) addr; 24 | close_out fo 25 | 26 | let main in_filename out_filename = 27 | let ic = create_context () in 28 | let imbuf = MemoryBuffer.of_file in_filename in 29 | let im = Llvm_bitreader.parse_bitcode ic imbuf in 30 | let ist = SlotTracker.create_of_module im in 31 | 32 | (* dump_module im; *) 33 | (* Llvm_pretty_printer.travel_module ist im; *) 34 | let coqim = Llvm2coq.translate_module debug ist im in 35 | (* Coq_pretty_printer.travel_module coqim; *) 36 | 37 | let oc = create_context () in 38 | let ombuf = MemoryBuffer.of_file out_filename in 39 | let om = Llvm_bitreader.parse_bitcode oc ombuf in 40 | let ost = SlotTracker.create_of_module om in 41 | 42 | let coqom = Llvm2coq.translate_module debug ost om in 43 | 44 | (* eprintf "EqTV=%b\n" (Eq_tv.tv_module coqim coqom); *) 45 | 46 | let sbom = Sub_tv_def.SBsyntax.of_llvm_module coqom in 47 | let md = Sub_tv_infer.metadata_from_module sbom 1000 1000 in 48 | let addr = Sub_tv_infer.addrofbe_from_module sbom in 49 | metadata_to_file md addr "metadata.db"; 50 | eprintf "Meta=%b SubTV=%b RSubTV=%b MTV=%b\n" 51 | (Sub_tv_infer.validate_metadata_from_module sbom md) 52 | (Sub_tv.tv_module coqim sbom) (Sub_tv.rtv_module coqim sbom) 53 | (Sub_tv.mtv_module coqim sbom); 54 | 55 | (* Coq2llvm.translate_module coqom; *) 56 | 57 | (* write the module to a file *) 58 | (* if not (Llvm_bitwriter.write_bitcode_file m out_filename) then exit 1; *) 59 | 60 | SlotTracker.dispose ist; 61 | SlotTracker.dispose ost; 62 | dispose_module im; 63 | dispose_module om 64 | 65 | let () = match Sys.argv with 66 | | [| _; in_filename; out_filename |] -> main in_filename out_filename 67 | | _ -> main "Input.bc" "Output.bc" 68 | 69 | -------------------------------------------------------------------------------- /src/Vellvm/README: -------------------------------------------------------------------------------- 1 | 2 | analysis.v : Domination/reachability analysis 3 | 4 | datatype_base.v : Primitive data type used by syntax_base.ott 5 | 6 | dopsem.v : A deterministic instance of Opsem. 7 | 8 | events.v : Events and traces. 9 | 10 | external_intrinsics.v : The semantics of external functions and intrinsics. 11 | 12 | genericvalues.v : Representations of run-time values used in the 13 | operational semantics, and the LLVM memory model, which is actually a wrapper of 14 | the CompCert memory model, with conversion between LLVM datatypes and datatypes 15 | that CompCert memory model can handle. 16 | 17 | genericvalues_inject.v : Simulation between generic values. 18 | 19 | genericvalues_props.v : Other properties of generic values. 20 | 21 | infrastructure.v : Operations over LLVM IR, such as, returning types and 22 | operands of an instruction, classifying instructions, traversing functions, 23 | checking if an instruction dominates others, building explicit CFGs, ... 24 | 25 | infrastructure_props.v : Equivalence over types, instructions, and other 26 | components, uniqueness of IDs, inclusion between functions and modules, ... 27 | 28 | interpreter.v : An interpreter that is consistent with small-step 29 | deterministic operational semantics. 30 | 31 | memory_props.v : More memory properties than Vellvm/compcert 32 | 33 | memory_sim.v : More memory simulation relations than Vellvm/compcert 34 | 35 | ndopsem.v : A non-deterministic instance of Opsem. 36 | 37 | opsem.v : A generic semantics (small-step/big-step) that can be 38 | instantiated as either a deterministic version or a non-deterministic version. 39 | 40 | opsem_dom.v : Dynamic properties for SSA 41 | 42 | opsem_inst.v : Deterministic instances are included by 43 | non-deterministic instances. 44 | 45 | opsem_props.v : Other properties of operational semantics 46 | 47 | opsem_wf.v : Progress and preservation of operational semantics 48 | 49 | program_sim.v : Program refinement 50 | 51 | static.v : The main lib of typing rules and properties 52 | 53 | syntax.v : The main lib of syntax definitions 54 | 55 | syntax_base.ott : The definitions of LLVM IR in Ott 56 | 57 | targetdata.v : Calculating bitsize, alignment, padding information 58 | in terms of user-defined data layout in IR. 59 | 60 | targetdata_props.v : Properties of data layout 61 | 62 | typing_rules.ott : LLVM IR typings 63 | 64 | typings.v : The main lib of typing rules. 65 | 66 | typings_props.v : Properties of typing rules. 67 | 68 | util.v : Facts of lists 69 | 70 | vellvm.v : The main lib of the Vellvm formalization. 71 | 72 | vellvm_tactics.v : Tacticals 73 | -------------------------------------------------------------------------------- /src/Vellvm/ott/ott_list_core.v: -------------------------------------------------------------------------------- 1 | (* Definitions that are used by ott-generated output (when using non-expanded lists) *) 2 | 3 | Require Import Bool. 4 | Require Import List. 5 | Set Implicit Arguments. 6 | 7 | 8 | 9 | Section list_predicates. 10 | Variable (A : Set). (* should be Type in coq >= V8.1 *) 11 | 12 | (* Test whether a predicate [p] holds for every element of a list [l]. *) 13 | Definition forall_list (p:A->bool) (l:list A) := 14 | fold_left (fun b (z:A) => b && p z) l true. 15 | 16 | (* Test whether a predicate [p] holds for some element of a list [l]. *) 17 | Definition exists_list (p:A->bool) (l:list A) := 18 | fold_left (fun b (z:A) => b || p z) l false. 19 | 20 | (* Assert that a property holds for every element of a list *) 21 | Inductive Forall_list (P:A->Prop) : list A -> Prop := 22 | | Forall_nil : Forall_list P nil 23 | | Forall_cons : 24 | forall x l, P x -> Forall_list P l -> Forall_list P (x::l). 25 | (* Assert that a property holds for some element of a list *) 26 | Inductive Exists_list (P:A->Prop) : list A -> Prop := 27 | | Exists_head : forall x l, P x -> Exists_list P (x::l) 28 | | Exists_tail : forall x l, Exists_list P l -> Exists_list P (x::l). 29 | 30 | End list_predicates. 31 | Hint Constructors Forall_list Exists_list. 32 | 33 | 34 | 35 | Section list_mem. 36 | (* Functions about membership in a list, with equality between a list 37 | element and a potential member being decided by [eq_dec]. *) 38 | Variable (A : Set). (* should be Type in coq >= V8.1 *) 39 | Variable (eq_dec : forall (a b:A), {a=b} + {a<>b}). 40 | 41 | (* Test whether [x] appears in [l]. *) 42 | Fixpoint list_mem (x:A) (l:list A) {struct l} : bool := 43 | match l with 44 | | nil => false 45 | | cons h t => if eq_dec h x then true else list_mem x t 46 | end. 47 | 48 | (* Remove any element of [l1] that is present in [l2]. *) 49 | Fixpoint list_minus (l1 l2:list A) {struct l1} : list A := 50 | match l1 with 51 | | nil => nil 52 | | cons h t => 53 | if (list_mem h l2) then list_minus t l2 else cons h (list_minus t l2) 54 | end. 55 | End list_mem. 56 | 57 | 58 | 59 | Section Flat_map_definition. 60 | Variables (A B : Set). (* should be Type in coq >= V8.1 *) 61 | Variable (f : A -> list B). 62 | (* This definition is almost the same as the one in the standard library of 63 | Coq V8.0 or V8.1. The difference is that this version has the shape 64 | fun A B f => (fix flat_map l := _) 65 | while the standard library has 66 | fun A B => (fix flat_map f l := _) 67 | Our version has the advantage of making recursive definitions such as 68 | fix foo x := match x with ... | List xs => flat_map foo xs end 69 | well-founded. 70 | *) 71 | Fixpoint flat_map (l:list A) {struct l} : list B := 72 | match l with 73 | | nil => nil 74 | | cons x t => (f x) ++ (flat_map t) 75 | end. 76 | End Flat_map_definition. 77 | 78 | 79 | 80 | (* Provide helper lemmas for {{coq-equality}} homs. *) 81 | Require Export ott_list_eq_dec. 82 | -------------------------------------------------------------------------------- /src/Vellvm/Dominators/dom.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | DOM=~/SVN/sol/vol/src3.0/_build/Vellvm/Dominators/main.native 4 | OC_DIR=../../Transforms/testcases/olden-ccured/ 5 | OC_CASES="bh bisort em3d health mst perimeter power treeadd tsp" 6 | S95_DIR=../../Transforms/testcases/spec95-ccured/ 7 | S95_CASES="129.compress 099.go 130.li 132.ijpeg" 8 | S00_DIR=../../../softbound_test/spec2k/ 9 | S00_CASES="164.gzip/src/obj/zjzzjz/llvm-mem2reg-test/spec2k-gzip-prefix.bc 10 | 175.vpr/src/obj/zjzzjz/llvm-mem2reg-test/spec2k-vpr-prefix.bc 11 | 177.mesa/src/obj/zjzzjz/llvm-mem2reg-test/spec2k-mesa-prefix.bc 12 | 179.art/src/obj/zjzzjz/llvm-mem2reg-test/spec2k-art-prefix.bc 13 | 188.ammp/src/obj/zjzzjz/llvm-mem2reg-test/spec2k-ammp-prefix.bc 14 | 183.equake-modified/src/obj/zjzzjz/llvm-mem2reg-test/spec2k-equake-modified-prefix.bc 15 | 256.bzip2/src/obj/zjzzjz/llvm-mem2reg-test/spec2k-bzip2-prefix.bc 16 | 197.parser/src/obj/zjzzjz/llvm-mem2reg-test/spec2k-parser-prefix.bc 17 | 300.twolf/src/obj/zjzzjz/llvm-mem2reg-test/spec2k-twolf-prefix.bc" 18 | # 186.crafty: "InlineAsmVal: Not_Supported" 19 | S06_DIR=../../../softbound_test/spec2k6/ 20 | S06_CASES="401.bzip2/src/obj/zjzzjz/llvm-mem2reg-test/spec2k6-bzip2-prefix.bc 21 | 429.mcf/src/obj/zjzzjz/llvm-mem2reg-test/spec2k6-mcf-prefix.bc 22 | 456.hmmer/src/obj/zjzzjz/llvm-mem2reg-test/spec2k6-hmmer-prefix.bc 23 | 462.libquantum/src/obj/zjzzjz/llvm-mem2reg-test/spec2k6-libquantum-prefix.bc 24 | 470.lbm/src/obj/zjzzjz/llvm-mem2reg-test/spec2k6-lbm-prefix.bc 25 | 433.milc/src/obj/zjzzjz/llvm-mem2reg-test/spec2k6-milc-prefix.bc 26 | 458.sjeng/src/obj/zjzzjz/llvm-mem2reg-test/spec2k6-sjeng-prefix.bc 27 | 464.h264ref/src/obj/zjzzjz/llvm-mem2reg-test/spec2k6-h264-prefix.bc" 28 | # 403.gcc/src/obj/zjzzjz/llvm-mem2reg-test/spec2k6-gcc-prefix.bc: slow 29 | WORST_DIR=./worstcases/ 30 | WORST_CASES="itworst_large.bc idfsquad_large.bc ibfsquad_large.bc sncaworst_large.bc" 31 | 32 | DEBUG="$1" 33 | 34 | Compiling () 35 | { 36 | echo -e $2": \c" ; 37 | 38 | if [[ $DEBUG != "debug" ]]; then 39 | echo -e "Push RPO"; time $DOM $1 40 | echo -e "Pull RPO"; time $DOM -type 1 $1 41 | echo -e "Slow"; time $DOM -type 2 $1 42 | echo -e "LLVM"; time $DOM -type 3 $1 43 | else 44 | echo -e "Push RPO"; time $DOM -d $1 45 | fi 46 | } 47 | 48 | for name in $OC_CASES; do 49 | Compiling $OC_DIR$name"/test.bc" $name 50 | done; 51 | 52 | for name in $S95_CASES; do 53 | Compiling $S95_DIR$name"/src/test.bc" $name 54 | done; 55 | 56 | if [[ $DEBUG != "debug" ]]; then 57 | for name in $S00_CASES; do 58 | Compiling $S00_DIR$name $name 59 | done; 60 | 61 | for name in $S06_CASES; do 62 | Compiling $S06_DIR$name $name 63 | done 64 | fi 65 | 66 | Worstcase() 67 | { 68 | echo -e $2": \c" ; 69 | opt -lowerswitch $1 -f -o lower.bc 70 | echo -e "Push RPO"; time $DOM lower.bc 71 | echo -e "Pull RPO"; time $DOM -type 1 lower.bc 72 | echo -e "LLVM"; time $DOM -type 3 lower.bc 73 | } 74 | 75 | if [[ $DEBUG != "debug" ]]; then 76 | for name in $WORST_CASES; do 77 | Worstcase $WORST_DIR$name $name 78 | done 79 | fi 80 | 81 | -------------------------------------------------------------------------------- /src/Vellvm/ott/ott_list_flat_map.v: -------------------------------------------------------------------------------- 1 | (*** Flattening and mapping ***) 2 | 3 | Require Import Arith. 4 | Require Import List. 5 | Require Import ott_list_core. 6 | Require Import ott_list_support. 7 | Require Import ott_list_base. 8 | 9 | 10 | 11 | Section Flat_map. 12 | Variables A B C : Set. 13 | Implicit Types x : A. 14 | Implicit Types y : B. 15 | Implicit Types l xs : list A. 16 | Implicit Types ys : list B. 17 | Implicit Types xss : list (list A). 18 | Implicit Types yss : list (list B). 19 | Implicit Types f : A -> B. 20 | Implicit Types g : B -> C. 21 | Implicit Types F : A -> list B. 22 | Implicit Types G : B -> list C. 23 | Set Implicit Arguments. 24 | 25 | Lemma std_eq_flat_map : 26 | forall F l, List.flat_map F l = flat_map F l. 27 | Proof. induction l; simpl; congruence. Qed. 28 | 29 | Lemma length_flat_map : 30 | forall F l, 31 | length (flat_map F l) = fold_right plus 0 (map (fun x => length (F x)) l). 32 | Proof. induction l; simpl; autorewrite with lists; congruence. Qed. 33 | 34 | Lemma flat_map_app : 35 | forall F l l', flat_map F (l ++ l') = flat_map F l ++ flat_map F l'. 36 | Proof. intros; induction l; simpl; autorewrite with lists; congruence. Qed. 37 | 38 | Lemma flat_map_map : 39 | forall f G l, flat_map G (map f l) = flat_map (compose G f) l. 40 | Proof. 41 | intros; induction l; simpl; autorewrite with lists; 42 | unfold compose in *; congruence. 43 | Qed. 44 | 45 | Lemma map_flat_map : 46 | forall F g l, map g (flat_map F l) = flat_map (compose (map g) F) l. 47 | Proof. 48 | intros; induction l; simpl; autorewrite with lists; 49 | unfold compose in *; congruence. 50 | Qed. 51 | 52 | Lemma flat_map_identity : forall l, flat_map (fun x => x::nil) l = l. 53 | Proof. induction l; simpl; congruence. Qed. 54 | 55 | Lemma flat_map_extensionality : 56 | forall F F' l, (forall x, F x = F' x) -> flat_map F l = flat_map F' l. 57 | Proof. intros; induction l; simpl; try rewrite H; congruence. Qed. 58 | 59 | Lemma flat_map_rev : 60 | forall F l, flat_map F (rev l) = rev (flat_map (compose (@rev _) F) l). 61 | Proof. 62 | intros; induction l; simpl. reflexivity. 63 | unfold compose in *; autorewrite with lists; 64 | rewrite flat_map_app; simpl; autorewrite with lists. congruence. 65 | Qed. 66 | 67 | Definition flatten := flat_map (fun xs => xs). 68 | Lemma unfold_flatten : flatten = flat_map (fun xs => xs). 69 | Proof refl_equal _. 70 | 71 | Lemma In_flat_map_intro : 72 | forall F l x y, 73 | In x l -> In y (F x) -> In y (flat_map F l). 74 | Proof. 75 | intros; induction l; simpl in *; destruct H. 76 | subst; auto with datatypes. auto with datatypes. 77 | Qed. 78 | 79 | Lemma In_flat_map_elim : 80 | forall F l y, 81 | In y (flat_map F l) -> 82 | exists x, In x l /\ In y (F x). 83 | Proof. 84 | intros; induction l; simpl in * . solve [elim H]. 85 | destruct (in_app_or _ _ _ H). subst; eauto with datatypes. firstorder. 86 | Qed. 87 | 88 | End Flat_map. 89 | 90 | Hint Rewrite std_eq_flat_map 91 | length_flat_map flat_map_app flat_map_map map_flat_map 92 | flat_map_identity flat_map_extensionality 93 | flat_map_rev 94 | unfold_flatten 95 | : lists. 96 | Hint Resolve In_flat_map_intro In_flat_map_elim : lists. 97 | -------------------------------------------------------------------------------- /Make: -------------------------------------------------------------------------------- 1 | -arg -impredicative-set 2 | -install none 3 | 4 | ./lib/cpdtlib/CpdtTactics.v 5 | 6 | ./lib/compcert-1.9/Iteration.v 7 | ./lib/compcert-1.9/AST.v 8 | ./lib/compcert-1.9/Maps.v 9 | ./lib/compcert-1.9/Coqlib.v 10 | ./lib/compcert-1.9/Intv.v 11 | ./lib/compcert-1.9/Floats.v 12 | ./lib/compcert-1.9/Axioms.v 13 | ./lib/compcert-1.9/Memtype.v 14 | ./lib/compcert-1.9/Values.v 15 | ./lib/compcert-1.9/Ordered.v 16 | ./lib/compcert-1.9/alist.v 17 | ./lib/compcert-1.9/Errors.v 18 | ./lib/compcert-1.9/Lattice.v 19 | ./lib/compcert-1.9/Kildall.v 20 | ./lib/compcert-1.9/Memdata.v 21 | ./lib/compcert-1.9/Memory.v 22 | ./lib/compcert-1.9/Integers.v 23 | 24 | ./lib/GraphBasics/Sets.v 25 | ./lib/GraphBasics/Dipaths.v 26 | ./lib/GraphBasics/Degrees.v 27 | ./lib/GraphBasics/Edges.v 28 | ./lib/GraphBasics/Digraphs.v 29 | ./lib/GraphBasics/Graphs.v 30 | ./lib/GraphBasics/Arcs.v 31 | ./lib/GraphBasics/Trees.v 32 | ./lib/GraphBasics/Enumerated.v 33 | ./lib/GraphBasics/Vertices.v 34 | ./lib/GraphBasics/Connected.v 35 | ./lib/GraphBasics/Acyclic.v 36 | ./lib/GraphBasics/Paths.v 37 | 38 | ./src/Vellvm/ott/ott_list_base.v 39 | ./src/Vellvm/ott/ott_list_core.v 40 | ./src/Vellvm/ott/ott_list_distinct.v 41 | ./src/Vellvm/ott/ott_list_eq_dec.v 42 | ./src/Vellvm/ott/ott_list_flat_map.v 43 | ./src/Vellvm/ott/ott_list_mem.v 44 | ./src/Vellvm/ott/ott_list_nth.v 45 | ./src/Vellvm/ott/ott_list_predicate.v 46 | ./src/Vellvm/ott/ott_list_repeat.v 47 | ./src/Vellvm/ott/ott_list_support.v 48 | ./src/Vellvm/ott/ott_list_takedrop.v 49 | ./src/Vellvm/ott/ott_list.v 50 | 51 | ./src/Vellvm/analysis.v 52 | ./src/Vellvm/datatype_base.v 53 | ./src/Vellvm/dopsem.v 54 | ./src/Vellvm/events.v 55 | ./src/Vellvm/external_intrinsics.v 56 | ./src/Vellvm/genericvalues_inject.v 57 | ./src/Vellvm/genericvalues_props.v 58 | ./src/Vellvm/genericvalues.v 59 | ./src/Vellvm/infrastructure_props.v 60 | ./src/Vellvm/infrastructure.v 61 | ./src/Vellvm/interpreter.v 62 | ./src/Vellvm/memory_sim.v 63 | ./src/Vellvm/monad.v 64 | ./src/Vellvm/ndopsem.v 65 | ./src/Vellvm/opsem_dom.v 66 | ./src/Vellvm/opsem_inst.v 67 | ./src/Vellvm/opsem_props.v 68 | ./src/Vellvm/opsem.v 69 | ./src/Vellvm/opsem_wf.v 70 | ./src/Vellvm/static.v 71 | ./src/Vellvm/syntax_base.v 72 | ./src/Vellvm/syntax.v 73 | ./src/Vellvm/tactics.v 74 | ./src/Vellvm/targetdata_props.v 75 | ./src/Vellvm/targetdata.v 76 | ./src/Vellvm/trace.v 77 | ./src/Vellvm/typing_rules.v 78 | ./src/Vellvm/typings_props.v 79 | ./src/Vellvm/typings.v 80 | ./src/Vellvm/util.v 81 | ./src/Vellvm/vellvm_tactics.v 82 | ./src/Vellvm/vellvm.v 83 | ./src/Vellvm/memory_props.v 84 | ./src/Vellvm/program_sim.v 85 | 86 | ./src/Vellvm/Dominators/dom_type.v 87 | ./src/Vellvm/Dominators/dom_libs.v 88 | ./src/Vellvm/Dominators/dfs.v 89 | ./src/Vellvm/Dominators/pull_iter.v 90 | ./src/Vellvm/Dominators/push_iter.v 91 | ./src/Vellvm/Dominators/dom_set.v 92 | ./src/Vellvm/Dominators/cfg.v 93 | ./src/Vellvm/Dominators/reach.v 94 | ./src/Vellvm/Dominators/dom_decl.v 95 | ./src/Vellvm/Dominators/dom_list.v 96 | ./src/Vellvm/Dominators/dom_tree.v 97 | ./src/Vellvm/Dominators/dom_list_tree.v 98 | ./src/Vellvm/Dominators/dom_set_tree.v 99 | ./src/Vellvm/Dominators/dom_list_tree_wf.v 100 | ./src/Vellvm/Dominators/dom_list_df.v 101 | -------------------------------------------------------------------------------- /src/Interpreter/main.ml: -------------------------------------------------------------------------------- 1 | open Opsem 2 | open Dopsem 3 | open Interpreter 4 | open Printf 5 | open Llvm 6 | open Llvm_executionengine 7 | open Events 8 | 9 | let interInsnLoop (cfg:OpsemAux.coq_Config) (s0:Opsem.coq_State) (tr0:trace) 10 | : (Opsem.coq_State*trace) option = 11 | 12 | let s = ref s0 in 13 | let n = ref 0 in 14 | 15 | while (Opsem.s_isFinialState coq_DGVs cfg !s = None) do 16 | (if !Globalstates.debug then (eprintf "n=%d\n" !n; flush_all())); 17 | match interInsn cfg !s with 18 | | Some (s', _) -> 19 | begin 20 | s := s'; 21 | n := !n + 1 22 | end 23 | | None -> failwith "Stuck!" 24 | done; 25 | 26 | Some (!s, coq_E0) 27 | 28 | let rec interInsnStar (cfg:OpsemAux.coq_Config) (s:Opsem.coq_State) (tr:trace) 29 | (n:int) : (Opsem.coq_State*trace) option = 30 | if (Opsem.s_isFinialState coq_DGVs cfg s = None) 31 | then 32 | begin 33 | (if !Globalstates.debug then (eprintf "Done!\n";flush_all())); 34 | Some (s, tr) 35 | end 36 | else 37 | if n > 0 38 | then 39 | begin 40 | (if !Globalstates.debug then (eprintf "n=%d\n" n; flush_all())); 41 | match interInsn cfg s with 42 | | Some (s', tr') -> interInsnStar cfg s' (coq_Eapp tr tr') (n-1) 43 | | None -> 44 | eprintf "Stuck!\n";flush_all(); 45 | None 46 | end 47 | else 48 | begin 49 | eprintf "Time up!\n";flush_all(); 50 | Some (s, tr) 51 | end 52 | 53 | let main in_filename argv = 54 | 55 | let ic = global_context () in 56 | let imbuf = MemoryBuffer.of_file in_filename in 57 | let im = Llvm_bitreader.parse_bitcode ic imbuf in 58 | let ist = SlotTracker.create_of_module im in 59 | 60 | (if !Globalstates.debug then dump_module im); 61 | (if !Globalstates.debug then Llvm_pretty_printer.travel_module ist im); 62 | let coqim = Llvm2coq.translate_module !Globalstates.debug ist im in 63 | (if !Globalstates.debug then Coq_pretty_printer.travel_module coqim); 64 | 65 | let li = ExecutionEngine.create_interpreter im in 66 | 67 | let print() = Array.iter print_endline argv in 68 | 69 | if !Globalstates.debug then 70 | (eprintf "main runs with arguments: \n"; print(); flush_all()); 71 | 72 | let gargvs = (GenericValue.of_int 73 | (Llvm.integer_type ic 32) (Array.length argv)):: 74 | ExecutionEngine.to_argv argv ic li:: 75 | [] in 76 | 77 | (* FIXME: We need to call ctors/dtors before/after execution *) 78 | (* Do we also need to formalize them in Coq? They are implemented by*) 79 | (* llvm.global_ctors/llvm.global_dtors. Are they target-independent? *) 80 | ExecutionEngine.run_static_ctors li; 81 | 82 | (match Opsem.s_genInitState coq_DGVs (coqim::[]) "@main" 83 | (Obj.magic gargvs) (li, im) with 84 | | Some (cfg, s) -> 85 | (match interInsnLoop cfg s coq_E0 with 86 | | Some (s', tr) -> (); ExecutionEngine.run_static_dtors li 87 | | None -> () ) 88 | | None -> () ); 89 | 90 | SlotTracker.dispose ist; 91 | ExecutionEngine.dispose li 92 | 93 | let _ = let len = Array.length Sys.argv in 94 | 95 | if len < 1 then 96 | failwith "# of argv is 0"; 97 | 98 | let idx = ref 1 in 99 | let set_flags = fun _ -> 100 | let finished = ref false in 101 | while (not !finished) && (!idx < len) do 102 | let arg = Array.get Sys.argv !idx in 103 | 104 | if arg = "-d" then 105 | Globalstates.debug := true; 106 | 107 | if String.get arg 0 != '-' 108 | then 109 | finished := true 110 | else 111 | idx := !idx + 1 112 | done in 113 | 114 | set_flags (); 115 | 116 | if !idx < len then 117 | main (Array.get Sys.argv !idx) (Array.sub Sys.argv !idx (len - !idx)) 118 | else 119 | main "Input.bc" (Array.make 1 "") 120 | -------------------------------------------------------------------------------- /src/Vellvm/Dominators/dom_list_df.v: -------------------------------------------------------------------------------- 1 | Require Import Coqlib. 2 | Require Import Maps. 3 | Require Import syntax. 4 | Require Import infrastructure. 5 | Require Import dom_tree. 6 | Require Import dom_list. 7 | Require Import dom_list_tree. 8 | Require Import dom_libs. 9 | Require Import dfs. 10 | Require Import push_iter. 11 | Import LLVMsyntax. 12 | Import LLVMinfra. 13 | 14 | (* This file constructs domination frontiers. 15 | 16 | We follow an algorithm that approaches the problem from the opposite direction, 17 | and tends to run faster than Cytron et al.’s algorithm in practice. The 18 | algorithm is based on three observations. First, nodes in a dominance frontier 19 | represent join points in the graph, nodes into which control flows from 20 | multiple predecessors. Second, the predecessors of any join point, j, must have 21 | j in their respective dominancefrontier sets, unless the predecessor dominates 22 | j. This is a direct result of the defnition of dominance frontiers, above. 23 | Finally, the dominators of j’s predecessors must themselves have j in their 24 | dominance frontier sets unless they also dominate j. 25 | 26 | These observations lead to a simple algorithm. First, we identify each join 27 | point, j—any node with more than one incoming edge is a join point. We then 28 | examine each predecessor, p, of j and walk up the dominator tree starting at p. 29 | We stop the walk when we reach j’s immediate dominator—j is in the dominance 30 | frontier of each of the nodes in the walk, except for j’s immediate dominator. 31 | Intuitively, all of the rest of j’s dominators are shared by j’s predecessors 32 | as well. Since they dominate j, they will not have j in their dominance 33 | frontiers. 34 | 35 | This approach tends to run faster than Cytron et al..’s algorithm in practice, 36 | almost certainly for two reasons. First, the iterative algorithm has already 37 | built the dominator tree. Second, the algorithm uses no more comparisons than 38 | are strictly necessary. Section 9.5.2 will revisit the implementation of the 39 | algorithm. *) 40 | Definition idom_of (dts: PMap.t LDoms.t) (p:positive) : option positive := 41 | match PMap.get p dts with 42 | | Some (idom::_) => Some idom 43 | | _ => None 44 | end. 45 | 46 | Definition doms_of (dts: PMap.t LDoms.t) (p:positive) : list positive := 47 | match PMap.get p dts with 48 | | Some sdoms => p::sdoms 49 | | _ => nil 50 | end. 51 | 52 | (* given curr, idom is the immediate dom of curr, and 53 | ps doms curr's predecesssors *) 54 | Fixpoint who_has_dom_frontier_aux (curr idom:positive) 55 | (acc:PTree.t (list positive)) (ps:list positive) : PTree.t (list positive) := 56 | match ps with 57 | | nil => acc 58 | | p::ps' => 59 | if (positive_eq_dec idom p) then acc 60 | else who_has_dom_frontier_aux curr idom (PTree.set p (curr::acc???p) acc) ps' 61 | end. 62 | 63 | (* given curr, idom is the immediate dom of curr, and 64 | pred is one of curr's predecesssors *) 65 | Definition who_has_dom_frontier (dts: PMap.t LDoms.t) (curr idom:positive) 66 | (acc:PTree.t (list positive)) (pred:positive) : PTree.t (list positive) := 67 | who_has_dom_frontier_aux curr idom acc (doms_of dts pred). 68 | 69 | Definition pdom_frontier_fun (dts: PMap.t LDoms.t) (acc:PTree.t (list positive)) 70 | (p:positive) (preds: list positive) : PTree.t (list positive) := 71 | match preds with 72 | | p1::p2::_ => 73 | match idom_of dts p with 74 | | None => acc 75 | | Some idom => fold_left (who_has_dom_frontier dts p idom) preds acc 76 | end 77 | | _ => acc 78 | end. 79 | 80 | Definition pdom_frontier (ppreds: PTree.t (list positive)) 81 | (dts: PMap.t LDoms.t) : PTree.t (list positive) := 82 | PTree.fold (pdom_frontier_fun dts) ppreds (PTree.empty _). 83 | 84 | Definition dom_frontier (f: fdef) (gen_tree: bool) 85 | : ATree.t (list l) * option DTree := 86 | let asuccs := cfg.successors f in 87 | match LLVMinfra.getEntryLabel f with 88 | | Some le => 89 | let '(mkPO _ a2p) := dfs asuccs le 1%positive in 90 | let psuccs := asuccs_psuccs a2p asuccs in 91 | match ATree.get le a2p with 92 | | Some pe => 93 | let dts := pdom_analyze psuccs pe (num_iters f) in 94 | let ppreds := XPTree.make_predecessors psuccs in 95 | let dfs := pdom_frontier ppreds dts in 96 | let p2a := a2p_p2a a2p in 97 | let odt := 98 | if gen_tree then 99 | let res := fun p:positive => PMap.get p dts in 100 | let pdt := create_dtree pe (get_reachable_nodes (bound_fdef f) a2p) res in 101 | DTreeConv.sdtree_tdtree p2a pdt 102 | else None in 103 | let df := PTree.fold 104 | (fun acc p0 df0 => 105 | match p2a ? p0 with 106 | | None => acc 107 | | Some a0 => ATree.set a0 (ps2as p2a df0) acc 108 | end) dfs (ATree.empty _) in 109 | (df, odt) 110 | | None => (ATree.empty _, None) 111 | end 112 | | None => (ATree.empty _, None) 113 | end. 114 | 115 | -------------------------------------------------------------------------------- /src/Vellvm/Dominators/pull_iter.v: -------------------------------------------------------------------------------- 1 | Require Import Coqlib. 2 | Require Import Iteration. 3 | Require Import Maps. 4 | Require Import syntax. 5 | Require Import infrastructure_props. 6 | Require Import Metatheory. 7 | Require Import Program.Tactics. 8 | Require Import dom_libs. 9 | Require Import dfs. 10 | 11 | (* When the Kildall's algorithm propogates, it ``pulls'' data from the 12 | predecessors of a note to the node. *) 13 | Module Weak_Pred_Dataflow_Solver (NS: PNODE_SET) (L: LATTICEELT). 14 | 15 | Section Kildall. 16 | 17 | Variable successors: PTree.t (list positive). 18 | Variable predecessors: PTree.t (list positive). 19 | Variable transf : positive -> L.t -> L.t. 20 | Variable entrypoints: list (positive * L.t). 21 | 22 | (** The state of the iteration has two components: 23 | - A mapping from program points to values of type [L.t] representing 24 | the candidate solution found so far. 25 | - A worklist of program points that remain to be considered. 26 | *) 27 | 28 | Record state : Type := 29 | mkstate { st_in: PMap.t L.t; st_wrk: NS.t }. 30 | 31 | (** Kildall's algorithm, in pseudo-code, is as follows: 32 | << 33 | while st_wrk is not empty, do 34 | extract a node n from st_wrk 35 | compute in = st_in[n] 36 | for each predecessor p of n: 37 | compute out = transf p st_in[p] 38 | compute in := lub in out 39 | end for 40 | if in <> st_in[n]: 41 | st_in[n] := in 42 | st_wrk := st_wrk union {successors of n} 43 | end if 44 | end while 45 | return st_in 46 | >> 47 | 48 | The initial state is built as follows: 49 | - The initial mapping sets all program points to [L.bot], except 50 | those mentioned in the [entrypoints] list, for which we take 51 | the associated approximation as initial value. Since a program 52 | point can be mentioned several times in [entrypoints], with different 53 | approximations, we actually take the l.u.b. of these approximations. 54 | - The initial worklist contains all the program points. *) 55 | 56 | Fixpoint start_state_in (ep: list (positive * L.t)) : PMap.t L.t := 57 | match ep with 58 | | nil => 59 | PMap.init L.bot 60 | | (n, v) :: rem => 61 | let m := start_state_in rem in 62 | PMap.set n (fst (L.lub m ?? n v)) m 63 | end. 64 | 65 | Definition start_state := 66 | mkstate (start_state_in entrypoints) (NS.initial predecessors). 67 | 68 | (** [propagate_pred_list] corresponds, in the pseudocode, 69 | to the [for] loop iterating over all predecessors. *) 70 | 71 | Definition propagate_pred_list (s: state) (oldl: L.t) (preds: list positive) 72 | : (L.t * bool) := 73 | fold_left (fun acc p => 74 | let '(accl, accb) := acc in 75 | let '(newl, changed) := L.lub accl (transf p s.(st_in) ?? p) in 76 | (newl, accb || changed)) preds (oldl, false). 77 | 78 | (** [step] corresponds to the body of the outer [while] loop in the 79 | pseudocode. *) 80 | 81 | Definition add_successors_into_worklist (rem: NS.t) (n: positive) : NS.t := 82 | fold_left (fun acc s => NS.add s acc) (successors ??? n) rem. 83 | 84 | Definition step (s: state) : PMap.t L.t + state := 85 | match NS.pick s.(st_wrk) with 86 | | None => 87 | inl _ s.(st_in) 88 | | Some(n, rem) => 89 | let oldl := s.(st_in) ?? n in 90 | let '(newl, changed) := propagate_pred_list s oldl (predecessors ??? n) in 91 | let s' := 92 | if changed 93 | then mkstate (PMap.set n newl s.(st_in)) 94 | (add_successors_into_worklist rem n) 95 | else mkstate s.(st_in) rem in 96 | inr _ s' 97 | end. 98 | 99 | (** The whole fixpoint computation is the iteration of [step] from 100 | the start state. *) 101 | 102 | Definition fixpoint : option (PMap.t L.t) := 103 | PrimIter.iterate _ _ step start_state. 104 | 105 | End Kildall. 106 | 107 | End Weak_Pred_Dataflow_Solver. 108 | 109 | (* Implement dominator analysis by the above Kildall's algorithm. *) 110 | Module LDoms := Doms (MergeLt). 111 | Module DomDS := Weak_Pred_Dataflow_Solver (PNodeSetMax) (LDoms). 112 | 113 | Definition transfer (n:positive) (input: LDoms.t) : LDoms.t := 114 | match input with 115 | | None => None 116 | | Some ps => Some (n::ps) 117 | end. 118 | 119 | Require analysis. 120 | Require Import infrastructure. 121 | Import LLVMsyntax. 122 | 123 | Definition dom_analyze (f: fdef) : PMap.t LDoms.t := 124 | let asuccs := cfg.successors f in 125 | match LLVMinfra.getEntryBlock f with 126 | | Some (le, _) => 127 | let 'mkPO _ a2p := dfs asuccs le 1%positive in 128 | let psuccs := asuccs_psuccs a2p asuccs in 129 | match ATree.get le a2p with 130 | | Some pe => 131 | match DomDS.fixpoint psuccs 132 | (XPTree.make_predecessors psuccs) 133 | transfer ((pe, LDoms.top) :: nil) with 134 | | None => (PMap.set pe LDoms.top (PMap.init LDoms.bot)) 135 | | Some res => res 136 | end 137 | | None => PMap.init LDoms.bot 138 | end 139 | | None => PMap.init LDoms.bot 140 | end. 141 | 142 | 143 | -------------------------------------------------------------------------------- /src/Vellvm/Dominators/main.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Llvm 3 | open Syntax 4 | open Infrastructure 5 | open Camlcoq 6 | open Maps 7 | open Transforms_aux 8 | open Arg 9 | 10 | let dom_type = ref 0 11 | let gen_dtree = ref true 12 | let only_pdtree = ref false 13 | 14 | let slow_dom f = 15 | match LLVMinfra.getEntryBlock f with 16 | | Some b -> 17 | let b0 = Cfg.bound_fdef f in 18 | let dts = Dom_set.AlgDom.sdom f in 19 | ignore(print_dominators b0 dts); 20 | if !gen_dtree then 21 | (match Analysis.reachablity_analysis f with 22 | | Some rd -> 23 | let (root, _) = b in 24 | let chains = Dom_set_tree.compute_sdom_chains dts rd in 25 | let dt = Dom_tree.create_dtree_from_chains 26 | MetatheoryAtom.AtomImpl.eq_atom_dec root chains in 27 | ignore (print_dtree (fun a->a) dt) 28 | | None -> ()) 29 | | None -> () 30 | 31 | let print_doms (dms: Push_iter.LDoms.t PMap.t) = 32 | let (_, cnts) = dms in 33 | PTree.map (fun key ods -> 34 | eprintf "%ld <<" (camlint_of_positive key); 35 | (match ods with 36 | | None -> () 37 | | Some ds -> 38 | List.iter (fun d -> eprintf "%ld " (camlint_of_positive d)) ds 39 | ); 40 | eprintf "\n") cnts 41 | 42 | let pull_dom f = 43 | let dts = Pull_iter.dom_analyze f in 44 | if (!Globalstates.print_dtree) then (ignore (print_doms dts)) 45 | 46 | let push_dom f = 47 | let (dts, a2p) = Dom_list.dom_analyze f in 48 | if (!Globalstates.print_dtree) then (ignore (print_doms dts)) 49 | 50 | let push_adtree f = 51 | match Dom_list.AlgDom.create_dom_tree f with 52 | | Some dt -> if (!Globalstates.print_dtree) 53 | then ignore (print_dtree (fun a -> a) dt) 54 | | None -> () 55 | 56 | let push_pdtree f = 57 | let (dts, a2p) = Dom_list.dom_analyze f in 58 | if (!Globalstates.print_dtree) then (ignore (print_doms dts)); 59 | match LLVMinfra.getEntryLabel f with 60 | | Some le -> 61 | (match ATree.get le a2p with 62 | | Some pe -> 63 | let res = fun p -> PMap.get p dts in 64 | let pdt = Dom_list_tree.create_dtree pe 65 | (Dom_list.get_reachable_nodes (Cfg.bound_fdef f) a2p) 66 | res in 67 | if (!Globalstates.print_dtree) 68 | then ignore (print_dtree 69 | (fun a -> sprintf "%ld" (camlint_of_positive a)) pdt) 70 | | None -> ()) 71 | | None -> () 72 | 73 | let print_df (dfs: LLVMsyntax.l list ATree.t) = 74 | eprintf "DF:\n"; 75 | ignore (ATree.map (fun key df -> 76 | eprintf "%s <<" key; 77 | List.iter (fun d -> eprintf "%s " d) df; 78 | eprintf "\n") dfs); 79 | eprintf "\n" 80 | 81 | let push_df f = 82 | let (dfs, _) = Dom_list_df.dom_frontier f false in 83 | if !Globalstates.print_dtree then print_df dfs 84 | 85 | let dom_product g = 86 | match g with 87 | | LLVMsyntax.Coq_product_fdef 88 | (LLVMsyntax.Coq_fdef_intro 89 | (LLVMsyntax.Coq_fheader_intro (_, _, fid, _, _), _) as f) -> 90 | (if (!Globalstates.print_dtree && !dom_type <= 2) 91 | then eprintf "Dom %s:\n" fid); 92 | (match !dom_type with 93 | | 0 -> (if !gen_dtree then 94 | (if !only_pdtree then push_pdtree f else push_adtree f) 95 | else push_dom f); 96 | if !Globalstates.gen_llvm_df then push_df f 97 | | 1 -> pull_dom f 98 | | 2 -> slow_dom f 99 | | _ -> ()) 100 | | _ -> () 101 | 102 | let dom_module m = 103 | match m with 104 | | LLVMsyntax.Coq_module_intro (_, _, ps) -> 105 | List.iter dom_product ps 106 | 107 | let main in_filename = 108 | (* Read bitcode [in_filename] into LLVM module [im] *) 109 | let ic = global_context () in 110 | let imbuf = MemoryBuffer.of_file in_filename in 111 | let im = Llvm_bitreader.parse_bitcode ic imbuf in 112 | let ist = SlotTracker.create_of_module im in 113 | 114 | (* Translate LLVM module [im] to Coq module [coqim] *) 115 | let coqim = Llvm2coq.translate_module !Globalstates.debug ist im in 116 | 117 | dom_module coqim; 118 | 119 | SlotTracker.dispose ist; 120 | dispose_module im 121 | 122 | let argspec = [ 123 | ("-d", Set Globalstates.print_dtree, "debug. Default=false"); 124 | ("-type", 125 | Int (fun i -> 126 | dom_type := i; 127 | if i>2 then Globalstates.gen_llvm_dtree := true), 128 | "0:push; 1:pull; 2:slow; others:llvm. Default=0"); 129 | ("-notree", Clear gen_dtree, "Do not generate dom-tree explicitly. Default=true"); 130 | ("-only-pdtree", Set only_pdtree, "Only generate positive dtree. Default=false"); 131 | ("-df", Unit (fun () -> Globalstates.gen_llvm_df := true), 132 | "Generate dominance frontier. Default=false"); 133 | ] 134 | 135 | let worklist = ref [] 136 | 137 | let () = 138 | Arg.parse argspec (fun f -> worklist := f :: !worklist) "dom-analysis \n"; 139 | match !worklist with 140 | | [] -> main "input.bc" 141 | | filename::_ -> main filename 142 | 143 | (* let () = *) 144 | (* match Sys.argv with *) 145 | (* | [| _; in_filename |] -> *) 146 | (* main in_filename *) 147 | (* | [| _; "-pull-dom"; in_filename |] -> *) 148 | (* dom_type := 1; *) 149 | (* main in_filename *) 150 | (* | [| _; "-slow-dom"; in_filename |] -> *) 151 | (* dom_type := 2; *) 152 | (* main in_filename *) 153 | (* | [| _; "-llvm-dom"; in_filename |] -> *) 154 | (* dom_type := 3; *) 155 | (* Globalstates.gen_llvm_dtree := true; *) 156 | (* main in_filename *) 157 | (* | [| _; "-dpush-dom" ; in_filename |] -> *) 158 | (* Globalstates.print_dtree := true; *) 159 | (* main in_filename *) 160 | (* | [| _; "-dpull-dom" ; in_filename |] -> *) 161 | (* dom_type := 1; *) 162 | (* Globalstates.print_dtree := true; *) 163 | (* main in_filename *) 164 | (* | [| _; "-dslow-dom"; in_filename |] -> *) 165 | (* dom_type := 2; *) 166 | (* Globalstates.print_dtree := true; *) 167 | (* main in_filename *) 168 | (* | [| _; "-dllvm-dom"; in_filename |] -> *) 169 | (* dom_type := 3; *) 170 | (* Globalstates.print_dtree := true; *) 171 | (* Globalstates.gen_llvm_dtree := true; *) 172 | (* main in_filename *) 173 | (* | _ -> main "input.bc" *) 174 | -------------------------------------------------------------------------------- /src/Vellvm/ott/ott_list_mem.v: -------------------------------------------------------------------------------- 1 | (*** Membership predicates ***) 2 | 3 | Require Import Arith. 4 | Require Import Bool. 5 | Require Import List. 6 | Require Import Ring. 7 | Require Import ott_list_base. 8 | Require Import ott_list_core. 9 | Require Import ott_list_nth. 10 | Set Implicit Arguments. 11 | 12 | 13 | 14 | (*** Membership predicate ***) 15 | 16 | Section In. 17 | Variable A : Set. 18 | Implicit Types x : A. 19 | Implicit Types xs l : list A. 20 | 21 | (* Speed up proofs by providing trivial consequences of [List.in_or_app] that 22 | do not require eauto. *) 23 | Lemma In_left_app : 24 | forall l l' a, In a l -> In a (l ++ l'). 25 | Proof. auto with datatypes. Qed. 26 | Lemma In_right_app : 27 | forall l l' a, In a l -> In a (l ++ l'). 28 | Proof. auto with datatypes. Qed. 29 | 30 | Lemma not_in_app_or : 31 | forall l l' a, ~In a (l ++ l') -> ~In a l /\ ~In a l'. 32 | Proof. unfold not; auto with datatypes. Qed. 33 | Lemma not_in_or_app : 34 | forall l l' a, ~In a l /\ ~In a l' -> ~In a (l ++ l'). 35 | Proof. unfold not; destruct 1; intros. pose (in_app_or _ _ _ H1). tauto. Qed. 36 | 37 | Lemma nth_error_In : 38 | forall l n x, nth_error l n = Some x -> In x l. 39 | Proof. 40 | intros; generalize dependent l; induction n; destruct l; intros; 41 | simpl in *; simplify_eq H; auto. 42 | Qed. 43 | 44 | Lemma nth_safe_In : 45 | forall l n H, In (nth_safe l n H) l. 46 | Proof. 47 | intros. eapply nth_error_In. rewrite nth_safe_eq_nth_error. eauto. 48 | Qed. 49 | 50 | End In. 51 | 52 | Hint Resolve In_left_app In_right_app : datatypes. 53 | Hint Resolve not_in_app_or not_in_or_app : datatypes. 54 | Hint Resolve nth_error_In nth_safe_In : datatypes. 55 | 56 | 57 | 58 | (*** Membership predicate and map ***) 59 | 60 | Lemma image_In_map : 61 | forall (A B:Set) x l (f:A->B), 62 | In x l -> In (f x) (map f l). 63 | Proof. 64 | intros. induction l; simpl in * . tauto. destruct H; subst; tauto. 65 | Qed. 66 | 67 | Lemma In_map_exists : 68 | forall (A B:Set) l y (f:A->B), 69 | In y (map f l) -> exists x, y = f x /\ In x l. 70 | Proof. 71 | intros. induction l; simpl in * . tauto. destruct H. eauto. firstorder. 72 | Qed. 73 | 74 | Ltac elim_In_map H x Eq Mem := 75 | let tmp := fresh "tmp" in ( 76 | try rename H into tmp; 77 | elim (In_map_exists _ _ _ tmp); intro x; destruct 1 as [Eq Mem]; 78 | try clear tmp 79 | ). 80 | 81 | Ltac elim_all_In_map := 82 | repeat match goal with 83 | | H : In ?y (map ?f ?l) |- _ => 84 | let Eq := fresh "Eq" with tmp := fresh "tmp" in ( 85 | rename H into tmp; 86 | elim (In_map_exists _ _ _ tmp); intro; destruct 1 as [Eq Mem]; 87 | clear tmp 88 | ) 89 | end. 90 | 91 | 92 | 93 | (*** Membership function ***) 94 | 95 | Section list_mem. 96 | Variable A : Set. 97 | Variable (eq_dec : forall (a b:A), {a=b} + {a<>b}). 98 | Implicit Types x : A. 99 | Implicit Types xs l : list A. 100 | 101 | Ltac case_eq foo := 102 | generalize (refl_equal foo); 103 | pattern foo at -1; 104 | case foo. 105 | 106 | Notation list_mem := (list_mem eq_dec). 107 | 108 | Lemma list_mem_implies_In : 109 | forall x l, Is_true (list_mem x l) -> In x l. 110 | Proof. 111 | intros. induction l. assumption. simpl in *; destruct (eq_dec a x); tauto. 112 | Qed. 113 | Lemma list_mem_false_implies_not_In : 114 | forall x l, list_mem x l = false -> ~In x l. 115 | Proof. 116 | intros. induction l; simpl in * . tauto. 117 | destruct (eq_dec a x). discriminate. tauto. 118 | Qed. 119 | Lemma case_list_mem_In : 120 | forall x l, if list_mem x l then In x l else ~In x l. 121 | Proof. 122 | intros; induction l; simpl in * . tauto. 123 | destruct (eq_dec a x). tauto. destruct (list_mem x l); tauto. 124 | Qed. 125 | Lemma list_mem_eq_In_dec : 126 | forall x l, list_mem x l = if In_dec eq_dec x l then true else false. 127 | Proof. 128 | intros. assert (If := case_list_mem_In x l). 129 | destruct (list_mem x l); destruct (In_dec eq_dec x l); tauto. 130 | Qed. 131 | 132 | Lemma In_implies_list_mem : 133 | forall x l, In x l -> Is_true (list_mem x l). 134 | Proof. 135 | intros. induction l. assumption. 136 | simpl in *; destruct (eq_dec a x); simpl; tauto. 137 | Qed. 138 | Lemma not_In_implies_list_mem_false : 139 | forall x l, ~In x l -> list_mem x l = false. 140 | Proof. 141 | intros. induction l; simpl in * . tauto. destruct (eq_dec a x); tauto. 142 | Qed. 143 | 144 | Lemma list_mem_app : 145 | forall x l l', list_mem x (l++l') = list_mem x l || list_mem x l'. 146 | Proof. 147 | intros; repeat rewrite list_mem_eq_In_dec; 148 | repeat match goal with |- context C [In_dec ?eq_dec_ ?x_ ?l_] => 149 | destruct (In_dec eq_dec_ x_ l_) 150 | end; 151 | intros; try ring; elimtype False; 152 | (let a := type of i in (generalize dependent i; fold (~a))); 153 | auto with datatypes. 154 | Qed. 155 | 156 | Lemma nth_error_mem : 157 | forall l n x, nth_error l n = Some x -> Is_true (list_mem x l). 158 | Proof. intros; apply In_implies_list_mem. eapply nth_error_In; eauto. Qed. 159 | Lemma nth_safe_mem : 160 | forall l n H, Is_true (list_mem (nth_safe l n H) l). 161 | Proof. intros; apply In_implies_list_mem. apply nth_safe_In; auto. Qed. 162 | 163 | End list_mem. 164 | 165 | Hint Rewrite list_mem_app : lists. 166 | 167 | 168 | 169 | (*** Removing an element ***) 170 | 171 | Section list_minus. 172 | Variable A : Set. 173 | Variable (eq_dec : forall (a b:A), {a=b} + {a<>b}). 174 | Implicit Types x : A. 175 | Implicit Types xs l : list A. 176 | 177 | Notation list_minus := (list_minus eq_dec). 178 | 179 | Lemma not_In_list_minus_self : 180 | forall l x, ~In x (list_minus l (x::nil)). 181 | Proof. 182 | induction l; intros; simpl in * . tauto. 183 | destruct (eq_dec x a); simpl in *; firstorder. 184 | Qed. 185 | 186 | Lemma In_list_plus : 187 | forall x l l', In x (list_minus l l') -> In x l. 188 | Proof. 189 | induction l; intros; simpl in * . assumption. 190 | destruct (list_mem eq_dec a l'); simpl in *; firstorder. 191 | Qed. 192 | 193 | Lemma In_list_minus_other : 194 | forall l x x', x' <> x -> In x l -> In x (list_minus l (x'::nil)). 195 | Proof. 196 | induction l; intros; simpl in * . assumption. 197 | destruct (eq_dec x' a); subst; simpl in * . 198 | apply IHl; tauto. 199 | destruct H0. tauto. auto. 200 | Qed. 201 | 202 | End list_minus. 203 | 204 | Hint Resolve In_list_plus : In_list_plus. 205 | Hint Resolve In_list_minus_other : datatypes. 206 | -------------------------------------------------------------------------------- /src/Vellvm/Dominators/dom_decl.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Require Import ListSet. 3 | Require Import Coqlib. 4 | Require Import Metatheory. 5 | Require Import Maps. 6 | Require Import Lattice. 7 | Require Import Kildall. 8 | Require Import Iteration. 9 | Require Import cfg. 10 | Require Import reach. 11 | Require Import Dipaths. 12 | 13 | Require Import syntax. 14 | Require Import infrastructure. 15 | Require Import infrastructure_props. 16 | Import LLVMsyntax. 17 | Import LLVMinfra. 18 | 19 | (* This file proves more properties of declarative dominations. *) 20 | Module DecDom. 21 | 22 | Local Open Scope dom. 23 | 24 | Ltac unfold_cfg f := 25 | unfold imm_domination, reachable, strict_domination, domination; 26 | intros; 27 | match goal with 28 | | Hentry: getEntryLabel f = Some ?entry |- _ => 29 | apply getEntryLabel__getEntryBlock in Hentry; 30 | destruct Hentry as [[] [Hentry EQ]]; simpl in EQ; subst entry; 31 | rewrite Hentry in * 32 | | |- _ => 33 | remember (getEntryBlock f) as R; 34 | destruct R as [[]|]; try congruence 35 | end. 36 | 37 | Lemma sdom_isnt_refl: forall f l1 l2 (Hreach: f ~>* l2) 38 | (Hdom12 : strict_domination f l1 l2), 39 | l1 <> l2. 40 | Proof. 41 | unfold_cfg f. 42 | eapply ACfg.sdom_isnt_refl; eauto. 43 | Qed. 44 | 45 | Lemma dom_tran: forall (f:fdef) (l1 l2 l3:l), 46 | f |= l1 >>= l2 -> f |= l2 >>= l3 -> f |= l1 >>= l3. 47 | Proof. 48 | unfold_cfg f. 49 | eapply ACfg.dom_tran; eauto. 50 | Qed. 51 | 52 | Lemma everything_dominates_unreachable_blocks : 53 | forall f l1 l2 (Hreach: ~ f ~>* l2) 54 | (Hentry: getEntryBlock f <> None), 55 | f |= l1 >>= l2. 56 | Proof. 57 | unfold_cfg f. 58 | eapply ACfg.everything_dominates_unreachable_blocks; eauto. 59 | Qed. 60 | 61 | Lemma everything_sdominates_unreachable_blocks : 62 | forall f l1 l2 (Hreach: ~ f ~>* l2) 63 | (Hentry: getEntryBlock f <> None), 64 | f |= l1 >> l2. 65 | Proof. 66 | unfold_cfg f. 67 | eapply ACfg.everything_sdominates_unreachable_blocks; eauto. 68 | Qed. 69 | 70 | Lemma sdom_reachable : forall f l1 l2, 71 | f ~>* l2 -> f |= l1 >> l2 -> f ~>* l1. 72 | Proof. 73 | unfold_cfg f. 74 | eapply ACfg.sdom_reachable; eauto. 75 | Qed. 76 | 77 | Lemma dom_reachable : forall f l1 l2, 78 | f ~>* l2 -> f |= l1 >>= l2 -> f ~>* l1. 79 | Proof. 80 | unfold_cfg f. 81 | eapply ACfg.dom_reachable; eauto. 82 | Qed. 83 | 84 | Lemma sdom_dom: forall f l1 l2, 85 | f |= l1 >> l2 -> f |= l1 >>= l2. 86 | Proof. 87 | unfold_cfg f. 88 | eapply ACfg.sdom_dom; eauto. 89 | Qed. 90 | 91 | Lemma dom_sdom: forall f l1 l2, 92 | f |= l1 >>= l2 -> l1 <> l2 -> f |= l1 >> l2. 93 | Proof. 94 | unfold_cfg f. 95 | eapply ACfg.dom_sdom; eauto. 96 | Qed. 97 | 98 | Lemma domination_has_entry: forall f l1 l2 (Hdom: f |= l1 >>= l2), 99 | getEntryBlock f <> None. 100 | Proof. 101 | intros. 102 | unfold domination in Hdom. 103 | intro EQ. rewrite EQ in Hdom. auto. 104 | Qed. 105 | 106 | Lemma strict_domination__getEntryLabel: forall f l1 l2 107 | (Hsdom: f |= l1 >> l2), 108 | exists e, getEntryLabel f = Some e. 109 | Proof. 110 | unfold strict_domination. 111 | intros. 112 | inv_mbind. symmetry in HeqR. 113 | apply getEntryBlock__getEntryLabel in HeqR. eauto. 114 | Qed. 115 | 116 | Section dom_acyclic_tran. 117 | 118 | Variable f:fdef. 119 | 120 | Hypothesis getEntryBlock_inv : forall 121 | (l3 : l) 122 | (l' : l) 123 | (ps : phinodes) 124 | (cs : cmds) 125 | (tmn : terminator) 126 | (HBinF : blockInFdefB (l3, stmts_intro ps cs tmn) f = true) 127 | (Hsucc : In l' (successors_terminator tmn)) a s0 128 | (H : getEntryBlock f = Some (a, s0)), 129 | l' <> a. 130 | 131 | Lemma entry_has_no_preds: forall (l5 : l) s5 132 | (HeqR : Some (l5, s5) = getEntryBlock f) 133 | (a0 : ATree.elt) (Hin: In l5 ((successors f) !!! a0)), 134 | False. 135 | Proof. 136 | intros. 137 | eapply successors__blockInFdefB in Hin; eauto. 138 | destruct Hin as [ps0 [cs0 [tmn0 [HBinF' Hinsucc]]]]. 139 | symmetry in HeqR. destruct f. 140 | eapply getEntryBlock_inv in Hinsucc; eauto. 141 | Qed. 142 | 143 | Lemma dom_acyclic: forall (l1 l2:l) 144 | (H: f ~>* l2) (H0: f |= l1 >> l2), 145 | ~ f |= l2 >>= l1. 146 | Proof. 147 | unfold_cfg f. 148 | eapply ACfg.dom_acyclic; eauto using entry_has_no_preds. 149 | Qed. 150 | 151 | Lemma sdom_tran1: forall (l1 l2 l3:l), 152 | f |= l1 >> l2 -> f |= l2 >>= l3 -> f |= l1 >> l3. 153 | Proof. 154 | unfold_cfg f. 155 | eapply ACfg.sdom_tran1; eauto using entry_has_no_preds. 156 | Qed. 157 | 158 | Lemma sdom_tran2: forall (l1 l2 l3:l), 159 | f |= l1 >>= l2 -> f |= l2 >> l3 -> f |= l1 >> l3. 160 | Proof. 161 | unfold_cfg f. 162 | eapply ACfg.sdom_tran2; eauto using entry_has_no_preds. 163 | Qed. 164 | 165 | Lemma sdom_tran: forall (l1 l2 l3:l), 166 | f |= l1 >> l2 -> f |= l2 >> l3 -> f |= l1 >> l3. 167 | Proof. 168 | intros. apply sdom_dom in H0. eapply sdom_tran1; eauto. 169 | Qed. 170 | 171 | Lemma idom_isnt_refl: forall l1 l2 (Hreach: f ~>* l2) 172 | (Hdom12 : f |= l1 >>> l2), 173 | l1 <> l2. 174 | Proof. 175 | unfold_cfg f. 176 | eapply ACfg.idom_isnt_refl; eauto. 177 | Qed. 178 | 179 | Lemma idom_sdom: forall l1 l2 (Hdom12 : f |= l1 >>> l2), 180 | f |= l1 >> l2. 181 | Proof. 182 | intros. destruct Hdom12. auto. 183 | Qed. 184 | 185 | Lemma idom_injective: forall p l1 l2 186 | (Hidom1 : f |= p >>> l1) (Hidom2 : f |= p >>> l2) 187 | (Hrd1 : f ~>* l1) (Hrd2 : f ~>* l2) 188 | (Hneq : l1 <> l2) 189 | (Hdec : f |= l1 >> l2 \/ f |= l2 >> l1), 190 | False. 191 | Proof. 192 | unfold_cfg f. 193 | eapply ACfg.idom_injective in Hdec; eauto using entry_has_no_preds. 194 | Qed. 195 | 196 | End dom_acyclic_tran. 197 | 198 | Lemma sdom_dec : forall f l1 l2, 199 | f |= l1 >> l2 \/ ~ f |= l1 >> l2. 200 | Proof. 201 | unfold_cfg f; auto. 202 | apply ACfg.sdom_dec; auto. 203 | Qed. 204 | 205 | Lemma non_sdom__inv: forall f l1 l2 be (Hentry: getEntryBlock f = Some be) 206 | (Hnsdom: ~ f |= l1 >> l2), 207 | exists vl, exists al, D_walk (vertexes_fdef f) (arcs_fdef f) 208 | (index l2) (index (getBlockLabel be)) vl al /\ 209 | ~ (In (index l1) vl /\ l1 <> l2). 210 | Proof. 211 | unfold_cfg f; auto. 212 | inv Hentry. 213 | eapply ACfg.non_sdom__inv; eauto. 214 | Qed. 215 | 216 | Lemma sdom_ordered : forall f l1 l2 l3 217 | (Hneq: l1 <> l2) (Hreach: f ~>* l3) 218 | (Hsdom: f |= l1 >> l3) 219 | (Hsdom': f |= l2 >> l3), 220 | f |= l1 >> l2 \/ f |= l2 >> l1. 221 | Proof. 222 | unfold_cfg f; auto. 223 | eapply ACfg.sdom_ordered; eauto. 224 | Qed. 225 | 226 | Lemma entry_doms_others: forall f entry l1 (Hnentry: l1 <> entry) 227 | (H: getEntryLabel f = Some entry), 228 | f |= entry >> l1. 229 | Proof. 230 | unfold_cfg f; auto. 231 | eapply ACfg.entry_doms_others; eauto. 232 | Qed. 233 | 234 | Close Scope dom. 235 | 236 | End DecDom. 237 | -------------------------------------------------------------------------------- /src/Vellvm/vellvm.v: -------------------------------------------------------------------------------- 1 | Require Export alist. 2 | Require Export Integers. 3 | Require Export Values. 4 | Require Export Coqlib. 5 | Require Export monad. 6 | Require Export events. 7 | Require Export Memory. 8 | Require Export Metatheory. 9 | Require Export Znumtheory. 10 | Require Export datatype_base. 11 | Require Import syntax. 12 | Require Import infrastructure. 13 | Require Export dom_list. 14 | Require Export analysis. 15 | Require Import typings. 16 | Require Import genericvalues. 17 | Require Import targetdata. 18 | Require Export infrastructure_props. 19 | Require Export static. 20 | Require Export opsem. 21 | Require Export opsem_wf. 22 | Require Export dopsem. 23 | Require Export ndopsem. 24 | Require Export external_intrinsics. 25 | Require Export vellvm_tactics. 26 | 27 | Export LLVMsyntax. 28 | Export LLVMinfra. 29 | Export LLVMgv. 30 | Export LLVMtd. 31 | Export LLVMtypings. 32 | 33 | Ltac destruct_cmd cmd := 34 | let i0 := fresh "i0" in 35 | let i1 := fresh "i1" in 36 | let b := fresh "b" in 37 | let s0 := fresh "s0" in 38 | let v := fresh "v" in 39 | let v0 := fresh "v0" in 40 | let v1 := fresh "v1" in 41 | let f0 := fresh "f0" in 42 | let f1 := fresh "f1" in 43 | let t := fresh "t" in 44 | let t0 := fresh "t0" in 45 | let t1 := fresh "t1" in 46 | let l2 := fresh "l2" in 47 | let a := fresh "a" in 48 | let p := fresh "p" in 49 | let n := fresh "n" in 50 | let c := fresh "c" in 51 | let e := fresh "e" in 52 | destruct cmd as [i0 b s0 v v0|i0 f0 f1 v v0|i0 t v l2 t0|i0 t v t0 v0 l2| 53 | i0 t v a|i0 t v|i0 t v a|i0 t v a|i0 t v v0 a|i0 i1 t v l2 t0| 54 | i0 t t0 v t1|i0 e t v t0|i0 c t v t0|i0 c t v v0| 55 | i0 f0 f1 v v0|i0 v t v0 v1|i0 n c t0 v0 v p]. 56 | 57 | Ltac destruct_typ t := 58 | let s0 := fresh "s0" in 59 | let f := fresh "f" in 60 | let t0 := fresh "t0" in 61 | let lt0 := fresh "lt0" in 62 | let i0 := fresh "i0" in 63 | destruct t as [s0 | f | | | | s0 t0 | t0 lt0 | lt0 | t0 | i0 ]. 64 | 65 | Ltac destruct_const cst := 66 | let Int5 := fresh "Int5" in 67 | let i0 := fresh "i0" in 68 | let b := fresh "b" in 69 | let sz5 := fresh "sz5" in 70 | let f0 := fresh "f0" in 71 | let f1 := fresh "f1" in 72 | let t := fresh "t" in 73 | let t0 := fresh "t0" in 74 | let l2 := fresh "l2" in 75 | let c0 := fresh "c0" in 76 | let c1 := fresh "c1" in 77 | let c2 := fresh "c2" in 78 | let e := fresh "e" in 79 | let cs0 := fresh "cs0" in 80 | destruct cst as [t|sz5 Int5|f0 f1|t|t|t cs0|t cs0|t i0|t c0 t0|e c0 t0|c0 c1 t0| 81 | i0 c0 cs0|c0 c1 c2|c0 c1 c2|f0 c1 c2|c0 cs0|c0 c1 cs0| 82 | b c0 c1|f0 c0 c1]. 83 | 84 | Ltac destruct_tmn tmn := 85 | let id5 := fresh "id5" in 86 | let t := fresh "t" in 87 | let value5 := fresh "value5" in 88 | let l2 := fresh "l2" in 89 | let l3 := fresh "l3" in 90 | let i0 := fresh "i0" in 91 | destruct tmn as [id5 t value5 | id5 | id5 value5 l2 l3 | i0 l2 | ]. 92 | 93 | Ltac repeat_bsplit := 94 | repeat (bsplit; auto using eq_sumbool2bool_true). 95 | 96 | Ltac uniq_result := 97 | repeat dgvs_instantiate_inv; 98 | repeat match goal with 99 | | H1 : ?f ?a ?b ?c ?d = _, 100 | H2 : ?f ?a ?b ?c ?d = _ |- _ => 101 | rewrite H1 in H2; inv H2 102 | | H1 : ?f ?a ?b ?c = _, 103 | H2 : ?f ?a ?b ?c = _ |- _ => 104 | rewrite H1 in H2; inv H2 105 | | H1 : ?f ?a ?b = _, 106 | H2 : ?f ?a ?b = _ |- _ => 107 | rewrite H1 in H2; inv H2 108 | | H1 : ?f ?a = _, 109 | H2 : ?f ?a = _ |- _ => 110 | rewrite H1 in H2; inv H2 111 | | H1 : _ @ _ |- _ => inv H1 112 | | H : ?f _ = ?f _ |- _ => inv H 113 | | H : ?f _ _ = ?f _ _ |- _ => inv H 114 | | H : ?f _ _ _ = ?f _ _ _ |- _ => inv H 115 | | H : ?f _ _ _ _ = ?f _ _ _ _ |- _ => inv H 116 | | H : ?f _ _ _ _ _ = ?f _ _ _ _ _ |- _ => inv H 117 | | H : False |- _ => inv H 118 | | H: moduleEqB _ _ = true |- _ => apply moduleEqB_inv in H; inv H 119 | | H: valueEqB _ _ = true |- _ => apply valueEqB_inv in H; inv H 120 | | H: true = valueEqB _ _ |- _ => 121 | symmetry in H; apply valueEqB_inv in H; inv H 122 | | H: phinodeEqB _ _ = true |- _ => apply phinodeEqB_inv in H; inv H 123 | | H: _ =cmd= _ = true |- _ => apply cmdEqB_inv in H; inv H 124 | | H: _ =tmn= _ = true |- _ => apply terminatorEqB_inv in H; inv H 125 | | H: _ =b= _ = true |- _ => apply blockEqB_inv in H; inv H 126 | | H: left ?e = false |- _ => inv H 127 | | J1 : ?f = Some _, J2 : None = ?f |- _ => 128 | rewrite J1 in J2; congruence 129 | end. 130 | 131 | Ltac wfCall_inv := 132 | match goal with 133 | | Heq3 : exists _, 134 | exists _, 135 | exists _, 136 | ?B = (_, stmts_intro _ _ _), 137 | HBinF1 : blockInFdefB ?B ?F = true, 138 | HwfCall : OpsemPP.wf_call 139 | {| 140 | Opsem.CurFunction := ?F; 141 | Opsem.CurBB := ?B; 142 | Opsem.CurCmds := nil; 143 | Opsem.Terminator := _; 144 | Opsem.Locals := _; 145 | Opsem.Allocas := _ |} 146 | ({| 147 | Opsem.CurFunction := _; 148 | Opsem.CurBB := _; 149 | Opsem.CurCmds := ?c' :: _; 150 | Opsem.Terminator := _; 151 | Opsem.Locals := _; 152 | Opsem.Allocas := _ |} :: _) |- _ => 153 | let cs3 := fresh "cs3" in 154 | destruct Heq3 as [l3 [ps3 [cs3 Heq3]]]; subst; 155 | assert (HBinF1':=HBinF1); 156 | apply HwfCall in HBinF1'; 157 | destruct_cmd c'; tinv HBinF1'; clear HBinF1' 158 | end. 159 | 160 | Lemma getTypeSizeInBits_and_Alignment__getTypeStoreSize: forall TD t sz al, 161 | getTypeSizeInBits_and_Alignment TD true t = Some (sz, al) -> 162 | getTypeStoreSize TD t = Some (nat_of_Z (ZRdiv (Z_of_nat sz) 8)). 163 | Proof. 164 | unfold getTypeStoreSize, getTypeSizeInBits. 165 | intros. fill_ctxhole. auto. 166 | Qed. 167 | 168 | Ltac inTmnOp_isnt_stuck v H3 Hwfcfg1 Hwfpp1 := 169 | match type of Hwfpp1 with 170 | | OpsemPP.wf_State 171 | {| 172 | OpsemAux.CurSystem := _; 173 | OpsemAux.CurTargetData := ?td; 174 | OpsemAux.CurProducts := _; 175 | OpsemAux.Globals := ?gl; 176 | OpsemAux.FunTable := _ |} 177 | {| Opsem.ECS := {| Opsem.CurFunction := _; 178 | Opsem.CurBB := ?b; 179 | Opsem.CurCmds := nil; 180 | Opsem.Terminator := ?tmn; 181 | Opsem.Locals := ?lc; 182 | Opsem.Allocas := _ 183 | |} :: _; 184 | Opsem.Mem := _ |} => 185 | let G := fresh "G" in 186 | let gvs := fresh "gvs" in 187 | assert (exists gvs, Opsem.getOperandValue td v lc gl = Some gvs) as G; 188 | try solve [ 189 | destruct H3 as [l5 [ps2 [cs21 H3]]]; subst; 190 | destruct Hwfcfg1 as [_ [Hwfg1 [Hwfs1 HmInS1]]]; 191 | destruct Hwfpp1 as 192 | [_ [[Hreach1 [HbInF1 [HfInPs1 [_ [Hinscope1 _]]]]] _]]; 193 | inv_mbind; 194 | eapply OpsemPP.getOperandValue_inTmnOperans_isnt_stuck; eauto 1; 195 | simpl; auto 196 | ]; 197 | destruct G as [gvs G] 198 | end. 199 | 200 | -------------------------------------------------------------------------------- /src/Vellvm/ott/ott_list_nth.v: -------------------------------------------------------------------------------- 1 | Require Import Arith. 2 | Require Import Omega. 3 | Require Import List. 4 | Require Import ott_list_support. 5 | Require Import ott_list_base. 6 | 7 | 8 | 9 | Section Lists. 10 | 11 | Variables A B C : Set. 12 | Implicit Types x : A. 13 | Implicit Types y : B. 14 | Implicit Types z : C. 15 | Implicit Types xs l : list A. 16 | Implicit Types ys : list B. 17 | Implicit Types zs : list C. 18 | Implicit Types f : A -> B. 19 | Implicit Types g : B -> C. 20 | Implicit Types m n : nat. 21 | Set Implicit Arguments. 22 | 23 | Ltac case_eq foo := 24 | generalize (refl_equal foo); 25 | pattern foo at -1; 26 | case foo. 27 | 28 | 29 | 30 | (*** Nth element ***) 31 | 32 | Unset Implicit Arguments. 33 | 34 | Fixpoint nth_safe l n {struct l} : n < length l -> A := 35 | match l as l1, n as n1 return n1 < length l1 -> A with 36 | | h::t, 0 => fun H => h 37 | | h::t, S m => fun H => nth_safe t m (le_S_n _ _ H) 38 | | nil, _ => fun H => match le_Sn_O _ H with end 39 | end. 40 | Implicit Arguments nth_safe []. 41 | 42 | Lemma nth_safe_eq_nth_error : 43 | forall l n H, value (nth_safe l n H) = nth_error l n. 44 | Proof. 45 | induction l; intro n; pose (F := le_Sn_O n); destruct n; try (contradiction || tauto). 46 | simpl length; intro H. 47 | simpl nth_error; rewrite <- (IHl n (le_S_n _ _ H)). 48 | reflexivity. 49 | Qed. 50 | 51 | Lemma nth_safe_proof_irrelevance : 52 | forall l n H H', nth_safe l n H = nth_safe l n H'. 53 | Proof. 54 | intros. assert (value (nth_safe l n H) = value (nth_safe l n H')). 55 | transitivity (nth_error l n); 56 | apply nth_safe_eq_nth_error || (symmetry; apply nth_safe_eq_nth_error). 57 | injection H0; trivial. 58 | Qed. 59 | 60 | Lemma nth_safe_cons : 61 | forall x l n H, 62 | nth_safe (x::l) (S n) H = nth_safe l n (le_S_n (S n) (length l) H). 63 | Proof. intros. reflexivity. Qed. 64 | 65 | Lemma nth_safe_app : 66 | forall l l' n (H:n nth_error l n = error. 94 | Proof. 95 | induction l; intros n H. solve [apply nth_error_nil]. 96 | simpl in H. destruct n. assert False; [omega | intuition]. 97 | simpl. apply IHl. omega. 98 | Qed. 99 | 100 | Lemma nth_error_app_prefix : 101 | forall l l' n H, nth_error (l++l') n = value (nth_safe l n H). 102 | Proof. 103 | intros. 104 | assert (H' : n < length (l ++ l')). 105 | rewrite (length_app l l'). solve [auto with arith]. 106 | transitivity (value (nth_safe (l++l') n H')). 107 | solve [apply nth_error_in]. 108 | assert ((nth_safe l n H) = (nth_safe (l ++ l') n H')). 109 | elim (nth_safe_app l l' n H). intros. 110 | rewrite H0. apply nth_safe_proof_irrelevance. 111 | rewrite H0. reflexivity. 112 | Qed. 113 | 114 | Lemma nth_error_app_suffix : 115 | forall l l' n, nth_error (l++l') (length l + n) = nth_error l' n. 116 | Proof. 117 | induction l; intros; simpl; auto. 118 | Qed. 119 | 120 | Lemma nth_error_dec : 121 | forall l n, nth_error l n = match le_lt_dec (length l) n with 122 | | left _ => error 123 | | right H => value (nth_safe l n H) 124 | end. 125 | Proof. 126 | intros l n; generalize l; clear l. induction n; destruct l; try reflexivity. 127 | simpl nth_error. simpl length. rewrite (IHn l); clear IHn. 128 | decompose sum (lt_eq_lt_dec (length l) n); 129 | destruct (le_lt_dec (length l) n); 130 | destruct (le_lt_dec (S (length l)) (S n)); 131 | reflexivity || 132 | (assert False; [omega | intuition]) || 133 | simpl. 134 | match match goal with |- ?g => g end with value ?lhs = value ?rhs => 135 | assert (Eq : lhs=rhs) 136 | end. apply nth_safe_proof_irrelevance. rewrite Eq; reflexivity. 137 | Qed. 138 | 139 | Lemma nth_error_length : 140 | forall l n, match nth_error l n with 141 | | value _ => n < length l 142 | | error => n >= length l 143 | end. 144 | Proof. 145 | induction l; intros; destruct n; try solve [compute; auto with arith]. 146 | simpl. pose (H := IHl n). 147 | case_eq (nth_error l n); intros; 148 | rewrite H0 in H; auto with arith. 149 | Qed. 150 | 151 | Lemma nth_error_value : 152 | forall l n x, nth_error l n = value x -> n < length l. 153 | Proof. intros; assert (L := nth_error_length l n). rewrite H in L; exact L. Qed. 154 | Lemma nth_error_error : 155 | forall l n, nth_error l n = error -> n >= length l. 156 | Proof. intros; assert (L := nth_error_length l n). rewrite H in L; exact L. Qed. 157 | 158 | Lemma nth_eq_nth_safe : 159 | forall l n default, 160 | nth n l default = match le_lt_dec (length l) n with 161 | | left _ => default 162 | | right H => nth_safe l n H 163 | end. 164 | Proof. 165 | induction l; destruct n; reflexivity || intros. simpl nth; simpl length. 166 | destruct (le_lt_dec (S (length l)) (S n)); 167 | case_eq (le_lt_dec (length l) n); intros; 168 | [idtac | elimtype False; omega | elimtype False; omega | idtac]; 169 | pose (H' := IHl n default); rewrite H in H'; rewrite H'. 170 | reflexivity. simpl; apply nth_safe_proof_irrelevance. 171 | Qed. 172 | 173 | Lemma nth_eq_nth_error : 174 | forall l n default, 175 | nth n l default = match nth_error l n with 176 | | value x => x 177 | | error => default 178 | end. 179 | Proof. 180 | induction l; destruct n; intros; try reflexivity. simpl; apply IHl. 181 | Qed. 182 | 183 | End Lists. 184 | 185 | Implicit Arguments nth_safe [A]. 186 | Implicit Arguments nth_safe_eq_nth_error [A]. 187 | Implicit Arguments nth_safe_proof_irrelevance [A]. 188 | Implicit Arguments nth_safe_cons [A]. 189 | Implicit Arguments nth_safe_app [A]. 190 | 191 | Hint Rewrite nth_map nth_ok_map nth_error_map : lists. 192 | Hint Rewrite nth_error_nil : lists. 193 | Hint Rewrite nth_error_in nth_error_out using omega : list_nth_error. 194 | Hint Rewrite nth_error_dec : list_nth_dec. 195 | Hint Resolve nth_error_value nth_error_error : datatypes. 196 | -------------------------------------------------------------------------------- /src/Vellvm/ott/ott_list_distinct.v: -------------------------------------------------------------------------------- 1 | (*** Lists with no repetition ***) 2 | 3 | Require Import Arith. 4 | Require Import Bool. 5 | Require Import List. 6 | Require Import Ring. 7 | Require Import ott_list_core. 8 | Require Import ott_list_base. 9 | Require Import ott_list_nth. 10 | Require Import ott_list_mem. 11 | 12 | 13 | 14 | Section All_distinct. 15 | Set Implicit Arguments. 16 | Variable A : Set. 17 | Variable eq_dec : forall (x y:A), {x=y} + {x<>y}. 18 | 19 | Notation one_distinct := (fun x xs => negb (list_mem eq_dec x xs)). 20 | 21 | Fixpoint all_distinct (xs:list A) : bool := 22 | match xs with 23 | | nil => true 24 | | x::xt => andb (one_distinct x xt) (all_distinct xt) 25 | end. 26 | Fixpoint disjoint (xs ys:list A) {struct xs} : bool := 27 | match xs with 28 | | nil => true 29 | | x::xt => andb (one_distinct x ys) (disjoint xt ys) 30 | end. 31 | 32 | 33 | 34 | Ltac destruct_andb := 35 | repeat match goal with 36 | | H : Is_true (?a && ?b) |- _ => 37 | (* N.B. [andb_prop2] is called [andb_prop_elim] after V8.1 *) 38 | destruct (andb_prop2 a b H); clear H 39 | end. 40 | 41 | Lemma one_distinct_eq_fold_right : 42 | forall x0 xs, 43 | one_distinct x0 xs = 44 | fold_right (fun x b => if eq_dec x x0 then false else b) true xs. 45 | Proof. 46 | induction xs; simpl in * . reflexivity. 47 | destruct (eq_dec a x0); simpl in *; congruence. 48 | Qed. 49 | Lemma disjoint_eq_fold_right : 50 | forall xs ys, 51 | disjoint xs ys = fold_right (fun x => andb (one_distinct x ys)) true xs. 52 | Proof. intros; induction xs; simpl in *; congruence. Qed. 53 | 54 | Lemma one_distinct_app : 55 | forall x xs ys, 56 | one_distinct x (xs++ys) = one_distinct x xs && one_distinct x ys. 57 | Proof. 58 | intros; induction xs; simpl in * . reflexivity. 59 | destruct (eq_dec a x); auto with bool. 60 | Qed. 61 | Lemma all_distinct_app : 62 | forall xs ys, 63 | all_distinct (xs++ys) = 64 | all_distinct xs && all_distinct ys && disjoint xs ys. 65 | Proof. 66 | intros; induction xs; simpl in * . ring. 67 | rewrite one_distinct_app. rewrite IHxs. ring. 68 | Qed. 69 | 70 | Lemma one_distinct_app_left : 71 | forall x xs ys, 72 | Is_true (one_distinct x (xs++ys)) -> Is_true (one_distinct x xs). 73 | Proof. 74 | intros; simpl in * . 75 | simplify_lists. apply Is_true_eq_left. assert (H' := Is_true_eq_true _ H). 76 | unfold negb in * . destruct (list_mem eq_dec x xs); auto. 77 | Qed. 78 | Lemma all_distinct_app_left : 79 | forall xs ys, Is_true (all_distinct (xs++ys)) -> Is_true (all_distinct xs). 80 | Proof. 81 | intros. rewrite all_distinct_app in H. 82 | destruct_andb; assumption. 83 | Qed. 84 | Lemma one_distinct_app_right : 85 | forall x xs ys, 86 | Is_true (one_distinct x (xs++ys)) -> Is_true (one_distinct x xs). 87 | Proof. 88 | intros; simpl in * . 89 | simplify_lists. apply Is_true_eq_left. assert (H' := Is_true_eq_true _ H). 90 | unfold negb in * . destruct (list_mem eq_dec x xs); auto. 91 | Qed. 92 | Lemma all_distinct_app_right : 93 | forall xs ys, Is_true (all_distinct (xs++ys)) -> Is_true (all_distinct xs). 94 | Proof. 95 | intros. rewrite all_distinct_app in H. 96 | destruct_andb; assumption. 97 | Qed. 98 | 99 | Lemma disjoint_nil_left : forall xs, disjoint nil xs = true. 100 | Proof. reflexivity. Qed. 101 | Lemma disjoint_nil_right : forall xs, disjoint xs nil = true. 102 | Proof. induction xs; simpl; congruence. Qed. 103 | Lemma disjoint_comm : 104 | forall xs ys, disjoint xs ys = disjoint ys xs. 105 | Proof. 106 | induction xs; intros; simpl in * . 107 | rewrite disjoint_nil_right; reflexivity. 108 | induction ys; simpl in * . rewrite IHxs; reflexivity. 109 | rewrite <- IHys; repeat rewrite IHxs; simpl. 110 | destruct (eq_dec a0 a); destruct (eq_dec a a0); try subst a0. 111 | reflexivity. elim n; reflexivity. elim n; reflexivity. ring. 112 | Qed. 113 | Lemma disjoint_app_distr_left : 114 | forall xs ys zs, disjoint xs (ys++zs) = disjoint xs ys && disjoint xs zs. 115 | Proof. 116 | intros. induction xs; simpl in * . reflexivity. 117 | rewrite IHxs; rewrite one_distinct_app. ring. 118 | Qed. 119 | Lemma disjoint_app_distr_right : 120 | forall xs ys zs, disjoint (xs++ys) zs = disjoint xs zs && disjoint ys zs. 121 | Proof. 122 | intros. rewrite disjoint_comm. rewrite disjoint_app_distr_left. 123 | do 2 rewrite (disjoint_comm zs). reflexivity. 124 | Qed. 125 | 126 | Lemma rev_one_distinct : 127 | forall x xs, one_distinct x (rev xs) = one_distinct x xs. 128 | Proof. 129 | intros; induction xs; simpl in * . reflexivity. 130 | rewrite one_distinct_app; rewrite IHxs; simpl. 131 | destruct (eq_dec a x); ring. 132 | Qed. 133 | Lemma rev_disjoint_right : 134 | forall xs ys, disjoint xs (rev ys) = disjoint xs ys. 135 | Proof. 136 | intros; induction xs; simpl in * . reflexivity. 137 | rewrite rev_one_distinct; rewrite IHxs; reflexivity. 138 | Qed. 139 | Lemma rev_disjoint_left : 140 | forall xs ys, disjoint (rev xs) ys = disjoint xs ys. 141 | Proof. 142 | intros; induction xs; simpl in * . reflexivity. 143 | rewrite disjoint_app_distr_right; simpl. rewrite IHxs; ring. 144 | Qed. 145 | Lemma rev_all_distinct : 146 | forall xs, all_distinct (rev xs) = all_distinct xs. 147 | Proof. 148 | intros; induction xs; simpl in * . reflexivity. 149 | rewrite all_distinct_app; simpl. rewrite IHxs. 150 | rewrite rev_disjoint_left; rewrite disjoint_comm; simpl; ring. 151 | Qed. 152 | 153 | Lemma all_distinct_indices_aux : 154 | forall xs i j, 155 | i <= j -> 156 | Is_true (all_distinct xs) -> 157 | nth_error xs i = nth_error xs j -> 158 | i < length xs -> 159 | i = j. 160 | Proof. 161 | intros xs i j Ineq. 162 | replace j with (i + (j-i)). 2: solve [auto with arith]. 163 | generalize (j-i); clear Ineq j; intros k Distinct Nths Bound. 164 | destruct k. solve [auto with arith]. elimtype False. 165 | generalize dependent xs; induction i; intros; destruct xs; simpl in * . 166 | omega. 167 | destruct (andb_prop2 _ _ Distinct) as [Notin _]; clear Distinct Bound. 168 | generalize dependent k; induction xs; intros; simpl in * . 169 | destruct k; discriminate. 170 | destruct (eq_dec a0 a). exact Notin. 171 | destruct k; simpl in *; [injection Nths | idtac]; solve [eauto]. 172 | omega. 173 | eapply IHi; eauto. destruct_andb; assumption. 174 | omega. 175 | Qed. 176 | Lemma all_distinct_indices : 177 | forall xs i j, 178 | Is_true (all_distinct xs) -> 179 | nth_error xs i = nth_error xs j -> 180 | i < length xs -> 181 | i = j. 182 | Proof. 183 | intros. destruct (le_ge_dec i j). 184 | eapply all_distinct_indices_aux; eauto. 185 | symmetry. eapply all_distinct_indices_aux; eauto. omega. 186 | Qed. 187 | 188 | End All_distinct. 189 | 190 | Notation one_distinct := (fun eq_dec x xs => negb (list_mem eq_dec x xs)). 191 | 192 | Hint Rewrite one_distinct_app all_distinct_app : lists. 193 | Hint Rewrite disjoint_nil_left disjoint_nil_right : lists. 194 | Hint Rewrite disjoint_app_distr_left disjoint_app_distr_right : lists. 195 | Hint Rewrite rev_one_distinct rev_disjoint_right rev_disjoint_left 196 | rev_all_distinct : lists. 197 | -------------------------------------------------------------------------------- /src/Vellvm/Dominators/README-cpp12: -------------------------------------------------------------------------------- 1 | =========================================================================== 2 | GENERAL DESCRIPTION 3 | =========================================================================== 4 | 5 | This is the source code of the CPP12 submission. The main source code 6 | submitted to CPP12 is at release/vol/src3.0/Vellvm/Dominators/README. 7 | 8 | * Formalism (the Coq code): 9 | http://www.cis.upenn.edu/~jianzhou/Vellvm/dominance/cpp12.tgz 10 | * LLVM 3.0 with extended OCaml-LLVM bindings: 11 | http://www.cis.upenn.edu/~jianzhou/Vellvm/llvm-3.0.src.tgz 12 | 13 | =========================================================================== 14 | CONTENTS 15 | =========================================================================== 16 | 17 | decompress cpp12.tgz to $(WHERE_RELEASE_IS) 18 | 19 | VOL = $(WHERE_RELEASE_IS)/vol 20 | 21 | in $(WHERE_RELEASE_IS) 22 | 23 | theory/metatheory_8.3 : 24 | The Penn Metatheory library, which can also be downloaded from 25 | * http://www.cis.upenn.edu/~jianzhou/Vellvm/metatheory.tgz 26 | 27 | vol/extralibs : Coq plug-ins -- Float and Equations 28 | 29 | vol/src3.0/Vellvm/compcert : The modified Compcert Memory Model (1.8) 30 | http://compcert.inria.fr/release/compcert-1.8.tgz 31 | 32 | vol/src3.0/Vellvm/ott : The modified coq libraries from Ott installation, 33 | which define properties of lists generated by Ott, but fixed some bugs. 34 | 35 | vol/src3.0/Vellvm/monads : Monads operations for 'imperative' programming 36 | 37 | vol/src/Vellvm/GraphBasics : Graph theory libraries from 38 | http://coq.inria.fr/pylons/contribs/view/GraphBasics/v8.3 39 | 40 | vol/src3.0/Vellvm : The Formalisms of LLVM IR 41 | 42 | syntax.ott : The definitions of LLVM IR in Ott 43 | 44 | infrastructure.v : Operations over LLVM IR, such as, returning types and 45 | operands of an instruction, classifying instructions, 46 | traversing functions, checking if an instruction dominates 47 | others, building explicit CFGs, ... 48 | 49 | infrastructure_props.v : Properties of LLVM IR, such as, decidability of 50 | equivalence over types, instructions, and other components, 51 | uniqueness of IDs, inclusion between functions and modules, 52 | ... 53 | 54 | targetdata.v : Calculating bitsize, alignment, padding information in 55 | term of user-defined data layout in IR. 56 | 57 | genericvalues.v : Representations of run-time values used in the operational 58 | semantics, and the LLVM memory model, which is actually a 59 | wrapper of the CompCert memory model, with conversion 60 | between LLVM datatypes and datatypes that CompCert memory 61 | model can handle. 62 | 63 | analysis : Domination/reachability analysis 64 | 65 | typings.ott : LLVM IR typings 66 | 67 | opsem.v : A generic semantics (small-step/big-step) that can be 68 | instantiated as either a deterministic version or a non- 69 | deterministic version. 70 | 71 | dopsem.v : A deterministic instance of Opsem. 72 | 73 | opsem_inst.v : deterministic instances are included by non-deterministic 74 | instances. 75 | 76 | tactics.v : Tacticals 77 | 78 | opsem_props/wf.v : Progress and preservation of operational semantics 79 | 80 | interpreter.v : An interpreter that is consistent with small-step 81 | deterministic operational semantics. 82 | 83 | vol/src3.0/Vellvm/Dominators : The dominance analysis submitted to CPP12 84 | See the README in the directory. 85 | 86 | vol/src3.0/Extraction : 87 | extraction_core.v : Extracting an OCaml interpreter 88 | extraction_dom.v : Extracting an OCaml Dominance analysis 89 | llvm_aux.ml/llvm_pretty_printer.ml : printing LLVM AST 90 | coq_pretty_printer.ml : printing Coq AST 91 | coq2llvm.ml : Translating Coq AST to LLVM AST 92 | llvm2coq.ml : Translating LLVM AST to Coq AST 93 | llvmcaml.ml/Camlcoq.ml : Realizing performance-sensitive operations 94 | into C++ definitions, for example, memory operations, int/float operations 95 | 96 | =========================================================================== 97 | DEPENDENCIES 98 | =========================================================================== 99 | 100 | * OCaml 3.12.0, 3.12.1 101 | http://caml.inria.fr/pub/distrib/ocaml-3.12/ocaml-3.12.0.tar.gz 102 | 103 | * Coq 8.3pl1, Coq 8.4beta 104 | 105 | * Two plug-ins of Coq 8.3 to install 106 | 1) Float $(VOL)/extralibs/Float8.2-1.2r.tgz 107 | A modified version from (https://lipforge.ens-lyon.fr/projects/pff/) to 108 | compile in 8.3 109 | 2) Equations $(VOL)/extralibs/mattam82-Coq-Equations-e52679e.tgz 110 | Same to https://github.com/mattam82/Coq-Equations/tree/8.3 111 | 112 | * Ott, which generates Coq definitions from *.ott in $(VOL)/src/Vellvm 113 | * Download http://www.cl.cam.ac.uk/~pes20/ott/ott_distro_0.20.1.tar.gz 114 | * Install following its instructions 115 | * Add Ott to PATH 116 | 117 | * The Penn Metatheory library: 118 | * $WHERE_RELEASE_IS$/theory/metatheory_8.3 119 | * or download from http://www.cis.upenn.edu/~jianzhou/Vellvm/metatheory.tgz 120 | 121 | * libffi 122 | http://sourceware.org/libffi/ 123 | The extracted interpreter needs libffi to call external functions. 124 | This is optional if you don't call the extracted interpreter with external 125 | fuctions. 126 | 127 | If you install libffi after installing LLVM, you need re-configure and 128 | recompile the LLVM. 129 | 130 | * The modified LLVM 3.0 131 | * Download the http://www.cis.upenn.edu/~jianzhou/Vellvm/llvm-3.0.src.tgz 132 | * tar zfxv llvm-3.0.src.tgz 133 | * mkdir llvm-3.0-obj 134 | * mkdir $WHERE_TO_INSTALL 135 | * cd llvm-3.0-obj 136 | * ../llvm-3.0.src/configure --prefix=$WHERE_TO_INSTALL --enable-libffi 137 | * make ENABLE_OPTIMIZED=0 // this is to build a debugging version of 138 | // llvm, in case the modification is buggy... 139 | // 'make' or 'make ENABLE_OPTIMIZED=1' will 140 | // build a release version 141 | * make ENABLE_OPTIMIZED=0 install 142 | 143 | =========================================================================== 144 | COMPILING 145 | =========================================================================== 146 | 147 | In $(VOL)/../theory/metatheory_8.3, make 148 | 149 | In $(VOL)/src3.0/, 150 | cp Makefile.config.sample Makefile.config 151 | set the variables in Makefile.config in term of your system. 152 | Then, make 153 | 154 | =========================================================================== 155 | EDITING 156 | =========================================================================== 157 | 158 | In $(VOL)/src3.0/, 159 | cp .dir-locals.el.sample .dir-locals.el 160 | set the variables in .dir-locals.el in term of your system. 161 | Then, emacs Coq files in $(VOL)/src3.0/ 162 | 163 | -------------------------------------------------------------------------------- /src/Vellvm/ott/ott_list_base.v: -------------------------------------------------------------------------------- 1 | (* Additional definitions and lemmas on lists *) 2 | 3 | Require Import Arith. 4 | Require Import List. 5 | Require Import Omega. 6 | Require Import Wf_nat. 7 | Require Import ott_list_support. 8 | 9 | 10 | 11 | (*** Tactic definitions ***) 12 | 13 | (* Tactic definitions do not survive their section, so tactics that are 14 | exported must come outside of any section. *) 15 | 16 | Ltac reverse_list l l' := 17 | let Rev := fresh "Rev" with tmp := fresh "l" in ( 18 | set (tmp := rev l) in *; 19 | assert (Rev : l = rev tmp); 20 | [rewrite <- (rev_involutive l); reflexivity | 21 | clearbody tmp; subst l; rename tmp into l'] 22 | ). 23 | 24 | 25 | 26 | (*** Start of the Lists section ***) 27 | 28 | Section Lists. 29 | 30 | Variables A B C : Set. 31 | Implicit Types x : A. 32 | Implicit Types y : B. 33 | Implicit Types z : C. 34 | Implicit Types xs l : list A. 35 | Implicit Types ys : list B. 36 | Implicit Types zs : list C. 37 | Implicit Types f : A -> B. 38 | Implicit Types g : B -> C. 39 | Implicit Types m n : nat. 40 | Set Implicit Arguments. 41 | 42 | 43 | 44 | 45 | (*** Length ***) 46 | 47 | Definition lt_length (A:Set) := ltof _ (@length A). 48 | Definition well_founded_lt_length (A:Set) := (well_founded_ltof _ (@length A)). 49 | 50 | Lemma length_app : forall l l', length (l ++ l') = length l + length l'. 51 | Proof. 52 | induction l; simpl; auto. 53 | Qed. 54 | 55 | 56 | 57 | 58 | (*** Reverse ***) 59 | 60 | Lemma length_rev : forall l, length (rev l) = length l. 61 | Proof. 62 | induction l; auto. 63 | simpl. rewrite length_app. rewrite IHl. simpl. rewrite plus_comm. auto. 64 | Qed. 65 | 66 | Definition rev_rev := rev_involutive. 67 | 68 | Lemma rev_inj : forall l l', rev l = rev l' -> l = l'. 69 | Proof. 70 | intros. rewrite <- (rev_involutive l). rewrite <- (rev_involutive l'). 71 | apply (f_equal (@rev A)). assumption. 72 | Qed. 73 | 74 | 75 | 76 | (*** Concatenation ***) 77 | 78 | Lemma rev_app : forall l l', rev (l++l') = rev l' ++ rev l. 79 | Proof (@distr_rev A). 80 | 81 | Lemma app_inj_prefix : forall l l1 l2, l++l1 = l++l2 -> l1 = l2. 82 | Proof. 83 | intros. induction l. assumption. 84 | simpl in H. injection H; intros. auto. 85 | Qed. 86 | 87 | Lemma app_inj_suffix : forall l l1 l2, l1++l = l2++l -> l1 = l2. 88 | Proof. 89 | intros. reverse_list l1 l1. reverse_list l2 l2. reverse_list l l. 90 | apply (f_equal (@rev A)). apply app_inj_prefix with (l := l). 91 | apply rev_inj. repeat rewrite rev_app. assumption. 92 | Qed. 93 | 94 | Lemma app_inj_prefix_length_prefix : 95 | forall l0 l1 l0' l1', 96 | length l0 = length l0' -> l0++l1 = l0'++l1' -> l0 = l0'. 97 | Proof. 98 | intros. generalize dependent l0'; induction l0; intros. 99 | destruct l0'; simpl in *; [congruence | discriminate]. 100 | destruct l0'. discriminate. injection H0; intros. 101 | rewrite (IHl0 l0'); auto. congruence. 102 | Qed. 103 | Lemma app_inj_prefix_length_suffix : 104 | forall l0 l1 l0' l1', 105 | length l0 = length l0' -> l0++l1 = l0'++l1' -> l1 = l1'. 106 | Proof. 107 | intros. rewrite (app_inj_prefix_length_prefix _ _ _ _ H H0) in H0. 108 | eapply app_inj_prefix; eauto. 109 | Qed. 110 | Lemma app_inj_suffix_length_prefix : 111 | forall l0 l1 l0' l1', 112 | length l1 = length l1' -> l0++l1 = l0'++l1' -> l0 = l0'. 113 | Proof. 114 | intros. eapply app_inj_prefix_length_prefix. 2: eexact H0. 115 | assert (Eq := f_equal (@length A) H0). 116 | repeat rewrite length_app in Eq. omega. 117 | Qed. 118 | Lemma app_inj_suffix_length_suffix : 119 | forall l0 l1 l0' l1', 120 | length l1 = length l1' -> l0++l1 = l0'++l1' -> l1 = l1'. 121 | Proof. 122 | intros. rewrite (app_inj_suffix_length_prefix _ _ _ _ H H0) in H0. 123 | eapply app_inj_prefix; eauto. 124 | Qed. 125 | 126 | 127 | 128 | (*** Map ***) 129 | 130 | Lemma length_map : forall f l, length (map f l) = length l. 131 | Proof. 132 | induction l; simpl; auto. 133 | Qed. 134 | 135 | Lemma nth_map : forall n f l x, nth n (map f l) (f x) = f (nth n l x). 136 | Proof. 137 | intros until l. generalize n; clear n. 138 | induction l; simpl; destruct n; auto. 139 | Qed. 140 | 141 | Lemma nth_ok_map : forall n f l x, nth_ok n (map f l) (f x) = nth_ok n l x. 142 | Proof. 143 | intros until l. generalize n; clear n. 144 | induction l; simpl; destruct n; auto. 145 | Qed. 146 | 147 | Lemma nth_error_map : 148 | forall n f l, nth_error (map f l) n = map_error f (nth_error l n). 149 | Proof. 150 | intros until l. generalize n; clear n. 151 | induction l; simpl; destruct n; simpl; auto. 152 | Qed. 153 | 154 | Lemma map_app : forall f l l', map f (l ++ l') = map f l ++ map f l'. 155 | Proof. 156 | induction l; auto. intro l'. simpl. rewrite (IHl l'). auto. 157 | Qed. 158 | 159 | Lemma map_map : forall f g l, map g (map f l) = map (compose g f) l. 160 | Proof. 161 | induction l; auto. simpl. rewrite IHl. reflexivity. 162 | Qed. 163 | 164 | Lemma map_identity : forall l, map (fun x => x) l = l. 165 | Proof. induction l; simpl; congruence. Qed. 166 | 167 | Lemma map_extensionality : 168 | forall f f' l, (forall x, f x = f' x) -> map f l = map f' l. 169 | Proof. intros; induction l; simpl; try rewrite H; congruence. Qed. 170 | 171 | Lemma map_rev : forall f l, map f (rev l) = rev (map f l). 172 | Proof. 173 | induction l; auto. 174 | simpl. rewrite map_app. rewrite IHl. reflexivity. 175 | Qed. 176 | 177 | 178 | 179 | (*** End of the Lists section ***) 180 | 181 | End Lists. 182 | Implicit Arguments lt_length [A]. 183 | 184 | Hint Resolve length_app length_map length_rev : datatypes. 185 | Hint Rewrite length_app length_map length_rev : lists. 186 | Hint Rewrite rev_app rev_unit rev_rev : lists. 187 | Hint Rewrite app_ass : lists. 188 | Hint Rewrite <- app_nil_end app_comm_cons : lists. 189 | Hint Rewrite map_app map_map map_rev map_identity : lists. 190 | Hint Rewrite app_inj_prefix_length_prefix app_inj_prefix_length_suffix 191 | app_inj_suffix_length_prefix app_inj_suffix_length_suffix 192 | app_inj_prefix app_inj_suffix : app_inj. 193 | 194 | 195 | 196 | (* Look for equations in the context that prove that some lists are empty, 197 | and substitute them away. *) 198 | Ltac eliminate_nil := 199 | repeat 200 | match goal with 201 | | H : nil = ?l1 ++ ?l2 |- _ => symmetry in H 202 | | H : ?l1 ++ ?l2 = nil |- _ => 203 | destruct (app_eq_nil l1 l2 H); try clear H 204 | | H : nil = ?l |- _ => symmetry in H 205 | | H : ?l = nil |- _ => subst l 206 | end. 207 | 208 | (* Simplify all hypotheses involving the list [l]. *) 209 | Ltac simplify_list l := 210 | generalize dependent l; intro; 211 | autorewrite with lists; unfold compose; simpl; 212 | intros. 213 | 214 | (* Simplify all hypotheses involving lists. *) 215 | Ltac simplify_lists := 216 | repeat match goal with l:list _ |- _ => 217 | generalize dependent l; intro; 218 | autorewrite with lists; unfold compose; simpl; 219 | generalize dependent l 220 | end; 221 | intros. 222 | 223 | (* For every hypothesis that is an equality between lists, add a hypothesis 224 | stating that their lengths are equal. *) 225 | Ltac equate_list_lengths := 226 | let eq' := fresh "eq" in ( 227 | pose (eq' := eq); 228 | repeat match goal with 229 | | H:(@eq (list ?T) ?lhs ?rhs) |- _ => 230 | generalize (f_equal (@length T) H); 231 | fold eq' in H 232 | end; 233 | unfold eq' in *; clear eq'; 234 | autorewrite with lists; simpl; intros 235 | ). 236 | 237 | -------------------------------------------------------------------------------- /src/Vellvm/monad.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Logic.FunctionalExtensionality. 2 | Require Import List. 3 | Require Import Arith. 4 | Require Import Recdef. 5 | Require Import Omega. 6 | 7 | Implicit Type X Y Z W : Type. 8 | 9 | Notation monad := option. 10 | 11 | Notation munit := Some. 12 | 13 | Notation merror := None. 14 | 15 | (* 16 | Inductive monad (X:Type) : Type := 17 | | munit : forall (x:X), monad X 18 | | merror : monad X 19 | . 20 | 21 | Hint Constructors monad. 22 | *) 23 | 24 | Definition mbind (X:Type) (Y:Type) (f:X -> monad Y) (mx:monad X) : monad Y := 25 | match mx with 26 | | munit x => f x 27 | | merror => merror 28 | end. 29 | 30 | Definition mif (X:Type) (c:bool) (tclause : monad X) (fclause : monad X) : monad X := 31 | match c with 32 | | true => tclause 33 | | false => fclause 34 | end. 35 | 36 | Fixpoint mswitch (X:Type) (cases : list (bool*monad X)) (default_case : monad X) : monad X := 37 | match cases with 38 | | nil => default_case 39 | | (true, action)::cases' => action 40 | | (false, action)::cases' => mswitch _ cases' default_case 41 | end. 42 | 43 | Fixpoint mfor (X:Type) (li:list X) (f:X->monad Prop) : monad Prop := 44 | match li with 45 | | nil => munit True 46 | | i::li' => 47 | match (f i) with 48 | | munit True => mfor _ li' f 49 | | _ => merror 50 | end 51 | end. 52 | 53 | Record Range : Type := mkRange 54 | { 55 | Range_b : nat; 56 | Range_e : nat; 57 | Range_d : nat; 58 | Range_P : Range_d > 0 59 | }. 60 | 61 | Function _range2list (i:Range) 62 | {measure 63 | (fun x => 64 | match x with 65 | | (mkRange b e d P) => 66 | e - b 67 | end) 68 | } : list nat := 69 | match i with 70 | | (mkRange b e d P) => 71 | match (le_lt_dec e b) with 72 | | left _ => (* e <= b *) 73 | nil 74 | | right _ => (* b < e *) 75 | b::_range2list (mkRange (b+1) e d P) 76 | end 77 | end. 78 | Proof. 79 | intros i b e d P l H1 H2. 80 | destruct i. 81 | inversion l; subst. 82 | omega. 83 | Qed. 84 | 85 | Lemma one_gt_zero : 1 > 0. omega. Qed. 86 | 87 | Definition range2list_1 (b e:nat) := _range2list (mkRange b e 1 one_gt_zero). 88 | 89 | Notation "'ret' x" := (@munit _ x) (at level 41). 90 | Notation "'Assert' x" := (@munit Prop x) (at level 41). 91 | Notation "x >>= f" := (@mbind _ _ f x) (at level 42, left associativity). 92 | Notation "e1 >> e2" := (e1 >>= (fun _ => e2)) (at level 42, left associativity). 93 | Notation "'do' x <- a ; b" := ( a >>= (fun x => b) ) (at level 42, left associativity). 94 | Notation "'do' a ; b" := ( a >> b ) (at level 42, left associativity). 95 | Notation "'do' a 'enddo'" := ( a ) (at level 42, left associativity). 96 | Notation "'If' b 'then' t 'else' f 'endif'" := (mif _ b t f) (at level 43). 97 | Notation "'If' b 'then' t 'endif'" := (mif _ b t (ret True)) (at level 43). 98 | Notation "'If' b1 'then' t1 'elseif' b2 'then' t2 'else' f2 'endif'" := (mif _ b1 t1 (mif _ b2 t2 f2)) (at level 43). 99 | Notation "'If' b1 'then' t1 'elseif' b2 'then' t2 'elseif' b3 'then' t3 'else' f3 'endif'" := (mif _ b1 t1 (mif _ b2 t2 (mif _ b3 t3 f3))) (at level 43). 100 | Notation "'If' b1 'then' t1 'elseif' b2 'then' t2 'elseif' b3 'then' t3 'elseif' b4 'then' t4 'else' f4 'endif'" := (mif _ b1 t1 (mif _ b2 t2 (mif _ b3 t3 (mif _ b4 t4 f4)))) (at level 43). 101 | Notation "'If' b1 'then' t1 'elseif' b2 'then' t2 'endif'" := (mif _ b1 t1 (mif _ b2 t2 (ret True))) (at level 43). 102 | Notation "'If' x <- mx 'then' t 'else' f 'endif'" := 103 | (match mx with 104 | | merror => f 105 | | munit _ => (do x <- mx ; t) 106 | end) (at level 43). 107 | Notation "'switch' cases 'default' default 'endswitch'" := ( mswitch _ cases default ) (at level 44). 108 | Notation "'for' i 'in' li 'do' block 'endfor'" := (mfor _ li (fun i => block)) (at level 44). 109 | Notation "'for' i 'From' b 'to' e 'do' block 'endfor'" := (mfor _ (range2list_1 b e) (fun i => block)) (at level 44). 110 | 111 | Definition mifk (X Y:Type) (c:bool) (tclause : monad X) (fclause : monad X) (con : X -> monad Y) : monad Y := 112 | match c with 113 | | true => tclause >>= con 114 | | false => fclause >>= con 115 | end. 116 | 117 | Fixpoint mswitchk (X Y:Type) (cases : list (bool*monad X)) (default_case : monad X) (con : X -> monad Y) : monad Y := 118 | match cases with 119 | | nil => default_case >>= con 120 | | (true, action)::cases' => action >>= con 121 | | (false, action)::cases' => mswitchk _ _ cases' default_case con 122 | end. 123 | 124 | Check 125 | do c <- ret true; 126 | do d <- ret c; 127 | do If c 128 | then 129 | do d <- ret false ; 130 | do ret d 131 | enddo 132 | else 133 | do ret false; 134 | do ret true 135 | enddo 136 | endif; 137 | do c <- ret d; 138 | do switch 139 | ((true, ret false)::nil) 140 | default (ret false) 141 | endswitch; 142 | do ret d 143 | enddo. 144 | 145 | Lemma mbind_mbind : forall (X Y Z:Set) (f : X -> monad Y) (g : Y -> monad Z) (x : monad X), 146 | x >>= f >>= g = x >>= (fun u => f u >>= g). 147 | Proof. 148 | intros. destruct x; trivial. 149 | Qed. 150 | 151 | Lemma mbind_munit : forall (X Y:Set) (f : X -> monad Y) (x : X), 152 | (ret x) >>= f = f x. 153 | Proof. 154 | intros. trivial. 155 | Qed. 156 | 157 | Lemma munit_mbind : forall (X:Set) (x : monad X), 158 | x >>= (@munit X) = x. 159 | Proof. 160 | intros. destruct x; trivial. 161 | Qed. 162 | 163 | Hint Rewrite mbind_mbind mbind_munit munit_mbind : monad. 164 | 165 | Hint Extern 1 (_ = _ : monad _) => autorewrite with monad : monad. 166 | 167 | Ltac monad := intros; autorewrite with monad; auto with monad. 168 | 169 | Definition mmap X Y (f : X -> Y) (x : monad X) : monad Y := 170 | x >>= (fun x => ret (f x)). 171 | 172 | Notation "x >>- f" := (@mmap _ _ f x) (at level 42, left associativity). 173 | 174 | Definition mjoin X : monad (monad X) -> monad X := 175 | mbind (monad X) X (fun x => x). 176 | 177 | Definition mlift X Y (f : X -> Y) : monad X -> monad Y := 178 | mbind X Y (fun u => ret (f u)). 179 | 180 | Definition mlift2 X Y Z (f : X -> Y -> Z) (a : monad X) (b : monad Y) : monad Z := 181 | a >>= (fun x => b >>= fun y => ret (f x y)). 182 | 183 | Definition mlift3 X Y Z W (f : X -> Y -> Z -> W) (a : monad X) (b : monad Y) (c : monad Z) : monad W := 184 | a >>= (fun x => b >>= fun y => c >>= fun z => ret (f x y z)). 185 | 186 | Section Monad_Facts. 187 | 188 | Lemma mbind_congr : forall X Y (f g : X -> monad Y) (x y : monad X), 189 | x = y -> (forall a, f a = g a) -> x >>= f = y >>= g. 190 | Proof. 191 | intros. replace g with f. subst y. reflexivity. 192 | apply functional_extensionality; trivial. 193 | Qed. 194 | 195 | Lemma munit_mbind_match : forall X 196 | (f : X -> monad X) (x : monad X), 197 | (forall a, f a = ret a) -> x >>= f = x. 198 | Proof. 199 | intros. transitivity (x >>= @munit X). 200 | apply mbind_congr; trivial. 201 | unfold mbind. destruct x; auto. 202 | Qed. 203 | 204 | Hint Resolve mbind_congr munit_mbind_match : monad. 205 | 206 | Lemma mmap_congr : forall X Y (f g : X -> Y) (x y : monad X), 207 | x = y -> (forall a, f a = g a) -> x >>- f = y >>- g. 208 | Proof. 209 | intros. unfold mmap. apply mbind_congr; auto. 210 | intros a. rewrite H0. reflexivity. 211 | Qed. 212 | 213 | Hint Resolve mmap_congr : monad. 214 | 215 | Lemma mmap_id : forall X (f : X -> X) (x : monad X), 216 | (forall a, f a = a) -> x >>- f = x. 217 | Proof. 218 | unfold mmap; monad. 219 | unfold mbind. destruct x; try solve [rewrite H; reflexivity | reflexivity]. 220 | Qed. 221 | 222 | Hint Resolve mmap_id : monad. 223 | 224 | Lemma mmap_munit : forall X Y (f : X -> Y) (x : X), 225 | ret x >>- f = ret (f x). 226 | Proof. 227 | unfold mmap; monad. 228 | Qed. 229 | 230 | Lemma mmap_mmap : forall X Y Z (f : X -> Y) (g : Y -> Z) (x : monad X), 231 | (x >>- f) >>- g = x >>- (fun u => g (f u)). 232 | Proof. 233 | unfold mmap. unfold mbind; monad. destruct x; auto. 234 | Qed. 235 | 236 | Lemma mmap_mbind : forall X Y Z (f : X -> Y) (g : Y -> monad Z) (x : monad X), 237 | x >>- f >>= g = x >>= (fun u => g (f u)). 238 | Proof. 239 | unfold mmap. unfold mbind; monad. destruct x; auto. 240 | Qed. 241 | 242 | Lemma mbind_mmap : forall X Y Z (f : X -> monad Y) (g : Y -> Z) (x : monad X), 243 | x >>= f >>- g = x >>= (fun u => f u >>- g). 244 | Proof. 245 | unfold mmap. unfold mbind; monad. destruct x; auto. 246 | Qed. 247 | 248 | Hint Rewrite mmap_munit mmap_mmap mmap_mbind mbind_mmap : monad. 249 | 250 | Lemma mjoin_mjoin : forall X (x : monad (monad (monad X))), 251 | mjoin X (mjoin (monad X) x) = mjoin X (x >>- (mjoin X)). 252 | Proof. 253 | unfold mjoin. unfold mbind; monad. destruct x; auto. 254 | Qed. 255 | 256 | Lemma mjoin_munit : forall X (x : monad X), 257 | mjoin X (ret x) = x. 258 | Proof. 259 | unfold mjoin; monad. 260 | Qed. 261 | 262 | Lemma munit_mjoin : forall X (x : monad X), 263 | mjoin X (x >>- @munit X) = x. 264 | Proof. 265 | unfold mjoin. unfold mbind; monad. destruct x; auto. 266 | Qed. 267 | 268 | Lemma mjoin_mmap : forall X Y (f : X -> monad Y) (x : monad X), 269 | mjoin Y (x >>- f) = x >>= f. 270 | Proof. 271 | unfold mjoin; monad. 272 | Qed. 273 | 274 | End Monad_Facts. 275 | 276 | Hint Resolve munit_mbind_match mbind_congr mmap_congr mmap_id : monad. 277 | 278 | Hint Rewrite mmap_munit mmap_mmap mmap_mbind mbind_mmap 279 | mjoin_mjoin mjoin_munit munit_mjoin mjoin_mmap : monad. 280 | 281 | Definition monad2prop (X:Type) (m:monad X) : Prop := 282 | match m with 283 | | munit _ => True 284 | | merror => False 285 | end. 286 | 287 | Notation "{{{ m }}}" := (@monad2prop _ m) (at level 50). 288 | 289 | 290 | -------------------------------------------------------------------------------- /src/Vellvm/Dominators/dom_list_tree.v: -------------------------------------------------------------------------------- 1 | Require Import Coqlib. 2 | Require Import Maps. 3 | Require Import syntax. 4 | Require Import infrastructure_props. 5 | Require Import Metatheory. 6 | Require Import Program.Tactics. 7 | Require Import dom_tree. 8 | Require Import push_iter. 9 | 10 | (* This file proves that creating dominator trees based on list gives 11 | well-formed dom-trees. *) 12 | 13 | (* res is a map from node to dominators, computed by push_iter. So, the 14 | dominators of each node are sorted by idom. *) 15 | Fixpoint compute_sdom_chains_aux (res: positive -> LDoms.t) 16 | (bd: list positive) (acc: list (positive * list positive)) 17 | : list (positive * list positive) := 18 | match bd with 19 | | nil => acc 20 | | l0 :: bd' => 21 | match res l0 with 22 | | Some dts0 => 23 | compute_sdom_chains_aux res bd' ((l0, (rev (l0 :: dts0)))::acc) 24 | | None => compute_sdom_chains_aux res bd' acc 25 | end 26 | end. 27 | 28 | Definition compute_sdom_chains (res: positive -> LDoms.t) rd 29 | : list (positive * list positive) := 30 | compute_sdom_chains_aux res rd nil. 31 | 32 | Definition create_dtree (pe:positive) (rd:list positive) 33 | (res: positive -> LDoms.t) : DTree := 34 | let chains := compute_sdom_chains res rd in 35 | create_dtree_from_chains positive_eq_dec pe chains. 36 | 37 | Lemma create_dtree__wf_dtree_aux: forall pe rd res dt, 38 | create_dtree pe rd res = dt -> 39 | let chains := compute_sdom_chains res rd in 40 | forall p0 ch0, 41 | (is_dtree_edge positive_eq_dec dt p0 ch0 = true -> 42 | exists l0, exists chain0, 43 | List.In (l0, chain0) chains /\ is_chain_edge chain0 p0 ch0) /\ 44 | ((exists l0, exists chain0, 45 | List.In (l0, chain0) chains /\ 46 | chain_connects_dtree (DT_node pe DT_nil) chain0 /\ 47 | is_chain_edge chain0 p0 ch0) -> 48 | is_dtree_edge positive_eq_dec dt p0 ch0 = true). 49 | Proof. 50 | unfold create_dtree. 51 | intros. subst. 52 | apply create_dtree_from_chains__is_dtree_edge__is_chain_edge. 53 | Qed. 54 | 55 | Lemma compute_sdom_chains_aux_spec: forall 56 | res l0 chain0 bd acc 57 | (H1: forall l0 chain0 58 | (Hin: List.In (l0, chain0) acc), 59 | exists dts0, 60 | res l0 = Some dts0 /\ 61 | chain0 = rev (l0 :: dts0)) 62 | (H2: In (l0, chain0) (compute_sdom_chains_aux res bd acc)), 63 | (exists dts0, 64 | res l0 = Some dts0 /\ 65 | chain0 = rev (l0 :: dts0)) /\ (In l0 bd \/ In (l0, chain0) acc). 66 | Proof. 67 | induction bd; intros; eauto. 68 | simpl in H2. 69 | remember (res a) as R. 70 | destruct R. 71 | Case "1". 72 | apply IHbd in H2. 73 | SCase "1.1". 74 | destruct H2 as [J1 J2]. 75 | split; auto. 76 | simpl. 77 | destruct J2 as [J2 | J2]; auto. 78 | destruct_in J2; auto. 79 | inv J2. auto. 80 | SCase "1.s". 81 | intros. 82 | destruct_in Hin; eauto. 83 | inv Hin. 84 | exists l. split; auto. 85 | Case "2". 86 | apply IHbd in H2; auto. 87 | destruct H2 as [J1 J2]. 88 | split; auto. 89 | simpl. 90 | destruct J2 as [J2 | J2]; auto. 91 | Qed. 92 | 93 | Lemma compute_sdom_chains_spec: forall res rd l0 chain, 94 | In (l0, chain) (compute_sdom_chains res rd) -> 95 | (exists dts0, 96 | res l0 = Some dts0 /\ 97 | chain = rev (l0 :: dts0)) /\ In l0 rd. 98 | Proof. 99 | intros. 100 | unfold compute_sdom_chains in H. 101 | apply compute_sdom_chains_aux_spec in H. 102 | destruct H as [H1 [H2 | H2]]; tauto. 103 | simpl. intros. tauto. 104 | Qed. 105 | 106 | Lemma compute_sdom_chains_aux_spec': forall res l0 dts0 rd acc 107 | (Hin: (res l0 = Some dts0 /\ In l0 rd) \/ In (l0, rev (l0 :: dts0)) acc), 108 | In (l0, rev (l0 :: dts0)) (compute_sdom_chains_aux res rd acc). 109 | Proof. 110 | induction rd; simpl; intros. 111 | tauto. 112 | 113 | destruct Hin as [[Hsome [EQ | Hin]] | Hin]; subst. 114 | rewrite Hsome. 115 | apply IHrd; simpl; auto. 116 | 117 | destruct (res a); apply IHrd; simpl; auto. 118 | destruct (res a); apply IHrd; simpl; auto. 119 | Qed. 120 | 121 | Lemma compute_sdom_chains_spec': forall res rd l0 dts0, 122 | res l0 = Some dts0 -> In l0 rd -> 123 | In (l0, rev (l0 :: dts0)) (compute_sdom_chains res rd). 124 | Proof. 125 | unfold compute_sdom_chains. 126 | intros. 127 | apply compute_sdom_chains_aux_spec'; auto. 128 | Qed. 129 | 130 | Lemma create_dtree__disjoint_children_dtree: forall pe rd res, 131 | disjoint_children_dtree positive_eq_dec (create_dtree pe rd res). 132 | Proof. 133 | unfold create_dtree. intros. 134 | apply create_dtree_from_chains__disjoint_children_dtree. 135 | Qed. 136 | 137 | Require Import cfg. 138 | 139 | (* An edge is in dtree iff the edge represents an idom-relation. *) 140 | Section create_dtree__wf_dtree. 141 | 142 | Variable dts: PMap.t LDoms.t. 143 | Variable psuccs: PTree.t (list positive). 144 | Variable pe ni: positive. 145 | Hypothesis Hanalyze: pdom_analyze psuccs pe ni = dts. 146 | Variable res: positive -> LDoms.t. 147 | Hypothesis Hquery: res = fun p:positive => PMap.get p dts. 148 | Variable rd: list positive. 149 | Hypothesis Hreach: forall p, PCfg.reachable psuccs pe p <-> List.In p rd. 150 | Variable dt: @DTree positive. 151 | Hypothesis Hdtree: create_dtree pe rd res = dt. 152 | Hypothesis wf_entrypoints: in_cfg psuccs pe. 153 | Definition entrypoints := (pe, LDoms.top) :: nil. 154 | Definition predecessors := XPTree.make_predecessors psuccs. 155 | Hypothesis wf_order: forall n (Hneq: n <> pe) 156 | (Hincfg: XPTree.in_cfg psuccs n), 157 | exists p, In p (predecessors ??? n) /\ (p > n)%positive. 158 | Hypothesis Hok: (ni >= Termination.num_iters psuccs)%positive. 159 | Hypothesis Hnopred: (XPTree.make_predecessors psuccs) ??? pe = nil. 160 | 161 | Lemma dtree_edge_iff_idom: forall p0 ch0, 162 | is_dtree_edge positive_eq_dec dt p0 ch0 = true <-> 163 | (PCfg.imm_domination psuccs pe p0 ch0 /\ PCfg.reachable psuccs pe ch0). 164 | Proof. 165 | intros. 166 | assert (J:=Hdtree). 167 | apply create_dtree__wf_dtree_aux with (p0:=p0)(ch0:=ch0) in J; auto. 168 | destruct J as [Hdtree1 Hdtree2]. 169 | split; intro J. 170 | Case "1". 171 | apply Hdtree1 in J. 172 | destruct J as [l0 [chain0 [Hin Hedge]]]. 173 | apply compute_sdom_chains_spec in Hin. 174 | destruct Hin as [[dts0 [Hin Heq]] ?]; subst chain0. 175 | assert (Sorted (PCfg.imm_domination psuccs pe) (rev (l0::dts0))) 176 | as Hsort. 177 | subst. eapply IdomSorted.dom__imm_sorted; eauto. 178 | split. 179 | SCase "1.1". 180 | eapply chain_edge_sorted; eauto. 181 | SCase "1.2". 182 | simpl in Hedge. 183 | apply is_chain_edge__inv in Hedge. 184 | destruct Hedge as [Hin1 [Hin2 Hnnil]]. 185 | apply rev_non_nil in Hnnil. 186 | subst dts res. 187 | assert (Hreach0:=Hin). 188 | apply PDomProps.nonempty_is_reachable in Hreach0; auto. 189 | destruct_in Hin2. 190 | apply in_rev in Hin2. 191 | eapply PDomProps.in_dom__reachable; eauto. 192 | 193 | destruct_in Hin2. 194 | Case "2". 195 | apply Hdtree2. 196 | destruct J as [J1 J2]. 197 | eapply IdomSorted.imm_dom__at_head in J1; eauto. 198 | destruct J1 as [dts0 J1]. 199 | rewrite Hanalyze in J1. 200 | exists ch0. exists (rev (ch0::p0::dts0)). 201 | split. 202 | SCase "2.1". 203 | apply compute_sdom_chains_spec'; subst; auto. 204 | apply Hreach; auto. 205 | split. 206 | SCase "2.2". 207 | subst dts. 208 | apply IdomSorted.entry__at_last in J1; try congruence; auto. 209 | destruct J1 as [dts' J1]. 210 | unfold PTree.elt in *. 211 | rewrite J1. 212 | rewrite_env ((ch0 :: dts') ++ pe :: nil). 213 | rewrite rev_unit. 214 | simpl. 215 | case_eq (rev dts' ++ ch0 :: nil); auto. 216 | intro J. contradict J. auto with datatypes v62. 217 | SCase "2.3". 218 | simpl. simpl_env. 219 | apply is_chain_edge_tail; simpl; auto. 220 | Qed. 221 | 222 | Lemma create_dtree___reachable_dtree: 223 | PDProps.reachable_dtree psuccs pe dt. 224 | Proof. 225 | subst dt. 226 | unfold create_dtree. 227 | apply PDProps.create_dtree_from_chains__reachable_dtree; auto. 228 | apply Forall_forall. 229 | intros [x xs] Hinx. 230 | apply compute_sdom_chains_spec in Hinx. 231 | destruct Hinx as [[dts0 [Hget Heq]] Hinrd]. 232 | simpl. 233 | intros p Hinp. subst. 234 | simpl in Hinp. 235 | destruct_in Hinp. 236 | apply in_rev in Hinp. 237 | eapply PDomProps.in_dom__reachable; eauto. 238 | 239 | destruct_in Hinp. 240 | apply Hreach; auto. 241 | Qed. 242 | 243 | Lemma create_dtree__wf_dtree: PDProps.wf_dtree psuccs pe positive_eq_dec dt. 244 | Proof. 245 | apply PDProps.create_dtree__wf_dtree; eauto using XPTree.no_preds__notin_succs. 246 | Case "1". 247 | intros p ch Hedge. 248 | assert (J:=Hdtree). 249 | apply create_dtree__wf_dtree_aux with (p0:=p)(ch0:=ch) in J; auto. 250 | destruct J as [Hdtree1 _]. 251 | apply_clear Hdtree1 in Hedge. 252 | destruct Hedge as [l0 [chain0 [Hin Hedge]]]. 253 | exists chain0. 254 | split; auto. 255 | apply compute_sdom_chains_spec in Hin. 256 | destruct Hin as [[dts0 [Hin Heq]] ?]; subst chain0. 257 | subst. eapply IdomSorted.dom__imm_sorted; eauto. 258 | Case "2". 259 | subst dt. apply create_dtree__disjoint_children_dtree. 260 | Case "3". 261 | apply create_dtree___reachable_dtree. 262 | Qed. 263 | 264 | End create_dtree__wf_dtree. 265 | 266 | -------------------------------------------------------------------------------- /src/Vellvm/ott/ott_list_takedrop.v: -------------------------------------------------------------------------------- 1 | (* Additional definitions and lemmas on lists *) 2 | 3 | Require Import Arith. 4 | Require Import Max. 5 | Require Import Min. 6 | Require Import List. 7 | Require Import Omega. 8 | Require Import ott_list_support. 9 | Require Import ott_list_base. 10 | Require Import ott_list_nth. 11 | Import List_lib_Arith. 12 | 13 | 14 | 15 | Section Lists. 16 | 17 | Variables A B C : Set. 18 | Implicit Types x : A. 19 | Implicit Types y : B. 20 | Implicit Types z : C. 21 | Implicit Types xs l : list A. 22 | Implicit Types ys : list B. 23 | Implicit Types zs : list C. 24 | Implicit Types f : A -> B. 25 | Implicit Types g : B -> C. 26 | Implicit Types m n : nat. 27 | Set Implicit Arguments. 28 | 29 | 30 | 31 | (*** Prefix and suffix extraction ***) 32 | 33 | Fixpoint take n l {struct l} : list A := 34 | match n, l with 35 | | 0, _ => nil 36 | | _, nil => nil 37 | | S m, h::t => h :: (take m t) 38 | end. 39 | 40 | Lemma take_0 : forall l, take 0 l = nil. 41 | Proof. destruct l; reflexivity. Qed. 42 | Lemma take_nil : forall n, take n nil = nil. 43 | Proof. destruct n; reflexivity. Qed. 44 | 45 | Lemma take_all : 46 | forall l n, length l <= n -> take n l = l. 47 | Proof. 48 | induction l; destruct n; intros; try reflexivity. 49 | solve [inversion H]. 50 | simpl in * . apply (f_equal2 (@cons A)). reflexivity. apply IHl. omega. 51 | Qed. 52 | 53 | Lemma take_length : 54 | forall l n, length (take n l) = min n (length l). 55 | Proof. 56 | induction l; destruct n; intros; simpl; try rewrite IHl; reflexivity. 57 | Qed. 58 | 59 | Lemma take_some_length : 60 | forall l n, n <= length l -> length (take n l) = n. 61 | Proof. 62 | intros. rewrite take_length. auto with arith. 63 | Qed. 64 | 65 | Lemma take_nth : 66 | forall l m n, 67 | nth_error (take m l) n = if le_lt_dec m n then error else nth_error l n. 68 | Proof. 69 | intros until n. generalize dependent l. generalize dependent m. 70 | induction n; intros; simpl. 71 | destruct m; destruct l; reflexivity. 72 | destruct l; simpl. 73 | destruct (le_lt_dec m (S n)); destruct m; reflexivity. 74 | destruct m. reflexivity. 75 | rewrite IHn. symmetry. apply le_lt_dec_S. 76 | Qed. 77 | 78 | Lemma take_take : 79 | forall l m n, take m (take n l) = take (min m n) l. 80 | Proof. 81 | induction l; intros; simpl. 82 | destruct (min m n); destruct n; repeat rewrite take_nil; reflexivity. 83 | destruct n; destruct m; try reflexivity. 84 | simpl. rewrite IHl. reflexivity. 85 | Qed. 86 | 87 | Fixpoint drop n l {struct l} : list A := 88 | match n, l with 89 | | 0, _ => l 90 | | _, nil => nil 91 | | S m, h::t => drop m t 92 | end. 93 | 94 | Lemma drop_0 : forall l, drop 0 l = l. 95 | Proof. destruct l; reflexivity. Qed. 96 | Lemma drop_nil : forall n, drop n nil = nil. 97 | Proof. destruct n; reflexivity. Qed. 98 | 99 | Lemma drop_all : 100 | forall l n, length l <= n -> drop n l = nil. 101 | Proof. 102 | induction l; destruct n; intros; try reflexivity. 103 | solve [inversion H]. 104 | simpl in * . apply IHl. omega. 105 | Qed. 106 | 107 | Lemma drop_length : forall l n, length (drop n l) = length l - n. 108 | Proof. 109 | induction l; destruct n; intros; simpl; try rewrite IHl; reflexivity. 110 | Qed. 111 | 112 | Lemma match_drop : 113 | forall l n, match drop n l with 114 | | nil => length l <= n 115 | | _::_ => length l > n 116 | end. 117 | Proof. 118 | intros. destruct (le_gt_dec (length l) n) as [Le | Gt]. 119 | rewrite drop_all; assumption. 120 | generalize (conj (refl_equal (length (drop n l))) (refl_equal (drop n l))). 121 | pattern (drop n l) at 1 3. 122 | case (drop n l); intros; rewrite drop_length in H; destruct H; simpl in * . 123 | elimtype False; omega. 124 | rewrite <- H0. assumption. 125 | Qed. 126 | 127 | Lemma drop_nth : 128 | forall l m n, nth_error (drop m l) n = nth_error l (m + n). 129 | Proof. 130 | induction l; intros. 131 | rewrite drop_nil. repeat rewrite nth_error_nil. reflexivity. 132 | destruct m; simpl; auto. 133 | Qed. 134 | 135 | Lemma drop_drop : 136 | forall l m n, drop m (drop n l) = drop (n + m) l. 137 | Proof. 138 | intros; generalize dependent l. induction n; simpl; intros. 139 | rewrite drop_0. reflexivity. 140 | destruct l; simpl; [destruct m | rewrite IHn]; reflexivity. 141 | Qed. 142 | 143 | Lemma take_app_drop : forall l n, take n l ++ drop n l = l. 144 | Proof. 145 | intros l n; generalize dependent l; induction n; intros. 146 | rewrite take_0; rewrite drop_0; reflexivity. 147 | induction l; simpl. reflexivity. 148 | rewrite IHn. reflexivity. 149 | Qed. 150 | 151 | Lemma take_app_exact : 152 | forall l l' n, length l = n -> take n (l ++ l') = l. 153 | Proof. 154 | induction l; intros; subst n; simpl in * . 155 | rewrite take_0. reflexivity. 156 | rewrite IHl; reflexivity. 157 | Qed. 158 | 159 | Lemma drop_app_exact : 160 | forall l l' n, length l = n -> drop n (l ++ l') = l'. 161 | Proof. 162 | induction l; intros; subst n; simpl in * . 163 | rewrite drop_0. reflexivity. 164 | rewrite IHl; reflexivity. 165 | Qed. 166 | 167 | Lemma take_app_long : 168 | forall l l' n, n <= length l -> take n (l ++ l') = take n l. 169 | Proof. 170 | intros. 171 | set (tmp := l) in |- * at 2. rewrite <- (take_app_drop l n). subst tmp. 172 | rewrite app_ass. rewrite take_app_exact. reflexivity. 173 | apply take_some_length. assumption. 174 | Qed. 175 | 176 | Lemma drop_app_long : 177 | forall l l' n, n <= length l -> drop n (l ++ l') = drop n l ++ l'. 178 | Proof. 179 | intros. 180 | set (tmp := l) in |- * at 2. rewrite <- (take_app_drop l n). subst tmp. 181 | rewrite app_ass. rewrite drop_app_exact. reflexivity. 182 | apply take_some_length. assumption. 183 | Qed. 184 | 185 | Lemma take_app_short : 186 | forall l l' n, take (length l + n) (l ++ l') = l ++ take n l'. 187 | Proof. intros. induction l; simpl; congruence. Qed. 188 | 189 | Lemma drop_app_short : 190 | forall l l' n, drop (length l + n) (l ++ l') = drop n l'. 191 | Proof. intros. induction l; simpl; congruence. Qed. 192 | 193 | Lemma take_from_app : 194 | forall l l', take (length l) (l ++ l') = l. 195 | Proof. 196 | intros. replace (length l) with (length l + 0). 2: omega. 197 | rewrite take_app_short. rewrite take_0. 198 | symmetry. apply app_nil_end. 199 | Qed. 200 | 201 | Lemma drop_from_app : 202 | forall l l', drop (length l) (l ++ l') = l'. 203 | Proof. 204 | intros. replace (length l) with (length l + 0). 2: omega. 205 | rewrite drop_app_short. apply drop_0. 206 | Qed. 207 | 208 | Lemma take_take_app : 209 | forall l l' n, n <= length l -> take n (take n l ++ l') = take n l. 210 | Proof. 211 | intros. rewrite take_app_long. rewrite take_take. 212 | destruct (min_dec n n) as [Eq | Eq]; rewrite Eq; reflexivity. 213 | rewrite take_some_length; trivial. 214 | Qed. 215 | 216 | Lemma drop_take_app : 217 | forall l l' n, n <= length l -> drop n (take n l ++ l') = l'. 218 | Proof. 219 | intros. rewrite drop_app_exact. reflexivity. 220 | apply take_some_length. assumption. 221 | Qed. 222 | 223 | 224 | 225 | (*** End of the Lists section ***) 226 | 227 | End Lists. 228 | 229 | Hint Rewrite take_0 take_nil take_length take_nth take_take : take_drop. 230 | Hint Rewrite take_all : take_drop_short. 231 | Hint Rewrite take_some_length : take_drop_long. 232 | Hint Rewrite drop_0 drop_nil drop_length drop_nth drop_drop : take_drop. 233 | Hint Rewrite drop_all : take_drop_short. 234 | Hint Rewrite take_app_drop : take_drop. 235 | Hint Rewrite take_app_exact drop_app_exact : take_drop_exact. 236 | Hint Rewrite take_app_long drop_app_long : take_drop_long. 237 | Hint Rewrite take_app_short drop_app_short : take_drop. 238 | Hint Rewrite take_from_app drop_from_app : take_drop. 239 | Hint Rewrite take_take_app drop_take_app : take_drop_long. 240 | 241 | (* Break the list [original] into two pieces [prefix] and [suffix] 242 | at the location indicated by [cut_point]. [cut_point] indicates 243 | the number of elements to retain in [prefix]; it may also be 244 | a list whose length is used. This tactic leaves either one or two 245 | goals. The first goal has a hypothesis stating that the length of 246 | [prefix] is [cut_point]. The second goal has [original] left 247 | unchanged and an additional hypothesis stating that 248 | [length original < cut_point]; the tactic tries refuting this by 249 | calling omega. *) 250 | Ltac cut_list original cut_point prefix suffix := 251 | let l := fresh "whole" with Ineq := fresh "Ineq" with 252 | Eq := fresh "Decomposition" with Eql := fresh "Eqlen" with 253 | p := fresh "prefix" with s := fresh "suffix" with 254 | n := match type of cut_point with 255 | | nat => cut_point 256 | | list _ => constr:(length cut_point) 257 | | _ => fail "cut_list: unrecognised cut_point type" 258 | end in ( 259 | destruct (le_lt_dec n (length original)) as [Ineq | Ineq]; [ 260 | (**length original >= n, so length prefix = n**) 261 | assert (Eql := take_some_length original Ineq); clear Ineq; 262 | generalize dependent original; intro l; 263 | assert (Eq := take_app_drop l n); 264 | set (p := (take n l)) in *; set (s := (drop n l)) in *; 265 | clearbody p s; subst l; 266 | (*We've done the cutting, now we try to do some simplifications*) 267 | autorewrite with lists take_drop; intros; 268 | rename p into prefix; rename s into suffix 269 | | (**length original < n**) 270 | try (equate_list_lengths; elimtype False; omega) ] 271 | ). 272 | 273 | (* Look for equations between lists that can be simplified. 274 | [?p ++ ?s = ?p' ++ ?s'] is simplified into [?p = ?p'] and [?s = ?s'] *) 275 | Ltac parallel_split := 276 | let eq' := fresh "eq" with tmp := fresh "tmp" with 277 | EqPrefix := fresh "Eql" with EqSuffix := fresh "Eql" in ( 278 | pose (eq' := eq); 279 | repeat match goal with 280 | | H : app ?p ?s = app ?p' ?s' |- _ => 281 | ( 282 | assert (tmp : length p = length p'); 283 | [equate_list_lengths; omega | idtac]; 284 | assert (EqPrefix := app_inj_prefix_length_prefix _ _ _ _ tmp H); 285 | rewrite <- EqPrefix in H; 286 | assert (EqSuffix := app_inj_prefix _ _ _ H); 287 | clear tmp H 288 | ) || ( 289 | assert (tmp : length s = length s'); 290 | [equate_list_lengths; omega | idtac]; 291 | assert (EqSuffix := app_inj_prefix_length_suffix _ _ _ _ tmp H); 292 | rewrite <- EqSuffix in H; 293 | assert (EqPrefix := app_inj_suffix _ _ _ H); 294 | clear tmp H 295 | ) || fold eq' in H 296 | | H : cons ?a ?l = cons ?a' ?l' |- _ => 297 | injection H; intro; clear H; intro H 298 | end; 299 | unfold eq' in *; clear eq' 300 | ). 301 | (* Ad-hoc obsolete tactic (superceded by [parallel_split]) *) 302 | Ltac parallel_split_maps := 303 | repeat match goal with 304 | | H : map ?f ?p ++ map ?f ?s = ?p' ++ ?s' |- _ => 305 | assert (Eqlen' : length (map f p) = length p'); 306 | [equate_list_lengths; omega | idtac]; 307 | assert (EqPrefix := app_inj_prefix_length_prefix _ _ _ _ Eqlen' H); 308 | rewrite <- EqPrefix in H; 309 | assert (EqSuffix := app_inj_prefix _ _ _ H); 310 | clear Eqlen' H 311 | | H : _ ++ _ = map _ _ ++ map _ _ |- _ => symmetry in H 312 | end. 313 | 314 | 315 | 316 | 317 | (*** The End. ***) 318 | -------------------------------------------------------------------------------- /src/Vellvm/Dominators/dom_type.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Require Import ListSet. 3 | Require Import Coqlib. 4 | Require Import Metatheory. 5 | Require Import Maps. 6 | Require Import Lattice. 7 | Require Import Kildall. 8 | Require Import Iteration. 9 | Require Import cfg. 10 | Require Import dom_decl. 11 | Require Import reach. 12 | Require Import Dipaths. 13 | Require Import dom_tree. 14 | Require Import syntax. 15 | Require Import infrastructure. 16 | Require Import infrastructure_props. 17 | Import LLVMsyntax. 18 | Import LLVMinfra. 19 | 20 | (* The file defines the specification of computing dominators. *) 21 | 22 | Notation "x {+} y" := (x :: y) (at level 0): dom. 23 | Notation "x {<=} y" := (incl x y) (at level 0): dom. 24 | Notation "{}" := nil (at level 0): dom. 25 | Notation "x `in` y" := (In x y) (at level 70): dom. 26 | Local Open Scope dom. 27 | 28 | (* ALGDOM gives an abstract specification of algorithms that compute dominators. 29 | First of all, sdom defines the signature of a dominance analysis algorithm: 30 | given a function f and a label l1, (sdom f l1) returns the set of strict 31 | dominators of l1 in f ; dom defines the set of dominators of l1 by adding l1 32 | into l1’s strict dominators. 33 | 34 | To make the interface simple, ALGDOM only requires the basic properties that 35 | ensure that sdom is correct: it must be both sound and complete in terms of 36 | the declarative definitions (Definition 2). Given the correctness of sdom, 37 | the AlgDom_Properties module can ‘lift’ properties (conversion, transitivity, 38 | acyclicity, ordering, etc.) from the declarative definitions to the 39 | implementations of sdom and dom. 40 | 41 | ALGDOM requires completeness directly. Soundness can be proven by two more 42 | basic properties: entry_sound requires that the entry has no strict 43 | dominators; successors_sound requires that if l1 is a successor of l2, then 44 | l2’s dominators must include l1’s strict dominators. Given an algorithm that 45 | establishes the two properties, AlgDom_Properties proves that the algorithm 46 | is sound by induction over any path from the entry to l2. *) 47 | Module Type ALGDOM. 48 | 49 | Parameter sdom : fdef -> atom -> set atom. 50 | 51 | Axiom dom_entrypoint : forall f l0 s0 52 | (Hentry : getEntryBlock f = Some (l0, s0)), 53 | sdom f l0 = {}. 54 | 55 | Definition branchs_in_fdef f := 56 | forall (p : l) (ps0 : phinodes) (cs0 : cmds) 57 | (tmn0 : terminator) (l2 : l), 58 | blockInFdefB (p, stmts_intro ps0 cs0 tmn0) f -> 59 | In l2 (successors_terminator tmn0) -> In l2 (bound_fdef f). 60 | 61 | Axiom sdom_in_bound: forall fh bs l5, 62 | (sdom (fdef_intro fh bs) l5) {<=} (bound_blocks bs). 63 | 64 | Axiom dom_successors : forall 65 | (l3 : l) (l' : l) f 66 | (contents3 contents': ListSet.set atom) 67 | (Hinscs : l' `in` (successors f) !!! l3) 68 | (Heqdefs3 : contents3 = sdom f l3) 69 | (Heqdefs' : contents' = sdom f l'), 70 | contents' {<=} (l3 {+} contents3). 71 | 72 | Axiom sdom_is_complete: forall (f:fdef) 73 | (Hbinf: branchs_in_fdef f) 74 | (l3 : l) (l' : l) s3 s' 75 | (HuniqF : uniqFdef f) 76 | (HBinF' : blockInFdefB (l', s') f = true) 77 | (HBinF : blockInFdefB (l3, s3) f = true) 78 | (Hsdom: f |= l' >> l3), 79 | l' `in` (sdom f l3). 80 | 81 | Axiom dom_unreachable: forall (f:fdef) 82 | (Hbinf: branchs_in_fdef f) 83 | (Hhasentry: getEntryBlock f <> None) 84 | (l3 : l) s3 85 | (HuniqF: uniqFdef f) 86 | (HBinF : blockInFdefB (l3, s3) f = true) 87 | (Hunreach: ~ f ~>* l3), 88 | sdom f l3 = bound_fdef f. 89 | 90 | Axiom pres_sdom: forall 91 | (ftrans: fdef -> fdef) 92 | (btrans: block -> block) 93 | (ftrans_spec: forall fh bs, 94 | ftrans (fdef_intro fh bs) = fdef_intro fh (List.map btrans bs)) 95 | (btrans_eq_label: forall b, getBlockLabel b = getBlockLabel (btrans b)) 96 | (btrans_eq_tmn: forall b, 97 | terminator_match (getTerminator b) (getTerminator (btrans b))) 98 | (f : fdef) (l5 l0 : l), 99 | ListSet.set_In l5 (sdom f l0) <-> 100 | ListSet.set_In l5 (sdom (ftrans f) l0). 101 | 102 | End ALGDOM. 103 | 104 | Module AlgDom_Properties(adom: ALGDOM). 105 | 106 | Lemma entry_doms_others: forall (f:fdef) 107 | (Hbinf: adom.branchs_in_fdef f) (Huniq: uniqFdef f) entry 108 | (H: getEntryLabel f = Some entry), 109 | (forall b (H0: b <> entry /\ reachable f b), 110 | entry `in` (adom.sdom f b)). 111 | Proof. 112 | intros. 113 | assert (Hsdom: strict_domination f entry b). 114 | apply DecDom.entry_doms_others; auto. 115 | destruct H0 as [Hneq Hreach]. 116 | apply reachable__in_bound in Hreach; auto. 117 | apply In_bound_fdef__blockInFdefB in Hreach. 118 | destruct Hreach as [s HBinF]. 119 | apply getEntryLabel__getEntryBlock in H. 120 | destruct H as [be [Hentry EQ]]; subst. 121 | apply entryBlockInFdef in Hentry. 122 | destruct be; simpl in *. 123 | eapply adom.sdom_is_complete; eauto. 124 | Qed. 125 | 126 | Lemma in_bound_dom__in_bound_fdef: forall l' f l1 127 | (Hin: l' `in` (adom.sdom f l1)), 128 | l' `in` (bound_fdef f). 129 | Proof. 130 | intros. destruct f. eapply adom.sdom_in_bound; eauto. 131 | Qed. 132 | 133 | Section sound. 134 | 135 | Variable f : fdef. 136 | Hypothesis Hhasentry: getEntryBlock f <> None. 137 | 138 | Lemma dom_is_sound : forall 139 | (l3 : l) (l' : l) s3 140 | (HBinF : blockInFdefB (l3, s3) f = true) 141 | (Hin : l' `in` (l3 {+} (adom.sdom f l3))), 142 | f |= l' >>= l3. 143 | Proof. 144 | unfold domination. autounfold with cfg. 145 | intros. destruct f as [fh bs]. 146 | remember (getEntryBlock (fdef_intro fh bs)) as R. 147 | destruct R; try congruence. clear Hhasentry. 148 | destruct b as [l5 s5]. 149 | intros vl al Hreach. 150 | generalize dependent s3. 151 | remember (ACfg.vertexes (successors (fdef_intro fh bs))) as Vs. 152 | remember (ACfg.arcs (successors (fdef_intro fh bs))) as As. 153 | unfold ATree.elt, l in *. 154 | remember (index l3) as v0. 155 | remember (index l5) as v1. 156 | generalize dependent bs. 157 | generalize dependent l3. 158 | generalize dependent l5. 159 | induction Hreach; intros; subst. 160 | inv Heqv0. symmetry in HeqR. 161 | apply adom.dom_entrypoint in HeqR. 162 | rewrite HeqR in Hin. 163 | simpl in Hin. destruct Hin as [Hin | Hin]; tinv Hin; auto. 164 | 165 | destruct y as [a0]. 166 | assert (exists ps0, exists cs0, exists tmn0, 167 | blockInFdefB (a0, stmts_intro ps0 cs0 tmn0) (fdef_intro fh bs) /\ 168 | In l3 (successors_terminator tmn0)) as J. 169 | eapply successors__blockInFdefB; eauto. 170 | destruct J as [ps0 [cs0 [tmn0 [HBinF'' Hinsucc]]]]. 171 | destruct (id_dec l' l3); subst; auto. 172 | left. 173 | assert (In l' 174 | (a0 :: (adom.sdom (fdef_intro fh bs) a0))) as J. 175 | assert (incl (adom.sdom (fdef_intro fh bs) l3) 176 | (a0 :: (adom.sdom (fdef_intro fh bs) a0))) as Hinc. 177 | eapply adom.dom_successors; eauto. 178 | simpl in Hin. destruct Hin; try congruence. 179 | apply Hinc; auto. 180 | eapply IHHreach in J; eauto 1. 181 | simpl. 182 | destruct J as [J | J]; subst; eauto. 183 | Qed. 184 | 185 | Lemma sdom_is_sound : forall 186 | (l3 : l) (l' : l) s3 187 | (HBinF : blockInFdefB (l3, s3) f = true) 188 | (Hin : l' `in` (adom.sdom f l3)), 189 | f |= l' >> l3. 190 | Proof. 191 | intros. 192 | eapply dom_is_sound with (l':=l') in HBinF; simpl; eauto. 193 | unfold strict_domination, domination in *. 194 | remember (getEntryBlock f) as R. 195 | destruct R; try congruence. 196 | destruct b as [l0 ? ? ?]. 197 | intros vl al Hreach. 198 | assert (Hw':=Hreach). 199 | apply DWalk_to_dpath in Hreach; auto. 200 | destruct Hreach as [vl0 [al0 Hp]]. 201 | destruct (id_dec l' l3); subst. 202 | Case "l'=l3". 203 | destruct (id_dec l3 l0); subst. 204 | SCase "l3=l0". 205 | symmetry in HeqR. 206 | apply adom.dom_entrypoint in HeqR. 207 | rewrite HeqR in Hin. inv Hin. 208 | SCase "l3<>l0". 209 | inv Hp; try congruence. 210 | destruct y as [a0]. 211 | assert (exists ps0, exists cs0, exists tmn0, 212 | blockInFdefB (a0, stmts_intro ps0 cs0 tmn0) f /\ 213 | In l3 (successors_terminator tmn0)) as J. 214 | eapply successors__blockInFdefB; eauto. 215 | destruct J as [ps0 [cs0 [tmn0 [HBinF' Hinsucc]]]]. 216 | assert (In l3 (a0 :: (adom.sdom f a0))) as J. 217 | assert (incl (adom.sdom f l3) (a0 :: (adom.sdom f a0))) as Hinc. 218 | destruct f. eapply adom.dom_successors; eauto. 219 | simpl in Hin. 220 | apply Hinc; auto. 221 | eapply dom_is_sound in J; try solve [eauto 1 | congruence]. 222 | unfold domination in J. 223 | rewrite <- HeqR in J. 224 | assert (Hw:=H). 225 | apply D_path_isa_walk in Hw. 226 | apply J in Hw. 227 | destruct Hw as [Hw | Hw]; subst; auto. 228 | apply H4 in Hw. inv Hw; try congruence. 229 | elimtype False. auto. 230 | Case "l'<>l3". 231 | apply HBinF in Hw'. 232 | split; auto. destruct Hw'; subst; auto. congruence. 233 | Qed. 234 | 235 | End sound. 236 | 237 | Lemma sdom_isnt_refl : forall 238 | f (l3 : l) (l' : l) s3 239 | (Hreach : reachable f l3) 240 | (HBinF : blockInFdefB (l3, s3) f = true) 241 | (Hin : In l' (adom.sdom f l3)), 242 | l' <> l3. 243 | Proof. 244 | intros. 245 | eapply sdom_is_sound in Hin; eauto using reachable_has_entry. 246 | unfold strict_domination, reachable in *. 247 | autounfold with cfg in *. 248 | destruct (getEntryBlock f) as [[]|]; try congruence. 249 | destruct Hreach as [vl [al Hreach]]. 250 | apply Hin in Hreach. tauto. 251 | Qed. 252 | 253 | Definition getEntryBlock_inv f := forall 254 | (l3 : l) 255 | (l' : l) 256 | (ps : phinodes) 257 | (cs : cmds) 258 | (tmn : terminator) 259 | (HBinF : blockInFdefB (l3, stmts_intro ps cs tmn) f = true) 260 | (Hsucc : In l' (successors_terminator tmn)) a s0 261 | (H : getEntryBlock f = Some (a, s0)), 262 | l' <> a. 263 | 264 | Lemma sdom_acyclic: forall f 265 | (HgetEntryBlock_inv : getEntryBlock_inv f) 266 | l1 l2 s1 s2, 267 | reachable f l2 -> 268 | blockInFdefB (l1, s1) f = true -> 269 | blockInFdefB (l2, s2) f = true -> 270 | l1 `in` (adom.sdom f l2) -> 271 | l2 `in` (adom.sdom f l1) -> 272 | l1 <> l2 -> 273 | False. 274 | Proof. 275 | intros. 276 | assert (strict_domination f l1 l2) as Hdom12. 277 | eapply sdom_is_sound; eauto using reachable_has_entry. 278 | assert (strict_domination f l2 l1) as Hdom21. 279 | eapply sdom_is_sound; eauto using reachable_has_entry. 280 | eapply DecDom.dom_acyclic in Hdom12; eauto 1. 281 | apply Hdom12. apply DecDom.sdom_dom; auto. 282 | Qed. 283 | 284 | End AlgDom_Properties. 285 | 286 | (* The analysis that create trees must ensure that generated trees are 287 | well-formed. *) 288 | Module Type ALGDOM_WITH_TREE. 289 | 290 | Include Type ALGDOM. 291 | 292 | Parameter create_dom_tree : fdef -> option (@DTree l). 293 | 294 | Axiom dtree_edge_iff_idom: forall (f:fdef) 295 | (dt: @DTree l) 296 | (Hcreate: create_dom_tree f = Some dt) 297 | (le:l) (Hentry: getEntryLabel f = Some le) 298 | (Hnopreds: (XATree.make_predecessors (successors f)) !!! le = nil) 299 | (Hwfcfg: branchs_in_fdef f) 300 | (Huniq: uniqFdef f), 301 | forall p0 ch0, 302 | is_dtree_edge eq_atom_dec dt p0 ch0 = true <-> 303 | (imm_domination f p0 ch0 /\ reachable f ch0). 304 | 305 | Axiom create_dom_tree__wf_dtree: forall (f:fdef) 306 | (dt: @DTree l) 307 | (Hcreate: create_dom_tree f = Some dt) 308 | (le:l) (Hentry: getEntryLabel f = Some le) 309 | (Hnopreds: (XATree.make_predecessors (successors f)) !!! le = nil) 310 | (Hwfcfg: branchs_in_fdef f) 311 | (Huniq: uniqFdef f), 312 | ADProps.wf_dtree (successors f) le eq_atom_dec dt. 313 | 314 | End ALGDOM_WITH_TREE. 315 | 316 | -------------------------------------------------------------------------------- /src/Vellvm/vellvm_tactics.v: -------------------------------------------------------------------------------- 1 | Require Import Coqlib. 2 | Require Import Metatheory. 3 | 4 | Ltac inv_mbind_app := 5 | match goal with 6 | | H: match ?e with 7 | | Some _ => _ 8 | | None => _ 9 | end = _ |- _ => remember e as R; destruct R 10 | end. 11 | 12 | Ltac tinv H := try solve [inv H]. 13 | 14 | Ltac uniq_result := 15 | repeat match goal with 16 | | H1 : ?f ?a ?b ?c ?d = _, 17 | H2 : ?f ?a ?b ?c ?d = _ |- _ => 18 | rewrite H1 in H2; inv H2 19 | | H1 : ?f ?a ?b ?c = _, 20 | H2 : ?f ?a ?b ?c = _ |- _ => 21 | rewrite H1 in H2; inv H2 22 | | H1 : ?f ?a ?b = _, 23 | H2 : ?f ?a ?b = _ |- _ => 24 | rewrite H1 in H2; inv H2 25 | | H1 : ?f ?a = _, 26 | H2 : ?f ?a = _ |- _ => 27 | rewrite H1 in H2; inv H2 28 | | H : ?f _ = ?f _ |- _ => inv H 29 | | H : ?f _ _ = ?f _ _ |- _ => inv H 30 | | H : ?f _ _ _ = ?f _ _ _ |- _ => inv H 31 | | H : ?f _ _ _ _ = ?f _ _ _ _ |- _ => inv H 32 | | H : ?f _ _ _ _ _ = ?f _ _ _ _ _ |- _ => inv H 33 | | H : False |- _ => inv H 34 | | H : (_, _) = (_, _) |- _ => inv H 35 | | J1 : ?f = Some _, J2 : None = ?f |- _ => 36 | rewrite J1 in J2; congruence 37 | end. 38 | 39 | Ltac destruct_if := 40 | match goal with 41 | | H: context [(if ?lk then _ else _)] |- _ => 42 | remember lk as R; destruct R; try inv H 43 | | H: context [if ?lk then _ else _] |- _ => 44 | remember lk as R; destruct R; try inv H 45 | | |- context [(if ?lk then _ else _)] => 46 | remember lk as R; destruct R; subst; auto 47 | | |- context [if ?lk then _ else _] => remember lk as R; destruct R; subst; auto 48 | end. 49 | 50 | Ltac destruct_let := 51 | match goal with 52 | | _: context [match ?e with 53 | | (_,_) => _ 54 | end] |- _ => destruct e 55 | | |- context [match ?e with 56 | | (_,_) => _ 57 | end] => destruct e 58 | end. 59 | 60 | Ltac destruct_exists := 61 | repeat match goal with 62 | | H : exists _, _ |- _ => 63 | let A := fresh "A" in 64 | let J := fresh "J" in 65 | destruct H as [A J] 66 | end. 67 | 68 | Ltac destruct_ands := 69 | repeat match goal with 70 | | H : _ /\ _ |- _ => destruct H 71 | end. 72 | 73 | Ltac zeauto := eauto with zarith. 74 | 75 | Ltac symmetry_ctx := 76 | repeat match goal with 77 | | H : Some _ = _ |- _ => symmetry in H 78 | end. 79 | 80 | Ltac inv_mbind := 81 | repeat match goal with 82 | | H : match ?e with 83 | | Some _ => _ 84 | | None => None 85 | end = Some _ |- _ => remember e as R; destruct R as [|]; inv H 86 | | H : Some _ = match ?e with 87 | | Some _ => _ 88 | | None => None 89 | end |- _ => remember e as R; destruct R as [|]; inv H 90 | | H : Some _ = match ?p with 91 | | (_, _) => _ 92 | end |- _ => destruct p 93 | | H : match ?p with 94 | | (_, _) => _ 95 | end = Some _ |- _ => destruct p 96 | | H : if ?e then _ else False |- _ => 97 | remember e as R; destruct R; tinv H 98 | | H : if ?e then False else _ |- _ => 99 | remember e as R; destruct R; tinv H 100 | | H : match ?e with 101 | | Some _ => _ 102 | | None => False 103 | end |- _ => remember e as R; destruct R as [|]; tinv H 104 | | H : match ?e with 105 | | Some _ => _ 106 | | None => false 107 | end = true |- _ => remember e as R; destruct R as [|]; tinv H 108 | | H: match ?e with 109 | | Some _ => _ 110 | | None => is_true false 111 | end |- _ => remember e as R; destruct R; tinv H 112 | end. 113 | 114 | Ltac inv_mbind' := inv_mbind. 115 | Ltac inv_mbind'' := inv_mbind. 116 | 117 | Ltac solve_in_prefix := 118 | repeat match goal with 119 | | G: In ?i (?prefix ++ _) |- In ?i (?prefix ++ _) => 120 | apply in_or_app; 121 | apply in_app_or in G; 122 | destruct G as [G | G]; auto; 123 | right 124 | end. 125 | 126 | Ltac solve_in_head := 127 | match goal with 128 | | H0 : In _ ([_] ++ _), 129 | J2 : _ \/ _ \/ _ |- _ => 130 | simpl in H0; 131 | destruct H0 as [H0 | H0]; subst; try solve [ 132 | destruct J2 as [J2 | [J2 | J2]]; subst; 133 | repeat match goal with 134 | | H : _ /\ _ |- _ => destruct H 135 | end; congruence] 136 | | H0 : In _ (_:: _), 137 | J2 : _ \/ _ \/ _ |- _ => 138 | simpl in H0; 139 | destruct H0 as [H0 | H0]; subst; try solve [ 140 | destruct J2 as [J2 | [J2 | J2]]; subst; 141 | repeat match goal with 142 | | H : _ /\ _ |- _ => destruct H 143 | end; congruence] 144 | | H0 : _ = _ \/ In _ _, 145 | J2 : _ \/ _ \/ _ |- _ => 146 | simpl in H0; 147 | destruct H0 as [H0 | H0]; subst; try solve [ 148 | destruct J2 as [J2 | [J2 | J2]]; subst; 149 | repeat match goal with 150 | | H : _ /\ _ |- _ => destruct H 151 | end; congruence] 152 | end. 153 | 154 | Ltac zauto := auto with zarith. 155 | 156 | Ltac SSSSSCase name := Case_aux subsubsubsubsubcase name. 157 | Ltac SSSSSSCase name := Case_aux subsubsubsubsubsubcase name. 158 | Ltac SSSSSSSCase name := Case_aux subsubsubsubsubsubsubcase name. 159 | Ltac SSSSSSSSCase name := Case_aux subsubsubsubsubsubsubsubcase name. 160 | Ltac SSSSSSSSSCase name := Case_aux subsubsubsubsubsubsubsubsubcase name. 161 | Ltac SSSSSSSSSSCase name := Case_aux subsubsubsubsubsubsubsubsubsubcase name. 162 | 163 | Ltac tac0 := match goal with 164 | | |- exists _, _ => idtac 165 | | |- _ => solve [eauto] 166 | end. 167 | 168 | Ltac app_inv := 169 | repeat match goal with 170 | | [ H: Some _ = Some _ |- _ ] => inv H 171 | end. 172 | 173 | Ltac trans_eq := 174 | repeat match goal with 175 | | H1 : ?a = ?b, H2 : ?c = ?b |- _ => rewrite <- H1 in H2; inv H2 176 | | H1 : ?a = ?b, H2 : ?b = ?c |- _ => rewrite <- H1 in H2; inv H2 177 | end. 178 | 179 | Ltac inv_mfalse := 180 | repeat match goal with 181 | | H : match ?e with 182 | | Some _ => _ 183 | | None => False 184 | end |- _ => remember e as R; destruct R as [|]; tinv H 185 | end. 186 | 187 | Tactic Notation "binvt" ident(H) "as" ident(J1) ident(J2) := 188 | apply orb_true_iff in H; destruct H as [J1 | J2]. 189 | 190 | Tactic Notation "binvf" ident(H) "as" ident(J1) ident(J2) := 191 | apply orb_false_iff in H; destruct H as [J1 J2]. 192 | 193 | Ltac destruct_match := 194 | match goal with 195 | | H: match ?lk with 196 | | Some _ => Some _ 197 | | None => _ 198 | end = Some _ |- _ => 199 | let r := fresh "r" in 200 | remember lk as R; destruct R as [r|]; inv H; symmetry_ctx 201 | end. 202 | 203 | Ltac fill_ctxhole := 204 | match goal with 205 | | H : ?e = _ |- context [ ?e ] => rewrite H 206 | | H : _ = ?e |- context [ ?e ] => rewrite <- H 207 | | H : exists _:_, ?e = _ |- context [ ?e ] => destruct H as [? H]; rewrite H 208 | | H : exists _:_, _ = ?e |- context [ ?e ] => destruct H as [? H]; rewrite <- H 209 | | H: ?e = _ |- context [if ?e then _ else _] => rewrite H 210 | | H: _ = ?e |- context [if ?e then _ else _] => rewrite H 211 | end. 212 | 213 | Tactic Notation "eapply_clear" hyp(H1) "in" hyp(H2) := 214 | eapply H1 in H2; eauto; clear H1. 215 | 216 | Tactic Notation "apply_clear" hyp(H1) "in" hyp(H2) := 217 | apply H1 in H2; auto; clear H1. 218 | 219 | Tactic Notation "bdestruct" ident(H) "as" ident(J1) ident(J2) := 220 | apply andb_true_iff in H; destruct H as [J1 J2]. 221 | 222 | Tactic Notation "bdestruct3" ident(H) "as" ident(J1) ident(J2) ident(J3) := 223 | bdestruct H as H J3; 224 | bdestruct H as J1 J2. 225 | 226 | Tactic Notation "bdestruct4" ident(H) "as" ident(J1) ident(J2) ident(J3) ident(J4) := 227 | bdestruct3 H as H J3 J4; 228 | bdestruct H as J1 J2. 229 | 230 | Tactic Notation "bdestruct5" ident(H) "as" ident(J1) ident(J2) ident(J3) ident(J4) ident(J5) := 231 | bdestruct4 H as H J3 J4 J5; 232 | bdestruct H as J1 J2. 233 | 234 | Ltac bdestructn H Js := 235 | match Js with 236 | | nil => idtac 237 | | ?J::nil => rename H into J 238 | | ?J::?Js' => apply andb_true_iff in H; destruct H as [H J]; bdestructn H Js 239 | end. 240 | 241 | Ltac bsplit := 242 | eapply andb_true_iff; split. 243 | 244 | Ltac destruct_if' := 245 | match goal with 246 | | H: context [(if ?lk then _ else _)] |- _ => 247 | match type of lk with 248 | | sumbool (@eq ?t ?e ?e) (not (@eq ?t ?e ?e)) => 249 | destruct lk; try congruence 250 | | _ => destruct_if 251 | end 252 | | |- _ => destruct_if 253 | end. 254 | 255 | (* If a split is being destructed, name each of its components 256 | and destruct it *) 257 | Tactic Notation "simpl_split" ident(l1) ident(l2) := 258 | match goal with 259 | | H : context[let '(_, _) := ?l in _] |- _ => 260 | match l with 261 | | split _ => 262 | remember l as R; destruct R as [l1 l2] 263 | end 264 | end. 265 | 266 | Tactic Notation "simpl_split" := 267 | let l1 := fresh "l1" in 268 | let l2 := fresh "l2" in 269 | simpl_split l1 l2. 270 | 271 | (* Break a tuple into its constituent parts *) 272 | Ltac simpl_prod := 273 | repeat match goal with 274 | | [ p : (_ * _)%type |- _ ] => 275 | destruct p 276 | end. 277 | 278 | (* Use hypothesis H, cleaning it afterwards *) 279 | Ltac apply_and_clean H := 280 | clear - H; 281 | intros; eapply H; eauto; try subst; trivial; 282 | clear H. 283 | 284 | (* If the goal involves term t, remove everything in the context 285 | that is not related to t. *) 286 | Ltac remove_irrelevant t := 287 | try match goal with 288 | | [ |- context[t] ] => 289 | repeat match goal with 290 | | [ H : ?P |- _ ] => 291 | match P with 292 | | context[t] => fail 1 293 | | _ => clear H 294 | end 295 | end; 296 | repeat match goal with 297 | | [ |- ?P -> ?Q ] => intro 298 | end 299 | end. 300 | 301 | (* Solve "forall-like" goals on lists by induction. Specifically, 302 | it was made to solve the goal whenever it looks like 303 | 304 | H : forall a, In a (List.map ... la) -> P a b c 305 | ------------------------------------------------ 306 | forall p, 307 | In p (List.map (fun a => (a, b, c)) la) -> 308 | let '(a, b, c) := p in P a b c 309 | 310 | This is used to convert from the new premises in well-formedness 311 | judgements to backward-compatible versions like wf_value_list. 312 | *) 313 | 314 | Ltac solve_forall_like_ind := 315 | match goal with 316 | | [ l : list _ |- forall p, In p ?l' -> _ ] => 317 | match l' with 318 | | context[l] => 319 | intros p Hp; simpl_prod; 320 | induction l; simpl_prod; simpl in *; try tauto; 321 | 322 | (* Either our element is the consed one, or we need to use 323 | the induction hypothesis *) 324 | repeat match goal with 325 | | [ H : _ = _ \/ _ |- _ ] => 326 | destruct H as [H | H]; 327 | [try inversion H; clear H; subst|] 328 | end; 329 | 330 | (* Try to solve for the newly consed element *) 331 | try match goal with 332 | | [ H : context[_ \/ _ -> _] |- _ ] => 333 | solve [apply H; left; trivial] 334 | end; 335 | 336 | (* Try to solve the for the list tail *) 337 | match goal with 338 | | [ H : context[In _ _ -> _] |- _ ] => 339 | apply H; 340 | solve [ trivial | 341 | match goal with 342 | | [ H : context[_ = _ \/ _ -> _] 343 | |- context[In _ _ -> _] ] => 344 | intros; apply H; right; trivial 345 | end 346 | ] 347 | end 348 | end 349 | end. 350 | 351 | 352 | (* Guess which of the hypothesis will solve this case *) 353 | Ltac guess_hyp converter := 354 | match goal with 355 | | [ H : _ |- _ ] => 356 | apply_and_clean H; converter; solve_forall_like_ind 357 | end. 358 | -------------------------------------------------------------------------------- /patch/metalib.patch: -------------------------------------------------------------------------------- 1 | diff -ru lib/metalib-20090714/AssocList.v lib.patched/metalib-20090714/AssocList.v 2 | --- lib/metalib-20090714/AssocList.v 2009-06-25 13:03:02.000000000 -0400 3 | +++ lib.patched/metalib-20090714/AssocList.v 2014-08-30 00:29:29.629588111 -0400 4 | @@ -206,7 +206,7 @@ 5 | 6 | Lemma in_one_iff : 7 | List.In x (one y) <-> x = y. 8 | - Proof. clear. split. inversion 1; intuition. constructor; intuition. Qed. 9 | + Proof. clear. split. inversion 1; intuition. contradiction. constructor; intuition. Qed. 10 | 11 | Lemma in_app_iff : 12 | List.In x (l1 ++ l2) <-> List.In x l1 \/ List.In x l2. 13 | @@ -629,12 +629,12 @@ 14 | Lemma binds_one_1 : 15 | binds x a (y ~ b) -> 16 | x = y. 17 | - Proof. clear. intros H. inversion H; intuition congruence. Qed. 18 | + Proof. clear. inversion 1. intuition congruence. contradiction. Qed. 19 | 20 | Lemma binds_one_2 : 21 | binds x a (y ~ b) -> 22 | a = b. 23 | - Proof. clear. intros H. inversion H; intuition congruence. Qed. 24 | + Proof. clear. inversion 1. intuition congruence. contradiction. Qed. 25 | 26 | Lemma binds_one_3 : 27 | x = y -> 28 | diff -ru lib/metalib-20090714/AssumeList.v lib.patched/metalib-20090714/AssumeList.v 29 | --- lib/metalib-20090714/AssumeList.v 2009-07-02 16:43:10.000000000 -0400 30 | +++ lib.patched/metalib-20090714/AssumeList.v 2014-08-30 00:29:29.629588111 -0400 31 | @@ -650,12 +650,12 @@ 32 | Lemma binds_one_1 : 33 | binds x a (one (VarAsn B y b)) -> 34 | x = y. 35 | - Proof. clear. intros H1. inversion H1; intuition congruence. Qed. 36 | + Proof. clear. inversion 1; [congruence | contradiction]. Qed. 37 | 38 | Lemma binds_one_2 : 39 | binds x a (one (VarAsn B y b)) -> 40 | a = b. 41 | - Proof. clear. intros H1. inversion H1; intuition congruence. Qed. 42 | + Proof. clear. inversion 1; [congruence | contradiction]. Qed. 43 | 44 | Lemma binds_one_iff : 45 | binds x a (one (VarAsn B y b)) <-> x = y /\ a = b. 46 | diff -ru lib/metalib-20090714/CoqEqDec.v lib.patched/metalib-20090714/CoqEqDec.v 47 | --- lib/metalib-20090714/CoqEqDec.v 2009-06-23 13:49:50.000000000 -0400 48 | +++ lib.patched/metalib-20090714/CoqEqDec.v 2014-08-30 00:29:29.629588111 -0400 49 | @@ -25,22 +25,22 @@ 50 | 51 | (** The [EqDec] class is defined in Coq's standard library. *) 52 | 53 | -Lemma equiv_reflexive' : forall `{EqDec A} (x : A), 54 | +Lemma equiv_reflexive' : forall (A : Type) `{EqDec A} (x : A), 55 | x === x. 56 | Proof. intros. apply equiv_reflexive. Qed. 57 | 58 | -Lemma equiv_symmetric' : forall `{EqDec A} (x y : A), 59 | +Lemma equiv_symmetric' : forall (A : Type) `{EqDec A} (x y : A), 60 | x === y -> 61 | y === x. 62 | Proof. intros. apply equiv_symmetric; assumption. Qed. 63 | 64 | -Lemma equiv_transitive' : forall `{EqDec A} (x y z : A), 65 | +Lemma equiv_transitive' : forall (A : Type) `{EqDec A} (x y z : A), 66 | x === y -> 67 | y === z -> 68 | x === z. 69 | Proof. intros. eapply @equiv_transitive; eassumption. Qed. 70 | 71 | -Lemma equiv_decidable : forall `{EqDec A} (x y : A), 72 | +Lemma equiv_decidable : forall (A : Type) `{EqDec A} (x y : A), 73 | decidable (x === y). 74 | Proof. intros. unfold decidable. destruct (x == y); auto. Defined. 75 | 76 | @@ -73,5 +73,5 @@ 77 | Class EqDec_eq (A : Type) := 78 | eq_dec : forall (x y : A), {x = y} + {x <> y}. 79 | 80 | -Instance EqDec_eq_of_EqDec `(@EqDec A eq eq_equivalence) : EqDec_eq A. 81 | +Instance EqDec_eq_of_EqDec (A : Type) `(@EqDec A eq eq_equivalence) : EqDec_eq A. 82 | Proof. trivial. Defined. 83 | diff -ru lib/metalib-20090714/CoqFSetInterface.v lib.patched/metalib-20090714/CoqFSetInterface.v 84 | --- lib/metalib-20090714/CoqFSetInterface.v 2009-06-05 16:55:23.000000000 -0400 85 | +++ lib.patched/metalib-20090714/CoqFSetInterface.v 2014-08-30 00:29:29.629588111 -0400 86 | @@ -280,7 +280,7 @@ 87 | 88 | Module Type WS. 89 | Declare Module E : DecidableType. 90 | - Include Type WSfun E. 91 | + Include WSfun E. 92 | End WS. 93 | 94 | 95 | @@ -291,7 +291,7 @@ 96 | and some stronger specifications for other functions. *) 97 | 98 | Module Type Sfun (E : OrderedType). 99 | - Include Type WSfun E. 100 | + Include WSfun E. 101 | 102 | Parameter lt : t -> t -> Prop. 103 | Parameter compare : forall s s' : t, Compare lt eq s s'. 104 | @@ -354,7 +354,7 @@ 105 | 106 | Module Type S. 107 | Declare Module E : OrderedType. 108 | - Include Type Sfun E. 109 | + Include Sfun E. 110 | End S. 111 | 112 | 113 | diff -ru lib/metalib-20090714/CoqListFacts.v lib.patched/metalib-20090714/CoqListFacts.v 114 | --- lib/metalib-20090714/CoqListFacts.v 2009-06-10 11:53:56.000000000 -0400 115 | +++ lib.patched/metalib-20090714/CoqListFacts.v 2014-08-30 00:29:29.629588111 -0400 116 | @@ -9,6 +9,7 @@ 117 | 118 | Require Import Coq.Lists.List. 119 | Require Import Coq.Lists.SetoidList. 120 | +Require Import Coq.Classes.RelationClasses. 121 | 122 | Require Import CoqUniquenessTac. 123 | 124 | @@ -126,7 +127,10 @@ 125 | 126 | Lemma InA_iff_In : forall (A : Type) (x : A) (xs : list A), 127 | InA (@eq _) x xs <-> In x xs. 128 | -Proof. split; auto using InA_In, SetoidList.In_InA. Qed. 129 | +Proof. 130 | + split; auto using InA_In. 131 | + apply SetoidList.In_InA. apply eq_equivalence. 132 | +Qed. 133 | 134 | (** Whether a list is sorted is a decidable proposition. *) 135 | 136 | @@ -186,7 +190,9 @@ 137 | intros xs ys ? ? ?. 138 | cut (eqlistA (@eq _) xs ys). 139 | auto using eqlist_eq. 140 | - eauto using trans_eq, SetoidList.SortA_equivlistA_eqlistA. 141 | + apply SetoidList.SortA_equivlistA_eqlistA with (ltA := ltA); eauto. 142 | + apply eq_equivalence. firstorder. 143 | + reduce. subst. split; auto. 144 | Qed. 145 | 146 | Lemma Sort_In_eq : forall xs ys, 147 | @@ -197,7 +203,8 @@ 148 | Proof with auto using In_InA, InA_In. 149 | intros ? ? ? ? H. 150 | apply Sort_InA_eq... 151 | - intros a; specialize (H a); intuition... 152 | + intros a; specialize (H a). 153 | + split; intros; apply In_InA; intuition... 154 | Qed. 155 | 156 | End SortedListEquality. 157 | diff -ru lib/metalib-20090714/CoqUniquenessTac.v lib.patched/metalib-20090714/CoqUniquenessTac.v 158 | --- lib/metalib-20090714/CoqUniquenessTac.v 2009-06-23 13:49:50.000000000 -0400 159 | +++ lib.patched/metalib-20090714/CoqUniquenessTac.v 2014-08-30 00:29:29.629588111 -0400 160 | @@ -42,9 +42,9 @@ 161 | : res. 162 | (* begin show *) 163 | Proof. 164 | - induction xs as [ | ? ? IH ]; simpl; intros res f arg. 165 | + induction xs as [ | ? ? IH ]; simpl. 166 | exact f. 167 | - exact (IH res (f (fst arg)) (snd arg)). 168 | + exact (IH (f (fst arg)) (snd arg)). 169 | Defined. 170 | (* end show *) 171 | 172 | @@ -75,9 +75,10 @@ 173 | : tuple (tr_list_rev xs acc). 174 | (* begin show *) 175 | Proof. 176 | - induction xs as [ | ? ? IH ]; simpl; intros ab acc acc'. 177 | + generalize dependent acc. 178 | + induction xs as [ | ? ? IH ]; simpl; intros acc acc'. 179 | exact acc'. 180 | - exact (IH (snd ab) (cons a acc) (fst ab, acc')). 181 | + exact (IH (snd ab) (a :: acc) (fst ab, acc')). 182 | Defined. 183 | (* end show *) 184 | 185 | diff -ru lib/metalib-20090714/.depend lib.patched/metalib-20090714/.depend 186 | --- lib/metalib-20090714/.depend 2009-07-14 16:36:49.000000000 -0400 187 | +++ lib.patched/metalib-20090714/.depend 2014-08-30 00:29:29.629588111 -0400 188 | @@ -1,22 +1,22 @@ 189 | -AssocList.vo: AssocList.v CoqFSetDecide.vo CoqListFacts.vo LibTactics.vo 190 | -CoqEqDec.vo: CoqEqDec.v 191 | -CoqFSetDecide.vo: CoqFSetDecide.v 192 | -CoqFSetInterface.vo: CoqFSetInterface.v 193 | -CoqListFacts.vo: CoqListFacts.v CoqUniquenessTac.vo 194 | -CoqUniquenessTac.vo: CoqUniquenessTac.v 195 | -CoqUniquenessTacEx.vo: CoqUniquenessTacEx.v CoqUniquenessTac.vo 196 | -FSetExtra.vo: FSetExtra.v CoqFSetInterface.vo 197 | -FSetWeakNotin.vo: FSetWeakNotin.v CoqFSetDecide.vo 198 | -LibDefaultSimp.vo: LibDefaultSimp.v 199 | -LibLNgen.vo: LibLNgen.v LibDefaultSimp.vo Metatheory.vo 200 | -LibTactics.vo: LibTactics.v 201 | -MetatheoryAtom.vo: MetatheoryAtom.v CoqFSetDecide.vo CoqListFacts.vo FSetExtra.vo FSetWeakNotin.vo LibTactics.vo 202 | -Metatheory.vo: Metatheory.v AssocList.vo CoqEqDec.vo CoqListFacts.vo LibTactics.vo MetatheoryAtom.vo 203 | -AssumeList.vo: AssumeList.v CoqFSetDecide.vo CoqListFacts.vo LibTactics.vo MetatheoryAtom.vo 204 | -MetatheoryAlt.vo: MetatheoryAlt.v CoqEqDec.vo CoqListFacts.vo LibTactics.vo MetatheoryAtom.vo AssumeList.vo 205 | -Fsub_LetSum_Definitions.vo: Fsub_LetSum_Definitions.v Metatheory.vo 206 | -Fsub_LetSum_Infrastructure.vo: Fsub_LetSum_Infrastructure.v Fsub_LetSum_Definitions.vo 207 | -Fsub_LetSum_Lemmas.vo: Fsub_LetSum_Lemmas.v Fsub_LetSum_Infrastructure.vo 208 | -Fsub_LetSum_Soundness.vo: Fsub_LetSum_Soundness.v Fsub_LetSum_Lemmas.vo 209 | -CoqIntro.vo: CoqIntro.v 210 | -STLCsol.vo: STLCsol.v Metatheory.vo 211 | +AssocList.vo AssocList.glob AssocList.v.beautified: AssocList.v CoqFSetDecide.vo CoqListFacts.vo LibTactics.vo 212 | +CoqEqDec.vo CoqEqDec.glob CoqEqDec.v.beautified: CoqEqDec.v 213 | +CoqFSetDecide.vo CoqFSetDecide.glob CoqFSetDecide.v.beautified: CoqFSetDecide.v 214 | +CoqFSetInterface.vo CoqFSetInterface.glob CoqFSetInterface.v.beautified: CoqFSetInterface.v 215 | +CoqListFacts.vo CoqListFacts.glob CoqListFacts.v.beautified: CoqListFacts.v CoqUniquenessTac.vo 216 | +CoqUniquenessTac.vo CoqUniquenessTac.glob CoqUniquenessTac.v.beautified: CoqUniquenessTac.v 217 | +CoqUniquenessTacEx.vo CoqUniquenessTacEx.glob CoqUniquenessTacEx.v.beautified: CoqUniquenessTacEx.v CoqUniquenessTac.vo 218 | +FSetExtra.vo FSetExtra.glob FSetExtra.v.beautified: FSetExtra.v CoqFSetInterface.vo 219 | +FSetWeakNotin.vo FSetWeakNotin.glob FSetWeakNotin.v.beautified: FSetWeakNotin.v CoqFSetDecide.vo 220 | +LibDefaultSimp.vo LibDefaultSimp.glob LibDefaultSimp.v.beautified: LibDefaultSimp.v 221 | +LibLNgen.vo LibLNgen.glob LibLNgen.v.beautified: LibLNgen.v LibDefaultSimp.vo Metatheory.vo 222 | +LibTactics.vo LibTactics.glob LibTactics.v.beautified: LibTactics.v 223 | +MetatheoryAtom.vo MetatheoryAtom.glob MetatheoryAtom.v.beautified: MetatheoryAtom.v CoqFSetDecide.vo CoqListFacts.vo FSetExtra.vo FSetWeakNotin.vo LibTactics.vo 224 | +Metatheory.vo Metatheory.glob Metatheory.v.beautified: Metatheory.v AssocList.vo CoqEqDec.vo CoqListFacts.vo LibTactics.vo MetatheoryAtom.vo 225 | +AssumeList.vo AssumeList.glob AssumeList.v.beautified: AssumeList.v CoqFSetDecide.vo CoqListFacts.vo LibTactics.vo MetatheoryAtom.vo 226 | +MetatheoryAlt.vo MetatheoryAlt.glob MetatheoryAlt.v.beautified: MetatheoryAlt.v CoqEqDec.vo CoqListFacts.vo LibTactics.vo MetatheoryAtom.vo AssumeList.vo 227 | +Fsub_LetSum_Definitions.vo Fsub_LetSum_Definitions.glob Fsub_LetSum_Definitions.v.beautified: Fsub_LetSum_Definitions.v Metatheory.vo 228 | +Fsub_LetSum_Infrastructure.vo Fsub_LetSum_Infrastructure.glob Fsub_LetSum_Infrastructure.v.beautified: Fsub_LetSum_Infrastructure.v Fsub_LetSum_Definitions.vo 229 | +Fsub_LetSum_Lemmas.vo Fsub_LetSum_Lemmas.glob Fsub_LetSum_Lemmas.v.beautified: Fsub_LetSum_Lemmas.v Fsub_LetSum_Infrastructure.vo 230 | +Fsub_LetSum_Soundness.vo Fsub_LetSum_Soundness.glob Fsub_LetSum_Soundness.v.beautified: Fsub_LetSum_Soundness.v Fsub_LetSum_Lemmas.vo 231 | +CoqIntro.vo CoqIntro.glob CoqIntro.v.beautified: CoqIntro.v 232 | +STLCsol.vo STLCsol.glob STLCsol.v.beautified: STLCsol.v Metatheory.vo 233 | Only in lib/metalib-20090714/doc: changes.html 234 | Only in lib/metalib-20090714/doc: css 235 | Only in lib/metalib-20090714/doc: html 236 | Only in lib/metalib-20090714/doc: index.html 237 | Only in lib/metalib-20090714/doc: logo.gif 238 | diff -ru lib/metalib-20090714/MetatheoryAtom.v lib.patched/metalib-20090714/MetatheoryAtom.v 239 | --- lib/metalib-20090714/MetatheoryAtom.v 2009-06-24 23:33:54.000000000 -0400 240 | +++ lib.patched/metalib-20090714/MetatheoryAtom.v 2014-08-30 00:29:29.629588111 -0400 241 | @@ -10,7 +10,7 @@ 242 | Require Import Coq.Arith.Max. 243 | Require Import Coq.Classes.EquivDec. 244 | Require Import Coq.Lists.List. 245 | -Require Import Coq.Logic.DecidableTypeEx. 246 | +Require Import Coq.Structures.DecidableTypeEx. 247 | 248 | Require Import CoqFSetDecide. 249 | Require Import CoqListFacts. 250 | @@ -107,6 +107,8 @@ 251 | Instance EqDec_atom : @EqDec atom eq eq_equivalence. 252 | Proof. exact eq_atom_dec. Defined. 253 | 254 | +Instance EqDec_nat : @EqDec nat eq eq_equivalence. 255 | +Proof. exact eq_nat_dec. Defined. 256 | 257 | (* ********************************************************************** *) 258 | (** * Finite sets of atoms *) 259 | -------------------------------------------------------------------------------- /src/Vellvm/ott/ott_list_predicate.v: -------------------------------------------------------------------------------- 1 | (*** Predicates on a list ***) 2 | 3 | Require Import Arith. 4 | Require Import Bool. 5 | Require Import List. 6 | Require Import ott_list_base. 7 | Require Import ott_list_core. 8 | Require Import ott_list_takedrop. 9 | 10 | 11 | 12 | Section List_predicate_inductive. 13 | (* Properties of [Forall_list] and [Exists_list] *) 14 | 15 | Variables A : Set. 16 | Implicit Types x : A. 17 | Implicit Types xs l : list A. 18 | Implicit Types p : A -> bool. 19 | Implicit Types P : A -> Prop. 20 | Set Implicit Arguments. 21 | 22 | Lemma not_Exists_list_nil : forall P, ~(Exists_list P nil). 23 | Proof. intros P H; inversion H. Qed. 24 | Hint Resolve not_Exists_list_nil. 25 | 26 | Lemma Forall_list_dec : 27 | forall P (dec : forall x, {P x} + {~P x}) l, 28 | {Forall_list P l} + {~Forall_list P l}. 29 | Proof. 30 | induction l; simpl in * . solve [auto]. 31 | destruct (dec a); [destruct IHl | idtac]; auto; 32 | right; intro; inversion_clear H; tauto. 33 | Qed. 34 | 35 | Lemma Exists_list_dec : 36 | forall P (dec : forall x, {P x} + {~P x}) l, 37 | {Exists_list P l} + {~Exists_list P l}. 38 | Proof. 39 | induction l; simpl in * . solve [auto]. 40 | destruct (dec a); [idtac | destruct IHl]; auto; 41 | right; intro; inversion_clear H; tauto. 42 | Qed. 43 | 44 | Lemma Forall_Exists_list_dec : 45 | forall P Q (dec : forall x, {P x} + {Q x}) l, 46 | {Forall_list P l} + {Exists_list Q l}. 47 | Proof. 48 | induction l; simpl in * . solve [auto]. 49 | destruct (dec a); destruct IHl; auto. 50 | Qed. 51 | 52 | Lemma Forall_list_In : 53 | forall P x l, In x l -> Forall_list P l -> P x. 54 | Proof. 55 | induction l; intros; simpl in *; destruct H; 56 | inversion H0; subst; auto. 57 | Qed. 58 | 59 | Lemma In_Forall_list : 60 | forall P l, (forall x, In x l -> P x) -> Forall_list P l. 61 | Proof. 62 | induction l; firstorder. 63 | Qed. 64 | 65 | Lemma exists_In_Exists_list : 66 | forall P l, Exists_list P l -> exists x, In x l /\ P x. 67 | Proof. 68 | induction 1. 69 | exists x; simpl; tauto. 70 | elim IHExists_list; intros. exists x0; simpl; tauto. 71 | Qed. 72 | 73 | Lemma Forall_list_app_left : 74 | forall P l l', Forall_list P (l++l') -> Forall_list P l. 75 | Proof. 76 | intros; induction l; simpl in * . auto. 77 | inversion_clear H. auto. 78 | Qed. 79 | Lemma Forall_list_app_right : 80 | forall P l l', Forall_list P (l++l') -> Forall_list P l'. 81 | Proof. 82 | induction l; intros. auto. inversion_clear H; auto. 83 | Qed. 84 | Lemma app_Forall_list : 85 | forall P l l', Forall_list P l -> Forall_list P l' -> Forall_list P (l++l'). 86 | Proof. 87 | intros; induction l; simpl in * . assumption. 88 | inversion_clear H. auto. 89 | Qed. 90 | Hint Resolve app_Forall_list Forall_list_app_left Forall_list_app_right. 91 | 92 | Lemma Exists_list_app_or : 93 | forall P l l', Exists_list P (l++l') -> 94 | Exists_list P l \/ Exists_list P l'. 95 | Proof. 96 | intros; induction l; simpl in * . solve [auto]. 97 | inversion_clear H. solve [auto]. 98 | destruct (IHl H0); solve [auto]. 99 | Qed. 100 | Lemma app_Exists_list_left : 101 | forall P l l', Exists_list P l -> Exists_list P (l++l'). 102 | Proof. 103 | intros; induction l; inversion_clear H; simpl; auto. 104 | Qed. 105 | Lemma app_Exists_list_right : 106 | forall P l l', Exists_list P l' -> Exists_list P (l++l'). 107 | Proof. 108 | intros; induction l; simpl; auto. 109 | Qed. 110 | Hint Resolve Exists_list_app_or app_Exists_list_left app_Exists_list_right. 111 | 112 | Lemma rev_Forall_list : 113 | forall P l, Forall_list P l -> Forall_list P (rev l). 114 | Proof. induction 1; simpl; auto. Qed. 115 | Lemma rev_Exists_list : 116 | forall P l, Exists_list P l -> Exists_list P (rev l). 117 | Proof. induction 1; simpl; auto. Qed. 118 | Lemma Forall_list_rev : 119 | forall P l, Forall_list P (rev l) -> Forall_list P l. 120 | Proof. 121 | intros. rewrite <- (rev_involutive l). apply rev_Forall_list; assumption. 122 | Qed. 123 | Lemma Exists_list_rev : 124 | forall P l, Exists_list P (rev l) -> Exists_list P l. 125 | Proof. 126 | intros. rewrite <- (rev_involutive l). apply rev_Exists_list; assumption. 127 | Qed. 128 | 129 | Lemma take_Forall_list : 130 | forall P n l, Forall_list P l -> Forall_list P (take n l). 131 | Proof. 132 | intros; generalize dependent n; induction l; intros; 133 | inversion_clear H; destruct n; simpl; auto. 134 | Qed. 135 | Lemma drop_Forall_list : 136 | forall P n l, Forall_list P l -> Forall_list P (drop n l). 137 | Proof. 138 | intros; generalize dependent n; induction l; intros; 139 | inversion_clear H; destruct n; simpl; auto. 140 | Qed. 141 | Lemma Forall_list_take_drop : 142 | forall P n l, 143 | Forall_list P (take n l) -> Forall_list P (drop n l) -> Forall_list P l. 144 | Proof. intros; rewrite <- (take_app_drop l n); auto. Qed. 145 | 146 | Lemma take_drop_Exists_list : 147 | forall P n l, Exists_list P l -> 148 | Exists_list P (take n l) \/ Exists_list P (drop n l). 149 | Proof. intros; rewrite <- (take_app_drop l n) in H; auto. Qed. 150 | Lemma Exists_list_take : 151 | forall P n l, Exists_list P (take n l) -> Exists_list P l. 152 | Proof. intros; rewrite <- (take_app_drop l n); auto. Qed. 153 | Lemma Exists_list_drop : 154 | forall P n l, Exists_list P (drop n l) -> Exists_list P l. 155 | Proof. intros; rewrite <- (take_app_drop l n); auto. Qed. 156 | 157 | Lemma Forall_list_implies : 158 | forall (P Q:A->Prop) xs, 159 | (forall x, In x xs -> P x -> Q x) -> 160 | Forall_list P xs -> Forall_list Q xs. 161 | Proof. induction 2; firstorder. Qed. 162 | Lemma Exists_list_implies : 163 | forall (P Q:A->Prop) xs, 164 | (forall x, In x xs -> P x -> Q x) -> 165 | Exists_list P xs -> Exists_list Q xs. 166 | Proof. induction 2; firstorder. Qed. 167 | 168 | End List_predicate_inductive. 169 | 170 | Hint Resolve not_Exists_list_nil : lists. 171 | Hint Resolve In_Forall_list : lists. 172 | Hint Resolve Forall_list_app_left Forall_list_app_right : lists. 173 | Hint Resolve app_Forall_list Exists_list_app_or : lists. 174 | Hint Resolve app_Exists_list_left app_Exists_list_right : lists. 175 | Hint Resolve rev_Forall_list rev_Exists_list : lists. 176 | Hint Resolve Forall_list_rev Exists_list_rev : lists. 177 | Hint Resolve take_Forall_list drop_Forall_list Forall_list_take_drop 178 | take_drop_Exists_list Exists_list_take Exists_list_drop 179 | : take_drop. 180 | Hint Resolve Forall_list_implies Exists_list_implies : lists. 181 | 182 | 183 | 184 | Section List_predicate_fold. 185 | (* Properties of [forall_list] and [exists_list] *) 186 | 187 | Variables A : Set. 188 | Implicit Types x : A. 189 | Implicit Types xs l : list A. 190 | Implicit Types p : A -> bool. 191 | Implicit Types P : A -> Prop. 192 | Set Implicit Arguments. 193 | 194 | Lemma forall_list_eq_fold_left_map : 195 | forall p l, 196 | forall_list p l = fold_left andb (map p l) true. 197 | Proof. 198 | unfold forall_list; intros. generalize true. 199 | induction l; intros; simpl in * . reflexivity. 200 | rewrite IHl. reflexivity. 201 | Qed. 202 | Lemma forall_list_eq_fold_right_map : 203 | forall p l, 204 | forall_list p l = fold_right andb true (map p l). 205 | Proof. 206 | intros. rewrite forall_list_eq_fold_left_map. 207 | apply fold_symmetric; auto with bool. 208 | Qed. 209 | Lemma forall_list_eq_fold_left : 210 | forall p l, 211 | forall_list p l = fold_left (fun b z => b && p z) l true. 212 | Proof. auto. Qed. 213 | Lemma forall_list_eq_fold_right : 214 | forall p l, 215 | forall_list p l = fold_right (fun z b => b && p z) true l. 216 | Proof. 217 | intros; rewrite forall_list_eq_fold_right_map. 218 | induction l; simpl. reflexivity. rewrite IHl. auto with bool. 219 | Qed. 220 | 221 | Lemma exists_list_eq_fold_left_map : 222 | forall p l, 223 | exists_list p l = fold_left orb (map p l) false. 224 | Proof. 225 | unfold exists_list; intros. generalize false. 226 | induction l; intros; simpl in * . reflexivity. 227 | rewrite IHl. reflexivity. 228 | Qed. 229 | Lemma exists_list_eq_fold_right_map : 230 | forall p l, 231 | exists_list p l = fold_right orb false (map p l). 232 | Proof. 233 | intros. rewrite exists_list_eq_fold_left_map. 234 | apply fold_symmetric; auto with bool. 235 | Qed. 236 | Lemma exists_list_eq_fold_left : 237 | forall p l, 238 | exists_list p l = fold_left (fun b z => b || p z) l false. 239 | Proof. auto. Qed. 240 | Lemma exists_list_eq_fold_right : 241 | forall p l, 242 | exists_list p l = fold_right (fun z b => b || p z) false l. 243 | Proof. 244 | intros; rewrite exists_list_eq_fold_right_map. 245 | induction l; simpl. reflexivity. rewrite IHl. auto with bool. 246 | Qed. 247 | 248 | Lemma forall_list_extensionality : 249 | forall p p' l, (forall x, p x = p' x) -> forall_list p l = forall_list p' l. 250 | Proof. 251 | intros; repeat rewrite forall_list_eq_fold_right. 252 | induction l; simpl. reflexivity. rewrite IHl; rewrite H. reflexivity. 253 | Qed. 254 | 255 | Lemma exists_list_extensionality : 256 | forall p p' l, (forall x, p x = p' x) -> exists_list p l = exists_list p' l. 257 | Proof. 258 | intros; repeat rewrite exists_list_eq_fold_right. 259 | induction l; simpl. reflexivity. rewrite IHl; rewrite H. reflexivity. 260 | Qed. 261 | 262 | End List_predicate_fold. 263 | 264 | 265 | 266 | Section List_predicate_relationship. 267 | 268 | Variables A : Set. 269 | Implicit Types x : A. 270 | Implicit Types xs l : list A. 271 | Implicit Types p : A -> bool. 272 | Implicit Types P : A -> Prop. 273 | Set Implicit Arguments. 274 | 275 | (* TODO: lemmas relating Forall_list and forall_list, Exists_list 276 | and exists_list, forall_list and exists_list. *) 277 | 278 | Lemma Forall_if_implies_if_forall : 279 | forall P p l, 280 | Forall_list (fun z => if p z then P z else ~P z) l -> 281 | if forall_list p l then Forall_list P l else ~Forall_list P l. 282 | Proof. 283 | intros; rewrite forall_list_eq_fold_right. 284 | induction H; simpl in * . apply Forall_nil. 285 | destruct (fold_right (fun (z : A) (b : bool) => b && p z) true l). 286 | destruct (p x); simpl. apply Forall_cons; assumption. 287 | intro No; inversion No; tauto. 288 | simpl; intro No; inversion No; tauto. 289 | Qed. 290 | 291 | End List_predicate_relationship. 292 | 293 | 294 | 295 | (*** More about maps ***) 296 | 297 | Section List_predicate_map. 298 | 299 | Variables A B C : Set. 300 | Implicit Types x : A. 301 | Implicit Types y : B. 302 | Implicit Types z : C. 303 | Implicit Types xs l : list A. 304 | Implicit Types ys : list B. 305 | Implicit Types zs : list C. 306 | Implicit Types f : A -> B. 307 | Implicit Types g : B -> C. 308 | Implicit Types P : A -> Prop. 309 | Implicit Types Q : B -> Prop. 310 | Implicit Types R : C -> Prop. 311 | Implicit Types m n : nat. 312 | Set Implicit Arguments. 313 | 314 | Lemma map_take : 315 | forall f l n, map f (take n l) = take n (map f l). 316 | Proof. 317 | intros. generalize dependent n; induction l; intros. 318 | destruct n; reflexivity. 319 | destruct n. reflexivity. simpl; rewrite IHl; reflexivity. 320 | Qed. 321 | 322 | Lemma map_drop : 323 | forall f l n, map f (drop n l) = drop n (map f l). 324 | Proof. 325 | intros. generalize dependent n; induction l; intros. 326 | destruct n; reflexivity. 327 | destruct n. reflexivity. simpl; rewrite IHl; reflexivity. 328 | Qed. 329 | 330 | Lemma Forall_list_implies_map : 331 | forall P Q f l, 332 | (forall x, P x -> Q (f x)) -> 333 | Forall_list P l -> Forall_list Q (map f l). 334 | Proof. induction 2; simpl; auto with lists. Qed. 335 | Lemma Exists_list_implies_map : 336 | forall P Q f l, 337 | (forall x, P x -> Q (f x)) -> 338 | Exists_list P l -> Exists_list Q (map f l). 339 | Proof. induction 2; simpl; auto with lists. Qed. 340 | 341 | Lemma Forall_list_map_implies : 342 | forall P Q f l, 343 | (forall x, Q (f x) -> P x) -> 344 | Forall_list Q (map f l) -> Forall_list P l. 345 | Proof. 346 | intros. induction l; simpl in * . apply Forall_nil. 347 | inversion_clear H0. auto with lists. 348 | Qed. 349 | Lemma Exists_list_map_implies : 350 | forall P Q f l, 351 | (forall x, Q (f x) -> P x) -> 352 | Exists_list Q (map f l) -> Exists_list P l. 353 | Proof. 354 | intros. induction l; simpl in *; 355 | inversion_clear H0; auto with lists. 356 | Qed. 357 | 358 | Lemma Forall_list_map_intro : 359 | forall Q f l, 360 | Forall_list (fun x => Q (f x)) l -> Forall_list Q (map f l). 361 | Proof. induction 1; simpl; auto with lists. Qed. 362 | Lemma Exists_list_map_intro : 363 | forall Q f l, 364 | Exists_list (fun x => Q (f x)) l -> Exists_list Q (map f l). 365 | Proof. induction 1; simpl; auto with lists. Qed. 366 | 367 | Lemma Forall_list_map_elim : 368 | forall Q f l, 369 | Forall_list Q (map f l) -> Forall_list (fun x => Q (f x)) l. 370 | Proof. 371 | intros. induction l; simpl in * . apply Forall_nil. 372 | inversion_clear H. auto with lists. 373 | Qed. 374 | Lemma Exists_list_map_elim : 375 | forall Q f l, 376 | Exists_list Q (map f l) -> Exists_list (fun x => Q (f x)) l. 377 | Proof. 378 | intros. induction l; simpl in *; 379 | inversion_clear H; auto with lists. 380 | Qed. 381 | 382 | End List_predicate_map. 383 | 384 | Hint Rewrite map_take map_drop : take_drop. 385 | Hint Resolve Forall_list_implies_map Exists_list_implies_map : lists. 386 | Hint Resolve Forall_list_map_implies Exists_list_map_implies : lists. 387 | Hint Resolve Forall_list_map_intro Exists_list_map_intro : lists. 388 | Hint Resolve Forall_list_map_elim Exists_list_map_elim : lists. 389 | 390 | (* Simplify hypotheses and goals involving [Forall_list]. Simplifications 391 | involve rewriting [Forall_list ?P ?l] into equivalent statements 392 | where [?l] is simpler. Recognised ``complex'' constructors for [?l] 393 | are [nil], [cons], [app], [map], [rev]. In the goal, only 394 | simplifications that do not solve or split the goal are considered. 395 | *) 396 | Ltac simplify_Forall_list := 397 | let tmp := fresh "tmp" in ( 398 | repeat match goal with 399 | | H : Forall_list ?P nil |- _ => clear H 400 | | H : Forall_list ?P (cons ?a ?l) |- _ => 401 | inversion_clear H; 402 | match goal with H':_ |- _ => rename H' into H end 403 | | H : Forall_list ?P (app ?l0 ?l1) |- _ => 404 | rename H into tmp; 405 | assert (H := Forall_list_app_right l0 l1 tmp); 406 | generalize H; clear H; 407 | assert (H := Forall_list_app_left l0 l1 tmp); 408 | intro; match goal with H':_ |- _ => 409 | move H' after tmp; simpl in H' 410 | end; 411 | move H after tmp; clear tmp; simpl in H 412 | | H : Forall_list ?P (map ?f ?l) |- _ => 413 | (*apply Forall_list_map_elim in H*) (*>=V8.1 only*) 414 | rename H into tmp; 415 | assert (H := Forall_list_map_elim f l tmp); 416 | move H after tmp; clear tmp; simpl in H 417 | | H : Forall_list ?P (rev ?l) |- _ => 418 | rename H into tmp; 419 | assert (tmp := Forall_list_rev l H); 420 | move H after tmp; clear tmp; simpl in H 421 | end; 422 | repeat ((apply Forall_list_map_intro || 423 | apply rev_Forall_list 424 | ); simpl) 425 | ). 426 | 427 | -------------------------------------------------------------------------------- /src/Vellvm/dopsem.v: -------------------------------------------------------------------------------- 1 | Require Import Metatheory. 2 | Require Import alist. 3 | Require Import monad. 4 | Require Import targetdata. 5 | Require Import genericvalues. 6 | Require Import Values. 7 | Require Import Memory. 8 | Require Import Integers. 9 | Require Import Coqlib. 10 | Require Import syntax. 11 | Require Import typings. 12 | Require Import static. 13 | Require Import opsem. 14 | Require Import opsem_props. 15 | Require Import opsem_wf. 16 | Require Import vellvm_tactics. 17 | Require Import infrastructure. 18 | Require Import infrastructure_props. 19 | 20 | Import LLVMsyntax. 21 | Import LLVMgv. 22 | Import LLVMtd. 23 | Import LLVMtypings. 24 | Import LLVMinfra. 25 | 26 | (* This file defines the deterministic instance of Vellvm's operational 27 | semantics. *) 28 | 29 | (* DGVs implements the signature of GenericValues. *) 30 | Module MDGVs. 31 | 32 | Definition t := GenericValue. 33 | Definition instantiate_gvs (gv : GenericValue) (gvs : t) : Prop := gvs = gv. 34 | Definition inhabited (gvs : t) : Prop := True. 35 | Definition cundef_gvs := LLVMgv.cundef_gv. 36 | Definition undef_gvs gv (ty:typ) : t := gv. 37 | Definition cgv2gvs := LLVMgv.cgv2gv. 38 | Definition gv2gvs (gv:GenericValue) (ty:typ) : t := gv. 39 | 40 | Notation "gv @ gvs" := 41 | (instantiate_gvs gv gvs) (at level 43, right associativity). 42 | Notation "$ gv # t $" := (gv2gvs gv t) (at level 41). 43 | Hint Unfold inhabited instantiate_gvs. 44 | 45 | Lemma cundef_gvs__getTypeSizeInBits : forall S los nts gv ty sz al gv', 46 | wf_typ S (los,nts) ty -> 47 | _getTypeSizeInBits_and_Alignment los 48 | (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true ty = 49 | Some (sz, al) -> 50 | Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) = sizeGenericValue gv -> 51 | gv' @ (cundef_gvs gv ty) -> 52 | Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) = 53 | sizeGenericValue gv'. 54 | Proof. 55 | unfold instantiate_gvs. 56 | intros. inv H2. 57 | eapply cundef_gv__getTypeSizeInBits; eauto. 58 | Qed. 59 | 60 | Lemma cundef_gvs__matches_chunks : forall S los nts gv ty gv', 61 | wf_typ S (los,nts) ty -> 62 | gv_chunks_match_typ (los, nts) gv ty -> 63 | gv' @ (cundef_gvs gv ty) -> 64 | gv_chunks_match_typ (los, nts) gv' ty. 65 | Proof. 66 | unfold instantiate_gvs. 67 | intros. subst. 68 | eapply cundef_gv__matches_chunks; eauto. 69 | Qed. 70 | 71 | Lemma cundef_gvs__inhabited : forall gv ty, inhabited (cundef_gvs gv ty). 72 | Proof. auto. Qed. 73 | 74 | Lemma undef_gvs__getTypeSizeInBits : forall S los nts gv t sz al gv', 75 | wf_typ S (los,nts) t -> 76 | _getTypeSizeInBits_and_Alignment los 77 | (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t = 78 | Some (sz, al) -> 79 | Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) = sizeGenericValue gv -> 80 | gv' @ (undef_gvs gv t) -> 81 | Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) = 82 | sizeGenericValue gv'. 83 | Proof. 84 | unfold instantiate_gvs. 85 | intros. inv H2. auto. 86 | Qed. 87 | 88 | Lemma undef_gvs__matches_chunks : forall S los nts gv ty gv', 89 | wf_typ S (los,nts) ty -> 90 | gv_chunks_match_typ (los, nts) gv ty -> 91 | gv' @ (undef_gvs gv ty) -> 92 | gv_chunks_match_typ (los, nts) gv' ty. 93 | Proof. 94 | unfold instantiate_gvs. 95 | intros. subst. auto. 96 | Qed. 97 | 98 | Lemma undef_gvs__inhabited : forall gv ty, inhabited (undef_gvs gv ty). 99 | Proof. auto. Qed. 100 | 101 | Lemma cgv2gvs__getTypeSizeInBits : forall S los nts gv t sz al gv', 102 | wf_typ S (los,nts) t -> 103 | _getTypeSizeInBits_and_Alignment los 104 | (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t = 105 | Some (sz, al) -> 106 | Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) = sizeGenericValue gv -> 107 | gv' @ (cgv2gvs gv t) -> 108 | Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) = 109 | sizeGenericValue gv'. 110 | Proof. 111 | unfold instantiate_gvs. 112 | intros. inv H2. 113 | eapply cgv2gv__getTypeSizeInBits; eauto. 114 | Qed. 115 | 116 | Lemma cgv2gvs__matches_chunks : forall S los nts gv t gv', 117 | wf_typ S (los,nts) t -> 118 | gv_chunks_match_typ (los, nts) gv t -> 119 | gv' @ (cgv2gvs gv t) -> 120 | gv_chunks_match_typ (los, nts) gv' t. 121 | Proof. 122 | unfold instantiate_gvs. 123 | intros. subst. unfold cgv2gvs. 124 | destruct gv; auto. 125 | destruct p as [[]]; auto. 126 | destruct gv; auto. 127 | eapply cundef_gvs__matches_chunks; eauto. 128 | Qed. 129 | 130 | Lemma cgv2gvs__inhabited : forall gv t, inhabited (cgv2gvs gv t). 131 | Proof. auto. Qed. 132 | 133 | Lemma gv2gvs__getTypeSizeInBits : forall S los nts gv t sz al, 134 | wf_typ S (los,nts) t -> 135 | _getTypeSizeInBits_and_Alignment los 136 | (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t = 137 | Some (sz, al) -> 138 | Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) = sizeGenericValue gv -> 139 | forall gv', gv' @ (gv2gvs gv t) -> 140 | sizeGenericValue gv' = Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8). 141 | Proof. 142 | unfold instantiate_gvs. 143 | intros. inv H2. auto. 144 | Qed. 145 | 146 | Lemma gv2gvs__matches_chunks : forall S los nts gv t, 147 | wf_typ S (los,nts) t -> 148 | gv_chunks_match_typ (los, nts) gv t -> 149 | forall gv', gv' @ (gv2gvs gv t) -> 150 | gv_chunks_match_typ (los, nts) gv' t. 151 | Proof. 152 | unfold instantiate_gvs. 153 | intros. subst. auto. 154 | Qed. 155 | 156 | Lemma gv2gvs__inhabited : forall gv t, inhabited ($ gv # t $). 157 | Proof. auto. Qed. 158 | 159 | Definition lift_op1 (f: GenericValue -> option GenericValue) (gvs1:t) (ty:typ) : 160 | option t := f gvs1. 161 | 162 | Definition lift_op2 (f: GenericValue -> GenericValue -> option GenericValue) 163 | (gvs1 gvs2:t) (ty: typ) : option t := f gvs1 gvs2. 164 | 165 | Lemma lift_op1__inhabited : forall f gvs1 ty gvs2 166 | (H:forall x, exists z, f x = Some z), 167 | inhabited gvs1 -> 168 | lift_op1 f gvs1 ty = Some gvs2 -> 169 | inhabited gvs2. 170 | Proof. auto. Qed. 171 | 172 | Lemma lift_op2__inhabited : forall f gvs1 gvs2 t gvs3 173 | (H:forall x y, exists z, f x y = Some z), 174 | inhabited gvs1 -> inhabited gvs2 -> 175 | lift_op2 f gvs1 gvs2 t = Some gvs3 -> 176 | inhabited gvs3. 177 | Proof. auto. Qed. 178 | 179 | Lemma lift_op1__isnt_stuck : forall f gvs1 ty 180 | (H:forall x, exists z, f x = Some z), 181 | exists gvs2, lift_op1 f gvs1 ty = Some gvs2. 182 | Proof. unfold lift_op1. auto. Qed. 183 | 184 | Lemma lift_op2__isnt_stuck : forall f gvs1 gvs2 t 185 | (H:forall x y, exists z, f x y = Some z), 186 | exists gvs3, lift_op2 f gvs1 gvs2 t = Some gvs3. 187 | Proof. unfold lift_op2. auto. Qed. 188 | 189 | Lemma lift_op1__getTypeSizeInBits : forall S los nts f g t sz al gvs, 190 | wf_typ S (los,nts) t -> 191 | _getTypeSizeInBits_and_Alignment los 192 | (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t = 193 | Some (sz, al) -> 194 | (forall x y, x @ g -> f x = Some y -> 195 | sizeGenericValue y = nat_of_Z (ZRdiv (Z_of_nat sz) 8)) -> 196 | lift_op1 f g t = Some gvs -> 197 | forall gv : GenericValue, 198 | gv @ gvs -> 199 | sizeGenericValue gv = nat_of_Z (ZRdiv (Z_of_nat sz) 8). 200 | Proof. intros. unfold lift_op1 in H2. inv H3. eauto. Qed. 201 | 202 | Lemma lift_op1__matches_chunks : forall S los nts f g t gvs, 203 | wf_typ S (los,nts) t -> 204 | (forall x y, instantiate_gvs x g -> f x = Some y -> 205 | gv_chunks_match_typ (los, nts) y t) -> 206 | lift_op1 f g t = Some gvs -> 207 | forall gv : GenericValue, 208 | instantiate_gvs gv gvs -> 209 | gv_chunks_match_typ (los, nts) gv t. 210 | Proof. intros. unfold lift_op1 in H1. inv H2. eauto. Qed. 211 | 212 | Lemma lift_op2__getTypeSizeInBits : forall S los nts f g1 g2 t sz al gvs, 213 | wf_typ S (los,nts) t -> 214 | _getTypeSizeInBits_and_Alignment los 215 | (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t = 216 | Some (sz, al) -> 217 | (forall x y z, x @ g1 -> y @ g2 -> f x y = Some z -> 218 | sizeGenericValue z = nat_of_Z (ZRdiv (Z_of_nat sz) 8)) -> 219 | lift_op2 f g1 g2 t = Some gvs -> 220 | forall gv : GenericValue, 221 | gv @ gvs -> 222 | sizeGenericValue gv = nat_of_Z (ZRdiv (Z_of_nat sz) 8). 223 | Proof. intros. unfold lift_op2 in H2. inv H3. eauto. Qed. 224 | 225 | Lemma lift_op2__matches_chunks : forall S los nts f g1 g2 t gvs, 226 | wf_typ S (los,nts) t -> 227 | (forall x y z, 228 | instantiate_gvs x g1 -> instantiate_gvs y g2 -> f x y = Some z -> 229 | gv_chunks_match_typ (los, nts) z t) -> 230 | lift_op2 f g1 g2 t = Some gvs -> 231 | forall gv : GenericValue, 232 | instantiate_gvs gv gvs -> 233 | gv_chunks_match_typ (los, nts) gv t. 234 | Proof. intros. unfold lift_op2 in H1. inv H2. eauto. Qed. 235 | 236 | Lemma inhabited_inv : forall gvs, inhabited gvs -> exists gv, gv @ gvs. 237 | Proof. eauto. Qed. 238 | 239 | Lemma instantiate_undef__undef_gvs : forall gv t, gv @ (undef_gvs gv t). 240 | Proof. auto. Qed. 241 | 242 | Lemma instantiate_gv__gv2gvs : forall gv t, gv @ ($ gv # t $). 243 | Proof. auto. Qed. 244 | 245 | Lemma none_undef2gvs_inv : forall gv gv' t, 246 | gv @ $ gv' # t $ -> (forall mc, (Vundef, mc)::nil <> gv') -> gv = gv'. 247 | Proof. 248 | intros. 249 | destruct gv'; try solve [inv H; auto]. 250 | Qed. 251 | 252 | End MDGVs. 253 | 254 | Definition DGVs : GenericValues := mkGVs 255 | MDGVs.t 256 | MDGVs.instantiate_gvs 257 | MDGVs.inhabited 258 | MDGVs.cgv2gvs 259 | MDGVs.gv2gvs 260 | MDGVs.lift_op1 261 | MDGVs.lift_op2 262 | MDGVs.cgv2gvs__getTypeSizeInBits 263 | MDGVs.cgv2gvs__matches_chunks 264 | MDGVs.cgv2gvs__inhabited 265 | MDGVs.gv2gvs__getTypeSizeInBits 266 | MDGVs.gv2gvs__matches_chunks 267 | MDGVs.gv2gvs__inhabited 268 | MDGVs.lift_op1__inhabited 269 | MDGVs.lift_op2__inhabited 270 | MDGVs.lift_op1__isnt_stuck 271 | MDGVs.lift_op2__isnt_stuck 272 | MDGVs.lift_op1__getTypeSizeInBits 273 | MDGVs.lift_op2__getTypeSizeInBits 274 | MDGVs.lift_op1__matches_chunks 275 | MDGVs.lift_op2__matches_chunks 276 | MDGVs.inhabited_inv 277 | MDGVs.instantiate_gv__gv2gvs 278 | MDGVs.none_undef2gvs_inv. 279 | 280 | Notation "gv @ gvs" := 281 | (DGVs.(instantiate_gvs) gv gvs) (at level 43, right associativity). 282 | Notation "$ gv # t $" := (DGVs.(gv2gvs) gv t) (at level 41). 283 | Notation "vidxs @@ vidxss" := (@Opsem.in_list_gvs DGVs vidxs vidxss) 284 | (at level 43, right associativity). 285 | 286 | (* Properties of deterministic operational semantics. *) 287 | Lemma dos_in_list_gvs_inv : forall gvs gvss, gvs @@ gvss -> gvs = gvss. 288 | Proof. 289 | induction 1; subst; auto. 290 | inv H; auto. 291 | Qed. 292 | 293 | Lemma dos_in_gvs_inv : forall gvs gvss, gvs @ gvss -> gvs = gvss. 294 | Proof. 295 | intros. inv H; auto. 296 | Qed. 297 | 298 | Ltac dgvs_instantiate_inv := 299 | match goal with 300 | | [ H : DGVs.(instantiate_gvs) _ _ |- _ ] => inv H 301 | | [ H : _ @@ _ |- _ ] => apply dos_in_list_gvs_inv in H; subst 302 | end. 303 | 304 | Lemma dos_instantiate_gvs_intro : forall gv, gv @ gv. 305 | Proof. 306 | Local Transparent instantiate_gvs. 307 | unfold instantiate_gvs. simpl. auto. 308 | Global Opaque instantiate_gvs. 309 | Qed. 310 | 311 | Hint Resolve dos_instantiate_gvs_intro. 312 | 313 | Lemma dos_in_list_gvs_intro : forall gvs, gvs @@ gvs. 314 | Proof. 315 | induction gvs; simpl; auto. 316 | Qed. 317 | 318 | Hint Resolve dos_in_list_gvs_intro. 319 | 320 | (*************************************) 321 | Definition DGVMap := @Opsem.GVsMap DGVs. 322 | 323 | (*************************************) 324 | (* Aux invariants of wf ECs *) 325 | 326 | Definition wfEC_inv s m (EC: @Opsem.ExecutionContext DGVs) : Prop := 327 | uniqFdef (Opsem.CurFunction EC) /\ 328 | blockInFdefB (Opsem.CurBB EC) (Opsem.CurFunction EC) = true /\ 329 | match Opsem.CurCmds EC with 330 | | nil => wf_insn s m (Opsem.CurFunction EC) (Opsem.CurBB EC) 331 | (insn_terminator (Opsem.Terminator EC)) 332 | | c::_ => wf_insn s m (Opsem.CurFunction EC) (Opsem.CurBB EC) 333 | (insn_cmd c) 334 | end /\ 335 | exists l0, exists ps0, exists cs0, 336 | Opsem.CurBB EC = (l0, stmts_intro ps0 (cs0 ++ Opsem.CurCmds EC) 337 | (Opsem.Terminator EC)). 338 | 339 | Definition wfECs_inv s m (ECs: list (@Opsem.ExecutionContext DGVs)) : Prop := 340 | List.Forall (wfEC_inv s m) ECs. 341 | 342 | Lemma wf_EC__wfEC_inv: forall S los nts Ps EC 343 | (HwfS : wf_system S) 344 | (HMinS : moduleInSystemB (module_intro los nts Ps) S = true) 345 | (Hwfec : OpsemPP.wf_ExecutionContext (los, nts) Ps EC), 346 | wfEC_inv S (module_intro los nts Ps) EC. 347 | Proof. 348 | destruct EC; simpl. 349 | intros. 350 | destruct Hwfec as [J1 [J2 [J3 [J4 [J5 J6]]]]]. 351 | unfold wfEC_inv. simpl. 352 | split; eauto 2 using wf_system__uniqFdef. 353 | split; auto. 354 | split; auto. 355 | destruct J6 as [l1 [ps1 [cs1 J6]]]; subst. 356 | destruct CurCmds. 357 | eapply wf_system__wf_tmn in J2; eauto. 358 | eapply wf_system__wf_cmd in J2; eauto using in_middle. 359 | Qed. 360 | 361 | Lemma wf_ECStack__wfECs_inv: forall S los nts Ps ECs 362 | (HwfS : wf_system S) 363 | (HMinS : moduleInSystemB (module_intro los nts Ps) S = true) 364 | (Hwf : OpsemPP.wf_ECStack (los, nts) Ps ECs), 365 | wfECs_inv S (module_intro los nts Ps) ECs. 366 | Proof. 367 | unfold wfECs_inv. 368 | induction ECs as [|]; simpl; intros; auto. 369 | destruct Hwf as [J1 [J2 J3]]. 370 | constructor; eauto using wf_EC__wfEC_inv. 371 | Qed. 372 | 373 | Lemma wf_State__wfECs_inv: forall cfg St (Hwfc: OpsemPP.wf_Config cfg) 374 | (Hwfst: OpsemPP.wf_State cfg St), 375 | wfECs_inv (OpsemAux.CurSystem cfg) 376 | (module_intro (fst (OpsemAux.CurTargetData cfg)) 377 | (snd (OpsemAux.CurTargetData cfg)) 378 | (OpsemAux.CurProducts cfg) ) 379 | (Opsem.ECS St). 380 | Proof. 381 | intros. 382 | destruct cfg as [? [? ?] ? ?]. 383 | destruct St. 384 | destruct Hwfc as [? [? [? ?]]]. 385 | destruct Hwfst. simpl. 386 | eapply wf_ECStack__wfECs_inv; eauto. 387 | Qed. 388 | 389 | Definition uniqEC (EC: @Opsem.ExecutionContext DGVs) : Prop := 390 | uniqFdef (Opsem.CurFunction EC) /\ 391 | blockInFdefB (Opsem.CurBB EC) (Opsem.CurFunction EC) = true /\ 392 | exists l0, exists ps0, exists cs0, 393 | Opsem.CurBB EC = (l0, stmts_intro ps0 (cs0 ++ Opsem.CurCmds EC) 394 | (Opsem.Terminator EC)). 395 | 396 | Definition uniqECs (ECs: list (@Opsem.ExecutionContext DGVs)) : Prop := 397 | List.Forall uniqEC ECs. 398 | 399 | Lemma wfEC_inv__uniqEC: forall s m EC (Hwf: wfEC_inv s m EC), uniqEC EC. 400 | Proof. 401 | intros. 402 | destruct Hwf as [J1 [J3 [_ J2]]]. split; auto. 403 | Qed. 404 | 405 | Lemma wfECs_inv__uniqECs: forall s m ECs (Hwf: wfECs_inv s m ECs), uniqECs ECs. 406 | Proof. 407 | unfold wfECs_inv, uniqECs. 408 | intros. 409 | induction Hwf; auto. 410 | constructor; auto. 411 | apply wfEC_inv__uniqEC in H; auto. 412 | Qed. 413 | 414 | Lemma wf_State__uniqECs: forall cfg St (Hwfc: OpsemPP.wf_Config cfg) 415 | (Hwfst: OpsemPP.wf_State cfg St), uniqECs (Opsem.ECS St). 416 | Proof. 417 | intros. 418 | destruct cfg as [? [? ?] ? ?]. 419 | destruct St. 420 | destruct Hwfc as [? [? [? ?]]]. 421 | destruct Hwfst. simpl. 422 | eapply wf_ECStack__wfECs_inv in H4; eauto. 423 | eapply wfECs_inv__uniqECs; eauto. 424 | Qed. 425 | 426 | Ltac find_uniqEC := 427 | repeat match goal with 428 | | H: uniqECs (Opsem.ECS {|Opsem.ECS := _; Opsem.Mem := _ |}) |- uniqEC _ => 429 | simpl in H 430 | | H: uniqECs (?EC::_) |- uniqEC ?EC => inv H; auto 431 | | H: uniqECs (_::?EC::_) |- uniqEC ?EC => inv H; auto 432 | | H: Forall uniqEC (?EC::_) |- uniqEC ?EC => inv H; auto 433 | | H: Forall uniqEC (_::?EC::_) |- uniqEC ?EC => inv H; auto 434 | end. 435 | 436 | (*************************************) 437 | (* More dynamic properties *) 438 | 439 | Lemma GEP_inv: forall TD t (mp1 : GVsT DGVs) inbounds0 vidxs mp2 t' 440 | (H1 : Opsem.GEP TD t mp1 vidxs inbounds0 t' = ret mp2), 441 | gundef TD (typ_pointer t') = ret mp2 \/ 442 | exists blk, exists ofs1, exists ofs2 : int32, exists m1, exists m2, 443 | mp1 = (Vptr blk ofs1, m1) :: nil /\ mp2 = (Vptr blk ofs2, m2) :: nil. 444 | Proof. 445 | Local Transparent lift_op1. 446 | intros. 447 | unfold Opsem.GEP in H1. unfold lift_op1 in H1. simpl in H1. 448 | unfold MDGVs.lift_op1 in H1. 449 | unfold gep in H1. unfold GEP in H1. 450 | remember (GV2ptr TD (getPointerSize TD) mp1) as R1. 451 | destruct R1; auto. 452 | destruct (GVs2Nats TD vidxs); auto. 453 | remember (mgep TD t v l0) as R2. 454 | destruct R2; auto. 455 | inv H1. 456 | unfold mgep in HeqR2. 457 | destruct v; tinv HeqR2. 458 | destruct l0; tinv HeqR2. 459 | destruct (mgetoffset TD (typ_array 0%nat t) (z :: l0)) as [[]|]; 460 | inv HeqR2. 461 | unfold GV2ptr in HeqR1. 462 | destruct mp1 as [|[]]; tinv HeqR1. 463 | destruct v; tinv HeqR1. 464 | destruct mp1; inv HeqR1. 465 | unfold ptr2GV. unfold val2GV. right. exists b0. exists i1. 466 | exists (Int.add 31 i1 (Int.repr 31 z0)). exists m. 467 | exists (AST.Mint (Size.mul Size.Eight (getPointerSize TD) - 1)). 468 | eauto. 469 | Opaque lift_op1. 470 | Qed. 471 | 472 | Lemma wf__getTypeStoreSize_eq_sizeGenericValue: forall (gl2 : GVMap) 473 | (lc2 : Opsem.GVsMap) (S : system) (los : layouts) (nts : namedts) 474 | (Ps : list product) (v1 : value) (gv1 : GenericValue) 475 | (Hwfg : LLVMgv.wf_global (los, nts) S gl2) (n : nat) t 476 | (HeqR : ret n = getTypeStoreSize (los, nts) t) F 477 | (H24 : @Opsem.getOperandValue DGVs (los, nts) v1 lc2 gl2 = ret gv1) 478 | (Hwflc1 : OpsemPP.wf_lc (los, nts) F lc2) 479 | (Hwfv : wf_value S (module_intro los nts Ps) F v1 t), 480 | n = sizeGenericValue gv1. 481 | Proof. 482 | intros. 483 | eapply OpsemPP.getOperandValue__wf_gvs in Hwflc1; eauto. 484 | inv Hwflc1. 485 | assert (gv1 @ gv1) as Hinst. auto. 486 | apply H2 in Hinst. 487 | unfold gv_chunks_match_typ in Hinst. 488 | clear - Hinst HeqR Hwfv. inv_mbind. 489 | apply wf_value__wf_typ in Hwfv. destruct Hwfv as [J1 J2]. 490 | symmetry in HeqR0. 491 | eapply flatten_typ__getTypeSizeInBits in HeqR0; eauto. 492 | destruct HeqR0 as [sz [al [A B]]]. 493 | unfold getTypeAllocSize, getTypeStoreSize, getABITypeAlignment, 494 | getTypeSizeInBits, getAlignment, 495 | getTypeSizeInBits_and_Alignment in HeqR. 496 | rewrite A in HeqR. 497 | inv HeqR. rewrite B. 498 | eapply vm_matches_typ__sizeMC_eq_sizeGenericValue; eauto. 499 | Qed. 500 | --------------------------------------------------------------------------------