├── .gitignore ├── README ├── arguments.txt ├── doc ├── lstcoq.sty ├── lstocaml.sty ├── main.tex └── mathpartir.sty ├── src ├── Theory.v ├── lib_coq.ml ├── lib_coq.mli ├── plugin.ml4 └── theplug.mllib └── test-suite └── example.v /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | \#*\# 3 | *.glob 4 | *.vo 5 | *.v.d 6 | *.cmi 7 | *.cma 8 | *.cmx 9 | *.cmo 10 | *.cmxs 11 | *.mli.d 12 | *.ml4.d 13 | *.ml.d 14 | *.a 15 | *.cmxa 16 | *.mllib.d 17 | *.o 18 | .*.aux 19 | Makefile-localvars.gen 20 | Makefile -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | An example of Coq plugin that defines a reification tactic. 2 | 3 | The files should be self-documented, even though we may manage to build a pdf that summarizes every interesting point. The project needs coq8.5(pl2). 4 | 5 | INSTRUCTIONS 6 | ============ 7 | 8 | 1. Build the makefile with: 9 | 10 | coq_makefile -f arguments.txt -o Makefile 11 | 12 | 2. run "make" 13 | 14 | FILES DESCRIPTION 15 | ================= 16 | 17 | arguments.txt : the pre-makefile that is fed to coq_makefile (coq_makefile -f arguments.txt -o Makefile) 18 | src/lib_coq.ml{i} : an interface with Coq, where we define some handlers for Coq's API and constructs. 19 | src/plugin.ml4 : the actual plugin that defines a reification tactic for a very simple subset of terms on nat 20 | src/Theory.v : reification primer 21 | test-suite/example.v : an example of usage of the tactic we defined in src/plugin.ml4. 22 | 23 | 24 | 25 | -------------------------------------------------------------------------------- /arguments.txt: -------------------------------------------------------------------------------- 1 | -I ./src 2 | -R ./test-suite ML_tutorial.Tests 3 | -R ./src ML_tutorial 4 | src/lib_coq.ml 5 | src/lib_coq.mli 6 | src/plugin.ml4 7 | src/theplug.mllib 8 | src/Theory.v 9 | test-suite/example.v 10 | -------------------------------------------------------------------------------- /doc/lstcoq.sty: -------------------------------------------------------------------------------- 1 | %======================================================================= 2 | % Définit le style ssr Gallina pour les listings (Assia Mahboubi 2007) 3 | \lstdefinelanguage{Coq}{ 4 | % 5 | % Anything betweeen $ becomes LaTeX math mode 6 | mathescape=true, 7 | % 8 | % Comments may or not include Latex commands 9 | texcl=false, 10 | % 11 | % 12 | % Vernacular commands 13 | morekeywords=[1]{ 14 | Section, Module, End, Require, Import, Export, 15 | Variable, Variables, Parameter, Parameters, Axiom, Hypothesis, Hypotheses, 16 | Notation, Local, Tactic, Reserved, Scope, Open, Close, Bind, Delimit, 17 | Definition, Let, Ltac, Fixpoint, CoFixpoint, Add, Morphism, Relation, 18 | Implicit, Arguments, Set, Unset, Contextual, Strict, Prenex, Implicits, 19 | Inductive, CoInductive, Record, Structure, Canonical, Coercion, 20 | Context, Class, Global, Instance, Program, Infix, 21 | Theorem, Lemma, Corollary, Proposition, Fact, Remark, Example, 22 | Proof, Goal, Save, Qed, Defined, Hint, Resolve, Rewrite, View, 23 | Search, Show, Print, Printing, All, Graph, Projections, inside, outside}, 24 | % 25 | % Gallina 26 | morekeywords=[2]{forall, exists, exists2, fun, fix, cofix, struct, 27 | match, with, end, as, in, return, let, if, is, then, else, 28 | for, of, nosimpl, when}, 29 | % 30 | % Sorts 31 | morekeywords=[3]{Type, Prop, Set}, 32 | % 33 | % Various tactics, some are std Coq subsumed by ssr, for the manual purpose 34 | morekeywords=[4]{ 35 | pose, set, move, case, elim, apply, clear, 36 | hnf, intro, intros, generalize, rename, pattern, after, 37 | destruct, induction, using, refine, inversion, injection, 38 | rewrite, congr, unlock, compute, ring, field, fourier, 39 | replace, fold, unfold, change, cutrewrite, simpl, 40 | have, suff, wlog, suffices, without, loss, nat_norm, 41 | assert, cut, trivial, revert, bool_congr, nat_congr, 42 | symmetry, transitivity, auto, split, autorewrite}, 43 | % symmetry, transitivity, auto, split, left, right, autorewrite}, 44 | % 45 | % Terminators 46 | morekeywords=[5]{ 47 | by, done, exact, reflexivity, tauto, romega, omega, 48 | assumption, solve, contradiction, discriminate}, 49 | % 50 | % Control 51 | morekeywords=[6]{do, last, first, try, idtac, repeat}, 52 | % 53 | % Various symbols 54 | % For the ssr manual we turn off the prettyprint of formulas 55 | % literate= 56 | % {->}{{$\rightarrow\,$}}2 57 | % {->}{{\tt ->}}3 58 | % {<-}{{$\leftarrow\,$}}2 59 | % {<-}{{\tt <-}}2 60 | % {>->}{{$\mapsto$}}3 61 | % {<=}{{$\leq$}}1 62 | % {>=}{{$\geq$}}1 63 | % {<>}{{$\neq$}}1 64 | % {/\\}{{$\wedge$}}2 65 | % {\\/}{{$\vee$}}2 66 | % {<->}{{$\leftrightarrow\;$}}3 67 | % {<=>}{{$\Leftrightarrow\;$}}3 68 | % {:nat}{{$~\in\mathbb{N}$}}3 69 | % {fforall\ }{{$\forall_f\,$}}1 70 | % {forall\ }{{$\forall\,$}}1 71 | % {exists\ }{{$\exists\,$}}1 72 | % {negb}{{$\neg$}}1 73 | % {spp}{{:*:\,}}1 74 | % {~}{{$\sim$}}1 75 | % {\\in}{{$\in\;$}}1 76 | % {/\\}{$\land\,$}1 77 | % {:*:}{{$*$}}2 78 | % {=>}{{$\,\Rightarrow\ $}}1 79 | % {=>}{{\tt =>}}2 80 | % {:=}{{{\tt:=}\,\,}}2 81 | % {==}{{$\equiv$}\,}2 82 | % {!=}{{$\neq$}\,}2 83 | % {^-1}{{$^{-1}$}}1 84 | % {elt'}{elt'}1 85 | % {=}{{\tt=}\,\,}2 86 | % {+}{{\tt+}\,\,}2, 87 | % 88 | % Comments delimiters, we do turn this off for the manual 89 | morecomment=[s]{(**}{**)}, 90 | % 91 | % Spaces are not displayed as a special character 92 | showstringspaces=false, 93 | % 94 | % String delimiters 95 | morestring=[b]", 96 | morestring=[d]’, 97 | % 98 | % Size of tabulations 99 | tabsize=3, 100 | % 101 | % Enables ASCII chars 128 to 255 102 | extendedchars=false, 103 | % 104 | % Case sensitivity 105 | sensitive=true, 106 | % 107 | % Automatic breaking of long lines 108 | breaklines=true, 109 | % 110 | % Default style fors listings 111 | basicstyle=\small, 112 | % 113 | % Position of captions is bottom 114 | captionpos=b, 115 | % 116 | % Full flexible columns 117 | columns=[l]fullflexible, 118 | keepspaces=true, 119 | % 120 | % Style for (listings') identifiers 121 | identifierstyle={\ttfamily\color{black}}, 122 | % Note : highlighting of Coq identifiers is done through a new 123 | % delimiter definition through an lstset at the begining of the 124 | % document. Don't know how to do better. 125 | % 126 | % Style for declaration keywords 127 | keywordstyle=[1]{\ttfamily\color{dkviolet}}, 128 | % Style for gallina keywords 129 | keywordstyle=[2]{\ttfamily\color{dkgreen}}, 130 | % Style for sorts keywords 131 | keywordstyle=[3]{\ttfamily\color{ltblue}}, 132 | % Style for tactics keywords 133 | keywordstyle=[4]{\ttfamily\color{dkblue}}, 134 | % Style for terminators keywords 135 | keywordstyle=[5]{\ttfamily\color{dkred}}, 136 | %Style for iterators 137 | %keywordstyle=[6]{\ttfamily\color{dkpink}}, 138 | % Style for strings 139 | stringstyle=\ttfamily, 140 | % Style for comments 141 | commentstyle={\ttfamily\color{dkgreen}}, 142 | % 143 | % 144 | moredelim=**[is][\ttfamily\color{red}]{/&}{&/}, 145 | %litterate 146 | literate= 147 | {\\equiv}{{$\leftrightarrow\,$}}3 148 | {==>}{{$\Rightarrow$}}1 149 | {=>}{{$\Rightarrow$}}1 150 | {>->}{{$\rightarrowtail$}}2 151 | {->}{{$\rightarrow\,$}}2 152 | {<-}{{$\leftarrow\,$}}2 153 | {++}{{$\cup$}}1 154 | {<==}{{$\subseteq$}}1 155 | {|-}{{\quad$\vdash$\quad}}1 156 | {forall}{{$\forall$}}1 157 | {exists}{{$\exists$}}1 158 | {=o=}{{$\circeq$}}1 159 | {\\fun}{{$\lambda$}}1 160 | {|>}{{$\rhd$}}1 161 | {\\oplus}{{$\oplus$}}1 162 | {\\tab}{{\quad}}1 163 | {\\_}{{ }}1 164 | {||}{{$\vee$}}1 165 | {\&\&}{{$\wedge$}}1 166 | {\\bool}{{$\mathbb{B}$}}1 167 | {\\data}{{$\mathbb{T}$}}1 168 | {\\times}{{$\times$}}1 169 | {\\xorb}{{$\oplus$}}1 170 | {\\andb}{{$\wedge$}}1 171 | % 172 | }[keywords,strings] 173 | 174 | \lstnewenvironment{coq}{\lstset{language=Coq}}{} 175 | % pour inliner dans le texte 176 | \def\coqinline{\lstinline[language=Coq, basicstyle=\normalsize]} 177 | % pour inliner dans les tableaux / displaymath... 178 | \def\coqinlines{\lstinline[language=Coq]} 179 | \def\coqe{\lstinline[language=Coq, basicstyle=\small]} 180 | -------------------------------------------------------------------------------- /doc/lstocaml.sty: -------------------------------------------------------------------------------- 1 | \lstdefinelanguage{OCaml}{ 2 | % Anything betweeen $ becomes LaTeX math mode 3 | mathescape=true, 4 | % 5 | % Comments may or not include Latex commands 6 | texcl=false, 7 | % 8 | % Vernacular commands 9 | morekeywords=[1]{and, as, assert, begin, class, constraint, do, done, downto, else, end, exception, external, false, for, fun, function, functor, if, in, include, inherit, initializer, lazy, let, match, method, module, mutable, new, object, of, open, or, private, rec, sig, struct, then, to, true, try, type, val, virtual, when, while, with}, 10 | % 11 | % 12 | % Comments delimiters, we do turn this off for the manual 13 | comment=[s]{(*}{*)}, 14 | % 15 | %keepspaces 16 | keepspaces=true, 17 | % Spaces are not displayed as a special character 18 | showstringspaces=false, 19 | % 20 | % String delimiters 21 | morestring=[b]", 22 | morestring=[d]’, 23 | % 24 | % Size of tabulations 25 | tabsize=3, 26 | % 27 | % Enables ASCII chars 128 to 255 28 | extendedchars=false, 29 | % 30 | % Case sensitivity 31 | sensitive=true, 32 | % 33 | % Automatic breaking of long lines 34 | breaklines=true, 35 | % 36 | % Default style fors listings 37 | basicstyle=\scriptsize, 38 | % 39 | % Position of captions is bottom 40 | captionpos=b, 41 | % 42 | % Full flexible columns 43 | columns=[l]fullflexible, 44 | % 45 | % Style for (listings') identifiers 46 | identifierstyle={\ttfamily\color{black}}, 47 | % Note : highlighting of Coq identifiers is done through a new 48 | % delimiter definition through an lstset at the begining of the 49 | % document. Don't know how to do better. 50 | % 51 | keywordstyle=[1]{\ttfamily\color{dkviolet}}, 52 | % Style for strings 53 | stringstyle=\ttfamily, 54 | % Style for comments 55 | commentstyle={\ttfamily\color{dkgreen}}, 56 | % 57 | %litterate 58 | literate= 59 | {->}{{$\to$\,}}2 60 | {fun}{{$\lambda$\,}}3 61 | % {[blank]}{{\mbox{~}}}1 62 | {'a}{{$\alpha$}}1 63 | {'b}{{$\beta$}}1 64 | {>>}{{$\gg$}}1 65 | {>>|}{{$\gg\mid$}}1 66 | {\\eqac}{{$\equiv_{AC}$}}1 67 | {->}{{$\rightarrow$}}1 68 | {|triangle}{{$\triangle$}}1 69 | {|kreuz_1}{{$\kreuz_1$}}1 70 | {|kreuz_2}{{$\kreuz_2$}}1 71 | {|kreuz_3}{{$\kreuz_3$}}1 72 | {sigma}{{$\sigma$}}1 73 | {p_1}{{$p_1$}}1 74 | {p_2}{{$p_2$}}1 75 | {t_1}{{$t_1$}}1 76 | {t_2}{{$t_2$}}1 77 | {p_i}{{$p_i$}}1 78 | {t_i}{{$t_i$}}1 79 | {\\tab}{{$\qquad$}}1 80 | {[blank]}{{\ }}1 81 | % 82 | }[keywords,comments,strings] 83 | 84 | 85 | \lstnewenvironment{ocaml}{\lstset{language=OCaml}}{} 86 | % pour inliner dans le texte 87 | \def\ocamlinline{\lstinline[language=OCaml, basicstyle=\small]} 88 | % pour inliner dans les tableaux / displaymath... 89 | \def\ocamlinlines{\lstinline[language=OCaml]} 90 | -------------------------------------------------------------------------------- /doc/main.tex: -------------------------------------------------------------------------------- 1 | \documentclass[a4]{article} 2 | \usepackage{color} 3 | \usepackage{listings} 4 | \usepackage{lstocaml} 5 | \usepackage{lstcoq} 6 | 7 | \newenvironment{twolistings}% 8 | {\noindent\begin{tabular*}{\linewidth}{@{}c@{\extracolsep{\fill}}c@{}}}% 9 | {\end{tabular*}} 10 | 11 | \begin{document} 12 | \begin{abstract} 13 | We try to build a tutorial on how to write an OCaml tactic for Coq, 14 | with a focus on reification tactics. 15 | \end{abstract} 16 | 17 | \section*{Introduction} 18 | The long term goal of this tutorial is to reify the equation on the 19 | left, into a reified version on the right, that exposes the syntax 20 | tree of the expressions. 21 | 22 | \begin{twolistings} 23 | \begin{coq} 24 | 25 | 26 | a,b: nat 27 | ========= 28 | a + S b + 2 = a + b + 3 29 | \end{coq} 30 | & 31 | \begin{coq} 32 | a,b: nat 33 | left := (a_plus (a_plus (a_const a) (a_succ (a_const b))) (a_const 2)) 34 | right := (a_plus (a_plus (a_const a) (a_const b)) (a_const 3)) 35 | ========= 36 | left = right 37 | \end{coq} 38 | 39 | \end{twolistings} 40 | \section{OCaml representation of a Coq term} 41 | The first step to get 42 | \begin{coq} 43 | 44 | \end{coq} 45 | \section{A first tactic} 46 | \section{Reification in Coq} 47 | 48 | \appendix 49 | \section{The makefile} 50 | \section{A walkthrough of Coq sources} 51 | 52 | \end{document} 53 | 54 | %%% Local Variables: 55 | %%% mode: latex 56 | %%% TeX-master: t 57 | %%% End: 58 | -------------------------------------------------------------------------------- /doc/mathpartir.sty: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/braibant/coq-tutorial-ml-tactics/1a9849b73a5e68cb3432f5d1d45b366ce75db6df/doc/mathpartir.sty -------------------------------------------------------------------------------- /src/Theory.v: -------------------------------------------------------------------------------- 1 | 2 | (** * Introduction 3 | 4 | The goal of this plugin is to reify concrete terms of type [nat] 5 | to a language of abstract terms of type [arith]. ([arith] is an 6 | inductive data-type that represents reified terms of type [nat].) 7 | This allows to use Barendredgt's so-called 2-level approach. *) 8 | 9 | Require Import Arith. 10 | 11 | (** The abstract language of terms of type [nat] (restricted to [plus], 12 | [O], [S] and variables) *) 13 | 14 | (* This is not the most simple example of reification possible, since 15 | we could work out an example without variables (with atoms, or holes, 16 | that contains constants). However, using an environment allows one to 17 | reify the identity of such atomic sub-terms. *) 18 | 19 | Inductive arith := 20 | | a_plus : arith -> arith -> arith 21 | | a_var : nat -> arith 22 | | a_const : nat -> arith 23 | | a_succ : arith -> arith. 24 | 25 | (** [eval] maps reified terms of type [arith] to [nat] using an 26 | environment to map syntactic variables to terms. *) 27 | 28 | Section t. 29 | Variable env : list nat. 30 | Fixpoint eval (t : arith) : nat := 31 | match t with 32 | | a_plus a b => (eval a) + (eval b) 33 | | a_const x => x 34 | | a_var x => List.nth x env 0 35 | | a_succ a => S (eval a) 36 | end. 37 | End t. 38 | 39 | (** * Some examples of reified terms *) 40 | Section example. 41 | Require Import List. 42 | Variables a b c : nat. 43 | Let env := a :: b ::c :: nil. 44 | 45 | (** [b + 3] *) 46 | Eval compute [eval nth env] in 47 | (eval env (a_plus (a_var 1) (a_const 3))). 48 | 49 | (** [a + 4] *) 50 | Eval compute [eval nth env] in 51 | (eval env (a_plus (a_var 0) (a_succ (a_const 3)))). 52 | 53 | (** [a * b + 4] *) 54 | Eval compute [eval nth env] in 55 | (eval ((a*b) :: env) (a_plus (a_var 0) (a_succ (a_const 3)))). 56 | 57 | (** [a * b + 4] *) 58 | Eval compute [eval nth env] in 59 | (eval nil (a_plus (a_const (a*b)) (a_succ (a_const 3)))). 60 | 61 | End example. 62 | 63 | (** * Some magic 64 | 65 | We use the following vernacular command to make Coq load the plugin 66 | [plugin] when one load the Coq file [Theory]. In the plugin 67 | [plugin], we declare some new tactics that will be available in 68 | proof-mode. 69 | 70 | In the current trunk (07/05/2011 rev 14260), one has to declare all 71 | ML modules that need to be linked dynamically. *) 72 | 73 | Declare ML Module "theplug". 74 | -------------------------------------------------------------------------------- /src/lib_coq.ml: -------------------------------------------------------------------------------- 1 | (* The contrib name is used to locate errors when loading constrs *) 2 | let contrib_name = "ml_tutorial" 3 | 4 | (** Getting constrs (primitive Coq terms) from existing Coq 5 | libraries. 6 | 7 | - [find_reference] is located in {v interp/coqlib.ml v} and return a global reference to the name "dir.s" (it must be used lazily). 8 | 9 | - [constr_of_global] is located in {v library/libnames.ml v} and turn a 10 | global reference into a constr. 11 | *) 12 | let find_constant contrib dir s = 13 | Universes.constr_of_global (Coqlib.find_reference contrib dir s) 14 | 15 | let init_constant dir s = find_constant contrib_name dir s 16 | 17 | (** [decomp_term] returns a user view of a constr, as defined in {v 18 | kernel/term.ml v}. *) 19 | let decomp_term (c : Term.constr) = 20 | Term.kind_of_term (Term.strip_outer_cast c) 21 | 22 | let lapp c v = Term.mkApp (Lazy.force c, v) 23 | 24 | module Env = struct 25 | module ConstrHashed = struct 26 | type t = Term.constr 27 | let equal = Term.eq_constr 28 | let hash = Term.hash_constr 29 | end 30 | module ConstrHashtbl = Hashtbl.Make (ConstrHashed) 31 | 32 | type t = (int ConstrHashtbl.t * int ref) 33 | 34 | let add (env : t) (t : Term.constr ) = 35 | try ConstrHashtbl.find (fst env) t 36 | with 37 | | Not_found -> 38 | let i = !(snd env) in 39 | ConstrHashtbl.add (fst env) t i ; incr (snd env); i 40 | 41 | let empty () = (ConstrHashtbl.create 16, ref 0) 42 | 43 | let to_list (env,_) = 44 | ConstrHashtbl.fold (fun constr key acc -> ( constr) :: acc) env [] 45 | 46 | end 47 | 48 | module Nat = struct 49 | let path = ["Coq" ; "Init"; "Datatypes"] 50 | let typ = lazy (init_constant path "nat") 51 | let _S = lazy (init_constant path "S") 52 | let _O = lazy (init_constant path "O") 53 | (* A coq nat from an int *) 54 | let of_int n = 55 | let rec aux n = 56 | begin match n with 57 | | n when n < 0 -> assert false 58 | | 0 -> Lazy.force _O 59 | | n -> Term.mkApp 60 | ( 61 | (Lazy.force _S 62 | ), [| aux (n-1)|] 63 | ) 64 | end 65 | in 66 | aux n 67 | end 68 | 69 | (** Lists from the standard library*) 70 | module List = struct 71 | let path = ["Coq"; "Lists"; "List"] 72 | let typ = lazy (init_constant path "list") 73 | let nil = lazy (init_constant path "nil") 74 | let cons = lazy (init_constant path "cons") 75 | let cons ty h t = 76 | Term.mkApp (Lazy.force cons, [| ty; h ; t |]) 77 | let nil ty = 78 | (Term.mkApp (Lazy.force nil, [| ty |])) 79 | let rec of_list ty = function 80 | | [] -> nil ty 81 | | t::q -> cons ty t (of_list ty q) 82 | let type_of_list ty = 83 | Term.mkApp (Lazy.force typ, [|ty|]) 84 | end 85 | 86 | 87 | 88 | -------------------------------------------------------------------------------- /src/lib_coq.mli: -------------------------------------------------------------------------------- 1 | (** Interface with Coq where we define some handlers for Coq's API, 2 | and we import several definitions from Coq's standard library. 3 | 4 | This general purpose library is a stripped down version of the one 5 | built for the plugin aac_tactics. 6 | 7 | We use Caml's module system to mimic Coq's one, and avoid 8 | cluttering the namespace 9 | *) 10 | 11 | (** {2 Getting Coq terms from the environment} *) 12 | 13 | (** [init_constant path cst] returns the constr corresponding to 14 | [path.cst]. It must be used lazily. *) 15 | val init_constant : string list -> string -> Term.constr 16 | 17 | (** {2 General purpose functions} *) 18 | 19 | (** [decomp_term c] returns a user-view of a term (as defined in the 20 | module kernel/term.mli). *) 21 | val decomp_term : Term.constr -> (Term.constr , Term.types) Term.kind_of_term 22 | 23 | (** [lapp c args] build the application of the lazy constr [c] to the 24 | array of arguments [args]. This is a handy shortcut. *) 25 | val lapp : Term.constr lazy_t -> Term.constr array -> Term.constr 26 | 27 | (** {2 Getting Coq terms from the environment} *) 28 | module Env: 29 | sig 30 | (** This module defines a very simple environment for Coq terms. It 31 | associate an index ([int]) to terms. If a term is added twice, 32 | then the same index is returned. *) 33 | 34 | (** the abstract type of the environment *) 35 | type t 36 | 37 | (** [add env c] add a new term to the environment. 38 | 39 | - If the term [c] is not bound in [env] then we associate a fresh 40 | index to it, and this pair to [env]. 41 | 42 | - If the term [c] is already present in [env], we return its 43 | index. 44 | *) 45 | val add : t -> Term.constr -> int 46 | 47 | (** [empty ()] return an empty environment *) 48 | val empty : unit -> t 49 | 50 | (** [to_list env] builds the list of the terms that were stored in 51 | the environment. This allows to access them by their position in 52 | the list (we ensure that the position in the list is the number 53 | that was returned when we added them). *) 54 | val to_list : t -> Term.constr list 55 | end 56 | 57 | (** {2 Bindings with Coq' Standard Library} *) 58 | 59 | (** Coq lists *) 60 | module List: 61 | sig 62 | (** [of_list ty l] *) 63 | val of_list:Term.constr ->Term.constr list ->Term.constr 64 | 65 | (** [type_of_list ty] *) 66 | val type_of_list:Term.constr ->Term.constr 67 | end 68 | 69 | (** Coq unary numbers (peano) *) 70 | module Nat: 71 | sig 72 | val typ:Term.constr lazy_t 73 | val of_int: int ->Term.constr 74 | end 75 | 76 | -------------------------------------------------------------------------------- /src/plugin.ml4: -------------------------------------------------------------------------------- 1 | DECLARE PLUGIN "theplug" 2 | 3 | (** We reify the structure of coq expressions as an ocaml 4 | data-type. We reify only the structure of the expression 5 | w.r.t. the [plus], [S], and [O] symbols of Coq. All other 6 | sub-expressions are stored in an environment. 7 | *) 8 | module Arith = struct 9 | 10 | (** First, we initialise some constants from Coq standard library.*) 11 | let plus = lazy (Lib_coq.init_constant ["Coq"; "Init"; "Peano"] "plus") 12 | let succ = lazy (Lib_coq.init_constant ["Coq"; "Init"; "Datatypes"] "S") 13 | let zero = lazy (Lib_coq.init_constant ["Coq"; "Init"; "Datatypes"] "O") 14 | 15 | (** [t] is an algebraic data-type that represents reified arithemtic 16 | expressions *) 17 | type t = 18 | | Plus of (t * t) 19 | | Const of int 20 | | Succ of t 21 | | Var of int 22 | 23 | 24 | let quote (env : Lib_coq.Env.t) (c : Term.constr) : t = 25 | (** First, we force the constants, once and for all *) 26 | let plus = Lazy.force plus in 27 | let succ = Lazy.force succ in 28 | let zero = Lazy.force zero in 29 | (** Second, we decompose recursively the given term. If the term 30 | is an application, we compare the head-symbol with [plus] and 31 | [succ]. If the term is equal to [zero], we build a 32 | constant. In any other case, we have to add a new variable to 33 | the reification environement. *) 34 | let rec aux c = match Lib_coq.decomp_term c with 35 | | Term.App (head,args) 36 | when Term.eq_constr head plus && Array.length args = 2 37 | -> Plus (aux args.(0), aux args.(1)) 38 | | Term.App (head,args) 39 | when Term.eq_constr head succ && Array.length args = 1 40 | -> 41 | (** a small match to get a intelligible representation of 42 | constants. *) 43 | begin match (aux args.(0)) with 44 | | Const i -> Const (i +1) 45 | | e -> Succ e 46 | end 47 | | _ when Term.eq_constr c zero -> 48 | Const 0 49 | | _ -> 50 | let i = Lib_coq.Env.add env c in 51 | Var i 52 | in 53 | aux c 54 | end 55 | 56 | (** Now that we have reified the structure of the term inside ocaml, 57 | we will reify it inside Coq (this is also the purpose of the Quote 58 | module of standard Coq). 59 | *) 60 | module Reif = struct 61 | (** We initialize a new bunch of constants that correspond to the 62 | constructors of our inductive. *) 63 | 64 | (** This [path] correspond to the name of the logical directory 65 | (ML_tutorial), and the name of the library (Theory). The name of 66 | the logical directory must be consistent with the options given 67 | to coq_makefile: [-R ./src ML_tutorial] adds the physical 68 | directory [src] as the logical directory [ML_tutorial]. 69 | *) 70 | let path = ["ML_tutorial";"Theory"] 71 | 72 | let plus = lazy (Lib_coq.init_constant path "a_plus") 73 | let var = lazy (Lib_coq.init_constant path "a_var") 74 | let const = lazy (Lib_coq.init_constant path "a_const") 75 | let succ = lazy (Lib_coq.init_constant path "a_succ") 76 | 77 | (** [eval] is the Coq function that maps a reified Coq arithmetic 78 | expression back to a nat *) 79 | let eval = lazy(Lib_coq.init_constant path "eval") 80 | 81 | (** [to_constr t] build the Coq term that corresponds to [t]. *) 82 | let rec to_constr (t : Arith.t) : Term.constr = match t with 83 | | Arith.Plus (a, b) -> Term.mkApp (Lazy.force plus, [|(to_constr a); (to_constr b)|]) 84 | | Arith.Const n -> Term.mkApp (Lazy.force const, [|Lib_coq.Nat.of_int n|]) 85 | | Arith.Succ a -> Term.mkApp (Lazy.force succ, [|(to_constr a)|]) 86 | | Arith.Var n -> Term.mkApp (Lazy.force var, [|Lib_coq.Nat.of_int n|]) 87 | 88 | (** [env_to_constr env] build the Coq list that correspond to the 89 | environment map. We build a uniform Coq list of nat of type 90 | [list nat]. More complex situations may be treated in subsequent 91 | tutorials. *) 92 | let env_to_constr (env : Lib_coq.Env.t) : Term.constr = 93 | let l = Lib_coq.Env.to_list env in 94 | Lib_coq.List.of_list (Lazy.force Lib_coq.Nat.typ) l 95 | 96 | (** [build_eval env t] builds the Coq term that corresponds to [eval 97 | env t]. *) 98 | let build_eval (env : Term.constr) (t : Arith.t) : Term.constr = 99 | Lib_coq.lapp eval [|env; to_constr t|] 100 | (* alternatively, 101 | Term.mkApp (Lazy.force eval, [|env_to_constr env; to_constr t|]) *) 102 | 103 | (** [tac] is the final tactic. *) 104 | let tac : unit Proofview.tactic = 105 | Proofview.Goal.enter (fun gl -> 106 | (** We get the conclusion of the as a goal, which is a constr. 107 | (see [proofs/proofview.mli].) *) 108 | let concl = Proofview.Goal.raw_concl gl in 109 | 110 | (** In our particular setting, the conclusion of the goal must 111 | be a relation applied to at least two arguments (the 112 | left-hand side and the right-hand side) of the 113 | "equation". *) 114 | match Lib_coq.decomp_term concl with 115 | | Term.App(c, args) when Array.length args >= 2 -> 116 | let n = Array.length args in 117 | let left = args.(n-2) in 118 | let right = args.(n-1) in 119 | (** We initialize the environment, to reify the left 120 | hand-side and the right-hand side of the equation*) 121 | let arith_env = Lib_coq.Env.empty () in 122 | let left' = Arith.quote arith_env left in 123 | let right' = Arith.quote arith_env right in 124 | let coq_env = env_to_constr arith_env in 125 | (** We want to move from 126 | {C left == right} 127 | to 128 | {C (eval env left') == (eval env right')} 129 | 130 | *) 131 | args.(n-2) <- build_eval coq_env left'; 132 | args.(n-1) <- build_eval coq_env right'; 133 | let concl' = Term.mkApp (c, args) 134 | in 135 | (** We use a {i tactical} to chain together a list of 136 | tactics (as would be done using a semi-column in Coq). 137 | (see [tactics/tacticals.mli] for other tacticals.) *) 138 | Tacticals.New.tclTHENLIST 139 | [ 140 | (** Our list of tactics consists in the following single 141 | tactic, that changes the conclusion of the goal to 142 | [concl'] if [concl] and [concl'] are convertible. 143 | (see [tactics/tactis.mli] for other tactics.) *) 144 | Tactics.change_concl concl' ; 145 | ] 146 | | _ -> 147 | (** If the goal was not looking like a relation applied to two 148 | arguments, we fail using the tacticals [tclFAIL]. 149 | 150 | The documentation of fail is 151 | {{:http://coq.inria.fr/refman/Reference-Manual012.html#@tactic183}here} 152 | 153 | In a nutshell [tclFAIl] has type [int -> Pp.std_ppcmds -> 154 | tactic]. The number is the failure level (0 means that 155 | an englobing [match goal] may proceed to the next clause 156 | and [try] succeeds, while n > 1 means that the current 157 | [match goal] or [try] is aborted, and the level is 158 | decremented. 159 | 160 | The [Pp.std_ppcmds] is a pretty-printer command. 161 | 162 | (see lib/pp.mli for more functions) 163 | *) 164 | Tacticals.New.tclFAIL 1 165 | (Pp.str "The goal does not look like an equation")) 166 | end 167 | 168 | (** The final magic part is to register our custom tactic in 169 | Coq. [_reflect_] is the name of this tactic extension (I do not know 170 | what it is used for). [Reif.tac] is our custom 171 | tactic. [reflect_arith] is the string through which this tactic 172 | can be invoked inside Coq. 173 | *) 174 | 175 | TACTIC EXTEND _reflect_ 176 | | ["reflect_arith"] -> [Reif.tac] 177 | END 178 | 179 | -------------------------------------------------------------------------------- /src/theplug.mllib: -------------------------------------------------------------------------------- 1 | Lib_coq 2 | Plugin 3 | -------------------------------------------------------------------------------- /test-suite/example.v: -------------------------------------------------------------------------------- 1 | Require Import Theory. 2 | 3 | (* example 1 *) 4 | Goal forall a b, a + b + 1 = 0. 5 | intros. reflect_arith. 6 | Abort. 7 | 8 | (* example 2 *) 9 | Goal forall a b c, a + b + 1 + c <= 1. 10 | intros. reflect_arith. 11 | Abort. 12 | 13 | (* example 3 *) 14 | Goal forall a b c, a + b + 1 <= c. 15 | intros. reflect_arith. 16 | Abort. 17 | --------------------------------------------------------------------------------