Initial import of SMTCoq v1.2

50 files changed, 24014 insertions, 0 deletions

diff --git a/src/Make b/src/Make
new file mode 100644
index 0000000..d1c9342
--- /dev/null
+++ b/src/Make
@@ -0,0 +1,91 @@
+########################################################################
+##   This file is intended to developers, please do not use it to     ##
+## generate a Makefile, rather use the provided Makefile.             ##
+########################################################################
+
+
+
+
+########################################################################
+## To generate the Makefile:                                          ##
+##   coq_makefile -f Make -o Makefile                                 ##
+## Change the "all" target into:                                      ##
+##   all: ml $(CMXFILES) $(CMXA) $(CMXS) $(VOFILES)                   ##
+## Change the "install-natdynlink" target: change CMXSFILES into CMXS and add the same thing for CMXA and VCMXS. ##
+## Change the "install" target: change CMO into CMX.                  ##
+## Finally, suppress the "Makefile" target and add to the "clean" target: ##
+##   - rm -f NSMTCoq* cnf/NSMTCoq* euf/NSMTCoq* lia/NSMTCoq* spl/NSMTCoq* ../unit-tests/NSMTCoq* ../unit-tests/*.zlog ../unit-tests/*.vtlog verit/veritParser.mli verit/veritParser.ml verit/veritLexer.ml verit/smtlib2_parse.mli verit/smtlib2_parse.ml verit/smtlib2_lex.ml ##
+########################################################################
+
+
+-R . SMTCoq
+
+-I cnf
+-I euf
+-I lia
+-I trace
+-I verit
+-I zchaff
+
+# -custom "cd ../unit-tests; make" "" "logs"
+-custom "cd ../unit-tests; make" "" "test"
+
+-custom "$(CAMLLEX) $<" "%.mll" "%.ml"
+-custom "$(CAMLYACC) $<" "%.mly" "%.ml %.mli"
+-custom "" "verit/veritParser.ml verit/veritLexer.ml verit/smtlib2_parse.ml verit/smtlib2_lex.ml" "ml"
+
+-custom "$(CAMLOPTLINK) $(ZFLAGS) -a -o $@ $^" "trace/smtMisc.cmx trace/coqTerms.cmx trace/smtForm.cmx trace/smtCertif.cmx trace/smtTrace.cmx trace/smtCnf.cmx trace/satAtom.cmx trace/smtAtom.cmx zchaff/satParser.cmx zchaff/zchaffParser.cmx zchaff/cnfParser.cmx zchaff/zchaff.cmx verit/smtlib2_util.cmx verit/smtlib2_ast.cmx verit/smtlib2_parse.cmx verit/smtlib2_lex.cmx lia/lia.cmx verit/veritSyntax.cmx verit/veritParser.cmx verit/veritLexer.cmx verit/smtlib2_genConstr.cmx verit/verit.cmx trace/smt_tactic.cmx" "$(CMXA)"
+-custom "$(CAMLOPTLINK) $(ZFLAGS) -o $@ -linkall -shared $^" "$(CMXA)" "$(CMXS)"
+
+CMXA = trace/smtcoq.cmxa
+CMXS = trace/smt_tactic.cmxs
+VCMXS = "NSMTCoq_State.cmxs NSMTCoq_Misc.cmxs NSMTCoq_SMT_terms.cmxs cnf/NSMTCoq_cnf_Cnf.cmxs euf/NSMTCoq_euf_Euf.cmxs lia/NSMTCoq_lia_Lia.cmxs spl/NSMTCoq_spl_Syntactic.cmxs spl/NSMTCoq_spl_Arithmetic.cmxs spl/NSMTCoq_spl_Operators.cmxs NSMTCoq_Trace.cmxs NSMTCoq_SMTCoq.cmxs NSMTCoq_State.cmi NSMTCoq_Misc.cmi NSMTCoq_SMT_terms.cmi cnf/NSMTCoq_cnf_Cnf.cmi euf/NSMTCoq_euf_Euf.cmi lia/NSMTCoq_lia_Lia.cmi spl/NSMTCoq_spl_Syntactic.cmxs spl/NSMTCoq_spl_Arithmetic.cmi spl/NSMTCoq_spl_Operators.cmi NSMTCoq_Trace.cmi NSMTCoq_Trace.cmi NSMTCoq_SMTCoq.cmi"
+CAMLLEX = $(CAMLBIN)ocamllex
+CAMLYACC = $(CAMLBIN)ocamlyacc
+
+trace/coqTerms.ml
+trace/satAtom.ml
+trace/smtAtom.ml
+trace/smtAtom.mli
+trace/smtCertif.ml
+trace/smtCnf.ml
+trace/smtForm.ml
+trace/smtForm.mli
+trace/smtMisc.ml
+trace/smt_tactic.ml4
+trace/smtTrace.ml
+
+verit/smtlib2_ast.ml
+verit/smtlib2_genConstr.ml
+verit/smtlib2_lex.ml
+verit/smtlib2_parse.ml
+verit/smtlib2_util.ml
+verit/veritParser.ml
+verit/veritLexer.ml
+verit/verit.ml
+verit/veritSyntax.ml
+verit/veritSyntax.mli
+
+zchaff/cnfParser.ml
+zchaff/satParser.ml
+zchaff/zchaff.ml
+zchaff/zchaffParser.ml
+
+cnf/Cnf.v
+
+euf/Euf.v
+
+lia/lia.ml
+lia/Lia.v
+
+spl/Syntactic.v
+spl/Arithmetic.v
+spl/Operators.v
+
+Misc.v
+SMTCoq.v
+SMT_terms.v
+State.v
+Trace.v
+
+# tests/Tests.v
diff --git a/src/Makefile b/src/Makefile
new file mode 100644
index 0000000..8919e7f
--- /dev/null
+++ b/src/Makefile
@@ -0,0 +1,416 @@
+#############################################################################
+##  v      #                   The Coq Proof Assistant                     ##
+## <O___,, #                INRIA - CNRS - LIX - LRI - PPS                 ##
+##   \VV/  #                                                               ##
+##    //   #  Makefile automagically generated by coq_makefile Vtrunk      ##
+#############################################################################
+
+# WARNING
+#
+# This Makefile has been automagically generated
+# Edit at your own risks !
+#
+# END OF WARNING
+
+#
+# This Makefile was generated by the command line :
+# coq_makefile -f Make -o Makefile 
+#
+
+.DEFAULT_GOAL := all
+
+# 
+# This Makefile may take arguments passed as environment variables:
+# COQBIN to specify the directory where Coq binaries resides;
+# ZDEBUG/COQDEBUG to specify debug flags for ocamlc&ocamlopt/coqc;
+# DSTROOT to specify a prefix to install path.
+
+# Here is a hack to make $(eval $(shell works:
+define donewline
+
+
+endef
+includecmdwithout@ = $(eval $(subst @,$(donewline),$(shell { $(1) | tr '\n' '@'; })))
+$(call includecmdwithout@,$(COQBIN)coqtop -config)
+
+##########################
+#                        #
+# Libraries definitions. #
+#                        #
+##########################
+
+OCAMLLIBS?=-I zchaff\
+  -I verit\
+  -I trace\
+  -I lia\
+  -I euf\
+  -I cnf
+COQLIBS?= -R . SMTCoq
+COQDOCLIBS?=-R . SMTCoq
+
+##########################
+#                        #
+# Variables definitions. #
+#                        #
+##########################
+
+CAMLYACC=$(CAMLBIN)ocamlyacc
+CAMLLEX=$(CAMLBIN)ocamllex
+VCMXS=NSMTCoq_State.cmxs NSMTCoq_Misc.cmxs NSMTCoq_SMT_terms.cmxs cnf/NSMTCoq_cnf_Cnf.cmxs euf/NSMTCoq_euf_Euf.cmxs lia/NSMTCoq_lia_Lia.cmxs spl/NSMTCoq_spl_Syntactic.cmxs spl/NSMTCoq_spl_Arithmetic.cmxs spl/NSMTCoq_spl_Operators.cmxs NSMTCoq_Trace.cmxs NSMTCoq_SMTCoq.cmxs NSMTCoq_State.cmi NSMTCoq_Misc.cmi NSMTCoq_SMT_terms.cmi cnf/NSMTCoq_cnf_Cnf.cmi euf/NSMTCoq_euf_Euf.cmi lia/NSMTCoq_lia_Lia.cmi spl/NSMTCoq_spl_Syntactic.cmxs spl/NSMTCoq_spl_Arithmetic.cmi spl/NSMTCoq_spl_Operators.cmi NSMTCoq_Trace.cmi NSMTCoq_Trace.cmi NSMTCoq_SMTCoq.cmi
+CMXS=trace/smt_tactic.cmxs
+CMXA=trace/smtcoq.cmxa
+
+OPT?=
+COQDEP?=$(COQBIN)coqdep -c
+COQFLAGS?=-q $(OPT) $(COQLIBS) $(OTHERFLAGS) $(COQ_XML)
+COQCHKFLAGS?=-silent -o
+COQDOCFLAGS?=-interpolate -utf8
+COQC?=$(COQBIN)coqc
+GALLINA?=$(COQBIN)gallina
+COQDOC?=$(COQBIN)coqdoc
+COQCHK?=$(COQBIN)coqchk
+
+COQSRCLIBS?=-I $(COQLIB)kernel -I $(COQLIB)lib \
+  -I $(COQLIB)library -I $(COQLIB)parsing \
+  -I $(COQLIB)pretyping -I $(COQLIB)interp \
+  -I $(COQLIB)proofs -I $(COQLIB)tactics \
+  -I $(COQLIB)toplevel \
+  -I $(COQLIB)plugins/btauto \
+  -I $(COQLIB)plugins/cc \
+  -I $(COQLIB)plugins/decl_mode \
+  -I $(COQLIB)plugins/extraction \
+  -I $(COQLIB)plugins/field \
+  -I $(COQLIB)plugins/firstorder \
+  -I $(COQLIB)plugins/fourier \
+  -I $(COQLIB)plugins/funind \
+  -I $(COQLIB)plugins/micromega \
+  -I $(COQLIB)plugins/nsatz \
+  -I $(COQLIB)plugins/omega \
+  -I $(COQLIB)plugins/quote \
+  -I $(COQLIB)plugins/ring \
+  -I $(COQLIB)plugins/romega \
+  -I $(COQLIB)plugins/rtauto \
+  -I $(COQLIB)plugins/setoid_ring \
+  -I $(COQLIB)plugins/syntax \
+  -I $(COQLIB)plugins/xml
+ZFLAGS=$(OCAMLLIBS) $(COQSRCLIBS) -I $(CAMLP4LIB)
+
+CAMLC?=$(OCAMLC) -c -rectypes
+CAMLOPTC?=$(OCAMLOPT) -c -rectypes
+CAMLLINK?=$(OCAMLC) -rectypes
+CAMLOPTLINK?=$(OCAMLOPT) -rectypes
+GRAMMARS?=grammar.cma
+CAMLP4EXTEND?=pa_extend.cmo pa_macro.cmo q_MLast.cmo
+CAMLP4OPTIONS?=-loc loc
+PP?=-pp "$(CAMLP4BIN)$(CAMLP4)o -I $(CAMLLIB) -I . $(COQSRCLIBS) $(CAMLP4EXTEND) $(GRAMMARS) $(CAMLP4OPTIONS) -impl"
+
+##################
+#                #
+# Install Paths. #
+#                #
+##################
+
+ifdef USERINSTALL
+XDG_DATA_HOME?=$(HOME)/.local/share
+COQLIBINSTALL=$(XDG_DATA_HOME)/coq
+COQDOCINSTALL=$(XDG_DATA_HOME)/doc/coq
+else
+COQLIBINSTALL=${COQLIB}user-contrib
+COQDOCINSTALL=${DOCDIR}user-contrib
+endif
+
+######################
+#                    #
+# Files dispatching. #
+#                    #
+######################
+
+VFILES:=Trace.v\
+  State.v\
+  SMT_terms.v\
+  SMTCoq.v\
+  Misc.v\
+  spl/Operators.v\
+  spl/Arithmetic.v\
+  spl/Syntactic.v\
+  lia/Lia.v\
+  euf/Euf.v\
+  cnf/Cnf.v
+
+-include $(addsuffix .d,$(VFILES))
+.SECONDARY: $(addsuffix .d,$(VFILES))
+
+vo_to_obj = $(addsuffix .o,$(foreach vo,$(1),$(addprefix $(dir $(vo)),$(filter-out Warning: Error:,$(firstword $(shell $(COQBIN)coqtop -batch -quiet -print-mod-uid $(vo:.vo=)))))))
+VOFILES:=$(foreach vo,$(VFILES:.v=.vo),$(dir $(vo))$(notdir $(vo)))
+GLOBFILES:=$(VFILES:.v=.glob)
+VIFILES:=$(VFILES:.v=.vi)
+GFILES:=$(VFILES:.v=.g)
+HTMLFILES:=$(VFILES:.v=.html)
+GHTMLFILES:=$(VFILES:.v=.g.html)
+OBJFILES:=$(call vo_to_obj,$(VOFILES))
+ML4FILES:=trace/smt_tactic.ml4
+
+-include $(addsuffix .d,$(ML4FILES))
+.SECONDARY: $(addsuffix .d,$(ML4FILES))
+
+MLFILES:=lia/lia.ml\
+  zchaff/zchaffParser.ml\
+  zchaff/zchaff.ml\
+  zchaff/satParser.ml\
+  zchaff/cnfParser.ml\
+  verit/veritSyntax.ml\
+  verit/verit.ml\
+  verit/veritLexer.ml\
+  verit/veritParser.ml\
+  verit/smtlib2_util.ml\
+  verit/smtlib2_parse.ml\
+  verit/smtlib2_lex.ml\
+  verit/smtlib2_genConstr.ml\
+  verit/smtlib2_ast.ml\
+  trace/smtTrace.ml\
+  trace/smtMisc.ml\
+  trace/smtForm.ml\
+  trace/smtCnf.ml\
+  trace/smtCertif.ml\
+  trace/smtAtom.ml\
+  trace/satAtom.ml\
+  trace/coqTerms.ml
+
+-include $(addsuffix .d,$(MLFILES))
+.SECONDARY: $(addsuffix .d,$(MLFILES))
+
+MLIFILES:=verit/veritSyntax.mli\
+  trace/smtForm.mli\
+  trace/smtAtom.mli
+
+-include $(addsuffix .d,$(MLIFILES))
+.SECONDARY: $(addsuffix .d,$(MLIFILES))
+
+ALLCMOFILES:=$(ML4FILES:.ml4=.cmo) $(MLFILES:.ml=.cmo)
+CMOFILES=$(filter-out $(addsuffix .cmo,$(foreach lib,$(MLLIBFILES:.mllib=_MLLIB_DEPENDENCIES) $(MLPACKFILES:.mlpack=_MLPACK_DEPENDENCIES),$($(lib)))),$(ALLCMOFILES))
+CMXFILES=$(CMOFILES:.cmo=.cmx)
+CMIFILES=$(sort $(ALLCMOFILES:.cmo=.cmi) $(MLIFILES:.mli=.cmi))
+CMXSFILES=$(CMXFILES:.cmx=.cmxs)
+
+#######################################
+#                                     #
+# Definition of the toplevel targets. #
+#                                     #
+#######################################
+
+all: ml $(CMXFILES) $(CMXA) $(CMXS) $(VOFILES)
+
+mlihtml: $(MLIFILES:.mli=.cmi)
+	 mkdir $@ || rm -rf $@/*
+	$(OCAMLDOC) -html -rectypes -d $@ -m A $(ZDEBUG) $(ZFLAGS) $(^:.cmi=.mli)
+
+all-mli.tex: $(MLIFILES:.mli=.cmi)
+	$(OCAMLDOC) -latex -rectypes -o $@ -m A $(ZDEBUG) $(ZFLAGS) $(^:.cmi=.mli)
+
+spec: $(VIFILES)
+
+gallina: $(GFILES)
+
+html: $(GLOBFILES) $(VFILES)
+	- mkdir -p html
+	$(COQDOC) -toc $(COQDOCFLAGS) -html $(COQDOCLIBS) -d html $(VFILES)
+
+gallinahtml: $(GLOBFILES) $(VFILES)
+	- mkdir -p html
+	$(COQDOC) -toc $(COQDOCFLAGS) -html -g $(COQDOCLIBS) -d html $(VFILES)
+
+all.ps: $(VFILES)
+	$(COQDOC) -toc $(COQDOCFLAGS) -ps $(COQDOCLIBS) -o $@ `$(COQDEP) -sort -suffix .v $^`
+
+all-gal.ps: $(VFILES)
+	$(COQDOC) -toc $(COQDOCFLAGS) -ps -g $(COQDOCLIBS) -o $@ `$(COQDEP) -sort -suffix .v $^`
+
+all.pdf: $(VFILES)
+	$(COQDOC) -toc $(COQDOCFLAGS) -pdf $(COQDOCLIBS) -o $@ `$(COQDEP) -sort -suffix .v $^`
+
+all-gal.pdf: $(VFILES)
+	$(COQDOC) -toc $(COQDOCFLAGS) -pdf -g $(COQDOCLIBS) -o $@ `$(COQDEP) -sort -suffix .v $^`
+
+validate: $(VOFILES)
+	$(COQCHK) $(COQCHKFLAGS) $(COQLIBS) $(notdir $(^:.vo=))
+
+beautify: $(VFILES:=.beautified)
+	for file in $^; do mv $${file%.beautified} $${file%beautified}old && mv $${file} $${file%.beautified}; done
+	@echo 'Do not do "make clean" until you are sure that everything went well!'
+	@echo 'If there were a problem, execute "for file in $$(find . -name \*.v.old -print); do mv $${file} $${file%.old}; done" in your shell/'
+
+.PHONY: all opt byte archclean clean install userinstall depend html validate
+
+###################
+#                 #
+# Custom targets. #
+#                 #
+###################
+
+$(CMXS): $(CMXA)
+	$(CAMLOPTLINK) $(ZFLAGS) -o $@ -linkall -shared $^
+
+$(CMXA): trace/smtMisc.cmx trace/coqTerms.cmx trace/smtForm.cmx trace/smtCertif.cmx trace/smtTrace.cmx trace/smtCnf.cmx trace/satAtom.cmx trace/smtAtom.cmx zchaff/satParser.cmx zchaff/zchaffParser.cmx zchaff/cnfParser.cmx zchaff/zchaff.cmx verit/smtlib2_util.cmx verit/smtlib2_ast.cmx verit/smtlib2_parse.cmx verit/smtlib2_lex.cmx lia/lia.cmx verit/veritSyntax.cmx verit/veritParser.cmx verit/veritLexer.cmx verit/smtlib2_genConstr.cmx verit/verit.cmx trace/smt_tactic.cmx
+	$(CAMLOPTLINK) $(ZFLAGS) -a -o $@ $^
+
+ml: verit/veritParser.ml verit/veritLexer.ml verit/smtlib2_parse.ml verit/smtlib2_lex.ml
+
+
+%.ml %.mli: %.mly
+	$(CAMLYACC) $<
+
+%.ml: %.mll
+	$(CAMLLEX) $<
+
+test: 
+	cd ../unit-tests; make
+
+####################
+#                  #
+# Special targets. #
+#                  #
+####################
+
+byte:
+	$(MAKE) all "OPT:=-byte"
+
+opt:
+	$(MAKE) all "OPT:=-opt"
+
+userinstall:
+	+$(MAKE) USERINSTALL=true install
+
+install-natdynlink:
+	for i in $(CMXS); do \
+	 install -d `dirname $(DSTROOT)$(COQLIBINSTALL)/SMTCoq/$$i`; \
+	 install -m 0644 $$i $(DSTROOT)$(COQLIBINSTALL)/SMTCoq/$$i; \
+	done
+	for i in $(CMXA); do \
+	 install -d `dirname $(DSTROOT)$(COQLIBINSTALL)/SMTCoq/$$i`; \
+	 install -m 0644 $$i $(DSTROOT)$(COQLIBINSTALL)/SMTCoq/$$i; \
+	done
+	for i in $(VCMXS); do \
+	 install -d `dirname $(DSTROOT)$(COQLIBINSTALL)/SMTCoq/$$i`; \
+	 install -m 0644 $$i $(DSTROOT)$(COQLIBINSTALL)/SMTCoq/$$i; \
+	done
+
+install:$(if ifeq '$(HASNATDYNLINK)' 'true',install-natdynlink)
+	for i in $(VOFILES) $(OBJFILES) $(OBJFILES:.o=.cm*); do \
+	 install -d `dirname $(DSTROOT)$(COQLIBINSTALL)/SMTCoq/$$i`; \
+	 install -m 0644 $$i $(DSTROOT)$(COQLIBINSTALL)/SMTCoq/$$i; \
+	done
+	for i in $(CMXFILES); do \
+	 install -d `dirname $(DSTROOT)$(COQLIBINSTALL)/SMTCoq/$$i`; \
+	 install -m 0644 $$i $(DSTROOT)$(COQLIBINSTALL)/SMTCoq/$$i; \
+	done
+	for i in $(CMIFILES); do \
+	 install -d `dirname $(DSTROOT)$(COQLIBINSTALL)/SMTCoq/$$i`; \
+	 install -m 0644 $$i $(DSTROOT)$(COQLIBINSTALL)/SMTCoq/$$i; \
+	done
+
+install-doc:
+	install -d $(DSTROOT)$(COQDOCINSTALL)/SMTCoq/html
+	for i in html/*; do \
+	 install -m 0644 $$i $(DSTROOT)$(COQDOCINSTALL)/SMTCoq/$$i;\
+	done
+	install -d $(DSTROOT)$(COQDOCINSTALL)/SMTCoq/mlihtml
+	for i in mlihtml/*; do \
+	 install -m 0644 $$i $(DSTROOT)$(COQDOCINSTALL)/SMTCoq/$$i;\
+	done
+
+clean:
+	rm -f $(ALLCMOFILES) $(CMIFILES) $(CMAFILES)
+	rm -f $(ALLCMOFILES:.cmo=.cmx) $(CMXAFILES) $(CMXSFILES) $(ALLCMOFILES:.cmo=.o) $(CMXAFILES:.cmxa=.a)
+	rm -f $(addsuffix .d,$(MLFILES) $(MLIFILES) $(ML4FILES) $(MLLIBFILES) $(MLPACKFILES))
+	rm -f $(OBJFILES) $(OBJFILES:.o=.native)
+	rm -f $(OBJFILES:.o=.cmi) $(OBJFILES:.o=.cmo)
+	rm -f $(OBJFILES:.o=.cmx) $(OBJFILES:.o=.cmxs)
+	rm -f $(VOFILES) $(VIFILES) $(GFILES) $(VFILES:.v=.v.d) $(VFILES:=.beautified) $(VFILES:=.old)
+	rm -f all.ps all-gal.ps all.pdf all-gal.pdf all.glob $(VFILES:.v=.glob) $(VFILES:.v=.tex) $(VFILES:.v=.g.tex) all-mli.tex
+	- rm -rf html mlihtml
+	- rm -rf $(CMXS)
+	- rm -rf $(CMXA)
+	- rm -rf ml
+	- rm -rf test
+	- rm -f NSMTCoq* cnf/NSMTCoq* euf/NSMTCoq* lia/NSMTCoq* spl/NSMTCoq* ../unit-tests/NSMTCoq* ../unit-tests/*.zlog ../unit-tests/*.vtlog verit/veritParser.mli verit/veritParser.ml verit/veritLexer.ml verit/smtlib2_parse.mli verit/smtlib2_parse.ml verit/smtlib2_lex.ml
+
+archclean:
+	rm -f *.cmx *.o
+
+printenv:
+	@$(COQBIN)coqtop -config
+	@echo CAMLC =	$(CAMLC)
+	@echo CAMLOPTC =	$(CAMLOPTC)
+	@echo PP =	$(PP)
+	@echo COQFLAGS =	$(COQFLAGS)
+	@echo COQLIBINSTALL =	$(COQLIBINSTALL)
+	@echo COQDOCINSTALL =	$(COQDOCINSTALL)
+
+
+###################
+#                 #
+# Implicit rules. #
+#                 #
+###################
+
+%.cmi: %.mli
+	$(CAMLC) $(ZDEBUG) $(ZFLAGS) $<
+
+%.mli.d: %.mli
+	$(OCAMLDEP) -slash $(OCAMLLIBS) "$<" > "$@" || ( RV=$$?; rm -f "$@"; exit $${RV} )
+
+%.cmo: %.ml4
+	$(CAMLC) $(ZDEBUG) $(ZFLAGS) $(PP) -impl $<
+
+%.cmx: %.ml4
+	$(CAMLOPTC) $(ZDEBUG) $(ZFLAGS) $(PP) -impl $<
+
+%.ml4.d: %.ml4
+	$(OCAMLDEP) -slash $(OCAMLLIBS) $(PP) -impl "$<" > "$@" || ( RV=$$?; rm -f "$@"; exit $${RV} )
+
+%.cmo: %.ml
+	$(CAMLC) $(ZDEBUG) $(ZFLAGS) $<
+
+%.cmx: %.ml
+	$(CAMLOPTC) $(ZDEBUG) $(ZFLAGS) $<
+
+%.ml.d: %.ml
+	$(OCAMLDEP) -slash $(OCAMLLIBS) "$<" > "$@" || ( RV=$$?; rm -f "$@"; exit $${RV} )
+
+%.cmxs: %.cmx
+	$(CAMLOPTLINK) $(ZDEBUG) $(ZFLAGS) -shared -o $@ $<
+
+%.vo %.glob: %.v
+	$(COQC) $(COQDEBUG) $(COQFLAGS) $*
+
+%.vi: %.v
+	$(COQC) -i $(COQDEBUG) $(COQFLAGS) $*
+
+%.g: %.v
+	$(GALLINA) $<
+
+%.tex: %.v
+	$(COQDOC) $(COQDOCFLAGS) -latex $< -o $@
+
+%.html: %.v %.glob
+	$(COQDOC) $(COQDOCFLAGS) -html $< -o $@
+
+%.g.tex: %.v
+	$(COQDOC) $(COQDOCFLAGS) -latex -g $< -o $@
+
+%.g.html: %.v %.glob
+	$(COQDOC)$(COQDOCFLAGS)  -html -g $< -o $@
+
+%.v.d: %.v
+	$(COQDEP) -slash $(COQLIBS) "$<" > "$@" || ( RV=$$?; rm -f "$@"; exit $${RV} )
+
+%.v.beautified:
+	$(COQC) $(COQDEBUG) $(COQFLAGS) -beautify $*
+
+# WARNING
+#
+# This Makefile has been automagically generated
+# Edit at your own risks !
+#
+# END OF WARNING
+
diff --git a/src/Misc.v b/src/Misc.v
new file mode 100644
index 0000000..c3e5de7
--- /dev/null
+++ b/src/Misc.v
@@ -0,0 +1,1004 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Require Import Bool List PArray Int63.
+Local Open Scope int63_scope.
+Local Open Scope array_scope.
+
+
+(** Lemmas about Bool *)
+
+Lemma implb_true_r : forall a, implb a true = true.
+Proof. intros [ | ]; reflexivity. Qed.
+
+
+(** Lemmas about Int63 *)
+
+Lemma le_eq : forall i j,
+  (j <= i) = true -> (j + 1 <= i) = false -> i = j.
+Proof.
+  intros i j; rewrite leb_spec; destruct (dec_Zle [|j+1|] [|i|]) as [H|H].
+  rewrite <- leb_spec in H; rewrite H; discriminate.
+  intros H1 _; apply to_Z_inj; rewrite add_spec, to_Z_1 in H.
+  assert (H2: (([|j|] + 1)%Z < wB)%Z \/ ([|j|] + 1)%Z = wB).
+  pose (H3 := to_Z_bounded j); omega.
+  destruct H2 as [H2|H2].
+  rewrite Zmod_small in H.
+  omega.
+  split.
+  pose (H3 := to_Z_bounded j); omega.
+  assumption.
+  rewrite H2, Z_mod_same_full in H; elim H; destruct (to_Z_bounded i) as [H3 _]; assumption.
+Qed.
+
+
+Lemma lt_eq : forall i j,
+  (i < j + 1) = true -> (i < j) = false -> i = j.
+Proof.
+  intros i j. rewrite ltb_spec. destruct (dec_Zlt [|i|] [|j|]) as [H|H].
+  rewrite <- ltb_spec in H; rewrite H; discriminate.
+  intros H1 _; apply to_Z_inj. rewrite add_spec in H1. rewrite to_Z_1 in H1.
+  assert (H2: (([|j|] + 1)%Z < wB)%Z \/ ([|j|] + 1)%Z = wB).
+  pose (H3 := to_Z_bounded j); omega.
+  destruct H2 as [H2|H2].
+  rewrite Zmod_small in H1.
+  omega.
+  split.
+  pose (H3 := to_Z_bounded j); omega.
+  assumption.
+  rewrite H2, Z_mod_same_full in H1; elimtype False. destruct (to_Z_bounded i) as [H3 _]. omega.
+Qed.
+
+
+Lemma foldi_down_ZInd2 :
+   forall A (P: Z -> A -> Prop) (f:int -> A -> A) max min a,
+   (max < min = true -> P ([|min|])%Z a) ->
+   (P ([|max|]+1)%Z a) ->
+   (forall i a, min <= i = true -> i <= max = true -> P ([|i|]+1)%Z a -> P [|i|] (f i a)) ->
+   P [|min|] (foldi_down f max min a).
+Proof.
+ unfold foldi_down;intros A P f max min a Hlt;intros.
+ set (P' z cont :=
+       if Zlt_bool z ([|min|]+1)%Z then cont = (fun a0 : A => a0)
+       else forall a, P z a -> P [|min|] (cont a)).
+ assert (H1: P' ([|max|]+1)%Z (foldi_down_cont (fun (i : int) (cont : A -> A) (a0 : A) => cont (f i a0)) max
+                       min (fun a0 : A => a0))).
+ apply foldi_down_cont_ZInd;intros;red.
+ assert (H20: (z+1 < [|min|]+1)%Z).
+ omega.
+ rewrite Zlt_is_lt_bool in H20; rewrite H20;trivial.
+ case_eq (Zlt_bool ([|i|]+1) ([|min|]+1));intros.
+  rewrite <- Zlt_is_lt_bool in H4;rewrite leb_spec in H1;elimtype False;omega.
+ clear H4;revert H3;unfold P'.
+ case_eq (Zlt_bool ([|i|] - 1 + 1) ([|min|]+1));intros;auto.
+  rewrite <- Zlt_is_lt_bool in H3; assert ([|i|] = [|min|]) by (rewrite leb_spec in H1;omega).
+  rewrite H4, <- H6. apply H0;trivial.
+  apply H4. replace ([|i|] - 1 + 1)%Z with [|i|] by omega. auto.
+ revert H1;unfold P'.
+ case_eq (Zlt_bool ([|max|]+1)%Z ([|min|]+1)%Z);auto.
+ rewrite <- Zlt_is_lt_bool.
+ intro H22; assert (H21: ([|max|] < [|min|])%Z). omega.
+ rewrite <- ltb_spec in H21. intros;rewrite foldi_down_cont_lt;auto.
+Qed.
+
+
+Lemma foldi_down_Ind2 : forall A (P : int -> A -> Prop) f max min a,
+  (max < max_int = true) ->
+  (max < min = true -> P min a) ->
+  P (max+1) a ->
+  (forall i a, min <= i = true -> i <= max = true ->
+    P (i+1) a -> P i (f i a)) ->
+  P min (foldi_down f max min a).
+Proof.
+  intros A P f max min a H H0 H1 H2.
+  set (P' z a := (0 <= z < wB)%Z -> P (of_Z z) a).
+  assert (W:= to_Z_add_1 _ _ H).
+  assert (P' ([|min|])%Z (foldi_down f max min a)).
+  apply foldi_down_ZInd2;unfold P';intros.
+  rewrite of_to_Z;auto.
+  rewrite <- W, of_to_Z;auto.
+  rewrite of_to_Z. apply H2; trivial.
+  assert (i < max_int = true).
+  apply leb_ltb_trans with max; trivial.
+  rewrite <- (to_Z_add_1 _ _ H7) in H5. rewrite of_to_Z in H5. apply H5. apply to_Z_bounded.
+  unfold P' in H3; rewrite of_to_Z in H3;apply H3;apply to_Z_bounded.
+Qed.
+
+
+(** Lemmas about PArray.to_list *)
+
+Lemma to_list_In : forall {A} (t: array A) i,
+  i < length t = true -> In (t.[i]) (to_list t).
+Proof.
+  intros A t i H; unfold to_list; case_eq (0 == length t); intro Heq.
+  unfold is_true in H; rewrite ltb_spec in H; rewrite eqb_spec in Heq; rewrite <- Heq in H; rewrite to_Z_0 in H; pose (H1 := to_Z_bounded i); elimtype False; omega.
+  pose (P := fun j a => i < j = true \/ In (t .[ i]) a).
+  pose (H1:= foldi_down_Ind2 _ P); unfold P in H1.
+  assert (H2: i < 0 = true \/ In (t .[ i]) (foldi_down (fun (i0 : int) (l : list A) => t .[ i0] :: l) (length t - 1) 0 nil)).
+  apply H1.
+  rewrite ltb_spec; erewrite to_Z_sub_1; try eassumption.
+  pose (H2 := to_Z_bounded (length t)); change [|max_int|] with (wB-1)%Z; omega.
+  intro H2; elimtype False; rewrite ltb_spec, to_Z_0 in H2; pose (H3 := to_Z_bounded (length t - 1)); omega.
+  left; unfold is_true; rewrite ltb_spec; rewrite (to_Z_add_1 _ max_int).
+  erewrite to_Z_sub_1; try eassumption.
+  unfold is_true in H; rewrite ltb_spec in H; omega.
+  rewrite ltb_spec; erewrite to_Z_sub_1; try eassumption.
+  pose (H2 := to_Z_bounded (length t)); change [|max_int|] with (wB-1)%Z; omega.
+  intros j a H2 H3 [H4|H4].
+  case_eq (i < j); intro Heq2.
+  left; reflexivity.
+  right; rewrite (lt_eq _ _ H4 Heq2); constructor; reflexivity.
+  right; constructor 2; assumption.
+  destruct H2 as [H2|H2]; try assumption.
+  unfold is_true in H2; rewrite ltb_spec, to_Z_0 in H2; pose (H3 := to_Z_bounded i); elimtype False; omega.
+Qed.
+
+Lemma In_to_list : forall {A} (t: array A) x,
+  In x (to_list t) -> exists i, i < length t = true /\ x = t.[i].
+Proof.
+  intros A t x; unfold to_list; case_eq (0 == length t); intro Heq.
+  intro H; inversion H.
+  rewrite eqb_false_spec in Heq.
+  pose (P (_:int) l := In x l ->
+   exists i : int, (i < length t) = true /\ x = t .[ i]).
+  pose (H1 := foldi_down_Ind2 _ P (fun (i : int) (l : list A) => t .[ i] :: l) (length t - 1) 0); unfold P in H1; apply H1.
+  rewrite ltb_spec, to_Z_sub_1_diff; auto; change [|max_int|] with (wB-1)%Z; pose (H2 := to_Z_bounded (length t)); omega.
+  intros _ H; inversion H.
+  intro H; inversion H.
+  simpl; intros i a _ H2 IH [H3|H3].
+  exists i; split; auto; rewrite ltb_spec; rewrite leb_spec, to_Z_sub_1_diff in H2; auto; omega.
+  destruct (IH H3) as [j [H4 H5]]; exists j; auto.
+Qed.
+
+
+(** Lemmas about PArray.mapi *)
+
+Lemma length_mapi : forall {A B} (f:int -> A -> B) t,
+  length (mapi f t) = length t.
+Proof.
+  unfold mapi; intros A B f t; case_eq (length t == 0).
+  rewrite Int63Properties.eqb_spec; intro Heq; rewrite Heq, length_make; auto.
+  rewrite eqb_false_spec; intro Heq; apply foldi_ind.
+  rewrite length_make, ltb_length; auto.
+  intros i a _ H1 H2; rewrite length_set; auto.
+Qed.
+
+
+Lemma default_mapi : forall {A B} (f:int -> A -> B) t,
+  default (mapi f t) = f (length t) (default t).
+Proof.
+  unfold mapi; intros A B f t; case (length t == 0).
+  rewrite default_make; auto.
+  apply foldi_ind.
+  rewrite default_make; auto.
+  intros; rewrite default_set; auto.
+Qed.
+
+Lemma get_mapi : forall {A B} (f:int -> A -> B) t i,
+  i < length t = true -> (mapi f t).[i] = f i (t.[i]).
+Proof.
+  intros A B f t i Hi; generalize (length_mapi f t); unfold mapi; case_eq (length t == 0).
+  rewrite Int63Properties.eqb_spec; intro Heq; rewrite Heq in Hi; eelim ltb_0; eassumption.
+  rewrite eqb_false_spec; intro Heq; pose (Hi':=Hi); replace (length t) with ((length t - 1) + 1) in Hi'.
+  generalize Hi'; apply (foldi_Ind _ (fun j a => (i < j) = true -> length a = length t -> a.[i] = f i (t.[i]))).
+  rewrite ltb_spec, (to_Z_sub_1 _ i); auto; destruct (to_Z_bounded (length t)) as [_ H]; change [|max_int|] with (wB-1)%Z; omega.
+  intros H _; eelim ltb_0; eassumption.
+  intros H; eelim ltb_0; eassumption.
+  intros j a _ H1 IH H2 H3; rewrite length_set in H3; case_eq (j == i).
+  rewrite Int63Properties.eqb_spec; intro Heq2; subst i; rewrite get_set_same; auto; rewrite H3; auto.
+  rewrite eqb_false_spec; intro Heq2; rewrite get_set_other; auto; apply IH; auto; rewrite ltb_spec; rewrite ltb_spec, (to_Z_add_1 _ (length t)) in H2.
+  assert (H4: [|i|] <> [|j|]) by (intro H4; apply Heq2, to_Z_inj; auto); omega.
+  rewrite ltb_spec; rewrite leb_spec, (to_Z_sub_1 _ _ Hi) in H1; omega.
+  apply to_Z_inj; rewrite (to_Z_add_1 _ max_int).
+  rewrite to_Z_sub_1_diff; auto; omega.
+  rewrite ltb_spec, to_Z_sub_1_diff; auto; destruct (to_Z_bounded (length t)) as [_ H]; change [|max_int|] with (wB-1)%Z; omega.
+Qed.
+
+
+Lemma get_mapi_outofbound : forall {A B} (f:int -> A -> B) t i,
+  i < length t = false -> (mapi f t).[i] = f (length t) (default t).
+Proof.
+  intros A B f t i H1; rewrite get_outofbound.
+  apply default_mapi.
+  rewrite length_mapi; auto.
+Qed.
+
+
+(** Custom fold_left and fold_right *)
+
+Definition afold_left A B default (OP : A -> A -> A) (F : B -> A) (V : array B) :=
+  let n := PArray.length V in
+  if n == 0 then default
+  else foldi (fun i a => OP a (F (V.[i]))) 1 (n-1) (F (V.[0])).
+
+
+Definition afold_right A B default (OP : A -> A -> A) (F : B -> A) (V : array B) :=
+  let n := PArray.length V in
+  if n == 0 then default else
+    if n <= 1 then F (V.[0])
+    else foldi_down (fun i b => OP (F (V.[i])) b) (n-2) 0 (F (V.[n-1])).
+
+
+(** Some properties about afold_left *)
+
+Lemma afold_left_eq :
+  forall A B OP def (F1 F2 : A -> B) V1 V2,
+    length V1 = length V2 ->
+    (forall i, i < length V1 = true -> F1 (V1.[i]) = F2 (V2.[i])) ->
+    afold_left _ _ def OP F1 V1 = afold_left _ _ def OP F2 V2.
+Proof.
+  unfold afold_left;intros. rewrite <- H.
+  destruct (Int63Properties.reflect_eqb (length V1) 0);trivial.
+  rewrite (H0 0); [ |  unfold is_true;rewrite <- not_0_ltb;trivial].
+  apply foldi_eq_compat;intros;rewrite H0;trivial.
+  unfold is_true;rewrite ltb_leb_sub1;trivial.
+Qed.
+
+
+Definition afoldi_left {A B:Type} default (OP : int -> A -> A -> A) (F : B -> A) (V : array B) :=
+  let n := PArray.length V in
+    if n == 0 then default
+      else foldi (fun i a => OP i a (F (V.[i]))) 1 (n-1) (F (V.[0])).
+
+
+Lemma afoldi_left_Ind :
+  forall {A B: Type} (P : int -> A -> Prop) default (OP : int -> A -> A -> A) (F : B -> A) (t:array B),
+    if length t == 0 then
+      True
+    else
+      (forall a i, i < length t = true -> P i a -> P (i+1) (OP i a (F (t.[i])))) ->
+      P 1 (F (t.[0])) ->
+      P (length t) (afoldi_left default OP F t).
+Proof.
+  intros A B P default OP F t; case_eq (length t == 0).
+  intros; exact I.
+  intros Heq H1 H2; unfold afoldi_left; rewrite Heq;
+    assert (H: (length t - 1) + 1 = length t) by ring.
+  rewrite <- H at 1; apply foldi_Ind; auto.
+  assert (W:= leb_max_int (length t)); rewrite leb_spec in W.
+  rewrite ltb_spec, to_Z_sub_1_diff; auto with zarith.
+  intro H3; rewrite H3 in Heq; discriminate.
+  intro Hlt; assert (H3: length t - 1 = 0).
+  rewrite ltb_spec, to_Z_1 in Hlt; apply to_Z_inj; rewrite to_Z_0; pose (H3 := to_Z_bounded (length t - 1)); omega.
+  rewrite H3; assumption.
+  intros i a H3 H4; apply H1; trivial.
+  rewrite ltb_leb_sub1; auto.
+  intro H5; rewrite H5 in Heq; discriminate.
+Qed.
+
+
+Lemma afold_left_Ind :
+  forall A B (P : int -> A -> Prop) default (OP : A -> A -> A) (F : B -> A) (t:array B),
+    if length t == 0 then
+      True
+    else
+      (forall a i, i < length t = true -> P i a -> P (i+1) (OP a (F (t.[i])))) ->
+      P 1 (F (t.[0])) ->
+      P (length t) (afold_left A B default OP F t).
+Proof.
+  intros A B P default OP F t;
+    apply (afoldi_left_Ind P default (fun _ => OP)); trivial.
+Qed.
+
+
+Lemma afold_left_ind :
+  forall A B (P : A -> Prop) default (OP : A -> A -> A) (F : B -> A) (t:array B),
+    (forall a i, i < length t = true -> P a -> P (OP a (F (t.[i])))) ->
+    P default -> P (F (t.[0])) ->
+    P (afold_left _ _ default OP F t).
+Proof.
+  intros A B P default OP F t H1 H2 H4.
+  pose (H3 := afold_left_Ind A B (fun _ => P) default OP F t).
+  case_eq (length t == 0); intro Heq.
+  unfold afold_left; rewrite Heq; assumption.
+  rewrite Heq in H3; apply H3; trivial.
+Qed.
+
+
+Lemma afold_left_spec : forall A B (f:B -> A) args op e,
+  (forall a, op e a = a) ->
+  afold_left _ _ e op f args =
+  fold_left (fun a v  => op a (f v)) e args.
+  Proof.
+    unfold afold_left, fold_left;intros A B f args op neu H10.
+    destruct (reflect_eqb (length args) 0) as [e|n].
+    rewrite e, eqb_refl;trivial.
+    apply not_eq_sym in n;rewrite (eqb_false_complete _ _ n).
+    case_eq (0 < (length args - 1));intros H.
+    rewrite foldi_lt with (from := 0);trivial.
+    rewrite H10; auto.
+    assert (H0: (0 <> [|length args|])%Z).
+    intros Heq;apply n;apply to_Z_inj;trivial.
+    assert (H1: length args = 1).
+    generalize (to_Z_bounded (length args)).
+    rewrite <- not_true_iff_false, ltb_spec, to_Z_0, to_Z_sub_1_diff in H;auto.
+    intros;apply to_Z_inj;rewrite to_Z_1;omega.
+    rewrite H1; change (1 - 1) with 0; rewrite (foldi_eq _ _ 0 0); auto.
+  Qed.
+
+
+(** Some properties about afold_right *)
+
+Lemma afold_right_eq :
+  forall A B OP def (F1 F2 : A -> B) V1 V2,
+    length V1 = length V2 ->
+    (forall i, i < length V1 = true -> F1 (V1.[i]) = F2 (V2.[i])) ->
+    afold_right _ _ def OP F1 V1 = afold_right _ _ def OP F2 V2.
+Proof.
+  unfold afold_right;intros.
+  rewrite <- H.
+  destruct (Int63Properties.reflect_eqb (length V1) 0);trivial.
+  destruct (reflect_leb (length V1) 1);intros.
+  apply H0;unfold is_true;rewrite ltb_leb_sub1;trivial. apply leb_0.
+  assert (length V1 - 1 < length V1 = true).
+  rewrite ltb_leb_sub1;auto using leb_refl.
+  rewrite (H0 (length V1 - 1));trivial.
+  apply foldi_down_eq_compat;intros;rewrite H0;trivial.
+  unfold is_true;rewrite ltb_leb_sub1;[ | trivial].
+  apply ltb_leb_sub1;trivial.
+  revert n0 H3;rewrite ltb_spec, leb_spec, to_Z_1, sub_spec.
+  change [|2|] with 2%Z.
+  intros HH;assert (W:= to_Z_bounded (length V1));rewrite Zmod_small;omega.
+Qed.
+
+
+Definition afoldi_right {A B:Type} default (OP : int -> A -> A -> A) (F : B -> A) (V : array B) :=
+  let n := PArray.length V in
+    if n == 0 then default
+      else if n <= 1 then F (V .[ 0])
+        else foldi_down (fun i a => OP i (F (V.[i])) a) (n-2) 0 (F (V.[n-1])).
+
+
+Lemma afoldi_right_Ind :
+  forall {A B: Type} (P : int -> A -> Prop) default (OP : int -> A -> A -> A) (F : B -> A) (t:array B),
+    if length t <= 1 then
+      True
+    else
+      (forall a i, i < length t - 1 = true -> P (i+1) a -> P i (OP i (F (t.[i])) a)) ->
+      P ((length t)-1) (F (t.[(length t)-1])) ->
+      P 0 (afoldi_right default OP F t).
+Proof.
+  intros A B P default OP F t; case_eq (length t <= 1).
+  intros; exact I.
+  intros Heq H1 H2; unfold afoldi_right. replace (length t == 0) with false.
+  rewrite Heq.
+  set (P' z a := P (of_Z (z + 1)) a).
+  change (P' ([|0|] - 1)%Z (foldi_down (fun (i : int) (a : A) => OP i (F (t .[ i])) a) (length t - 2) 0 (F (t .[ length t - 1])))).
+  apply foldi_down_ZInd;unfold P'.
+  intros Hlt;elim (ltb_0 _ Hlt).
+  replace (length t - 2) with (length t - 1 - 1) by ring.
+  rewrite to_Z_sub_1_diff.
+  ring_simplify ([|length t - 1|] - 1 + 1)%Z;rewrite of_to_Z;trivial.
+  assert (H10: (1 < length t) = true) by (rewrite ltb_negb_geb, Heq; auto).
+  intro H11. rewrite ltb_spec in H10. assert (H12: [|length t - 1|] = 0%Z) by (rewrite H11; auto). change [|1|] with (1%Z) in H10. rewrite to_Z_sub_1_diff in H12; [omega| ]. intro H13. assert (H14: [|length t|] = 0%Z) by (rewrite H13; auto). omega.
+  intros;ring_simplify ([|i|] - 1 + 1)%Z;rewrite of_to_Z;auto.
+  assert (i < length t - 1 = true).
+    rewrite ltb_spec. rewrite leb_spec in H0. replace (length t - 2) with (length t - 1 - 1) in H0 by ring. rewrite to_Z_sub_1_diff in H0; [omega| ]. intro H4. assert (H5: [|length t - 1|] = 0%Z) by (rewrite H4; auto). assert (H6: 1 < length t = true) by (rewrite ltb_negb_geb, Heq; auto). rewrite ltb_spec in H6. change ([|1|]) with (1%Z) in H6. rewrite to_Z_sub_1_diff in H5; [omega| ]. intro H7. assert (H8: [|length t|] = 0%Z) by (rewrite H7; auto). omega.
+  apply H1;trivial.
+  rewrite <-(to_Z_add_1 _ _ H4), of_to_Z in H3;auto.
+  symmetry. rewrite eqb_false_spec. intro H. rewrite H in Heq. discriminate.
+Qed.
+
+
+Lemma afold_right_Ind :
+  forall A B (P : int -> A -> Prop) default (OP : A -> A -> A) (F : B -> A) (t:array B),
+    if length t <= 1 then
+      True
+    else
+      (forall a i, i < length t - 1 = true -> P (i+1) a -> P i (OP (F (t.[i])) a)) ->
+      P ((length t)-1) (F (t.[(length t)-1])) ->
+      P 0 (afold_right A B default OP F t).
+Proof.
+  intros A B P default OP F t;
+    apply (afoldi_right_Ind P default (fun _ => OP)); trivial.
+Qed.
+
+
+Lemma afold_right_ind :
+  forall A B (P : A -> Prop) default (OP : A -> A -> A) (F : B -> A) (t:array B),
+    (forall a i, i < length t - 1 = true -> P a -> P (OP (F (t.[i])) a)) ->
+    P default -> P (F (t.[length t - 1])) ->
+    P (afold_right _ _ default OP F t).
+Proof.
+  intros A B P default OP F t H1 H2 H4.
+  pose (H3 := afold_right_Ind A B (fun _ => P) default OP F t).
+  unfold afold_right. case_eq (length t == 0); auto. intro H10. assert (H := H10). rewrite eqb_false_spec in H. case_eq (length t <= 1); intro Heq.
+  replace 0 with (length t - 1); auto. apply to_Z_inj. rewrite to_Z_sub_1_diff; auto. rewrite leb_spec in Heq. assert (H5 := leb_0 (length t)). rewrite leb_spec in H5. change [|0|] with 0%Z in *. change [|1|] with 1%Z in Heq. assert (H6 : [|length t|] <> 0%Z) by (intro H6; elim H; apply to_Z_inj; auto). omega. rewrite Heq in H3. unfold afold_right in H3. rewrite H10, Heq in H3. apply H3; auto.
+Qed.
+
+
+Lemma afold_right_ind_nonempty :
+  forall A B (P : A -> Prop) default (OP : A -> A -> A) (F : B -> A) (t:array B),
+    (forall a i, i < length t - 1 = true -> P a -> P (OP (F (t.[i])) a)) ->
+    0 < length t = true -> P (F (t.[length t - 1])) ->
+    P (afold_right _ _ default OP F t).
+Proof.
+  intros A B P default OP F t H1 H2 H4.
+  pose (H3 := afold_right_Ind A B (fun _ => P) default OP F t).
+  unfold afold_right. assert (H10 : length t == 0 = false) by (rewrite eqb_false_spec; intro H; rewrite H in H2; discriminate). rewrite H10. assert (H := H10). rewrite eqb_false_spec in H. case_eq (length t <= 1); intro Heq.
+  replace 0 with (length t - 1); auto. apply to_Z_inj. rewrite to_Z_sub_1_diff; auto. rewrite leb_spec in Heq. assert (H5 := leb_0 (length t)). rewrite leb_spec in H5. change [|0|] with 0%Z in *. change [|1|] with 1%Z in Heq. assert (H6 : [|length t|] <> 0%Z) by (intro H6; elim H; apply to_Z_inj; auto). omega. rewrite Heq in H3. unfold afold_right in H3. rewrite H10, Heq in H3. apply H3; auto.
+Qed.
+
+
+Lemma afold_right_spec : forall A B (f:B -> A) args op e,
+  (forall a, op a e = a) ->
+  afold_right _ _ e op f args =
+  fold_right (fun v a => op (f v) a) args e.
+  Proof.
+    unfold afold_right, fold_right;intros A B f args op neu H10.
+    destruct (reflect_eqb (length args) 0) as [e|n].
+    rewrite e, eqb_refl;trivial.
+    apply not_eq_sym in n;rewrite (eqb_false_complete _ _ n).
+    case_eq (length args <= 1); intro Heq.
+    assert (H11: length args = 1).
+    apply to_Z_inj. rewrite leb_spec in Heq. assert (H11: 0%Z <> [|length args|]) by (intro H; elim n; apply to_Z_inj; auto). change [|1|] with (1%Z) in *. assert (H12 := leb_0 (length args)). rewrite leb_spec in H12. change [|0|] with 0%Z in H12. omega.
+    rewrite H11, foldi_down_eq; auto.
+    assert (H11: 1 < length args = true) by (rewrite ltb_negb_geb, Heq; auto). replace (foldi_down (fun (i : int) (b : A) => op (f (args .[ i])) b) (length args - 1) 0 neu) with (foldi_down (fun (i : int) (b : A) => op (f (args .[ i])) b) (length args - 1 - 1) 0 (op (f (args .[ length args - 1])) neu)).
+    replace (length args - 1 - 1) with (length args - 2) by ring. rewrite H10. auto.
+    symmetry. apply foldi_down_gt. rewrite ltb_spec. change [|0|] with 0%Z. rewrite to_Z_sub_1_diff; auto. rewrite ltb_spec in H11. change [|1|] with 1%Z in H11. omega.
+  Qed.
+
+
+(** Application to our uses of afold_left and afold_right *)
+(* Case andb *)
+
+Lemma afold_left_andb_false : forall A i a f,
+  i < length a = true ->
+  f (a .[ i]) = false ->
+  afold_left bool A true andb f a = false.
+Proof.
+  intros A i a f; rewrite afold_left_spec; auto; apply (fold_left_Ind _ _ (fun j t => (i < j) = true -> f (a .[ i]) = false -> t = false)).
+  intros b j H1 H2 H3 H4; case_eq (i == j).
+  rewrite Int63Properties.eqb_spec; intro; subst i; rewrite H4, andb_false_r; auto.
+  rewrite eqb_false_spec; intro Heq; rewrite H2; auto; rewrite ltb_spec; rewrite ltb_spec in H3; rewrite (to_Z_add_1 _ (length a)) in H3; auto; assert (H5: [|i|] <> [|j|]) by (intro H5; apply Heq, to_Z_inj; auto); omega.
+  intro H; eelim ltb_0; eassumption.
+Qed.
+
+
+Lemma afold_left_andb_false_inv : forall A a f,
+  afold_left bool A true andb f a = false ->
+  exists i, (i < length a = true) /\ (f (a .[ i]) = false).
+Proof.
+  intros A a f; rewrite afold_left_spec; auto; apply fold_left_ind; try discriminate.
+  intros b i H1; case b; simpl.
+  intros _ H2; exists i; auto.
+  intros H2 _; destruct (H2 (refl_equal false)) as [j [H3 H4]]; exists j; auto.
+Qed.
+
+
+Lemma afold_left_andb_true : forall A a f,
+  (forall i, i < length a = true -> f (a.[i]) = true) ->
+  afold_left bool A true andb f a = true.
+Proof.
+  intros A a f H; rewrite afold_left_spec; auto; apply fold_left_ind; trivial; intros b j H1 H2; rewrite H2; simpl; rewrite H; trivial.
+Qed.
+
+
+Lemma afold_left_andb_true_inv : forall A a f,
+  afold_left bool A true andb f a = true ->
+  forall i, i < length a = true -> f (a.[i]) = true.
+Proof.
+  intros A a f; rewrite afold_left_spec; auto; apply (fold_left_Ind _ _ (fun j t => t = true -> forall i, (i < j) = true -> f (a .[ i]) = true)).
+  intros b i H1; case b; simpl; try discriminate; intros H2 H3 j Hj; case_eq (j == i); intro Heq.
+  rewrite Int63Properties.eqb_spec in Heq; subst j; auto.
+  apply H2; auto; rewrite eqb_false_spec in Heq; rewrite ltb_spec; rewrite ltb_spec in Hj; assert (H4: [|j|] <> [|i|]) by (intro H; apply Heq, to_Z_inj; auto); rewrite (to_Z_add_1 _ (length a)) in Hj; auto; omega.
+  intros _ i H; eelim ltb_0; eassumption.
+Qed.
+
+
+(* Case orb *)
+
+Lemma afold_left_orb_true : forall A i a f,
+  i < length a = true ->
+  f (a .[ i]) = true ->
+  afold_left bool A false orb f a = true.
+Proof.
+  intros A i a f; rewrite afold_left_spec; auto; apply (fold_left_Ind _ _ (fun j t => (i < j) = true -> f (a .[ i]) = true -> t = true)).
+  intros b j H1 H2 H3 H4; case_eq (i == j).
+  rewrite Int63Properties.eqb_spec; intro; subst i; rewrite H4, orb_true_r; auto.
+  rewrite eqb_false_spec; intro Heq; rewrite H2; auto; rewrite ltb_spec; rewrite ltb_spec in H3; rewrite (to_Z_add_1 _ (length a)) in H3; auto; assert (H5: [|i|] <> [|j|]) by (intro H5; apply Heq, to_Z_inj; auto); omega.
+  intro H; eelim ltb_0; eassumption.
+Qed.
+
+
+Lemma afold_left_orb_true_inv : forall A a f,
+  afold_left bool A false orb f a = true ->
+  exists i, (i < length a = true) /\ (f (a .[ i]) = true).
+Proof.
+  intros A a f; rewrite afold_left_spec; auto; apply fold_left_ind; try discriminate.
+  intros b i H1; case b; simpl.
+  intros H2 _; destruct (H2 (refl_equal true)) as [j [H3 H4]]; exists j; auto.
+  intros _ H2; exists i; auto.
+Qed.
+
+
+Lemma afold_left_orb_false : forall A a f,
+  (forall i, i < length a = true -> f (a.[i]) = false) ->
+  afold_left bool A false orb f a = false.
+Proof.
+  intros A a f H; rewrite afold_left_spec; auto; apply fold_left_ind; trivial; intros b j H1 H2; rewrite H2; simpl; rewrite H; trivial.
+Qed.
+
+
+Lemma afold_left_orb_false_inv : forall A a f,
+  afold_left bool A false orb f a = false ->
+  forall i, i < length a = true -> f (a.[i]) = false.
+Proof.
+  intros A a f; rewrite afold_left_spec; auto; apply (fold_left_Ind _ _ (fun j t => t = false -> forall i, (i < j) = true -> f (a .[ i]) = false)).
+  intros b i H1; case b; simpl; try discriminate; intros H2 H3 j Hj; case_eq (j == i); intro Heq.
+  rewrite Int63Properties.eqb_spec in Heq; subst j; auto.
+  apply H2; auto; rewrite eqb_false_spec in Heq; rewrite ltb_spec; rewrite ltb_spec in Hj; assert (H4: [|j|] <> [|i|]) by (intro H; apply Heq, to_Z_inj; auto); rewrite (to_Z_add_1 _ (length a)) in Hj; auto; omega.
+  intros _ i H; eelim ltb_0; eassumption.
+Qed.
+
+
+(* Case implb *)
+
+Lemma afold_right_implb_false : forall A a f,
+  0 < length a = true /\
+  (forall i, i < length a - 1 = true -> f (a .[ i]) = true) /\
+  f (a.[length a - 1]) = false ->
+  afold_right bool A true implb f a = false.
+Proof.
+  intros A a f; intros [H1 [H2 H3]]; apply afold_right_ind_nonempty; auto; intros b i H4 H5; rewrite H5, H2; auto.
+Qed.
+
+
+Lemma afold_right_implb_false_inv : forall A a f,
+  afold_right bool A true implb f a = false ->
+  0 < length a = true /\
+  (forall i, i < length a - 1 = true -> f (a .[ i]) = true) /\
+  f (a.[length a - 1]) = false.
+Proof.
+  intros A a f; case_eq (length a == 0); intro Heq1.
+  unfold afold_right; rewrite Heq1; discriminate.
+  intro H; split.
+  rewrite eqb_false_spec in Heq1; rewrite <- not_0_ltb; auto.
+  generalize H; clear H; case_eq (length a <= 1); intro Heq2.
+  unfold afold_right; rewrite Heq1, Heq2; intro H; replace (length a - 1) with 0.
+  split; auto; intros i Hi; elim (ltb_0 i); auto.
+  rewrite eqb_false_spec in Heq1; apply to_Z_inj; rewrite to_Z_sub_1_diff; auto; rewrite leb_spec in Heq2; change [|1|] with 1%Z in Heq2; assert ([|length a|] <> 0%Z) by (intro H1; apply Heq1, to_Z_inj; auto); generalize (leb_0 (length a)); rewrite leb_spec; change [|0|] with 0%Z; omega.
+  pose (P j k := k = false -> (forall i : int, (j <= i) = true -> (i < length a - 1) = true -> f (a .[ i]) = true) /\ f (a .[ length a - 1]) = false); assert (H: P 0 (afold_right bool A true implb f a)).
+  generalize (afold_right_Ind _ _ P true implb f a); rewrite Heq2; intro IH; apply IH; clear IH; unfold P.
+  intros b i H1 H2 H3; case_eq b; intro Heq3.
+  rewrite Heq3 in H3; generalize H3; case (f (a .[ i])); discriminate.
+  destruct (H2 Heq3) as [H4 H5]; split; auto; intros j H6 H7; case_eq (i == j); intro Heq4.
+  rewrite eqb_spec in Heq4; subst j b; generalize H3; case (f (a .[ i])); auto; discriminate.
+  apply H4; auto; rewrite leb_spec in *; rewrite (to_Z_add_1 _ _ H1); rewrite eqb_false_spec in Heq4; assert ([|i|] <> [|j|]) by (intro H; apply Heq4, to_Z_inj; auto); omega.
+  intro H; split; auto; intros i H1 H2; elimtype False; rewrite leb_spec in H1; rewrite ltb_spec in H2; omega.
+  unfold P in H; intro H1; destruct (H H1) as [H2 H3]; split; auto; intro i; apply H2, leb_0.
+Qed.
+
+
+Lemma afold_right_implb_true_aux : forall A a f,
+  (exists i, i < length a - 1 = true /\ f (a.[i]) = false) ->
+  afold_right bool A true implb f a = true.
+Proof.
+  intros A a f; case_eq (length a == 0); intro Heq1.
+  intros _; unfold afold_right; rewrite Heq1; auto.
+  case_eq (length a <= 1); intro Heq2.
+  intros [i [Hi _]]; elim (ltb_0 i); replace 0 with (length a - 1); auto; rewrite eqb_false_spec in Heq1; apply to_Z_inj; rewrite to_Z_sub_1_diff; auto; assert (H1: [|length a|] <> 0%Z) by (intro H; apply Heq1, to_Z_inj; auto); rewrite leb_spec in Heq2; generalize (leb_0 (length a)); rewrite leb_spec; change [|0|] with 0%Z; change [|1|] with 1%Z in Heq2; omega.
+  pose (P j k := (exists i : int, (j <= i) = true /\ (i < length a - 1) = true /\ f (a .[ i]) = false) -> k = true); assert (H: P 0 (afold_right bool A true implb f a)).
+  generalize (afold_right_Ind _ _ P true implb f a); rewrite Heq2; intro IH; apply IH; clear IH; unfold P.
+  intros b i H1 H2 [j [H3 [H4 H5]]]; case_eq (i == j); intro Heq3.
+  rewrite eqb_spec in Heq3; subst i; rewrite H5; case b; auto.
+  rewrite H2.
+  case (f (a .[ i])); auto.
+  exists j; repeat split; auto; assert (H: i < j = true).
+  rewrite ltb_spec; rewrite leb_spec in H3; rewrite eqb_false_spec in Heq3; assert (H: [|i|] <> [|j|]) by (intro H; apply Heq3, to_Z_inj; auto); omega.
+  rewrite leb_spec, (to_Z_add_1 _ _ H); rewrite ltb_spec in H; omega.
+  intros [i [H1 [H2 _]]]; elimtype False; rewrite leb_spec in H1; rewrite ltb_spec in H2; omega.
+  unfold P in H; intros [i Hi]; apply H; exists i; split; auto; apply leb_0.
+Qed.
+
+
+Lemma afold_right_implb_true : forall A a f,
+  length a = 0 \/ (exists i, i < length a - 1 = true /\ f (a.[i]) = false) \/
+  (forall i, i < length a = true -> f (a.[i]) = true) ->
+  afold_right bool A true implb f a = true.
+Proof.
+  intros A a f; case_eq (length a == 0).
+  intros H _; unfold afold_right; rewrite H; auto.
+  intros Heq [H1|[H1|H1]].
+  rewrite H1 in Heq; discriminate.
+  apply afold_right_implb_true_aux; auto.
+  apply afold_right_ind_nonempty.
+  intros b i H2 H3; subst b; case (f (a .[ i])); auto.
+  apply not_0_ltb; intro H; rewrite H in Heq; discriminate.
+  apply H1; rewrite ltb_spec, to_Z_sub_1_diff; [omega| ]; intro H; rewrite H in Heq; discriminate.
+Qed.
+
+
+Lemma afold_right_implb_true_inv : forall A a f,
+  afold_right bool A true implb f a = true ->
+  length a = 0 \/ (exists i, i < length a - 1 = true /\ f (a.[i]) = false) \/
+  (forall i, i < length a = true -> f (a.[i]) = true).
+Proof.
+  intros A a f; case_eq (length a == 0); intro Heq1.
+  intros _; left; rewrite eqb_spec in Heq1; auto.
+  case_eq (length a <= 1); intro Heq2.
+  unfold afold_right; rewrite Heq1, Heq2; intro H; right; right; intros i Hi; replace i with 0; auto; apply to_Z_inj; rewrite ltb_spec in Hi; rewrite eqb_false_spec in Heq1; assert (H1: [|length a|] <> 0%Z) by (intro H1; apply Heq1, to_Z_inj; auto); rewrite leb_spec in Heq2; change [|1|] with 1%Z in Heq2; generalize (leb_0 (length a)) (leb_0 i); rewrite !leb_spec; change [|0|] with 0%Z;  omega.
+  pose (P j k := k = true -> (exists i : int, (j <= i) = true /\ (i < length a - 1) = true /\ f (a .[ i]) = false) \/ (forall i : int, (j <= i) = true -> (i < length a) = true -> f (a .[ i]) = true)); assert (H: P 0 (afold_right bool A true implb f a)).
+  generalize (afold_right_Ind _ _ P true implb f a); rewrite Heq2; intro IH; apply IH; clear IH; unfold P.
+  intros b i H1 H2 H3; case_eq b; intro Heq3.
+  destruct (H2 Heq3) as [[j [H4 [H5 H6]]]|H4].
+  left; exists j; repeat split; auto; rewrite leb_spec in *; rewrite (to_Z_add_1 _ _ H1) in H4; omega.
+  case_eq (f (a.[i])); intro Heq4.
+  right; intros j H5 H6; case_eq (i == j); intro Heq5.
+  rewrite eqb_spec in Heq5; subst j; auto.
+  apply H4; auto; rewrite leb_spec in *; rewrite (to_Z_add_1 _ _ H1); rewrite eqb_false_spec in Heq5; assert ([|i|] <> [|j|]) by (intro H; apply Heq5, to_Z_inj; auto); omega.
+  left; exists i; repeat split; auto; apply leb_refl.
+  rewrite Heq3 in H3; case_eq (f (a .[ i])); intro Heq4; rewrite Heq4 in H3; try discriminate; left; exists i; repeat split; auto; apply leb_refl.
+  intros H1; right; intros i H2 H3; replace i with (length a - 1); auto; apply to_Z_inj; rewrite leb_spec in H2; rewrite (to_Z_sub_1 _ _ H3) in *; rewrite ltb_spec in H3; omega.
+  unfold P in H; intro H1; right; destruct (H H1) as [[i [_ H2]]|H2].
+  left; exists i; auto.
+  right; intro i; apply H2, leb_0.
+Qed.
+
+
+(* Other cases *)
+
+Lemma afold_left_length_2 : forall A B default OP F t,
+  (length t == 2) = true ->
+  afold_left A B default OP F t = OP (F (t.[0])) (F (t.[1])).
+Proof.
+  intros A B default OP F t H; unfold afold_left; rewrite eqb_spec in H; rewrite H; change (2 == 0) with false; simpl; change (2-1) with 1; rewrite foldi_eq; trivial.
+Qed.
+
+
+Lemma afold_right_length_2 : forall A B default OP F t,
+  (length t == 2) = true ->
+  afold_right A B default OP F t = OP (F (t.[0])) (F (t.[1])).
+Proof.
+  intros A B default OP F t H; unfold afold_right; rewrite eqb_spec in H; rewrite H; change (2 == 0) with false; simpl; change (2<=1) with false; simpl; change (2-2) with 0; rewrite foldi_down_eq; trivial.
+Qed.
+
+
+Ltac tac_left :=
+  intros t f H H1 H2; rewrite afold_left_length_2;
+    [rewrite H1, H2| ]; trivial.
+
+
+Ltac tac_right :=
+  try (intros t f H H1 H2; rewrite afold_right_length_2;
+    [rewrite H1, H2| ]; trivial);
+  try (intros t f H H1; rewrite afold_right_length_2;
+    [rewrite H1| ]; trivial);
+  try (rewrite implb_true_r; trivial).
+
+
+Lemma afold_left_xorb_false1 : forall t f,
+  (PArray.length t == 2) = true ->
+  f (t .[ 0]) = false -> f (t .[ 1]) = false ->
+  afold_left bool int false xorb f t = false.
+Proof. tac_left. Qed.
+
+
+Lemma afold_left_xorb_false2 : forall t f,
+  (PArray.length t == 2) = true ->
+  f (t .[ 0]) = true -> f (t .[ 1]) = true ->
+  afold_left bool int false xorb f t = false.
+Proof. tac_left. Qed.
+
+
+Lemma afold_left_xorb_true1 : forall t f,
+  (PArray.length t == 2) = true ->
+  f (t .[ 0]) = false -> f (t .[ 1]) = true ->
+  afold_left bool int false xorb f t = true.
+Proof. tac_left. Qed.
+
+
+Lemma afold_left_xorb_true2 : forall t f,
+  (PArray.length t == 2) = true ->
+  f (t .[ 0]) = true -> f (t .[ 1]) = false ->
+  afold_left bool int false xorb f t = true.
+Proof. tac_left. Qed.
+
+
+(* Lemma afold_right_implb_false : forall t f, *)
+(*   (PArray.length t == 2) = true -> *)
+(*   f (t .[ 0]) = true -> f (t .[ 1]) = false -> *)
+(*   afold_right bool int true implb f t = false. *)
+(* Proof. tac_right. Qed. *)
+
+
+(* Lemma afold_right_implb_true1 : forall t f, *)
+(*   (PArray.length t == 2) = true -> *)
+(*   f (t .[ 0]) = false -> *)
+(*   afold_right bool int true implb f t = true. *)
+(* Proof. tac_right. Qed. *)
+
+
+(* Lemma afold_right_implb_true2 : forall t f, *)
+(*   (PArray.length t == 2) = true -> *)
+(*   f (t.[1]) = true -> *)
+(*   afold_right bool int true implb f t = true. *)
+(* Proof. tac_right. Qed. *)
+
+
+Lemma afold_left_eqb_false1 : forall t f,
+  (PArray.length t == 2) = true ->
+  f (t .[ 0]) = false -> f (t .[ 1]) = true ->
+  afold_left bool int true eqb f t = false.
+Proof. tac_left. Qed.
+
+
+Lemma afold_left_eqb_false2 : forall t f,
+  (PArray.length t == 2) = true ->
+  f (t .[ 0]) = true -> f (t .[ 1]) = false ->
+  afold_left bool int true eqb f t = false.
+Proof. tac_left. Qed.
+
+
+Lemma afold_left_eqb_true1 : forall t f,
+  (PArray.length t == 2) = true ->
+  f (t .[ 0]) = true -> f (t .[ 1]) = true ->
+  afold_left bool int true eqb f t = true.
+Proof. tac_left. Qed.
+
+
+Lemma afold_left_eqb_true2 : forall t f,
+  (PArray.length t == 2) = true ->
+  f (t .[ 0]) = false -> f (t .[ 1]) = false ->
+  afold_left bool int true eqb f t = true.
+Proof. tac_left. Qed.
+
+
+(** Two elements in a list *)
+
+Section List2.
+
+  Variable A : Type.
+
+  Inductive In2 (i j : A) : list A -> Prop :=
+  | In2_hd : forall l, In j l -> In2 i j (i::l)
+  | In2_tl : forall k l, In2 i j l -> In2 i j (k::l).
+
+  Local Hint Constructors In2.
+
+
+  Lemma In2_app : forall i j l m, In2 i j (l ++ m) <->
+    In2 i j l \/ (In i l /\ In j m) \/ In2 i j m.
+  Proof.
+    intros i j; induction l as [ |t l IHl]; simpl; intro m; split; auto.
+    intros [H|[[H _]|H]]; auto.
+    inversion H.
+    elim H.
+    intro H; inversion H; clear H.
+    subst i l0; rewrite in_app_iff in H1; destruct H1 as [H1|H1]; auto.
+    subst k l0; rewrite IHl in H1; destruct H1 as [H1|[[H1 H2]|H1]]; auto.
+    intros [H|[[[H|H] H1]|H]].
+    inversion H; clear H.
+    subst i l0; constructor 1; rewrite in_app_iff; auto.
+    subst k l0; constructor 2; rewrite IHl; left; auto.
+    subst t; constructor 1; rewrite in_app_iff; auto.
+    constructor 2; rewrite IHl; right; left; auto.
+    constructor 2; rewrite IHl; right; right; auto.
+  Qed.
+
+
+  Fixpoint rev_aux acc (l:list A) :=
+    match l with
+      | nil => acc
+      | t::q => rev_aux (t::acc) q
+    end.
+
+
+  Lemma In2_rev_aux : forall i j l acc, In2 i j (rev_aux acc l) <->
+    In2 i j acc \/ (In i l /\ In j acc) \/ In2 j i l.
+  Proof.
+    intros i j; induction l as [ |t q IHq]; simpl; intro acc; split; auto.
+    intros [H|[[H _]|H]]; auto.
+    elim H.
+    inversion H.
+    rewrite IHq; clear IHq; intros [H|[[H1 H2]|H]]; auto.
+    inversion H; auto.
+    inversion H2; auto; clear H2; subst t; right; right; auto.
+    intros [H|[[[H1|H1] H2]|H]]; rewrite IHq; clear IHq; auto.
+    subst t; auto.
+    right; left; split; auto; constructor 2; auto.
+    inversion H; clear H; auto; subst j l; right; left; split; auto; constructor 1; auto.
+  Qed.
+
+
+  Definition rev := rev_aux nil.
+
+
+  Lemma In2_rev : forall i j l, In2 i j (rev l) <-> In2 j i l.
+  Proof.
+    intros i j l; unfold rev; rewrite In2_rev_aux; split; auto; intros [H|[[_ H]|H]]; auto; inversion H.
+  Qed.
+
+
+  Lemma In2_In : forall i j, i <> j -> forall l, (In i l /\ In j l) <-> (In2 i j l \/ In2 j i l).
+  Proof.
+    intros i j H l; split.
+    intros [H1 H2]; generalize H1 H2; clear H1 H2; induction l as [ |t q IHq].
+    intro H1; inversion H1.
+    intros H1 H2; inversion H1; clear H1.
+    subst t; inversion H2; auto; elim H; auto.
+    inversion H2; clear H2.
+    subst t; auto.
+    destruct (IHq H0 H1) as [H2|H2]; auto.
+    intros [H1|H1]; induction H1 as [H1|t q H1 [IH1 IH2]].
+    split; [constructor 1|constructor 2]; auto.
+    split; constructor 2; auto.
+    split; [constructor 2|constructor 1]; auto.
+    split; constructor 2; auto.
+  Qed.
+
+End List2.
+
+Arguments In2 [A] i j _.
+Arguments rev [A] l.
+Arguments In2_In [A i j] _ l.
+
+
+(** List of distinct elements *)
+
+Section Distinct.
+
+  Variable A : Type.
+  Variable eq : A -> A -> bool.
+
+  Fixpoint distinct_aux2 acc ref l :=
+    match l with
+      | nil => acc
+      | t::q => distinct_aux2 (acc && (negb (eq ref t))) ref q
+    end.
+
+  Lemma distinct_aux2_spec : forall ref l acc, distinct_aux2 acc ref l = true
+    <->
+    acc = true /\ (forall i, In i l -> eq ref i = false).
+  Proof.
+    intro ref; induction l as [ |t q IHq]; simpl.
+    intro acc; split.
+    intro H; split; auto; intros i H1; elim H1.
+    intros [H _]; auto.
+    intro acc; rewrite (IHq (acc && negb (eq ref t))); split.
+    rewrite andb_true_iff; intros [[H1 H2] H3]; split; auto; intros i [Hi|Hi]; auto; subst i; generalize H2; case (eq ref t); auto; discriminate.
+    intros [H1 H2]; rewrite andb_true_iff; repeat split; auto; rewrite (H2 t); auto.
+  Qed.
+
+  Lemma distinct_aux2_spec_neg : forall ref l acc,
+    distinct_aux2 acc ref l = false <->
+    acc = false \/ (exists i, In i l /\ eq ref i = true).
+  Proof.
+    intro ref; induction l as [ |t q IHq]; simpl.
+    intro acc; split; auto; intros [H|[i [H _]]]; auto; elim H.
+    intro acc; rewrite (IHq (acc && negb (eq ref t))); rewrite andb_false_iff;split.
+    intros [[H|H]|[i [H1 H2]]]; auto.
+    right; exists t; split; auto; generalize H; case (eq ref t); auto.
+    right; exists i; split; auto.
+    intros [H|[i [[H1|H1] H2]]]; auto.
+    subst t; left; right; generalize H2; case (eq ref i); auto.
+    right; exists i; auto.
+  Qed.
+
+  Fixpoint distinct_aux acc l :=
+    match l with
+      | nil => acc
+      | t::q =>
+        let acc' := distinct_aux2 acc t q in
+        distinct_aux acc' q
+    end.
+
+  Local Hint Constructors In2.
+
+  Lemma distinct_aux_spec : forall l acc, distinct_aux acc l = true <->
+    acc = true /\ (forall i j, In2 i j l -> eq i j = false).
+  Proof.
+    induction l as [ |t q IHq]; simpl.
+    intro acc; split.
+    intro H; split; auto; intros i j H1; inversion H1.
+    intros [H _]; auto.
+    intro acc; rewrite (IHq (distinct_aux2 acc t q)), distinct_aux2_spec; split.
+    intros [[H1 H2] H3]; split; auto; intros i j H; inversion H; auto.
+    intros [H1 H2]; repeat split; auto.
+  Qed.
+
+  Lemma distinct_aux_spec_neg : forall l acc, distinct_aux acc l = false <->
+    acc = false \/ (exists i j, In2 i j l /\ eq i j = true).
+  Proof.
+    induction l as [ |t q IHq]; simpl.
+    intro acc; split; auto; intros [H|[i [j [H _]]]]; auto; inversion H.
+    intro acc; rewrite (IHq (distinct_aux2 acc t q)), distinct_aux2_spec_neg; split.
+    intros [[H|[i [H1 H2]]]|[i [j [H1 H2]]]]; auto.
+    right; exists t; exists i; auto.
+    right; exists i; exists j; auto.
+    intros [H|[i [j [H1 H2]]]]; auto; inversion H1; clear H1.
+    subst i l; left; right; exists j; auto.
+    subst k l; right; exists i; exists j; auto.
+  Qed.
+
+  Definition distinct := distinct_aux true.
+
+  Lemma distinct_spec : forall l, distinct l = true <->
+    (forall i j, In2 i j l -> eq i j = false).
+  Proof.
+    unfold distinct; intro l; rewrite distinct_aux_spec; split; auto; intros [_ H]; auto.
+  Qed.
+
+  Lemma distinct_false_spec : forall l, distinct l = false <->
+    (exists i j, In2 i j l /\ eq i j = true).
+  Proof.
+    unfold distinct; intro l; rewrite distinct_aux_spec_neg; split; auto; intros [H|H]; auto; discriminate.
+  Qed.
+
+End Distinct.
+
+Arguments distinct [A] eq l.
+
+
+(** Specification of existsb *)
+
+Lemma existsb_false_spec : forall f from to,
+  existsb f from to = false <->
+  forall i, ((from <= i) = true /\ (i <= to) = true) -> f i = false.
+Proof.
+  unfold existsb;intros; setoid_rewrite leb_spec; apply foldi_cont_ZInd.
+  intros z Hz; split; auto; intros _ i [H1 H2]; assert (H3 := Z.le_trans _ _ _ H1 H2); elimtype False; omega.
+  intros i cont H1 H2 H3; case_eq (f i); intro Heq.
+  split; try discriminate; intro H; rewrite <- Heq; apply H; split; try omega; rewrite leb_spec in H2; auto.
+  rewrite H3; split; intros H j [Hj1 Hj2].
+  case_eq (i == j); intro Heq2.
+  rewrite eqb_spec in Heq2; subst j; auto.
+  apply H; split; auto; rewrite eqb_false_spec in Heq2; assert ([|i|] <> [|j|]) by (intro; apply Heq2, to_Z_inj; auto); omega.
+  apply H; omega.
+Qed.
+
+
+Lemma array_existsbi_false_spec : forall A (f : int -> A -> bool) t,
+  existsbi f t = false <->
+  forall i, i < length t = true -> f i (t.[i]) = false.
+Proof.
+  unfold existsbi;intros A f t; destruct (reflect_eqb 0 (length t)).
+  split; auto. intros _ i Hi. elim (ltb_0 i). rewrite e. auto.
+  rewrite existsb_false_spec. split.
+  intros H i Hi. apply H. split; [apply leb_0| ]. rewrite leb_spec. rewrite (to_Z_sub_1 _ _ Hi). rewrite ltb_spec in Hi. omega.
+  intros H i [_ Hi]. apply H. rewrite ltb_spec. rewrite leb_spec in Hi. rewrite to_Z_sub_1_diff in Hi; auto; omega.
+Qed.
+
+
+Lemma array_existsb_false_spec : forall A (f : A -> bool) t,
+  PArray.existsb f t = false <->
+  forall i, i < length t = true -> f (t.[i]) = false.
+Proof.
+  intros A f t; unfold PArray.existsb; case_eq (0 == length t).
+  rewrite eqb_spec; intro H; split; auto; intros _ i Hi; elim (ltb_0 i); rewrite H; auto.
+  intro H; rewrite existsb_false_spec; split.
+  intros H1 i Hi; apply H1; split; [apply leb_0| ]; rewrite leb_spec, (to_Z_sub_1 _ _ Hi); rewrite ltb_spec in Hi; omega.
+  intros H1 i [_ H2]; apply H1; rewrite ltb_spec; rewrite leb_spec in H2; rewrite to_Z_sub_1_diff in H2; [omega| ]; intro H3; rewrite H3 in H; discriminate.
+Qed.
+
+
+(** Forall of two lists at the same time *)
+
+Section Forall2.
+
+  Variables (A B:Type) (f:A->B->bool).
+
+  Fixpoint forallb2 l1 l2 :=
+    match l1, l2 with
+      | nil, nil => true
+      | a::l1, b::l2 => f a b && forallb2 l1 l2
+      | _, _ => false
+    end.
+
+End Forall2.
+
+Implicit Arguments forallb2 [A B].
+
diff --git a/src/SMTCoq.v b/src/SMTCoq.v
new file mode 100644
index 0000000..e318cc0
--- /dev/null
+++ b/src/SMTCoq.v
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+Require Export Int63 List PArray.
+Require Export State SMT_terms Trace.
+Export Atom Form Sat_Checker Cnf_Checker Euf_Checker.
+
+Declare ML Module "trace/smt_tactic".
diff --git a/src/SMT_terms.v b/src/SMT_terms.v
new file mode 100644
index 0000000..5f6120e
--- /dev/null
+++ b/src/SMT_terms.v
@@ -0,0 +1,1308 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Add LoadPath "." as SMTCoq.
+Require Import Bool List Int63 PArray.
+Require Import Misc State.
+
+Local Open Scope array_scope.
+Local Open Scope int63_scope.
+
+Hint Unfold is_true.
+
+
+(* Remark: I use Notation instead of Definition du eliminate conversion check during the type checking *)
+Notation atom := int (only parsing).
+
+Module Form.
+
+  Notation fargs := (array _lit) (only parsing).
+
+  Inductive form : Type :=
+  | Fatom (_:atom)
+  | Ftrue
+  | Ffalse
+  | Fnot2 (_:int) (_:_lit)
+  | Fand (_:fargs)
+  | For  (_:fargs)
+  | Fimp (_:fargs)
+  | Fxor (_:_lit) (_:_lit)
+  | Fiff (_:_lit) (_:_lit)
+  | Fite (_:_lit) (_:_lit) (_:_lit).
+
+  Definition is_Ftrue h :=
+    match h with Ftrue => true | _ => false end.
+
+  Definition is_Ffalse h :=
+    match h with Ffalse => true | _ => false end.
+
+  Lemma is_Ftrue_correct : forall h, is_Ftrue h -> h = Ftrue.
+  Proof. destruct h;trivial;discriminate. Qed.
+
+  Lemma is_Ffalse_correct : forall h, is_Ffalse h -> h = Ffalse.
+  Proof. destruct h;trivial;discriminate. Qed.
+
+  Section Interp.
+    Variable interp_atom : atom -> bool.
+
+    Section Interp_form.
+
+    (* On suppose qu'on a l'interprétation des litéraux *)
+      Variable interp_var : var -> bool.
+
+      (* Interprétation d'une formule en supposant l'interprétation
+         des litéraux *)
+      (* (les litéraux font office d'index de hachage) *)
+      Definition interp_aux (h:form) : bool :=
+        match h with
+        | Fatom a => interp_atom a
+        | Ftrue => true
+        | Ffalse => false
+        | Fnot2 i l => fold (fun b => negb (negb b)) 1 i (Lit.interp interp_var l)
+        | Fand args => afold_left _ _ true andb (Lit.interp interp_var) args
+        | For args => afold_left _ _ false orb (Lit.interp interp_var) args
+        | Fimp args => afold_right _ _ true implb (Lit.interp interp_var) args
+        | Fxor a b => xorb (Lit.interp interp_var a) (Lit.interp interp_var b)
+        | Fiff a b => Bool.eqb (Lit.interp interp_var a) (Lit.interp interp_var b)
+        | Fite a b c =>
+          if Lit.interp interp_var a then Lit.interp interp_var b
+          else Lit.interp interp_var c
+        end.
+
+    End Interp_form.
+
+    Section Interp_get.
+
+      Variable t_form : PArray.array form.
+
+      Definition t_interp : PArray.array bool :=
+        PArray.foldi_left (fun i t_b hf => 
+            t_b.[i <- interp_aux (PArray.get t_b) hf])
+        (PArray.make (PArray.length t_form) true) t_form.
+
+      Fixpoint lt_form i h:=
+        match h with
+        | Fatom _ | Ftrue | Ffalse => true
+        | Fnot2 _ l => Lit.blit l < i
+        | Fand args | For args | Fimp args =>
+          PArray.forallb (fun l => Lit.blit l < i) args
+        | Fxor a b | Fiff a b => (Lit.blit a < i) && (Lit.blit b < i) 
+        | Fite a b c => (Lit.blit a < i) && (Lit.blit b < i) && (Lit.blit c < i)
+        end.
+
+      Lemma lt_form_interp_form_aux :
+        forall f1 f2 i h,
+          (forall j, j < i -> f1 j = f2 j) ->
+          lt_form i h ->
+          interp_aux f1 h = interp_aux f2 h.
+      Proof.
+        destruct h;simpl;intros;trivial;
+          try (apply afold_left_eq;unfold is_true in H0;
+            rewrite PArray.forallb_spec in H0;intros;
+              auto using Lit.interp_eq_compat).
+        f_equal;auto using Lit.interp_eq_compat.
+        apply afold_right_eq;unfold is_true in H0;
+          rewrite PArray.forallb_spec in H0;intros;
+            auto using Lit.interp_eq_compat.
+        unfold is_true in H0;rewrite !andb_true_iff in H0;decompose [and] H0;
+          rewrite !(Lit.interp_eq_compat f1 f2);auto.
+        unfold is_true in H0;rewrite !andb_true_iff in H0;decompose [and] H0;
+          rewrite !(Lit.interp_eq_compat f1 f2);auto.
+        unfold is_true in H0;rewrite !andb_true_iff in H0;decompose [and] H0;
+          rewrite !(Lit.interp_eq_compat f1 f2);auto.
+      Qed.
+
+      Definition wf := PArray.forallbi lt_form t_form.
+
+      Hypothesis wf_t_i : wf.
+
+      Lemma length_t_interp : length t_interp = length t_form.
+      Proof.
+        unfold t_interp;apply PArray.foldi_left_Ind with (P := fun i a => length a = length t_form).
+        intros;rewrite length_set;trivial.
+        rewrite length_make, ltb_length;trivial.
+      Qed.
+
+      Lemma default_t_interp : default t_interp = true.
+      Proof.
+        unfold t_interp;apply PArray.foldi_left_Ind with
+          (P := fun i a => default a = true).
+        intros;rewrite default_set;trivial.
+        apply default_make.
+      Qed.
+
+      Lemma t_interp_wf : forall i, i < PArray.length t_form ->
+        t_interp.[i] = interp_aux (PArray.get t_interp) (t_form.[i]).
+      Proof.
+        set (P' i t := length t = length t_form ->
+          forall j, j < i ->
+            t.[j] = interp_aux (PArray.get t) (t_form.[j])).
+        assert (P' (length t_form) t_interp).
+        unfold is_true, wf in wf_t_i;rewrite PArray.forallbi_spec in wf_t_i.
+        unfold t_interp;apply foldi_left_Ind;unfold P';intros.
+        rewrite length_set in H1.
+        destruct (Int63Properties.reflect_eqb j i).
+        rewrite e, PArray.get_set_same.
+        apply lt_form_interp_form_aux with (2:= wf_t_i i H).
+        intros;rewrite get_set_other;trivial.
+        intros Heq;elim (not_ltb_refl i);rewrite Heq at 1;trivial.
+        rewrite H1;trivial.
+        assert (j < i).
+        assert ([|j|] <> [|i|]) by (intros Heq1;elim n;apply to_Z_inj;trivial).
+        generalize H2;unfold is_true;rewrite !ltb_spec, (to_Z_add_1 _ _ H);
+          auto with zarith.
+        rewrite get_set_other, H0;auto.
+        apply lt_form_interp_form_aux with
+          (2:= wf_t_i j (ltb_trans _ _ _ H3 H)).
+        intros;rewrite get_set_other;trivial.
+        intros Heq;elim (not_ltb_refl i);apply ltb_trans with j;
+          [ rewrite Heq| ];trivial.
+        elim (ltb_0 _ H0).
+        apply H;apply length_t_interp.
+      Qed.
+
+    End Interp_get.
+
+    Definition interp_state_var t_form :=
+      let t_interp := t_interp t_form in
+      PArray.get t_interp.
+
+    Register interp_aux as PrimInline.
+    Definition interp t_form := interp_aux (interp_state_var t_form).
+
+    Lemma wf_interp_form_lt :
+      forall t_form, wf t_form ->
+        forall x, x < PArray.length t_form ->
+          interp_state_var t_form x = interp t_form (t_form.[x]).
+    Proof.
+      unfold interp_state_var;intros.
+      apply t_interp_wf;trivial.
+    Qed.
+
+    Lemma wf_interp_form :
+      forall t_form, PArray.default t_form = Ftrue -> wf t_form ->
+        forall x, interp_state_var t_form x = interp t_form (t_form.[x]).
+    Proof.
+      intros t Hd Hwf x;case_eq (x < PArray.length t);intros.
+      apply wf_interp_form_lt;trivial.
+      unfold interp_state_var;rewrite !PArray.get_outofbound;trivial.
+      rewrite default_t_interp, Hd;trivial.
+      rewrite length_t_interp;trivial.
+    Qed.
+
+    Definition check_form t_form :=
+      is_Ftrue (PArray.default t_form) &&
+      is_Ftrue (t_form.[0]) &&
+      is_Ffalse (t_form.[1]) &&
+      wf t_form.
+
+    Lemma check_form_correct : forall t_form,
+       check_form t_form ->
+       ((PArray.default t_form = Ftrue /\ wf t_form) /\
+        Valuation.wf (interp_state_var t_form)).
+    Proof.
+     unfold is_true, check_form;intros t;rewrite !andb_true_iff.
+     intros H;decompose [and] H;clear H;
+     assert (PArray.default t = Ftrue) by (apply is_Ftrue_correct;trivial).
+     repeat split;trivial.
+     rewrite wf_interp_form;trivial.
+     apply is_Ftrue_correct in H4;trivial;rewrite H4;reflexivity.
+     rewrite wf_interp_form;trivial.
+     apply is_Ffalse_correct in H3;trivial;rewrite H3;discriminate.
+    Qed.
+
+  End Interp.
+
+End Form.
+
+(* TODO Move this *)
+Record typ_eqb : Type := Typ_eqb {
+  te_carrier : Type;
+  te_eqb : te_carrier -> te_carrier -> bool;
+  te_reflect : forall x y, reflect (x = y) (te_eqb x y)
+}.
+
+(* Common used types into which we interpret *)
+
+(* Unit *)
+
+Section Unit_typ_eqb.
+
+  Let carrier : Type := unit.
+
+  Let eqb : carrier -> carrier -> bool :=
+    fun _ _ => true.
+
+  Lemma unit_reflect :
+    forall x y, reflect (x = y) (eqb x y).
+  Proof.
+    unfold eqb; intros x y; case x; case y; simpl;
+      constructor; reflexivity.
+  Qed.
+
+  Definition unit_typ_eqb :=
+    Typ_eqb carrier eqb unit_reflect.
+
+End Unit_typ_eqb.
+(* End TODO *)
+
+Module Typ.
+
+  Notation index := int (only parsing).
+
+  Inductive type :=
+  | Tindex : index -> type
+  | TZ : type
+  | Tbool : type
+  | Tpositive : type.
+
+  Definition ftype := (list type * type)%type.
+
+  Section Interp.
+
+    Variable t_i : PArray.array typ_eqb.
+
+    Definition interp t :=
+      match t with
+      | Tindex i => (t_i.[i]).(te_carrier)
+      | TZ => Z
+      | Tbool => bool
+      | Tpositive => positive
+      end.
+
+    Definition interp_ftype (t:ftype) :=
+      List.fold_right (fun dom codom =>interp dom -> codom)
+      (interp (snd t)) (fst t).
+
+    (* Boolean equality over interpretation of a btype *)
+    Section Interp_Equality.
+
+      Definition i_eqb (t:type) : interp t -> interp t -> bool :=
+        match t with
+        | Tindex i => (t_i.[i]).(te_eqb)
+        | TZ => Zeq_bool
+        | Tbool => Bool.eqb
+        | Tpositive => Peqb
+        end.
+
+      Lemma i_eqb_spec : forall t x y, i_eqb t x y <-> x = y.
+      Proof.
+       destruct t;simpl;intros.
+       symmetry;apply reflect_iff;apply te_reflect.
+       symmetry;apply Zeq_is_eq_bool.
+       apply Bool.eqb_true_iff.
+       apply Peqb_eq.
+      Qed.
+
+      Lemma reflect_i_eqb : forall t x y, reflect (x = y) (i_eqb t x y).
+      Proof.
+        intros;apply iff_reflect;symmetry;apply i_eqb_spec.
+      Qed.
+
+      Lemma i_eqb_sym : forall t x y, i_eqb t x y = i_eqb t y x.
+      Proof.
+        intros t x y; case_eq (i_eqb t x y); case_eq (i_eqb t y x); auto.
+        change (i_eqb t x y = true) with (is_true (i_eqb t x y)); rewrite i_eqb_spec; intros H1 H2; subst y; pose (H:=reflect_i_eqb t x x); inversion H; [rewrite <- H0 in H1; discriminate|elim H2; auto].
+        change (i_eqb t y x = true) with (is_true (i_eqb t y x)); rewrite i_eqb_spec; intros H1 H2; subst y; pose (H:=reflect_i_eqb t x x); inversion H; [rewrite <- H0 in H2; discriminate|elim H1; auto].
+      Qed.
+
+    End Interp_Equality.
+
+  End Interp.
+
+  (* Plutôt que de tester l'égalité entre deux btypes dans Prop, on
+     écrit une fonction calculant:
+     - si deux btype A et B sont égaux
+     - si oui, une fonction permettant de passer les objets de type A en
+     objets de type B
+     On montre que cette fonction réfléchit l'égalité de Coq. *)
+
+  Section Cast.
+
+  (* L'inductif cast_result spécifie si deux btype sont égaux (Cast) ou
+     non (NoCast). Dans le cas où ils sont égaux, une fonction permet de
+     passer de l'un à l'autre. *)
+
+    Inductive cast_result (A B: type) : Type :=
+    | Cast (k: forall P, P A -> P B)
+    | NoCast.
+
+    Implicit Arguments Cast [A B].
+    Implicit Arguments NoCast [A B].
+
+    Notation idcast := (Cast (fun P x => x)).
+    (* La fonction cast calcule cast_result *)
+
+    Definition cast (A B: type) : cast_result A B :=
+      match A as C, B as D return cast_result C D with
+      | Tindex i, Tindex j =>
+        match cast i j with
+        | Some k => Cast (fun P => k (fun y => P (Tindex y)))
+        | None => NoCast
+        end
+      | TZ, TZ => idcast
+      | Tbool, Tbool => idcast
+      | Tpositive, Tpositive => idcast
+      | _, _ => NoCast
+      end.
+
+    Lemma cast_refl:
+      forall A, cast A A = Cast (fun P (H : P A) => H).
+    Proof.
+      intros A0;destruct A0;simpl;trivial.
+      rewrite cast_refl;trivial.
+    Qed.
+
+    (* Remark : I use this definition because eqb will not be used only in the interpretation *)
+    Definition eqb (A B: type) : bool :=
+      match A, B with
+      | Tindex i, Tindex j => i == j
+      | TZ, TZ => true
+      | Tbool, Tbool => true
+      | Tpositive, Tpositive => true
+      | _, _ => false
+      end.
+
+
+    (* TODO : Move this *)
+    Lemma not_false : ~ false.
+    Proof. intro;discriminate. Qed.
+    Hint Resolve not_false.
+
+    Lemma is_true_true : true.
+    Proof. reflexivity. Qed.
+    Hint Resolve is_true_true.
+
+    Lemma not_is_true_eq_false : forall b:bool, ~ b <-> b = false.
+    Proof. exact not_true_iff_false. Qed.
+
+    Lemma cast_diff: forall A B, eqb A B = false -> cast A B = NoCast.
+    Proof.
+      intros A0 B0;destruct A0; destruct B0;simpl;trivial;try discriminate.
+      intros Heq;rewrite (cast_diff _ _ Heq);trivial.
+    Qed.
+
+    Lemma neq_cast : forall A B,
+      cast A B = (if eqb A B then cast A B else NoCast).
+    Proof.
+      intros C D;case_eq (eqb C D);trivial;apply cast_diff.
+    Qed.
+
+    Lemma reflect_eqb : forall x y, reflect (x = y) (eqb x y).
+    Proof.
+      intros x y;destruct x;destruct y;simpl;try constructor;trivial;try discriminate.
+      apply iff_reflect;rewrite eqb_spec;split;intros H;[inversion H | subst];trivial.
+    Qed.
+
+    Lemma eqb_spec : forall x y, eqb x y <-> x = y.
+    Proof.
+      intros;symmetry;apply reflect_iff;apply reflect_eqb.
+    Qed.
+
+    Lemma eqb_refl : forall x, eqb x x.
+    Proof. intros; rewrite eqb_spec; auto. Qed.
+
+  End Cast.
+
+End Typ.
+
+(* TODO move this *)
+Inductive dlist (A:Type) (P:A->Type) : list A -> Type :=
+| Dnil : dlist A P nil
+| Dcons : forall a l, P a -> dlist A P l -> dlist A P (cons a l).
+
+Set Implicit Arguments.
+Definition list_beq := fun (A : Type) (eq_A : A -> A -> bool) =>
+fix list_eqrec (X Y : list A) : bool :=
+  match X with
+  | nil => match Y with
+           | nil => true
+           | (_ :: _)%list => false
+           end
+  | (x :: x0)%list =>
+      match Y with
+      | nil => false
+      | (x1 :: x2)%list => (eq_A x x1 && list_eqrec x0 x2)%bool
+      end
+  end.
+Unset Implicit Arguments.
+
+Lemma reflect_list_beq : forall (A:Type) (beq:A -> A -> bool),
+  (forall x y, reflect (x = y) (beq x y)) ->
+  forall x y, reflect (x = y) (list_beq beq x y).
+Proof.
+  intros A beq Hbeq;induction x;destruct y;simpl;try (constructor;trivial;discriminate).
+  destruct (Hbeq a a0) as [Heq | Hd];simpl;[ | constructor;intros Heq;elim Hd;inversion Heq;trivial].
+  destruct (IHx y) as [Heq0 | Hd];simpl;[ | constructor;intros Heq0;elim Hd;inversion Heq0;trivial].
+  constructor;subst;trivial.
+Qed.
+
+Lemma list_beq_spec : forall (A:Type) (beq:A -> A -> bool),
+  (forall x y, beq x y <-> x = y) ->
+  forall x y, list_beq beq x y <-> x = y.
+Proof.
+  intros A beq HA x y;symmetry;apply reflect_iff;apply reflect_list_beq.
+  intros;apply iff_reflect;symmetry;apply HA.
+Qed.
+(* End move *)
+
+Module Atom.
+
+  Notation func := int (only parsing).
+ 
+  Inductive cop : Type := 
+   | CO_xH
+   | CO_Z0.
+
+  Inductive unop : Type :=
+   | UO_xO
+   | UO_xI
+   | UO_Zpos 
+   | UO_Zneg
+   | UO_Zopp.
+
+  Inductive binop : Type :=
+   | BO_Zplus
+   | BO_Zminus
+   | BO_Zmult
+   | BO_Zlt
+   | BO_Zle
+   | BO_Zge
+   | BO_Zgt
+   | BO_eq (_ : Typ.type).
+
+  Inductive nop : Type :=
+   | NO_distinct (_ : Typ.type).
+
+  Notation hatom := int (only parsing).
+ 
+  Inductive atom : Type :=
+   | Acop (_: cop)
+   | Auop (_ : unop) (_:hatom)
+   | Abop (_ : binop) (_:hatom) (_:hatom)
+   | Anop (_ : nop) (_: list hatom)
+   | Aapp (_:func) (_: list hatom).
+
+
+  (* Generic predicates and operations *)
+
+  (** Equality *)
+  Definition cop_eqb o o' :=
+   match o, o' with
+   | CO_xH, CO_xH 
+   | CO_Z0, CO_Z0 => true
+   | _,_ => false
+   end.
+
+  Definition uop_eqb o o' :=
+   match o, o' with
+   | UO_xO, UO_xO 
+   | UO_xI, UO_xI
+   | UO_Zpos, UO_Zpos 
+   | UO_Zneg, UO_Zneg
+   | UO_Zopp, UO_Zopp => true
+   | _,_ => false
+   end.
+
+  Definition bop_eqb o o' :=
+   match o, o' with
+   | BO_Zplus, BO_Zplus
+   | BO_Zminus, BO_Zminus
+   | BO_Zmult, BO_Zmult
+   | BO_Zlt, BO_Zlt
+   | BO_Zle, BO_Zle
+   | BO_Zge, BO_Zge
+   | BO_Zgt, BO_Zgt => true
+   | BO_eq t, BO_eq t' => Typ.eqb t t'
+   | _,_ => false
+   end.
+
+  Definition nop_eqb o o' :=
+    match o, o' with
+      | NO_distinct t, NO_distinct t' => Typ.eqb t t'
+    end.
+
+  Definition eqb (t t':atom) :=
+    match t,t' with
+    | Acop o, Acop o' => cop_eqb o o'
+    | Auop o t, Auop o' t' => uop_eqb o o' && (t == t')
+    | Abop o t1 t2, Abop o' t1' t2' => bop_eqb o o' && (t1 == t1') && (t2 == t2')
+    | Anop o t, Anop o' t' => nop_eqb o o' && list_beq Int63Native.eqb t t'
+    | Aapp a la, Aapp b lb => (a == b) && list_beq Int63Native.eqb la lb
+    | _, _ => false
+    end.
+
+  Ltac preflect t :=
+    let Heq := fresh "Heq" in
+      let Hd := fresh "Hd" in
+        destruct t as [Heq | Hd];simpl;
+          [ | constructor;intros Heq;elim Hd;inversion Heq;trivial].
+
+  Lemma reflect_cop_eqb : forall o1 o2, reflect (o1 = o2) (cop_eqb o1 o2).
+  Proof.
+   destruct o1;destruct o2;simpl;constructor;trivial;discriminate.
+  Qed.
+
+  Lemma reflect_uop_eqb : forall o1 o2, reflect (o1 = o2) (uop_eqb o1 o2).
+  Proof.
+   destruct o1;destruct o2;simpl;constructor;trivial;discriminate.
+  Qed.
+ 
+  Lemma reflect_bop_eqb : forall o1 o2, reflect (o1 = o2) (bop_eqb o1 o2).
+  Proof.
+   destruct o1;destruct o2;simpl;try (constructor;trivial;discriminate).
+   preflect (Typ.reflect_eqb t t0).
+   constructor;subst;trivial.
+  Qed.
+
+  Lemma reflect_nop_eqb : forall o1 o2, reflect (o1 = o2) (nop_eqb o1 o2).
+  Proof.
+    intros [t1] [t2]; simpl; preflect (Typ.reflect_eqb t1 t2); constructor; subst; reflexivity.
+  Qed.
+
+  Lemma reflect_eqb : forall t1 t2, reflect (t1 = t2) (eqb t1 t2).
+  Proof.
+    destruct t1;destruct t2;simpl; try (constructor;trivial;discriminate).
+    (* Constants *)
+    preflect (reflect_cop_eqb c c0);constructor;subst;trivial.
+    (* Unary operators *)
+    preflect (reflect_uop_eqb u u0); preflect (Int63Properties.reflect_eqb i i0);
+      constructor;subst;trivial.
+    (* Binary operators *)
+    preflect (reflect_bop_eqb b b0); 
+    preflect (Int63Properties.reflect_eqb i i1);
+    preflect (Int63Properties.reflect_eqb i0 i2);
+    constructor;subst;trivial.
+    (* N-ary operators *)
+    preflect (reflect_nop_eqb n n0); preflect (reflect_list_beq _ _ Int63Properties.reflect_eqb l l0); constructor; subst; reflexivity.
+    (* Application *)
+    preflect (Int63Properties.reflect_eqb i i0);
+    preflect (reflect_list_beq _ _ Int63Properties.reflect_eqb l l0);
+    constructor;subst;trivial.
+  Qed.
+  
+  Lemma eqb_spec : forall t1 t2, eqb t1 t2 <-> t1 = t2.
+  Proof.
+    intros;symmetry;apply reflect_iff;apply reflect_eqb.
+  Qed.
+  
+  (** Typing and interpretation *)
+  
+  Record val (t:Type) (I:t -> Type) := Val {
+    v_type : t;
+    v_val : I v_type
+  }.
+
+  Section Typing_Interp.
+    Variable t_i : PArray.array typ_eqb.
+
+    Local Notation interp_t := (Typ.interp t_i).
+    Local Notation interp_ft := (Typ.interp_ftype t_i).
+
+    Definition bval := val Typ.type interp_t.
+    Definition Bval := Val Typ.type interp_t.
+    Definition tval := val Typ.ftype interp_ft.
+    Definition Tval := Val Typ.ftype interp_ft.
+
+    Definition bvtrue : bval := Bval Typ.Tbool true.
+    Definition bvfalse : bval := Bval Typ.Tbool false.
+
+    Lemma Bval_inj1 : forall T U t u, Bval T t = Bval U u -> T = U.
+    Proof. intros T U t u H; inversion H; auto. Qed.
+
+    Lemma Bval_inj2 : forall T t u, Bval T t = Bval T u -> t = u.
+    Proof.
+      intros T t u H; assert (H1: (fun (x:bval) =>
+      match Typ.cast (v_type _ _ x) T with
+        | Typ.Cast k => k _ (v_val _ _ x) = v_val _ _ (Bval T u)
+        | Typ.NoCast => True
+      end) (Bval T t)).
+      rewrite H, Typ.cast_refl; reflexivity.
+      simpl in H1; rewrite Typ.cast_refl in H1; auto.
+    Qed.
+
+    (* Interprétation d'une fonction*)
+    Variable t_func : PArray.array tval.
+
+    (** Type checking of atom assuming an type for hatom *)
+    Section Typ_Aux.
+      Variable get_type : hatom -> Typ.type.
+
+      Definition typ_cop o := 
+        match o with
+        | CO_xH => Typ.Tpositive 
+        | CO_Z0 => Typ.TZ
+        end.
+
+      Definition typ_uop o :=
+        match o with
+        | UO_xO => (Typ.Tpositive,Typ.Tpositive) 
+        | UO_xI => (Typ.Tpositive,Typ.Tpositive) 
+        | UO_Zpos => (Typ.Tpositive, Typ.TZ)
+        | UO_Zneg => (Typ.Tpositive, Typ.TZ)
+        | UO_Zopp => (Typ.TZ, Typ.TZ)
+        end.
+
+      Definition typ_bop o := 
+        match o with
+        | BO_Zplus  => ((Typ.TZ,Typ.TZ), Typ.TZ) 
+        | BO_Zminus => ((Typ.TZ,Typ.TZ), Typ.TZ) 
+        | BO_Zmult  => ((Typ.TZ,Typ.TZ), Typ.TZ) 
+        | BO_Zlt    => ((Typ.TZ,Typ.TZ), Typ.Tbool) 
+        | BO_Zle    => ((Typ.TZ,Typ.TZ), Typ.Tbool) 
+        | BO_Zge    => ((Typ.TZ,Typ.TZ), Typ.Tbool) 
+        | BO_Zgt    => ((Typ.TZ,Typ.TZ), Typ.Tbool)
+        | BO_eq t   => ((t,t),Typ.Tbool)
+        end.
+
+      Definition typ_nop o :=
+        match o with
+          | NO_distinct t => (t,Typ.Tbool)
+        end.
+
+      Fixpoint check_args (args:list hatom) (targs:list Typ.type) :=
+        match args, targs with
+        | nil, nil => true
+        | a::args, t::targs => Typ.eqb (get_type a) t && check_args args targs
+        | _, _ => false
+        end.
+
+      Definition check_aux (a:atom) (t:Typ.type) : bool := 
+        match a with
+        | Acop o => Typ.eqb (typ_cop o) t 
+        | Auop o a =>
+          let (ta,t') := typ_uop o in
+          Typ.eqb t' t && Typ.eqb (get_type a) ta
+        | Abop o a1 a2 =>
+          let (ta,t') := typ_bop o in
+          let (ta1,ta2) := ta in
+          Typ.eqb t' t && Typ.eqb (get_type a1) ta1 && Typ.eqb (get_type a2) ta2 
+        | Anop o a =>
+          let (ta,t') := typ_nop o in
+          (Typ.eqb t' t) && (List.forallb (fun t1 => Typ.eqb (get_type t1) ta) a)
+        | Aapp f args =>
+          let (targs,tr) := v_type _ _ (t_func.[f]) in
+          check_args args targs && Typ.eqb tr t
+        end.
+
+      (* Typing is unique *)
+
+      Lemma unicity : forall a t1 t2,
+        check_aux a t1 -> check_aux a t2 -> t1 = t2.
+      Proof.
+        destruct a;simpl. 
+        (* Constants *)
+        intros t1 t2;rewrite !Typ.eqb_spec;intros;subst;trivial.
+        (* Unary operators *)
+        unfold is_true; intros t1 t2;rewrite (surjective_pairing (typ_uop u)),!andb_true_iff.
+        intros [H1 _] [H2 _]; change (is_true (Typ.eqb (snd (typ_uop u)) t1)) in H1.
+        change (is_true (Typ.eqb (snd (typ_uop u)) t2)) in H2.
+        rewrite Typ.eqb_spec in H1, H2;subst;trivial.
+        (* Binary operators *)
+        unfold is_true; intros t1 t2;rewrite (surjective_pairing (typ_bop b)),
+           (surjective_pairing (fst (typ_bop b))) ,!andb_true_iff.
+        intros [[H1 _] _] [[H2 _] _]; change (is_true (Typ.eqb (snd (typ_bop b)) t1)) in H1.
+        change (is_true (Typ.eqb (snd (typ_bop b)) t2)) in H2.
+        rewrite Typ.eqb_spec in H1, H2;subst;trivial.
+        (* N-ary operators *)
+        intros t1 t2; destruct (typ_nop n) as [ta t']; unfold is_true; rewrite !andb_true_iff; change (is_true (Typ.eqb t' t1) /\ is_true (List.forallb (fun t3 : int => Typ.eqb (get_type t3) ta) l) -> is_true (Typ.eqb t' t2) /\ is_true (List.forallb (fun t3 : int => Typ.eqb (get_type t3) ta) l) -> t1 = t2); rewrite !Typ.eqb_spec; intros [H1 _] [H2 _]; subst; auto.
+        (* Application *)
+        intros t1 t2;destruct (v_type Typ.ftype interp_ft (t_func.[ i])).
+        unfold is_true;rewrite !andb_true_iff;intros [_ H1] [_ H2].
+        transitivity t;[ symmetry| ];rewrite <-Typ.eqb_spec;trivial.
+      Qed.
+
+      (* Typing is decidable *)
+
+      Lemma check_args_dec : forall tr args targs,
+        {exists T : Typ.type,
+          check_args args targs && Typ.eqb tr T} +
+        {forall T : Typ.type,
+          check_args args targs && Typ.eqb tr T = false}.
+      Proof.
+        intro A; induction args as [ |h l IHl]; simpl.
+        (* Base case *)
+        intros [ | ]; simpl.
+        left; exists A; apply Typ.eqb_refl.
+        intros; right; reflexivity.
+        (* Inductive case *)
+        intros [ |B targs]; simpl.
+        right; reflexivity.
+        case (Typ.eqb (get_type h) B); simpl; auto.
+      Qed.
+
+      Lemma check_aux_dec : forall a,
+        {exists T, check_aux a T} + {forall T, check_aux a T = false}.
+      Proof.
+        intros [op|op h|op h1 h2|op ha|f args]; simpl.
+        (* Constants *)
+        left; destruct op; simpl.
+        exists Typ.Tpositive; auto.
+        exists Typ.TZ; auto.
+        (* Unary operators *)
+        destruct op; simpl; try (case (Typ.eqb (get_type h) Typ.Tpositive); [left; exists Typ.Tpositive|right; intro; rewrite andb_false_r]; reflexivity); try (case (Typ.eqb (get_type h) Typ.Tpositive); [left; exists Typ.TZ|right; intro; rewrite andb_false_r]; reflexivity); case (Typ.eqb (get_type h) Typ.TZ); [left; exists Typ.TZ|right; intro; rewrite andb_false_r]; reflexivity.
+        (* Binary operators *)
+        destruct op; simpl; try (case (Typ.eqb (get_type h1) Typ.TZ); [case (Typ.eqb (get_type h2) Typ.TZ); [left; exists Typ.TZ|right; intro; rewrite andb_false_r]|right; intro; rewrite andb_false_r]; reflexivity); try (case (Typ.eqb (get_type h1) Typ.TZ); [case (Typ.eqb (get_type h2) Typ.TZ); [left; exists Typ.Tbool|right; intro; rewrite andb_false_r]|right; intro; rewrite andb_false_r]; reflexivity); case (Typ.eqb (get_type h1) t); [case (Typ.eqb (get_type h2) t); [left; exists Typ.Tbool|right; intro; rewrite andb_false_r]|right; intro; rewrite andb_false_r]; reflexivity.
+        (* N-ary operators *)
+        destruct op as [ty]; simpl; case (List.forallb (fun t1 : int => Typ.eqb (get_type t1) ty) ha).
+        left; exists Typ.Tbool; auto.
+        right; intro T; rewrite andb_false_r; auto.
+        (* Application *)
+        case (v_type Typ.ftype interp_ft (t_func .[ f])); intros; apply check_args_dec.
+      Qed.
+
+    End Typ_Aux.
+    (** Interpretation of hatom assuming an interpretation for atom *)
+    Section Interp_Aux.
+
+      Variable interp_hatom : hatom -> bval.
+
+      Definition apply_unop (t  r : Typ.type)
+            (op : interp_t t -> interp_t r) (tv:bval) :=
+        let (t', v) := tv in
+        match Typ.cast t' t with
+        | Typ.Cast k => Bval r (op (k _ v))
+        | _ => bvtrue
+        end.
+
+      Definition apply_binop (t1 t2 r : Typ.type)
+            (op : interp_t t1 -> interp_t t2 -> interp_t r) (tv1 tv2:bval) :=
+        let (t1', v1) := tv1 in
+        let (t2', v2) := tv2 in
+        match Typ.cast t1' t1, Typ.cast t2' t2 with
+        | Typ.Cast k1, Typ.Cast k2 => Bval r (op (k1 _ v1) (k2 _ v2))
+        | _, _ => bvtrue
+        end.
+
+      Fixpoint apply_func
+           targs tr (f:interp_ft (targs,tr)) (lv:list bval) : bval :=
+        match targs as targs0 return interp_ft (targs0,tr) -> bval with
+        | nil => fun v =>
+          match lv with
+          | nil => Bval tr v
+          | _ => bvtrue
+          end
+        | t::targs => fun f =>
+          match lv with
+          | v::lv =>
+            let (tv,v) := v in
+            match Typ.cast tv t with
+            | Typ.Cast k =>
+              let f := f (k _ v) in apply_func targs tr f lv
+            | _ => bvtrue
+            end
+          | _ => bvtrue
+          end
+        end f.
+
+      Definition interp_cop o :=
+        match o with
+        | CO_xH => Bval Typ.Tpositive xH
+        | CO_Z0 => Bval Typ.TZ Z0
+        end.
+
+      Definition interp_uop o :=    
+        match o with
+        | UO_xO   => apply_unop Typ.Tpositive Typ.Tpositive xO
+        | UO_xI   => apply_unop Typ.Tpositive Typ.Tpositive xI
+        | UO_Zpos => apply_unop Typ.Tpositive Typ.TZ Zpos
+        | UO_Zneg => apply_unop Typ.Tpositive Typ.TZ Zneg
+        | UO_Zopp => apply_unop Typ.TZ Typ.TZ Zopp
+        end.
+
+      Definition interp_bop o :=
+         match o with
+         | BO_Zplus => apply_binop Typ.TZ Typ.TZ Typ.TZ Zplus
+         | BO_Zminus => apply_binop Typ.TZ Typ.TZ Typ.TZ Zminus
+         | BO_Zmult => apply_binop Typ.TZ Typ.TZ Typ.TZ Zmult
+         | BO_Zlt => apply_binop Typ.TZ Typ.TZ Typ.Tbool Zlt_bool
+         | BO_Zle => apply_binop Typ.TZ Typ.TZ Typ.Tbool Zle_bool
+         | BO_Zge => apply_binop Typ.TZ Typ.TZ Typ.Tbool Zge_bool
+         | BO_Zgt => apply_binop Typ.TZ Typ.TZ Typ.Tbool Zgt_bool
+         | BO_eq t => apply_binop t t Typ.Tbool (Typ.i_eqb t_i t)
+         end.
+
+      Fixpoint compute_interp ty acc l :=
+        match l with
+          | nil => Some acc
+          | a::q =>
+            let (ta,va) := interp_hatom a in
+            match Typ.cast ta ty with
+              | Typ.Cast ka => compute_interp ty ((ka _ va)::acc) q
+              | _ => None
+            end
+        end.
+
+      (* Lemma compute_interp_spec : forall ty l acc, *)
+      (*   match compute_interp ty acc l with *)
+      (*     | Some l' => forall i, In i l' <-> (In i acc \/ (exists a, In a l /\ interp_hatom a = Bval ty i)) *)
+      (*     | None => exists a, In a l /\ let (ta,_) := interp_hatom a in ta <> ty *)
+      (*   end. *)
+      (* Proof. *)
+      (*   intro ty; induction l as [ |a q IHq]; simpl. *)
+      (*   intros acc i; split. *)
+      (*   intro H; left; auto. *)
+      (*   intros [H|[a [H _]]]; auto; elim H. *)
+      (*   intro acc; case_eq (interp_hatom a); intros ta va Heq; rewrite Typ.neq_cast; case_eq (Typ.eqb ta ty). *)
+      (*   change (Typ.eqb ta ty = true) with (is_true (Typ.eqb ta ty)); rewrite Typ.eqb_spec; intro; subst ta; rewrite Typ.cast_refl; generalize (IHq (va :: acc)); clear IHq; case (compute_interp ty (va :: acc) q). *)
+      (*   intros l IH i; rewrite (IH i); clear IH; split; intros [H|[a1 [H1 H2]]]. *)
+      (*   inversion H; auto. *)
+      (*   subst va; clear H; right; exists a; split; auto. *)
+      (*   right; exists a1; split; auto. *)
+      (*   left; constructor 2; auto. *)
+      (*   destruct H1 as [H1|H1]. *)
+      (*   subst a1; left; constructor 1; rewrite Heq in H2; apply (Bval_inj2 ty); auto. *)
+      (*   right; exists a1; auto. *)
+      (*   intros [a1 [H1 H2]]; exists a1; split; auto. *)
+      (*   intro H; exists a; split; auto; rewrite Heq; intro H1; subst ta; rewrite Typ.eqb_refl in H; discriminate. *)
+      (* Qed. *)
+
+      Lemma compute_interp_spec : forall ty l acc,
+        match compute_interp ty acc l with
+          | Some l' => forall i j, In2 i j l' <-> (In2 i j acc \/ (In j acc /\ exists a, In a l /\ interp_hatom a = Bval ty i) \/ (exists a b, In2 b a l /\ interp_hatom a = Bval ty i /\ interp_hatom b = Bval ty j))
+          | None => exists a, In a l /\ let (ta,_) := interp_hatom a in ta <> ty
+        end.
+      Proof.
+        intro ty; induction l as [ |a q IHq]; simpl.
+        intros acc i; split.
+        intro H; left; auto.
+        intros [H|[[_ [a [H _]]]|[a [b [H _]]]]]; auto.
+        elim H.
+        inversion H.
+        intro acc; case_eq (interp_hatom a); intros ta va Heq; rewrite Typ.neq_cast; case_eq (Typ.eqb ta ty).
+        change (Typ.eqb ta ty = true) with (is_true (Typ.eqb ta ty)); rewrite Typ.eqb_spec; intro; subst ta; rewrite Typ.cast_refl; generalize (IHq (va :: acc)); clear IHq; case (compute_interp ty (va :: acc) q).
+        intros l IH i j; rewrite (IH i j); clear IH; split.
+        intros [H|[[H [b [H1 H2]]]|[b [c [H [H1 H2]]]]]].
+        inversion H; clear H.
+        subst i l0; right; left; split; auto; exists a; split; auto.
+        subst k l0; left; auto.
+        inversion H; clear H.
+        subst va; right; right; exists b; exists a; repeat split; auto; constructor 1; auto.
+        right; left; split; auto; exists b; auto.
+        right; right; exists b; exists c; repeat split; auto; constructor 2; auto.
+        intros [H|[[H [b [[H1|H1] H2]]]|[b [c [H [H1 H2]]]]]].
+        left; constructor 2; auto.
+        subst b; rewrite Heq in H2; generalize (Bval_inj2 _ _ _ H2); intro; subst va; left; constructor; auto.
+        right; left; split.
+        constructor 2; auto.
+        exists b; auto.
+        inversion H; clear H.
+        subst c l0; rewrite Heq in H2; generalize (Bval_inj2 _ _ _ H2); intro; subst va; right; left; split.
+        constructor 1; auto.
+        exists b; auto.
+        subst k l0; right; right; exists b; exists c; auto.
+        intros [a1 [H1 H2]]; exists a1; split; auto.
+        intro H; exists a; split; auto; rewrite Heq; intro H1; subst ta; rewrite Typ.eqb_refl in H; discriminate.
+      Qed.
+
+      (* Lemma compute_interp_spec_rev : forall ty l, *)
+      (*   match compute_interp ty nil l with *)
+      (*     | Some l' => forall i, In i (rev l') <-> (exists a, In a l /\ interp_hatom a = Bval ty i) *)
+      (*     | None => exists a, In a l /\ let (ta,_) := interp_hatom a in ta <> ty *)
+      (*   end. *)
+      (* Proof. (* ICI *) *)
+      (*   intros ty l; generalize (compute_interp_spec ty l nil); case (compute_interp ty nil l); auto; intros l' H i; rewrite <- In_rev, (H i); split; auto; intros [H1|H1]; auto; inversion H1. *)
+      (* Qed. *)
+
+      Lemma compute_interp_spec_rev : forall ty l,
+        match compute_interp ty nil l with
+          | Some l' => forall i j, In2 j i (rev l') <-> (exists a b, In2 b a l /\ interp_hatom a = Bval ty i /\ interp_hatom b = Bval ty j)
+          | None => exists a, In a l /\ let (ta,_) := interp_hatom a in ta <> ty
+        end.
+      Proof.
+        intros ty l; generalize (compute_interp_spec ty l nil); case (compute_interp ty nil l); auto; intros l' H i j; rewrite In2_rev, (H i j); split; auto; intros [H1|[[H1 _]|H1]]; auto; inversion H1.
+      Qed.
+
+      Definition interp_aux (a:atom) : bval :=
+        match a with
+        | Acop o => interp_cop o
+        | Auop o a => interp_uop o (interp_hatom a)
+        | Abop o a1 a2 => interp_bop o (interp_hatom a1) (interp_hatom a2)
+        | Anop (NO_distinct t) a =>
+          match compute_interp t nil a with
+            | Some l => Bval Typ.Tbool (distinct (Typ.i_eqb t_i t) (rev l))
+            | None => bvtrue
+          end
+        | Aapp f args =>
+          let (tf,f) := t_func.[f] in
+          let lv := List.map interp_hatom args in
+          apply_func (fst tf) (snd tf) f lv
+        end.
+
+      Definition interp_bool (v:bval) : bool :=
+        let (t,v) := v in
+        match Typ.cast t Typ.Tbool with
+        | Typ.Cast k => k _ v
+        | _ => true
+        end.
+
+
+      (* If an atom is well-typed, it has an interpretation *)
+
+      Variable get_type : hatom -> Typ.type.
+      Hypothesis check_aux_interp_hatom : forall h,
+        exists v, interp_hatom h = (Bval (get_type h) v).
+
+      Lemma check_args_interp_aux : forall t l f,
+        (let (targs, tr) := v_type Typ.ftype interp_ft f in
+          check_args get_type l targs && Typ.eqb tr t) ->
+        exists v : interp_t t,
+          (let (tf, f0) := f in
+            apply_func (fst tf) (snd tf) f0 (List.map interp_hatom l)) =
+          Bval t v.
+      Proof.
+        intro A; induction l as [ |h l IHl]; simpl; intros [tf f]; simpl.
+        (* Base case *)
+        destruct tf as [[ | ] tr]; try discriminate; simpl; rewrite Typ.eqb_spec; intro; subst tr; exists f; auto.
+        (* Inductive case *)
+        destruct tf as [[ |B targs] tr]; try discriminate; simpl; rewrite <- andb_assoc; unfold is_true; rewrite andb_true_iff; change (Typ.eqb (get_type h) B = true /\ check_args get_type l targs && Typ.eqb tr A = true) with (is_true (Typ.eqb (get_type h) B) /\ is_true (check_args get_type l targs && Typ.eqb tr A)); rewrite Typ.eqb_spec; intros [H1 H2]; destruct (check_aux_interp_hatom h) as [v0 Heq0]; rewrite Heq0; generalize v0 Heq0; rewrite H1; intros v1 Heq1; simpl; generalize (IHl (Tval (targs,tr) (f v1))); simpl; intro IH; destruct (IH H2) as [v2 Heq2]; exists v2; rewrite Typ.cast_refl; auto.
+      Qed.
+
+      Lemma check_aux_interp_aux_aux : forall a t,
+         check_aux get_type a t ->
+         exists v, interp_aux a = (Bval t v).
+      Proof.
+        intros [op|op h|op h1 h2|op ha|f l]; simpl.
+        (* Constants *)
+        destruct op; intros [i| | | ]; simpl; try discriminate; intros _.
+        exists 1%positive; auto.
+        exists 0%Z; auto.
+        (* Unary operators *)
+        destruct op; intros [i| | | ]; simpl; try discriminate; rewrite Typ.eqb_spec; intro H1; destruct (check_aux_interp_hatom h) as [x Hx]; rewrite Hx; simpl; generalize x Hx; rewrite H1; intros y Hy; rewrite Typ.cast_refl.
+        exists (y~0)%positive; auto.
+        exists (y~1)%positive; auto.
+        exists (Zpos y); auto.
+        exists (Zneg y); auto.
+        exists (- y)%Z; auto.
+        (* Binary operators *)
+        destruct op as [ | | | | | | |A]; intros [i| | | ]; simpl; try discriminate; unfold is_true; rewrite andb_true_iff; try (change (Typ.eqb (get_type h1) Typ.TZ = true /\ Typ.eqb (get_type h2) Typ.TZ = true) with (is_true (Typ.eqb (get_type h1) Typ.TZ) /\ is_true (Typ.eqb (get_type h2) Typ.TZ)); rewrite !Typ.eqb_spec; intros [H1 H2]; destruct (check_aux_interp_hatom h1) as [x1 Hx1]; rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl; generalize x1 Hx1 x2 Hx2; rewrite H1, H2; intros y1 Hy1 y2 Hy2; rewrite !Typ.cast_refl).
+        exists (y1 + y2)%Z; auto.
+        exists (y1 - y2)%Z; auto.
+        exists (y1 * y2)%Z; auto.
+        exists (y1 <? y2)%Z; auto.
+        exists (y1 <=? y2)%Z; auto.
+        exists (y1 >=? y2)%Z; auto.
+        exists (y1 >? y2)%Z; auto.
+        change (Typ.eqb (get_type h1) A = true /\ Typ.eqb (get_type h2) A = true) with (is_true (Typ.eqb (get_type h1) A) /\ is_true (Typ.eqb (get_type h2) A)); rewrite !Typ.eqb_spec; intros [H1 H2]; destruct (check_aux_interp_hatom h1) as [x1 Hx1]; rewrite Hx1; destruct (check_aux_interp_hatom h2) as [x2 Hx2]; rewrite Hx2; simpl; generalize x1 Hx1 x2 Hx2; rewrite H1, H2; intros y1 Hy1 y2 Hy2; rewrite !Typ.cast_refl; exists (Typ.i_eqb t_i A y1 y2); auto.
+        (* N-ary operators *)
+        destruct op as [A]; simpl; intros [ | | | ]; try discriminate; simpl; intros _; case (compute_interp A nil ha).
+        intro l; exists (distinct (Typ.i_eqb t_i A) (rev l)); auto.
+        exists true; auto.
+        (* Application *)
+        intro t; apply check_args_interp_aux.
+      Qed.
+
+
+      (* If an atom is not well-typed, its interpretation is bvtrue *)
+
+      Lemma check_args_interp_aux_contr : forall l f,
+        (forall T : Typ.type,
+          (let (targs, tr) := v_type Typ.ftype interp_ft f in
+            check_args get_type l targs && Typ.eqb tr T) = false) ->
+        (let (tf, f0) := f in
+          apply_func (fst tf) (snd tf) f0 (List.map interp_hatom l)) = bvtrue.
+        induction l as [ |h l IHl]; simpl; intros [tf f]; simpl.
+        (* Base case *)
+        destruct tf as [[ | ] tr]; simpl; auto; intro H; generalize (H tr); rewrite Typ.eqb_refl; discriminate.
+        (* Inductive case *)
+        destruct tf as [[ |B targs] tr]; simpl; auto. intro H. destruct (check_aux_interp_hatom h) as [v Hv]. rewrite Hv. simpl. assert (H2: (Typ.eqb (get_type h) B = false) \/ (forall T : Typ.type, check_args get_type l targs && Typ.eqb tr T = false)) by (case_eq (Typ.eqb (get_type h) B); try (intros; left; reflexivity); intro Heq; right; intro T; generalize (H T); rewrite Heq; auto). destruct H2 as [H2|H2]; rewrite Typ.neq_cast.
+        rewrite H2. auto.
+        case_eq (Typ.eqb (get_type h) B); auto. change (Typ.eqb (get_type h) B = true) with (is_true (Typ.eqb (get_type h) B)). rewrite Typ.eqb_spec. intro; subst B. rewrite Typ.cast_refl. apply (IHl (Tval (targs,tr) (f v))). auto.
+      Qed.
+
+      Lemma check_aux_interp_aux_contr_aux : forall a,
+        (forall T, check_aux get_type a T = false) ->
+        interp_aux a = bvtrue.
+      Proof.
+        intros [op|op h|op h1 h2|op ha|f l]; simpl.
+        (* Constants *)
+        destruct op; simpl; intro H.
+        discriminate (H Typ.Tpositive).
+        discriminate (H Typ.TZ).
+        (* Unary operators *)
+        destruct op; simpl; intro H; destruct (check_aux_interp_hatom h) as [v Hv]; rewrite Hv; simpl; rewrite Typ.neq_cast; try (pose (H2 := H Typ.Tpositive); simpl in H2; rewrite H2; auto); pose (H2 := H Typ.TZ); simpl in H2; rewrite H2; auto.
+        (* Binary operators *)
+        destruct op; simpl; intro H; destruct (check_aux_interp_hatom h1) as [v1 Hv1]; destruct (check_aux_interp_hatom h2) as [v2 Hv2]; rewrite Hv1, Hv2; simpl; try (pose (H2 := H Typ.TZ); simpl in H2; rewrite andb_false_iff in H2; destruct H2 as [H2|H2]; [rewrite (Typ.neq_cast (get_type h1)), H2|rewrite (Typ.neq_cast (get_type h2)), H2; case (Typ.cast (get_type h1) Typ.TZ)]; auto); try (pose (H2 := H Typ.Tbool); simpl in H2; rewrite andb_false_iff in H2; destruct H2 as [H2|H2]; [rewrite (Typ.neq_cast (get_type h1)), H2|rewrite (Typ.neq_cast (get_type h2)), H2; case (Typ.cast (get_type h1) Typ.TZ)]; auto); case (Typ.cast (get_type h1) t); auto.
+        (* N-ary operators *)
+        destruct op as [A]; simpl; intro H; generalize (H Typ.Tbool); simpl; clear H; assert (H: forall l1, List.forallb (fun t1 : int => Typ.eqb (get_type t1) A) ha = false -> match compute_interp A l1 ha with | Some l => Bval Typ.Tbool (distinct (Typ.i_eqb t_i A) (rev l)) | None => bvtrue end = bvtrue).
+        induction ha as [ |h ha Iha]; simpl.
+        intros; discriminate.
+        intro l1; destruct (check_aux_interp_hatom h) as [vh Hh]; case_eq (Typ.eqb (get_type h) A); simpl.
+        change (Typ.eqb (get_type h) A = true) with (is_true (Typ.eqb (get_type h) A)); rewrite Typ.eqb_spec; intro; subst A; intro H; rewrite Hh; simpl; rewrite Typ.cast_refl; apply Iha; auto.
+        intros H _; rewrite Hh; simpl; rewrite (Typ.cast_diff _ _ H); auto.
+        apply H.
+        (* Application *)
+        apply check_args_interp_aux_contr.
+      Qed.
+
+    End Interp_Aux.
+
+    Section Interp_get.
+
+      Variable t_atom : PArray.array atom.
+
+      Definition t_interp : PArray.array bval :=
+        PArray.foldi_left (fun i t_a a => t_a.[i <- interp_aux (PArray.get t_a) a])
+          (PArray.make (PArray.length t_atom) (interp_cop CO_xH)) t_atom.
+
+      Definition lt_atom i a :=
+        match a with
+        | Acop _ => true
+        | Auop _ h => h < i
+        | Abop _ h1 h2 => (h1 < i) && (h2 < i)
+        | Anop _ ha => List.forallb (fun h => h < i) ha
+        | Aapp f args => List.forallb (fun h => h < i) args
+        end.
+
+      Lemma lt_interp_aux :
+         forall f1 f2 i, (forall j, j < i -> f1 j = f2 j) ->
+         forall a, lt_atom i a ->
+             interp_aux f1 a = interp_aux f2 a.
+      Proof.
+        intros f1 f2 i Hf; destruct a;simpl;intros;auto.
+        (* Unary operators *)
+        rewrite Hf;trivial.
+        (* Binary operators *)
+        unfold is_true in H;rewrite andb_true_iff in H;destruct H;rewrite !Hf;trivial.
+        (* N-ary operators *)
+        destruct n as [A]; replace (compute_interp f1 A nil l) with (compute_interp f2 A nil l); trivial; assert (H1: forall acc, compute_interp f2 A acc l = compute_interp f1 A acc l); auto; induction l as [ |k l IHl]; simpl; auto; intro acc; simpl in H; unfold is_true in H; rewrite andb_true_iff in H; destruct H as [H1 H2]; rewrite (Hf _ H1); destruct (f2 k) as [ta va]; destruct (Typ.cast ta A) as [ka| ]; auto.
+        (* Application *)
+        replace (List.map f1 l) with (List.map f2 l); trivial.
+        induction l;simpl in H |- *;trivial.
+        unfold is_true in H;rewrite andb_true_iff in H;destruct H;rewrite Hf, IHl;trivial.
+      Qed.
+
+      Definition wf := PArray.forallbi lt_atom t_atom.
+
+      Hypothesis wf_t_i : wf.
+
+      Lemma length_t_interp : length t_interp = length t_atom.
+      Proof.
+        unfold t_interp;apply PArray.foldi_left_Ind with
+          (P := fun i a => length a = length t_atom).
+        intros;rewrite length_set;trivial.
+        rewrite length_make, ltb_length;trivial.
+      Qed.
+
+      Lemma default_t_interp : default t_interp = interp_cop CO_xH.
+      Proof.
+        unfold t_interp;apply PArray.foldi_left_Ind with
+          (P := fun i a => default a = interp_cop CO_xH).
+        intros;rewrite default_set;trivial.
+        apply default_make.
+      Qed.
+
+      Lemma t_interp_wf_lt : forall i, i < PArray.length t_atom ->
+         t_interp.[i] = interp_aux (PArray.get t_interp) (t_atom.[i]).
+      Proof.
+        set (P' i t := length t = length t_atom ->
+               forall j, j < i ->
+               t.[j] = interp_aux (PArray.get t) (t_atom.[j])).
+        assert (P' (length t_atom) t_interp).
+         unfold is_true, wf in wf_t_i;rewrite PArray.forallbi_spec in wf_t_i.
+         unfold t_interp;apply foldi_left_Ind;unfold P';intros.
+         rewrite length_set in H1.
+         destruct (Int63Properties.reflect_eqb j i).
+          rewrite e, PArray.get_set_same.
+          apply lt_interp_aux with (2:= wf_t_i i H).
+          intros;rewrite get_set_other;trivial.
+          intros Heq;elim (not_ltb_refl i);rewrite Heq at 1;trivial.
+          rewrite H1;trivial.
+         assert (j < i).
+          assert ([|j|] <> [|i|]) by(intros Heq1;elim n;apply to_Z_inj;trivial).
+          generalize H2;unfold is_true;rewrite !ltb_spec,
+            (to_Z_add_1 _ _ H);auto with zarith.
+         rewrite get_set_other, H0;auto.
+         apply lt_interp_aux with (2:= wf_t_i j (ltb_trans _ _ _ H3 H)).
+         intros;rewrite get_set_other;trivial.
+         intros Heq;elim (not_ltb_refl i);apply ltb_trans with j;
+           [ rewrite Heq| ];trivial.
+         elim (ltb_0 _ H0).
+        apply H;apply length_t_interp.
+      Qed.
+
+      Hypothesis default_t_atom : default t_atom = Acop CO_xH.
+
+      Lemma t_interp_wf : forall i,
+         t_interp.[i] = interp_aux (PArray.get t_interp) (t_atom.[i]).
+      Proof.
+        intros i;case_eq (i< PArray.length t_atom);intros.
+        apply t_interp_wf_lt;trivial.
+        rewrite !PArray.get_outofbound;trivial.
+        rewrite default_t_atom, default_t_interp;trivial.
+        rewrite length_t_interp;trivial.
+      Qed.
+
+      Definition get_type' (t_interp':array bval) i := v_type _ _ (t_interp'.[i]).
+
+      Local Notation get_type := (get_type' t_interp).
+
+      (* If an atom is well-typed, it has an interpretation *)
+
+      Lemma check_aux_interp_aux_lt_aux : forall a h,
+        (forall j : int,
+          j < h ->
+          exists v : interp_t (v_type Typ.type interp_t (a .[ j])),
+            a .[ j] = Bval (v_type Typ.type interp_t (a .[ j])) v) ->
+        forall l, List.forallb (fun h0 : int => h0 < h) l = true ->
+          forall (f0: tval),
+            exists
+              v : interp_t
+              (v_type Typ.type interp_t
+                (let (tf, f) := f0 in
+                  apply_func (fst tf) (snd tf) f (List.map (get a) l))),
+              (let (tf, f) := f0 in
+                apply_func (fst tf) (snd tf) f (List.map (get a) l)) =
+              Bval
+              (v_type Typ.type interp_t
+                (let (tf, f) := f0 in
+                  apply_func (fst tf) (snd tf) f (List.map (get a) l))) v.
+      Proof.
+        intros a h IH; induction l as [ |j l IHl]; simpl.
+        intros _ [[[ | ] tr] f]; simpl.
+        exists f; auto.
+        exists true; auto.
+        rewrite andb_true_iff; intros [H1 H2] [[[ |A targs] tr] f]; simpl.
+        exists true; auto.
+        destruct (IH j H1) as [x Hx]; rewrite Hx; simpl; case (Typ.cast (v_type Typ.type interp_t (a .[ j])) A); simpl.
+        intro k; destruct (IHl H2 (Tval (targs,tr) (f (k interp_t x)))) as [y Hy]; simpl in Hy; rewrite Hy; simpl; exists y; auto.
+        exists true; auto.
+      Qed.
+
+      Lemma check_aux_interp_aux_lt : forall h, h < length t_atom ->
+        forall a,
+          (forall j, j < h ->
+            exists v, a.[j] = Bval (v_type _ _ (a.[j])) v) ->
+          exists v, interp_aux (get a) (t_atom.[h]) =
+            Bval (v_type _ _ (interp_aux (get a) (t_atom.[h]))) v.
+      Proof.
+        unfold wf, is_true in wf_t_i; rewrite forallbi_spec in wf_t_i.
+        intros h Hh a IH; generalize (wf_t_i h Hh).
+        case (t_atom.[h]); simpl.
+        (* Constants *)
+        intros [ | ] _; simpl.
+        exists 1%positive; auto.
+        exists 0%Z; auto.
+        (* Unary operators *)
+        intros [ | | | | ] i H; simpl; destruct (IH i H) as [x Hx]; rewrite Hx; simpl.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ i])) Typ.Tpositive); simpl; try (exists true; auto); intro k; exists ((k interp_t x)~0)%positive; auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ i])) Typ.Tpositive); simpl; try (exists true; auto); intro k; exists ((k interp_t x)~1)%positive; auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ i])) Typ.Tpositive); simpl; try (exists true; auto); intro k; exists (Zpos (k interp_t x)); auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ i])) Typ.Tpositive); simpl; try (exists true; auto); intro k; exists (Zneg (k interp_t x)); auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ i])) Typ.TZ); simpl; try (exists true; auto); intro k; exists (- k interp_t x)%Z; auto.
+        (* Binary operators *)
+        intros [ | | | | | | |A] h1 h2; simpl; rewrite andb_true_iff; intros [H1 H2]; destruct (IH h1 H1) as [x Hx]; destruct (IH h2 H2) as [y Hy]; rewrite Hx, Hy; simpl.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) Typ.TZ); simpl; try (exists true; auto); intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) Typ.TZ); simpl; try (exists true; auto); intro k2; exists (k1 interp_t x + k2 interp_t y)%Z; auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) Typ.TZ); simpl; try (exists true; auto); intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) Typ.TZ); simpl; try (exists true; auto); intro k2; exists (k1 interp_t x - k2 interp_t y)%Z; auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) Typ.TZ); simpl; try (exists true; auto); intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) Typ.TZ); simpl; try (exists true; auto); intro k2; exists (k1 interp_t x * k2 interp_t y)%Z; auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) Typ.TZ); simpl; try (exists true; auto); intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) Typ.TZ) as [k2| ]; simpl; try (exists true; reflexivity); exists (k1 interp_t x <? k2 interp_t y); auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) Typ.TZ); simpl; try (exists true; auto); intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) Typ.TZ) as [k2| ]; simpl; try (exists true; reflexivity); exists (k1 interp_t x <=? k2 interp_t y); auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) Typ.TZ); simpl; try (exists true; auto); intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) Typ.TZ) as [k2| ]; simpl; try (exists true; reflexivity); exists (k1 interp_t x >=? k2 interp_t y); auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) Typ.TZ); simpl; try (exists true; auto); intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) Typ.TZ) as [k2| ]; simpl; try (exists true; reflexivity); exists (k1 interp_t x >? k2 interp_t y); auto.
+        case (Typ.cast (v_type Typ.type interp_t (a .[ h1])) A); simpl; try (exists true; auto); intro k1; case (Typ.cast (v_type Typ.type interp_t (a .[ h2])) A) as [k2| ]; simpl; try (exists true; reflexivity); exists (Typ.i_eqb t_i A (k1 interp_t x) (k2 interp_t y)); auto.
+        (* N-ary operators *)
+        intros [A] l; assert (forall acc, List.forallb (fun h0 : int => h0 < h) l = true -> exists v, match compute_interp (get a) A acc l with | Some l0 => Bval Typ.Tbool (distinct (Typ.i_eqb t_i A) (rev l0)) | None => bvtrue end = Bval (v_type Typ.type interp_t match compute_interp (get a) A acc l with | Some l0 => Bval Typ.Tbool (distinct (Typ.i_eqb t_i A) (rev l0)) | None => bvtrue end) v); auto; induction l as [ |i l IHl]; simpl.
+        intros acc _; exists (distinct (Typ.i_eqb t_i A) (rev acc)); auto.
+        intro acc; rewrite andb_true_iff; intros [H1 H2]; destruct (IH _ H1) as [va Hva]; rewrite Hva; simpl; case (Typ.cast (v_type Typ.type interp_t (a .[ i])) A); simpl; try (exists true; auto); intro k; destruct (IHl (k interp_t va :: acc) H2) as [vb Hvb]; exists vb; auto.
+        (* Application *)
+        intros i l H; apply (check_aux_interp_aux_lt_aux a h IH l H (t_func.[i])).
+      Qed.
+
+      Lemma check_aux_interp_hatom_lt : forall h, h < length t_atom ->
+        exists v, t_interp.[h] = Bval (get_type h) v.
+      Proof.
+        set (P' i t := length t = length t_atom ->
+          forall j, j < i ->
+            exists v, t.[j] = Bval (v_type Typ.type interp_t (t.[j])) v).
+        assert (P' (length t_atom) t_interp).
+        unfold t_interp;apply foldi_left_Ind;unfold P';intros.
+        rewrite length_set in H1.
+        destruct (Int63Properties.reflect_eqb j i).
+        rewrite e, PArray.get_set_same.
+        apply check_aux_interp_aux_lt; auto.
+        rewrite H1; auto.
+        assert (j < i).
+        assert ([|j|] <> [|i|]) by(intros Heq1;elim n;apply to_Z_inj;trivial).
+        generalize H2;unfold is_true;rewrite !ltb_spec,
+          (to_Z_add_1 _ _ H);auto with zarith.
+        rewrite get_set_other;auto.
+        elim (ltb_0 _ H0).
+        apply H;apply length_t_interp.
+      Qed.
+
+      Lemma check_aux_interp_hatom : forall h,
+        exists v, t_interp.[h] = Bval (get_type h) v.
+      Proof.
+        intros i;case_eq (i< PArray.length t_atom);intros.
+        apply check_aux_interp_hatom_lt;trivial.
+        unfold get_type'; rewrite !PArray.get_outofbound;trivial.
+        rewrite default_t_interp; simpl; exists (1%positive); auto.
+        rewrite length_t_interp;trivial.
+      Qed.
+
+      Lemma check_aux_interp_aux : forall a t,
+         check_aux get_type a t ->
+         exists v, interp_aux (get t_interp) a = (Bval t v).
+      Proof.
+        intros a t; apply check_aux_interp_aux_aux; apply check_aux_interp_hatom.
+      Qed.
+
+      (* If an atom is not well-typed, its interpretation if bvtrue *)
+
+      Lemma check_aux_interp_aux_contr : forall a,
+        (forall T, check_aux get_type a T = false) ->
+        interp_aux (get t_interp) a = bvtrue.
+      Proof.
+        intros; eapply check_aux_interp_aux_contr_aux; eauto; apply check_aux_interp_hatom.
+      Qed.
+
+    End Interp_get.
+
+
+    Definition get_type t_atom :=
+      get_type' (t_interp t_atom).
+
+    Definition wt t_atom :=
+      let t_interp := t_interp t_atom in
+      let get_type := get_type' t_interp in
+        PArray.forallbi (fun i h => check_aux get_type h (get_type i)) t_atom.
+
+
+    Definition interp_hatom (t_atom : PArray.array atom) :=
+      let t_a := t_interp t_atom in
+      PArray.get t_a.
+
+    Definition interp t_atom := interp_aux (interp_hatom t_atom).
+
+    Definition interp_form_hatom t_atom : hatom -> bool :=
+      let interp := interp_hatom t_atom in
+      fun a => interp_bool (interp a).
+
+  End Typing_Interp.
+
+  Definition check_atom t_atom :=
+    match default t_atom with
+      | Acop CO_xH => wf t_atom
+      | _ => false
+    end.
+
+  Lemma check_atom_correct : forall t_atom, check_atom t_atom ->
+    wf t_atom /\ default t_atom = Acop CO_xH.
+  Proof.
+    intro t_atom; unfold check_atom; case (default t_atom); try discriminate; intro c; case c; auto; discriminate.
+  Qed.
+
+End Atom.
diff --git a/src/State.v b/src/State.v
new file mode 100644
index 0000000..d793410
--- /dev/null
+++ b/src/State.v
@@ -0,0 +1,572 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+Require Import List.
+Require Import Bool.
+Require Import Int63.
+Require Import PArray.
+
+(* Require Import AxiomesInt. *)
+
+Local Open Scope int63_scope.
+Local Open Scope array_scope.
+
+Coercion is_true (x: bool) := x = true.
+
+Set Vm Optimize.
+
+Notation var := int (only parsing).
+
+(* Variables interpretation *)
+Module Valuation.
+(* TODO : Should be var -> Prop *)
+  Definition t := var -> bool.
+  Definition wf (rho : t) : Prop := rho 0 /\ ~ rho 1.
+
+End Valuation.
+
+
+Module Var.
+
+  Definition _true : var := 0. (* true *)
+  Register _true as PrimInline.
+
+  Definition _false : var := 1. (* false *)
+
+  Definition interp (rho:Valuation.t) (x:var) : bool := rho x.
+
+  Lemma interp_true : forall rho, Valuation.wf rho -> interp rho _true.
+  Proof. intros rho [H _];exact H. Qed.
+
+  Lemma interp_false : forall rho, Valuation.wf rho -> ~ interp rho _false.
+  Proof. intros rho [_ H];exact H. Qed.
+
+End Var.
+
+Notation _lit := int (only parsing).
+
+Module Lit.
+
+  Definition is_pos (l:_lit) := is_even l.
+  Register is_pos as PrimInline.
+
+  Definition blit (l:_lit) : var := l >> 1.
+  Register blit as PrimInline.
+
+  Definition lit (x:var) : _lit := x << 1.
+  Register lit as PrimInline.
+
+  Definition neg (l:_lit) : _lit := l lxor 1.
+  Register neg as PrimInline.
+
+  Definition nlit (x:var) : _lit := neg (lit x).
+  Register nlit as PrimInline.
+
+  Definition _true : _lit := Eval compute in lit Var._true.
+  Register _true as PrimInline.
+
+  Lemma lit_true : _true = lit Var._true.
+  Proof. reflexivity. Qed.
+
+  Definition _false : _lit := Eval compute in lit Var._false.
+  Register _false as PrimInline.
+
+  Lemma lit_false : _false = lit Var._false.
+  Proof. reflexivity. Qed.
+
+  Definition eqb (l l' : _lit) := l == l'.
+  Register eqb as PrimInline.
+
+  Lemma eqb_spec : forall l l', eqb l l' = true <-> l = l'.
+  Proof eqb_spec.
+
+  Lemma neg_involutive : forall l,  neg (neg l) = l.
+  Proof.
+    unfold neg;intros; rewrite <- lxor_assoc;change (1 lxor 1) with 0;rewrite lxor_0_r;trivial.
+  Qed.
+
+  Lemma blit_neg : forall l, blit (neg l) = blit l.
+  Proof.
+    unfold blit, neg;intros l.
+    rewrite lxor_lsr, lxor_0_r;trivial.
+  Qed.
+
+  Lemma lit_blit: forall l,
+    is_pos l = true -> lit (blit l) = l.
+  Proof.
+    unfold is_pos, lit, blit;intros.
+    rewrite (bit_xor_split l) at 2.
+    rewrite is_even_bit, negb_true_iff in H;rewrite H.
+    symmetry;apply lxor_0_r.
+  Qed.
+
+  Lemma lit_blit_neg: forall l,
+    is_pos l = false -> lit (blit l) = neg l.
+  Proof.
+    unfold is_pos, lit, blit;intros.
+    rewrite (bit_xor_split l) at 2.
+    rewrite is_even_bit, negb_false_iff in H;rewrite H.
+    rewrite <- (neg_involutive ((l >> 1) << 1)) at 1;trivial.
+  Qed.
+
+  Lemma nlit_blit: forall l,
+    is_pos l = false -> nlit (blit l) = l.
+  Proof.
+    unfold nlit;intros;rewrite lit_blit_neg;auto using neg_involutive.
+  Qed.
+
+  Lemma nlit_blit_neg: forall l,
+    is_pos l = true -> nlit (blit l) = neg l.
+  Proof.
+    unfold nlit;intros;rewrite lit_blit;auto using neg_involutive.
+  Qed.
+
+  Lemma is_pos_lit : forall l,
+    is_pos (lit l) = true.
+  Proof.
+    unfold is_pos, lit;apply is_even_lsl_1.
+  Qed.
+
+  Lemma is_pos_neg : forall l,
+    is_pos (neg l) = negb (is_pos l).
+  Proof.
+    unfold neg, is_pos;intros l.
+    rewrite is_even_xor, xorb_false_r;trivial.
+  Qed.
+
+  Lemma is_pos_nlit : forall l,
+    is_pos (nlit l) = false.
+  Proof.
+    unfold nlit;intros l;rewrite is_pos_neg, is_pos_lit;trivial.
+  Qed.
+
+  Lemma is_pos_true : is_pos _true.
+  Proof. reflexivity. Qed.
+
+  Lemma is_pos_false : is_pos _false.
+  Proof. reflexivity. Qed.
+
+  Lemma blit_pos :forall a b,
+    Lit.blit a = Lit.blit b -> Lit.is_pos a = Lit.is_pos b ->
+    a = b.
+  Proof lsr_is_even_eq.
+
+  Lemma blit_lit : forall l, blit (lit (blit l)) = blit l.
+  Proof.
+    intros l;case_eq (is_pos l);intros.
+    rewrite lit_blit;trivial.
+    rewrite lit_blit_neg, blit_neg;trivial.
+  Qed.
+
+  Lemma blit_nlit : forall l, blit (nlit (blit l)) = blit l.
+  Proof.
+    intros l;case_eq (is_pos l);intros.
+    rewrite nlit_blit_neg, blit_neg;trivial.
+    rewrite nlit_blit;trivial.
+  Qed.
+
+  Lemma blit_true : blit _true = Var._true.
+  Proof. reflexivity. Qed.
+
+  Lemma blit_false : blit _false = Var._false.
+  Proof. reflexivity. Qed.
+
+                        (* Interpretation of a literal *)
+  Definition interp rho (l:_lit) :=
+    if is_pos l then Var.interp rho (blit l)
+      else negb (Var.interp rho (blit l)).
+
+  Lemma interp_true : forall rho, Valuation.wf rho -> interp rho _true.
+  Proof.
+    intros rho Hwf;unfold interp;rewrite is_pos_true, blit_true.
+    apply Var.interp_true;trivial.
+  Qed.
+
+  Lemma interp_false : forall rho, Valuation.wf rho -> ~interp rho _false.
+  Proof.
+    intros rho Hwf;unfold interp;rewrite is_pos_false, blit_false.
+    apply Var.interp_false;trivial.
+  Qed.
+
+  Lemma interp_neg : forall rho l, interp rho (neg l) = negb (interp rho l).
+  Proof.
+    intros rho l;unfold interp;rewrite is_pos_neg, blit_neg.
+    destruct (is_pos l);simpl;auto using negb_involutive.
+  Qed.
+
+  Lemma interp_lit : forall rho l, interp rho (lit (blit l)) = Var.interp rho (blit l).
+  Proof.
+    intros;unfold interp;rewrite is_pos_lit, blit_lit;trivial.
+  Qed.
+
+  Lemma interp_nlit : forall rho l, interp rho (nlit (blit l)) = negb (Var.interp rho (blit l)).
+  Proof.
+    unfold nlit;intros rho l;rewrite interp_neg, interp_lit;trivial.
+  Qed.
+
+  Lemma interp_eq_compat : forall rho1 rho2 l,
+    rho1 (blit l) = rho2 (blit l) ->
+    interp rho1 l = interp rho2 l.
+  Proof.
+    unfold interp, Var.interp;intros rho1 rho2 l Heq;rewrite Heq;trivial.
+  Qed.
+
+  Lemma lxor_neg : forall l1 l2, (l1 lxor l2 == 1) = true -> l1 = Lit.neg l2.
+  Proof.
+    unfold Lit.neg; intros l1 l2;rewrite eqb_spec;intros Heq;rewrite <- Heq.
+    rewrite lxor_comm, <- lxor_assoc, lxor_nilpotent, lxor_0_r;trivial.
+  Qed.
+
+End Lit.
+
+
+Lemma compare_spec' : forall x y,
+    match x ?= y with
+    | Lt => x < y
+    | Eq => x = y
+    | Gt => y < x
+    end.
+Proof.
+  intros x y;rewrite compare_def_spec;unfold compare_def.
+  case_eq (x < y);intros;[reflexivity | ].
+  case_eq (x == y);intros.
+  rewrite <- eqb_spec;trivial.
+  rewrite <- not_true_iff_false in H, H0.
+  unfold is_true in *;rewrite ltb_spec in H |- *;rewrite eqb_spec in H0.
+  assert ([|x|] <> [|y|]) by (intros Heq;apply H0, to_Z_inj;trivial);omega.
+Qed.
+
+
+Module C.
+
+  Definition t := list _lit.
+
+  Definition interp (rho:Valuation.t) (l:t) :=
+    List.existsb (Lit.interp rho) l.
+
+  Definition valid rho c :=
+    interp rho c = true.
+
+  Definition _true : t := Lit._true :: nil.
+
+  Definition is_false (c:t) :=
+    match c with
+      | nil => true
+      | _ => false
+    end.
+
+  Section OR.
+
+    Variable or : t -> t -> t.
+    Variable l1 : _lit.
+    Variable c1 : t.
+
+    Fixpoint or_aux (c2:t) :=
+      match c2 with
+      | nil => l1 :: c1
+      | l2::c2' =>
+        match l1 ?= l2 with
+        | Eq => l1 :: or c1 c2'
+        | Lt => l1 :: or c1 c2
+        | Gt => l2 :: or_aux c2'
+        end
+      end.
+
+    Variable rho : Valuation.t.
+    Hypothesis or_correct : forall c2,
+        interp rho (or c1 c2) = interp rho c1 || interp rho c2.
+
+    Lemma or_aux_correct : forall c2,
+      interp rho (or_aux c2) = interp rho (l1::c1) || interp rho c2.
+    Proof.
+      induction c2;simpl.
+      rewrite orb_false_r;trivial.
+      generalize (compare_spec' l1 a);destruct (l1 ?= a);intros H;simpl.
+      rewrite H;destruct (Lit.interp rho a);trivial.
+      rewrite !orb_false_l, or_correct;trivial.
+      rewrite or_correct;simpl;rewrite orb_assoc;trivial.
+      rewrite IHc2;simpl.
+      destruct (Lit.interp rho a);simpl;trivial.
+      rewrite orb_true_r;trivial.
+    Qed.
+
+  End OR.
+
+  Fixpoint or (c1 c2:t) {struct c1} : t :=
+    match c1, c2 with
+    | nil, _ => c2
+    | _, nil => c1
+    | l1::c1, l2::c2' =>
+      match compare l1 l2 with
+      | Eq => l1 :: or c1 c2'
+      | Lt => l1 :: or c1 c2
+      | Gt => l2 :: or_aux or l1 c1 c2'
+      end
+    end.
+
+  Lemma or_correct : forall rho c1 c2,
+    interp rho (or c1 c2) = interp rho c1 || interp rho c2.
+  Proof.
+    induction c1;simpl;trivial.
+    destruct c2;simpl.
+    rewrite orb_false_r;trivial.
+    generalize (compare_spec' a i);destruct (a ?= i);intros H;simpl.
+    rewrite H, IHc1;simpl;destruct (Lit.interp rho i);simpl;trivial.
+    rewrite IHc1, orb_assoc;trivial.
+    rewrite or_aux_correct;simpl;trivial.
+    destruct (Lit.interp rho i);trivial.
+    simpl;rewrite !orb_true_r;trivial.
+  Qed.
+
+  Section RESOLVE.
+
+    Variable resolve : t -> t -> t.
+    Variable l1 : _lit.
+    Variable c1 : t.
+
+    Fixpoint resolve_aux (c2:t) : t :=
+      match c2 with
+      | nil => _true
+      | l2::c2' =>
+        match compare l1 l2 with
+        | Eq => l1 :: resolve c1 c2'
+        | Lt => if l1 lxor l2 == 1 then or c1 c2' else l1 :: resolve c1 c2
+        | Gt =>
+          if l1 lxor l2 == 1 then or c1 c2' else l2 :: resolve_aux c2'
+        end
+      end.
+
+    Lemma resolve_aux_correct : forall rho,
+      (forall c2, interp rho c1 -> interp rho c2 -> interp rho (resolve c1 c2)) ->
+      interp rho (l1 :: c1) ->
+      forall c2, interp rho c2 ->
+      interp rho (resolve_aux c2).
+    Proof.
+      intros rho resolve_correct Hc1;simpl in Hc1.
+      induction c2;simpl;try discriminate.
+      generalize (compare_spec' l1 a);destruct (l1 ?= a);intros;subst;simpl.
+      simpl in Hc1;destruct (Lit.interp rho a);simpl in *;auto.
+      generalize (Lit.lxor_neg l1 a);destruct (l1 lxor a == 1);intros.
+      rewrite or_correct.
+      rewrite H1, Lit.interp_neg in Hc1;trivial;destruct (Lit.interp rho a).
+      simpl in Hc1;rewrite Hc1;trivial.
+      simpl in H0;rewrite H0, orb_true_r;trivial.
+      simpl;destruct (Lit.interp rho l1);simpl;auto.
+      generalize (Lit.lxor_neg l1 a);destruct (l1 lxor a == 1);intros.
+      rewrite or_correct.
+      rewrite H1, Lit.interp_neg in Hc1;trivial;destruct (Lit.interp rho a).
+      simpl in Hc1;rewrite Hc1;trivial.
+      simpl in H0;rewrite H0, orb_true_r;trivial.
+      simpl;destruct (Lit.interp rho a);simpl;auto.
+    Qed.
+
+  End RESOLVE.
+
+  Fixpoint resolve (c1 c2:t) {struct c1} : t :=
+    match c1, c2 with
+    | nil, _ => _true
+    | _, nil => _true
+    | l1::c1, l2::c2' =>
+      match compare l1 l2 with
+      | Eq => l1 :: resolve c1 c2'
+      | Lt => if l1 lxor l2 == 1 then or c1 c2' else l1 :: resolve c1 c2
+      | Gt =>
+        if l1 lxor l2 == 1 then or c1 c2' else l2 :: resolve_aux resolve l1 c1 c2'
+      end
+    end.
+
+  Lemma resolve_correct : forall rho c1 c2,
+    interp rho c1 -> interp rho c2 ->
+    interp rho (resolve c1 c2).
+  Proof.
+    induction c1;simpl;try discriminate.
+    destruct c2;simpl;try discriminate.
+    intros Hc1 Hc2.
+    generalize (compare_spec' a i);destruct (a ?= i);intros;subst;simpl.
+    destruct (Lit.interp rho i);simpl in *;auto.
+    generalize (Lit.lxor_neg a i);destruct (a lxor i == 1);intros.
+    rewrite or_correct.
+    rewrite H0, Lit.interp_neg in Hc1;trivial;destruct (Lit.interp rho i).
+    simpl in Hc1;rewrite Hc1;trivial.
+    simpl in Hc2;rewrite Hc2, orb_true_r;trivial.
+    simpl;destruct (Lit.interp rho a);simpl;auto.
+    generalize (Lit.lxor_neg a i);destruct (a lxor i == 1);intros.
+    rewrite or_correct.
+    rewrite H0, Lit.interp_neg in Hc1;trivial;destruct (Lit.interp rho i).
+    simpl in Hc1;rewrite Hc1;trivial.
+    simpl in Hc2;rewrite Hc2, orb_true_r;trivial.
+    simpl;destruct (Lit.interp rho i);simpl;auto using resolve_aux_correct.
+  Qed.
+
+  Lemma interp_true : forall rho, Valuation.wf rho -> interp rho _true = true.
+  Proof.
+    unfold _true, interp;intros rho Hwf;simpl.
+    rewrite Lit.interp_true;trivial.
+  Qed.
+
+  Lemma is_false_correct :
+    forall c, is_false c = true ->
+      forall rho, ~valid rho c.
+  Proof.
+    unfold valid, interp;destruct c;simpl; auto;discriminate.
+  Qed.
+
+End C.
+
+
+Notation clause_id := int (only parsing).
+
+Notation resolution := (array clause_id) (only parsing).
+
+Module S.
+
+  Definition t := array C.t.
+
+  Definition get (s:t) (cid:clause_id) := s.[cid].
+  Register get as PrimInline.
+
+  (* Do not use this function outside this module *)
+  (* expect if you are sure that [c = sort_uniq c] *)
+  Definition internal_set (s:t) (cid:clause_id) (c:C.t) : t := s.[cid <- c].
+  Register internal_set as PrimInline.
+
+  Definition make (nclauses : int) : t :=
+    PArray.make nclauses C._true.
+
+  Definition valid rho s :=
+    forall id, C.valid rho (get s id).
+
+
+  (* Specification of make *)
+
+  Lemma valid_make : forall rho nclauses,
+    Valuation.wf rho ->
+    valid rho (make nclauses).
+  Proof.
+    unfold valid, make, get;intros.
+    rewrite PArray.get_make; apply C.interp_true;trivial.
+  Qed.
+
+
+  (* Specification of get *)
+
+  Lemma valid_get : forall rho s, valid rho s ->
+    forall id, C.valid rho (get s id).
+  Proof. auto. Qed.
+
+
+  (* Specification of internal_set *)
+
+  Lemma valid_internal_set :
+    forall rho s, valid rho s ->
+      forall c, C.valid rho c ->
+        forall id, valid rho (set s id c).
+  Proof.
+    unfold valid, get, set;simpl;intros.
+    destruct (Int63Properties.reflect_eqb id id0);subst.
+    case_eq (id0 < length s);intros.
+    rewrite PArray.get_set_same;trivial.
+    rewrite PArray.get_outofbound.
+    rewrite PArray.default_set.
+    rewrite <- (PArray.get_outofbound _ _ (length s)); trivial.
+    rewrite <- not_true_iff_false, ltb_spec;auto with zarith.
+    rewrite PArray.length_set;trivial.
+    rewrite get_set_other;trivial.
+  Qed.
+
+  (* Building clause *)
+  (* Same as set but without precondition *)
+
+  (* TODO: It can be a good idea to change the insertion sort algorithm *)
+
+  Fixpoint insert l1 c :=
+   match c with
+   | nil => l1:: nil
+   | l2 :: c' =>
+     match l1 ?= l2 with
+     | Lt => if l1 lxor l2 == 1 then C._true else l1 :: c
+     | Eq => c
+     | Gt => if l1 lxor l2 == 1 then C._true else l2 :: insert l1 c'
+     end
+   end.
+
+  Fixpoint sort_uniq c :=
+    match c with
+    | nil => nil
+    | l1 :: c => insert l1 (sort_uniq c)
+    end.
+
+  Lemma insert_correct : forall rho (Hwf:Valuation.wf rho) l1 c,
+    C.interp rho (insert l1 c) = C.interp rho (l1 :: c).
+  Proof.
+    intros rho Hwf l1;induction c;simpl;trivial.
+    generalize (compare_spec' l1 a);destruct (l1 ?= a);intros;subst;simpl.
+    destruct (Lit.interp rho a);simpl in *;auto.
+    generalize (Lit.lxor_neg l1 a);destruct (l1 lxor a == 1);intros;trivial.
+    rewrite C.interp_true;trivial.
+    rewrite H0, Lit.interp_neg;trivial;destruct (Lit.interp rho a);trivial.
+    generalize (Lit.lxor_neg l1 a);destruct (l1 lxor a == 1);intros.
+    rewrite C.interp_true;trivial.
+    rewrite H0, Lit.interp_neg;trivial;destruct (Lit.interp rho a);trivial.
+    simpl;rewrite orb_assoc,(orb_comm (Lit.interp rho l1)),<-orb_assoc,IHc;trivial.
+  Qed.
+
+  Lemma sort_uniq_correct : forall rho (Hwf:Valuation.wf rho) c,
+    C.interp rho (sort_uniq c) = C.interp rho c.
+  Proof.
+    intros rho Hwf;induction c;simpl;trivial.
+    rewrite insert_correct;trivial;simpl;rewrite IHc;trivial.
+  Qed.
+
+  Definition set_clause (s:t) pos (c:C.t) : t :=
+    set s pos (sort_uniq c).
+
+  Lemma valid_set_clause :
+    forall rho s, Valuation.wf rho -> valid rho s -> forall pos c,
+      C.valid rho c -> valid rho (set_clause s pos c).
+  Proof.
+    unfold valid, get, set_clause. intros rho s Hrho Hs pos c Hc id.
+    destruct (Int63Properties.reflect_eqb pos id);subst.
+    case_eq (id < length s); intro H.
+    unfold get;rewrite PArray.get_set_same; trivial.
+    unfold C.valid;rewrite sort_uniq_correct;trivial.
+    generalize (Hs id);rewrite !PArray.get_outofbound, PArray.default_set;trivial.
+    rewrite length_set;trivial.
+    rewrite get_set_other;trivial.
+  Qed.
+
+
+  (* Resolution *)
+
+  Definition set_resolve (s:t) pos (r:resolution) : t :=
+    let len := PArray.length r in
+    if len == 0 then s
+    else
+      let c := foldi (fun i c => C.resolve (get s (r.[i])) c) 1 (len - 1)
+         (get s (r.[0])) in
+      internal_set s pos c.
+
+  Lemma valid_set_resolve :
+    forall rho s, Valuation.wf rho -> valid rho s ->
+      forall pos r, valid rho (set_resolve s pos r).
+  Proof.
+    unfold set_resolve; intros rho s Hrho Hv pos r.
+    destruct (Int63Properties.reflect_eqb (length r) 0);[trivial | ].
+    apply valid_internal_set;trivial.
+    apply foldi_ind;auto.
+    intros i c _ _ Hc;apply C.resolve_correct;auto;apply Hv.
+  Qed.
+
+End S.
diff --git a/src/Trace.v b/src/Trace.v
new file mode 100644
index 0000000..d369958
--- /dev/null
+++ b/src/Trace.v
@@ -0,0 +1,567 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+Add LoadPath "." as SMTCoq.
+Add LoadPath "cnf" as SMTCoq.cnf.
+Add LoadPath "euf" as SMTCoq.euf.
+Add LoadPath "lia" as SMTCoq.lia.
+Add LoadPath "spl" as SMTCoq.spl.
+
+Require Import Bool Int63 PArray.
+Require Import Misc State SMT_terms Cnf Euf Lia Syntactic Arithmetic Operators.
+
+Local Open Scope array_scope.
+Local Open Scope int63_scope.
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+Set Vm Optimize.
+Section trace.
+
+  (* We are given a certificate, a checker for it (that modifies a
+     state), and a proof that the checker is correct: the state it
+     returns must be valid and well-formed. *)
+
+  Variable step : Type.
+
+  Variable check_step : S.t -> step -> S.t.
+
+  Variable rho : Valuation.t.
+
+  (* We use [array array step] to allow bigger trace *)
+  Definition _trace_ := array (array step).
+
+  (* A checker for such a trace *)
+
+  Variable is_false : C.t -> bool.
+  Hypothesis is_false_correct : forall c, is_false c -> ~ C.interp rho c.
+
+  Definition _checker_ (s: S.t) (t: _trace_) (confl:clause_id) : bool :=
+    let s' := PArray.fold_left (fun s a => PArray.fold_left check_step s a) s t in
+    is_false (S.get s' confl).
+  Register _checker_ as PrimInline.
+
+  (* For debugging *)
+  (*
+
+  Variable check_step_debug : S.t -> step -> option S.t.
+
+  Definition _checker_debug_ (s: S.t) (t: _trace_) : sum S.t ((int*int)*S.t) :=
+    let s' := PArray.foldi_left (fun i s a => PArray.foldi_left (fun j s' a' =>
+      match s' with
+        | inl s'' =>
+          match check_step_debug s'' a' with
+            | Some s''' => inl s'''
+            | None => inr ((i,j),s'')
+          end
+        | u => u
+      end) s a) (inl s) t in
+    s'.
+
+  Definition _checker_partial_ (s: S.t) (t: _trace_) (max:int) : S.t :=
+    PArray.fold_left (fun s a => PArray.foldi_left (fun i s' a' => if i < max then check_step s' a' else s') s a) s t.
+  *)
+
+  (* Proof of its partial correction: if it returns true, then the
+     initial state is not valid *)
+
+  Hypothesis valid_check_step :
+    forall s, S.valid rho s -> forall c, S.valid rho (check_step s c).
+
+  Lemma _checker__correct :
+    forall s, forall t confl, _checker_ s t confl-> ~ (S.valid rho s).
+  Proof.
+    unfold _checker_.
+    intros s t' cid Hf Hv.
+    apply (is_false_correct Hf).
+    apply S.valid_get.
+    apply PArray.fold_left_ind; auto.
+    intros a i _ Ha;apply PArray.fold_left_ind;trivial.
+    intros a0 i0 _ H1;auto.
+  Qed.
+ 
+End trace.
+
+
+(* Application to resolution *)
+
+Module Sat_Checker.
+
+ Inductive step :=
+   | Res (_:int) (_:resolution).
+
+ Definition resolution_checker s t :=
+    _checker_ (fun s (st:step) => let (pos, r) := st in S.set_resolve s pos r) s t.
+
+ Lemma resolution_checker_correct :
+    forall rho, Valuation.wf rho ->
+    forall s t cid, resolution_checker C.is_false s t cid->
+     ~S.valid rho s.
+ Proof.
+   intros rho Hwr;apply _checker__correct.
+   intros; apply C.is_false_correct; trivial.
+   intros s Hv (pos, r);apply S.valid_set_resolve;trivial. 
+ Qed.
+   
+ (** Application to Zchaff *)
+ Definition dimacs := PArray.array (PArray.array _lit).
+
+ Definition C_interp_or rho c := 
+   afold_left _ _ false orb (Lit.interp rho) c.
+
+ Lemma C_interp_or_spec : forall rho c,
+   C_interp_or rho c = C.interp rho (to_list c).
+ Proof.
+   intros rho c; unfold C_interp_or; case_eq (C.interp rho (to_list c)).
+   unfold C.interp; rewrite List.existsb_exists; intros [x [H1 H2]]; destruct (In_to_list _ _ H1) as [i [H3 H4]]; subst x; apply (afold_left_orb_true _ i); auto.
+   unfold C.interp; intro H; apply afold_left_orb_false; intros i H1; case_eq (Lit.interp rho (c .[ i])); auto; intro Heq; assert (H2: exists x, List.In x (to_list c) /\ Lit.interp rho x = true).
+   exists (c.[i]); split; auto; apply to_list_In; auto.
+   rewrite <- List.existsb_exists in H2; rewrite H2 in H; auto.
+Qed.
+
+ Definition valid rho (d:dimacs) :=
+   afold_left _ _ true andb (C_interp_or rho) d.
+
+ Lemma valid_spec : forall rho d,
+   valid rho d <->
+   (forall i : int, i < length d -> C.interp rho (PArray.to_list (d.[i]))).
+ Proof.
+   unfold valid; intros rho d; split; intro H.
+   intros i Hi; case_eq (C.interp rho (to_list (d .[ i]))); try reflexivity.
+   intro Heq; erewrite afold_left_andb_false in H; try eassumption.
+   rewrite C_interp_or_spec; auto.
+   apply afold_left_andb_true; try assumption; intros i Hi; rewrite C_interp_or_spec; apply H; auto.
+ Qed.
+
+ Inductive certif :=
+   | Certif : int -> _trace_ step -> clause_id -> certif.
+
+ Definition add_roots s (d:dimacs) := 
+   PArray.foldi_right (fun i c s => S.set_clause s i (PArray.to_list c)) d s.
+
+ Definition checker (d:dimacs) (c:certif) :=
+   let (nclauses, t, confl_id) := c in
+   resolution_checker C.is_false (add_roots (S.make nclauses) d) t confl_id.
+
+ Lemma valid_add_roots : forall rho, Valuation.wf rho ->
+    forall d s, valid rho d -> S.valid rho s ->
+    S.valid rho (add_roots s d).
+ Proof.
+   intros rho Hwr d s Hd Hs; unfold add_roots; apply (PArray.foldi_right_Ind _ _ (fun _ a => S.valid rho a)); auto; intros a i Hlt Hv; apply S.valid_set_clause; auto; rewrite valid_spec in Hd; apply Hd; auto.
+ Qed.
+
+ Lemma checker_correct : forall d c,
+    checker d c = true ->
+    forall rho, Valuation.wf rho -> ~valid rho d.
+ Proof.
+   unfold checker; intros d (nclauses, t, confl_id) Hc rho Hwf Hv.
+   apply (resolution_checker_correct Hwf Hc).
+   apply valid_add_roots; auto.
+   apply S.valid_make; auto.
+ Qed.
+
+ Definition interp_var rho x := 
+   match compare x 1 with
+   | Lt => true
+   | Eq => false
+   | Gt => rho (x - 1) 
+     (* This allows to have variable starting at 1 in the interpretation as in dimacs files *)
+   end.
+
+ Lemma theorem_checker : 
+   forall d c,
+     checker d c = true ->
+     forall rho, ~valid (interp_var rho) d.
+ Proof.
+  intros d c H rho;apply checker_correct with c;trivial.
+  split;compute;trivial;discriminate.
+ Qed.
+
+End Sat_Checker.
+
+Module Cnf_Checker.
+  
+  Inductive step :=
+  | Res (pos:int) (res:resolution)
+  | ImmFlatten (pos:int) (cid:clause_id) (lf:_lit) 
+  | CTrue (pos:int)       
+  | CFalse (pos:int)
+  | BuildDef (pos:int) (l:_lit)
+  | BuildDef2 (pos:int) (l:_lit)
+  | BuildProj (pos:int) (l:_lit) (i:int)
+  | ImmBuildDef (pos:int) (cid:clause_id)
+  | ImmBuildDef2 (pos:int) (cid:clause_id)
+  | ImmBuildProj (pos:int) (cid:clause_id) (i:int).
+
+  Local Open Scope list_scope.
+
+  Local Notation check_flatten t_form := (check_flatten t_form (fun i1 i2 => i1 == i2) (fun _ _ => false)) (only parsing).
+
+  Definition step_checker t_form s (st:step) :=
+    match st with
+    | Res pos res => S.set_resolve s pos res
+    | ImmFlatten pos cid lf => S.set_clause s pos (check_flatten t_form s cid lf) 
+    | CTrue pos => S.set_clause s pos Cnf.check_True
+    | CFalse pos => S.set_clause s pos Cnf.check_False
+    | BuildDef pos l => S.set_clause s pos (check_BuildDef t_form l)
+    | BuildDef2 pos l => S.set_clause s pos (check_BuildDef2 t_form l)
+    | BuildProj pos l i => S.set_clause s pos (check_BuildProj t_form l i)
+    | ImmBuildDef pos cid => S.set_clause s pos (check_ImmBuildDef t_form s cid) 
+    | ImmBuildDef2 pos cid => S.set_clause s pos (check_ImmBuildDef2 t_form s cid)
+    | ImmBuildProj pos cid i => S.set_clause s pos (check_ImmBuildProj t_form s cid i) 
+    end.
+
+  Lemma step_checker_correct : forall rho t_form,
+    Form.check_form t_form ->
+    forall s, S.valid (Form.interp_state_var rho t_form) s ->
+      forall st : step, S.valid (Form.interp_state_var rho t_form)
+        (step_checker t_form s st).
+  Proof.
+    intros rho t_form Ht s H; destruct (Form.check_form_correct rho _ Ht) as [[Ht1 Ht2] Ht3]; intros [pos res|pos cid lf|pos|pos|pos l|pos l|pos l i|pos cid|pos cid|pos cid i]; simpl; try apply S.valid_set_clause; auto.
+    apply S.valid_set_resolve; auto.
+    apply valid_check_flatten; auto; try discriminate; intros a1 a2; unfold is_true; rewrite Int63Properties.eqb_spec; intro; subst a1; auto.
+    apply valid_check_True; auto.
+    apply valid_check_False; auto.
+    apply valid_check_BuildDef; auto.
+    apply valid_check_BuildDef2; auto.
+    apply valid_check_BuildProj; auto.
+    apply valid_check_ImmBuildDef; auto.
+    apply valid_check_ImmBuildDef2; auto.
+    apply valid_check_ImmBuildProj; auto.
+  Qed.
+
+  Definition cnf_checker t_form s t :=
+    _checker_ (step_checker t_form) s t.
+
+  Lemma cnf_checker_correct : forall rho t_form,
+    Form.check_form t_form -> forall s t confl,
+      cnf_checker t_form C.is_false s t confl ->
+      ~ (S.valid (Form.interp_state_var rho t_form) s).
+  Proof.
+    unfold cnf_checker; intros rho t_form Ht; apply _checker__correct.
+    intros c H; apply C.is_false_correct; auto.
+    apply step_checker_correct; auto.
+  Qed.
+
+
+ Inductive certif :=
+   | Certif : int -> _trace_ step -> int -> certif.
+
+ Definition checker t_form l (c:certif) :=
+   let (nclauses, t, confl) := c in   
+   Form.check_form t_form &&
+   cnf_checker t_form C.is_false (S.set_clause (S.make nclauses) 0 (l::nil)) t confl.
+
+ Lemma checker_correct : forall t_form l c,
+    checker t_form l c = true ->
+    forall rho, ~ (Lit.interp (Form.interp_state_var rho t_form) l).
+ Proof.
+   unfold checker; intros t_form l (nclauses, t, confl); unfold is_true; rewrite andb_true_iff; intros [H1 H2] rho H; apply (cnf_checker_correct (rho:=rho) H1 H2); destruct (Form.check_form_correct rho _ H1) as [[Ht1 Ht2] Ht3]; apply S.valid_set_clause; auto.
+   apply S.valid_make; auto.
+   unfold C.valid; simpl; rewrite H; auto.
+ Qed.
+
+ Definition checker_b t_form l (b:bool) (c:certif) :=
+   let l := if b then Lit.neg l else l in
+   checker t_form l c.
+
+ Lemma checker_b_correct : forall t_var t_form l b c,
+    checker_b t_form l b c = true ->
+    Lit.interp (Form.interp_state_var (PArray.get t_var) t_form) l = b.
+ Proof.
+   unfold checker_b; intros t_var t_form l b c; case b; case_eq (Lit.interp (Form.interp_state_var (get t_var) t_form) l); auto; intros H1 H2; elim (checker_correct H2 (rho:=get t_var)); auto; rewrite Lit.interp_neg, H1; auto.
+ Qed.
+
+ Definition checker_eq t_form l1 l2 l (c:certif) :=
+   negb (Lit.is_pos l) && 
+   match t_form.[Lit.blit l] with
+   | Form.Fiff l1' l2' => (l1 == l1') && (l2 == l2')
+   | _ => false
+   end && 
+   checker t_form l c.
+
+ Lemma checker_eq_correct : forall t_var t_form l1 l2 l c,
+   checker_eq t_form l1 l2 l c = true ->
+    Lit.interp (Form.interp_state_var (PArray.get t_var) t_form) l1 =
+    Lit.interp (Form.interp_state_var (PArray.get t_var) t_form) l2.
+ Proof.
+   unfold checker_eq; intros t_var t_form l1 l2 l c; rewrite !andb_true_iff; case_eq (t_form .[ Lit.blit l]); [intros _ _|intros _|intros _|intros _ _ _|intros _ _|intros _ _|intros _ _|intros _ _ _|intros l1' l2' Heq|intros _ _ _ _]; intros [[H1 H2] H3]; try discriminate; rewrite andb_true_iff in H2; rewrite !Int63Properties.eqb_spec in H2; destruct H2 as [H2 H4]; subst l1' l2'; case_eq (Lit.is_pos l); intro Heq'; rewrite Heq' in H1; try discriminate; clear H1; assert (H:PArray.default t_form = Form.Ftrue /\ Form.wf t_form).
+   unfold checker in H3; destruct c as (nclauses, t, confl); rewrite andb_true_iff in H3; destruct H3 as [H3 _]; destruct (Form.check_form_correct (get t_var) _ H3) as [[Ht1 Ht2] Ht3]; split; auto.
+   destruct H as [H1 H2]; case_eq (Lit.interp (Form.interp_state_var (get t_var) t_form) l1); intro Heq1; case_eq (Lit.interp (Form.interp_state_var (get t_var) t_form) l2); intro Heq2; auto; elim (checker_correct H3 (rho:=get t_var)); unfold Lit.interp; rewrite Heq'; unfold Var.interp; rewrite Form.wf_interp_form; auto; rewrite Heq; simpl; rewrite Heq1, Heq2; auto.
+ Qed.
+
+End Cnf_Checker.
+
+
+(* Application to resolution + cnf justification + euf + lia *)
+
+(* Require Cnf.Cnf. *)
+(* Require Euf.Euf. *)
+(* Require Lia.Lia. *)
+
+Module Euf_Checker.
+
+  Inductive step :=
+  | Res (pos:int) (res:resolution)
+  | ImmFlatten (pos:int) (cid:clause_id) (lf:_lit)
+  | CTrue (pos:int)
+  | CFalse (pos:int)
+  | BuildDef (pos:int) (l:_lit)
+  | BuildDef2 (pos:int) (l:_lit)
+  | BuildProj (pos:int) (l:_lit) (i:int)
+  | ImmBuildDef (pos:int) (cid:clause_id)
+  | ImmBuildDef2 (pos:int) (cid:clause_id)
+  | ImmBuildProj (pos:int) (cid:clause_id) (i:int)
+  | EqTr (pos:int) (l:_lit) (fl: list _lit)
+  | EqCgr (pos:int) (l:_lit) (fl: list (option _lit))
+  | EqCgrP (pos:int) (l1:_lit) (l2:_lit) (fl: list (option _lit))
+  | LiaMicromega (pos:int) (cl:list _lit) (c:list ZMicromega.ZArithProof)
+  | LiaDiseq (pos:int) (l:_lit)
+  | SplArith (pos:int) (orig:clause_id) (res:_lit) (l:list ZMicromega.ZArithProof)
+  | SplDistinctElim (pos:int) (orig:clause_id) (res:_lit).
+
+  Local Open Scope list_scope.
+
+  Local Notation check_flatten t_atom t_form := (check_flatten t_form (check_hatom t_atom) (check_neg_hatom t_atom)) (only parsing).
+
+  Definition step_checker t_atom t_form s (st:step) :=
+    match st with
+      | Res pos res => S.set_resolve s pos res
+      | ImmFlatten pos cid lf => S.set_clause s pos (check_flatten t_atom t_form s cid lf)
+      | CTrue pos => S.set_clause s pos Cnf.check_True
+      | CFalse pos => S.set_clause s pos Cnf.check_False
+      | BuildDef pos l => S.set_clause s pos (check_BuildDef t_form l)
+      | BuildDef2 pos l => S.set_clause s pos (check_BuildDef2 t_form l)
+      | BuildProj pos l i => S.set_clause s pos (check_BuildProj t_form l i)
+      | ImmBuildDef pos cid => S.set_clause s pos (check_ImmBuildDef t_form s cid)
+      | ImmBuildDef2 pos cid => S.set_clause s pos (check_ImmBuildDef2 t_form s cid)
+      | ImmBuildProj pos cid i => S.set_clause s pos (check_ImmBuildProj t_form s cid i)
+      | EqTr pos l fl => S.set_clause s pos (check_trans t_form t_atom l fl)
+      | EqCgr pos l fl => S.set_clause s pos (check_congr t_form t_atom l fl)
+      | EqCgrP pos l1 l2 fl => S.set_clause s pos (check_congr_pred t_form t_atom l1 l2 fl)
+      | LiaMicromega pos cl c => S.set_clause s pos (check_micromega t_form t_atom cl c)
+      | LiaDiseq pos l => S.set_clause s pos (check_diseq t_form t_atom l)
+      | SplArith pos orig res l => S.set_clause s pos (check_spl_arith t_form t_atom (S.get s orig) res l)
+      | SplDistinctElim pos orig res => S.set_clause s pos (check_distinct_elim t_form t_atom (S.get s orig) res)
+    end.
+
+  Lemma step_checker_correct : forall t_i t_func t_atom t_form,
+    let rho := Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form in
+      Form.check_form t_form -> Atom.check_atom t_atom ->
+      Atom.wt t_i t_func t_atom ->
+      forall s, S.valid rho s ->
+        forall st : step, S.valid rho (step_checker t_atom t_form s st).
+  Proof.
+    intros t_i t_func t_atom t_form rho H1 H2 H10 s Hs. destruct (Form.check_form_correct (Atom.interp_form_hatom t_i t_func t_atom) _ H1) as [[Ht1 Ht2] Ht3]. destruct (Atom.check_atom_correct _ H2) as [Ha1 Ha2]. intros [pos res|pos cid lf|pos|pos|pos l|pos l|pos l i|pos cid|pos cid|pos cid i|pos l fl|pos l fl|pos l1 l2 fl|pos cl c|pos l|pos orig res l|pos orig res]; simpl; try apply S.valid_set_clause; auto.
+    apply S.valid_set_resolve; auto.
+    apply valid_check_flatten; auto; intros h1 h2 H.
+    rewrite (Syntactic.check_hatom_correct_bool _ _ _ Ha1 Ha2 _ _ H); auto.
+    rewrite (Syntactic.check_neg_hatom_correct_bool _ _ _ H10 Ha1 Ha2 _ _ H); auto.
+    apply valid_check_True; auto.
+    apply valid_check_False; auto.
+    apply valid_check_BuildDef; auto.
+    apply valid_check_BuildDef2; auto.
+    apply valid_check_BuildProj; auto.
+    apply valid_check_ImmBuildDef; auto.
+    apply valid_check_ImmBuildDef2; auto.
+    apply valid_check_ImmBuildProj; auto.
+    apply valid_check_trans; auto.
+    apply valid_check_congr; auto.
+    apply valid_check_congr_pred; auto.
+    apply valid_check_micromega; auto.
+    apply valid_check_diseq; auto.
+    apply valid_check_spl_arith; auto.
+    apply valid_check_distinct_elim; auto.
+  Qed.
+
+  Definition euf_checker t_atom t_form s t :=
+    _checker_ (step_checker t_atom t_form) s t.
+
+  Lemma euf_checker_correct : forall t_i t_func t_atom t_form,
+    let rho := Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form in
+      Form.check_form t_form -> Atom.check_atom t_atom ->
+      Atom.wt t_i t_func t_atom ->
+      forall s t confl,
+        euf_checker t_atom t_form C.is_false s t confl ->
+        ~ (S.valid rho s).
+  Proof.
+    unfold euf_checker; intros t_i t_func t_atom t_form rho H1 H2 H10; apply _checker__correct.
+    intros c H; apply C.is_false_correct; auto.
+    apply step_checker_correct; auto.
+  Qed.
+
+  Inductive certif :=
+  | Certif : int -> _trace_ step -> int -> certif.
+
+  Definition add_roots s d used_roots :=
+    match used_roots with
+      | Some ur => PArray.foldi_right (fun i c_index s =>
+        let c := if c_index < length d then (d.[c_index])::nil else C._true in
+          S.set_clause s i c) ur s
+      | None => PArray.foldi_right (fun i c s => S.set_clause s i (c::nil)) d s
+    end.
+
+  Definition valid t_i t_func t_atom t_form d :=
+    let rho := Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form in
+    afold_left _ _ true andb (Lit.interp rho) d.
+
+  Lemma add_roots_correct : forall t_i t_func t_atom t_form,
+    let rho := Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form in
+      Form.check_form t_form -> Atom.check_atom t_atom ->
+      Atom.wt t_i t_func t_atom ->
+      forall s d used_roots, S.valid rho s -> valid t_func t_atom t_form d ->
+        S.valid rho (add_roots s d used_roots).
+  Proof.
+    intros t_i t_func t_atom t_form rho H1 H2 H10 s d used_roots H3; unfold valid; intro H4; pose (H5 := (afold_left_andb_true_inv _ _ _ H4)); unfold add_roots; assert (Valuation.wf rho) by (destruct (Form.check_form_correct (Atom.interp_form_hatom t_i t_func t_atom) _ H1) as [_ H]; auto); case used_roots.
+    intro ur; apply (foldi_right_Ind _ _ (fun _ a => S.valid rho a)); auto; intros a i H6 Ha; apply S.valid_set_clause; auto; case_eq (ur .[ i] < length d).
+    intro; unfold C.valid; simpl; rewrite H5; auto.
+    intros; apply C.interp_true; auto.
+    apply (foldi_right_Ind _ _ (fun _ a => S.valid rho a)); auto; intros a i H6 Ha; apply S.valid_set_clause; auto; unfold C.valid; simpl; rewrite H5; auto.
+  Qed.
+
+  Definition checker t_i t_func t_atom t_form d used_roots (c:certif) :=
+    let (nclauses, t, confl) := c in
+    Form.check_form t_form && Atom.check_atom t_atom &&
+    Atom.wt t_i t_func t_atom &&
+    euf_checker t_atom t_form C.is_false (add_roots (S.make nclauses) d used_roots) t confl.
+  Implicit Arguments checker [].
+
+  Lemma checker_correct : forall t_i t_func t_atom t_form d used_roots c,
+    checker t_i t_func t_atom t_form d used_roots c = true ->
+    ~ valid t_func t_atom t_form d.
+  Proof.
+    unfold checker; intros t_i t_func t_atom t_form d used_roots (nclauses, t, confl); rewrite !andb_true_iff; intros [[[H1 H2] H10] H3] H; eelim euf_checker_correct; try eassumption; apply add_roots_correct; try eassumption; apply S.valid_make; destruct (Form.check_form_correct (Atom.interp_form_hatom t_i t_func t_atom) _ H1) as [_ H4]; auto.
+  Qed.
+
+  Definition checker_b t_i t_func t_atom t_form l (b:bool) (c:certif) :=
+    let l := if b then Lit.neg l else l in
+    let (nclauses,_,_) := c in
+    checker t_i t_func t_atom t_form (PArray.make nclauses l) None c.
+
+  Lemma checker_b_correct : forall t_i t_func t_atom t_form l b c,
+    checker_b t_func t_atom t_form l b c = true ->
+    Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form) l = b.
+  Proof.
+   unfold checker_b; intros t_i t_func t_atom t_form l b (nclauses, t, confl); case b; intros H2; case_eq (Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form) l); auto; intros H1; elim (checker_correct H2 (t_func:=t_func)); auto; unfold valid; apply afold_left_andb_true; intros i Hi; rewrite get_make; auto; rewrite Lit.interp_neg, H1; auto.
+ Qed.
+
+  Definition checker_eq t_i t_func t_atom t_form l1 l2 l (c:certif) :=
+    negb (Lit.is_pos l) &&
+    match t_form.[Lit.blit l] with
+      | Form.Fiff l1' l2' => (l1 == l1') && (l2 == l2')
+      | _ => false
+    end &&
+    let (nclauses,_,_) := c in
+    checker t_i t_func t_atom t_form (PArray.make nclauses l) None c.
+
+  Lemma checker_eq_correct : forall t_i t_func t_atom t_form l1 l2 l c,
+    checker_eq t_func t_atom t_form l1 l2 l c = true ->
+    Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form) l1 =
+    Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form) l2.
+  Proof.
+   unfold checker_eq; intros t_i t_func t_atom t_form l1 l2 l (nclauses, t, confl); rewrite !andb_true_iff; case_eq (t_form .[ Lit.blit l]); [intros _ _|intros _|intros _|intros _ _ _|intros _ _|intros _ _|intros _ _|intros _ _ _|intros l1' l2' Heq|intros _ _ _ _]; intros [[H1 H2] H3]; try discriminate; rewrite andb_true_iff in H2; rewrite !Int63Properties.eqb_spec in H2; destruct H2 as [H2 H4]; subst l1' l2'; case_eq (Lit.is_pos l); intro Heq'; rewrite Heq' in H1; try discriminate; clear H1; assert (H:PArray.default t_form = Form.Ftrue /\ Form.wf t_form).
+   unfold checker in H3; rewrite !andb_true_iff in H3; destruct H3 as [[[H3 _] _] _]; destruct (Form.check_form_correct (Atom.interp_form_hatom t_i t_func t_atom) _ H3) as [[Ht1 Ht2] Ht3]; split; auto.
+   destruct H as [H1 H2]; case_eq (Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form) l1); intro Heq1; case_eq (Lit.interp (Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form) l2); intro Heq2; auto; elim (checker_correct H3 (t_func:=t_func)); unfold valid; apply afold_left_andb_true; intros i Hi; rewrite get_make; unfold Lit.interp; rewrite Heq'; unfold Var.interp; rewrite Form.wf_interp_form; auto; rewrite Heq; simpl; rewrite Heq1, Heq2; auto.
+ Qed.
+
+
+  (* Checker for extraction, that does not know the evaluation contexts.
+     TODO: show that there always exists a well-typed evaluation
+     context. *)
+
+  Definition checker_ext t_atom t_form d used_roots (c:certif) :=
+    let (nclauses, t, confl) := c in
+    Form.check_form t_form && Atom.check_atom t_atom &&
+    euf_checker t_atom t_form C.is_false (add_roots (S.make nclauses) d used_roots) t confl.
+  Implicit Arguments checker_ext [].
+
+  Lemma checker_ext_correct : forall t_atom t_form d used_roots c,
+    checker_ext t_atom t_form d used_roots c = true ->
+    forall t_i t_func, Atom.wt t_i t_func t_atom ->
+                       ~ valid t_func t_atom t_form d.
+  Proof.
+    unfold checker_ext; intros t_atom t_form d used_roots (nclauses, t, confl); rewrite !andb_true_iff; intros [[H1 H2] H3]; intros t_i t_func H10 H; eelim euf_checker_correct; try eassumption; apply add_roots_correct; try eassumption; apply S.valid_make; destruct (Form.check_form_correct (Atom.interp_form_hatom t_i t_func t_atom) _ H1) as [_ H4]; auto.
+  Qed.
+
+  (* For debugging *)
+  (*
+  Fixpoint is__true (c:C.t) :=
+    match c with
+      | cons l q => if (l == 0) then true else is__true q
+      | _ => false
+    end.
+
+  Definition step_checker_debug t_atom t_form s (st:step) :=
+    match st with
+      | Res pos res =>
+        let s' := S.set_resolve s pos res in
+          if is__true (s'.[pos]) then None else Some s'
+      | ImmFlatten pos cid lf =>
+        let c := check_flatten t_atom t_form s cid lf in
+          if is__true c then None else Some (S.set_clause s pos c)
+      | CTrue pos => Some (S.set_clause s pos Cnf.check_True)
+      | CFalse pos => Some (S.set_clause s pos Cnf.check_False)
+      | BuildDef pos l =>
+        let c := check_BuildDef t_form l in
+          if is__true c then None else Some (S.set_clause s pos c)
+      | BuildDef2 pos l =>
+        let c := check_BuildDef2 t_form l in
+          if is__true c then None else Some (S.set_clause s pos c)
+      | BuildProj pos l i =>
+        let c := check_BuildProj t_form l i in
+          if is__true c then None else Some (S.set_clause s pos c)
+      | ImmBuildDef pos cid =>
+        let c := check_ImmBuildDef t_form s cid in
+          if is__true c then None else Some (S.set_clause s pos c)
+      | ImmBuildDef2 pos cid =>
+        let c := check_ImmBuildDef2 t_form s cid in
+          if is__true c then None else Some (S.set_clause s pos c)
+      | ImmBuildProj pos cid i =>
+        let c := check_ImmBuildProj t_form s cid i in
+          if is__true c then None else Some (S.set_clause s pos c)
+      | EqTr pos l fl =>
+        let c := check_trans t_form t_atom l fl in
+          if is__true c then None else Some (S.set_clause s pos c)
+      | EqCgr pos l fl =>
+        let c := check_congr t_form t_atom l fl in
+          if is__true c then None else Some (S.set_clause s pos c)
+      | EqCgrP pos l1 l2 fl =>
+        let c := check_congr_pred t_form t_atom l1 l2 fl in
+          if is__true c then None else Some (S.set_clause s pos c)
+      | LiaMicromega pos cl c =>
+        let c := check_micromega t_form t_atom cl c in
+          if is__true c then None else Some (S.set_clause s pos c)
+      | LiaDiseq pos l =>
+        let c := check_diseq t_form t_atom l in
+          if is__true c then None else Some (S.set_clause s pos c)
+      | SplArith pos orig res l =>
+        let c := check_spl_arith t_form t_atom (S.get s orig) res l in
+          if is__true c then None else Some (S.set_clause s pos c)
+      | SplDistinctElim pos input res =>
+        let c := check_distinct_elim t_form t_atom (S.get s input) res in
+          if is__true c then None else Some (S.set_clause s pos c)
+    end.
+
+  Definition euf_checker_debug t_atom t_form s t :=
+    _checker_debug_ (step_checker_debug t_atom t_form) s t.
+
+  Definition euf_checker_partial t_atom t_form s t :=
+    _checker_partial_ (step_checker t_atom t_form) s t.
+  *)
+
+End Euf_Checker.
+
+
+Unset Implicit Arguments.
diff --git a/src/cnf/Cnf.v b/src/cnf/Cnf.v
new file mode 100644
index 0000000..d918dab
--- /dev/null
+++ b/src/cnf/Cnf.v
@@ -0,0 +1,419 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+Require Import PArray List Bool.
+(* Add LoadPath ".." as SMTCoq. *)
+Require Import Misc State SMT_terms.
+
+Import Form.
+
+Local Open Scope array_scope.
+Local Open Scope int63_scope.
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+Definition or_of_imp args :=
+  let last := PArray.length args - 1 in
+  PArray.mapi (fun i l => if i == last then l else Lit.neg l) args.
+Register or_of_imp as PrimInline.
+
+Lemma length_or_of_imp : forall args,
+  PArray.length (or_of_imp args) = PArray.length args.
+Proof. intro; apply length_mapi. Qed.
+
+Lemma get_or_of_imp : forall args i,
+  i < (PArray.length args) - 1 -> (or_of_imp args).[i] = Lit.neg (args.[i]).
+Proof.
+  unfold or_of_imp; intros args i H; case_eq (0 < PArray.length args).
+  intro Heq; rewrite get_mapi.
+  replace (i == PArray.length args - 1) with false; auto; symmetry; rewrite eqb_false_spec; intro; subst i; unfold is_true in H; rewrite ltb_spec, (to_Z_sub_1 _ _ Heq) in H; omega.
+  rewrite ltb_spec; unfold is_true in H; rewrite ltb_spec, (to_Z_sub_1 _ _ Heq) in H; omega.
+  rewrite ltb_negb_geb; case_eq (PArray.length args <= 0); try discriminate; intros Heq _; assert (H1: PArray.length args = 0).
+  apply to_Z_inj; rewrite leb_spec in Heq; destruct (to_Z_bounded (PArray.length args)) as [H1 _]; change [|0|] with 0%Z in *; omega.
+  rewrite !get_outofbound.
+  rewrite default_mapi, H1; auto.
+  rewrite H1; case_eq (i < 0); auto; intro H2; eelim ltb_0; eassumption.
+  rewrite length_mapi, H1; case_eq (i < 0); auto; intro H2; eelim ltb_0; eassumption.
+Qed.
+
+Lemma get_or_of_imp2 : forall args i, 0 < PArray.length args ->
+  i = (PArray.length args) - 1 -> (or_of_imp args).[i] = args.[i].
+Proof.
+  unfold or_of_imp; intros args i Heq Hi; rewrite get_mapi; subst i.
+  rewrite Int63Axioms.eqb_refl; auto.
+  rewrite ltb_spec, (to_Z_sub_1 _ _ Heq); omega.
+Qed.
+
+
+Section CHECKER.
+
+  Variable t_form : PArray.array form.
+  Local Notation get_hash := (PArray.get t_form) (only parsing).
+  Variable s : S.t.
+
+
+  (*  * true             : {true}  *)
+
+  Definition check_True := C._true.
+
+
+  (* * false             : {(not false)} *)
+
+  Definition check_False  := Lit.neg (Lit._false)::nil.
+
+
+  (* * and_neg          : {(and a_1 ... a_n) (not a_1) ... (not a_n)}
+     * or_pos           : {(not (or a_1 ... a_n)) a_1 ... a_n} 
+     * implies_pos      : {(not (implies a b)) (not a) b}
+     * xor_pos1         : {(not (xor a b)) a b}
+     * xor_neg1         : {(xor a b) a (not b)}
+     * equiv_pos1       : {(not (iff a b)) a (not b)}
+     * equiv_neg1       : {(iff a b) (not a) (not b)}
+     * ite_pos1         : {(not (if_then_else a b c)) a c}
+     * ite_neg1         : {(if_then_else a b c) a (not c)} *)
+
+  Definition check_BuildDef l :=
+    match get_hash (Lit.blit l) with
+    | Fand args => 
+      if Lit.is_pos l then l :: List.map Lit.neg (PArray.to_list args) 
+      else C._true
+    | For args =>
+      if Lit.is_pos l then C._true
+      else l :: PArray.to_list args
+    | Fimp args =>
+      if Lit.is_pos l then C._true
+      else
+        let args := or_of_imp args in
+        l :: PArray.to_list args
+    | Fxor a b =>
+      if Lit.is_pos l then l::a::Lit.neg b::nil 
+      else l::a::b::nil
+    | Fiff a b =>
+      if Lit.is_pos l then l::Lit.neg a::Lit.neg b::nil
+      else l::a::Lit.neg b::nil
+    | Fite a b c =>
+      if Lit.is_pos l then l::a::Lit.neg c::nil
+      else l::a::c::nil
+    | _ => C._true
+    end.
+
+ 
+  (* * not_and           : {(not (and a_1 ... a_n))} --> {(not a_1) ... (not a_n)}
+     * or                : {(or a_1 ... a_n)} --> {a_1 ... a_n}
+     * implies           : {(implies a b)} --> {(not a) b}
+     * xor1              : {(xor a b)} --> {a b}
+     * not_xor1          : {(not (xor a b))} --> {a (not b)}
+     * equiv2            : {(iff a b)} --> {a (not b)}
+     * not_equiv2        : {(not (iff a b))} --> {(not a) (not b)}
+     * ite1              : {(if_then_else a b c)} --> {a c}
+     * not_ite1          : {(not (if_then_else a b c))} --> {a (not c)} *)
+
+  Definition check_ImmBuildDef pos :=
+    match S.get s pos with
+    | l::nil =>
+      match get_hash (Lit.blit l) with
+      | Fand args => 
+        if Lit.is_pos l then C._true
+        else List.map Lit.neg (PArray.to_list args) 
+      | For args =>
+        if Lit.is_pos l then PArray.to_list args
+        else C._true
+      | Fimp args =>
+        if Lit.is_pos l then 
+          let args := or_of_imp args in
+          PArray.to_list args
+        else C._true
+      | Fxor a b =>
+        if Lit.is_pos l then a::b::nil
+        else a::Lit.neg b::nil 
+      | Fiff a b =>
+        if Lit.is_pos l then a::Lit.neg b::nil
+        else Lit.neg a::Lit.neg b::nil
+      | Fite a b c =>
+        if Lit.is_pos l then a::c::nil
+        else a::Lit.neg c::nil
+      | _ => C._true
+      end
+    | _ => C._true
+    end.
+
+
+  (* * xor_pos2          : {(not (xor a b)) (not a) (not b)}
+     * xor_neg2          : {(xor a b) (not a) b}
+     * equiv_pos2        : {(not (iff a b)) (not a) b}
+     * equiv_neg2        : {(iff a b) a b}
+     * ite_pos2          : {(not (if_then_else a b c)) (not a) b}
+     * ite_neg2          : {(if_then_else a b c) (not a) (not b)} *)
+
+  Definition check_BuildDef2 l :=
+    match get_hash (Lit.blit l) with
+    | Fxor a b =>
+      if Lit.is_pos l then l::Lit.neg a::b::nil
+      else l::Lit.neg a::Lit.neg b::nil
+    | Fiff a b =>
+      if Lit.is_pos l then l::a::b::nil
+      else l::Lit.neg a::b::nil
+    | Fite a b c =>
+      if Lit.is_pos l then l::Lit.neg a::Lit.neg b::nil
+      else l::Lit.neg a::b::nil
+    | _ => C._true
+    end.
+
+
+  (* * xor2              : {(xor a b)} --> {(not a) (not b)}
+     * not_xor2          : {(not (xor a b))} --> {(not a) b}
+     * equiv1            : {(iff a b)} --> {(not a) b}
+     * not_equiv1        : {(not (iff a b))} --> {a b}
+     * ite2              : {(if_then_else a b c)} --> {(not a) b}
+     * not_ite2          : {(not (if_then_else a b c))} --> {(not a) (not b)}
+     *)
+
+  Definition check_ImmBuildDef2 pos :=
+    match S.get s pos with
+    | l::nil =>
+      match get_hash (Lit.blit l) with
+      | Fxor a b =>
+        if Lit.is_pos l then Lit.neg a::Lit.neg b::nil
+        else Lit.neg a::b::nil
+      | Fiff a b =>
+        if Lit.is_pos l then Lit.neg a::b::nil
+        else a::b::nil
+      | Fite a b c =>
+        if Lit.is_pos l then Lit.neg a::b::nil
+        else Lit.neg a::Lit.neg b::nil
+      | _ => C._true
+      end
+    | _ => C._true
+    end.
+
+ 
+  (* * or_neg           : {(or a_1 ... a_n) (not a_i)}
+     * and_pos          : {(not (and a_1 ... a_n)) a_i} 
+     * implies_neg1     : {(implies a b) a}
+     * implies_neg2     : {(implies a b) (not b)} *)
+
+  Definition check_BuildProj l i :=
+    let x := Lit.blit l in
+    match get_hash x with
+    | For args =>
+      if i < PArray.length args then Lit.lit x::Lit.neg (args.[i])::nil
+      else C._true
+    | Fand args =>
+      if i < PArray.length args then Lit.nlit x::(args.[i])::nil
+      else C._true
+    | Fimp args =>
+      let len := PArray.length args in
+      if i < len then
+        if i == len - 1 then Lit.lit x::Lit.neg (args.[i])::nil
+        else Lit.lit x::(args.[i])::nil
+      else C._true
+    | _ => C._true
+    end.
+
+
+  (* * and               : {(and a_1 ... a_n)} --> {a_i} 
+     * not_or            : {(not (or a_1 ... a_n))} --> {(not a_i)}
+     * not_implies1      : {(not (implies a b))} --> {a}
+     * not_implies2      : {(not (implies a b))} --> {(not b)} *)
+
+  Definition check_ImmBuildProj pos i := 
+    match S.get s pos with
+    | l::nil =>
+      let x := Lit.blit l in
+      match get_hash x with
+      | For args =>
+        if (i < PArray.length args) && negb (Lit.is_pos l) then Lit.neg (args.[i])::nil
+        else C._true
+      | Fand args =>
+        if (i < PArray.length args) && (Lit.is_pos l) then (args.[i])::nil
+        else C._true
+      | Fimp args =>
+        let len := PArray.length args in
+        if (i < len) && negb (Lit.is_pos l) then
+          if i == len - 1 then Lit.neg (args.[i])::nil
+          else (args.[i])::nil
+        else C._true
+      | _ => C._true
+      end
+    | _ => C._true
+    end.
+
+  (** The correctness proofs *)
+
+  Variable interp_atom : atom -> bool.
+
+  Hypothesis Hch_f : check_form t_form.
+
+  Local Notation rho := (Form.interp_state_var interp_atom t_form).
+
+  Let Hwfrho : Valuation.wf rho.
+  Proof.
+    destruct (check_form_correct interp_atom _ Hch_f) as (_, H);exact H. 
+  Qed.
+
+  Lemma valid_check_True : C.valid rho check_True.
+  Proof. 
+    apply C.interp_true;trivial.
+  Qed.
+
+  Lemma valid_check_False : C.valid rho check_False.
+  Proof.
+    unfold check_False, C.valid;simpl.
+    rewrite Lit.interp_neg.
+    assert (W:= Lit.interp_false _ Hwfrho).
+    destruct (Lit.interp rho Lit._false);trivial;elim W;red;trivial.
+  Qed.
+
+  Let rho_interp : forall x : int,
+    rho x = interp interp_atom t_form (t_form.[ x]).
+  Proof.
+    destruct (check_form_correct interp_atom _ Hch_f) as ((H,H0), _).
+    intros x;apply wf_interp_form;trivial.
+  Qed.
+
+  Ltac tauto_check :=
+   try (rewrite !Lit.interp_neg);
+   repeat 
+     match goal with |- context [Lit.interp rho ?x] => 
+     destruct (Lit.interp rho x);trivial end.
+
+  Axiom afold_left_and : forall a,
+    afold_left bool int true andb (Lit.interp rho) a =
+    List.forallb (Lit.interp rho) (to_list a).
+
+  Axiom afold_left_or : forall a,
+    afold_left bool int false orb (Lit.interp rho) a =
+    C.interp rho (to_list a).
+
+  Axiom afold_right_impb : forall a,
+    (afold_right bool int true implb (Lit.interp rho) a) =
+    C.interp rho (to_list (or_of_imp a)).
+
+  Axiom Cinterp_neg : forall cl,
+     C.interp rho (map Lit.neg cl) = negb (forallb (Lit.interp rho) cl).  
+
+  Lemma valid_check_BuildDef : forall l, C.valid rho (check_BuildDef l).
+  Proof.
+   unfold check_BuildDef,C.valid;intros l.
+   case_eq (t_form.[Lit.blit l]);intros;auto using C.interp_true;
+   case_eq (Lit.is_pos l);intros Heq;auto using C.interp_true;simpl;
+   unfold Lit.interp at 1;rewrite Heq;unfold Var.interp; rewrite rho_interp, H;simpl;
+   tauto_check.
+   rewrite afold_left_and, Cinterp_neg;apply orb_negb_r.
+   rewrite afold_left_or, orb_comm;apply orb_negb_r.
+   rewrite afold_right_impb, orb_comm;apply orb_negb_r.
+  Qed.
+
+  Lemma valid_check_BuildDef2 : forall l, C.valid rho (check_BuildDef2 l).
+  Proof.
+   unfold check_BuildDef2,C.valid;intros l.
+   case_eq (t_form.[Lit.blit l]);intros;auto using C.interp_true;
+   case_eq (Lit.is_pos l);intros Heq;auto using C.interp_true;simpl;
+   unfold Lit.interp at 1;rewrite Heq;unfold Var.interp; rewrite rho_interp, H;simpl;
+   tauto_check.
+  Qed.
+
+  Lemma valid_check_BuildProj : forall l i, C.valid rho (check_BuildProj l i).
+  Proof.
+   unfold check_BuildProj,C.valid;intros l i.
+   case_eq (t_form.[Lit.blit l]);intros;auto using C.interp_true;
+   case_eq (i < PArray.length a);intros Hlt;auto using C.interp_true;simpl.
+
+   rewrite Lit.interp_nlit;unfold Var.interp;rewrite rho_interp, orb_false_r, H.
+   simpl;rewrite afold_left_and.
+   case_eq (forallb (Lit.interp rho) (to_list a));trivial.
+   rewrite forallb_forall;intros Heq;rewrite Heq;trivial.
+   apply to_list_In; auto.
+   rewrite Lit.interp_lit;unfold Var.interp;rewrite rho_interp, orb_false_r, H.
+   simpl;rewrite afold_left_or.
+      
+   unfold C.interp;case_eq (existsb (Lit.interp rho) (to_list a));trivial.
+   rewrite <-not_true_iff_false, existsb_exists, Lit.interp_neg.
+   case_eq (Lit.interp rho (a .[ i]));trivial.
+   intros Heq Hex;elim Hex;exists (a.[i]);split;trivial.
+   apply to_list_In; auto.
+   case_eq (i == PArray.length a - 1);intros Heq;simpl;
+   rewrite Lit.interp_lit;unfold Var.interp;rewrite rho_interp, H;simpl;
+   rewrite afold_right_impb; case_eq (C.interp rho (to_list (or_of_imp a)));trivial;
+   unfold C.interp;rewrite <-not_true_iff_false, existsb_exists;
+   try rewrite Lit.interp_neg; case_eq (Lit.interp rho (a .[ i]));trivial;
+   intros Heq' Hex;elim Hex.
+   exists (a.[i]);split;trivial.
+   assert (H1: 0 < PArray.length a) by (apply (leb_ltb_trans _ i _); auto; apply leb_0); rewrite Int63Properties.eqb_spec in Heq; rewrite <- (get_or_of_imp2 H1 Heq); apply to_list_In; rewrite length_or_of_imp; auto.
+   exists (Lit.neg (a.[i]));rewrite Lit.interp_neg, Heq';split;trivial.
+   assert (H1: i < PArray.length a - 1 = true) by (rewrite ltb_spec, (to_Z_sub_1 _ _ Hlt); rewrite eqb_false_spec in Heq; assert (H1: [|i|] <> ([|PArray.length a|] - 1)%Z) by (intro H1; apply Heq, to_Z_inj; rewrite (to_Z_sub_1 _ _ Hlt); auto); rewrite ltb_spec in Hlt; omega); rewrite <- (get_or_of_imp H1); apply to_list_In; rewrite length_or_of_imp; auto.
+  Qed.
+
+  Hypothesis Hs : S.valid rho s.
+
+  Lemma valid_check_ImmBuildDef : forall cid,
+     C.valid rho (check_ImmBuildDef cid).
+  Proof.
+   unfold check_ImmBuildDef,C.valid;intros cid.
+   generalize (Hs cid);unfold C.valid.
+   destruct (S.get s cid) as [ | l [ | _l _c]];auto using C.interp_true.
+   simpl;unfold Lit.interp, Var.interp; rewrite !rho_interp;
+   destruct (t_form.[Lit.blit l]);auto using C.interp_true;
+   case_eq (Lit.is_pos l);intros Heq;auto using C.interp_true;simpl;
+   tauto_check.
+   rewrite afold_left_and, Cinterp_neg, orb_false_r;trivial.
+   rewrite afold_left_or, orb_false_r;trivial.
+   rewrite afold_right_impb, orb_false_r;trivial.
+  Qed.
+
+  Lemma valid_check_ImmBuildDef2 : forall cid, C.valid rho (check_ImmBuildDef2 cid).
+  Proof.
+    unfold check_ImmBuildDef2,C.valid;intros cid.
+    generalize (Hs cid);unfold C.valid.
+    destruct (S.get s cid) as [ | l [ | _l _c]];auto using C.interp_true.
+    simpl;unfold Lit.interp, Var.interp; rewrite !rho_interp;
+    destruct (t_form.[Lit.blit l]);auto using C.interp_true;
+    case_eq (Lit.is_pos l);intros Heq;auto using C.interp_true;simpl;
+    tauto_check.
+  Qed.
+
+  Lemma valid_check_ImmBuildProj : forall cid i, C.valid rho (check_ImmBuildProj cid i).
+  Proof.
+   unfold check_ImmBuildProj,C.valid;intros cid i.
+   generalize (Hs cid);unfold C.valid.
+   destruct (S.get s cid) as [ | l [ | _l _c]];auto using C.interp_true.
+   simpl;unfold Lit.interp, Var.interp; rewrite !rho_interp;
+     destruct (t_form.[Lit.blit l]);auto using C.interp_true;
+       case_eq (i < PArray.length a); intros Hlt;auto using C.interp_true;
+       case_eq (Lit.is_pos l);intros Heq;auto using C.interp_true;simpl;
+       rewrite !orb_false_r.  
+   rewrite afold_left_and.
+   rewrite forallb_forall;intros H;apply H;auto.
+   apply to_list_In; auto.
+   rewrite negb_true_iff, <-not_true_iff_false, afold_left_or.
+   unfold C.interp;rewrite existsb_exists, Lit.interp_neg.
+   case_eq (Lit.interp rho (a .[ i]));trivial.
+   intros Heq' Hex;elim Hex;exists (a.[i]);split;trivial.
+   apply to_list_In; auto.
+   rewrite negb_true_iff, <-not_true_iff_false, afold_right_impb.
+   case_eq (i == PArray.length a - 1);intros Heq';simpl;
+     unfold C.interp;simpl;try rewrite Lit.interp_neg;rewrite orb_false_r,
+   existsb_exists;case_eq (Lit.interp rho (a .[ i]));trivial;
+   intros Heq2 Hex;elim Hex.
+   exists (a.[i]);split;trivial.
+   assert (H1: 0 < PArray.length a) by (apply (leb_ltb_trans _ i _); auto; apply leb_0); rewrite Int63Properties.eqb_spec in Heq'; rewrite <- (get_or_of_imp2 H1 Heq'); apply to_list_In; rewrite length_or_of_imp; auto.
+   exists (Lit.neg (a.[i]));rewrite Lit.interp_neg, Heq2;split;trivial.
+   assert (H1: i < PArray.length a - 1 = true) by (rewrite ltb_spec, (to_Z_sub_1 _ _ Hlt); rewrite eqb_false_spec in Heq'; assert (H1: [|i|] <> ([|PArray.length a|] - 1)%Z) by (intro H1; apply Heq', to_Z_inj; rewrite (to_Z_sub_1 _ _ Hlt); auto); rewrite ltb_spec in Hlt; omega); rewrite <- (get_or_of_imp H1); apply to_list_In; rewrite length_or_of_imp; auto.
+  Qed.
+
+End CHECKER.
+  
+Unset Implicit Arguments.
diff --git a/src/euf/Euf.v b/src/euf/Euf.v
new file mode 100644
index 0000000..9b86bf3
--- /dev/null
+++ b/src/euf/Euf.v
@@ -0,0 +1,538 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+(* Add LoadPath ".." as SMTCoq. *)
+Require Import Bool List Int63 PArray.
+Require Import State SMT_terms.
+
+Local Open Scope array_scope.
+Local Open Scope int63_scope.
+
+Section certif.
+
+  Variable t_form : PArray.array Form.form.
+  Variable t_atom : PArray.array Atom.atom.
+
+  Local Notation get_atom := (PArray.get t_atom) (only parsing).
+  Local Notation get_form := (PArray.get t_form) (only parsing).
+
+  Definition get_eq (x:var) (f : int -> int -> C.t) :=
+    match get_form x with
+    | Form.Fatom xa =>
+      match get_atom xa with
+      | Atom.Abop (Atom.BO_eq _) a b => f a b
+      | _ => C._true
+      end
+    | _ => C._true
+    end.
+  Register get_eq as PrimInline.
+
+  Fixpoint check_trans_aux (t1 t2:int)
+      (eqs:list _lit) (res:_lit) (clause:C.t) : C.t :=
+    match eqs with
+    | nil =>
+      let xres := Lit.blit res in
+      get_eq xres (fun t1' t2' =>
+         if ((t1 == t1') && (t2 == t2')) ||
+            ((t1 == t2') && (t2 == t1')) then
+            Lit.lit xres :: clause
+         else C._true)
+    | leq::eqs =>
+      let xeq := Lit.blit leq in
+      get_eq xeq (fun t t' =>
+          if t2 == t' then
+            check_trans_aux t1 t eqs res (Lit.nlit xeq :: clause)
+          else
+            if t2 == t then
+              check_trans_aux t1 t' eqs res (Lit.nlit xeq :: clause)
+            else
+              if t1 == t' then
+                check_trans_aux t t2 eqs res (Lit.nlit xeq :: clause)
+              else
+                if t1 == t then
+                  check_trans_aux t' t2 eqs res (Lit.nlit xeq :: clause)
+                else C._true)
+    end.
+
+  Definition check_trans (res:_lit) (eqs:list _lit) : C.t :=
+    match eqs with
+    | nil =>
+      let xres := Lit.blit res in
+        get_eq xres (fun t1 t2 =>
+         if t1 == t2 then Lit.lit xres :: nil else C._true)
+    | leq :: eqs =>
+      let xeq := Lit.blit leq in
+      get_eq xeq
+        (fun t1 t2 => check_trans_aux t1 t2 eqs res (Lit.nlit xeq :: nil))
+    end.
+
+  Fixpoint build_congr (eqs:list (option _lit))
+       (l r:list int) (c:C.t) {struct eqs} :=
+    match eqs, l, r with
+    | nil, nil, nil => c
+    | eq::eqs, t1::l, t2::r =>
+      match eq with
+      | None => if t1 == t2 then build_congr eqs l r c else C._true
+      | Some leq =>
+        let xeq := Lit.blit leq in
+        get_eq xeq (fun t1' t2' =>
+          if ((t1 == t1') && (t2 == t2')) ||
+             ((t1 == t2') && (t2 == t1')) then
+            build_congr eqs l r (Lit.nlit xeq :: c)
+          else C._true)
+      end
+    | _, _, _ => C._true
+    end.
+
+  Definition check_congr (leq:_lit) (eqs:list (option _lit)) :=
+    let xeq := Lit.blit leq in
+    get_eq xeq (fun t1 t2 =>
+      match get_atom t1, get_atom t2 with
+      | Atom.Abop o1 a1 a2, Atom.Abop o2 b1 b2 =>
+        if Atom.bop_eqb o1 o2 then
+           build_congr eqs (a1::a2::nil) (b1::b2::nil) (Lit.lit xeq :: nil)
+        else C._true
+      | Atom.Auop o1 a, Atom.Auop o2 b =>
+        if Atom.uop_eqb o1 o2 then
+           build_congr eqs (a::nil) (b::nil) (Lit.lit xeq :: nil)
+        else C._true
+      | Atom.Aapp f1 args1, Atom.Aapp f2 args2 =>
+        if f1 == f2 then build_congr eqs args1 args2 (Lit.lit xeq :: nil)
+        else C._true
+      | _, _ => C._true
+      end).
+
+  Definition check_congr_pred (PA:_lit) (PB:_lit) (eqs:list (option _lit)) :=
+    let xPA := Lit.blit PA in
+    let xPB := Lit.blit PB in
+    match get_form xPA, get_form xPB with
+    | Form.Fatom pa, Form.Fatom pb =>
+      match get_atom pa, get_atom pb with
+      | Atom.Abop o1 a1 a2, Atom.Abop o2 b1 b2 =>
+         if Atom.bop_eqb o1 o2 then
+          build_congr eqs
+          (a1::a2::nil) (b1::b2::nil) (Lit.nlit xPA :: Lit.lit xPB :: nil)
+        else C._true
+      | Atom.Auop o1 a, Atom.Auop o2 b =>
+         if Atom.uop_eqb o1 o2 then
+          build_congr eqs
+          (a::nil) (b::nil) (Lit.nlit xPA :: Lit.lit xPB :: nil)
+        else C._true
+      | Atom.Aapp p a, Atom.Aapp p' b =>
+        if p == p' then
+          build_congr eqs a b (Lit.nlit xPA :: Lit.lit xPB :: nil)
+        else C._true
+      | _, _ => C._true
+      end
+    | _, _ => C._true
+    end.
+
+  Section Proof.
+
+    Variables (t_i : array typ_eqb)
+              (t_func : array (Atom.tval t_i))
+              (ch_atom : Atom.check_atom t_atom)
+              (ch_form : Form.check_form t_form)
+              (wt_t_atom : Atom.wt t_i t_func t_atom).
+
+    Local Notation interp_hatom :=
+      (Atom.interp_hatom t_i t_func t_atom).
+
+    Local Notation interp_form_hatom :=
+      (Atom.interp_form_hatom t_i t_func t_atom).
+
+    Local Notation rho :=
+      (Form.interp_state_var interp_form_hatom t_form).
+
+    Let wf_t_atom : Atom.wf t_atom.
+    Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed.
+
+    Let def_t_atom : default t_atom = Atom.Acop Atom.CO_xH.
+    Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed.
+
+    Let def_t_form : default t_form = Form.Ftrue.
+    Proof.
+      destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [H _]; destruct H; auto.
+    Qed.
+
+    Let wf_t_form : Form.wf t_form.
+    Proof.
+      destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [H _]; destruct H; auto.
+    Qed.
+
+    Let wf_rho : Valuation.wf rho.
+    Proof.
+      destruct (Form.check_form_correct interp_form_hatom _ ch_form); auto.
+    Qed.
+
+    Lemma valid_C_true : C.interp rho C._true.
+    Proof.
+      apply C.interp_true.
+      destruct (Form.check_form_correct interp_form_hatom _ ch_form);trivial.
+    Qed.
+    Hint Resolve valid_C_true.
+
+    Local Notation interp := (Atom.interp t_i t_func t_atom).
+
+    Lemma wf_interp_form : forall x,
+       rho x = Form.interp interp_form_hatom t_form (t_form.[x]).
+    Proof.
+      destruct (Form.check_form_correct interp_form_hatom _ ch_form).
+      destruct H; intros x;rewrite Form.wf_interp_form;trivial.
+    Qed.
+
+    Local Notation get_type :=
+        (Atom.get_type t_i t_func t_atom).
+
+    Local Notation check_type :=
+        (Atom.check_aux t_i t_func get_type).
+
+    Lemma get_eq_interp :
+      forall (l:_lit) (f:Atom.hatom -> Atom.hatom -> C.t),
+       (forall xa, t_form.[Lit.blit l] = Form.Fatom xa ->
+        forall t a b, t_atom.[xa] = Atom.Abop (Atom.BO_eq t) a b ->
+        rho (Lit.blit l) =
+          Atom.interp_bool t_i
+           (Atom.apply_binop t_i t t Typ.Tbool (Typ.i_eqb t_i t)
+              (interp_hatom a) (interp_hatom b)) ->
+        Typ.eqb (get_type a) t -> Typ.eqb (get_type b) t ->
+        C.interp rho (f a b)) ->
+      C.interp rho (get_eq (Lit.blit l) f).
+    Proof.
+      intros l f Hf;unfold get_eq.
+      case_eq (t_form.[Lit.blit l]);trivial;intros.
+      case_eq (t_atom.[i]);trivial;intros.
+      destruct b;trivial.
+      generalize wt_t_atom;unfold Atom.wt;unfold is_true;
+       rewrite PArray.forallbi_spec;intros.
+      assert (i < length t_atom).
+        apply PArray.get_not_default_lt.
+        rewrite H0, def_t_atom;discriminate.
+      apply H1 in H2;clear H1;rewrite H0 in H2;simpl in H2.
+      rewrite !andb_true_iff in H2;decompose [and] H2;clear H2.
+      apply Hf with (2:= H0);trivial.
+      rewrite wf_interp_form, H;simpl.
+      unfold Atom.interp_form_hatom, Atom.interp_hatom at 1;simpl.
+      rewrite Atom.t_interp_wf, H0;simpl;trivial.
+    Qed.
+
+    Let tunicity : forall A T U, Typ.eqb A T -> Typ.eqb A U -> T = U.
+    Proof. intros A T U; rewrite !Typ.eqb_spec; intros; subst T U; auto. Qed.
+
+    Ltac tunicity :=
+      match goal with
+      | [ H1 : is_true (Typ.eqb ?a ?t1),
+          H2 : is_true (Typ.eqb ?a ?t2) |- _ ] =>
+        assert (W:= tunicity _ _ _ H1 H2);try subst
+      | _ => idtac
+      end.
+
+    Lemma interp_binop_eqb_sym :
+      forall u a b,
+      Atom.apply_binop t_i u u Typ.Tbool (Typ.i_eqb t_i u) a b =
+      Atom.apply_binop t_i u u Typ.Tbool (Typ.i_eqb t_i u) b a.
+    Proof.
+      unfold Atom.apply_binop;simpl;intros u (ta,va) (tb,vb).
+      destruct (Typ.cast ta u);destruct (Typ.cast tb u);trivial.
+      apply f_equal; apply eq_true_iff_eq.
+      match goal with |- ?x = _ <-> ?y = _ =>
+         change (is_true x <-> is_true y) end.
+      rewrite !Typ.i_eqb_spec;split;auto.
+    Qed.
+
+    Lemma interp_binop_eqb_trans:
+      forall u a b c,
+      Typ.eqb (get_type a) u -> Typ.eqb (get_type b) u -> Typ.eqb (get_type c) u ->
+      Atom.interp_bool t_i
+        (Atom.apply_binop t_i u u Typ.Tbool (Typ.i_eqb t_i u)
+           (interp_hatom a) (interp_hatom b)) ->
+      Atom.interp_bool t_i
+        (Atom.apply_binop t_i u u Typ.Tbool (Typ.i_eqb t_i u)
+           (interp_hatom b) (interp_hatom c)) ->
+      Atom.interp_bool t_i
+        (Atom.apply_binop t_i u u Typ.Tbool (Typ.i_eqb t_i u)
+           (interp_hatom a) (interp_hatom c)).
+    Proof.
+      intros u a b c Ha Hb Hc.
+      generalize (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom a), (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom b), (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom c). rewrite Typ.eqb_spec in Ha. rewrite Typ.eqb_spec in Hb. rewrite Typ.eqb_spec in Hc. unfold Atom.get_type in Ha, Hb, Hc. rewrite Ha, Hb, Hc. intros [va HHa] [vb HHb] [vc HHc].
+      unfold Atom.interp_hatom.
+      rewrite HHa, HHb, HHc;simpl;rewrite Typ.cast_refl.
+      unfold Atom.interp_bool;simpl.
+      rewrite !Typ.i_eqb_spec;intros HH;rewrite HH;trivial.
+    Qed.
+
+    Lemma check_trans_aux_correct :
+      forall eqs u t1 t2 res c,
+       Typ.eqb (get_type t1) u -> Typ.eqb (get_type t2) u ->
+       Atom.interp_bool t_i (interp (Atom.Abop (Atom.BO_eq u) t1 t2)) \/
+       C.interp rho c ->
+       C.interp rho (check_trans_aux t1 t2 eqs res c).
+    Proof.
+      induction eqs;simpl;intros.
+      apply get_eq_interp;intros.
+      match goal with |- context [if ?b then _ else _] => case_eq b end;
+       intros;trivial.
+      simpl;rewrite Lit.interp_lit;unfold Var.interp.
+      destruct H1;[ | rewrite H1,orb_true_r;auto].
+      rewrite orb_true_iff, !andb_true_iff in H7;destruct H7 as
+        [[H7 H8] | [H7 H8]].
+      rewrite eqb_spec in H7. rewrite eqb_spec in H8. subst.
+      tunicity. rewrite H4, H1;auto.
+      rewrite eqb_spec in H7. rewrite eqb_spec in H8. subst.
+      tunicity;rewrite interp_binop_eqb_sym in H1;rewrite H4, H1;auto.
+      apply get_eq_interp;intros.
+      destruct (Int63Properties.reflect_eqb t2 b);subst;tunicity.
+      apply (IHeqs u);trivial.
+      simpl;unfold is_true;rewrite orb_true_iff.
+      rewrite Lit.interp_nlit;unfold Var.interp.
+      (* Attention ici on utilise la decidabilit'e de l'egalit'e sur u *)
+      case_eq (rho (Lit.blit a));[rewrite H4; intros | simpl;auto].
+      destruct H1;[left | auto].
+      apply interp_binop_eqb_trans with (4:= H1);trivial.
+      rewrite interp_binop_eqb_sym;trivial.
+      destruct (Int63Properties.reflect_eqb t2 a0); subst;tunicity.
+      apply (IHeqs u);trivial.
+      simpl;unfold is_true;rewrite orb_true_iff.
+      rewrite Lit.interp_nlit;unfold Var.interp.
+      (* Attention ici on utilise la decidabilit'e de l'egalit'e sur u *)
+      case_eq (rho (Lit.blit a));[rewrite H4; intros | simpl;auto].
+      destruct H1;[left | auto].
+      apply interp_binop_eqb_trans with (4:= H1);trivial.
+      destruct (Int63Properties.reflect_eqb t1 b);subst;tunicity.
+      apply (IHeqs u);trivial.
+      simpl;unfold is_true;rewrite orb_true_iff.
+      rewrite Lit.interp_nlit;unfold Var.interp.
+      (* Attention ici on utilise la decidabilit'e de l'egalit'e sur u *)
+      case_eq (rho (Lit.blit a));[rewrite H4; intros | simpl;auto].
+      destruct H1;[left | auto].
+      apply interp_binop_eqb_trans with (5:= H1);trivial.
+      destruct (Int63Properties.reflect_eqb t1 a0);[subst;tunicity|auto].
+      apply (IHeqs u);trivial.
+      simpl;unfold is_true;rewrite orb_true_iff.
+      rewrite Lit.interp_nlit;unfold Var.interp.
+      (* Attention ici on utilise la decidabilit'e de l'egalit'e sur u *)
+      case_eq (rho (Lit.blit a));[rewrite H4; intros | simpl;auto].
+      destruct H1;[left | auto].
+      apply interp_binop_eqb_trans with (5:= H1);trivial.
+      rewrite interp_binop_eqb_sym;trivial.
+    Qed.
+
+    Lemma valid_check_trans :
+      forall res eqs,
+       C.interp rho (check_trans res eqs).
+    Proof.
+      unfold check_trans;intros res [ | leq eqs].
+      apply get_eq_interp;intros.
+      destruct (Int63Properties.reflect_eqb a b).
+      unfold C.interp; simpl; rewrite orb_false_r.
+      unfold Lit.interp; simpl; rewrite Lit.is_pos_lit.
+      unfold Var.interp; simpl; rewrite Lit.blit_lit.
+      rewrite H1.
+      unfold Atom.interp_bool; simpl.
+      rewrite e; simpl.
+      generalize (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom b). rewrite Typ.eqb_spec in H3. unfold Atom.get_type in H3. rewrite H3. intros [vb HHb].
+      unfold Atom.interp_hatom.
+      rewrite HHb;simpl;rewrite Typ.cast_refl;simpl.
+      rewrite !Typ.i_eqb_spec;trivial.
+      auto.
+      apply get_eq_interp;intros.
+      apply check_trans_aux_correct with t;trivial.
+      simpl;rewrite Lit.interp_nlit;unfold Var.interp. rewrite <- H1.
+      (* Attention ici on utilise la decidabilit'e de l'egalit'e sur t *)
+      destruct (rho (Lit.blit leq));auto.
+    Qed.
+
+    Inductive Forall2 A B (P:A->B->Prop) : list A -> list B -> Prop :=
+    | Forall2_nil : Forall2 A B P nil nil
+    | Forall2_cons :
+       forall a b la lb, P a b -> Forall2 A B P la lb ->
+         Forall2 A B P (a::la) (b::lb).
+
+    Lemma build_congr_correct : forall lp l r c,
+      (Forall2 _ _ (fun a b => interp_hatom a = interp_hatom b) l r -> C.interp rho c) ->
+      C.interp rho (build_congr lp l r c).
+    Proof.
+      induction lp;destruct l;destruct r;simpl;trivial;intros.
+      apply H;constructor.
+      destruct a.
+      apply get_eq_interp;intros.
+      match goal with |- context [if ?x then _ else _] =>
+       case_eq x;intros;auto end.
+      apply IHlp;simpl;intros.
+      rewrite Lit.interp_nlit;unfold Var.interp.
+      case_eq (rho (Lit.blit i1));intros;simpl;[ | auto].
+      apply H;constructor;trivial.
+      generalize (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom a), (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom b). rewrite Typ.eqb_spec in H3. rewrite Typ.eqb_spec in H4. unfold Atom.get_type in H3, H4. rewrite H3,H4. intros [va HHa] [vb HHb].
+      revert H7;rewrite H2;unfold Atom.apply_binop; simpl.
+      unfold Atom.interp_hatom.
+      rewrite HHa, HHb;simpl;rewrite Typ.cast_refl;simpl.
+      intros W;change (is_true (Typ.i_eqb t_i t va vb)) in W.
+      rewrite Typ.i_eqb_spec in W.
+      rewrite orb_true_iff, !andb_true_iff in H5;destruct H5 as
+        [ [H5 H7] | [H5 H7]].
+      rewrite eqb_spec in H5. rewrite eqb_spec in H7. subst.
+      rewrite HHa, HHb;trivial.
+      rewrite eqb_spec in H5. rewrite eqb_spec in H7. subst.
+      rewrite HHa, HHb;trivial.
+      destruct (Int63Properties.reflect_eqb i i0);[subst | auto].
+      apply IHlp;intros;apply H;constructor;auto.
+    Qed.
+
+    Lemma valid_check_congr :
+       forall leq eqs,
+          C.interp rho (check_congr leq eqs).
+    Proof.
+      unfold check_congr;intros leq eqs;apply get_eq_interp;intros.
+      case_eq (t_atom .[ a]);intros;auto;
+      case_eq (t_atom .[ b]);intros;auto.
+      (* uop *)
+      destruct (Atom.reflect_uop_eqb u u0);[subst | auto].
+      apply build_congr_correct;intros.
+      simpl;rewrite Lit.interp_lit, orb_false_r;unfold Var.interp.
+      rewrite H1.
+      generalize (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom a), (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom b). rewrite Typ.eqb_spec in H2. rewrite Typ.eqb_spec in H3. unfold Atom.get_type in H2, H3. rewrite H2,H3. intros [va HHa] [vb HHb].
+      unfold Atom.apply_binop;unfold Atom.interp_hatom;simpl.
+      rewrite HHb, HHa. simpl.
+      rewrite Atom.t_interp_wf in HHa; auto. rewrite H4 in HHa. simpl in HHa.
+      rewrite Atom.t_interp_wf in HHb; auto. rewrite H5 in HHb. simpl in HHb.
+      rewrite Typ.cast_refl;simpl.
+      assert (Atom.Bval t_i t va = Atom.Bval t_i t vb).
+       inversion H6;subst.
+       unfold Atom.interp_hatom in H10.
+       rewrite <- HHa; rewrite <- HHb, H10;trivial.
+      rewrite Typ.i_eqb_spec.
+      inversion H7.
+      apply Eqdep_dec.inj_pair2_eq_dec in H9;trivial.
+      intros x y;destruct (Typ.reflect_eqb x y);auto.
+      (* bop *)
+      destruct (Atom.reflect_bop_eqb b0 b1);[subst | auto].
+      apply build_congr_correct;intros.
+      simpl;rewrite Lit.interp_lit, orb_false_r;unfold Var.interp.
+      rewrite H1.
+      generalize (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom a), (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom b). rewrite Typ.eqb_spec in H2. rewrite Typ.eqb_spec in H3. unfold Atom.get_type in H2, H3. rewrite H2,H3. intros [va HHa] [vb HHb].
+      unfold Atom.apply_binop. unfold Atom.interp_hatom;simpl.
+      rewrite HHb, HHa;simpl.
+      rewrite Atom.t_interp_wf in HHa; auto. rewrite H4 in HHa. simpl in HHa.
+      rewrite Atom.t_interp_wf in HHb; auto. rewrite H5 in HHb. simpl in HHb.
+      rewrite Typ.cast_refl;simpl.
+      assert (Atom.Bval t_i t va = Atom.Bval t_i t vb).
+       inversion H6;clear H6;subst.
+       inversion H12;clear H12;subst.
+       unfold Atom.interp_hatom in H10, H8.
+       rewrite <- HHa. rewrite <- HHb, H10, H8;trivial.
+      rewrite Typ.i_eqb_spec.
+      inversion H7.
+      apply Eqdep_dec.inj_pair2_eq_dec in H9;trivial.
+      intros x y;destruct (Typ.reflect_eqb x y);auto.
+      (* op *)
+      destruct (Int63Properties.reflect_eqb i i0);[subst | auto].
+      apply build_congr_correct;intros.
+      simpl;rewrite Lit.interp_lit, orb_false_r;unfold Var.interp.
+      rewrite H1.
+      generalize (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom a), (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom b). rewrite Typ.eqb_spec in H2. rewrite Typ.eqb_spec in H3. unfold Atom.get_type in H2, H3. rewrite H2,H3. intros [va HHa] [vb HHb].
+      unfold Atom.apply_binop;unfold Atom.interp_hatom;simpl.
+      rewrite HHb, HHa;simpl.
+      rewrite Atom.t_interp_wf in HHa; auto. rewrite H4 in HHa. simpl in HHa.
+      rewrite Atom.t_interp_wf in HHb; auto. rewrite H5 in HHb. simpl in HHb.
+      rewrite Typ.cast_refl;simpl.
+      assert (Atom.Bval t_i t va = Atom.Bval t_i t vb).
+        rewrite <- HHa;rewrite <- HHb;destruct (t_func.[i0]).
+        apply f_equal;clear HHa HHb va vb H5 H4.
+        induction H6;simpl;trivial.
+        unfold Atom.interp_hatom in H4.
+        rewrite IHForall2, H4;trivial.
+      rewrite Typ.i_eqb_spec.
+      inversion H7.
+      apply Eqdep_dec.inj_pair2_eq_dec in H9;trivial.
+      intros x y;destruct (Typ.reflect_eqb x y);auto.
+    Qed.
+
+    Lemma valid_check_congr_pred :
+       forall lpa lpb eqs,
+          C.interp rho (check_congr_pred lpa lpb eqs).
+    Proof.
+      unfold check_congr_pred;intros.
+      case_eq (t_form.[Lit.blit lpa]);auto.
+      case_eq (t_form.[Lit.blit lpb]);auto;intros.
+      case_eq (t_atom.[i0]);auto; case_eq (t_atom.[i]);auto;intros.
+      (* uop *)
+      destruct (Atom.reflect_uop_eqb u0 u);[subst | auto].
+      apply build_congr_correct;simpl;intros.
+      rewrite orb_false_r, Lit.interp_lit, Lit.interp_nlit;unfold Var.interp.
+      replace (rho (Lit.blit lpb)) with (rho (Lit.blit lpa)).
+       destruct (rho (Lit.blit lpa));reflexivity.
+      rewrite !wf_interp_form, H, H0;simpl.
+      generalize wt_t_atom;unfold Atom.wt;unfold is_true;
+       rewrite PArray.forallbi_spec;intros.
+      assert (i < length t_atom).
+        apply PArray.get_not_default_lt.
+        rewrite H1, def_t_atom;discriminate.
+      assert (i0 < length t_atom).
+        apply PArray.get_not_default_lt.
+        rewrite H2, def_t_atom;discriminate.
+      apply H4 in H5;apply H4 in H6;clear H4.
+      unfold Atom.interp_form_hatom, Atom.interp_hatom;simpl.
+      rewrite !Atom.t_interp_wf, H1, H2;simpl;trivial.
+      apply f_equal;apply f_equal.
+      inversion H3;clear H3;subst;trivial.
+
+      (* bop *)
+      destruct (Atom.reflect_bop_eqb b0 b);[subst | auto].
+      apply build_congr_correct;simpl;intros.
+      rewrite orb_false_r, Lit.interp_lit, Lit.interp_nlit;unfold Var.interp.
+      replace (rho (Lit.blit lpb)) with (rho (Lit.blit lpa)).
+       destruct (rho (Lit.blit lpa));reflexivity.
+      rewrite !wf_interp_form, H, H0;simpl.
+      generalize wt_t_atom;unfold Atom.wt;unfold is_true;
+       rewrite PArray.forallbi_spec;intros.
+      assert (i < length t_atom).
+        apply PArray.get_not_default_lt.
+        rewrite H1, def_t_atom. discriminate.
+      assert (i0 < length t_atom).
+        apply PArray.get_not_default_lt.
+        rewrite H2, def_t_atom;discriminate.
+      apply H4 in H5;apply H4 in H6;clear H4.
+      unfold Atom.interp_form_hatom, Atom.interp_hatom;simpl.
+      rewrite !Atom.t_interp_wf, H1, H2;simpl;trivial.
+      inversion H3;clear H3;subst.
+      inversion H11;clear H11;subst.
+      apply f_equal; apply f_equal2;trivial.
+
+      (* op *)
+      destruct (Int63Properties.reflect_eqb i2 i1);[subst | auto].
+      apply build_congr_correct;simpl;intros.
+      rewrite orb_false_r, Lit.interp_lit, Lit.interp_nlit;unfold Var.interp.
+      replace (rho (Lit.blit lpb)) with (rho (Lit.blit lpa)).
+       destruct (rho (Lit.blit lpa));reflexivity.
+      rewrite !wf_interp_form, H, H0;simpl.
+      generalize wt_t_atom;unfold Atom.wt;unfold is_true;
+       rewrite PArray.forallbi_spec;intros.
+      assert (i < length t_atom).
+        apply PArray.get_not_default_lt.
+        rewrite H1, def_t_atom;discriminate.
+      assert (i0 < length t_atom).
+        apply PArray.get_not_default_lt.
+        rewrite H2, def_t_atom;discriminate.
+      apply H4 in H5;apply H4 in H6;clear H4.
+      unfold Atom.interp_form_hatom, Atom.interp_hatom;simpl.
+      rewrite !Atom.t_interp_wf, H1, H2;simpl;trivial.
+      apply f_equal;destruct (t_func.[i1]);apply f_equal.
+      clear H H0 H1 H2 H5 H6.
+      induction H3;simpl;trivial.
+      unfold Atom.interp_hatom in H;rewrite H, IHForall2;trivial.
+    Qed.
+
+  End Proof.
+
+End certif.
diff --git a/src/extraction/Extract.v b/src/extraction/Extract.v
new file mode 100644
index 0000000..1161f48
--- /dev/null
+++ b/src/extraction/Extract.v
@@ -0,0 +1,26 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+Require Int63Native.
+Require Import ExtractNative.
+Require Import SMTCoq.
+
+Extract Constant Int63Native.eqb => "fun i j -> ExtrNative.compare i j = ExtrNative.Eq".
+
+Set Extraction AccessOpaque.
+
+Extraction "extraction/sat_checker.ml" Sat_Checker.checker.
+Extraction "extraction/smt_checker.ml" Euf_Checker.checker_ext.
diff --git a/src/extraction/Makefile b/src/extraction/Makefile
new file mode 100644
index 0000000..07a30dd
--- /dev/null
+++ b/src/extraction/Makefile
@@ -0,0 +1,47 @@
+# List of user's files and name of the final program (edit this part)
+
+USERFILES=test.ml
+PROGRAM=test
+# USERFILES=../../../../examples/example.ml
+# PROGRAM=../../../../examples/example
+
+
+# Compilation
+
+COQTOP=$(COQBIN)../
+
+FLAGS=-rectypes
+COMPILEFLAGS=-cclib -lunix
+
+SMTLIB=-I .. -I ../zchaff -I ../verit -I ../trace -I ../lia -I ../euf -I ../cnf
+COQLIB=-I ${COQTOP}kernel -I ${COQTOP}lib -I ${COQTOP}library -I ${COQTOP}parsing -I ${COQTOP}pretyping -I ${COQTOP}interp -I ${COQTOP}proofs -I ${COQTOP}tactics -I ${COQTOP}toplevel -I ${COQTOP}plugins/btauto -I ${COQTOP}plugins/cc -I ${COQTOP}plugins/decl_mode -I ${COQTOP}plugins/extraction -I ${COQTOP}plugins/field -I ${COQTOP}plugins/firstorder -I ${COQTOP}plugins/fourier -I ${COQTOP}plugins/funind -I ${COQTOP}plugins/micromega -I ${COQTOP}plugins/nsatz -I ${COQTOP}plugins/omega -I ${COQTOP}plugins/quote -I ${COQTOP}plugins/ring -I ${COQTOP}plugins/romega -I ${COQTOP}plugins/rtauto -I ${COQTOP}plugins/setoid_ring -I ${COQTOP}plugins/syntax -I ${COQTOP}plugins/xml -I /usr/lib/ocaml/camlp5
+
+CMXA=nums.cmxa str.cmxa unix.cmxa gramlib.cmxa dynlink.cmxa ${COQTOP}kernel/byterun/coq_fix_code.o ${COQTOP}kernel/byterun/coq_interp.o ${COQTOP}kernel/byterun/coq_memory.o ${COQTOP}kernel/byterun/coq_values.o clib.cmxa lib.cmxa kernel.cmxa library.cmxa pretyping.cmxa interp.cmxa proofs.cmxa parsing.cmxa tactics.cmxa toplevel.cmxa micromega_plugin.cmxa smtcoq.cmxa
+CMI=extrNative.cmi sat_checker.cmi smt_checker.cmi
+CMX=extrNative.cmx sat_checker.cmx zchaff_checker.cmx smt_checker.cmx verit_checker.cmx
+USERCMX=$(USERFILES:.ml=.cmx)
+
+OCAMLC=ocamlc
+OCAMLOPT=ocamlopt
+
+
+all: $(PROGRAM)
+
+%.cmi: %.mli
+	$(OCAMLC) -c $(FLAGS) $(SMTLIB) $(COQLIB) $<
+
+%.cmx: %.ml
+	$(OCAMLOPT) -c $(FLAGS) $(SMTLIB) $(COQLIB) $<
+
+$(PROGRAM): $(CMI) $(CMX) $(USERCMX)
+	$(OCAMLOPT) $(FLAGS) $(SMTLIB) $(COQLIB) -o $@ $(COMPILEFLAGS) $(CMXA) $(CMX) $(USERCMX)
+
+
+.PHONY: clean mrproper
+
+
+clean:
+	rm -f *.cmi *.cmx *.o
+
+mrproper: clean
+	rm -rf $(PROGRAM)
diff --git a/src/extraction/extrNative.ml b/src/extraction/extrNative.ml
new file mode 100644
index 0000000..4d56287
--- /dev/null
+++ b/src/extraction/extrNative.ml
@@ -0,0 +1,332 @@
+type comparison = Eq | Lt | Gt
+
+type 'a carry = C0 of 'a | C1 of 'a
+    
+type uint = int 
+    
+  (* to be used only on 32 bits achitectures *)
+let maxuint31 = Int32.of_string "0x7FFFFFFF"
+let uint_32 i =  Int32.logand (Int32.of_int i) maxuint31
+    
+let select f32 f64 = if Sys.word_size = 64 then f64 else f32
+ 
+    (* conversion to an int *)
+let to_int i = i 
+
+let of_int_32 i = i
+let of_int_64 i = i land 0x7FFFFFFF
+
+let of_int = select of_int_32 of_int_64
+let of_uint i = i
+ 	
+    (* convertion of an uint31 to a string *)
+let to_string_32 i = Int32.to_string (uint_32 i)
+let to_string_64 = string_of_int 
+
+let to_string = select to_string_32 to_string_64
+let of_string s = 
+  let i32 = Int32.of_string s in
+  if Int32.compare Int32.zero i32 <= 0
+      && Int32.compare i32 maxuint31 <= 0 
+  then Int32.to_int i32
+  else raise (Failure "int_of_string")
+
+      
+
+    (* logical shift *)
+let l_sl x y = 
+  of_int (if 0 <= y && y < 31 then x lsl y else 0)
+    
+let l_sr x y = 
+  if 0 <= y && y < 31 then x lsr y else 0
+    
+let l_and x y = x land y
+let l_or x y = x lor y
+let l_xor x y = x lxor y
+
+    (* addition of int31 *)
+let add x y = of_int (x + y)
+ 
+    (* subtraction *)
+let sub x y = of_int (x - y)
+   
+    (* multiplication *)
+let mul x y = of_int (x * y)
+    
+    (* exact multiplication *)
+let mulc_32 x y =
+  let x = Int64.of_int32 (uint_32 x) in
+  let y = Int64.of_int32 (uint_32 y) in
+  let m = Int64.mul x y in
+  let l = Int64.to_int m in
+  let h = Int64.to_int (Int64.shift_right_logical m 31) in
+  h,l
+
+let mulc_64 x y =
+  let m = x * y in
+  let l = of_int_64 m in
+  let h = of_int_64 (m lsr 31) in
+  h, l
+let mulc = select mulc_32 mulc_64
+
+    (* division *)
+let div_32 x y = 
+  if y = 0 then 0 else
+  Int32.to_int (Int32.div (uint_32 x) (uint_32 y)) 
+let div_64 x y = if y = 0 then 0 else  x / y
+let div = select div_32 div_64
+    
+    (* modulo *)
+let rem_32 x y = 
+  if y = 0 then 0 
+  else Int32.to_int (Int32.rem (uint_32 x) (uint_32 y))
+let rem_64 x y = if y = 0 then 0 else x mod y
+let rem = select rem_32 rem_64
+    
+    (* division of two numbers by one *)
+let div21_32 xh xl y =
+  if y = 0 then (0,0) 
+  else
+    let x = 
+      Int64.logor 
+	(Int64.shift_left (Int64.of_int32 (uint_32 xh)) 31) 
+	(Int64.of_int32 (uint_32 xl)) in
+    let y = Int64.of_int32 (uint_32 y) in
+    let q = Int64.div x y in
+    let r = Int64.rem x y in
+    Int64.to_int q, Int64.to_int r
+let div21_64 xh xl y =
+  if y = 0 then (0,0) 
+  else
+    let x = (xh lsl 31) lor xl in
+    let q = x / y in
+    let r = x mod y in
+    q, r
+let div21 = select div21_32 div21_64
+    
+    (* comparison *)
+let lt_32 x y = (x lxor 0x40000000) < (y lxor 0x40000000)
+(*  if 0 <= x then
+    if 0 <= y then x < y
+    else true
+  else if 0 <= y then false
+    else x < y *)
+(* Int32.compare (uint_32 x) (uint_32 y) < 0 *)
+
+let lt_64 x y = x < y
+let lt = select lt_32 lt_64
+    
+let le_32 x y = 
+ (x lxor 0x40000000) <= (y lxor 0x40000000)
+(*
+  if 0 <= x then
+    if 0 <= y then x <= y
+    else true
+  else if 0 <= y then false
+    else x <= y
+*)
+(*Int32.compare (uint_32 x) (uint_32 y) <= 0*)
+let le_64 x y = x <= y
+let le = select le_32 le_64
+
+let eq x y = x == y
+    
+let cmp_32 x y = Int32.compare (uint_32 x) (uint_32 y)
+let cmp_64 x y = compare x y
+let compare = select cmp_32 cmp_64
+ 
+let compare x y =
+  match compare x y with
+  | x when x < 0 -> Lt
+  | 0 -> Eq
+  | _ -> Gt
+
+    (* head tail *)
+
+let head0 x =
+  let r = ref 0 in
+  let x = ref x in
+  if !x land 0x7FFF0000 = 0 then r := !r + 15
+  else x := !x lsr 15;
+  if !x land 0xFF00 = 0 then (x := !x lsl 8; r := !r + 8);
+  if !x land 0xF000 = 0 then (x := !x lsl 4; r := !r + 4);
+  if !x land 0xC000 = 0 then (x := !x lsl 2; r := !r + 2);
+  if !x land 0x8000 = 0 then (x := !x lsl 1; r := !r + 1);
+  if !x land 0x8000 = 0 then (               r := !r + 1);
+  !r;;
+
+let tail0 x =
+  let r = ref 0 in
+  let x = ref x in
+  if !x land 0xFFFF = 0 then (x := !x lsr 16; r := !r + 16);
+  if !x land 0xFF = 0   then (x := !x lsr 8;  r := !r + 8);
+  if !x land 0xF = 0    then (x := !x lsr 4;  r := !r + 4);
+  if !x land 0x3 = 0    then (x := !x lsr 2;  r := !r + 2);
+  if !x land 0x1 = 0    then (                r := !r + 1);
+  !r
+
+let addc x y =
+  let s = add x y in
+  if lt s x then C1 s else C0 s
+
+let addcarryc x y =
+  let s = add (x+1) y in 
+  if le s x then C1 s else C0 s
+
+let subc x y =
+  let s = sub x y in
+  if lt x y then C1 s else C0 s
+
+let subcarryc x y =
+  let s = sub (x-1) y in
+  if le x y then C1 s else C0 s
+
+let diveucl x y = div x y, rem x y
+
+let diveucl_21 = div21
+
+let addmuldiv p i j =
+  let p' = to_int p in
+  of_uint (l_or 
+	     (l_sl i p) 
+	     (l_sr j (of_int (31 - p'))))
+
+let rec foldi_cont f min max cont a =
+  if lt min max then f min (foldi_cont f (add min 1) max cont) a
+  else if min = max then f min cont a 
+  else cont a 
+
+let rec foldi_down_cont f max min cont a =
+  if lt min max then
+    f max (foldi_down_cont f (sub max 1) min cont) a
+  else if min = max then f min cont a
+  else cont a
+
+let print_uint x =
+  Printf.fprintf stderr "%s" (to_string x);
+  flush stderr;
+  x
+   
+(* Les Tableaux maintenant *)
+
+let max_array_length32 = 4194303 (* Sys.max_array_length on arch32 *)
+ 
+type 'a parray = ('a kind) ref
+and 'a kind =
+  | Array of 'a array 
+	(* | Matrix of 'a array array *)
+  | Updated of int * 'a * 'a parray
+
+let of_array t = ref (Array t)
+
+let parray_make n def = 
+  let n = to_int n in
+  let n = 
+    if 0 <= n && n < max_array_length32 then n + 1 
+    else max_array_length32 in
+  ref (Array (Array.make n def))
+
+let rec get_updated p n =
+  match !p with
+  | Array t ->
+      let l =  Array.length t in
+      if 0 <= n && n < l then Array.unsafe_get t n
+      else (Array.unsafe_get t (l-1))
+  | Updated (k,e,p) -> if n = k then e else get_updated p n
+      
+let parray_get p n =
+  let n = to_int n in
+  match !p with
+  | Array t ->
+      let l = Array.length t in
+      if 0 <= n && n < l then Array.unsafe_get t n
+      else (Array.unsafe_get t (l-1))
+  | Updated _ -> get_updated p n
+      
+
+let rec default_updated p =
+  match !p with
+  | Array t -> Array.unsafe_get t (Array.length t - 1)
+  | Updated (_,_,p) -> default_updated p
+	
+let parray_default p =
+  match !p with
+  | Array t -> Array.unsafe_get t (Array.length t - 1)
+  | Updated (_,_,p) -> default_updated p
+
+let rec length p =
+  match !p with
+  | Array t -> of_int (Array.length t - 1) (* The default value *)
+  | Updated (_, _, p) -> length p
+	
+let parray_length p = 
+  match !p with
+  | Array t -> of_int (Array.length t - 1)
+  | Updated (_, _, p) -> length p
+	
+let parray_set p n e =
+  let kind = !p in
+  let n = to_int n in
+  match kind with
+  | Array t ->
+      if 0 <= n && n < Array.length t - 1 then
+	let res = ref kind in
+	p := Updated (n, Array.unsafe_get t n, res);
+	Array.unsafe_set t n e;
+	res
+      else p
+  | Updated _ ->
+      if 0 <= n && n < to_int (parray_length p) then
+	ref (Updated(n, e, p))   
+      else p
+
+	
+let rec copy_updated p =
+  match !p with
+  | Array t -> Array.copy t
+  | Updated (n,e,p) -> 
+      let t = copy_updated p in 
+      Array.unsafe_set t n e; t 
+	
+let parray_copy p =
+  let t = 
+    match !p with
+    | Array t -> Array.copy t
+    | Updated _ -> copy_updated p in
+  ref (Array t)
+    
+let rec rerootk t k = 
+  match !t with
+  | Array _ -> k ()
+  | Updated (i, v, t') -> 
+      let k' () =
+	begin match !t' with
+	| Array a as n ->
+	    let v' = a.(i) in
+	    a.(i) <- v;
+	    t := n;
+	    t' := Updated (i, v', t)
+	| Updated _ -> assert false 
+	end; k() in
+      rerootk t' k'
+	
+let parray_reroot t = rerootk t (fun () -> t)
+ 
+let parray_init n f def =
+  let n = to_int n in
+  let n = 
+    if 0 <= n && n < max_array_length32 then n + 1 
+    else max_array_length32 in
+  let t = Array.make n def in
+  for i = 0 to n - 2 do Array.unsafe_set t i (f i) done;
+  ref (Array t)
+
+let parray_map f p =
+  match !p with
+  | Array t -> ref (Array (Array.map f t))
+  | _ ->
+      let len = to_int (length p) in
+      ref (Array 
+	     (Array.init (len + 1) 
+		(fun i -> f (parray_get p (of_int i)))))
+	
diff --git a/src/extraction/extrNative.mli b/src/extraction/extrNative.mli
new file mode 100644
index 0000000..14eff5f
--- /dev/null
+++ b/src/extraction/extrNative.mli
@@ -0,0 +1,67 @@
+type comparison = Eq | Lt | Gt
+type 'a carry = C0 of 'a | C1 of 'a
+
+(*s Unsigned Int *)
+type uint 
+
+(* Conversion with int *)
+val to_int : uint -> int
+val of_int : int -> uint
+val of_uint : int -> uint
+
+(* Conversion with string *)
+val to_string : uint -> string
+val of_string : string -> uint
+
+(* logical operations *)
+val l_sl : uint -> uint -> uint
+val l_sr : uint -> uint -> uint
+val l_and : uint -> uint -> uint
+val l_or : uint -> uint -> uint
+val l_xor : uint -> uint -> uint
+
+(* arithmetic operations *)
+val add : uint -> uint -> uint
+val sub : uint -> uint -> uint
+val mul : uint -> uint -> uint
+val mulc : uint -> uint -> uint * uint
+val div : uint -> uint -> uint
+val rem : uint -> uint -> uint
+
+val lt : uint -> uint -> bool
+val le : uint -> uint -> bool
+val eq : uint -> uint -> bool
+val compare : uint -> uint -> comparison
+
+val head0 : uint -> uint
+val tail0 : uint -> uint
+
+val addc : uint -> uint -> uint carry
+val addcarryc : uint -> uint -> uint carry
+val subc : uint -> uint -> uint carry
+val subcarryc : uint -> uint -> uint carry
+val diveucl : uint -> uint -> uint * uint
+val diveucl_21 : uint -> uint -> uint -> uint * uint
+val addmuldiv : uint -> uint -> uint -> uint
+
+val foldi_cont :
+  (uint -> ('a -> 'b) -> 'a -> 'b) -> uint -> uint -> ('a -> 'b) -> 'a -> 'b
+val foldi_down_cont :
+  (uint -> ('a -> 'b) -> 'a -> 'b) -> uint -> uint -> ('a -> 'b) -> 'a -> 'b
+val print_uint : uint -> uint
+
+
+(*s Persistant array *)
+
+type 'a parray 
+
+val of_array : 'a array -> 'a parray
+
+val parray_make : uint -> 'a -> 'a parray
+val parray_get : 'a parray -> uint -> 'a
+val parray_default : 'a parray -> 'a
+val parray_length : 'a parray -> uint
+val parray_set : 'a parray -> uint -> 'a -> 'a parray
+val parray_copy : 'a parray -> 'a parray
+val parray_reroot : 'a parray -> 'a parray
+
diff --git a/src/extraction/sat_checker.ml b/src/extraction/sat_checker.ml
new file mode 100644
index 0000000..59635e0
--- /dev/null
+++ b/src/extraction/sat_checker.ml
@@ -0,0 +1,431 @@
+(** val negb : bool -> bool **)
+
+let negb = function
+| true -> false
+| false -> true
+
+type 'a list =
+| Nil
+| Cons of 'a * 'a list
+
+(** val existsb : ('a1 -> bool) -> 'a1 list -> bool **)
+
+let rec existsb f = function
+| Nil -> false
+| Cons (a, l0) -> if f a then true else existsb f l0
+
+type int = ExtrNative.uint
+
+(** val lsl0 : int -> int -> int **)
+
+let lsl0 = ExtrNative.l_sl
+
+(** val lsr0 : int -> int -> int **)
+
+let lsr0 = ExtrNative.l_sr
+
+(** val land0 : int -> int -> int **)
+
+let land0 = ExtrNative.l_and
+
+(** val lxor0 : int -> int -> int **)
+
+let lxor0 = ExtrNative.l_xor
+
+(** val sub : int -> int -> int **)
+
+let sub = ExtrNative.sub
+
+(** val eqb : int -> int -> bool **)
+
+let eqb = fun i j -> ExtrNative.compare i j = ExtrNative.Eq
+
+(** val foldi_cont :
+    (int -> ('a1 -> 'a2) -> 'a1 -> 'a2) -> int -> int -> ('a1 -> 'a2) -> 'a1
+    -> 'a2 **)
+
+let foldi_cont = ExtrNative.foldi_cont
+
+(** val foldi_down_cont :
+    (int -> ('a1 -> 'a2) -> 'a1 -> 'a2) -> int -> int -> ('a1 -> 'a2) -> 'a1
+    -> 'a2 **)
+
+let foldi_down_cont = ExtrNative.foldi_down_cont
+
+(** val is_zero : int -> bool **)
+
+let is_zero i =
+  eqb i (ExtrNative.of_uint(0))
+
+(** val is_even : int -> bool **)
+
+let is_even i =
+  is_zero (land0 i (ExtrNative.of_uint(1)))
+
+(** val compare : int -> int -> ExtrNative.comparison **)
+
+let compare = ExtrNative.compare
+
+(** val foldi : (int -> 'a1 -> 'a1) -> int -> int -> 'a1 -> 'a1 **)
+
+let foldi f from to0 =
+  foldi_cont (fun i cont a -> cont (f i a)) from to0 (fun a -> a)
+
+(** val foldi_down : (int -> 'a1 -> 'a1) -> int -> int -> 'a1 -> 'a1 **)
+
+let foldi_down f from downto0 =
+  foldi_down_cont (fun i cont a -> cont (f i a)) from downto0 (fun a -> a)
+
+type 'a array = 'a ExtrNative.parray
+
+(** val make : int -> 'a1 -> 'a1 array **)
+
+let make = ExtrNative.parray_make
+
+module Coq__1 = struct 
+ (** val get : 'a1 array -> int -> 'a1 **)
+ 
+ let get = ExtrNative.parray_get
+end
+let get = Coq__1.get
+
+(** val set : 'a1 array -> int -> 'a1 -> 'a1 array **)
+
+let set = ExtrNative.parray_set
+
+(** val length : 'a1 array -> int **)
+
+let length = ExtrNative.parray_length
+
+(** val to_list : 'a1 array -> 'a1 list **)
+
+let to_list t0 =
+  let len = length t0 in
+  if eqb (ExtrNative.of_uint(0)) len
+  then Nil
+  else foldi_down (fun i l -> Cons ((get t0 i), l))
+         (sub len (ExtrNative.of_uint(1))) (ExtrNative.of_uint(0)) Nil
+
+(** val fold_left : ('a1 -> 'a2 -> 'a1) -> 'a1 -> 'a2 array -> 'a1 **)
+
+let fold_left f a t0 =
+  let len = length t0 in
+  if eqb (ExtrNative.of_uint(0)) len
+  then a
+  else foldi (fun i a0 -> f a0 (get t0 i)) (ExtrNative.of_uint(0))
+         (sub (length t0) (ExtrNative.of_uint(1))) a
+
+(** val foldi_right :
+    (int -> 'a1 -> 'a2 -> 'a2) -> 'a1 array -> 'a2 -> 'a2 **)
+
+let foldi_right f t0 b =
+  let len = length t0 in
+  if eqb (ExtrNative.of_uint(0)) len
+  then b
+  else foldi_down (fun i b0 -> f i (get t0 i) b0)
+         (sub len (ExtrNative.of_uint(1))) (ExtrNative.of_uint(0)) b
+
+module Valuation = 
+ struct 
+  type t = int -> bool
+ end
+
+module Var = 
+ struct 
+  (** val _true : int **)
+  
+  let _true =
+    (ExtrNative.of_uint(0))
+  
+  (** val _false : int **)
+  
+  let _false =
+    (ExtrNative.of_uint(1))
+  
+  (** val interp : Valuation.t -> int -> bool **)
+  
+  let interp rho x =
+    rho x
+ end
+
+module Lit = 
+ struct 
+  (** val is_pos : int -> bool **)
+  
+  let is_pos l =
+    is_even l
+  
+  (** val blit : int -> int **)
+  
+  let blit l =
+    lsr0 l (ExtrNative.of_uint(1))
+  
+  (** val lit : int -> int **)
+  
+  let lit x =
+    lsl0 x (ExtrNative.of_uint(1))
+  
+  (** val neg : int -> int **)
+  
+  let neg l =
+    lxor0 l (ExtrNative.of_uint(1))
+  
+  (** val nlit : int -> int **)
+  
+  let nlit x =
+    neg (lit x)
+  
+  (** val _true : int **)
+  
+  let _true =
+    (ExtrNative.of_uint(0))
+  
+  (** val _false : int **)
+  
+  let _false =
+    (ExtrNative.of_uint(2))
+  
+  (** val eqb : int -> int -> bool **)
+  
+  let eqb l l' =
+    eqb l l'
+  
+  (** val interp : Valuation.t -> int -> bool **)
+  
+  let interp rho l =
+    if is_pos l
+    then Var.interp rho (blit l)
+    else negb (Var.interp rho (blit l))
+ end
+
+module C = 
+ struct 
+  type t = int list
+  
+  (** val interp : Valuation.t -> t -> bool **)
+  
+  let interp rho l =
+    existsb (Lit.interp rho) l
+  
+  (** val _true : t **)
+  
+  let _true =
+    Cons (Lit._true, Nil)
+  
+  (** val is_false : t -> bool **)
+  
+  let is_false = function
+  | Nil -> true
+  | Cons (i, l) -> false
+  
+  (** val or_aux : (t -> t -> t) -> int -> t -> t -> int list **)
+  
+  let rec or_aux or0 l1 c1 c2 = match c2 with
+  | Nil -> Cons (l1, c1)
+  | Cons (l2, c2') ->
+    (match compare l1 l2 with
+     | ExtrNative.Eq -> Cons (l1, (or0 c1 c2'))
+     | ExtrNative.Lt -> Cons (l1, (or0 c1 c2))
+     | ExtrNative.Gt -> Cons (l2, (or_aux or0 l1 c1 c2')))
+  
+  (** val coq_or : t -> t -> t **)
+  
+  let rec coq_or c1 c2 =
+    match c1 with
+    | Nil -> c2
+    | Cons (l1, c3) ->
+      (match c2 with
+       | Nil -> c1
+       | Cons (l2, c2') ->
+         (match compare l1 l2 with
+          | ExtrNative.Eq -> Cons (l1, (coq_or c3 c2'))
+          | ExtrNative.Lt -> Cons (l1, (coq_or c3 c2))
+          | ExtrNative.Gt -> Cons (l2, (or_aux coq_or l1 c3 c2'))))
+  
+  (** val resolve_aux : (t -> t -> t) -> int -> t -> t -> t **)
+  
+  let rec resolve_aux resolve0 l1 c1 c2 = match c2 with
+  | Nil -> _true
+  | Cons (l2, c2') ->
+    (match compare l1 l2 with
+     | ExtrNative.Eq -> Cons (l1, (resolve0 c1 c2'))
+     | ExtrNative.Lt ->
+       if eqb (lxor0 l1 l2) (ExtrNative.of_uint(1))
+       then coq_or c1 c2'
+       else Cons (l1, (resolve0 c1 c2))
+     | ExtrNative.Gt ->
+       if eqb (lxor0 l1 l2) (ExtrNative.of_uint(1))
+       then coq_or c1 c2'
+       else Cons (l2, (resolve_aux resolve0 l1 c1 c2')))
+  
+  (** val resolve : t -> t -> t **)
+  
+  let rec resolve c1 c2 =
+    match c1 with
+    | Nil -> _true
+    | Cons (l1, c3) ->
+      (match c2 with
+       | Nil -> _true
+       | Cons (l2, c2') ->
+         (match compare l1 l2 with
+          | ExtrNative.Eq -> Cons (l1, (resolve c3 c2'))
+          | ExtrNative.Lt ->
+            if eqb (lxor0 l1 l2) (ExtrNative.of_uint(1))
+            then coq_or c3 c2'
+            else Cons (l1, (resolve c3 c2))
+          | ExtrNative.Gt ->
+            if eqb (lxor0 l1 l2) (ExtrNative.of_uint(1))
+            then coq_or c3 c2'
+            else Cons (l2, (resolve_aux resolve l1 c3 c2'))))
+ end
+
+module S = 
+ struct 
+  type t = C.t array
+  
+  (** val get : t -> int -> C.t **)
+  
+  let get s cid =
+    get s cid
+  
+  (** val internal_set : t -> int -> C.t -> t **)
+  
+  let internal_set s cid c =
+    set s cid c
+  
+  (** val make : int -> t **)
+  
+  let make nclauses =
+    make nclauses C._true
+  
+  (** val insert : int -> int list -> int list **)
+  
+  let rec insert l1 c = match c with
+  | Nil -> Cons (l1, Nil)
+  | Cons (l2, c') ->
+    (match compare l1 l2 with
+     | ExtrNative.Eq -> c
+     | ExtrNative.Lt ->
+       if eqb (lxor0 l1 l2) (ExtrNative.of_uint(1))
+       then C._true
+       else Cons (l1, c)
+     | ExtrNative.Gt ->
+       if eqb (lxor0 l1 l2) (ExtrNative.of_uint(1))
+       then C._true
+       else Cons (l2, (insert l1 c')))
+  
+  (** val sort_uniq : int list -> int list **)
+  
+  let rec sort_uniq = function
+  | Nil -> Nil
+  | Cons (l1, c0) -> insert l1 (sort_uniq c0)
+  
+  (** val set_clause : t -> int -> C.t -> t **)
+  
+  let set_clause s pos c =
+    set s pos (sort_uniq c)
+  
+  (** val set_resolve : t -> int -> int array -> t **)
+  
+  let set_resolve s pos r =
+    let len = length r in
+    if eqb len (ExtrNative.of_uint(0))
+    then s
+    else let c =
+           foldi (fun i c -> C.resolve (get s (Coq__1.get r i)) c)
+             (ExtrNative.of_uint(1)) (sub len (ExtrNative.of_uint(1)))
+             (get s (Coq__1.get r (ExtrNative.of_uint(0))))
+         in
+         internal_set s pos c
+ end
+
+(** val afold_left :
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a2 -> 'a1) -> 'a2 array -> 'a1 **)
+
+let afold_left default oP f v =
+  let n = length v in
+  if eqb n (ExtrNative.of_uint(0))
+  then default
+  else foldi (fun i a -> oP a (f (get v i))) (ExtrNative.of_uint(1))
+         (sub n (ExtrNative.of_uint(1))) (f (get v (ExtrNative.of_uint(0))))
+
+type 'step _trace_ = 'step array array
+
+(** val _checker_ :
+    (S.t -> 'a1 -> S.t) -> (C.t -> bool) -> S.t -> 'a1 _trace_ -> int -> bool **)
+
+let _checker_ check_step is_false0 s t0 confl =
+  let s' = fold_left (fun s0 a -> fold_left check_step s0 a) s t0 in
+  is_false0 (S.get s' confl)
+
+module Sat_Checker = 
+ struct 
+  type step =
+  | Res of int * int array
+  
+  (** val step_rect : (int -> int array -> 'a1) -> step -> 'a1 **)
+  
+  let step_rect f = function
+  | Res (x, x0) -> f x x0
+  
+  (** val step_rec : (int -> int array -> 'a1) -> step -> 'a1 **)
+  
+  let step_rec f = function
+  | Res (x, x0) -> f x x0
+  
+  (** val resolution_checker :
+      (C.t -> bool) -> S.t -> step _trace_ -> int -> bool **)
+  
+  let resolution_checker s t0 =
+    _checker_ (fun s0 st -> let Res (pos, r) = st in S.set_resolve s0 pos r)
+      s t0
+  
+  type dimacs = int array array
+  
+  (** val coq_C_interp_or : Valuation.t -> int array -> bool **)
+  
+  let coq_C_interp_or rho c =
+    afold_left false (fun b1 b2 -> if b1 then true else b2) (Lit.interp rho)
+      c
+  
+  (** val valid : Valuation.t -> dimacs -> bool **)
+  
+  let valid rho d =
+    afold_left true (fun b1 b2 -> if b1 then b2 else false)
+      (coq_C_interp_or rho) d
+  
+  type certif =
+  | Certif of int * step _trace_ * int
+  
+  (** val certif_rect :
+      (int -> step _trace_ -> int -> 'a1) -> certif -> 'a1 **)
+  
+  let certif_rect f = function
+  | Certif (x, x0, x1) -> f x x0 x1
+  
+  (** val certif_rec :
+      (int -> step _trace_ -> int -> 'a1) -> certif -> 'a1 **)
+  
+  let certif_rec f = function
+  | Certif (x, x0, x1) -> f x x0 x1
+  
+  (** val add_roots : S.t -> dimacs -> S.t **)
+  
+  let add_roots s d =
+    foldi_right (fun i c s0 -> S.set_clause s0 i (to_list c)) d s
+  
+  (** val checker : dimacs -> certif -> bool **)
+  
+  let checker d = function
+  | Certif (nclauses, t0, confl_id) ->
+    resolution_checker C.is_false (add_roots (S.make nclauses) d) t0 confl_id
+  
+  (** val interp_var : (int -> bool) -> int -> bool **)
+  
+  let interp_var rho x =
+    match compare x (ExtrNative.of_uint(1)) with
+    | ExtrNative.Eq -> false
+    | ExtrNative.Lt -> true
+    | ExtrNative.Gt -> rho (sub x (ExtrNative.of_uint(1)))
+ end
+
diff --git a/src/extraction/sat_checker.mli b/src/extraction/sat_checker.mli
new file mode 100644
index 0000000..5fa2757
--- /dev/null
+++ b/src/extraction/sat_checker.mli
@@ -0,0 +1,169 @@
+val negb : bool -> bool
+
+type 'a list =
+| Nil
+| Cons of 'a * 'a list
+
+val existsb : ('a1 -> bool) -> 'a1 list -> bool
+
+type int = ExtrNative.uint
+
+val lsl0 : int -> int -> int
+
+val lsr0 : int -> int -> int
+
+val land0 : int -> int -> int
+
+val lxor0 : int -> int -> int
+
+val sub : int -> int -> int
+
+val eqb : int -> int -> bool
+
+val foldi_cont :
+  (int -> ('a1 -> 'a2) -> 'a1 -> 'a2) -> int -> int -> ('a1 -> 'a2) -> 'a1 ->
+  'a2
+
+val foldi_down_cont :
+  (int -> ('a1 -> 'a2) -> 'a1 -> 'a2) -> int -> int -> ('a1 -> 'a2) -> 'a1 ->
+  'a2
+
+val is_zero : int -> bool
+
+val is_even : int -> bool
+
+val compare : int -> int -> ExtrNative.comparison
+
+val foldi : (int -> 'a1 -> 'a1) -> int -> int -> 'a1 -> 'a1
+
+val foldi_down : (int -> 'a1 -> 'a1) -> int -> int -> 'a1 -> 'a1
+
+type 'a array = 'a ExtrNative.parray
+
+val make : int -> 'a1 -> 'a1 array
+
+val get : 'a1 array -> int -> 'a1
+
+val set : 'a1 array -> int -> 'a1 -> 'a1 array
+
+val length : 'a1 array -> int
+
+val to_list : 'a1 array -> 'a1 list
+
+val fold_left : ('a1 -> 'a2 -> 'a1) -> 'a1 -> 'a2 array -> 'a1
+
+val foldi_right : (int -> 'a1 -> 'a2 -> 'a2) -> 'a1 array -> 'a2 -> 'a2
+
+module Valuation : 
+ sig 
+  type t = int -> bool
+ end
+
+module Var : 
+ sig 
+  val _true : int
+  
+  val _false : int
+  
+  val interp : Valuation.t -> int -> bool
+ end
+
+module Lit : 
+ sig 
+  val is_pos : int -> bool
+  
+  val blit : int -> int
+  
+  val lit : int -> int
+  
+  val neg : int -> int
+  
+  val nlit : int -> int
+  
+  val _true : int
+  
+  val _false : int
+  
+  val eqb : int -> int -> bool
+  
+  val interp : Valuation.t -> int -> bool
+ end
+
+module C : 
+ sig 
+  type t = int list
+  
+  val interp : Valuation.t -> t -> bool
+  
+  val _true : t
+  
+  val is_false : t -> bool
+  
+  val or_aux : (t -> t -> t) -> int -> t -> t -> int list
+  
+  val coq_or : t -> t -> t
+  
+  val resolve_aux : (t -> t -> t) -> int -> t -> t -> t
+  
+  val resolve : t -> t -> t
+ end
+
+module S : 
+ sig 
+  type t = C.t array
+  
+  val get : t -> int -> C.t
+  
+  val internal_set : t -> int -> C.t -> t
+  
+  val make : int -> t
+  
+  val insert : int -> int list -> int list
+  
+  val sort_uniq : int list -> int list
+  
+  val set_clause : t -> int -> C.t -> t
+  
+  val set_resolve : t -> int -> int array -> t
+ end
+
+val afold_left :
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a2 -> 'a1) -> 'a2 array -> 'a1
+
+type 'step _trace_ = 'step array array
+
+val _checker_ :
+  (S.t -> 'a1 -> S.t) -> (C.t -> bool) -> S.t -> 'a1 _trace_ -> int -> bool
+
+module Sat_Checker : 
+ sig 
+  type step =
+  | Res of int * int array
+  
+  val step_rect : (int -> int array -> 'a1) -> step -> 'a1
+  
+  val step_rec : (int -> int array -> 'a1) -> step -> 'a1
+  
+  val resolution_checker :
+    (C.t -> bool) -> S.t -> step _trace_ -> int -> bool
+  
+  type dimacs = int array array
+  
+  val coq_C_interp_or : Valuation.t -> int array -> bool
+  
+  val valid : Valuation.t -> dimacs -> bool
+  
+  type certif =
+  | Certif of int * step _trace_ * int
+  
+  val certif_rect : (int -> step _trace_ -> int -> 'a1) -> certif -> 'a1
+  
+  val certif_rec : (int -> step _trace_ -> int -> 'a1) -> certif -> 'a1
+  
+  val add_roots : S.t -> dimacs -> S.t
+  
+  val checker : dimacs -> certif -> bool
+  
+  val interp_var : (int -> bool) -> int -> bool
+ end
+
diff --git a/src/extraction/smt_checker.ml b/src/extraction/smt_checker.ml
new file mode 100644
index 0000000..53aa130
--- /dev/null
+++ b/src/extraction/smt_checker.ml
@@ -0,0 +1,6849 @@
+type __ = Obj.t
+let __ = let rec f _ = Obj.repr f in Obj.repr f
+
+type unit0 =
+| Tt
+
+(** val implb : bool -> bool -> bool **)
+
+let implb b1 b2 =
+  if b1 then b2 else true
+
+(** val xorb : bool -> bool -> bool **)
+
+let xorb b1 b2 =
+  if b1 then if b2 then false else true else b2
+
+(** val negb : bool -> bool **)
+
+let negb = function
+| true -> false
+| false -> true
+
+type nat =
+| O
+| S of nat
+
+type 'a option =
+| Some of 'a
+| None
+
+(** val option_map : ('a1 -> 'a2) -> 'a1 option -> 'a2 option **)
+
+let option_map f = function
+| Some a -> Some (f a)
+| None -> None
+
+(** val fst : ('a1*'a2) -> 'a1 **)
+
+let fst = function
+| x,y -> x
+
+(** val snd : ('a1*'a2) -> 'a2 **)
+
+let snd = function
+| x,y -> y
+
+type 'a list =
+| Nil
+| Cons of 'a * 'a list
+
+(** val app : 'a1 list -> 'a1 list -> 'a1 list **)
+
+let rec app l m =
+  match l with
+  | Nil -> m
+  | Cons (a, l1) -> Cons (a, (app l1 m))
+
+(** val compOpp : ExtrNative.comparison -> ExtrNative.comparison **)
+
+let compOpp = function
+| ExtrNative.Eq -> ExtrNative.Eq
+| ExtrNative.Lt -> ExtrNative.Gt
+| ExtrNative.Gt -> ExtrNative.Lt
+
+type compareSpecT =
+| CompEqT
+| CompLtT
+| CompGtT
+
+(** val compareSpec2Type : ExtrNative.comparison -> compareSpecT **)
+
+let compareSpec2Type = function
+| ExtrNative.Eq -> CompEqT
+| ExtrNative.Lt -> CompLtT
+| ExtrNative.Gt -> CompGtT
+
+type 'a compSpecT = compareSpecT
+
+(** val compSpec2Type :
+    'a1 -> 'a1 -> ExtrNative.comparison -> 'a1 compSpecT **)
+
+let compSpec2Type x y c =
+  compareSpec2Type c
+
+type 'a sig0 =
+  'a
+  (* singleton inductive, whose constructor was exist *)
+
+type sumbool =
+| Left
+| Right
+
+type 'a sumor =
+| Inleft of 'a
+| Inright
+
+(** val plus : nat -> nat -> nat **)
+
+let rec plus n0 m =
+  match n0 with
+  | O -> m
+  | S p -> S (plus p m)
+
+(** val nat_iter : nat -> ('a1 -> 'a1) -> 'a1 -> 'a1 **)
+
+let rec nat_iter n0 f x =
+  match n0 with
+  | O -> x
+  | S n' -> f (nat_iter n' f x)
+
+type positive =
+| XI of positive
+| XO of positive
+| XH
+
+type n =
+| N0
+| Npos of positive
+
+type z =
+| Z0
+| Zpos of positive
+| Zneg of positive
+
+(** val eqb : bool -> bool -> bool **)
+
+let eqb b1 b2 =
+  if b1 then b2 else if b2 then false else true
+
+type reflect =
+| ReflectT
+| ReflectF
+
+(** val iff_reflect : bool -> reflect **)
+
+let iff_reflect = function
+| true -> ReflectT
+| false -> ReflectF
+
+module type TotalOrder' = 
+ sig 
+  type t 
+ end
+
+module MakeOrderTac = 
+ functor (O:TotalOrder') ->
+ struct 
+  
+ end
+
+module MaxLogicalProperties = 
+ functor (O:TotalOrder') ->
+ functor (M:sig 
+  val max : O.t -> O.t -> O.t
+ end) ->
+ struct 
+  module Private_Tac = MakeOrderTac(O)
+ end
+
+module Pos = 
+ struct 
+  type t = positive
+  
+  (** val succ : positive -> positive **)
+  
+  let rec succ = function
+  | XI p -> XO (succ p)
+  | XO p -> XI p
+  | XH -> XO XH
+  
+  (** val add : positive -> positive -> positive **)
+  
+  let rec add x y =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q -> XO (add_carry p q)
+       | XO q -> XI (add p q)
+       | XH -> XO (succ p))
+    | XO p ->
+      (match y with
+       | XI q -> XI (add p q)
+       | XO q -> XO (add p q)
+       | XH -> XI p)
+    | XH ->
+      (match y with
+       | XI q -> XO (succ q)
+       | XO q -> XI q
+       | XH -> XO XH)
+  
+  (** val add_carry : positive -> positive -> positive **)
+  
+  and add_carry x y =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q -> XI (add_carry p q)
+       | XO q -> XO (add_carry p q)
+       | XH -> XI (succ p))
+    | XO p ->
+      (match y with
+       | XI q -> XO (add_carry p q)
+       | XO q -> XI (add p q)
+       | XH -> XO (succ p))
+    | XH ->
+      (match y with
+       | XI q -> XI (succ q)
+       | XO q -> XO (succ q)
+       | XH -> XI XH)
+  
+  (** val pred_double : positive -> positive **)
+  
+  let rec pred_double = function
+  | XI p -> XI (XO p)
+  | XO p -> XI (pred_double p)
+  | XH -> XH
+  
+  (** val pred : positive -> positive **)
+  
+  let pred = function
+  | XI p -> XO p
+  | XO p -> pred_double p
+  | XH -> XH
+  
+  (** val pred_N : positive -> n **)
+  
+  let pred_N = function
+  | XI p -> Npos (XO p)
+  | XO p -> Npos (pred_double p)
+  | XH -> N0
+  
+  type mask =
+  | IsNul
+  | IsPos of positive
+  | IsNeg
+  
+  (** val mask_rect : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 **)
+  
+  let mask_rect f f0 f1 = function
+  | IsNul -> f
+  | IsPos x -> f0 x
+  | IsNeg -> f1
+  
+  (** val mask_rec : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 **)
+  
+  let mask_rec f f0 f1 = function
+  | IsNul -> f
+  | IsPos x -> f0 x
+  | IsNeg -> f1
+  
+  (** val succ_double_mask : mask -> mask **)
+  
+  let succ_double_mask = function
+  | IsNul -> IsPos XH
+  | IsPos p -> IsPos (XI p)
+  | IsNeg -> IsNeg
+  
+  (** val double_mask : mask -> mask **)
+  
+  let double_mask = function
+  | IsPos p -> IsPos (XO p)
+  | x0 -> x0
+  
+  (** val double_pred_mask : positive -> mask **)
+  
+  let double_pred_mask = function
+  | XI p -> IsPos (XO (XO p))
+  | XO p -> IsPos (XO (pred_double p))
+  | XH -> IsNul
+  
+  (** val pred_mask : mask -> mask **)
+  
+  let pred_mask = function
+  | IsPos q ->
+    (match q with
+     | XH -> IsNul
+     | _ -> IsPos (pred q))
+  | _ -> IsNeg
+  
+  (** val sub_mask : positive -> positive -> mask **)
+  
+  let rec sub_mask x y =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q -> double_mask (sub_mask p q)
+       | XO q -> succ_double_mask (sub_mask p q)
+       | XH -> IsPos (XO p))
+    | XO p ->
+      (match y with
+       | XI q -> succ_double_mask (sub_mask_carry p q)
+       | XO q -> double_mask (sub_mask p q)
+       | XH -> IsPos (pred_double p))
+    | XH ->
+      (match y with
+       | XH -> IsNul
+       | _ -> IsNeg)
+  
+  (** val sub_mask_carry : positive -> positive -> mask **)
+  
+  and sub_mask_carry x y =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q -> succ_double_mask (sub_mask_carry p q)
+       | XO q -> double_mask (sub_mask p q)
+       | XH -> IsPos (pred_double p))
+    | XO p ->
+      (match y with
+       | XI q -> double_mask (sub_mask_carry p q)
+       | XO q -> succ_double_mask (sub_mask_carry p q)
+       | XH -> double_pred_mask p)
+    | XH -> IsNeg
+  
+  (** val sub : positive -> positive -> positive **)
+  
+  let sub x y =
+    match sub_mask x y with
+    | IsPos z0 -> z0
+    | _ -> XH
+  
+  (** val mul : positive -> positive -> positive **)
+  
+  let rec mul x y =
+    match x with
+    | XI p -> add y (XO (mul p y))
+    | XO p -> XO (mul p y)
+    | XH -> y
+  
+  (** val iter : positive -> ('a1 -> 'a1) -> 'a1 -> 'a1 **)
+  
+  let rec iter n0 f x =
+    match n0 with
+    | XI n' -> f (iter n' f (iter n' f x))
+    | XO n' -> iter n' f (iter n' f x)
+    | XH -> f x
+  
+  (** val pow : positive -> positive -> positive **)
+  
+  let pow x y =
+    iter y (mul x) XH
+  
+  (** val square : positive -> positive **)
+  
+  let rec square = function
+  | XI p2 -> XI (XO (add (square p2) p2))
+  | XO p2 -> XO (XO (square p2))
+  | XH -> XH
+  
+  (** val div2 : positive -> positive **)
+  
+  let div2 = function
+  | XI p2 -> p2
+  | XO p2 -> p2
+  | XH -> XH
+  
+  (** val div2_up : positive -> positive **)
+  
+  let div2_up = function
+  | XI p2 -> succ p2
+  | XO p2 -> p2
+  | XH -> XH
+  
+  (** val size_nat : positive -> nat **)
+  
+  let rec size_nat = function
+  | XI p2 -> S (size_nat p2)
+  | XO p2 -> S (size_nat p2)
+  | XH -> S O
+  
+  (** val size : positive -> positive **)
+  
+  let rec size = function
+  | XI p2 -> succ (size p2)
+  | XO p2 -> succ (size p2)
+  | XH -> XH
+  
+  (** val compare_cont :
+      positive -> positive -> ExtrNative.comparison -> ExtrNative.comparison **)
+  
+  let rec compare_cont x y r =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q -> compare_cont p q r
+       | XO q -> compare_cont p q ExtrNative.Gt
+       | XH -> ExtrNative.Gt)
+    | XO p ->
+      (match y with
+       | XI q -> compare_cont p q ExtrNative.Lt
+       | XO q -> compare_cont p q r
+       | XH -> ExtrNative.Gt)
+    | XH ->
+      (match y with
+       | XH -> r
+       | _ -> ExtrNative.Lt)
+  
+  (** val compare : positive -> positive -> ExtrNative.comparison **)
+  
+  let compare x y =
+    compare_cont x y ExtrNative.Eq
+  
+  (** val min : positive -> positive -> positive **)
+  
+  let min p p' =
+    match compare p p' with
+    | ExtrNative.Gt -> p'
+    | _ -> p
+  
+  (** val max : positive -> positive -> positive **)
+  
+  let max p p' =
+    match compare p p' with
+    | ExtrNative.Gt -> p
+    | _ -> p'
+  
+  (** val eqb : positive -> positive -> bool **)
+  
+  let rec eqb p q =
+    match p with
+    | XI p2 ->
+      (match q with
+       | XI q0 -> eqb p2 q0
+       | _ -> false)
+    | XO p2 ->
+      (match q with
+       | XO q0 -> eqb p2 q0
+       | _ -> false)
+    | XH ->
+      (match q with
+       | XH -> true
+       | _ -> false)
+  
+  (** val leb : positive -> positive -> bool **)
+  
+  let leb x y =
+    match compare x y with
+    | ExtrNative.Gt -> false
+    | _ -> true
+  
+  (** val ltb : positive -> positive -> bool **)
+  
+  let ltb x y =
+    match compare x y with
+    | ExtrNative.Lt -> true
+    | _ -> false
+  
+  (** val sqrtrem_step :
+      (positive -> positive) -> (positive -> positive) -> (positive*mask) ->
+      positive*mask **)
+  
+  let sqrtrem_step f g = function
+  | s,y ->
+    (match y with
+     | IsPos r ->
+       let s' = XI (XO s) in
+       let r' = g (f r) in
+       if leb s' r' then (XI s),(sub_mask r' s') else (XO s),(IsPos r')
+     | _ -> (XO s),(sub_mask (g (f XH)) (XO (XO XH))))
+  
+  (** val sqrtrem : positive -> positive*mask **)
+  
+  let rec sqrtrem = function
+  | XI p2 ->
+    (match p2 with
+     | XI p3 -> sqrtrem_step (fun x -> XI x) (fun x -> XI x) (sqrtrem p3)
+     | XO p3 -> sqrtrem_step (fun x -> XO x) (fun x -> XI x) (sqrtrem p3)
+     | XH -> XH,(IsPos (XO XH)))
+  | XO p2 ->
+    (match p2 with
+     | XI p3 -> sqrtrem_step (fun x -> XI x) (fun x -> XO x) (sqrtrem p3)
+     | XO p3 -> sqrtrem_step (fun x -> XO x) (fun x -> XO x) (sqrtrem p3)
+     | XH -> XH,(IsPos XH))
+  | XH -> XH,IsNul
+  
+  (** val sqrt : positive -> positive **)
+  
+  let sqrt p =
+    fst (sqrtrem p)
+  
+  (** val gcdn : nat -> positive -> positive -> positive **)
+  
+  let rec gcdn n0 a b =
+    match n0 with
+    | O -> XH
+    | S n1 ->
+      (match a with
+       | XI a' ->
+         (match b with
+          | XI b' ->
+            (match compare a' b' with
+             | ExtrNative.Eq -> a
+             | ExtrNative.Lt -> gcdn n1 (sub b' a') a
+             | ExtrNative.Gt -> gcdn n1 (sub a' b') b)
+          | XO b0 -> gcdn n1 a b0
+          | XH -> XH)
+       | XO a0 ->
+         (match b with
+          | XI p -> gcdn n1 a0 b
+          | XO b0 -> XO (gcdn n1 a0 b0)
+          | XH -> XH)
+       | XH -> XH)
+  
+  (** val gcd : positive -> positive -> positive **)
+  
+  let gcd a b =
+    gcdn (plus (size_nat a) (size_nat b)) a b
+  
+  (** val ggcdn :
+      nat -> positive -> positive -> positive*(positive*positive) **)
+  
+  let rec ggcdn n0 a b =
+    match n0 with
+    | O -> XH,(a,b)
+    | S n1 ->
+      (match a with
+       | XI a' ->
+         (match b with
+          | XI b' ->
+            (match compare a' b' with
+             | ExtrNative.Eq -> a,(XH,XH)
+             | ExtrNative.Lt ->
+               let g,p = ggcdn n1 (sub b' a') a in
+               let ba,aa = p in g,(aa,(add aa (XO ba)))
+             | ExtrNative.Gt ->
+               let g,p = ggcdn n1 (sub a' b') b in
+               let ab,bb = p in g,((add bb (XO ab)),bb))
+          | XO b0 ->
+            let g,p = ggcdn n1 a b0 in let aa,bb = p in g,(aa,(XO bb))
+          | XH -> XH,(a,XH))
+       | XO a0 ->
+         (match b with
+          | XI p ->
+            let g,p2 = ggcdn n1 a0 b in let aa,bb = p2 in g,((XO aa),bb)
+          | XO b0 -> let g,p = ggcdn n1 a0 b0 in (XO g),p
+          | XH -> XH,(a,XH))
+       | XH -> XH,(XH,b))
+  
+  (** val ggcd : positive -> positive -> positive*(positive*positive) **)
+  
+  let ggcd a b =
+    ggcdn (plus (size_nat a) (size_nat b)) a b
+  
+  (** val coq_Nsucc_double : n -> n **)
+  
+  let coq_Nsucc_double = function
+  | N0 -> Npos XH
+  | Npos p -> Npos (XI p)
+  
+  (** val coq_Ndouble : n -> n **)
+  
+  let coq_Ndouble = function
+  | N0 -> N0
+  | Npos p -> Npos (XO p)
+  
+  (** val coq_lor : positive -> positive -> positive **)
+  
+  let rec coq_lor p q =
+    match p with
+    | XI p2 ->
+      (match q with
+       | XI q0 -> XI (coq_lor p2 q0)
+       | XO q0 -> XI (coq_lor p2 q0)
+       | XH -> p)
+    | XO p2 ->
+      (match q with
+       | XI q0 -> XI (coq_lor p2 q0)
+       | XO q0 -> XO (coq_lor p2 q0)
+       | XH -> XI p2)
+    | XH ->
+      (match q with
+       | XO q0 -> XI q0
+       | _ -> q)
+  
+  (** val coq_land : positive -> positive -> n **)
+  
+  let rec coq_land p q =
+    match p with
+    | XI p2 ->
+      (match q with
+       | XI q0 -> coq_Nsucc_double (coq_land p2 q0)
+       | XO q0 -> coq_Ndouble (coq_land p2 q0)
+       | XH -> Npos XH)
+    | XO p2 ->
+      (match q with
+       | XI q0 -> coq_Ndouble (coq_land p2 q0)
+       | XO q0 -> coq_Ndouble (coq_land p2 q0)
+       | XH -> N0)
+    | XH ->
+      (match q with
+       | XO q0 -> N0
+       | _ -> Npos XH)
+  
+  (** val ldiff : positive -> positive -> n **)
+  
+  let rec ldiff p q =
+    match p with
+    | XI p2 ->
+      (match q with
+       | XI q0 -> coq_Ndouble (ldiff p2 q0)
+       | XO q0 -> coq_Nsucc_double (ldiff p2 q0)
+       | XH -> Npos (XO p2))
+    | XO p2 ->
+      (match q with
+       | XI q0 -> coq_Ndouble (ldiff p2 q0)
+       | XO q0 -> coq_Ndouble (ldiff p2 q0)
+       | XH -> Npos p)
+    | XH ->
+      (match q with
+       | XO q0 -> Npos XH
+       | _ -> N0)
+  
+  (** val coq_lxor : positive -> positive -> n **)
+  
+  let rec coq_lxor p q =
+    match p with
+    | XI p2 ->
+      (match q with
+       | XI q0 -> coq_Ndouble (coq_lxor p2 q0)
+       | XO q0 -> coq_Nsucc_double (coq_lxor p2 q0)
+       | XH -> Npos (XO p2))
+    | XO p2 ->
+      (match q with
+       | XI q0 -> coq_Nsucc_double (coq_lxor p2 q0)
+       | XO q0 -> coq_Ndouble (coq_lxor p2 q0)
+       | XH -> Npos (XI p2))
+    | XH ->
+      (match q with
+       | XI q0 -> Npos (XO q0)
+       | XO q0 -> Npos (XI q0)
+       | XH -> N0)
+  
+  (** val shiftl_nat : positive -> nat -> positive **)
+  
+  let shiftl_nat p n0 =
+    nat_iter n0 (fun x -> XO x) p
+  
+  (** val shiftr_nat : positive -> nat -> positive **)
+  
+  let shiftr_nat p n0 =
+    nat_iter n0 div2 p
+  
+  (** val shiftl : positive -> n -> positive **)
+  
+  let shiftl p = function
+  | N0 -> p
+  | Npos n1 -> iter n1 (fun x -> XO x) p
+  
+  (** val shiftr : positive -> n -> positive **)
+  
+  let shiftr p = function
+  | N0 -> p
+  | Npos n1 -> iter n1 div2 p
+  
+  (** val testbit_nat : positive -> nat -> bool **)
+  
+  let rec testbit_nat p n0 =
+    match p with
+    | XI p2 ->
+      (match n0 with
+       | O -> true
+       | S n' -> testbit_nat p2 n')
+    | XO p2 ->
+      (match n0 with
+       | O -> false
+       | S n' -> testbit_nat p2 n')
+    | XH ->
+      (match n0 with
+       | O -> true
+       | S n1 -> false)
+  
+  (** val testbit : positive -> n -> bool **)
+  
+  let rec testbit p n0 =
+    match p with
+    | XI p2 ->
+      (match n0 with
+       | N0 -> true
+       | Npos n1 -> testbit p2 (pred_N n1))
+    | XO p2 ->
+      (match n0 with
+       | N0 -> false
+       | Npos n1 -> testbit p2 (pred_N n1))
+    | XH ->
+      (match n0 with
+       | N0 -> true
+       | Npos p2 -> false)
+  
+  (** val iter_op : ('a1 -> 'a1 -> 'a1) -> positive -> 'a1 -> 'a1 **)
+  
+  let rec iter_op op p a =
+    match p with
+    | XI p2 -> op a (iter_op op p2 (op a a))
+    | XO p2 -> iter_op op p2 (op a a)
+    | XH -> a
+  
+  (** val to_nat : positive -> nat **)
+  
+  let to_nat x =
+    iter_op plus x (S O)
+  
+  (** val of_nat : nat -> positive **)
+  
+  let rec of_nat = function
+  | O -> XH
+  | S x ->
+    (match x with
+     | O -> XH
+     | S n1 -> succ (of_nat x))
+  
+  (** val of_succ_nat : nat -> positive **)
+  
+  let rec of_succ_nat = function
+  | O -> XH
+  | S x -> succ (of_succ_nat x)
+ end
+
+module Coq_Pos = 
+ struct 
+  module Coq__1 = struct 
+   type t = positive
+  end
+  type t = Coq__1.t
+  
+  (** val succ : positive -> positive **)
+  
+  let rec succ = function
+  | XI p -> XO (succ p)
+  | XO p -> XI p
+  | XH -> XO XH
+  
+  (** val add : positive -> positive -> positive **)
+  
+  let rec add x y =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q -> XO (add_carry p q)
+       | XO q -> XI (add p q)
+       | XH -> XO (succ p))
+    | XO p ->
+      (match y with
+       | XI q -> XI (add p q)
+       | XO q -> XO (add p q)
+       | XH -> XI p)
+    | XH ->
+      (match y with
+       | XI q -> XO (succ q)
+       | XO q -> XI q
+       | XH -> XO XH)
+  
+  (** val add_carry : positive -> positive -> positive **)
+  
+  and add_carry x y =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q -> XI (add_carry p q)
+       | XO q -> XO (add_carry p q)
+       | XH -> XI (succ p))
+    | XO p ->
+      (match y with
+       | XI q -> XO (add_carry p q)
+       | XO q -> XI (add p q)
+       | XH -> XO (succ p))
+    | XH ->
+      (match y with
+       | XI q -> XI (succ q)
+       | XO q -> XO (succ q)
+       | XH -> XI XH)
+  
+  (** val pred_double : positive -> positive **)
+  
+  let rec pred_double = function
+  | XI p -> XI (XO p)
+  | XO p -> XI (pred_double p)
+  | XH -> XH
+  
+  (** val pred : positive -> positive **)
+  
+  let pred = function
+  | XI p -> XO p
+  | XO p -> pred_double p
+  | XH -> XH
+  
+  (** val pred_N : positive -> n **)
+  
+  let pred_N = function
+  | XI p -> Npos (XO p)
+  | XO p -> Npos (pred_double p)
+  | XH -> N0
+  
+  type mask = Pos.mask =
+  | IsNul
+  | IsPos of positive
+  | IsNeg
+  
+  (** val mask_rect : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 **)
+  
+  let mask_rect f f0 f1 = function
+  | IsNul -> f
+  | IsPos x -> f0 x
+  | IsNeg -> f1
+  
+  (** val mask_rec : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 **)
+  
+  let mask_rec f f0 f1 = function
+  | IsNul -> f
+  | IsPos x -> f0 x
+  | IsNeg -> f1
+  
+  (** val succ_double_mask : mask -> mask **)
+  
+  let succ_double_mask = function
+  | IsNul -> IsPos XH
+  | IsPos p -> IsPos (XI p)
+  | IsNeg -> IsNeg
+  
+  (** val double_mask : mask -> mask **)
+  
+  let double_mask = function
+  | IsPos p -> IsPos (XO p)
+  | x0 -> x0
+  
+  (** val double_pred_mask : positive -> mask **)
+  
+  let double_pred_mask = function
+  | XI p -> IsPos (XO (XO p))
+  | XO p -> IsPos (XO (pred_double p))
+  | XH -> IsNul
+  
+  (** val pred_mask : mask -> mask **)
+  
+  let pred_mask = function
+  | IsPos q ->
+    (match q with
+     | XH -> IsNul
+     | _ -> IsPos (pred q))
+  | _ -> IsNeg
+  
+  (** val sub_mask : positive -> positive -> mask **)
+  
+  let rec sub_mask x y =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q -> double_mask (sub_mask p q)
+       | XO q -> succ_double_mask (sub_mask p q)
+       | XH -> IsPos (XO p))
+    | XO p ->
+      (match y with
+       | XI q -> succ_double_mask (sub_mask_carry p q)
+       | XO q -> double_mask (sub_mask p q)
+       | XH -> IsPos (pred_double p))
+    | XH ->
+      (match y with
+       | XH -> IsNul
+       | _ -> IsNeg)
+  
+  (** val sub_mask_carry : positive -> positive -> mask **)
+  
+  and sub_mask_carry x y =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q -> succ_double_mask (sub_mask_carry p q)
+       | XO q -> double_mask (sub_mask p q)
+       | XH -> IsPos (pred_double p))
+    | XO p ->
+      (match y with
+       | XI q -> double_mask (sub_mask_carry p q)
+       | XO q -> succ_double_mask (sub_mask_carry p q)
+       | XH -> double_pred_mask p)
+    | XH -> IsNeg
+  
+  (** val sub : positive -> positive -> positive **)
+  
+  let sub x y =
+    match sub_mask x y with
+    | IsPos z0 -> z0
+    | _ -> XH
+  
+  (** val mul : positive -> positive -> positive **)
+  
+  let rec mul x y =
+    match x with
+    | XI p -> add y (XO (mul p y))
+    | XO p -> XO (mul p y)
+    | XH -> y
+  
+  (** val iter : positive -> ('a1 -> 'a1) -> 'a1 -> 'a1 **)
+  
+  let rec iter n0 f x =
+    match n0 with
+    | XI n' -> f (iter n' f (iter n' f x))
+    | XO n' -> iter n' f (iter n' f x)
+    | XH -> f x
+  
+  (** val pow : positive -> positive -> positive **)
+  
+  let pow x y =
+    iter y (mul x) XH
+  
+  (** val square : positive -> positive **)
+  
+  let rec square = function
+  | XI p2 -> XI (XO (add (square p2) p2))
+  | XO p2 -> XO (XO (square p2))
+  | XH -> XH
+  
+  (** val div2 : positive -> positive **)
+  
+  let div2 = function
+  | XI p2 -> p2
+  | XO p2 -> p2
+  | XH -> XH
+  
+  (** val div2_up : positive -> positive **)
+  
+  let div2_up = function
+  | XI p2 -> succ p2
+  | XO p2 -> p2
+  | XH -> XH
+  
+  (** val size_nat : positive -> nat **)
+  
+  let rec size_nat = function
+  | XI p2 -> S (size_nat p2)
+  | XO p2 -> S (size_nat p2)
+  | XH -> S O
+  
+  (** val size : positive -> positive **)
+  
+  let rec size = function
+  | XI p2 -> succ (size p2)
+  | XO p2 -> succ (size p2)
+  | XH -> XH
+  
+  (** val compare_cont :
+      positive -> positive -> ExtrNative.comparison -> ExtrNative.comparison **)
+  
+  let rec compare_cont x y r =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q -> compare_cont p q r
+       | XO q -> compare_cont p q ExtrNative.Gt
+       | XH -> ExtrNative.Gt)
+    | XO p ->
+      (match y with
+       | XI q -> compare_cont p q ExtrNative.Lt
+       | XO q -> compare_cont p q r
+       | XH -> ExtrNative.Gt)
+    | XH ->
+      (match y with
+       | XH -> r
+       | _ -> ExtrNative.Lt)
+  
+  (** val compare : positive -> positive -> ExtrNative.comparison **)
+  
+  let compare x y =
+    compare_cont x y ExtrNative.Eq
+  
+  (** val min : positive -> positive -> positive **)
+  
+  let min p p' =
+    match compare p p' with
+    | ExtrNative.Gt -> p'
+    | _ -> p
+  
+  (** val max : positive -> positive -> positive **)
+  
+  let max p p' =
+    match compare p p' with
+    | ExtrNative.Gt -> p
+    | _ -> p'
+  
+  (** val eqb : positive -> positive -> bool **)
+  
+  let rec eqb p q =
+    match p with
+    | XI p2 ->
+      (match q with
+       | XI q0 -> eqb p2 q0
+       | _ -> false)
+    | XO p2 ->
+      (match q with
+       | XO q0 -> eqb p2 q0
+       | _ -> false)
+    | XH ->
+      (match q with
+       | XH -> true
+       | _ -> false)
+  
+  (** val leb : positive -> positive -> bool **)
+  
+  let leb x y =
+    match compare x y with
+    | ExtrNative.Gt -> false
+    | _ -> true
+  
+  (** val ltb : positive -> positive -> bool **)
+  
+  let ltb x y =
+    match compare x y with
+    | ExtrNative.Lt -> true
+    | _ -> false
+  
+  (** val sqrtrem_step :
+      (positive -> positive) -> (positive -> positive) -> (positive*mask) ->
+      positive*mask **)
+  
+  let sqrtrem_step f g = function
+  | s,y ->
+    (match y with
+     | IsPos r ->
+       let s' = XI (XO s) in
+       let r' = g (f r) in
+       if leb s' r' then (XI s),(sub_mask r' s') else (XO s),(IsPos r')
+     | _ -> (XO s),(sub_mask (g (f XH)) (XO (XO XH))))
+  
+  (** val sqrtrem : positive -> positive*mask **)
+  
+  let rec sqrtrem = function
+  | XI p2 ->
+    (match p2 with
+     | XI p3 -> sqrtrem_step (fun x -> XI x) (fun x -> XI x) (sqrtrem p3)
+     | XO p3 -> sqrtrem_step (fun x -> XO x) (fun x -> XI x) (sqrtrem p3)
+     | XH -> XH,(IsPos (XO XH)))
+  | XO p2 ->
+    (match p2 with
+     | XI p3 -> sqrtrem_step (fun x -> XI x) (fun x -> XO x) (sqrtrem p3)
+     | XO p3 -> sqrtrem_step (fun x -> XO x) (fun x -> XO x) (sqrtrem p3)
+     | XH -> XH,(IsPos XH))
+  | XH -> XH,IsNul
+  
+  (** val sqrt : positive -> positive **)
+  
+  let sqrt p =
+    fst (sqrtrem p)
+  
+  (** val gcdn : nat -> positive -> positive -> positive **)
+  
+  let rec gcdn n0 a b =
+    match n0 with
+    | O -> XH
+    | S n1 ->
+      (match a with
+       | XI a' ->
+         (match b with
+          | XI b' ->
+            (match compare a' b' with
+             | ExtrNative.Eq -> a
+             | ExtrNative.Lt -> gcdn n1 (sub b' a') a
+             | ExtrNative.Gt -> gcdn n1 (sub a' b') b)
+          | XO b0 -> gcdn n1 a b0
+          | XH -> XH)
+       | XO a0 ->
+         (match b with
+          | XI p -> gcdn n1 a0 b
+          | XO b0 -> XO (gcdn n1 a0 b0)
+          | XH -> XH)
+       | XH -> XH)
+  
+  (** val gcd : positive -> positive -> positive **)
+  
+  let gcd a b =
+    gcdn (plus (size_nat a) (size_nat b)) a b
+  
+  (** val ggcdn :
+      nat -> positive -> positive -> positive*(positive*positive) **)
+  
+  let rec ggcdn n0 a b =
+    match n0 with
+    | O -> XH,(a,b)
+    | S n1 ->
+      (match a with
+       | XI a' ->
+         (match b with
+          | XI b' ->
+            (match compare a' b' with
+             | ExtrNative.Eq -> a,(XH,XH)
+             | ExtrNative.Lt ->
+               let g,p = ggcdn n1 (sub b' a') a in
+               let ba,aa = p in g,(aa,(add aa (XO ba)))
+             | ExtrNative.Gt ->
+               let g,p = ggcdn n1 (sub a' b') b in
+               let ab,bb = p in g,((add bb (XO ab)),bb))
+          | XO b0 ->
+            let g,p = ggcdn n1 a b0 in let aa,bb = p in g,(aa,(XO bb))
+          | XH -> XH,(a,XH))
+       | XO a0 ->
+         (match b with
+          | XI p ->
+            let g,p2 = ggcdn n1 a0 b in let aa,bb = p2 in g,((XO aa),bb)
+          | XO b0 -> let g,p = ggcdn n1 a0 b0 in (XO g),p
+          | XH -> XH,(a,XH))
+       | XH -> XH,(XH,b))
+  
+  (** val ggcd : positive -> positive -> positive*(positive*positive) **)
+  
+  let ggcd a b =
+    ggcdn (plus (size_nat a) (size_nat b)) a b
+  
+  (** val coq_Nsucc_double : n -> n **)
+  
+  let coq_Nsucc_double = function
+  | N0 -> Npos XH
+  | Npos p -> Npos (XI p)
+  
+  (** val coq_Ndouble : n -> n **)
+  
+  let coq_Ndouble = function
+  | N0 -> N0
+  | Npos p -> Npos (XO p)
+  
+  (** val coq_lor : positive -> positive -> positive **)
+  
+  let rec coq_lor p q =
+    match p with
+    | XI p2 ->
+      (match q with
+       | XI q0 -> XI (coq_lor p2 q0)
+       | XO q0 -> XI (coq_lor p2 q0)
+       | XH -> p)
+    | XO p2 ->
+      (match q with
+       | XI q0 -> XI (coq_lor p2 q0)
+       | XO q0 -> XO (coq_lor p2 q0)
+       | XH -> XI p2)
+    | XH ->
+      (match q with
+       | XO q0 -> XI q0
+       | _ -> q)
+  
+  (** val coq_land : positive -> positive -> n **)
+  
+  let rec coq_land p q =
+    match p with
+    | XI p2 ->
+      (match q with
+       | XI q0 -> coq_Nsucc_double (coq_land p2 q0)
+       | XO q0 -> coq_Ndouble (coq_land p2 q0)
+       | XH -> Npos XH)
+    | XO p2 ->
+      (match q with
+       | XI q0 -> coq_Ndouble (coq_land p2 q0)
+       | XO q0 -> coq_Ndouble (coq_land p2 q0)
+       | XH -> N0)
+    | XH ->
+      (match q with
+       | XO q0 -> N0
+       | _ -> Npos XH)
+  
+  (** val ldiff : positive -> positive -> n **)
+  
+  let rec ldiff p q =
+    match p with
+    | XI p2 ->
+      (match q with
+       | XI q0 -> coq_Ndouble (ldiff p2 q0)
+       | XO q0 -> coq_Nsucc_double (ldiff p2 q0)
+       | XH -> Npos (XO p2))
+    | XO p2 ->
+      (match q with
+       | XI q0 -> coq_Ndouble (ldiff p2 q0)
+       | XO q0 -> coq_Ndouble (ldiff p2 q0)
+       | XH -> Npos p)
+    | XH ->
+      (match q with
+       | XO q0 -> Npos XH
+       | _ -> N0)
+  
+  (** val coq_lxor : positive -> positive -> n **)
+  
+  let rec coq_lxor p q =
+    match p with
+    | XI p2 ->
+      (match q with
+       | XI q0 -> coq_Ndouble (coq_lxor p2 q0)
+       | XO q0 -> coq_Nsucc_double (coq_lxor p2 q0)
+       | XH -> Npos (XO p2))
+    | XO p2 ->
+      (match q with
+       | XI q0 -> coq_Nsucc_double (coq_lxor p2 q0)
+       | XO q0 -> coq_Ndouble (coq_lxor p2 q0)
+       | XH -> Npos (XI p2))
+    | XH ->
+      (match q with
+       | XI q0 -> Npos (XO q0)
+       | XO q0 -> Npos (XI q0)
+       | XH -> N0)
+  
+  (** val shiftl_nat : positive -> nat -> positive **)
+  
+  let shiftl_nat p n0 =
+    nat_iter n0 (fun x -> XO x) p
+  
+  (** val shiftr_nat : positive -> nat -> positive **)
+  
+  let shiftr_nat p n0 =
+    nat_iter n0 div2 p
+  
+  (** val shiftl : positive -> n -> positive **)
+  
+  let shiftl p = function
+  | N0 -> p
+  | Npos n1 -> iter n1 (fun x -> XO x) p
+  
+  (** val shiftr : positive -> n -> positive **)
+  
+  let shiftr p = function
+  | N0 -> p
+  | Npos n1 -> iter n1 div2 p
+  
+  (** val testbit_nat : positive -> nat -> bool **)
+  
+  let rec testbit_nat p n0 =
+    match p with
+    | XI p2 ->
+      (match n0 with
+       | O -> true
+       | S n' -> testbit_nat p2 n')
+    | XO p2 ->
+      (match n0 with
+       | O -> false
+       | S n' -> testbit_nat p2 n')
+    | XH ->
+      (match n0 with
+       | O -> true
+       | S n1 -> false)
+  
+  (** val testbit : positive -> n -> bool **)
+  
+  let rec testbit p n0 =
+    match p with
+    | XI p2 ->
+      (match n0 with
+       | N0 -> true
+       | Npos n1 -> testbit p2 (pred_N n1))
+    | XO p2 ->
+      (match n0 with
+       | N0 -> false
+       | Npos n1 -> testbit p2 (pred_N n1))
+    | XH ->
+      (match n0 with
+       | N0 -> true
+       | Npos p2 -> false)
+  
+  (** val iter_op : ('a1 -> 'a1 -> 'a1) -> positive -> 'a1 -> 'a1 **)
+  
+  let rec iter_op op p a =
+    match p with
+    | XI p2 -> op a (iter_op op p2 (op a a))
+    | XO p2 -> iter_op op p2 (op a a)
+    | XH -> a
+  
+  (** val to_nat : positive -> nat **)
+  
+  let to_nat x =
+    iter_op plus x (S O)
+  
+  (** val of_nat : nat -> positive **)
+  
+  let rec of_nat = function
+  | O -> XH
+  | S x ->
+    (match x with
+     | O -> XH
+     | S n1 -> succ (of_nat x))
+  
+  (** val of_succ_nat : nat -> positive **)
+  
+  let rec of_succ_nat = function
+  | O -> XH
+  | S x -> succ (of_succ_nat x)
+  
+  (** val eq_dec : positive -> positive -> sumbool **)
+  
+  let rec eq_dec p y0 =
+    match p with
+    | XI p2 ->
+      (match y0 with
+       | XI p3 -> eq_dec p2 p3
+       | _ -> Right)
+    | XO p2 ->
+      (match y0 with
+       | XO p3 -> eq_dec p2 p3
+       | _ -> Right)
+    | XH ->
+      (match y0 with
+       | XH -> Left
+       | _ -> Right)
+  
+  (** val peano_rect : 'a1 -> (positive -> 'a1 -> 'a1) -> positive -> 'a1 **)
+  
+  let rec peano_rect a f p =
+    let f2 = peano_rect (f XH a) (fun p2 x -> f (succ (XO p2)) (f (XO p2) x))
+    in
+    (match p with
+     | XI q -> f (XO q) (f2 q)
+     | XO q -> f2 q
+     | XH -> a)
+  
+  (** val peano_rec : 'a1 -> (positive -> 'a1 -> 'a1) -> positive -> 'a1 **)
+  
+  let peano_rec =
+    peano_rect
+  
+  type coq_PeanoView =
+  | PeanoOne
+  | PeanoSucc of positive * coq_PeanoView
+  
+  (** val coq_PeanoView_rect :
+      'a1 -> (positive -> coq_PeanoView -> 'a1 -> 'a1) -> positive ->
+      coq_PeanoView -> 'a1 **)
+  
+  let rec coq_PeanoView_rect f f0 p = function
+  | PeanoOne -> f
+  | PeanoSucc (p3, p4) -> f0 p3 p4 (coq_PeanoView_rect f f0 p3 p4)
+  
+  (** val coq_PeanoView_rec :
+      'a1 -> (positive -> coq_PeanoView -> 'a1 -> 'a1) -> positive ->
+      coq_PeanoView -> 'a1 **)
+  
+  let rec coq_PeanoView_rec f f0 p = function
+  | PeanoOne -> f
+  | PeanoSucc (p3, p4) -> f0 p3 p4 (coq_PeanoView_rec f f0 p3 p4)
+  
+  (** val peanoView_xO : positive -> coq_PeanoView -> coq_PeanoView **)
+  
+  let rec peanoView_xO p = function
+  | PeanoOne -> PeanoSucc (XH, PeanoOne)
+  | PeanoSucc (p2, q0) ->
+    PeanoSucc ((succ (XO p2)), (PeanoSucc ((XO p2), (peanoView_xO p2 q0))))
+  
+  (** val peanoView_xI : positive -> coq_PeanoView -> coq_PeanoView **)
+  
+  let rec peanoView_xI p = function
+  | PeanoOne -> PeanoSucc ((succ XH), (PeanoSucc (XH, PeanoOne)))
+  | PeanoSucc (p2, q0) ->
+    PeanoSucc ((succ (XI p2)), (PeanoSucc ((XI p2), (peanoView_xI p2 q0))))
+  
+  (** val peanoView : positive -> coq_PeanoView **)
+  
+  let rec peanoView = function
+  | XI p2 -> peanoView_xI p2 (peanoView p2)
+  | XO p2 -> peanoView_xO p2 (peanoView p2)
+  | XH -> PeanoOne
+  
+  (** val coq_PeanoView_iter :
+      'a1 -> (positive -> 'a1 -> 'a1) -> positive -> coq_PeanoView -> 'a1 **)
+  
+  let rec coq_PeanoView_iter a f p = function
+  | PeanoOne -> a
+  | PeanoSucc (p2, q0) -> f p2 (coq_PeanoView_iter a f p2 q0)
+  
+  (** val eqb_spec : positive -> positive -> reflect **)
+  
+  let eqb_spec x y =
+    iff_reflect (eqb x y)
+  
+  (** val switch_Eq :
+      ExtrNative.comparison -> ExtrNative.comparison -> ExtrNative.comparison **)
+  
+  let switch_Eq c = function
+  | ExtrNative.Eq -> c
+  | x -> x
+  
+  (** val mask2cmp : mask -> ExtrNative.comparison **)
+  
+  let mask2cmp = function
+  | IsNul -> ExtrNative.Eq
+  | IsPos p2 -> ExtrNative.Gt
+  | IsNeg -> ExtrNative.Lt
+  
+  (** val leb_spec0 : positive -> positive -> reflect **)
+  
+  let leb_spec0 x y =
+    iff_reflect (leb x y)
+  
+  (** val ltb_spec0 : positive -> positive -> reflect **)
+  
+  let ltb_spec0 x y =
+    iff_reflect (ltb x y)
+  
+  module Private_Tac = 
+   struct 
+    
+   end
+  
+  module Private_Rev = 
+   struct 
+    module ORev = 
+     struct 
+      type t = Coq__1.t
+     end
+    
+    module MRev = 
+     struct 
+      (** val max : t -> t -> t **)
+      
+      let max x y =
+        min y x
+     end
+    
+    module MPRev = MaxLogicalProperties(ORev)(MRev)
+   end
+  
+  module Private_Dec = 
+   struct 
+    (** val max_case_strong :
+        t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1)
+        -> 'a1 **)
+    
+    let max_case_strong n0 m compat hl hr =
+      let c = compSpec2Type n0 m (compare n0 m) in
+      (match c with
+       | CompGtT -> compat n0 (max n0 m) __ (hl __)
+       | _ -> compat m (max n0 m) __ (hr __))
+    
+    (** val max_case :
+        t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1 **)
+    
+    let max_case n0 m x x0 x1 =
+      max_case_strong n0 m x (fun _ -> x0) (fun _ -> x1)
+    
+    (** val max_dec : t -> t -> sumbool **)
+    
+    let max_dec n0 m =
+      max_case n0 m (fun x y _ h0 -> h0) Left Right
+    
+    (** val min_case_strong :
+        t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1)
+        -> 'a1 **)
+    
+    let min_case_strong n0 m compat hl hr =
+      let c = compSpec2Type n0 m (compare n0 m) in
+      (match c with
+       | CompGtT -> compat m (min n0 m) __ (hr __)
+       | _ -> compat n0 (min n0 m) __ (hl __))
+    
+    (** val min_case :
+        t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1 **)
+    
+    let min_case n0 m x x0 x1 =
+      min_case_strong n0 m x (fun _ -> x0) (fun _ -> x1)
+    
+    (** val min_dec : t -> t -> sumbool **)
+    
+    let min_dec n0 m =
+      min_case n0 m (fun x y _ h0 -> h0) Left Right
+   end
+  
+  (** val max_case_strong : t -> t -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 **)
+  
+  let max_case_strong n0 m x x0 =
+    Private_Dec.max_case_strong n0 m (fun x1 y _ x2 -> x2) x x0
+  
+  (** val max_case : t -> t -> 'a1 -> 'a1 -> 'a1 **)
+  
+  let max_case n0 m x x0 =
+    max_case_strong n0 m (fun _ -> x) (fun _ -> x0)
+  
+  (** val max_dec : t -> t -> sumbool **)
+  
+  let max_dec =
+    Private_Dec.max_dec
+  
+  (** val min_case_strong : t -> t -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 **)
+  
+  let min_case_strong n0 m x x0 =
+    Private_Dec.min_case_strong n0 m (fun x1 y _ x2 -> x2) x x0
+  
+  (** val min_case : t -> t -> 'a1 -> 'a1 -> 'a1 **)
+  
+  let min_case n0 m x x0 =
+    min_case_strong n0 m (fun _ -> x) (fun _ -> x0)
+  
+  (** val min_dec : t -> t -> sumbool **)
+  
+  let min_dec =
+    Private_Dec.min_dec
+ end
+
+module N = 
+ struct 
+  type t = n
+  
+  (** val zero : n **)
+  
+  let zero =
+    N0
+  
+  (** val one : n **)
+  
+  let one =
+    Npos XH
+  
+  (** val two : n **)
+  
+  let two =
+    Npos (XO XH)
+  
+  (** val succ_double : n -> n **)
+  
+  let succ_double = function
+  | N0 -> Npos XH
+  | Npos p -> Npos (XI p)
+  
+  (** val double : n -> n **)
+  
+  let double = function
+  | N0 -> N0
+  | Npos p -> Npos (XO p)
+  
+  (** val succ : n -> n **)
+  
+  let succ = function
+  | N0 -> Npos XH
+  | Npos p -> Npos (Coq_Pos.succ p)
+  
+  (** val pred : n -> n **)
+  
+  let pred = function
+  | N0 -> N0
+  | Npos p -> Coq_Pos.pred_N p
+  
+  (** val succ_pos : n -> positive **)
+  
+  let succ_pos = function
+  | N0 -> XH
+  | Npos p -> Coq_Pos.succ p
+  
+  (** val add : n -> n -> n **)
+  
+  let add n0 m =
+    match n0 with
+    | N0 -> m
+    | Npos p ->
+      (match m with
+       | N0 -> n0
+       | Npos q -> Npos (Coq_Pos.add p q))
+  
+  (** val sub : n -> n -> n **)
+  
+  let sub n0 m =
+    match n0 with
+    | N0 -> N0
+    | Npos n' ->
+      (match m with
+       | N0 -> n0
+       | Npos m' ->
+         (match Coq_Pos.sub_mask n' m' with
+          | Coq_Pos.IsPos p -> Npos p
+          | _ -> N0))
+  
+  (** val mul : n -> n -> n **)
+  
+  let mul n0 m =
+    match n0 with
+    | N0 -> N0
+    | Npos p ->
+      (match m with
+       | N0 -> N0
+       | Npos q -> Npos (Coq_Pos.mul p q))
+  
+  (** val compare : n -> n -> ExtrNative.comparison **)
+  
+  let compare n0 m =
+    match n0 with
+    | N0 ->
+      (match m with
+       | N0 -> ExtrNative.Eq
+       | Npos m' -> ExtrNative.Lt)
+    | Npos n' ->
+      (match m with
+       | N0 -> ExtrNative.Gt
+       | Npos m' -> Coq_Pos.compare n' m')
+  
+  (** val eqb : n -> n -> bool **)
+  
+  let rec eqb n0 m =
+    match n0 with
+    | N0 ->
+      (match m with
+       | N0 -> true
+       | Npos p -> false)
+    | Npos p ->
+      (match m with
+       | N0 -> false
+       | Npos q -> Coq_Pos.eqb p q)
+  
+  (** val leb : n -> n -> bool **)
+  
+  let leb x y =
+    match compare x y with
+    | ExtrNative.Gt -> false
+    | _ -> true
+  
+  (** val ltb : n -> n -> bool **)
+  
+  let ltb x y =
+    match compare x y with
+    | ExtrNative.Lt -> true
+    | _ -> false
+  
+  (** val min : n -> n -> n **)
+  
+  let min n0 n' =
+    match compare n0 n' with
+    | ExtrNative.Gt -> n'
+    | _ -> n0
+  
+  (** val max : n -> n -> n **)
+  
+  let max n0 n' =
+    match compare n0 n' with
+    | ExtrNative.Gt -> n0
+    | _ -> n'
+  
+  (** val div2 : n -> n **)
+  
+  let div2 = function
+  | N0 -> N0
+  | Npos p2 ->
+    (match p2 with
+     | XI p -> Npos p
+     | XO p -> Npos p
+     | XH -> N0)
+  
+  (** val even : n -> bool **)
+  
+  let even = function
+  | N0 -> true
+  | Npos p ->
+    (match p with
+     | XO p2 -> true
+     | _ -> false)
+  
+  (** val odd : n -> bool **)
+  
+  let odd n0 =
+    negb (even n0)
+  
+  (** val pow : n -> n -> n **)
+  
+  let pow n0 = function
+  | N0 -> Npos XH
+  | Npos p2 ->
+    (match n0 with
+     | N0 -> N0
+     | Npos q -> Npos (Coq_Pos.pow q p2))
+  
+  (** val square : n -> n **)
+  
+  let square = function
+  | N0 -> N0
+  | Npos p -> Npos (Coq_Pos.square p)
+  
+  (** val log2 : n -> n **)
+  
+  let log2 = function
+  | N0 -> N0
+  | Npos p2 ->
+    (match p2 with
+     | XI p -> Npos (Coq_Pos.size p)
+     | XO p -> Npos (Coq_Pos.size p)
+     | XH -> N0)
+  
+  (** val size : n -> n **)
+  
+  let size = function
+  | N0 -> N0
+  | Npos p -> Npos (Coq_Pos.size p)
+  
+  (** val size_nat : n -> nat **)
+  
+  let size_nat = function
+  | N0 -> O
+  | Npos p -> Coq_Pos.size_nat p
+  
+  (** val pos_div_eucl : positive -> n -> n*n **)
+  
+  let rec pos_div_eucl a b =
+    match a with
+    | XI a' ->
+      let q,r = pos_div_eucl a' b in
+      let r' = succ_double r in
+      if leb b r' then (succ_double q),(sub r' b) else (double q),r'
+    | XO a' ->
+      let q,r = pos_div_eucl a' b in
+      let r' = double r in
+      if leb b r' then (succ_double q),(sub r' b) else (double q),r'
+    | XH ->
+      (match b with
+       | N0 -> N0,(Npos XH)
+       | Npos p ->
+         (match p with
+          | XH -> (Npos XH),N0
+          | _ -> N0,(Npos XH)))
+  
+  (** val div_eucl : n -> n -> n*n **)
+  
+  let div_eucl a b =
+    match a with
+    | N0 -> N0,N0
+    | Npos na ->
+      (match b with
+       | N0 -> N0,a
+       | Npos p -> pos_div_eucl na b)
+  
+  (** val div : n -> n -> n **)
+  
+  let div a b =
+    fst (div_eucl a b)
+  
+  (** val modulo : n -> n -> n **)
+  
+  let modulo a b =
+    snd (div_eucl a b)
+  
+  (** val gcd : n -> n -> n **)
+  
+  let gcd a b =
+    match a with
+    | N0 -> b
+    | Npos p ->
+      (match b with
+       | N0 -> a
+       | Npos q -> Npos (Coq_Pos.gcd p q))
+  
+  (** val ggcd : n -> n -> n*(n*n) **)
+  
+  let ggcd a b =
+    match a with
+    | N0 -> b,(N0,(Npos XH))
+    | Npos p ->
+      (match b with
+       | N0 -> a,((Npos XH),N0)
+       | Npos q ->
+         let g,p2 = Coq_Pos.ggcd p q in
+         let aa,bb = p2 in (Npos g),((Npos aa),(Npos bb)))
+  
+  (** val sqrtrem : n -> n*n **)
+  
+  let sqrtrem = function
+  | N0 -> N0,N0
+  | Npos p ->
+    let s,m = Coq_Pos.sqrtrem p in
+    (match m with
+     | Coq_Pos.IsPos r -> (Npos s),(Npos r)
+     | _ -> (Npos s),N0)
+  
+  (** val sqrt : n -> n **)
+  
+  let sqrt = function
+  | N0 -> N0
+  | Npos p -> Npos (Coq_Pos.sqrt p)
+  
+  (** val coq_lor : n -> n -> n **)
+  
+  let coq_lor n0 m =
+    match n0 with
+    | N0 -> m
+    | Npos p ->
+      (match m with
+       | N0 -> n0
+       | Npos q -> Npos (Coq_Pos.coq_lor p q))
+  
+  (** val coq_land : n -> n -> n **)
+  
+  let coq_land n0 m =
+    match n0 with
+    | N0 -> N0
+    | Npos p ->
+      (match m with
+       | N0 -> N0
+       | Npos q -> Coq_Pos.coq_land p q)
+  
+  (** val ldiff : n -> n -> n **)
+  
+  let rec ldiff n0 m =
+    match n0 with
+    | N0 -> N0
+    | Npos p ->
+      (match m with
+       | N0 -> n0
+       | Npos q -> Coq_Pos.ldiff p q)
+  
+  (** val coq_lxor : n -> n -> n **)
+  
+  let coq_lxor n0 m =
+    match n0 with
+    | N0 -> m
+    | Npos p ->
+      (match m with
+       | N0 -> n0
+       | Npos q -> Coq_Pos.coq_lxor p q)
+  
+  (** val shiftl_nat : n -> nat -> n **)
+  
+  let shiftl_nat a n0 =
+    nat_iter n0 double a
+  
+  (** val shiftr_nat : n -> nat -> n **)
+  
+  let shiftr_nat a n0 =
+    nat_iter n0 div2 a
+  
+  (** val shiftl : n -> n -> n **)
+  
+  let shiftl a n0 =
+    match a with
+    | N0 -> N0
+    | Npos a0 -> Npos (Coq_Pos.shiftl a0 n0)
+  
+  (** val shiftr : n -> n -> n **)
+  
+  let shiftr a = function
+  | N0 -> a
+  | Npos p -> Coq_Pos.iter p div2 a
+  
+  (** val testbit_nat : n -> nat -> bool **)
+  
+  let testbit_nat = function
+  | N0 -> (fun x -> false)
+  | Npos p -> Coq_Pos.testbit_nat p
+  
+  (** val testbit : n -> n -> bool **)
+  
+  let testbit a n0 =
+    match a with
+    | N0 -> false
+    | Npos p -> Coq_Pos.testbit p n0
+  
+  (** val to_nat : n -> nat **)
+  
+  let to_nat = function
+  | N0 -> O
+  | Npos p -> Coq_Pos.to_nat p
+  
+  (** val of_nat : nat -> n **)
+  
+  let of_nat = function
+  | O -> N0
+  | S n' -> Npos (Coq_Pos.of_succ_nat n')
+  
+  (** val iter : n -> ('a1 -> 'a1) -> 'a1 -> 'a1 **)
+  
+  let iter n0 f x =
+    match n0 with
+    | N0 -> x
+    | Npos p -> Coq_Pos.iter p f x
+  
+  (** val eq_dec : n -> n -> sumbool **)
+  
+  let eq_dec n0 m =
+    match n0 with
+    | N0 ->
+      (match m with
+       | N0 -> Left
+       | Npos p -> Right)
+    | Npos x ->
+      (match m with
+       | N0 -> Right
+       | Npos p2 -> Coq_Pos.eq_dec x p2)
+  
+  (** val discr : n -> positive sumor **)
+  
+  let discr = function
+  | N0 -> Inright
+  | Npos p -> Inleft p
+  
+  (** val binary_rect :
+      'a1 -> (n -> 'a1 -> 'a1) -> (n -> 'a1 -> 'a1) -> n -> 'a1 **)
+  
+  let binary_rect f0 f2 fS2 n0 =
+    let f2' = fun p -> f2 (Npos p) in
+    let fS2' = fun p -> fS2 (Npos p) in
+    (match n0 with
+     | N0 -> f0
+     | Npos p ->
+       let rec f = function
+       | XI p3 -> fS2' p3 (f p3)
+       | XO p3 -> f2' p3 (f p3)
+       | XH -> fS2 N0 f0
+       in f p)
+  
+  (** val binary_rec :
+      'a1 -> (n -> 'a1 -> 'a1) -> (n -> 'a1 -> 'a1) -> n -> 'a1 **)
+  
+  let binary_rec =
+    binary_rect
+  
+  (** val peano_rect : 'a1 -> (n -> 'a1 -> 'a1) -> n -> 'a1 **)
+  
+  let peano_rect f0 f n0 =
+    let f' = fun p -> f (Npos p) in
+    (match n0 with
+     | N0 -> f0
+     | Npos p -> Coq_Pos.peano_rect (f N0 f0) f' p)
+  
+  (** val peano_rec : 'a1 -> (n -> 'a1 -> 'a1) -> n -> 'a1 **)
+  
+  let peano_rec =
+    peano_rect
+  
+  (** val leb_spec0 : n -> n -> reflect **)
+  
+  let leb_spec0 x y =
+    iff_reflect (leb x y)
+  
+  (** val ltb_spec0 : n -> n -> reflect **)
+  
+  let ltb_spec0 x y =
+    iff_reflect (ltb x y)
+  
+  module Private_BootStrap = 
+   struct 
+    
+   end
+  
+  (** val recursion : 'a1 -> (n -> 'a1 -> 'a1) -> n -> 'a1 **)
+  
+  let recursion x =
+    peano_rect x
+  
+  module Private_OrderTac = 
+   struct 
+    module Elts = 
+     struct 
+      type t = n
+     end
+    
+    module Tac = MakeOrderTac(Elts)
+   end
+  
+  module Private_NZPow = 
+   struct 
+    
+   end
+  
+  module Private_NZSqrt = 
+   struct 
+    
+   end
+  
+  (** val sqrt_up : n -> n **)
+  
+  let sqrt_up a =
+    match compare N0 a with
+    | ExtrNative.Lt -> succ (sqrt (pred a))
+    | _ -> N0
+  
+  (** val log2_up : n -> n **)
+  
+  let log2_up a =
+    match compare (Npos XH) a with
+    | ExtrNative.Lt -> succ (log2 (pred a))
+    | _ -> N0
+  
+  module Private_NZDiv = 
+   struct 
+    
+   end
+  
+  (** val lcm : n -> n -> n **)
+  
+  let lcm a b =
+    mul a (div b (gcd a b))
+  
+  (** val eqb_spec : n -> n -> reflect **)
+  
+  let eqb_spec x y =
+    iff_reflect (eqb x y)
+  
+  (** val b2n : bool -> n **)
+  
+  let b2n = function
+  | true -> Npos XH
+  | false -> N0
+  
+  (** val setbit : n -> n -> n **)
+  
+  let setbit a n0 =
+    coq_lor a (shiftl (Npos XH) n0)
+  
+  (** val clearbit : n -> n -> n **)
+  
+  let clearbit a n0 =
+    ldiff a (shiftl (Npos XH) n0)
+  
+  (** val ones : n -> n **)
+  
+  let ones n0 =
+    pred (shiftl (Npos XH) n0)
+  
+  (** val lnot : n -> n -> n **)
+  
+  let lnot a n0 =
+    coq_lxor a (ones n0)
+  
+  module Private_Tac = 
+   struct 
+    
+   end
+  
+  module Private_Rev = 
+   struct 
+    module ORev = 
+     struct 
+      type t = n
+     end
+    
+    module MRev = 
+     struct 
+      (** val max : n -> n -> n **)
+      
+      let max x y =
+        min y x
+     end
+    
+    module MPRev = MaxLogicalProperties(ORev)(MRev)
+   end
+  
+  module Private_Dec = 
+   struct 
+    (** val max_case_strong :
+        n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1)
+        -> 'a1 **)
+    
+    let max_case_strong n0 m compat hl hr =
+      let c = compSpec2Type n0 m (compare n0 m) in
+      (match c with
+       | CompGtT -> compat n0 (max n0 m) __ (hl __)
+       | _ -> compat m (max n0 m) __ (hr __))
+    
+    (** val max_case :
+        n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1 **)
+    
+    let max_case n0 m x x0 x1 =
+      max_case_strong n0 m x (fun _ -> x0) (fun _ -> x1)
+    
+    (** val max_dec : n -> n -> sumbool **)
+    
+    let max_dec n0 m =
+      max_case n0 m (fun x y _ h0 -> h0) Left Right
+    
+    (** val min_case_strong :
+        n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1)
+        -> 'a1 **)
+    
+    let min_case_strong n0 m compat hl hr =
+      let c = compSpec2Type n0 m (compare n0 m) in
+      (match c with
+       | CompGtT -> compat m (min n0 m) __ (hr __)
+       | _ -> compat n0 (min n0 m) __ (hl __))
+    
+    (** val min_case :
+        n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1 **)
+    
+    let min_case n0 m x x0 x1 =
+      min_case_strong n0 m x (fun _ -> x0) (fun _ -> x1)
+    
+    (** val min_dec : n -> n -> sumbool **)
+    
+    let min_dec n0 m =
+      min_case n0 m (fun x y _ h0 -> h0) Left Right
+   end
+  
+  (** val max_case_strong : n -> n -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 **)
+  
+  let max_case_strong n0 m x x0 =
+    Private_Dec.max_case_strong n0 m (fun x1 y _ x2 -> x2) x x0
+  
+  (** val max_case : n -> n -> 'a1 -> 'a1 -> 'a1 **)
+  
+  let max_case n0 m x x0 =
+    max_case_strong n0 m (fun _ -> x) (fun _ -> x0)
+  
+  (** val max_dec : n -> n -> sumbool **)
+  
+  let max_dec =
+    Private_Dec.max_dec
+  
+  (** val min_case_strong : n -> n -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 **)
+  
+  let min_case_strong n0 m x x0 =
+    Private_Dec.min_case_strong n0 m (fun x1 y _ x2 -> x2) x x0
+  
+  (** val min_case : n -> n -> 'a1 -> 'a1 -> 'a1 **)
+  
+  let min_case n0 m x x0 =
+    min_case_strong n0 m (fun _ -> x) (fun _ -> x0)
+  
+  (** val min_dec : n -> n -> sumbool **)
+  
+  let min_dec =
+    Private_Dec.min_dec
+ end
+
+module Z = 
+ struct 
+  type t = z
+  
+  (** val zero : z **)
+  
+  let zero =
+    Z0
+  
+  (** val one : z **)
+  
+  let one =
+    Zpos XH
+  
+  (** val two : z **)
+  
+  let two =
+    Zpos (XO XH)
+  
+  (** val double : z -> z **)
+  
+  let double = function
+  | Z0 -> Z0
+  | Zpos p -> Zpos (XO p)
+  | Zneg p -> Zneg (XO p)
+  
+  (** val succ_double : z -> z **)
+  
+  let succ_double = function
+  | Z0 -> Zpos XH
+  | Zpos p -> Zpos (XI p)
+  | Zneg p -> Zneg (Coq_Pos.pred_double p)
+  
+  (** val pred_double : z -> z **)
+  
+  let pred_double = function
+  | Z0 -> Zneg XH
+  | Zpos p -> Zpos (Coq_Pos.pred_double p)
+  | Zneg p -> Zneg (XI p)
+  
+  (** val pos_sub : positive -> positive -> z **)
+  
+  let rec pos_sub x y =
+    match x with
+    | XI p ->
+      (match y with
+       | XI q -> double (pos_sub p q)
+       | XO q -> succ_double (pos_sub p q)
+       | XH -> Zpos (XO p))
+    | XO p ->
+      (match y with
+       | XI q -> pred_double (pos_sub p q)
+       | XO q -> double (pos_sub p q)
+       | XH -> Zpos (Coq_Pos.pred_double p))
+    | XH ->
+      (match y with
+       | XI q -> Zneg (XO q)
+       | XO q -> Zneg (Coq_Pos.pred_double q)
+       | XH -> Z0)
+  
+  (** val add : z -> z -> z **)
+  
+  let add x y =
+    match x with
+    | Z0 -> y
+    | Zpos x' ->
+      (match y with
+       | Z0 -> x
+       | Zpos y' -> Zpos (Coq_Pos.add x' y')
+       | Zneg y' -> pos_sub x' y')
+    | Zneg x' ->
+      (match y with
+       | Z0 -> x
+       | Zpos y' -> pos_sub y' x'
+       | Zneg y' -> Zneg (Coq_Pos.add x' y'))
+  
+  (** val opp : z -> z **)
+  
+  let opp = function
+  | Z0 -> Z0
+  | Zpos x0 -> Zneg x0
+  | Zneg x0 -> Zpos x0
+  
+  (** val succ : z -> z **)
+  
+  let succ x =
+    add x (Zpos XH)
+  
+  (** val pred : z -> z **)
+  
+  let pred x =
+    add x (Zneg XH)
+  
+  (** val sub : z -> z -> z **)
+  
+  let sub m n0 =
+    add m (opp n0)
+  
+  (** val mul : z -> z -> z **)
+  
+  let mul x y =
+    match x with
+    | Z0 -> Z0
+    | Zpos x' ->
+      (match y with
+       | Z0 -> Z0
+       | Zpos y' -> Zpos (Coq_Pos.mul x' y')
+       | Zneg y' -> Zneg (Coq_Pos.mul x' y'))
+    | Zneg x' ->
+      (match y with
+       | Z0 -> Z0
+       | Zpos y' -> Zneg (Coq_Pos.mul x' y')
+       | Zneg y' -> Zpos (Coq_Pos.mul x' y'))
+  
+  (** val pow_pos : z -> positive -> z **)
+  
+  let pow_pos z0 n0 =
+    Coq_Pos.iter n0 (mul z0) (Zpos XH)
+  
+  (** val pow : z -> z -> z **)
+  
+  let pow x = function
+  | Z0 -> Zpos XH
+  | Zpos p -> pow_pos x p
+  | Zneg p -> Z0
+  
+  (** val square : z -> z **)
+  
+  let square = function
+  | Z0 -> Z0
+  | Zpos p -> Zpos (Coq_Pos.square p)
+  | Zneg p -> Zpos (Coq_Pos.square p)
+  
+  (** val compare : z -> z -> ExtrNative.comparison **)
+  
+  let compare x y =
+    match x with
+    | Z0 ->
+      (match y with
+       | Z0 -> ExtrNative.Eq
+       | Zpos y' -> ExtrNative.Lt
+       | Zneg y' -> ExtrNative.Gt)
+    | Zpos x' ->
+      (match y with
+       | Zpos y' -> Coq_Pos.compare x' y'
+       | _ -> ExtrNative.Gt)
+    | Zneg x' ->
+      (match y with
+       | Zneg y' -> compOpp (Coq_Pos.compare x' y')
+       | _ -> ExtrNative.Lt)
+  
+  (** val sgn : z -> z **)
+  
+  let sgn = function
+  | Z0 -> Z0
+  | Zpos p -> Zpos XH
+  | Zneg p -> Zneg XH
+  
+  (** val leb : z -> z -> bool **)
+  
+  let leb x y =
+    match compare x y with
+    | ExtrNative.Gt -> false
+    | _ -> true
+  
+  (** val ltb : z -> z -> bool **)
+  
+  let ltb x y =
+    match compare x y with
+    | ExtrNative.Lt -> true
+    | _ -> false
+  
+  (** val geb : z -> z -> bool **)
+  
+  let geb x y =
+    match compare x y with
+    | ExtrNative.Lt -> false
+    | _ -> true
+  
+  (** val gtb : z -> z -> bool **)
+  
+  let gtb x y =
+    match compare x y with
+    | ExtrNative.Gt -> true
+    | _ -> false
+  
+  (** val eqb : z -> z -> bool **)
+  
+  let rec eqb x y =
+    match x with
+    | Z0 ->
+      (match y with
+       | Z0 -> true
+       | _ -> false)
+    | Zpos p ->
+      (match y with
+       | Zpos q -> Coq_Pos.eqb p q
+       | _ -> false)
+    | Zneg p ->
+      (match y with
+       | Zneg q -> Coq_Pos.eqb p q
+       | _ -> false)
+  
+  (** val max : z -> z -> z **)
+  
+  let max n0 m =
+    match compare n0 m with
+    | ExtrNative.Lt -> m
+    | _ -> n0
+  
+  (** val min : z -> z -> z **)
+  
+  let min n0 m =
+    match compare n0 m with
+    | ExtrNative.Gt -> m
+    | _ -> n0
+  
+  (** val abs : z -> z **)
+  
+  let abs = function
+  | Zneg p -> Zpos p
+  | x -> x
+  
+  (** val abs_nat : z -> nat **)
+  
+  let abs_nat = function
+  | Z0 -> O
+  | Zpos p -> Coq_Pos.to_nat p
+  | Zneg p -> Coq_Pos.to_nat p
+  
+  (** val abs_N : z -> n **)
+  
+  let abs_N = function
+  | Z0 -> N0
+  | Zpos p -> Npos p
+  | Zneg p -> Npos p
+  
+  (** val to_nat : z -> nat **)
+  
+  let to_nat = function
+  | Zpos p -> Coq_Pos.to_nat p
+  | _ -> O
+  
+  (** val to_N : z -> n **)
+  
+  let to_N = function
+  | Zpos p -> Npos p
+  | _ -> N0
+  
+  (** val of_nat : nat -> z **)
+  
+  let of_nat = function
+  | O -> Z0
+  | S n1 -> Zpos (Coq_Pos.of_succ_nat n1)
+  
+  (** val of_N : n -> z **)
+  
+  let of_N = function
+  | N0 -> Z0
+  | Npos p -> Zpos p
+  
+  (** val iter : z -> ('a1 -> 'a1) -> 'a1 -> 'a1 **)
+  
+  let iter n0 f x =
+    match n0 with
+    | Zpos p -> Coq_Pos.iter p f x
+    | _ -> x
+  
+  (** val pos_div_eucl : positive -> z -> z*z **)
+  
+  let rec pos_div_eucl a b =
+    match a with
+    | XI a' ->
+      let q,r = pos_div_eucl a' b in
+      let r' = add (mul (Zpos (XO XH)) r) (Zpos XH) in
+      if ltb r' b
+      then (mul (Zpos (XO XH)) q),r'
+      else (add (mul (Zpos (XO XH)) q) (Zpos XH)),(sub r' b)
+    | XO a' ->
+      let q,r = pos_div_eucl a' b in
+      let r' = mul (Zpos (XO XH)) r in
+      if ltb r' b
+      then (mul (Zpos (XO XH)) q),r'
+      else (add (mul (Zpos (XO XH)) q) (Zpos XH)),(sub r' b)
+    | XH -> if leb (Zpos (XO XH)) b then Z0,(Zpos XH) else (Zpos XH),Z0
+  
+  (** val div_eucl : z -> z -> z*z **)
+  
+  let div_eucl a b =
+    match a with
+    | Z0 -> Z0,Z0
+    | Zpos a' ->
+      (match b with
+       | Z0 -> Z0,Z0
+       | Zpos p -> pos_div_eucl a' b
+       | Zneg b' ->
+         let q,r = pos_div_eucl a' (Zpos b') in
+         (match r with
+          | Z0 -> (opp q),Z0
+          | _ -> (opp (add q (Zpos XH))),(add b r)))
+    | Zneg a' ->
+      (match b with
+       | Z0 -> Z0,Z0
+       | Zpos p ->
+         let q,r = pos_div_eucl a' b in
+         (match r with
+          | Z0 -> (opp q),Z0
+          | _ -> (opp (add q (Zpos XH))),(sub b r))
+       | Zneg b' -> let q,r = pos_div_eucl a' (Zpos b') in q,(opp r))
+  
+  (** val div : z -> z -> z **)
+  
+  let div a b =
+    let q,x = div_eucl a b in q
+  
+  (** val modulo : z -> z -> z **)
+  
+  let modulo a b =
+    let x,r = div_eucl a b in r
+  
+  (** val quotrem : z -> z -> z*z **)
+  
+  let quotrem a b =
+    match a with
+    | Z0 -> Z0,Z0
+    | Zpos a0 ->
+      (match b with
+       | Z0 -> Z0,a
+       | Zpos b0 ->
+         let q,r = N.pos_div_eucl a0 (Npos b0) in (of_N q),(of_N r)
+       | Zneg b0 ->
+         let q,r = N.pos_div_eucl a0 (Npos b0) in (opp (of_N q)),(of_N r))
+    | Zneg a0 ->
+      (match b with
+       | Z0 -> Z0,a
+       | Zpos b0 ->
+         let q,r = N.pos_div_eucl a0 (Npos b0) in
+         (opp (of_N q)),(opp (of_N r))
+       | Zneg b0 ->
+         let q,r = N.pos_div_eucl a0 (Npos b0) in (of_N q),(opp (of_N r)))
+  
+  (** val quot : z -> z -> z **)
+  
+  let quot a b =
+    fst (quotrem a b)
+  
+  (** val rem : z -> z -> z **)
+  
+  let rem a b =
+    snd (quotrem a b)
+  
+  (** val even : z -> bool **)
+  
+  let even = function
+  | Z0 -> true
+  | Zpos p ->
+    (match p with
+     | XO p2 -> true
+     | _ -> false)
+  | Zneg p ->
+    (match p with
+     | XO p2 -> true
+     | _ -> false)
+  
+  (** val odd : z -> bool **)
+  
+  let odd = function
+  | Z0 -> false
+  | Zpos p ->
+    (match p with
+     | XO p2 -> false
+     | _ -> true)
+  | Zneg p ->
+    (match p with
+     | XO p2 -> false
+     | _ -> true)
+  
+  (** val div2 : z -> z **)
+  
+  let div2 = function
+  | Z0 -> Z0
+  | Zpos p ->
+    (match p with
+     | XH -> Z0
+     | _ -> Zpos (Coq_Pos.div2 p))
+  | Zneg p -> Zneg (Coq_Pos.div2_up p)
+  
+  (** val quot2 : z -> z **)
+  
+  let quot2 = function
+  | Z0 -> Z0
+  | Zpos p ->
+    (match p with
+     | XH -> Z0
+     | _ -> Zpos (Coq_Pos.div2 p))
+  | Zneg p ->
+    (match p with
+     | XH -> Z0
+     | _ -> Zneg (Coq_Pos.div2 p))
+  
+  (** val log2 : z -> z **)
+  
+  let log2 = function
+  | Zpos p2 ->
+    (match p2 with
+     | XI p -> Zpos (Coq_Pos.size p)
+     | XO p -> Zpos (Coq_Pos.size p)
+     | XH -> Z0)
+  | _ -> Z0
+  
+  (** val sqrtrem : z -> z*z **)
+  
+  let sqrtrem = function
+  | Zpos p ->
+    let s,m = Coq_Pos.sqrtrem p in
+    (match m with
+     | Coq_Pos.IsPos r -> (Zpos s),(Zpos r)
+     | _ -> (Zpos s),Z0)
+  | _ -> Z0,Z0
+  
+  (** val sqrt : z -> z **)
+  
+  let sqrt = function
+  | Zpos p -> Zpos (Coq_Pos.sqrt p)
+  | _ -> Z0
+  
+  (** val gcd : z -> z -> z **)
+  
+  let gcd a b =
+    match a with
+    | Z0 -> abs b
+    | Zpos a0 ->
+      (match b with
+       | Z0 -> abs a
+       | Zpos b0 -> Zpos (Coq_Pos.gcd a0 b0)
+       | Zneg b0 -> Zpos (Coq_Pos.gcd a0 b0))
+    | Zneg a0 ->
+      (match b with
+       | Z0 -> abs a
+       | Zpos b0 -> Zpos (Coq_Pos.gcd a0 b0)
+       | Zneg b0 -> Zpos (Coq_Pos.gcd a0 b0))
+  
+  (** val ggcd : z -> z -> z*(z*z) **)
+  
+  let ggcd a b =
+    match a with
+    | Z0 -> (abs b),(Z0,(sgn b))
+    | Zpos a0 ->
+      (match b with
+       | Z0 -> (abs a),((sgn a),Z0)
+       | Zpos b0 ->
+         let g,p = Coq_Pos.ggcd a0 b0 in
+         let aa,bb = p in (Zpos g),((Zpos aa),(Zpos bb))
+       | Zneg b0 ->
+         let g,p = Coq_Pos.ggcd a0 b0 in
+         let aa,bb = p in (Zpos g),((Zpos aa),(Zneg bb)))
+    | Zneg a0 ->
+      (match b with
+       | Z0 -> (abs a),((sgn a),Z0)
+       | Zpos b0 ->
+         let g,p = Coq_Pos.ggcd a0 b0 in
+         let aa,bb = p in (Zpos g),((Zneg aa),(Zpos bb))
+       | Zneg b0 ->
+         let g,p = Coq_Pos.ggcd a0 b0 in
+         let aa,bb = p in (Zpos g),((Zneg aa),(Zneg bb)))
+  
+  (** val testbit : z -> z -> bool **)
+  
+  let testbit a = function
+  | Z0 -> odd a
+  | Zpos p ->
+    (match a with
+     | Z0 -> false
+     | Zpos a0 -> Coq_Pos.testbit a0 (Npos p)
+     | Zneg a0 -> negb (N.testbit (Coq_Pos.pred_N a0) (Npos p)))
+  | Zneg p -> false
+  
+  (** val shiftl : z -> z -> z **)
+  
+  let shiftl a = function
+  | Z0 -> a
+  | Zpos p -> Coq_Pos.iter p (mul (Zpos (XO XH))) a
+  | Zneg p -> Coq_Pos.iter p div2 a
+  
+  (** val shiftr : z -> z -> z **)
+  
+  let shiftr a n0 =
+    shiftl a (opp n0)
+  
+  (** val coq_lor : z -> z -> z **)
+  
+  let coq_lor a b =
+    match a with
+    | Z0 -> b
+    | Zpos a0 ->
+      (match b with
+       | Z0 -> a
+       | Zpos b0 -> Zpos (Coq_Pos.coq_lor a0 b0)
+       | Zneg b0 -> Zneg (N.succ_pos (N.ldiff (Coq_Pos.pred_N b0) (Npos a0))))
+    | Zneg a0 ->
+      (match b with
+       | Z0 -> a
+       | Zpos b0 -> Zneg (N.succ_pos (N.ldiff (Coq_Pos.pred_N a0) (Npos b0)))
+       | Zneg b0 ->
+         Zneg
+           (N.succ_pos (N.coq_land (Coq_Pos.pred_N a0) (Coq_Pos.pred_N b0))))
+  
+  (** val coq_land : z -> z -> z **)
+  
+  let coq_land a b =
+    match a with
+    | Z0 -> Z0
+    | Zpos a0 ->
+      (match b with
+       | Z0 -> Z0
+       | Zpos b0 -> of_N (Coq_Pos.coq_land a0 b0)
+       | Zneg b0 -> of_N (N.ldiff (Npos a0) (Coq_Pos.pred_N b0)))
+    | Zneg a0 ->
+      (match b with
+       | Z0 -> Z0
+       | Zpos b0 -> of_N (N.ldiff (Npos b0) (Coq_Pos.pred_N a0))
+       | Zneg b0 ->
+         Zneg
+           (N.succ_pos (N.coq_lor (Coq_Pos.pred_N a0) (Coq_Pos.pred_N b0))))
+  
+  (** val ldiff : z -> z -> z **)
+  
+  let ldiff a b =
+    match a with
+    | Z0 -> Z0
+    | Zpos a0 ->
+      (match b with
+       | Z0 -> a
+       | Zpos b0 -> of_N (Coq_Pos.ldiff a0 b0)
+       | Zneg b0 -> of_N (N.coq_land (Npos a0) (Coq_Pos.pred_N b0)))
+    | Zneg a0 ->
+      (match b with
+       | Z0 -> a
+       | Zpos b0 ->
+         Zneg (N.succ_pos (N.coq_lor (Coq_Pos.pred_N a0) (Npos b0)))
+       | Zneg b0 -> of_N (N.ldiff (Coq_Pos.pred_N b0) (Coq_Pos.pred_N a0)))
+  
+  (** val coq_lxor : z -> z -> z **)
+  
+  let coq_lxor a b =
+    match a with
+    | Z0 -> b
+    | Zpos a0 ->
+      (match b with
+       | Z0 -> a
+       | Zpos b0 -> of_N (Coq_Pos.coq_lxor a0 b0)
+       | Zneg b0 ->
+         Zneg (N.succ_pos (N.coq_lxor (Npos a0) (Coq_Pos.pred_N b0))))
+    | Zneg a0 ->
+      (match b with
+       | Z0 -> a
+       | Zpos b0 ->
+         Zneg (N.succ_pos (N.coq_lxor (Coq_Pos.pred_N a0) (Npos b0)))
+       | Zneg b0 -> of_N (N.coq_lxor (Coq_Pos.pred_N a0) (Coq_Pos.pred_N b0)))
+  
+  (** val eq_dec : z -> z -> sumbool **)
+  
+  let eq_dec x y =
+    match x with
+    | Z0 ->
+      (match y with
+       | Z0 -> Left
+       | _ -> Right)
+    | Zpos x0 ->
+      (match y with
+       | Zpos p2 -> Coq_Pos.eq_dec x0 p2
+       | _ -> Right)
+    | Zneg x0 ->
+      (match y with
+       | Zneg p2 -> Coq_Pos.eq_dec x0 p2
+       | _ -> Right)
+  
+  module Private_BootStrap = 
+   struct 
+    
+   end
+  
+  (** val leb_spec0 : z -> z -> reflect **)
+  
+  let leb_spec0 x y =
+    iff_reflect (leb x y)
+  
+  (** val ltb_spec0 : z -> z -> reflect **)
+  
+  let ltb_spec0 x y =
+    iff_reflect (ltb x y)
+  
+  module Private_OrderTac = 
+   struct 
+    module Elts = 
+     struct 
+      type t = z
+     end
+    
+    module Tac = MakeOrderTac(Elts)
+   end
+  
+  (** val sqrt_up : z -> z **)
+  
+  let sqrt_up a =
+    match compare Z0 a with
+    | ExtrNative.Lt -> succ (sqrt (pred a))
+    | _ -> Z0
+  
+  (** val log2_up : z -> z **)
+  
+  let log2_up a =
+    match compare (Zpos XH) a with
+    | ExtrNative.Lt -> succ (log2 (pred a))
+    | _ -> Z0
+  
+  module Private_NZDiv = 
+   struct 
+    
+   end
+  
+  module Private_Div = 
+   struct 
+    module Quot2Div = 
+     struct 
+      (** val div : z -> z -> z **)
+      
+      let div =
+        quot
+      
+      (** val modulo : z -> z -> z **)
+      
+      let modulo =
+        rem
+     end
+    
+    module NZQuot = 
+     struct 
+      
+     end
+   end
+  
+  (** val lcm : z -> z -> z **)
+  
+  let lcm a b =
+    abs (mul a (div b (gcd a b)))
+  
+  (** val eqb_spec : z -> z -> reflect **)
+  
+  let eqb_spec x y =
+    iff_reflect (eqb x y)
+  
+  (** val b2z : bool -> z **)
+  
+  let b2z = function
+  | true -> Zpos XH
+  | false -> Z0
+  
+  (** val setbit : z -> z -> z **)
+  
+  let setbit a n0 =
+    coq_lor a (shiftl (Zpos XH) n0)
+  
+  (** val clearbit : z -> z -> z **)
+  
+  let clearbit a n0 =
+    ldiff a (shiftl (Zpos XH) n0)
+  
+  (** val lnot : z -> z **)
+  
+  let lnot a =
+    pred (opp a)
+  
+  (** val ones : z -> z **)
+  
+  let ones n0 =
+    pred (shiftl (Zpos XH) n0)
+  
+  module Private_Tac = 
+   struct 
+    
+   end
+  
+  module Private_Rev = 
+   struct 
+    module ORev = 
+     struct 
+      type t = z
+     end
+    
+    module MRev = 
+     struct 
+      (** val max : z -> z -> z **)
+      
+      let max x y =
+        min y x
+     end
+    
+    module MPRev = MaxLogicalProperties(ORev)(MRev)
+   end
+  
+  module Private_Dec = 
+   struct 
+    (** val max_case_strong :
+        z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1)
+        -> 'a1 **)
+    
+    let max_case_strong n0 m compat hl hr =
+      let c = compSpec2Type n0 m (compare n0 m) in
+      (match c with
+       | CompGtT -> compat n0 (max n0 m) __ (hl __)
+       | _ -> compat m (max n0 m) __ (hr __))
+    
+    (** val max_case :
+        z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1 **)
+    
+    let max_case n0 m x x0 x1 =
+      max_case_strong n0 m x (fun _ -> x0) (fun _ -> x1)
+    
+    (** val max_dec : z -> z -> sumbool **)
+    
+    let max_dec n0 m =
+      max_case n0 m (fun x y _ h0 -> h0) Left Right
+    
+    (** val min_case_strong :
+        z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1)
+        -> 'a1 **)
+    
+    let min_case_strong n0 m compat hl hr =
+      let c = compSpec2Type n0 m (compare n0 m) in
+      (match c with
+       | CompGtT -> compat m (min n0 m) __ (hr __)
+       | _ -> compat n0 (min n0 m) __ (hl __))
+    
+    (** val min_case :
+        z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1 **)
+    
+    let min_case n0 m x x0 x1 =
+      min_case_strong n0 m x (fun _ -> x0) (fun _ -> x1)
+    
+    (** val min_dec : z -> z -> sumbool **)
+    
+    let min_dec n0 m =
+      min_case n0 m (fun x y _ h0 -> h0) Left Right
+   end
+  
+  (** val max_case_strong : z -> z -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 **)
+  
+  let max_case_strong n0 m x x0 =
+    Private_Dec.max_case_strong n0 m (fun x1 y _ x2 -> x2) x x0
+  
+  (** val max_case : z -> z -> 'a1 -> 'a1 -> 'a1 **)
+  
+  let max_case n0 m x x0 =
+    max_case_strong n0 m (fun _ -> x) (fun _ -> x0)
+  
+  (** val max_dec : z -> z -> sumbool **)
+  
+  let max_dec =
+    Private_Dec.max_dec
+  
+  (** val min_case_strong : z -> z -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 **)
+  
+  let min_case_strong n0 m x x0 =
+    Private_Dec.min_case_strong n0 m (fun x1 y _ x2 -> x2) x x0
+  
+  (** val min_case : z -> z -> 'a1 -> 'a1 -> 'a1 **)
+  
+  let min_case n0 m x x0 =
+    min_case_strong n0 m (fun _ -> x) (fun _ -> x0)
+  
+  (** val min_dec : z -> z -> sumbool **)
+  
+  let min_dec =
+    Private_Dec.min_dec
+ end
+
+(** val zeq_bool : z -> z -> bool **)
+
+let zeq_bool x y =
+  match Z.compare x y with
+  | ExtrNative.Eq -> true
+  | _ -> false
+
+(** val nth : nat -> 'a1 list -> 'a1 -> 'a1 **)
+
+let rec nth n0 l default0 =
+  match n0 with
+  | O ->
+    (match l with
+     | Nil -> default0
+     | Cons (x, l') -> x)
+  | S m ->
+    (match l with
+     | Nil -> default0
+     | Cons (x, t0) -> nth m t0 default0)
+
+(** val map : ('a1 -> 'a2) -> 'a1 list -> 'a2 list **)
+
+let rec map f = function
+| Nil -> Nil
+| Cons (a, t0) -> Cons ((f a), (map f t0))
+
+(** val fold_right : ('a2 -> 'a1 -> 'a1) -> 'a1 -> 'a2 list -> 'a1 **)
+
+let rec fold_right f a0 = function
+| Nil -> a0
+| Cons (b, t0) -> f b (fold_right f a0 t0)
+
+(** val existsb : ('a1 -> bool) -> 'a1 list -> bool **)
+
+let rec existsb f = function
+| Nil -> false
+| Cons (a, l0) -> if f a then true else existsb f l0
+
+(** val forallb : ('a1 -> bool) -> 'a1 list -> bool **)
+
+let rec forallb f = function
+| Nil -> true
+| Cons (a, l0) -> if f a then forallb f l0 else false
+
+type int = ExtrNative.uint
+
+(** val lsl0 : int -> int -> int **)
+
+let lsl0 = ExtrNative.l_sl
+
+(** val lsr0 : int -> int -> int **)
+
+let lsr0 = ExtrNative.l_sr
+
+(** val land0 : int -> int -> int **)
+
+let land0 = ExtrNative.l_and
+
+(** val lxor0 : int -> int -> int **)
+
+let lxor0 = ExtrNative.l_xor
+
+(** val sub0 : int -> int -> int **)
+
+let sub0 = ExtrNative.sub
+
+(** val eqb0 : int -> int -> bool **)
+
+let eqb0 = fun i j -> ExtrNative.compare i j = ExtrNative.Eq
+
+(** val ltb0 : int -> int -> bool **)
+
+let ltb0 = ExtrNative.lt
+
+(** val leb0 : int -> int -> bool **)
+
+let leb0 = ExtrNative.le
+
+(** val foldi_cont :
+    (int -> ('a1 -> 'a2) -> 'a1 -> 'a2) -> int -> int -> ('a1 -> 'a2) -> 'a1
+    -> 'a2 **)
+
+let foldi_cont = ExtrNative.foldi_cont
+
+(** val foldi_down_cont :
+    (int -> ('a1 -> 'a2) -> 'a1 -> 'a2) -> int -> int -> ('a1 -> 'a2) -> 'a1
+    -> 'a2 **)
+
+let foldi_down_cont = ExtrNative.foldi_down_cont
+
+(** val is_zero : int -> bool **)
+
+let is_zero i =
+  eqb0 i (ExtrNative.of_uint(0))
+
+(** val is_even : int -> bool **)
+
+let is_even i =
+  is_zero (land0 i (ExtrNative.of_uint(1)))
+
+(** val compare0 : int -> int -> ExtrNative.comparison **)
+
+let compare0 = ExtrNative.compare
+
+(** val foldi : (int -> 'a1 -> 'a1) -> int -> int -> 'a1 -> 'a1 **)
+
+let foldi f from to0 =
+  foldi_cont (fun i cont a -> cont (f i a)) from to0 (fun a -> a)
+
+(** val fold : ('a1 -> 'a1) -> int -> int -> 'a1 -> 'a1 **)
+
+let fold f from to0 =
+  foldi_cont (fun i cont a -> cont (f a)) from to0 (fun a -> a)
+
+(** val foldi_down : (int -> 'a1 -> 'a1) -> int -> int -> 'a1 -> 'a1 **)
+
+let foldi_down f from downto0 =
+  foldi_down_cont (fun i cont a -> cont (f i a)) from downto0 (fun a -> a)
+
+(** val forallb0 : (int -> bool) -> int -> int -> bool **)
+
+let forallb0 f from to0 =
+  foldi_cont (fun i cont x -> if f i then cont Tt else false) from to0
+    (fun x -> true) Tt
+
+(** val existsb0 : (int -> bool) -> int -> int -> bool **)
+
+let existsb0 f from to0 =
+  foldi_cont (fun i cont x -> if f i then true else cont Tt) from to0
+    (fun x -> false) Tt
+
+(** val cast : int -> int -> (__ -> __ -> __) option **)
+
+let cast i j =
+  if eqb0 i j then Some (fun _ hi -> hi) else None
+
+(** val reflect_eqb : int -> int -> reflect **)
+
+let reflect_eqb i j =
+  iff_reflect (eqb0 i j)
+
+type 'a array = 'a ExtrNative.parray
+
+(** val make : int -> 'a1 -> 'a1 array **)
+
+let make = ExtrNative.parray_make
+
+module Coq__2 = struct 
+ (** val get : 'a1 array -> int -> 'a1 **)
+ 
+ let get = ExtrNative.parray_get
+end
+let get = Coq__2.get
+
+(** val default : 'a1 array -> 'a1 **)
+
+let default = ExtrNative.parray_default
+
+(** val set : 'a1 array -> int -> 'a1 -> 'a1 array **)
+
+let set = ExtrNative.parray_set
+
+(** val length : 'a1 array -> int **)
+
+let length = ExtrNative.parray_length
+
+(** val to_list : 'a1 array -> 'a1 list **)
+
+let to_list t0 =
+  let len = length t0 in
+  if eqb0 (ExtrNative.of_uint(0)) len
+  then Nil
+  else foldi_down (fun i l -> Cons ((get t0 i), l))
+         (sub0 len (ExtrNative.of_uint(1))) (ExtrNative.of_uint(0)) Nil
+
+(** val forallbi : (int -> 'a1 -> bool) -> 'a1 array -> bool **)
+
+let forallbi f t0 =
+  let len = length t0 in
+  if eqb0 (ExtrNative.of_uint(0)) len
+  then true
+  else forallb0 (fun i -> f i (get t0 i)) (ExtrNative.of_uint(0))
+         (sub0 len (ExtrNative.of_uint(1)))
+
+(** val forallb1 : ('a1 -> bool) -> 'a1 array -> bool **)
+
+let forallb1 f t0 =
+  let len = length t0 in
+  if eqb0 (ExtrNative.of_uint(0)) len
+  then true
+  else forallb0 (fun i -> f (get t0 i)) (ExtrNative.of_uint(0))
+         (sub0 len (ExtrNative.of_uint(1)))
+
+(** val existsb1 : ('a1 -> bool) -> 'a1 array -> bool **)
+
+let existsb1 f t0 =
+  let len = length t0 in
+  if eqb0 (ExtrNative.of_uint(0)) len
+  then false
+  else existsb0 (fun i -> f (get t0 i)) (ExtrNative.of_uint(0))
+         (sub0 len (ExtrNative.of_uint(1)))
+
+(** val mapi : (int -> 'a1 -> 'a2) -> 'a1 array -> 'a2 array **)
+
+let mapi f t0 =
+  let size0 = length t0 in
+  let def = f size0 (default t0) in
+  let tb = make size0 def in
+  if eqb0 size0 (ExtrNative.of_uint(0))
+  then tb
+  else foldi (fun i tb0 -> set tb0 i (f i (get t0 i)))
+         (ExtrNative.of_uint(0)) (sub0 size0 (ExtrNative.of_uint(1))) tb
+
+(** val foldi_left :
+    (int -> 'a1 -> 'a2 -> 'a1) -> 'a1 -> 'a2 array -> 'a1 **)
+
+let foldi_left f a t0 =
+  let len = length t0 in
+  if eqb0 (ExtrNative.of_uint(0)) len
+  then a
+  else foldi (fun i a0 -> f i a0 (get t0 i)) (ExtrNative.of_uint(0))
+         (sub0 len (ExtrNative.of_uint(1))) a
+
+(** val fold_left : ('a1 -> 'a2 -> 'a1) -> 'a1 -> 'a2 array -> 'a1 **)
+
+let fold_left f a t0 =
+  let len = length t0 in
+  if eqb0 (ExtrNative.of_uint(0)) len
+  then a
+  else foldi (fun i a0 -> f a0 (get t0 i)) (ExtrNative.of_uint(0))
+         (sub0 (length t0) (ExtrNative.of_uint(1))) a
+
+(** val foldi_right :
+    (int -> 'a1 -> 'a2 -> 'a2) -> 'a1 array -> 'a2 -> 'a2 **)
+
+let foldi_right f t0 b =
+  let len = length t0 in
+  if eqb0 (ExtrNative.of_uint(0)) len
+  then b
+  else foldi_down (fun i b0 -> f i (get t0 i) b0)
+         (sub0 len (ExtrNative.of_uint(1))) (ExtrNative.of_uint(0)) b
+
+module Valuation = 
+ struct 
+  type t = int -> bool
+ end
+
+module Var = 
+ struct 
+  (** val _true : int **)
+  
+  let _true =
+    (ExtrNative.of_uint(0))
+  
+  (** val _false : int **)
+  
+  let _false =
+    (ExtrNative.of_uint(1))
+  
+  (** val interp : Valuation.t -> int -> bool **)
+  
+  let interp rho x =
+    rho x
+ end
+
+module Lit = 
+ struct 
+  (** val is_pos : int -> bool **)
+  
+  let is_pos l =
+    is_even l
+  
+  (** val blit : int -> int **)
+  
+  let blit l =
+    lsr0 l (ExtrNative.of_uint(1))
+  
+  (** val lit : int -> int **)
+  
+  let lit x =
+    lsl0 x (ExtrNative.of_uint(1))
+  
+  (** val neg : int -> int **)
+  
+  let neg l =
+    lxor0 l (ExtrNative.of_uint(1))
+  
+  (** val nlit : int -> int **)
+  
+  let nlit x =
+    neg (lit x)
+  
+  (** val _true : int **)
+  
+  let _true =
+    (ExtrNative.of_uint(0))
+  
+  (** val _false : int **)
+  
+  let _false =
+    (ExtrNative.of_uint(2))
+  
+  (** val eqb : int -> int -> bool **)
+  
+  let eqb l l' =
+    eqb0 l l'
+  
+  (** val interp : Valuation.t -> int -> bool **)
+  
+  let interp rho l =
+    if is_pos l
+    then Var.interp rho (blit l)
+    else negb (Var.interp rho (blit l))
+ end
+
+module C = 
+ struct 
+  type t = int list
+  
+  (** val interp : Valuation.t -> t -> bool **)
+  
+  let interp rho l =
+    existsb (Lit.interp rho) l
+  
+  (** val _true : t **)
+  
+  let _true =
+    Cons (Lit._true, Nil)
+  
+  (** val is_false : t -> bool **)
+  
+  let is_false = function
+  | Nil -> true
+  | Cons (i, l) -> false
+  
+  (** val or_aux : (t -> t -> t) -> int -> t -> t -> int list **)
+  
+  let rec or_aux or0 l1 c1 c2 = match c2 with
+  | Nil -> Cons (l1, c1)
+  | Cons (l2, c2') ->
+    (match compare0 l1 l2 with
+     | ExtrNative.Eq -> Cons (l1, (or0 c1 c2'))
+     | ExtrNative.Lt -> Cons (l1, (or0 c1 c2))
+     | ExtrNative.Gt -> Cons (l2, (or_aux or0 l1 c1 c2')))
+  
+  (** val coq_or : t -> t -> t **)
+  
+  let rec coq_or c1 c2 =
+    match c1 with
+    | Nil -> c2
+    | Cons (l1, c3) ->
+      (match c2 with
+       | Nil -> c1
+       | Cons (l2, c2') ->
+         (match compare0 l1 l2 with
+          | ExtrNative.Eq -> Cons (l1, (coq_or c3 c2'))
+          | ExtrNative.Lt -> Cons (l1, (coq_or c3 c2))
+          | ExtrNative.Gt -> Cons (l2, (or_aux coq_or l1 c3 c2'))))
+  
+  (** val resolve_aux : (t -> t -> t) -> int -> t -> t -> t **)
+  
+  let rec resolve_aux resolve0 l1 c1 c2 = match c2 with
+  | Nil -> _true
+  | Cons (l2, c2') ->
+    (match compare0 l1 l2 with
+     | ExtrNative.Eq -> Cons (l1, (resolve0 c1 c2'))
+     | ExtrNative.Lt ->
+       if eqb0 (lxor0 l1 l2) (ExtrNative.of_uint(1))
+       then coq_or c1 c2'
+       else Cons (l1, (resolve0 c1 c2))
+     | ExtrNative.Gt ->
+       if eqb0 (lxor0 l1 l2) (ExtrNative.of_uint(1))
+       then coq_or c1 c2'
+       else Cons (l2, (resolve_aux resolve0 l1 c1 c2')))
+  
+  (** val resolve : t -> t -> t **)
+  
+  let rec resolve c1 c2 =
+    match c1 with
+    | Nil -> _true
+    | Cons (l1, c3) ->
+      (match c2 with
+       | Nil -> _true
+       | Cons (l2, c2') ->
+         (match compare0 l1 l2 with
+          | ExtrNative.Eq -> Cons (l1, (resolve c3 c2'))
+          | ExtrNative.Lt ->
+            if eqb0 (lxor0 l1 l2) (ExtrNative.of_uint(1))
+            then coq_or c3 c2'
+            else Cons (l1, (resolve c3 c2))
+          | ExtrNative.Gt ->
+            if eqb0 (lxor0 l1 l2) (ExtrNative.of_uint(1))
+            then coq_or c3 c2'
+            else Cons (l2, (resolve_aux resolve l1 c3 c2'))))
+ end
+
+module S = 
+ struct 
+  type t = C.t array
+  
+  (** val get : t -> int -> C.t **)
+  
+  let get s cid =
+    get s cid
+  
+  (** val internal_set : t -> int -> C.t -> t **)
+  
+  let internal_set s cid c =
+    set s cid c
+  
+  (** val make : int -> t **)
+  
+  let make nclauses =
+    make nclauses C._true
+  
+  (** val insert : int -> int list -> int list **)
+  
+  let rec insert l1 c = match c with
+  | Nil -> Cons (l1, Nil)
+  | Cons (l2, c') ->
+    (match compare0 l1 l2 with
+     | ExtrNative.Eq -> c
+     | ExtrNative.Lt ->
+       if eqb0 (lxor0 l1 l2) (ExtrNative.of_uint(1))
+       then C._true
+       else Cons (l1, c)
+     | ExtrNative.Gt ->
+       if eqb0 (lxor0 l1 l2) (ExtrNative.of_uint(1))
+       then C._true
+       else Cons (l2, (insert l1 c')))
+  
+  (** val sort_uniq : int list -> int list **)
+  
+  let rec sort_uniq = function
+  | Nil -> Nil
+  | Cons (l1, c0) -> insert l1 (sort_uniq c0)
+  
+  (** val set_clause : t -> int -> C.t -> t **)
+  
+  let set_clause s pos c =
+    set s pos (sort_uniq c)
+  
+  (** val set_resolve : t -> int -> int array -> t **)
+  
+  let set_resolve s pos r =
+    let len = length r in
+    if eqb0 len (ExtrNative.of_uint(0))
+    then s
+    else let c =
+           foldi (fun i c -> C.resolve (get s (Coq__2.get r i)) c)
+             (ExtrNative.of_uint(1)) (sub0 len (ExtrNative.of_uint(1)))
+             (get s (Coq__2.get r (ExtrNative.of_uint(0))))
+         in
+         internal_set s pos c
+ end
+
+(** val afold_left :
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a2 -> 'a1) -> 'a2 array -> 'a1 **)
+
+let afold_left default0 oP f v =
+  let n0 = length v in
+  if eqb0 n0 (ExtrNative.of_uint(0))
+  then default0
+  else foldi (fun i a -> oP a (f (get v i))) (ExtrNative.of_uint(1))
+         (sub0 n0 (ExtrNative.of_uint(1)))
+         (f (get v (ExtrNative.of_uint(0))))
+
+(** val afold_right :
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a2 -> 'a1) -> 'a2 array -> 'a1 **)
+
+let afold_right default0 oP f v =
+  let n0 = length v in
+  if eqb0 n0 (ExtrNative.of_uint(0))
+  then default0
+  else if leb0 n0 (ExtrNative.of_uint(1))
+       then f (get v (ExtrNative.of_uint(0)))
+       else foldi_down (fun i b -> oP (f (get v i)) b)
+              (sub0 n0 (ExtrNative.of_uint(2))) (ExtrNative.of_uint(0))
+              (f (get v (sub0 n0 (ExtrNative.of_uint(1)))))
+
+(** val rev_aux : 'a1 list -> 'a1 list -> 'a1 list **)
+
+let rec rev_aux acc = function
+| Nil -> acc
+| Cons (t0, q) -> rev_aux (Cons (t0, acc)) q
+
+(** val rev : 'a1 list -> 'a1 list **)
+
+let rev l =
+  rev_aux Nil l
+
+(** val distinct_aux2 :
+    ('a1 -> 'a1 -> bool) -> bool -> 'a1 -> 'a1 list -> bool **)
+
+let rec distinct_aux2 eq acc ref = function
+| Nil -> acc
+| Cons (t0, q) ->
+  distinct_aux2 eq (if acc then negb (eq ref t0) else false) ref q
+
+(** val distinct_aux : ('a1 -> 'a1 -> bool) -> bool -> 'a1 list -> bool **)
+
+let rec distinct_aux eq acc = function
+| Nil -> acc
+| Cons (t0, q) ->
+  let acc' = distinct_aux2 eq acc t0 q in distinct_aux eq acc' q
+
+(** val distinct : ('a1 -> 'a1 -> bool) -> 'a1 list -> bool **)
+
+let distinct eq =
+  distinct_aux eq true
+
+(** val forallb2 : ('a1 -> 'a2 -> bool) -> 'a1 list -> 'a2 list -> bool **)
+
+let rec forallb2 f l1 l2 =
+  match l1 with
+  | Nil ->
+    (match l2 with
+     | Nil -> true
+     | Cons (y, l) -> false)
+  | Cons (a, l3) ->
+    (match l2 with
+     | Nil -> false
+     | Cons (b, l4) -> if f a b then forallb2 f l3 l4 else false)
+
+module Form = 
+ struct 
+  type form =
+  | Fatom of int
+  | Ftrue
+  | Ffalse
+  | Fnot2 of int * int
+  | Fand of int array
+  | For of int array
+  | Fimp of int array
+  | Fxor of int * int
+  | Fiff of int * int
+  | Fite of int * int * int
+  
+  (** val form_rect :
+      (int -> 'a1) -> 'a1 -> 'a1 -> (int -> int -> 'a1) -> (int array -> 'a1)
+      -> (int array -> 'a1) -> (int array -> 'a1) -> (int -> int -> 'a1) ->
+      (int -> int -> 'a1) -> (int -> int -> int -> 'a1) -> form -> 'a1 **)
+  
+  let form_rect f f0 f1 f2 f3 f4 f5 f6 f7 f8 = function
+  | Fatom x -> f x
+  | Ftrue -> f0
+  | Ffalse -> f1
+  | Fnot2 (x, x0) -> f2 x x0
+  | Fand x -> f3 x
+  | For x -> f4 x
+  | Fimp x -> f5 x
+  | Fxor (x, x0) -> f6 x x0
+  | Fiff (x, x0) -> f7 x x0
+  | Fite (x, x0, x1) -> f8 x x0 x1
+  
+  (** val form_rec :
+      (int -> 'a1) -> 'a1 -> 'a1 -> (int -> int -> 'a1) -> (int array -> 'a1)
+      -> (int array -> 'a1) -> (int array -> 'a1) -> (int -> int -> 'a1) ->
+      (int -> int -> 'a1) -> (int -> int -> int -> 'a1) -> form -> 'a1 **)
+  
+  let form_rec f f0 f1 f2 f3 f4 f5 f6 f7 f8 = function
+  | Fatom x -> f x
+  | Ftrue -> f0
+  | Ffalse -> f1
+  | Fnot2 (x, x0) -> f2 x x0
+  | Fand x -> f3 x
+  | For x -> f4 x
+  | Fimp x -> f5 x
+  | Fxor (x, x0) -> f6 x x0
+  | Fiff (x, x0) -> f7 x x0
+  | Fite (x, x0, x1) -> f8 x x0 x1
+  
+  (** val is_Ftrue : form -> bool **)
+  
+  let is_Ftrue = function
+  | Ftrue -> true
+  | _ -> false
+  
+  (** val is_Ffalse : form -> bool **)
+  
+  let is_Ffalse = function
+  | Ffalse -> true
+  | _ -> false
+  
+  (** val interp_aux : (int -> bool) -> (int -> bool) -> form -> bool **)
+  
+  let interp_aux interp_atom interp_var = function
+  | Fatom a -> interp_atom a
+  | Ftrue -> true
+  | Ffalse -> false
+  | Fnot2 (i, l) ->
+    fold (fun b -> negb (negb b)) (ExtrNative.of_uint(1)) i
+      (Lit.interp interp_var l)
+  | Fand args ->
+    afold_left true (fun b1 b2 -> if b1 then b2 else false)
+      (Lit.interp interp_var) args
+  | For args ->
+    afold_left false (fun b1 b2 -> if b1 then true else b2)
+      (Lit.interp interp_var) args
+  | Fimp args -> afold_right true implb (Lit.interp interp_var) args
+  | Fxor (a, b) -> xorb (Lit.interp interp_var a) (Lit.interp interp_var b)
+  | Fiff (a, b) -> eqb (Lit.interp interp_var a) (Lit.interp interp_var b)
+  | Fite (a, b, c) ->
+    if Lit.interp interp_var a
+    then Lit.interp interp_var b
+    else Lit.interp interp_var c
+  
+  (** val t_interp : (int -> bool) -> form array -> bool array **)
+  
+  let t_interp interp_atom t_form =
+    foldi_left (fun i t_b hf ->
+      set t_b i (interp_aux interp_atom (get t_b) hf))
+      (make (length t_form) true) t_form
+  
+  (** val lt_form : int -> form -> bool **)
+  
+  let rec lt_form i = function
+  | Fnot2 (i0, l) -> ltb0 (Lit.blit l) i
+  | Fand args -> forallb1 (fun l -> ltb0 (Lit.blit l) i) args
+  | For args -> forallb1 (fun l -> ltb0 (Lit.blit l) i) args
+  | Fimp args -> forallb1 (fun l -> ltb0 (Lit.blit l) i) args
+  | Fxor (a, b) -> if ltb0 (Lit.blit a) i then ltb0 (Lit.blit b) i else false
+  | Fiff (a, b) -> if ltb0 (Lit.blit a) i then ltb0 (Lit.blit b) i else false
+  | Fite (a, b, c) ->
+    if if ltb0 (Lit.blit a) i then ltb0 (Lit.blit b) i else false
+    then ltb0 (Lit.blit c) i
+    else false
+  | _ -> true
+  
+  (** val wf : form array -> bool **)
+  
+  let wf t_form =
+    forallbi lt_form t_form
+  
+  (** val interp_state_var : (int -> bool) -> form array -> int -> bool **)
+  
+  let interp_state_var interp_atom t_form =
+    let t_interp0 = t_interp interp_atom t_form in get t_interp0
+  
+  (** val interp : (int -> bool) -> form array -> form -> bool **)
+  
+  let interp interp_atom t_form =
+    interp_aux interp_atom (interp_state_var interp_atom t_form)
+  
+  (** val check_form : form array -> bool **)
+  
+  let check_form t_form =
+    if if if is_Ftrue (default t_form)
+          then is_Ftrue (get t_form (ExtrNative.of_uint(0)))
+          else false
+       then is_Ffalse (get t_form (ExtrNative.of_uint(1)))
+       else false
+    then wf t_form
+    else false
+ end
+
+type typ_eqb = { te_eqb : (__ -> __ -> bool);
+                 te_reflect : (__ -> __ -> reflect) }
+
+type te_carrier = __
+
+(** val te_eqb : typ_eqb -> te_carrier -> te_carrier -> bool **)
+
+let te_eqb x = x.te_eqb
+
+module Typ = 
+ struct 
+  type coq_type =
+  | Tindex of int
+  | TZ
+  | Tbool
+  | Tpositive
+  
+  (** val type_rect :
+      (int -> 'a1) -> 'a1 -> 'a1 -> 'a1 -> coq_type -> 'a1 **)
+  
+  let type_rect f f0 f1 f2 = function
+  | Tindex x -> f x
+  | TZ -> f0
+  | Tbool -> f1
+  | Tpositive -> f2
+  
+  (** val type_rec : (int -> 'a1) -> 'a1 -> 'a1 -> 'a1 -> coq_type -> 'a1 **)
+  
+  let type_rec f f0 f1 f2 = function
+  | Tindex x -> f x
+  | TZ -> f0
+  | Tbool -> f1
+  | Tpositive -> f2
+  
+  type ftype = coq_type list*coq_type
+  
+  type interp = __
+  
+  type interp_ftype = __
+  
+  (** val i_eqb : typ_eqb array -> coq_type -> interp -> interp -> bool **)
+  
+  let i_eqb t_i = function
+  | Tindex i -> (get t_i i).te_eqb
+  | TZ -> Obj.magic zeq_bool
+  | Tbool -> Obj.magic eqb
+  | Tpositive -> Obj.magic Coq_Pos.eqb
+  
+  (** val reflect_i_eqb :
+      typ_eqb array -> coq_type -> interp -> interp -> reflect **)
+  
+  let reflect_i_eqb t_i t0 x y =
+    iff_reflect (i_eqb t_i t0 x y)
+  
+  type cast_result =
+  | Cast of (__ -> __ -> __)
+  | NoCast
+  
+  (** val cast_result_rect :
+      coq_type -> coq_type -> ((__ -> __ -> __) -> 'a1) -> 'a1 -> cast_result
+      -> 'a1 **)
+  
+  let cast_result_rect a b f f0 = function
+  | Cast x -> f x
+  | NoCast -> f0
+  
+  (** val cast_result_rec :
+      coq_type -> coq_type -> ((__ -> __ -> __) -> 'a1) -> 'a1 -> cast_result
+      -> 'a1 **)
+  
+  let cast_result_rec a b f f0 = function
+  | Cast x -> f x
+  | NoCast -> f0
+  
+  (** val cast : coq_type -> coq_type -> cast_result **)
+  
+  let cast a b =
+    match a with
+    | Tindex i ->
+      (match b with
+       | Tindex j ->
+         (match cast i j with
+          | Some k -> Cast (fun _ -> k __)
+          | None -> NoCast)
+       | _ -> NoCast)
+    | TZ ->
+      (match b with
+       | TZ -> Cast (fun _ x -> x)
+       | _ -> NoCast)
+    | Tbool ->
+      (match b with
+       | Tbool -> Cast (fun _ x -> x)
+       | _ -> NoCast)
+    | Tpositive ->
+      (match b with
+       | Tpositive -> Cast (fun _ x -> x)
+       | _ -> NoCast)
+  
+  (** val eqb : coq_type -> coq_type -> bool **)
+  
+  let eqb a b =
+    match a with
+    | Tindex i ->
+      (match b with
+       | Tindex j -> eqb0 i j
+       | _ -> false)
+    | TZ ->
+      (match b with
+       | TZ -> true
+       | _ -> false)
+    | Tbool ->
+      (match b with
+       | Tbool -> true
+       | _ -> false)
+    | Tpositive ->
+      (match b with
+       | Tpositive -> true
+       | _ -> false)
+  
+  (** val reflect_eqb : coq_type -> coq_type -> reflect **)
+  
+  let reflect_eqb x y =
+    match x with
+    | Tindex i ->
+      (match y with
+       | Tindex i0 -> iff_reflect (eqb0 i i0)
+       | _ -> ReflectF)
+    | TZ ->
+      (match y with
+       | TZ -> ReflectT
+       | _ -> ReflectF)
+    | Tbool ->
+      (match y with
+       | Tbool -> ReflectT
+       | _ -> ReflectF)
+    | Tpositive ->
+      (match y with
+       | Tpositive -> ReflectT
+       | _ -> ReflectF)
+ end
+
+(** val list_beq : ('a1 -> 'a1 -> bool) -> 'a1 list -> 'a1 list -> bool **)
+
+let rec list_beq eq_A x y =
+  match x with
+  | Nil ->
+    (match y with
+     | Nil -> true
+     | Cons (a, l) -> false)
+  | Cons (x0, x1) ->
+    (match y with
+     | Nil -> false
+     | Cons (x2, x3) -> if eq_A x0 x2 then list_beq eq_A x1 x3 else false)
+
+(** val reflect_list_beq :
+    ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> reflect) -> 'a1 list -> 'a1 list
+    -> reflect **)
+
+let rec reflect_list_beq beq hbeq x y =
+  match x with
+  | Nil ->
+    (match y with
+     | Nil -> ReflectT
+     | Cons (a, y0) -> ReflectF)
+  | Cons (y0, l) ->
+    (match y with
+     | Nil -> ReflectF
+     | Cons (a0, y1) ->
+       let r = hbeq y0 a0 in
+       (match r with
+        | ReflectT -> reflect_list_beq beq hbeq l y1
+        | ReflectF -> ReflectF))
+
+module Atom = 
+ struct 
+  type cop =
+  | CO_xH
+  | CO_Z0
+  
+  (** val cop_rect : 'a1 -> 'a1 -> cop -> 'a1 **)
+  
+  let cop_rect f f0 = function
+  | CO_xH -> f
+  | CO_Z0 -> f0
+  
+  (** val cop_rec : 'a1 -> 'a1 -> cop -> 'a1 **)
+  
+  let cop_rec f f0 = function
+  | CO_xH -> f
+  | CO_Z0 -> f0
+  
+  type unop =
+  | UO_xO
+  | UO_xI
+  | UO_Zpos
+  | UO_Zneg
+  | UO_Zopp
+  
+  (** val unop_rect : 'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> unop -> 'a1 **)
+  
+  let unop_rect f f0 f1 f2 f3 = function
+  | UO_xO -> f
+  | UO_xI -> f0
+  | UO_Zpos -> f1
+  | UO_Zneg -> f2
+  | UO_Zopp -> f3
+  
+  (** val unop_rec : 'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> unop -> 'a1 **)
+  
+  let unop_rec f f0 f1 f2 f3 = function
+  | UO_xO -> f
+  | UO_xI -> f0
+  | UO_Zpos -> f1
+  | UO_Zneg -> f2
+  | UO_Zopp -> f3
+  
+  type binop =
+  | BO_Zplus
+  | BO_Zminus
+  | BO_Zmult
+  | BO_Zlt
+  | BO_Zle
+  | BO_Zge
+  | BO_Zgt
+  | BO_eq of Typ.coq_type
+  
+  (** val binop_rect :
+      'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> (Typ.coq_type -> 'a1)
+      -> binop -> 'a1 **)
+  
+  let binop_rect f f0 f1 f2 f3 f4 f5 f6 = function
+  | BO_Zplus -> f
+  | BO_Zminus -> f0
+  | BO_Zmult -> f1
+  | BO_Zlt -> f2
+  | BO_Zle -> f3
+  | BO_Zge -> f4
+  | BO_Zgt -> f5
+  | BO_eq x -> f6 x
+  
+  (** val binop_rec :
+      'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> (Typ.coq_type -> 'a1)
+      -> binop -> 'a1 **)
+  
+  let binop_rec f f0 f1 f2 f3 f4 f5 f6 = function
+  | BO_Zplus -> f
+  | BO_Zminus -> f0
+  | BO_Zmult -> f1
+  | BO_Zlt -> f2
+  | BO_Zle -> f3
+  | BO_Zge -> f4
+  | BO_Zgt -> f5
+  | BO_eq x -> f6 x
+  
+  type nop =
+    Typ.coq_type
+    (* singleton inductive, whose constructor was NO_distinct *)
+  
+  (** val nop_rect : (Typ.coq_type -> 'a1) -> nop -> 'a1 **)
+  
+  let nop_rect f n0 =
+    f n0
+  
+  (** val nop_rec : (Typ.coq_type -> 'a1) -> nop -> 'a1 **)
+  
+  let nop_rec f n0 =
+    f n0
+  
+  type atom =
+  | Acop of cop
+  | Auop of unop * int
+  | Abop of binop * int * int
+  | Anop of nop * int list
+  | Aapp of int * int list
+  
+  (** val atom_rect :
+      (cop -> 'a1) -> (unop -> int -> 'a1) -> (binop -> int -> int -> 'a1) ->
+      (nop -> int list -> 'a1) -> (int -> int list -> 'a1) -> atom -> 'a1 **)
+  
+  let atom_rect f f0 f1 f2 f3 = function
+  | Acop x -> f x
+  | Auop (x, x0) -> f0 x x0
+  | Abop (x, x0, x1) -> f1 x x0 x1
+  | Anop (x, x0) -> f2 x x0
+  | Aapp (x, x0) -> f3 x x0
+  
+  (** val atom_rec :
+      (cop -> 'a1) -> (unop -> int -> 'a1) -> (binop -> int -> int -> 'a1) ->
+      (nop -> int list -> 'a1) -> (int -> int list -> 'a1) -> atom -> 'a1 **)
+  
+  let atom_rec f f0 f1 f2 f3 = function
+  | Acop x -> f x
+  | Auop (x, x0) -> f0 x x0
+  | Abop (x, x0, x1) -> f1 x x0 x1
+  | Anop (x, x0) -> f2 x x0
+  | Aapp (x, x0) -> f3 x x0
+  
+  (** val cop_eqb : cop -> cop -> bool **)
+  
+  let cop_eqb o o' =
+    match o with
+    | CO_xH ->
+      (match o' with
+       | CO_xH -> true
+       | CO_Z0 -> false)
+    | CO_Z0 ->
+      (match o' with
+       | CO_xH -> false
+       | CO_Z0 -> true)
+  
+  (** val uop_eqb : unop -> unop -> bool **)
+  
+  let uop_eqb o o' =
+    match o with
+    | UO_xO ->
+      (match o' with
+       | UO_xO -> true
+       | _ -> false)
+    | UO_xI ->
+      (match o' with
+       | UO_xI -> true
+       | _ -> false)
+    | UO_Zpos ->
+      (match o' with
+       | UO_Zpos -> true
+       | _ -> false)
+    | UO_Zneg ->
+      (match o' with
+       | UO_Zneg -> true
+       | _ -> false)
+    | UO_Zopp ->
+      (match o' with
+       | UO_Zopp -> true
+       | _ -> false)
+  
+  (** val bop_eqb : binop -> binop -> bool **)
+  
+  let bop_eqb o o' =
+    match o with
+    | BO_Zplus ->
+      (match o' with
+       | BO_Zplus -> true
+       | _ -> false)
+    | BO_Zminus ->
+      (match o' with
+       | BO_Zminus -> true
+       | _ -> false)
+    | BO_Zmult ->
+      (match o' with
+       | BO_Zmult -> true
+       | _ -> false)
+    | BO_Zlt ->
+      (match o' with
+       | BO_Zlt -> true
+       | _ -> false)
+    | BO_Zle ->
+      (match o' with
+       | BO_Zle -> true
+       | _ -> false)
+    | BO_Zge ->
+      (match o' with
+       | BO_Zge -> true
+       | _ -> false)
+    | BO_Zgt ->
+      (match o' with
+       | BO_Zgt -> true
+       | _ -> false)
+    | BO_eq t0 ->
+      (match o' with
+       | BO_eq t' -> Typ.eqb t0 t'
+       | _ -> false)
+  
+  (** val nop_eqb : nop -> nop -> bool **)
+  
+  let nop_eqb o o' =
+    Typ.eqb o o'
+  
+  (** val eqb : atom -> atom -> bool **)
+  
+  let eqb t0 t' =
+    match t0 with
+    | Acop o ->
+      (match t' with
+       | Acop o' -> cop_eqb o o'
+       | _ -> false)
+    | Auop (o, t1) ->
+      (match t' with
+       | Auop (o', t'0) -> if uop_eqb o o' then eqb0 t1 t'0 else false
+       | _ -> false)
+    | Abop (o, t1, t2) ->
+      (match t' with
+       | Abop (o', t1', t2') ->
+         if if bop_eqb o o' then eqb0 t1 t1' else false
+         then eqb0 t2 t2'
+         else false
+       | _ -> false)
+    | Anop (o, t1) ->
+      (match t' with
+       | Anop (o', t'0) ->
+         if nop_eqb o o' then list_beq eqb0 t1 t'0 else false
+       | _ -> false)
+    | Aapp (a, la) ->
+      (match t' with
+       | Aapp (b, lb) -> if eqb0 a b then list_beq eqb0 la lb else false
+       | _ -> false)
+  
+  (** val reflect_cop_eqb : cop -> cop -> reflect **)
+  
+  let reflect_cop_eqb o1 o2 =
+    match o1 with
+    | CO_xH ->
+      (match o2 with
+       | CO_xH -> ReflectT
+       | CO_Z0 -> ReflectF)
+    | CO_Z0 ->
+      (match o2 with
+       | CO_xH -> ReflectF
+       | CO_Z0 -> ReflectT)
+  
+  (** val reflect_uop_eqb : unop -> unop -> reflect **)
+  
+  let reflect_uop_eqb o1 o2 =
+    match o1 with
+    | UO_xO ->
+      (match o2 with
+       | UO_xO -> ReflectT
+       | _ -> ReflectF)
+    | UO_xI ->
+      (match o2 with
+       | UO_xI -> ReflectT
+       | _ -> ReflectF)
+    | UO_Zpos ->
+      (match o2 with
+       | UO_Zpos -> ReflectT
+       | _ -> ReflectF)
+    | UO_Zneg ->
+      (match o2 with
+       | UO_Zneg -> ReflectT
+       | _ -> ReflectF)
+    | UO_Zopp ->
+      (match o2 with
+       | UO_Zopp -> ReflectT
+       | _ -> ReflectF)
+  
+  (** val reflect_bop_eqb : binop -> binop -> reflect **)
+  
+  let reflect_bop_eqb o1 o2 =
+    match o1 with
+    | BO_Zplus ->
+      (match o2 with
+       | BO_Zplus -> ReflectT
+       | _ -> ReflectF)
+    | BO_Zminus ->
+      (match o2 with
+       | BO_Zminus -> ReflectT
+       | _ -> ReflectF)
+    | BO_Zmult ->
+      (match o2 with
+       | BO_Zmult -> ReflectT
+       | _ -> ReflectF)
+    | BO_Zlt ->
+      (match o2 with
+       | BO_Zlt -> ReflectT
+       | _ -> ReflectF)
+    | BO_Zle ->
+      (match o2 with
+       | BO_Zle -> ReflectT
+       | _ -> ReflectF)
+    | BO_Zge ->
+      (match o2 with
+       | BO_Zge -> ReflectT
+       | _ -> ReflectF)
+    | BO_Zgt ->
+      (match o2 with
+       | BO_Zgt -> ReflectT
+       | _ -> ReflectF)
+    | BO_eq t0 ->
+      (match o2 with
+       | BO_eq t1 -> Typ.reflect_eqb t0 t1
+       | _ -> ReflectF)
+  
+  (** val reflect_nop_eqb : nop -> nop -> reflect **)
+  
+  let reflect_nop_eqb o1 o2 =
+    Typ.reflect_eqb o1 o2
+  
+  (** val reflect_eqb : atom -> atom -> reflect **)
+  
+  let reflect_eqb t1 t2 =
+    match t1 with
+    | Acop c ->
+      (match t2 with
+       | Acop c0 -> reflect_cop_eqb c c0
+       | _ -> ReflectF)
+    | Auop (u, i) ->
+      (match t2 with
+       | Auop (u0, i0) ->
+         let r = reflect_uop_eqb u u0 in
+         (match r with
+          | ReflectT -> reflect_eqb i i0
+          | ReflectF -> ReflectF)
+       | _ -> ReflectF)
+    | Abop (b, i, i0) ->
+      (match t2 with
+       | Abop (b0, i1, i2) ->
+         let r = reflect_bop_eqb b b0 in
+         (match r with
+          | ReflectT ->
+            let r0 = reflect_eqb i i1 in
+            (match r0 with
+             | ReflectT -> reflect_eqb i0 i2
+             | ReflectF -> ReflectF)
+          | ReflectF -> ReflectF)
+       | _ -> ReflectF)
+    | Anop (n0, l) ->
+      (match t2 with
+       | Anop (n1, l0) ->
+         let r = reflect_nop_eqb n0 n1 in
+         (match r with
+          | ReflectT -> reflect_list_beq eqb0 reflect_eqb l l0
+          | ReflectF -> ReflectF)
+       | _ -> ReflectF)
+    | Aapp (i, l) ->
+      (match t2 with
+       | Aapp (i0, l0) ->
+         let r = reflect_eqb i i0 in
+         (match r with
+          | ReflectT -> reflect_list_beq eqb0 reflect_eqb l l0
+          | ReflectF -> ReflectF)
+       | _ -> ReflectF)
+  
+  type ('t, 'i) coq_val = { v_type : 't; v_val : 'i }
+  
+  (** val val_rect : ('a1 -> 'a2 -> 'a3) -> ('a1, 'a2) coq_val -> 'a3 **)
+  
+  let val_rect f v =
+    let { v_type = x; v_val = x0 } = v in f x x0
+  
+  (** val val_rec : ('a1 -> 'a2 -> 'a3) -> ('a1, 'a2) coq_val -> 'a3 **)
+  
+  let val_rec f v =
+    let { v_type = x; v_val = x0 } = v in f x x0
+  
+  (** val v_type : ('a1, 'a2) coq_val -> 'a1 **)
+  
+  let v_type x = x.v_type
+  
+  (** val v_val : ('a1, 'a2) coq_val -> 'a2 **)
+  
+  let v_val x = x.v_val
+  
+  type bval = (Typ.coq_type, Typ.interp) coq_val
+  
+  (** val coq_Bval :
+      typ_eqb array -> Typ.coq_type -> Typ.interp -> (Typ.coq_type,
+      Typ.interp) coq_val **)
+  
+  let coq_Bval t_i x x0 =
+    { v_type = x; v_val = x0 }
+  
+  type tval = (Typ.ftype, Typ.interp_ftype) coq_val
+  
+  (** val coq_Tval :
+      typ_eqb array -> Typ.ftype -> Typ.interp_ftype -> (Typ.ftype,
+      Typ.interp_ftype) coq_val **)
+  
+  let coq_Tval t_i x x0 =
+    { v_type = x; v_val = x0 }
+  
+  (** val bvtrue : typ_eqb array -> bval **)
+  
+  let bvtrue t_i =
+    coq_Bval t_i Typ.Tbool (Obj.magic true)
+  
+  (** val bvfalse : typ_eqb array -> bval **)
+  
+  let bvfalse t_i =
+    coq_Bval t_i Typ.Tbool (Obj.magic false)
+  
+  (** val typ_cop : cop -> Typ.coq_type **)
+  
+  let typ_cop = function
+  | CO_xH -> Typ.Tpositive
+  | CO_Z0 -> Typ.TZ
+  
+  (** val typ_uop : unop -> Typ.coq_type*Typ.coq_type **)
+  
+  let typ_uop = function
+  | UO_xO -> Typ.Tpositive,Typ.Tpositive
+  | UO_xI -> Typ.Tpositive,Typ.Tpositive
+  | UO_Zopp -> Typ.TZ,Typ.TZ
+  | _ -> Typ.Tpositive,Typ.TZ
+  
+  (** val typ_bop : binop -> (Typ.coq_type*Typ.coq_type)*Typ.coq_type **)
+  
+  let typ_bop = function
+  | BO_Zplus -> (Typ.TZ,Typ.TZ),Typ.TZ
+  | BO_Zminus -> (Typ.TZ,Typ.TZ),Typ.TZ
+  | BO_Zmult -> (Typ.TZ,Typ.TZ),Typ.TZ
+  | BO_eq t0 -> (t0,t0),Typ.Tbool
+  | _ -> (Typ.TZ,Typ.TZ),Typ.Tbool
+  
+  (** val typ_nop : nop -> Typ.coq_type*Typ.coq_type **)
+  
+  let typ_nop o =
+    o,Typ.Tbool
+  
+  (** val check_args :
+      (int -> Typ.coq_type) -> int list -> Typ.coq_type list -> bool **)
+  
+  let rec check_args get_type0 args targs =
+    match args with
+    | Nil ->
+      (match targs with
+       | Nil -> true
+       | Cons (t0, l) -> false)
+    | Cons (a, args0) ->
+      (match targs with
+       | Nil -> false
+       | Cons (t0, targs0) ->
+         if Typ.eqb (get_type0 a) t0
+         then check_args get_type0 args0 targs0
+         else false)
+  
+  (** val check_aux :
+      typ_eqb array -> tval array -> (int -> Typ.coq_type) -> atom ->
+      Typ.coq_type -> bool **)
+  
+  let check_aux t_i t_func get_type0 a t0 =
+    match a with
+    | Acop o -> Typ.eqb (typ_cop o) t0
+    | Auop (o, a0) ->
+      let ta,t' = typ_uop o in
+      if Typ.eqb t' t0 then Typ.eqb (get_type0 a0) ta else false
+    | Abop (o, a1, a2) ->
+      let ta,t' = typ_bop o in
+      let ta1,ta2 = ta in
+      if if Typ.eqb t' t0 then Typ.eqb (get_type0 a1) ta1 else false
+      then Typ.eqb (get_type0 a2) ta2
+      else false
+    | Anop (o, a0) ->
+      let ta,t' = typ_nop o in
+      if Typ.eqb t' t0
+      then forallb (fun t1 -> Typ.eqb (get_type0 t1) ta) a0
+      else false
+    | Aapp (f, args) ->
+      let targs,tr = (get t_func f).v_type in
+      if check_args get_type0 args targs then Typ.eqb tr t0 else false
+  
+  (** val check_args_dec :
+      (int -> Typ.coq_type) -> Typ.coq_type -> int list -> Typ.coq_type list
+      -> sumbool **)
+  
+  let rec check_args_dec get_type0 a args targs =
+    match args with
+    | Nil ->
+      (match targs with
+       | Nil -> Left
+       | Cons (t0, l) -> Right)
+    | Cons (y, l) ->
+      (match targs with
+       | Nil -> Right
+       | Cons (b, targs0) ->
+         if Typ.eqb (get_type0 y) b
+         then check_args_dec get_type0 a l targs0
+         else Right)
+  
+  (** val check_aux_dec :
+      typ_eqb array -> tval array -> (int -> Typ.coq_type) -> atom -> sumbool **)
+  
+  let check_aux_dec t_i t_func get_type0 = function
+  | Acop op -> Left
+  | Auop (op, h) ->
+    (match op with
+     | UO_Zopp -> if Typ.eqb (get_type0 h) Typ.TZ then Left else Right
+     | _ -> if Typ.eqb (get_type0 h) Typ.Tpositive then Left else Right)
+  | Abop (op, h1, h2) ->
+    (match op with
+     | BO_eq t0 ->
+       if Typ.eqb (get_type0 h1) t0
+       then if Typ.eqb (get_type0 h2) t0 then Left else Right
+       else Right
+     | _ ->
+       if Typ.eqb (get_type0 h1) Typ.TZ
+       then if Typ.eqb (get_type0 h2) Typ.TZ then Left else Right
+       else Right)
+  | Anop (op, ha) ->
+    if forallb (fun t1 -> Typ.eqb (get_type0 t1) op) ha then Left else Right
+  | Aapp (f, args) ->
+    let l,t0 = (get t_func f).v_type in check_args_dec get_type0 t0 args l
+  
+  (** val apply_unop :
+      typ_eqb array -> Typ.coq_type -> Typ.coq_type -> (Typ.interp ->
+      Typ.interp) -> bval -> (Typ.coq_type, Typ.interp) coq_val **)
+  
+  let apply_unop t_i t0 r op tv =
+    let { v_type = t'; v_val = v } = tv in
+    (match Typ.cast t' t0 with
+     | Typ.Cast k -> coq_Bval t_i r (op (k __ v))
+     | Typ.NoCast -> bvtrue t_i)
+  
+  (** val apply_binop :
+      typ_eqb array -> Typ.coq_type -> Typ.coq_type -> Typ.coq_type ->
+      (Typ.interp -> Typ.interp -> Typ.interp) -> bval -> bval ->
+      (Typ.coq_type, Typ.interp) coq_val **)
+  
+  let apply_binop t_i t1 t2 r op tv1 tv2 =
+    let { v_type = t1'; v_val = v1 } = tv1 in
+    let { v_type = t2'; v_val = v2 } = tv2 in
+    (match Typ.cast t1' t1 with
+     | Typ.Cast k1 ->
+       (match Typ.cast t2' t2 with
+        | Typ.Cast k2 -> coq_Bval t_i r (op (k1 __ v1) (k2 __ v2))
+        | Typ.NoCast -> bvtrue t_i)
+     | Typ.NoCast -> bvtrue t_i)
+  
+  (** val apply_func :
+      typ_eqb array -> Typ.coq_type list -> Typ.coq_type -> Typ.interp_ftype
+      -> bval list -> bval **)
+  
+  let rec apply_func t_i targs tr f lv =
+    match targs with
+    | Nil ->
+      (match lv with
+       | Nil -> coq_Bval t_i tr f
+       | Cons (b, l) -> bvtrue t_i)
+    | Cons (t0, targs0) ->
+      (match lv with
+       | Nil -> bvtrue t_i
+       | Cons (v, lv0) ->
+         let { v_type = tv; v_val = v0 } = v in
+         (match Typ.cast tv t0 with
+          | Typ.Cast k ->
+            let f0 = Obj.magic f (k __ v0) in apply_func t_i targs0 tr f0 lv0
+          | Typ.NoCast -> bvtrue t_i))
+  
+  (** val interp_cop :
+      typ_eqb array -> cop -> (Typ.coq_type, Typ.interp) coq_val **)
+  
+  let interp_cop t_i = function
+  | CO_xH -> coq_Bval t_i Typ.Tpositive (Obj.magic XH)
+  | CO_Z0 -> coq_Bval t_i Typ.TZ (Obj.magic Z0)
+  
+  (** val interp_uop :
+      typ_eqb array -> unop -> bval -> (Typ.coq_type, Typ.interp) coq_val **)
+  
+  let interp_uop t_i = function
+  | UO_xO ->
+    apply_unop t_i Typ.Tpositive Typ.Tpositive (Obj.magic (fun x -> XO x))
+  | UO_xI ->
+    apply_unop t_i Typ.Tpositive Typ.Tpositive (Obj.magic (fun x -> XI x))
+  | UO_Zpos ->
+    apply_unop t_i Typ.Tpositive Typ.TZ (Obj.magic (fun x -> Zpos x))
+  | UO_Zneg ->
+    apply_unop t_i Typ.Tpositive Typ.TZ (Obj.magic (fun x -> Zneg x))
+  | UO_Zopp -> apply_unop t_i Typ.TZ Typ.TZ (Obj.magic Z.opp)
+  
+  (** val interp_bop :
+      typ_eqb array -> binop -> bval -> bval -> (Typ.coq_type, Typ.interp)
+      coq_val **)
+  
+  let interp_bop t_i = function
+  | BO_Zplus -> apply_binop t_i Typ.TZ Typ.TZ Typ.TZ (Obj.magic Z.add)
+  | BO_Zminus -> apply_binop t_i Typ.TZ Typ.TZ Typ.TZ (Obj.magic Z.sub)
+  | BO_Zmult -> apply_binop t_i Typ.TZ Typ.TZ Typ.TZ (Obj.magic Z.mul)
+  | BO_Zlt -> apply_binop t_i Typ.TZ Typ.TZ Typ.Tbool (Obj.magic Z.ltb)
+  | BO_Zle -> apply_binop t_i Typ.TZ Typ.TZ Typ.Tbool (Obj.magic Z.leb)
+  | BO_Zge -> apply_binop t_i Typ.TZ Typ.TZ Typ.Tbool (Obj.magic Z.geb)
+  | BO_Zgt -> apply_binop t_i Typ.TZ Typ.TZ Typ.Tbool (Obj.magic Z.gtb)
+  | BO_eq t0 ->
+    apply_binop t_i t0 t0 Typ.Tbool (Obj.magic (Typ.i_eqb t_i t0))
+  
+  (** val compute_interp :
+      typ_eqb array -> (int -> bval) -> Typ.coq_type -> Typ.interp list ->
+      int list -> Typ.interp list option **)
+  
+  let rec compute_interp t_i interp_hatom0 ty acc = function
+  | Nil -> Some acc
+  | Cons (a, q) ->
+    let { v_type = ta; v_val = va } = interp_hatom0 a in
+    (match Typ.cast ta ty with
+     | Typ.Cast ka ->
+       compute_interp t_i interp_hatom0 ty (Cons ((ka __ va), acc)) q
+     | Typ.NoCast -> None)
+  
+  (** val interp_aux :
+      typ_eqb array -> tval array -> (int -> bval) -> atom -> bval **)
+  
+  let interp_aux t_i t_func interp_hatom0 = function
+  | Acop o -> interp_cop t_i o
+  | Auop (o, a0) -> interp_uop t_i o (interp_hatom0 a0)
+  | Abop (o, a1, a2) ->
+    interp_bop t_i o (interp_hatom0 a1) (interp_hatom0 a2)
+  | Anop (n0, a0) ->
+    (match compute_interp t_i interp_hatom0 n0 Nil a0 with
+     | Some l ->
+       coq_Bval t_i Typ.Tbool
+         (Obj.magic (distinct (Typ.i_eqb t_i n0) (rev l)))
+     | None -> bvtrue t_i)
+  | Aapp (f, args) ->
+    let { v_type = tf; v_val = f0 } = get t_func f in
+    let lv = map interp_hatom0 args in apply_func t_i (fst tf) (snd tf) f0 lv
+  
+  (** val interp_bool : typ_eqb array -> bval -> bool **)
+  
+  let interp_bool t_i v =
+    let { v_type = t0; v_val = v0 } = v in
+    (match Typ.cast t0 Typ.Tbool with
+     | Typ.Cast k -> Obj.magic k __ v0
+     | Typ.NoCast -> true)
+  
+  (** val t_interp :
+      typ_eqb array -> tval array -> atom array -> bval array **)
+  
+  let t_interp t_i t_func t_atom =
+    foldi_left (fun i t_a a -> set t_a i (interp_aux t_i t_func (get t_a) a))
+      (make (length t_atom) (interp_cop t_i CO_xH)) t_atom
+  
+  (** val lt_atom : int -> atom -> bool **)
+  
+  let lt_atom i = function
+  | Acop c -> true
+  | Auop (u, h) -> ltb0 h i
+  | Abop (b, h1, h2) -> if ltb0 h1 i then ltb0 h2 i else false
+  | Anop (n0, ha) -> forallb (fun h -> ltb0 h i) ha
+  | Aapp (f, args) -> forallb (fun h -> ltb0 h i) args
+  
+  (** val wf : atom array -> bool **)
+  
+  let wf t_atom =
+    forallbi lt_atom t_atom
+  
+  (** val get_type' : typ_eqb array -> bval array -> int -> Typ.coq_type **)
+  
+  let get_type' t_i t_interp' i =
+    (get t_interp' i).v_type
+  
+  (** val get_type :
+      typ_eqb array -> tval array -> atom array -> int -> Typ.coq_type **)
+  
+  let get_type t_i t_func t_atom =
+    get_type' t_i (t_interp t_i t_func t_atom)
+  
+  (** val wt : typ_eqb array -> tval array -> atom array -> bool **)
+  
+  let wt t_i t_func t_atom =
+    let t_interp0 = t_interp t_i t_func t_atom in
+    let get_type0 = get_type' t_i t_interp0 in
+    forallbi (fun i h -> check_aux t_i t_func get_type0 h (get_type0 i))
+      t_atom
+  
+  (** val interp_hatom :
+      typ_eqb array -> tval array -> atom array -> int -> bval **)
+  
+  let interp_hatom t_i t_func t_atom =
+    let t_a = t_interp t_i t_func t_atom in get t_a
+  
+  (** val interp :
+      typ_eqb array -> tval array -> atom array -> atom -> bval **)
+  
+  let interp t_i t_func t_atom =
+    interp_aux t_i t_func (interp_hatom t_i t_func t_atom)
+  
+  (** val interp_form_hatom :
+      typ_eqb array -> tval array -> atom array -> int -> bool **)
+  
+  let interp_form_hatom t_i t_func t_atom =
+    let interp0 = interp_hatom t_i t_func t_atom in
+    (fun a -> interp_bool t_i (interp0 a))
+  
+  (** val check_atom : atom array -> bool **)
+  
+  let check_atom t_atom =
+    match default t_atom with
+    | Acop c ->
+      (match c with
+       | CO_xH -> wf t_atom
+       | CO_Z0 -> false)
+    | _ -> false
+ end
+
+(** val or_of_imp : int array -> int array **)
+
+let or_of_imp args =
+  let last = sub0 (length args) (ExtrNative.of_uint(1)) in
+  mapi (fun i l -> if eqb0 i last then l else Lit.neg l) args
+
+(** val check_True : C.t **)
+
+let check_True =
+  C._true
+
+(** val check_False : int list **)
+
+let check_False =
+  Cons ((Lit.neg Lit._false), Nil)
+
+(** val check_BuildDef : Form.form array -> int -> C.t **)
+
+let check_BuildDef t_form l =
+  match get t_form (Lit.blit l) with
+  | Form.Fand args ->
+    if Lit.is_pos l then Cons (l, (map Lit.neg (to_list args))) else C._true
+  | Form.For args ->
+    if Lit.is_pos l then C._true else Cons (l, (to_list args))
+  | Form.Fimp args ->
+    if Lit.is_pos l
+    then C._true
+    else let args0 = or_of_imp args in Cons (l, (to_list args0))
+  | Form.Fxor (a, b) ->
+    if Lit.is_pos l
+    then Cons (l, (Cons (a, (Cons ((Lit.neg b), Nil)))))
+    else Cons (l, (Cons (a, (Cons (b, Nil)))))
+  | Form.Fiff (a, b) ->
+    if Lit.is_pos l
+    then Cons (l, (Cons ((Lit.neg a), (Cons ((Lit.neg b), Nil)))))
+    else Cons (l, (Cons (a, (Cons ((Lit.neg b), Nil)))))
+  | Form.Fite (a, b, c) ->
+    if Lit.is_pos l
+    then Cons (l, (Cons (a, (Cons ((Lit.neg c), Nil)))))
+    else Cons (l, (Cons (a, (Cons (c, Nil)))))
+  | _ -> C._true
+
+(** val check_ImmBuildDef : Form.form array -> S.t -> int -> C.t **)
+
+let check_ImmBuildDef t_form s pos =
+  match S.get s pos with
+  | Nil -> C._true
+  | Cons (l, l0) ->
+    (match l0 with
+     | Nil ->
+       (match get t_form (Lit.blit l) with
+        | Form.Fand args ->
+          if Lit.is_pos l then C._true else map Lit.neg (to_list args)
+        | Form.For args -> if Lit.is_pos l then to_list args else C._true
+        | Form.Fimp args ->
+          if Lit.is_pos l
+          then let args0 = or_of_imp args in to_list args0
+          else C._true
+        | Form.Fxor (a, b) ->
+          if Lit.is_pos l
+          then Cons (a, (Cons (b, Nil)))
+          else Cons (a, (Cons ((Lit.neg b), Nil)))
+        | Form.Fiff (a, b) ->
+          if Lit.is_pos l
+          then Cons (a, (Cons ((Lit.neg b), Nil)))
+          else Cons ((Lit.neg a), (Cons ((Lit.neg b), Nil)))
+        | Form.Fite (a, b, c) ->
+          if Lit.is_pos l
+          then Cons (a, (Cons (c, Nil)))
+          else Cons (a, (Cons ((Lit.neg c), Nil)))
+        | _ -> C._true)
+     | Cons (i, l1) -> C._true)
+
+(** val check_BuildDef2 : Form.form array -> int -> C.t **)
+
+let check_BuildDef2 t_form l =
+  match get t_form (Lit.blit l) with
+  | Form.Fxor (a, b) ->
+    if Lit.is_pos l
+    then Cons (l, (Cons ((Lit.neg a), (Cons (b, Nil)))))
+    else Cons (l, (Cons ((Lit.neg a), (Cons ((Lit.neg b), Nil)))))
+  | Form.Fiff (a, b) ->
+    if Lit.is_pos l
+    then Cons (l, (Cons (a, (Cons (b, Nil)))))
+    else Cons (l, (Cons ((Lit.neg a), (Cons (b, Nil)))))
+  | Form.Fite (a, b, c) ->
+    if Lit.is_pos l
+    then Cons (l, (Cons ((Lit.neg a), (Cons ((Lit.neg b), Nil)))))
+    else Cons (l, (Cons ((Lit.neg a), (Cons (b, Nil)))))
+  | _ -> C._true
+
+(** val check_ImmBuildDef2 : Form.form array -> S.t -> int -> C.t **)
+
+let check_ImmBuildDef2 t_form s pos =
+  match S.get s pos with
+  | Nil -> C._true
+  | Cons (l, l0) ->
+    (match l0 with
+     | Nil ->
+       (match get t_form (Lit.blit l) with
+        | Form.Fxor (a, b) ->
+          if Lit.is_pos l
+          then Cons ((Lit.neg a), (Cons ((Lit.neg b), Nil)))
+          else Cons ((Lit.neg a), (Cons (b, Nil)))
+        | Form.Fiff (a, b) ->
+          if Lit.is_pos l
+          then Cons ((Lit.neg a), (Cons (b, Nil)))
+          else Cons (a, (Cons (b, Nil)))
+        | Form.Fite (a, b, c) ->
+          if Lit.is_pos l
+          then Cons ((Lit.neg a), (Cons (b, Nil)))
+          else Cons ((Lit.neg a), (Cons ((Lit.neg b), Nil)))
+        | _ -> C._true)
+     | Cons (i, l1) -> C._true)
+
+(** val check_BuildProj : Form.form array -> int -> int -> C.t **)
+
+let check_BuildProj t_form l i =
+  let x = Lit.blit l in
+  (match get t_form x with
+   | Form.Fand args ->
+     if ltb0 i (length args)
+     then Cons ((Lit.nlit x), (Cons ((get args i), Nil)))
+     else C._true
+   | Form.For args ->
+     if ltb0 i (length args)
+     then Cons ((Lit.lit x), (Cons ((Lit.neg (get args i)), Nil)))
+     else C._true
+   | Form.Fimp args ->
+     let len = length args in
+     if ltb0 i len
+     then if eqb0 i (sub0 len (ExtrNative.of_uint(1)))
+          then Cons ((Lit.lit x), (Cons ((Lit.neg (get args i)), Nil)))
+          else Cons ((Lit.lit x), (Cons ((get args i), Nil)))
+     else C._true
+   | _ -> C._true)
+
+(** val check_ImmBuildProj : Form.form array -> S.t -> int -> int -> C.t **)
+
+let check_ImmBuildProj t_form s pos i =
+  match S.get s pos with
+  | Nil -> C._true
+  | Cons (l, l0) ->
+    (match l0 with
+     | Nil ->
+       let x = Lit.blit l in
+       (match get t_form x with
+        | Form.Fand args ->
+          if if ltb0 i (length args) then Lit.is_pos l else false
+          then Cons ((get args i), Nil)
+          else C._true
+        | Form.For args ->
+          if if ltb0 i (length args) then negb (Lit.is_pos l) else false
+          then Cons ((Lit.neg (get args i)), Nil)
+          else C._true
+        | Form.Fimp args ->
+          let len = length args in
+          if if ltb0 i len then negb (Lit.is_pos l) else false
+          then if eqb0 i (sub0 len (ExtrNative.of_uint(1)))
+               then Cons ((Lit.neg (get args i)), Nil)
+               else Cons ((get args i), Nil)
+          else C._true
+        | _ -> C._true)
+     | Cons (i0, l1) -> C._true)
+
+(** val get_eq :
+    Form.form array -> Atom.atom array -> int -> (int -> int -> C.t) -> C.t **)
+
+let get_eq t_form t_atom x f =
+  match get t_form x with
+  | Form.Fatom xa ->
+    (match get t_atom xa with
+     | Atom.Abop (b0, a, b) ->
+       (match b0 with
+        | Atom.BO_eq t0 -> f a b
+        | _ -> C._true)
+     | _ -> C._true)
+  | _ -> C._true
+
+(** val check_trans_aux :
+    Form.form array -> Atom.atom array -> int -> int -> int list -> int ->
+    C.t -> C.t **)
+
+let rec check_trans_aux t_form t_atom t1 t2 eqs res clause0 =
+  match eqs with
+  | Nil ->
+    let xres = Lit.blit res in
+    get_eq t_form t_atom xres (fun t1' t2' ->
+      if if if eqb0 t1 t1' then eqb0 t2 t2' else false
+         then true
+         else if eqb0 t1 t2' then eqb0 t2 t1' else false
+      then Cons ((Lit.lit xres), clause0)
+      else C._true)
+  | Cons (leq, eqs0) ->
+    let xeq = Lit.blit leq in
+    get_eq t_form t_atom xeq (fun t0 t' ->
+      if eqb0 t2 t'
+      then check_trans_aux t_form t_atom t1 t0 eqs0 res (Cons
+             ((Lit.nlit xeq), clause0))
+      else if eqb0 t2 t0
+           then check_trans_aux t_form t_atom t1 t' eqs0 res (Cons
+                  ((Lit.nlit xeq), clause0))
+           else if eqb0 t1 t'
+                then check_trans_aux t_form t_atom t0 t2 eqs0 res (Cons
+                       ((Lit.nlit xeq), clause0))
+                else if eqb0 t1 t0
+                     then check_trans_aux t_form t_atom t' t2 eqs0 res (Cons
+                            ((Lit.nlit xeq), clause0))
+                     else C._true)
+
+(** val check_trans :
+    Form.form array -> Atom.atom array -> int -> int list -> C.t **)
+
+let check_trans t_form t_atom res = function
+| Nil ->
+  let xres = Lit.blit res in
+  get_eq t_form t_atom xres (fun t1 t2 ->
+    if eqb0 t1 t2 then Cons ((Lit.lit xres), Nil) else C._true)
+| Cons (leq, eqs0) ->
+  let xeq = Lit.blit leq in
+  get_eq t_form t_atom xeq (fun t1 t2 ->
+    check_trans_aux t_form t_atom t1 t2 eqs0 res (Cons ((Lit.nlit xeq), Nil)))
+
+(** val build_congr :
+    Form.form array -> Atom.atom array -> int option list -> int list -> int
+    list -> C.t -> C.t **)
+
+let rec build_congr t_form t_atom eqs l r c =
+  match eqs with
+  | Nil ->
+    (match l with
+     | Nil ->
+       (match r with
+        | Nil -> c
+        | Cons (i, l0) -> C._true)
+     | Cons (i, l0) -> C._true)
+  | Cons (eq, eqs0) ->
+    (match l with
+     | Nil -> C._true
+     | Cons (t1, l0) ->
+       (match r with
+        | Nil -> C._true
+        | Cons (t2, r0) ->
+          (match eq with
+           | Some leq ->
+             let xeq = Lit.blit leq in
+             get_eq t_form t_atom xeq (fun t1' t2' ->
+               if if if eqb0 t1 t1' then eqb0 t2 t2' else false
+                  then true
+                  else if eqb0 t1 t2' then eqb0 t2 t1' else false
+               then build_congr t_form t_atom eqs0 l0 r0 (Cons
+                      ((Lit.nlit xeq), c))
+               else C._true)
+           | None ->
+             if eqb0 t1 t2
+             then build_congr t_form t_atom eqs0 l0 r0 c
+             else C._true)))
+
+(** val check_congr :
+    Form.form array -> Atom.atom array -> int -> int option list -> C.t **)
+
+let check_congr t_form t_atom leq eqs =
+  let xeq = Lit.blit leq in
+  get_eq t_form t_atom xeq (fun t1 t2 ->
+    match get t_atom t1 with
+    | Atom.Auop (o1, a) ->
+      (match get t_atom t2 with
+       | Atom.Auop (o2, b) ->
+         if Atom.uop_eqb o1 o2
+         then build_congr t_form t_atom eqs (Cons (a, Nil)) (Cons (b, Nil))
+                (Cons ((Lit.lit xeq), Nil))
+         else C._true
+       | _ -> C._true)
+    | Atom.Abop (o1, a1, a2) ->
+      (match get t_atom t2 with
+       | Atom.Abop (o2, b1, b2) ->
+         if Atom.bop_eqb o1 o2
+         then build_congr t_form t_atom eqs (Cons (a1, (Cons (a2, Nil))))
+                (Cons (b1, (Cons (b2, Nil)))) (Cons ((Lit.lit xeq), Nil))
+         else C._true
+       | _ -> C._true)
+    | Atom.Aapp (f1, args1) ->
+      (match get t_atom t2 with
+       | Atom.Aapp (f2, args2) ->
+         if eqb0 f1 f2
+         then build_congr t_form t_atom eqs args1 args2 (Cons ((Lit.lit xeq),
+                Nil))
+         else C._true
+       | _ -> C._true)
+    | _ -> C._true)
+
+(** val check_congr_pred :
+    Form.form array -> Atom.atom array -> int -> int -> int option list ->
+    C.t **)
+
+let check_congr_pred t_form t_atom pA pB eqs =
+  let xPA = Lit.blit pA in
+  let xPB = Lit.blit pB in
+  (match get t_form xPA with
+   | Form.Fatom pa ->
+     (match get t_form xPB with
+      | Form.Fatom pb ->
+        (match get t_atom pa with
+         | Atom.Auop (o1, a) ->
+           (match get t_atom pb with
+            | Atom.Auop (o2, b) ->
+              if Atom.uop_eqb o1 o2
+              then build_congr t_form t_atom eqs (Cons (a, Nil)) (Cons (b,
+                     Nil)) (Cons ((Lit.nlit xPA), (Cons ((Lit.lit xPB),
+                     Nil))))
+              else C._true
+            | _ -> C._true)
+         | Atom.Abop (o1, a1, a2) ->
+           (match get t_atom pb with
+            | Atom.Abop (o2, b1, b2) ->
+              if Atom.bop_eqb o1 o2
+              then build_congr t_form t_atom eqs (Cons (a1, (Cons (a2,
+                     Nil)))) (Cons (b1, (Cons (b2, Nil)))) (Cons
+                     ((Lit.nlit xPA), (Cons ((Lit.lit xPB), Nil))))
+              else C._true
+            | _ -> C._true)
+         | Atom.Aapp (p, a) ->
+           (match get t_atom pb with
+            | Atom.Aapp (p', b) ->
+              if eqb0 p p'
+              then build_congr t_form t_atom eqs a b (Cons ((Lit.nlit xPA),
+                     (Cons ((Lit.lit xPB), Nil))))
+              else C._true
+            | _ -> C._true)
+         | _ -> C._true)
+      | _ -> C._true)
+   | _ -> C._true)
+
+type 'c pol =
+| Pc of 'c
+| Pinj of positive * 'c pol
+| PX of 'c pol * positive * 'c pol
+
+(** val p0 : 'a1 -> 'a1 pol **)
+
+let p0 cO =
+  Pc cO
+
+(** val p1 : 'a1 -> 'a1 pol **)
+
+let p1 cI =
+  Pc cI
+
+(** val peq : ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> bool **)
+
+let rec peq ceqb p p' =
+  match p with
+  | Pc c ->
+    (match p' with
+     | Pc c' -> ceqb c c'
+     | _ -> false)
+  | Pinj (j, q) ->
+    (match p' with
+     | Pinj (j', q') ->
+       (match Coq_Pos.compare j j' with
+        | ExtrNative.Eq -> peq ceqb q q'
+        | _ -> false)
+     | _ -> false)
+  | PX (p2, i, q) ->
+    (match p' with
+     | PX (p'0, i', q') ->
+       (match Coq_Pos.compare i i' with
+        | ExtrNative.Eq -> if peq ceqb p2 p'0 then peq ceqb q q' else false
+        | _ -> false)
+     | _ -> false)
+
+(** val mkPinj : positive -> 'a1 pol -> 'a1 pol **)
+
+let mkPinj j p = match p with
+| Pc c -> p
+| Pinj (j', q) -> Pinj ((Coq_Pos.add j j'), q)
+| PX (p2, p3, p4) -> Pinj (j, p)
+
+(** val mkPinj_pred : positive -> 'a1 pol -> 'a1 pol **)
+
+let mkPinj_pred j p =
+  match j with
+  | XI j0 -> Pinj ((XO j0), p)
+  | XO j0 -> Pinj ((Coq_Pos.pred_double j0), p)
+  | XH -> p
+
+(** val mkPX :
+    'a1 -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
+
+let mkPX cO ceqb p i q =
+  match p with
+  | Pc c -> if ceqb c cO then mkPinj XH q else PX (p, i, q)
+  | Pinj (p2, p3) -> PX (p, i, q)
+  | PX (p', i', q') ->
+    if peq ceqb q' (p0 cO)
+    then PX (p', (Coq_Pos.add i' i), q)
+    else PX (p, i, q)
+
+(** val mkXi : 'a1 -> 'a1 -> positive -> 'a1 pol **)
+
+let mkXi cO cI i =
+  PX ((p1 cI), i, (p0 cO))
+
+(** val mkX : 'a1 -> 'a1 -> 'a1 pol **)
+
+let mkX cO cI =
+  mkXi cO cI XH
+
+(** val popp : ('a1 -> 'a1) -> 'a1 pol -> 'a1 pol **)
+
+let rec popp copp = function
+| Pc c -> Pc (copp c)
+| Pinj (j, q) -> Pinj (j, (popp copp q))
+| PX (p2, i, q) -> PX ((popp copp p2), i, (popp copp q))
+
+(** val paddC : ('a1 -> 'a1 -> 'a1) -> 'a1 pol -> 'a1 -> 'a1 pol **)
+
+let rec paddC cadd p c =
+  match p with
+  | Pc c1 -> Pc (cadd c1 c)
+  | Pinj (j, q) -> Pinj (j, (paddC cadd q c))
+  | PX (p2, i, q) -> PX (p2, i, (paddC cadd q c))
+
+(** val psubC : ('a1 -> 'a1 -> 'a1) -> 'a1 pol -> 'a1 -> 'a1 pol **)
+
+let rec psubC csub p c =
+  match p with
+  | Pc c1 -> Pc (csub c1 c)
+  | Pinj (j, q) -> Pinj (j, (psubC csub q c))
+  | PX (p2, i, q) -> PX (p2, i, (psubC csub q c))
+
+(** val paddI :
+    ('a1 -> 'a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol ->
+    positive -> 'a1 pol -> 'a1 pol **)
+
+let rec paddI cadd pop q j = function
+| Pc c -> mkPinj j (paddC cadd q c)
+| Pinj (j', q') ->
+  (match Z.pos_sub j' j with
+   | Z0 -> mkPinj j (pop q' q)
+   | Zpos k -> mkPinj j (pop (Pinj (k, q')) q)
+   | Zneg k -> mkPinj j' (paddI cadd pop q k q'))
+| PX (p2, i, q') ->
+  (match j with
+   | XI j0 -> PX (p2, i, (paddI cadd pop q (XO j0) q'))
+   | XO j0 -> PX (p2, i, (paddI cadd pop q (Coq_Pos.pred_double j0) q'))
+   | XH -> PX (p2, i, (pop q' q)))
+
+(** val psubI :
+    ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) ->
+    'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
+
+let rec psubI cadd copp pop q j = function
+| Pc c -> mkPinj j (paddC cadd (popp copp q) c)
+| Pinj (j', q') ->
+  (match Z.pos_sub j' j with
+   | Z0 -> mkPinj j (pop q' q)
+   | Zpos k -> mkPinj j (pop (Pinj (k, q')) q)
+   | Zneg k -> mkPinj j' (psubI cadd copp pop q k q'))
+| PX (p2, i, q') ->
+  (match j with
+   | XI j0 -> PX (p2, i, (psubI cadd copp pop q (XO j0) q'))
+   | XO j0 -> PX (p2, i, (psubI cadd copp pop q (Coq_Pos.pred_double j0) q'))
+   | XH -> PX (p2, i, (pop q' q)))
+
+(** val paddX :
+    'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol
+    -> positive -> 'a1 pol -> 'a1 pol **)
+
+let rec paddX cO ceqb pop p' i' p = match p with
+| Pc c -> PX (p', i', p)
+| Pinj (j, q') ->
+  (match j with
+   | XI j0 -> PX (p', i', (Pinj ((XO j0), q')))
+   | XO j0 -> PX (p', i', (Pinj ((Coq_Pos.pred_double j0), q')))
+   | XH -> PX (p', i', q'))
+| PX (p2, i, q') ->
+  (match Z.pos_sub i i' with
+   | Z0 -> mkPX cO ceqb (pop p2 p') i q'
+   | Zpos k -> mkPX cO ceqb (pop (PX (p2, k, (p0 cO))) p') i' q'
+   | Zneg k -> mkPX cO ceqb (paddX cO ceqb pop p' k p2) i q')
+
+(** val psubX :
+    'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1
+    pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
+
+let rec psubX cO copp ceqb pop p' i' p = match p with
+| Pc c -> PX ((popp copp p'), i', p)
+| Pinj (j, q') ->
+  (match j with
+   | XI j0 -> PX ((popp copp p'), i', (Pinj ((XO j0), q')))
+   | XO j0 -> PX ((popp copp p'), i', (Pinj ((Coq_Pos.pred_double j0), q')))
+   | XH -> PX ((popp copp p'), i', q'))
+| PX (p2, i, q') ->
+  (match Z.pos_sub i i' with
+   | Z0 -> mkPX cO ceqb (pop p2 p') i q'
+   | Zpos k -> mkPX cO ceqb (pop (PX (p2, k, (p0 cO))) p') i' q'
+   | Zneg k -> mkPX cO ceqb (psubX cO copp ceqb pop p' k p2) i q')
+
+(** val padd :
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol
+    -> 'a1 pol **)
+
+let rec padd cO cadd ceqb p = function
+| Pc c' -> paddC cadd p c'
+| Pinj (j', q') -> paddI cadd (padd cO cadd ceqb) q' j' p
+| PX (p'0, i', q') ->
+  (match p with
+   | Pc c -> PX (p'0, i', (paddC cadd q' c))
+   | Pinj (j, q) ->
+     (match j with
+      | XI j0 -> PX (p'0, i', (padd cO cadd ceqb (Pinj ((XO j0), q)) q'))
+      | XO j0 ->
+        PX (p'0, i',
+          (padd cO cadd ceqb (Pinj ((Coq_Pos.pred_double j0), q)) q'))
+      | XH -> PX (p'0, i', (padd cO cadd ceqb q q')))
+   | PX (p2, i, q) ->
+     (match Z.pos_sub i i' with
+      | Z0 ->
+        mkPX cO ceqb (padd cO cadd ceqb p2 p'0) i (padd cO cadd ceqb q q')
+      | Zpos k ->
+        mkPX cO ceqb (padd cO cadd ceqb (PX (p2, k, (p0 cO))) p'0) i'
+          (padd cO cadd ceqb q q')
+      | Zneg k ->
+        mkPX cO ceqb (paddX cO ceqb (padd cO cadd ceqb) p'0 k p2) i
+          (padd cO cadd ceqb q q')))
+
+(** val psub :
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
+    -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
+
+let rec psub cO cadd csub copp ceqb p = function
+| Pc c' -> psubC csub p c'
+| Pinj (j', q') -> psubI cadd copp (psub cO cadd csub copp ceqb) q' j' p
+| PX (p'0, i', q') ->
+  (match p with
+   | Pc c -> PX ((popp copp p'0), i', (paddC cadd (popp copp q') c))
+   | Pinj (j, q) ->
+     (match j with
+      | XI j0 ->
+        PX ((popp copp p'0), i',
+          (psub cO cadd csub copp ceqb (Pinj ((XO j0), q)) q'))
+      | XO j0 ->
+        PX ((popp copp p'0), i',
+          (psub cO cadd csub copp ceqb (Pinj ((Coq_Pos.pred_double j0), q))
+            q'))
+      | XH -> PX ((popp copp p'0), i', (psub cO cadd csub copp ceqb q q')))
+   | PX (p2, i, q) ->
+     (match Z.pos_sub i i' with
+      | Z0 ->
+        mkPX cO ceqb (psub cO cadd csub copp ceqb p2 p'0) i
+          (psub cO cadd csub copp ceqb q q')
+      | Zpos k ->
+        mkPX cO ceqb (psub cO cadd csub copp ceqb (PX (p2, k, (p0 cO))) p'0)
+          i' (psub cO cadd csub copp ceqb q q')
+      | Zneg k ->
+        mkPX cO ceqb
+          (psubX cO copp ceqb (psub cO cadd csub copp ceqb) p'0 k p2) i
+          (psub cO cadd csub copp ceqb q q')))
+
+(** val pmulC_aux :
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 ->
+    'a1 pol **)
+
+let rec pmulC_aux cO cmul ceqb p c =
+  match p with
+  | Pc c' -> Pc (cmul c' c)
+  | Pinj (j, q) -> mkPinj j (pmulC_aux cO cmul ceqb q c)
+  | PX (p2, i, q) ->
+    mkPX cO ceqb (pmulC_aux cO cmul ceqb p2 c) i (pmulC_aux cO cmul ceqb q c)
+
+(** val pmulC :
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol ->
+    'a1 -> 'a1 pol **)
+
+let pmulC cO cI cmul ceqb p c =
+  if ceqb c cO
+  then p0 cO
+  else if ceqb c cI then p else pmulC_aux cO cmul ceqb p c
+
+(** val pmulI :
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol ->
+    'a1 pol -> 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
+
+let rec pmulI cO cI cmul ceqb pmul0 q j = function
+| Pc c -> mkPinj j (pmulC cO cI cmul ceqb q c)
+| Pinj (j', q') ->
+  (match Z.pos_sub j' j with
+   | Z0 -> mkPinj j (pmul0 q' q)
+   | Zpos k -> mkPinj j (pmul0 (Pinj (k, q')) q)
+   | Zneg k -> mkPinj j' (pmulI cO cI cmul ceqb pmul0 q k q'))
+| PX (p', i', q') ->
+  (match j with
+   | XI j' ->
+     mkPX cO ceqb (pmulI cO cI cmul ceqb pmul0 q j p') i'
+       (pmulI cO cI cmul ceqb pmul0 q (XO j') q')
+   | XO j' ->
+     mkPX cO ceqb (pmulI cO cI cmul ceqb pmul0 q j p') i'
+       (pmulI cO cI cmul ceqb pmul0 q (Coq_Pos.pred_double j') q')
+   | XH -> mkPX cO ceqb (pmulI cO cI cmul ceqb pmul0 q XH p') i' (pmul0 q' q))
+
+(** val pmul :
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
+
+let rec pmul cO cI cadd cmul ceqb p p'' = match p'' with
+| Pc c -> pmulC cO cI cmul ceqb p c
+| Pinj (j', q') -> pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' j' p
+| PX (p', i', q') ->
+  (match p with
+   | Pc c -> pmulC cO cI cmul ceqb p'' c
+   | Pinj (j, q) ->
+     let qQ' =
+       match j with
+       | XI j0 -> pmul cO cI cadd cmul ceqb (Pinj ((XO j0), q)) q'
+       | XO j0 ->
+         pmul cO cI cadd cmul ceqb (Pinj ((Coq_Pos.pred_double j0), q)) q'
+       | XH -> pmul cO cI cadd cmul ceqb q q'
+     in
+     mkPX cO ceqb (pmul cO cI cadd cmul ceqb p p') i' qQ'
+   | PX (p2, i, q) ->
+     let qQ' = pmul cO cI cadd cmul ceqb q q' in
+     let pQ' = pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' XH p2 in
+     let qP' = pmul cO cI cadd cmul ceqb (mkPinj XH q) p' in
+     let pP' = pmul cO cI cadd cmul ceqb p2 p' in
+     padd cO cadd ceqb
+       (mkPX cO ceqb (padd cO cadd ceqb (mkPX cO ceqb pP' i (p0 cO)) qP') i'
+         (p0 cO)) (mkPX cO ceqb pQ' i qQ'))
+
+(** val psquare :
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> bool) -> 'a1 pol -> 'a1 pol **)
+
+let rec psquare cO cI cadd cmul ceqb = function
+| Pc c -> Pc (cmul c c)
+| Pinj (j, q) -> Pinj (j, (psquare cO cI cadd cmul ceqb q))
+| PX (p2, i, q) ->
+  let twoPQ =
+    pmul cO cI cadd cmul ceqb p2
+      (mkPinj XH (pmulC cO cI cmul ceqb q (cadd cI cI)))
+  in
+  let q2 = psquare cO cI cadd cmul ceqb q in
+  let p3 = psquare cO cI cadd cmul ceqb p2 in
+  mkPX cO ceqb (padd cO cadd ceqb (mkPX cO ceqb p3 i (p0 cO)) twoPQ) i q2
+
+type 'c pExpr =
+| PEc of 'c
+| PEX of positive
+| PEadd of 'c pExpr * 'c pExpr
+| PEsub of 'c pExpr * 'c pExpr
+| PEmul of 'c pExpr * 'c pExpr
+| PEopp of 'c pExpr
+| PEpow of 'c pExpr * n
+
+(** val mk_X : 'a1 -> 'a1 -> positive -> 'a1 pol **)
+
+let mk_X cO cI j =
+  mkPinj_pred j (mkX cO cI)
+
+(** val ppow_pos :
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive -> 'a1
+    pol **)
+
+let rec ppow_pos cO cI cadd cmul ceqb subst_l res p = function
+| XI p3 ->
+  subst_l
+    (pmul cO cI cadd cmul ceqb
+      (ppow_pos cO cI cadd cmul ceqb subst_l
+        (ppow_pos cO cI cadd cmul ceqb subst_l res p p3) p p3) p)
+| XO p3 ->
+  ppow_pos cO cI cadd cmul ceqb subst_l
+    (ppow_pos cO cI cadd cmul ceqb subst_l res p p3) p p3
+| XH -> subst_l (pmul cO cI cadd cmul ceqb res p)
+
+(** val ppow_N :
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol **)
+
+let ppow_N cO cI cadd cmul ceqb subst_l p = function
+| N0 -> p1 cI
+| Npos p2 -> ppow_pos cO cI cadd cmul ceqb subst_l (p1 cI) p p2
+
+(** val norm_aux :
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol **)
+
+let rec norm_aux cO cI cadd cmul csub copp ceqb = function
+| PEc c -> Pc c
+| PEX j -> mk_X cO cI j
+| PEadd (pe1, pe2) ->
+  (match pe1 with
+   | PEopp pe3 ->
+     psub cO cadd csub copp ceqb
+       (norm_aux cO cI cadd cmul csub copp ceqb pe2)
+       (norm_aux cO cI cadd cmul csub copp ceqb pe3)
+   | _ ->
+     (match pe2 with
+      | PEopp pe3 ->
+        psub cO cadd csub copp ceqb
+          (norm_aux cO cI cadd cmul csub copp ceqb pe1)
+          (norm_aux cO cI cadd cmul csub copp ceqb pe3)
+      | _ ->
+        padd cO cadd ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1)
+          (norm_aux cO cI cadd cmul csub copp ceqb pe2)))
+| PEsub (pe1, pe2) ->
+  psub cO cadd csub copp ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1)
+    (norm_aux cO cI cadd cmul csub copp ceqb pe2)
+| PEmul (pe1, pe2) ->
+  pmul cO cI cadd cmul ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1)
+    (norm_aux cO cI cadd cmul csub copp ceqb pe2)
+| PEopp pe1 -> popp copp (norm_aux cO cI cadd cmul csub copp ceqb pe1)
+| PEpow (pe1, n0) ->
+  ppow_N cO cI cadd cmul ceqb (fun p -> p)
+    (norm_aux cO cI cadd cmul csub copp ceqb pe1) n0
+
+type 'a bFormula =
+| TT
+| FF
+| X
+| A of 'a
+| Cj of 'a bFormula * 'a bFormula
+| D of 'a bFormula * 'a bFormula
+| N of 'a bFormula
+| I of 'a bFormula * 'a bFormula
+
+type 'term' clause = 'term' list
+
+type 'term' cnf = 'term' clause list
+
+(** val tt : 'a1 cnf **)
+
+let tt =
+  Nil
+
+(** val ff : 'a1 cnf **)
+
+let ff =
+  Cons (Nil, Nil)
+
+(** val add_term :
+    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 -> 'a1 clause -> 'a1
+    clause option **)
+
+let rec add_term unsat deduce t0 = function
+| Nil ->
+  (match deduce t0 t0 with
+   | Some u -> if unsat u then None else Some (Cons (t0, Nil))
+   | None -> Some (Cons (t0, Nil)))
+| Cons (t', cl0) ->
+  (match deduce t0 t' with
+   | Some u ->
+     if unsat u
+     then None
+     else (match add_term unsat deduce t0 cl0 with
+           | Some cl' -> Some (Cons (t', cl'))
+           | None -> None)
+   | None ->
+     (match add_term unsat deduce t0 cl0 with
+      | Some cl' -> Some (Cons (t', cl'))
+      | None -> None))
+
+(** val or_clause :
+    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 clause
+    -> 'a1 clause option **)
+
+let rec or_clause unsat deduce cl1 cl2 =
+  match cl1 with
+  | Nil -> Some cl2
+  | Cons (t0, cl) ->
+    (match add_term unsat deduce t0 cl2 with
+     | Some cl' -> or_clause unsat deduce cl cl'
+     | None -> None)
+
+(** val or_clause_cnf :
+    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 cnf ->
+    'a1 cnf **)
+
+let or_clause_cnf unsat deduce t0 f =
+  fold_right (fun e acc ->
+    match or_clause unsat deduce t0 e with
+    | Some cl -> Cons (cl, acc)
+    | None -> acc) Nil f
+
+(** val or_cnf :
+    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 cnf -> 'a1 cnf -> 'a1
+    cnf **)
+
+let rec or_cnf unsat deduce f f' =
+  match f with
+  | Nil -> tt
+  | Cons (e, rst) ->
+    app (or_cnf unsat deduce rst f') (or_clause_cnf unsat deduce e f')
+
+(** val and_cnf : 'a1 cnf -> 'a1 cnf -> 'a1 cnf **)
+
+let and_cnf f1 f2 =
+  app f1 f2
+
+(** val xcnf :
+    ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1
+    -> 'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf **)
+
+let rec xcnf unsat deduce normalise0 negate0 pol0 = function
+| TT -> if pol0 then tt else ff
+| FF -> if pol0 then ff else tt
+| X -> ff
+| A x -> if pol0 then normalise0 x else negate0 x
+| Cj (e1, e2) ->
+  if pol0
+  then and_cnf (xcnf unsat deduce normalise0 negate0 pol0 e1)
+         (xcnf unsat deduce normalise0 negate0 pol0 e2)
+  else or_cnf unsat deduce (xcnf unsat deduce normalise0 negate0 pol0 e1)
+         (xcnf unsat deduce normalise0 negate0 pol0 e2)
+| D (e1, e2) ->
+  if pol0
+  then or_cnf unsat deduce (xcnf unsat deduce normalise0 negate0 pol0 e1)
+         (xcnf unsat deduce normalise0 negate0 pol0 e2)
+  else and_cnf (xcnf unsat deduce normalise0 negate0 pol0 e1)
+         (xcnf unsat deduce normalise0 negate0 pol0 e2)
+| N e -> xcnf unsat deduce normalise0 negate0 (negb pol0) e
+| I (e1, e2) ->
+  if pol0
+  then or_cnf unsat deduce
+         (xcnf unsat deduce normalise0 negate0 (negb pol0) e1)
+         (xcnf unsat deduce normalise0 negate0 pol0 e2)
+  else and_cnf (xcnf unsat deduce normalise0 negate0 (negb pol0) e1)
+         (xcnf unsat deduce normalise0 negate0 pol0 e2)
+
+(** val cnf_checker :
+    ('a1 list -> 'a2 -> bool) -> 'a1 cnf -> 'a2 list -> bool **)
+
+let rec cnf_checker checker0 f l =
+  match f with
+  | Nil -> true
+  | Cons (e, f0) ->
+    (match l with
+     | Nil -> false
+     | Cons (c, l0) ->
+       if checker0 e c then cnf_checker checker0 f0 l0 else false)
+
+(** val tauto_checker :
+    ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1
+    -> 'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1 bFormula -> 'a3 list ->
+    bool **)
+
+let tauto_checker unsat deduce normalise0 negate0 checker0 f w =
+  cnf_checker checker0 (xcnf unsat deduce normalise0 negate0 true f) w
+
+(** val cneqb : ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 -> bool **)
+
+let cneqb ceqb x y =
+  negb (ceqb x y)
+
+(** val cltb :
+    ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 -> bool **)
+
+let cltb ceqb cleb x y =
+  if cleb x y then cneqb ceqb x y else false
+
+type 'c polC = 'c pol
+
+type op1 =
+| Equal
+| NonEqual
+| Strict
+| NonStrict
+
+type 'c nFormula = 'c polC*op1
+
+(** val opMult : op1 -> op1 -> op1 option **)
+
+let opMult o o' =
+  match o with
+  | Equal -> Some Equal
+  | NonEqual ->
+    (match o' with
+     | Strict -> None
+     | NonStrict -> None
+     | x -> Some x)
+  | Strict ->
+    (match o' with
+     | NonEqual -> None
+     | _ -> Some o')
+  | NonStrict ->
+    (match o' with
+     | NonEqual -> None
+     | Strict -> Some NonStrict
+     | x -> Some x)
+
+(** val opAdd : op1 -> op1 -> op1 option **)
+
+let opAdd o o' =
+  match o with
+  | Equal -> Some o'
+  | NonEqual ->
+    (match o' with
+     | Equal -> Some NonEqual
+     | _ -> None)
+  | Strict ->
+    (match o' with
+     | NonEqual -> None
+     | _ -> Some Strict)
+  | NonStrict ->
+    (match o' with
+     | Equal -> Some NonStrict
+     | NonEqual -> None
+     | x -> Some x)
+
+type 'c psatz =
+| PsatzIn of nat
+| PsatzSquare of 'c polC
+| PsatzMulC of 'c polC * 'c psatz
+| PsatzMulE of 'c psatz * 'c psatz
+| PsatzAdd of 'c psatz * 'c psatz
+| PsatzC of 'c
+| PsatzZ
+
+(** val map_option : ('a1 -> 'a2 option) -> 'a1 option -> 'a2 option **)
+
+let map_option f = function
+| Some x -> f x
+| None -> None
+
+(** val map_option2 :
+    ('a1 -> 'a2 -> 'a3 option) -> 'a1 option -> 'a2 option -> 'a3 option **)
+
+let map_option2 f o o' =
+  match o with
+  | Some x ->
+    (match o' with
+     | Some x' -> f x x'
+     | None -> None)
+  | None -> None
+
+(** val pexpr_times_nformula :
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> bool) -> 'a1 polC -> 'a1 nFormula -> 'a1 nFormula option **)
+
+let pexpr_times_nformula cO cI cplus ctimes ceqb e = function
+| ef,o ->
+  (match o with
+   | Equal -> Some ((pmul cO cI cplus ctimes ceqb e ef),Equal)
+   | _ -> None)
+
+(** val nformula_times_nformula :
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> bool) -> 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula option **)
+
+let nformula_times_nformula cO cI cplus ctimes ceqb f1 f2 =
+  let e1,o1 = f1 in
+  let e2,o2 = f2 in
+  map_option (fun x -> Some ((pmul cO cI cplus ctimes ceqb e1 e2),x))
+    (opMult o1 o2)
+
+(** val nformula_plus_nformula :
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula -> 'a1
+    nFormula -> 'a1 nFormula option **)
+
+let nformula_plus_nformula cO cplus ceqb f1 f2 =
+  let e1,o1 = f1 in
+  let e2,o2 = f2 in
+  map_option (fun x -> Some ((padd cO cplus ceqb e1 e2),x)) (opAdd o1 o2)
+
+(** val eval_Psatz :
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz -> 'a1
+    nFormula option **)
+
+let rec eval_Psatz cO cI cplus ctimes ceqb cleb l = function
+| PsatzIn n0 -> Some (nth n0 l ((Pc cO),Equal))
+| PsatzSquare e0 -> Some ((psquare cO cI cplus ctimes ceqb e0),NonStrict)
+| PsatzMulC (re, e0) ->
+  map_option (pexpr_times_nformula cO cI cplus ctimes ceqb re)
+    (eval_Psatz cO cI cplus ctimes ceqb cleb l e0)
+| PsatzMulE (f1, f2) ->
+  map_option2 (nformula_times_nformula cO cI cplus ctimes ceqb)
+    (eval_Psatz cO cI cplus ctimes ceqb cleb l f1)
+    (eval_Psatz cO cI cplus ctimes ceqb cleb l f2)
+| PsatzAdd (f1, f2) ->
+  map_option2 (nformula_plus_nformula cO cplus ceqb)
+    (eval_Psatz cO cI cplus ctimes ceqb cleb l f1)
+    (eval_Psatz cO cI cplus ctimes ceqb cleb l f2)
+| PsatzC c -> if cltb ceqb cleb cO c then Some ((Pc c),Strict) else None
+| PsatzZ -> Some ((Pc cO),Equal)
+
+(** val check_inconsistent :
+    'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula ->
+    bool **)
+
+let check_inconsistent cO ceqb cleb = function
+| e,op ->
+  (match e with
+   | Pc c ->
+     (match op with
+      | Equal -> cneqb ceqb c cO
+      | NonEqual -> ceqb c cO
+      | Strict -> cleb c cO
+      | NonStrict -> cltb ceqb cleb c cO)
+   | _ -> false)
+
+type op2 =
+| OpEq
+| OpNEq
+| OpLe
+| OpGe
+| OpLt
+| OpGt
+
+type 't formula = { flhs : 't pExpr; fop : op2; frhs : 't pExpr }
+
+(** val norm :
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol **)
+
+let norm cO cI cplus ctimes cminus copp ceqb =
+  norm_aux cO cI cplus ctimes cminus copp ceqb
+
+(** val psub0 :
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
+    -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
+
+let psub0 cO cplus cminus copp ceqb =
+  psub cO cplus cminus copp ceqb
+
+(** val padd0 :
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol
+    -> 'a1 pol **)
+
+let padd0 cO cplus ceqb =
+  padd cO cplus ceqb
+
+type zWitness = z psatz
+
+(** val psub1 : z pol -> z pol -> z pol **)
+
+let psub1 =
+  psub0 Z0 Z.add Z.sub Z.opp zeq_bool
+
+(** val padd1 : z pol -> z pol -> z pol **)
+
+let padd1 =
+  padd0 Z0 Z.add zeq_bool
+
+(** val norm0 : z pExpr -> z pol **)
+
+let norm0 =
+  norm Z0 (Zpos XH) Z.add Z.mul Z.sub Z.opp zeq_bool
+
+(** val xnormalise : z formula -> z nFormula list **)
+
+let xnormalise t0 =
+  let { flhs = lhs; fop = o; frhs = rhs } = t0 in
+  let lhs0 = norm0 lhs in
+  let rhs0 = norm0 rhs in
+  (match o with
+   | OpEq ->
+     Cons (((psub1 lhs0 (padd1 rhs0 (Pc (Zpos XH)))),NonStrict), (Cons
+       (((psub1 rhs0 (padd1 lhs0 (Pc (Zpos XH)))),NonStrict), Nil)))
+   | OpNEq -> Cons (((psub1 lhs0 rhs0),Equal), Nil)
+   | OpLe -> Cons (((psub1 lhs0 (padd1 rhs0 (Pc (Zpos XH)))),NonStrict), Nil)
+   | OpGe -> Cons (((psub1 rhs0 (padd1 lhs0 (Pc (Zpos XH)))),NonStrict), Nil)
+   | OpLt -> Cons (((psub1 lhs0 rhs0),NonStrict), Nil)
+   | OpGt -> Cons (((psub1 rhs0 lhs0),NonStrict), Nil))
+
+(** val normalise : z formula -> z nFormula cnf **)
+
+let normalise t0 =
+  map (fun x -> Cons (x, Nil)) (xnormalise t0)
+
+(** val xnegate : z formula -> z nFormula list **)
+
+let xnegate t0 =
+  let { flhs = lhs; fop = o; frhs = rhs } = t0 in
+  let lhs0 = norm0 lhs in
+  let rhs0 = norm0 rhs in
+  (match o with
+   | OpEq -> Cons (((psub1 lhs0 rhs0),Equal), Nil)
+   | OpNEq ->
+     Cons (((psub1 lhs0 (padd1 rhs0 (Pc (Zpos XH)))),NonStrict), (Cons
+       (((psub1 rhs0 (padd1 lhs0 (Pc (Zpos XH)))),NonStrict), Nil)))
+   | OpLe -> Cons (((psub1 rhs0 lhs0),NonStrict), Nil)
+   | OpGe -> Cons (((psub1 lhs0 rhs0),NonStrict), Nil)
+   | OpLt -> Cons (((psub1 rhs0 (padd1 lhs0 (Pc (Zpos XH)))),NonStrict), Nil)
+   | OpGt -> Cons (((psub1 lhs0 (padd1 rhs0 (Pc (Zpos XH)))),NonStrict), Nil))
+
+(** val negate : z formula -> z nFormula cnf **)
+
+let negate t0 =
+  map (fun x -> Cons (x, Nil)) (xnegate t0)
+
+(** val zunsat : z nFormula -> bool **)
+
+let zunsat =
+  check_inconsistent Z0 zeq_bool Z.leb
+
+(** val zdeduce : z nFormula -> z nFormula -> z nFormula option **)
+
+let zdeduce =
+  nformula_plus_nformula Z0 Z.add zeq_bool
+
+(** val ceiling : z -> z -> z **)
+
+let ceiling a b =
+  let q,r = Z.div_eucl a b in
+  (match r with
+   | Z0 -> q
+   | _ -> Z.add q (Zpos XH))
+
+type zArithProof =
+| DoneProof
+| RatProof of zWitness * zArithProof
+| CutProof of zWitness * zArithProof
+| EnumProof of zWitness * zWitness * zArithProof list
+
+(** val zgcdM : z -> z -> z **)
+
+let zgcdM x y =
+  Z.max (Z.gcd x y) (Zpos XH)
+
+(** val zgcd_pol : z polC -> z*z **)
+
+let rec zgcd_pol = function
+| Pc c -> Z0,c
+| Pinj (p2, p3) -> zgcd_pol p3
+| PX (p2, p3, q) ->
+  let g1,c1 = zgcd_pol p2 in
+  let g2,c2 = zgcd_pol q in (zgcdM (zgcdM g1 c1) g2),c2
+
+(** val zdiv_pol : z polC -> z -> z polC **)
+
+let rec zdiv_pol p x =
+  match p with
+  | Pc c -> Pc (Z.div c x)
+  | Pinj (j, p2) -> Pinj (j, (zdiv_pol p2 x))
+  | PX (p2, j, q) -> PX ((zdiv_pol p2 x), j, (zdiv_pol q x))
+
+(** val makeCuttingPlane : z polC -> z polC*z **)
+
+let makeCuttingPlane p =
+  let g,c = zgcd_pol p in
+  if Z.gtb g Z0
+  then (zdiv_pol (psubC Z.sub p c) g),(Z.opp (ceiling (Z.opp c) g))
+  else p,Z0
+
+(** val genCuttingPlane : z nFormula -> ((z polC*z)*op1) option **)
+
+let genCuttingPlane = function
+| e,op ->
+  (match op with
+   | Equal ->
+     let g,c = zgcd_pol e in
+     if if Z.gtb g Z0
+        then if negb (zeq_bool c Z0)
+             then negb (zeq_bool (Z.gcd g c) g)
+             else false
+        else false
+     then None
+     else Some ((makeCuttingPlane e),Equal)
+   | NonEqual -> Some ((e,Z0),op)
+   | Strict -> Some ((makeCuttingPlane (psubC Z.sub e (Zpos XH))),NonStrict)
+   | NonStrict -> Some ((makeCuttingPlane e),NonStrict))
+
+(** val nformula_of_cutting_plane : ((z polC*z)*op1) -> z nFormula **)
+
+let nformula_of_cutting_plane = function
+| e_z,o -> let e,z0 = e_z in (padd1 e (Pc z0)),o
+
+(** val is_pol_Z0 : z polC -> bool **)
+
+let is_pol_Z0 = function
+| Pc z0 ->
+  (match z0 with
+   | Z0 -> true
+   | _ -> false)
+| _ -> false
+
+(** val eval_Psatz0 : z nFormula list -> zWitness -> z nFormula option **)
+
+let eval_Psatz0 =
+  eval_Psatz Z0 (Zpos XH) Z.add Z.mul zeq_bool Z.leb
+
+(** val valid_cut_sign : op1 -> bool **)
+
+let valid_cut_sign = function
+| Equal -> true
+| NonStrict -> true
+| _ -> false
+
+(** val zChecker : z nFormula list -> zArithProof -> bool **)
+
+let rec zChecker l = function
+| DoneProof -> false
+| RatProof (w, pf0) ->
+  (match eval_Psatz0 l w with
+   | Some f -> if zunsat f then true else zChecker (Cons (f, l)) pf0
+   | None -> false)
+| CutProof (w, pf0) ->
+  (match eval_Psatz0 l w with
+   | Some f ->
+     (match genCuttingPlane f with
+      | Some cp -> zChecker (Cons ((nformula_of_cutting_plane cp), l)) pf0
+      | None -> true)
+   | None -> false)
+| EnumProof (w1, w2, pf0) ->
+  (match eval_Psatz0 l w1 with
+   | Some f1 ->
+     (match eval_Psatz0 l w2 with
+      | Some f2 ->
+        (match genCuttingPlane f1 with
+         | Some p ->
+           let p2,op3 = p in
+           let e1,z1 = p2 in
+           (match genCuttingPlane f2 with
+            | Some p3 ->
+              let p4,op4 = p3 in
+              let e2,z2 = p4 in
+              if if if valid_cut_sign op3 then valid_cut_sign op4 else false
+                 then is_pol_Z0 (padd1 e1 e2)
+                 else false
+              then let rec label pfs lb ub =
+                     match pfs with
+                     | Nil -> Z.gtb lb ub
+                     | Cons (pf1, rsr) ->
+                       if zChecker (Cons (((psub1 e1 (Pc lb)),Equal), l)) pf1
+                       then label rsr (Z.add lb (Zpos XH)) ub
+                       else false
+                   in label pf0 (Z.opp z1) z2
+              else false
+            | None -> true)
+         | None -> true)
+      | None -> false)
+   | None -> false)
+
+(** val zTautoChecker : z formula bFormula -> zArithProof list -> bool **)
+
+let zTautoChecker f w =
+  tauto_checker zunsat zdeduce normalise negate zChecker f w
+
+(** val build_positive_atom_aux :
+    (int -> positive option) -> Atom.atom -> positive option **)
+
+let build_positive_atom_aux build_positive0 = function
+| Atom.Acop c ->
+  (match c with
+   | Atom.CO_xH -> Some XH
+   | Atom.CO_Z0 -> None)
+| Atom.Auop (u, a0) ->
+  (match u with
+   | Atom.UO_xO -> option_map (fun x -> XO x) (build_positive0 a0)
+   | Atom.UO_xI -> option_map (fun x -> XI x) (build_positive0 a0)
+   | _ -> None)
+| _ -> None
+
+(** val build_positive : Atom.atom array -> int -> positive option **)
+
+let build_positive t_atom =
+  foldi_down_cont (fun i cont h ->
+    build_positive_atom_aux cont (get t_atom h)) (length t_atom)
+    (ExtrNative.of_uint(0)) (fun x -> None)
+
+(** val build_z_atom_aux : Atom.atom array -> Atom.atom -> z option **)
+
+let build_z_atom_aux t_atom = function
+| Atom.Acop c ->
+  (match c with
+   | Atom.CO_xH -> None
+   | Atom.CO_Z0 -> Some Z0)
+| Atom.Auop (u, a0) ->
+  (match u with
+   | Atom.UO_Zpos -> option_map (fun x -> Zpos x) (build_positive t_atom a0)
+   | Atom.UO_Zneg -> option_map (fun x -> Zneg x) (build_positive t_atom a0)
+   | _ -> None)
+| _ -> None
+
+(** val build_z_atom : Atom.atom array -> Atom.atom -> z option **)
+
+let build_z_atom t_atom =
+  build_z_atom_aux t_atom
+
+type vmap = positive*Atom.atom list
+
+(** val find_var_aux :
+    Atom.atom -> positive -> Atom.atom list -> positive option **)
+
+let rec find_var_aux h p = function
+| Nil -> None
+| Cons (h', l0) ->
+  let p2 = Coq_Pos.pred p in
+  if Atom.eqb h h' then Some p2 else find_var_aux h p2 l0
+
+(** val find_var : vmap -> Atom.atom -> vmap*positive **)
+
+let find_var vm h =
+  let count,map0 = vm in
+  (match find_var_aux h count map0 with
+   | Some p -> vm,p
+   | None -> ((Coq_Pos.succ count),(Cons (h, map0))),count)
+
+(** val empty_vmap : vmap **)
+
+let empty_vmap =
+  XH,Nil
+
+(** val build_pexpr_atom_aux :
+    Atom.atom array -> (vmap -> int -> vmap*z pExpr) -> vmap -> Atom.atom ->
+    vmap*z pExpr **)
+
+let build_pexpr_atom_aux t_atom build_pexpr0 vm h = match h with
+| Atom.Auop (u, a) ->
+  (match u with
+   | Atom.UO_Zopp -> let vm0,pe = build_pexpr0 vm a in vm0,(PEopp pe)
+   | _ ->
+     (match build_z_atom t_atom h with
+      | Some z0 -> vm,(PEc z0)
+      | None -> let vm0,p = find_var vm h in vm0,(PEX p)))
+| Atom.Abop (b, a1, a2) ->
+  (match b with
+   | Atom.BO_Zplus ->
+     let vm0,pe1 = build_pexpr0 vm a1 in
+     let vm1,pe2 = build_pexpr0 vm0 a2 in vm1,(PEadd (pe1, pe2))
+   | Atom.BO_Zminus ->
+     let vm0,pe1 = build_pexpr0 vm a1 in
+     let vm1,pe2 = build_pexpr0 vm0 a2 in vm1,(PEsub (pe1, pe2))
+   | Atom.BO_Zmult ->
+     let vm0,pe1 = build_pexpr0 vm a1 in
+     let vm1,pe2 = build_pexpr0 vm0 a2 in vm1,(PEmul (pe1, pe2))
+   | _ ->
+     (match build_z_atom t_atom h with
+      | Some z0 -> vm,(PEc z0)
+      | None -> let vm0,p = find_var vm h in vm0,(PEX p)))
+| _ ->
+  (match build_z_atom t_atom h with
+   | Some z0 -> vm,(PEc z0)
+   | None -> let vm0,p = find_var vm h in vm0,(PEX p))
+
+(** val build_pexpr : Atom.atom array -> vmap -> int -> vmap*z pExpr **)
+
+let build_pexpr t_atom =
+  foldi_down_cont (fun i cont vm h ->
+    build_pexpr_atom_aux t_atom cont vm (get t_atom h)) (length t_atom)
+    (ExtrNative.of_uint(0)) (fun vm x -> vm,(PEc Z0))
+
+(** val build_op2 : Atom.binop -> op2 option **)
+
+let build_op2 = function
+| Atom.BO_Zlt -> Some OpLt
+| Atom.BO_Zle -> Some OpLe
+| Atom.BO_Zge -> Some OpGe
+| Atom.BO_Zgt -> Some OpGt
+| Atom.BO_eq t0 ->
+  (match t0 with
+   | Typ.TZ -> Some OpEq
+   | _ -> None)
+| _ -> None
+
+(** val build_formula_atom :
+    Atom.atom array -> vmap -> Atom.atom -> (vmap*z formula) option **)
+
+let build_formula_atom t_atom vm = function
+| Atom.Abop (op, a1, a2) ->
+  (match build_op2 op with
+   | Some o ->
+     let vm0,pe1 = build_pexpr t_atom vm a1 in
+     let vm1,pe2 = build_pexpr t_atom vm0 a2 in
+     Some (vm1,{ flhs = pe1; fop = o; frhs = pe2 })
+   | None -> None)
+| _ -> None
+
+(** val build_formula :
+    Atom.atom array -> vmap -> int -> (vmap*z formula) option **)
+
+let build_formula t_atom vm h =
+  build_formula_atom t_atom vm (get t_atom h)
+
+(** val build_not2 : int -> z formula bFormula -> z formula bFormula **)
+
+let build_not2 i f =
+  fold (fun f' -> N (N f')) (ExtrNative.of_uint(1)) i f
+
+(** val build_hform :
+    Atom.atom array -> (vmap -> int -> (vmap*z formula bFormula) option) ->
+    vmap -> Form.form -> (vmap*z formula bFormula) option **)
+
+let build_hform t_atom build_var0 vm = function
+| Form.Fatom h ->
+  (match build_formula t_atom vm h with
+   | Some p -> let vm0,f0 = p in Some (vm0,(A f0))
+   | None -> None)
+| Form.Ftrue -> Some (vm,TT)
+| Form.Ffalse -> Some (vm,FF)
+| Form.Fnot2 (i, l) ->
+  (match build_var0 vm (Lit.blit l) with
+   | Some p ->
+     let vm0,f0 = p in
+     let f' = build_not2 i f0 in
+     let f'' = if Lit.is_pos l then f' else N f' in Some (vm0,f'')
+   | None -> None)
+| Form.Fand args ->
+  let n0 = length args in
+  if eqb0 n0 (ExtrNative.of_uint(0))
+  then Some (vm,TT)
+  else foldi (fun i f1 ->
+         match f1 with
+         | Some y ->
+           let vm',f1' = y in
+           let l = get args i in
+           (match build_var0 vm' (Lit.blit l) with
+            | Some p ->
+              let vm2,f2 = p in
+              let f2' = if Lit.is_pos l then f2 else N f2 in
+              Some (vm2,(Cj (f1', f2')))
+            | None -> None)
+         | None -> None) (ExtrNative.of_uint(1))
+         (sub0 n0 (ExtrNative.of_uint(1)))
+         (let l = get args (ExtrNative.of_uint(0)) in
+          match build_var0 vm (Lit.blit l) with
+          | Some p ->
+            let vm',f0 = p in
+            if Lit.is_pos l then Some (vm',f0) else Some (vm',(N f0))
+          | None -> None)
+| Form.For args ->
+  let n0 = length args in
+  if eqb0 n0 (ExtrNative.of_uint(0))
+  then Some (vm,FF)
+  else foldi (fun i f1 ->
+         match f1 with
+         | Some y ->
+           let vm',f1' = y in
+           let l = get args i in
+           (match build_var0 vm' (Lit.blit l) with
+            | Some p ->
+              let vm2,f2 = p in
+              let f2' = if Lit.is_pos l then f2 else N f2 in
+              Some (vm2,(D (f1', f2')))
+            | None -> None)
+         | None -> None) (ExtrNative.of_uint(1))
+         (sub0 n0 (ExtrNative.of_uint(1)))
+         (let l = get args (ExtrNative.of_uint(0)) in
+          match build_var0 vm (Lit.blit l) with
+          | Some p ->
+            let vm',f0 = p in
+            if Lit.is_pos l then Some (vm',f0) else Some (vm',(N f0))
+          | None -> None)
+| Form.Fimp args ->
+  let n0 = length args in
+  if eqb0 n0 (ExtrNative.of_uint(0))
+  then Some (vm,TT)
+  else if leb0 n0 (ExtrNative.of_uint(1))
+       then let l = get args (ExtrNative.of_uint(0)) in
+            (match build_var0 vm (Lit.blit l) with
+             | Some p ->
+               let vm',f0 = p in
+               if Lit.is_pos l then Some (vm',f0) else Some (vm',(N f0))
+             | None -> None)
+       else foldi_down (fun i f1 ->
+              match f1 with
+              | Some y ->
+                let vm',f1' = y in
+                let l = get args i in
+                (match build_var0 vm' (Lit.blit l) with
+                 | Some p ->
+                   let vm2,f2 = p in
+                   let f2' = if Lit.is_pos l then f2 else N f2 in
+                   Some (vm2,(I (f2', f1')))
+                 | None -> None)
+              | None -> None) (sub0 n0 (ExtrNative.of_uint(2)))
+              (ExtrNative.of_uint(0))
+              (let l = get args (sub0 n0 (ExtrNative.of_uint(1))) in
+               match build_var0 vm (Lit.blit l) with
+               | Some p ->
+                 let vm',f0 = p in
+                 if Lit.is_pos l then Some (vm',f0) else Some (vm',(N f0))
+               | None -> None)
+| Form.Fxor (a, b) ->
+  (match build_var0 vm (Lit.blit a) with
+   | Some p ->
+     let vm1,f1 = p in
+     (match build_var0 vm1 (Lit.blit b) with
+      | Some p2 ->
+        let vm2,f2 = p2 in
+        let f1' = if Lit.is_pos a then f1 else N f1 in
+        let f2' = if Lit.is_pos b then f2 else N f2 in
+        Some (vm2,(Cj ((D (f1', f2')), (D ((N f1'), (N f2'))))))
+      | None -> None)
+   | None -> None)
+| Form.Fiff (a, b) ->
+  (match build_var0 vm (Lit.blit a) with
+   | Some p ->
+     let vm1,f1 = p in
+     (match build_var0 vm1 (Lit.blit b) with
+      | Some p2 ->
+        let vm2,f2 = p2 in
+        let f1' = if Lit.is_pos a then f1 else N f1 in
+        let f2' = if Lit.is_pos b then f2 else N f2 in
+        Some (vm2,(Cj ((D (f1', (N f2'))), (D ((N f1'), f2')))))
+      | None -> None)
+   | None -> None)
+| Form.Fite (a, b, c) ->
+  (match build_var0 vm (Lit.blit a) with
+   | Some p ->
+     let vm1,f1 = p in
+     (match build_var0 vm1 (Lit.blit b) with
+      | Some p2 ->
+        let vm2,f2 = p2 in
+        (match build_var0 vm2 (Lit.blit c) with
+         | Some p3 ->
+           let vm3,f3 = p3 in
+           let f1' = if Lit.is_pos a then f1 else N f1 in
+           let f2' = if Lit.is_pos b then f2 else N f2 in
+           let f3' = if Lit.is_pos c then f3 else N f3 in
+           Some (vm3,(D ((Cj (f1', f2')), (Cj ((N f1'), f3')))))
+         | None -> None)
+      | None -> None)
+   | None -> None)
+
+(** val build_var :
+    Form.form array -> Atom.atom array -> vmap -> int -> (vmap*z formula
+    bFormula) option **)
+
+let build_var t_form t_atom =
+  foldi_down_cont (fun i cont vm h ->
+    build_hform t_atom cont vm (get t_form h)) (length t_form)
+    (ExtrNative.of_uint(0)) (fun x x0 -> None)
+
+(** val build_form :
+    Form.form array -> Atom.atom array -> vmap -> Form.form -> (vmap*z
+    formula bFormula) option **)
+
+let build_form t_form t_atom =
+  build_hform t_atom (build_var t_form t_atom)
+
+(** val build_nlit :
+    Form.form array -> Atom.atom array -> vmap -> int -> (vmap*z formula
+    bFormula) option **)
+
+let build_nlit t_form t_atom vm l =
+  let l0 = Lit.neg l in
+  (match build_form t_form t_atom vm (get t_form (Lit.blit l0)) with
+   | Some p ->
+     let vm0,f = p in
+     let f0 = if Lit.is_pos l0 then f else N f in Some (vm0,f0)
+   | None -> None)
+
+(** val build_clause_aux :
+    Form.form array -> Atom.atom array -> vmap -> int list -> (vmap*z formula
+    bFormula) option **)
+
+let rec build_clause_aux t_form t_atom vm = function
+| Nil -> None
+| Cons (l, cl0) ->
+  (match cl0 with
+   | Nil -> build_nlit t_form t_atom vm l
+   | Cons (i, l0) ->
+     (match build_nlit t_form t_atom vm l with
+      | Some p ->
+        let vm0,bf1 = p in
+        (match build_clause_aux t_form t_atom vm0 cl0 with
+         | Some p2 -> let vm1,bf2 = p2 in Some (vm1,(Cj (bf1, bf2)))
+         | None -> None)
+      | None -> None))
+
+(** val build_clause :
+    Form.form array -> Atom.atom array -> vmap -> int list -> (vmap*z formula
+    bFormula) option **)
+
+let build_clause t_form t_atom vm cl =
+  match build_clause_aux t_form t_atom vm cl with
+  | Some p -> let vm0,bf = p in Some (vm0,(I (bf, FF)))
+  | None -> None
+
+(** val get_eq0 :
+    Form.form array -> Atom.atom array -> int -> (int -> int -> C.t) -> C.t **)
+
+let get_eq0 t_form t_atom l f =
+  if Lit.is_pos l
+  then (match get t_form (Lit.blit l) with
+        | Form.Fatom xa ->
+          (match get t_atom xa with
+           | Atom.Abop (b0, a, b) ->
+             (match b0 with
+              | Atom.BO_eq t0 -> f a b
+              | _ -> C._true)
+           | _ -> C._true)
+        | _ -> C._true)
+  else C._true
+
+(** val get_not_le :
+    Form.form array -> Atom.atom array -> int -> (int -> int -> C.t) -> C.t **)
+
+let get_not_le t_form t_atom l f =
+  if negb (Lit.is_pos l)
+  then (match get t_form (Lit.blit l) with
+        | Form.Fatom xa ->
+          (match get t_atom xa with
+           | Atom.Abop (b0, a, b) ->
+             (match b0 with
+              | Atom.BO_Zle -> f a b
+              | _ -> C._true)
+           | _ -> C._true)
+        | _ -> C._true)
+  else C._true
+
+(** val check_micromega :
+    Form.form array -> Atom.atom array -> int list -> zArithProof list -> C.t **)
+
+let check_micromega t_form t_atom cl c =
+  match build_clause t_form t_atom empty_vmap cl with
+  | Some p -> let v,bf = p in if zTautoChecker bf c then cl else C._true
+  | None -> C._true
+
+(** val check_diseq : Form.form array -> Atom.atom array -> int -> C.t **)
+
+let check_diseq t_form t_atom l =
+  match get t_form (Lit.blit l) with
+  | Form.For a ->
+    if eqb0 (length a) (ExtrNative.of_uint(3))
+    then let a_eq_b = get a (ExtrNative.of_uint(0)) in
+         let not_a_le_b = get a (ExtrNative.of_uint(1)) in
+         let not_b_le_a = get a (ExtrNative.of_uint(2)) in
+         get_eq0 t_form t_atom a_eq_b (fun a0 b ->
+           get_not_le t_form t_atom not_a_le_b (fun a' b' ->
+             get_not_le t_form t_atom not_b_le_a (fun b'' a'' ->
+               if if if if eqb0 a0 a' then eqb0 a0 a'' else false
+                     then eqb0 b b'
+                     else false
+                  then eqb0 b b''
+                  else false
+               then Cons ((Lit.lit (Lit.blit l)), Nil)
+               else if if if if eqb0 a0 b' then eqb0 a0 b'' else false
+                          then eqb0 b a'
+                          else false
+                       then eqb0 b a''
+                       else false
+                    then Cons ((Lit.lit (Lit.blit l)), Nil)
+                    else C._true)))
+    else C._true
+  | _ -> C._true
+
+(** val check_atom_aux :
+    Atom.atom array -> (int -> int -> bool) -> Atom.atom -> Atom.atom -> bool **)
+
+let check_atom_aux t_atom check_hatom0 a b =
+  match a with
+  | Atom.Acop o1 ->
+    (match b with
+     | Atom.Acop o2 -> Atom.cop_eqb o1 o2
+     | _ -> false)
+  | Atom.Auop (o1, a0) ->
+    (match o1 with
+     | Atom.UO_Zneg ->
+       (match b with
+        | Atom.Auop (o2, b0) ->
+          (match o2 with
+           | Atom.UO_Zopp ->
+             (match get t_atom b0 with
+              | Atom.Auop (u, q) ->
+                (match u with
+                 | Atom.UO_Zpos -> check_hatom0 a0 q
+                 | _ -> false)
+              | _ -> false)
+           | _ -> if Atom.uop_eqb o1 o2 then check_hatom0 a0 b0 else false)
+        | _ -> false)
+     | Atom.UO_Zopp ->
+       (match b with
+        | Atom.Auop (o2, b0) ->
+          (match o2 with
+           | Atom.UO_Zneg ->
+             (match get t_atom a0 with
+              | Atom.Auop (u, p) ->
+                (match u with
+                 | Atom.UO_Zpos -> check_hatom0 p b0
+                 | _ -> false)
+              | _ -> false)
+           | _ -> if Atom.uop_eqb o1 o2 then check_hatom0 a0 b0 else false)
+        | _ -> false)
+     | _ ->
+       (match b with
+        | Atom.Auop (o2, b0) ->
+          if Atom.uop_eqb o1 o2 then check_hatom0 a0 b0 else false
+        | _ -> false))
+  | Atom.Abop (o1, a1, a2) ->
+    (match b with
+     | Atom.Abop (o2, b1, b2) ->
+       (match o1 with
+        | Atom.BO_Zplus ->
+          (match o2 with
+           | Atom.BO_Zplus ->
+             if if check_hatom0 a1 b1 then check_hatom0 a2 b2 else false
+             then true
+             else if check_hatom0 a1 b2 then check_hatom0 a2 b1 else false
+           | _ -> false)
+        | Atom.BO_Zminus ->
+          (match o2 with
+           | Atom.BO_Zminus ->
+             if check_hatom0 a1 b1 then check_hatom0 a2 b2 else false
+           | _ -> false)
+        | Atom.BO_Zmult ->
+          (match o2 with
+           | Atom.BO_Zmult ->
+             if if check_hatom0 a1 b1 then check_hatom0 a2 b2 else false
+             then true
+             else if check_hatom0 a1 b2 then check_hatom0 a2 b1 else false
+           | _ -> false)
+        | Atom.BO_Zlt ->
+          (match o2 with
+           | Atom.BO_Zlt ->
+             if check_hatom0 a1 b1 then check_hatom0 a2 b2 else false
+           | Atom.BO_Zgt ->
+             if check_hatom0 a1 b2 then check_hatom0 a2 b1 else false
+           | _ -> false)
+        | Atom.BO_Zle ->
+          (match o2 with
+           | Atom.BO_Zle ->
+             if check_hatom0 a1 b1 then check_hatom0 a2 b2 else false
+           | Atom.BO_Zge ->
+             if check_hatom0 a1 b2 then check_hatom0 a2 b1 else false
+           | _ -> false)
+        | Atom.BO_Zge ->
+          (match o2 with
+           | Atom.BO_Zle ->
+             if check_hatom0 a1 b2 then check_hatom0 a2 b1 else false
+           | Atom.BO_Zge ->
+             if check_hatom0 a1 b1 then check_hatom0 a2 b2 else false
+           | _ -> false)
+        | Atom.BO_Zgt ->
+          (match o2 with
+           | Atom.BO_Zlt ->
+             if check_hatom0 a1 b2 then check_hatom0 a2 b1 else false
+           | Atom.BO_Zgt ->
+             if check_hatom0 a1 b1 then check_hatom0 a2 b2 else false
+           | _ -> false)
+        | Atom.BO_eq t1 ->
+          (match o2 with
+           | Atom.BO_eq t2 ->
+             if Typ.eqb t1 t2
+             then if if check_hatom0 a1 b1 then check_hatom0 a2 b2 else false
+                  then true
+                  else if check_hatom0 a1 b2
+                       then check_hatom0 a2 b1
+                       else false
+             else false
+           | _ -> false))
+     | _ -> false)
+  | Atom.Anop (o1, l1) ->
+    (match b with
+     | Atom.Anop (o2, l2) ->
+       if Typ.eqb o1 o2 then list_beq check_hatom0 l1 l2 else false
+     | _ -> false)
+  | Atom.Aapp (f1, aargs) ->
+    (match b with
+     | Atom.Aapp (f2, bargs) ->
+       if eqb0 f1 f2 then list_beq check_hatom0 aargs bargs else false
+     | _ -> false)
+
+(** val check_hatom : Atom.atom array -> int -> int -> bool **)
+
+let check_hatom t_atom h1 h2 =
+  foldi_down_cont (fun x cont h3 h4 ->
+    if eqb0 h3 h4
+    then true
+    else check_atom_aux t_atom cont (get t_atom h3) (get t_atom h4))
+    (length t_atom) (ExtrNative.of_uint(0)) (fun h3 h4 -> false) h1 h2
+
+(** val check_neg_hatom : Atom.atom array -> int -> int -> bool **)
+
+let check_neg_hatom t_atom h1 h2 =
+  match get t_atom h1 with
+  | Atom.Abop (op3, a1, a2) ->
+    (match get t_atom h2 with
+     | Atom.Abop (op4, b1, b2) ->
+       (match op3 with
+        | Atom.BO_Zlt ->
+          (match op4 with
+           | Atom.BO_Zle ->
+             if check_hatom t_atom a1 b2
+             then check_hatom t_atom a2 b1
+             else false
+           | Atom.BO_Zge ->
+             if check_hatom t_atom a1 b1
+             then check_hatom t_atom a2 b2
+             else false
+           | _ -> false)
+        | Atom.BO_Zle ->
+          (match op4 with
+           | Atom.BO_Zlt ->
+             if check_hatom t_atom a1 b2
+             then check_hatom t_atom a2 b1
+             else false
+           | Atom.BO_Zgt ->
+             if check_hatom t_atom a1 b1
+             then check_hatom t_atom a2 b2
+             else false
+           | _ -> false)
+        | Atom.BO_Zge ->
+          (match op4 with
+           | Atom.BO_Zlt ->
+             if check_hatom t_atom a1 b1
+             then check_hatom t_atom a2 b2
+             else false
+           | Atom.BO_Zgt ->
+             if check_hatom t_atom a1 b2
+             then check_hatom t_atom a2 b1
+             else false
+           | _ -> false)
+        | Atom.BO_Zgt ->
+          (match op4 with
+           | Atom.BO_Zle ->
+             if check_hatom t_atom a1 b1
+             then check_hatom t_atom a2 b2
+             else false
+           | Atom.BO_Zge ->
+             if check_hatom t_atom a1 b2
+             then check_hatom t_atom a2 b1
+             else false
+           | _ -> false)
+        | _ -> false)
+     | _ -> false)
+  | _ -> false
+
+(** val remove_not : Form.form array -> int -> int **)
+
+let remove_not t_form l =
+  match get t_form (Lit.blit l) with
+  | Form.Fnot2 (i, l') -> if Lit.is_pos l then l' else Lit.neg l'
+  | _ -> l
+
+(** val get_and : Form.form array -> int -> int array option **)
+
+let get_and t_form l =
+  let l0 = remove_not t_form l in
+  if Lit.is_pos l0
+  then (match get t_form (Lit.blit l0) with
+        | Form.Fand args -> Some args
+        | _ -> None)
+  else None
+
+(** val get_or : Form.form array -> int -> int array option **)
+
+let get_or t_form l =
+  let l0 = remove_not t_form l in
+  if Lit.is_pos l0
+  then (match get t_form (Lit.blit l0) with
+        | Form.For args -> Some args
+        | _ -> None)
+  else None
+
+(** val flatten_op_body :
+    (int -> int array option) -> (int list -> int -> int list) -> int list ->
+    int -> int list **)
+
+let flatten_op_body get_op frec largs l =
+  match get_op l with
+  | Some a -> fold_left frec largs a
+  | None -> Cons (l, largs)
+
+(** val flatten_op_lit :
+    (int -> int array option) -> int -> int list -> int -> int list **)
+
+let flatten_op_lit get_op max0 =
+  foldi_cont (fun x -> flatten_op_body get_op) (ExtrNative.of_uint(0)) max0
+    (fun largs l -> Cons (l, largs))
+
+(** val flatten_and : Form.form array -> int array -> int list **)
+
+let flatten_and t_form t0 =
+  fold_left (flatten_op_lit (get_and t_form) (length t_form)) Nil t0
+
+(** val flatten_or : Form.form array -> int array -> int list **)
+
+let flatten_or t_form t0 =
+  fold_left (flatten_op_lit (get_or t_form) (length t_form)) Nil t0
+
+(** val check_flatten_body :
+    Form.form array -> (int -> int -> bool) -> (int -> int -> bool) -> (int
+    -> int -> bool) -> int -> int -> bool **)
+
+let check_flatten_body t_form check_atom0 check_neg_atom frec l lf =
+  let l0 = remove_not t_form l in
+  let lf0 = remove_not t_form lf in
+  if eqb0 l0 lf0
+  then true
+  else if eqb0 (land0 (ExtrNative.of_uint(1)) (lxor0 l0 lf0))
+            (ExtrNative.of_uint(0))
+       then (match get t_form (Lit.blit l0) with
+             | Form.Fatom a1 ->
+               (match get t_form (Lit.blit lf0) with
+                | Form.Fatom a2 -> check_atom0 a1 a2
+                | _ -> false)
+             | Form.Ftrue ->
+               (match get t_form (Lit.blit lf0) with
+                | Form.Ftrue -> true
+                | _ -> false)
+             | Form.Ffalse ->
+               (match get t_form (Lit.blit lf0) with
+                | Form.Ffalse -> true
+                | _ -> false)
+             | Form.Fnot2 (i, i0) -> false
+             | Form.Fand args1 ->
+               (match get t_form (Lit.blit lf0) with
+                | Form.Fand args2 ->
+                  let args3 = flatten_and t_form args1 in
+                  let args4 = flatten_and t_form args2 in
+                  forallb2 frec args3 args4
+                | _ -> false)
+             | Form.For args1 ->
+               (match get t_form (Lit.blit lf0) with
+                | Form.For args2 ->
+                  let args3 = flatten_or t_form args1 in
+                  let args4 = flatten_or t_form args2 in
+                  forallb2 frec args3 args4
+                | _ -> false)
+             | Form.Fimp args1 ->
+               (match get t_form (Lit.blit lf0) with
+                | Form.Fimp args2 ->
+                  if eqb0 (length args1) (length args2)
+                  then forallbi (fun i l1 -> frec l1 (get args2 i)) args1
+                  else false
+                | _ -> false)
+             | Form.Fxor (l1, l2) ->
+               (match get t_form (Lit.blit lf0) with
+                | Form.Fxor (lf1, lf2) ->
+                  if frec l1 lf1 then frec l2 lf2 else false
+                | _ -> false)
+             | Form.Fiff (l1, l2) ->
+               (match get t_form (Lit.blit lf0) with
+                | Form.Fiff (lf1, lf2) ->
+                  if frec l1 lf1 then frec l2 lf2 else false
+                | _ -> false)
+             | Form.Fite (l1, l2, l3) ->
+               (match get t_form (Lit.blit lf0) with
+                | Form.Fite (lf1, lf2, lf3) ->
+                  if if frec l1 lf1 then frec l2 lf2 else false
+                  then frec l3 lf3
+                  else false
+                | _ -> false))
+       else (match get t_form (Lit.blit l0) with
+             | Form.Fatom a1 ->
+               (match get t_form (Lit.blit lf0) with
+                | Form.Fatom a2 -> check_neg_atom a1 a2
+                | _ -> false)
+             | _ -> false)
+
+(** val check_flatten_aux :
+    Form.form array -> (int -> int -> bool) -> (int -> int -> bool) -> int ->
+    int -> bool **)
+
+let check_flatten_aux t_form check_atom0 check_neg_atom l lf =
+  foldi_cont (fun x -> check_flatten_body t_form check_atom0 check_neg_atom)
+    (ExtrNative.of_uint(0)) (length t_form) (fun x x0 -> false) l lf
+
+(** val check_flatten :
+    Form.form array -> (int -> int -> bool) -> (int -> int -> bool) -> S.t ->
+    int -> int -> C.t **)
+
+let check_flatten t_form check_atom0 check_neg_atom s cid lf =
+  match S.get s cid with
+  | Nil -> C._true
+  | Cons (l, l0) ->
+    (match l0 with
+     | Nil ->
+       if check_flatten_aux t_form check_atom0 check_neg_atom l lf
+       then Cons (lf, Nil)
+       else C._true
+     | Cons (i, l1) -> C._true)
+
+(** val check_spl_arith :
+    Form.form array -> Atom.atom array -> int list -> int -> zArithProof list
+    -> C.t **)
+
+let check_spl_arith t_form t_atom orig res l =
+  match orig with
+  | Nil -> C._true
+  | Cons (li, l0) ->
+    (match l0 with
+     | Nil ->
+       let cl = Cons ((Lit.neg li), (Cons (res, Nil))) in
+       (match build_clause t_form t_atom empty_vmap cl with
+        | Some p ->
+          let v,bf = p in
+          if zTautoChecker bf l then Cons (res, Nil) else C._true
+        | None -> C._true)
+     | Cons (y, l1) -> C._true)
+
+(** val check_in : int -> int list -> bool **)
+
+let rec check_in x = function
+| Nil -> false
+| Cons (t0, q) -> if eqb0 x t0 then true else check_in x q
+
+(** val check_diseqs_complete_aux :
+    int -> int list -> (int*int) option array -> bool **)
+
+let rec check_diseqs_complete_aux a dist t0 =
+  match dist with
+  | Nil -> true
+  | Cons (b, q) ->
+    if existsb1 (fun x ->
+         match x with
+         | Some p ->
+           let a',b' = p in
+           if if eqb0 a a' then eqb0 b b' else false
+           then true
+           else if eqb0 a b' then eqb0 b a' else false
+         | None -> false) t0
+    then check_diseqs_complete_aux a q t0
+    else false
+
+(** val check_diseqs_complete :
+    int list -> (int*int) option array -> bool **)
+
+let rec check_diseqs_complete dist t0 =
+  match dist with
+  | Nil -> true
+  | Cons (a, q) ->
+    if check_diseqs_complete_aux a q t0
+    then check_diseqs_complete q t0
+    else false
+
+(** val check_diseqs :
+    Form.form array -> Atom.atom array -> Typ.coq_type -> int list -> int
+    array -> bool **)
+
+let check_diseqs t_form t_atom ty dist diseq =
+  let t0 =
+    mapi (fun x t0 ->
+      if Lit.is_pos t0
+      then None
+      else (match get t_form (Lit.blit t0) with
+            | Form.Fatom a ->
+              (match get t_atom a with
+               | Atom.Acop c -> None
+               | Atom.Auop (u, i) -> None
+               | Atom.Abop (b, h1, h2) ->
+                 (match b with
+                  | Atom.BO_Zplus -> None
+                  | Atom.BO_Zminus -> None
+                  | Atom.BO_Zmult -> None
+                  | Atom.BO_Zlt -> None
+                  | Atom.BO_Zle -> None
+                  | Atom.BO_Zge -> None
+                  | Atom.BO_Zgt -> None
+                  | Atom.BO_eq a0 ->
+                    if if if if Typ.eqb ty a0
+                             then negb (eqb0 h1 h2)
+                             else false
+                          then check_in h1 dist
+                          else false
+                       then check_in h2 dist
+                       else false
+                    then Some (h1,h2)
+                    else None)
+               | _ -> None)
+            | _ -> None)) diseq
+  in
+  if forallb1 (fun x ->
+       match x with
+       | Some y -> true
+       | None -> false) t0
+  then check_diseqs_complete dist t0
+  else false
+
+(** val check_distinct :
+    Form.form array -> Atom.atom array -> int -> int array -> bool **)
+
+let check_distinct t_form t_atom ha diseq =
+  match get t_atom ha with
+  | Atom.Anop (n0, dist) -> check_diseqs t_form t_atom n0 dist diseq
+  | _ -> false
+
+(** val check_distinct_two_args :
+    Form.form array -> Atom.atom array -> int -> int -> bool **)
+
+let check_distinct_two_args t_form t_atom f1 f2 =
+  match get t_form f1 with
+  | Form.Fatom ha ->
+    (match get t_form f2 with
+     | Form.Fatom hb ->
+       (match get t_atom ha with
+        | Atom.Anop (n0, l) ->
+          (match l with
+           | Nil -> false
+           | Cons (x, l0) ->
+             (match l0 with
+              | Nil -> false
+              | Cons (y, l1) ->
+                (match l1 with
+                 | Nil ->
+                   (match get t_atom hb with
+                    | Atom.Abop (b, x', y') ->
+                      (match b with
+                       | Atom.BO_eq ty' ->
+                         if Typ.eqb n0 ty'
+                         then if if eqb0 x x' then eqb0 y y' else false
+                              then true
+                              else if eqb0 x y' then eqb0 y x' else false
+                         else false
+                       | _ -> false)
+                    | _ -> false)
+                 | Cons (i, l2) -> false)))
+        | _ -> false)
+     | _ -> false)
+  | _ -> false
+
+(** val check_lit :
+    Form.form array -> Atom.atom array -> (int -> int -> bool) -> int -> int
+    -> bool **)
+
+let check_lit t_form t_atom check_var l1 l2 =
+  if if eqb0 l1 l2
+     then true
+     else if eqb (Lit.is_pos l1) (Lit.is_pos l2)
+          then check_var (Lit.blit l1) (Lit.blit l2)
+          else false
+  then true
+  else if eqb (Lit.is_pos l1) (negb (Lit.is_pos l2))
+       then check_distinct_two_args t_form t_atom (Lit.blit l1) (Lit.blit l2)
+       else false
+
+(** val check_form_aux :
+    Form.form array -> Atom.atom array -> (int -> int -> bool) -> Form.form
+    -> Form.form -> bool **)
+
+let check_form_aux t_form t_atom check_var a b =
+  match a with
+  | Form.Fatom a0 ->
+    (match b with
+     | Form.Fatom b0 -> eqb0 a0 b0
+     | Form.Fand diseq -> check_distinct t_form t_atom a0 diseq
+     | _ -> false)
+  | Form.Ftrue ->
+    (match b with
+     | Form.Ftrue -> true
+     | _ -> false)
+  | Form.Ffalse ->
+    (match b with
+     | Form.Ffalse -> true
+     | _ -> false)
+  | Form.Fnot2 (i1, l1) ->
+    (match b with
+     | Form.Fnot2 (i2, l2) ->
+       if eqb0 i1 i2 then check_lit t_form t_atom check_var l1 l2 else false
+     | _ -> false)
+  | Form.Fand a1 ->
+    (match b with
+     | Form.Fand a2 ->
+       if eqb0 (length a1) (length a2)
+       then forallbi (fun i l ->
+              check_lit t_form t_atom check_var l (get a2 i)) a1
+       else false
+     | _ -> false)
+  | Form.For a1 ->
+    (match b with
+     | Form.For a2 ->
+       if eqb0 (length a1) (length a2)
+       then forallbi (fun i l ->
+              check_lit t_form t_atom check_var l (get a2 i)) a1
+       else false
+     | _ -> false)
+  | Form.Fimp a1 ->
+    (match b with
+     | Form.Fimp a2 ->
+       if eqb0 (length a1) (length a2)
+       then forallbi (fun i l ->
+              check_lit t_form t_atom check_var l (get a2 i)) a1
+       else false
+     | _ -> false)
+  | Form.Fxor (l1, l2) ->
+    (match b with
+     | Form.Fxor (j1, j2) ->
+       if check_lit t_form t_atom check_var l1 j1
+       then check_lit t_form t_atom check_var l2 j2
+       else false
+     | _ -> false)
+  | Form.Fiff (l1, l2) ->
+    (match b with
+     | Form.Fiff (j1, j2) ->
+       if check_lit t_form t_atom check_var l1 j1
+       then check_lit t_form t_atom check_var l2 j2
+       else false
+     | _ -> false)
+  | Form.Fite (l1, l2, l3) ->
+    (match b with
+     | Form.Fite (j1, j2, j3) ->
+       if if check_lit t_form t_atom check_var l1 j1
+          then check_lit t_form t_atom check_var l2 j2
+          else false
+       then check_lit t_form t_atom check_var l3 j3
+       else false
+     | _ -> false)
+
+(** val check_hform :
+    Form.form array -> Atom.atom array -> int -> int -> bool **)
+
+let check_hform t_form t_atom h1 h2 =
+  foldi_down_cont (fun x cont h3 h4 ->
+    if eqb0 h3 h4
+    then true
+    else check_form_aux t_form t_atom cont (get t_form h3) (get t_form h4))
+    (length t_form) (ExtrNative.of_uint(0)) (fun h3 h4 -> false) h1 h2
+
+(** val check_lit' :
+    Form.form array -> Atom.atom array -> int -> int -> bool **)
+
+let check_lit' t_form t_atom =
+  check_lit t_form t_atom (check_hform t_form t_atom)
+
+(** val check_distinct_elim :
+    Form.form array -> Atom.atom array -> int list -> int -> int list **)
+
+let rec check_distinct_elim t_form t_atom input res =
+  match input with
+  | Nil -> Nil
+  | Cons (l, q) ->
+    if check_lit' t_form t_atom l res
+    then Cons (res, q)
+    else Cons (l, (check_distinct_elim t_form t_atom q res))
+
+type 'step _trace_ = 'step array array
+
+(** val _checker_ :
+    (S.t -> 'a1 -> S.t) -> (C.t -> bool) -> S.t -> 'a1 _trace_ -> int -> bool **)
+
+let _checker_ check_step is_false0 s t0 confl =
+  let s' = fold_left (fun s0 a -> fold_left check_step s0 a) s t0 in
+  is_false0 (S.get s' confl)
+
+module Euf_Checker = 
+ struct 
+  type step =
+  | Res of int * int array
+  | ImmFlatten of int * int * int
+  | CTrue of int
+  | CFalse of int
+  | BuildDef of int * int
+  | BuildDef2 of int * int
+  | BuildProj of int * int * int
+  | ImmBuildDef of int * int
+  | ImmBuildDef2 of int * int
+  | ImmBuildProj of int * int * int
+  | EqTr of int * int * int list
+  | EqCgr of int * int * int option list
+  | EqCgrP of int * int * int * int option list
+  | LiaMicromega of int * int list * zArithProof list
+  | LiaDiseq of int * int
+  | SplArith of int * int * int * zArithProof list
+  | SplDistinctElim of int * int * int
+  
+  (** val step_rect :
+      (int -> int array -> 'a1) -> (int -> int -> int -> 'a1) -> (int -> 'a1)
+      -> (int -> 'a1) -> (int -> int -> 'a1) -> (int -> int -> 'a1) -> (int
+      -> int -> int -> 'a1) -> (int -> int -> 'a1) -> (int -> int -> 'a1) ->
+      (int -> int -> int -> 'a1) -> (int -> int -> int list -> 'a1) -> (int
+      -> int -> int option list -> 'a1) -> (int -> int -> int -> int option
+      list -> 'a1) -> (int -> int list -> zArithProof list -> 'a1) -> (int ->
+      int -> 'a1) -> (int -> int -> int -> zArithProof list -> 'a1) -> (int
+      -> int -> int -> 'a1) -> step -> 'a1 **)
+  
+  let step_rect f f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 = function
+  | Res (x, x0) -> f x x0
+  | ImmFlatten (x, x0, x1) -> f0 x x0 x1
+  | CTrue x -> f1 x
+  | CFalse x -> f2 x
+  | BuildDef (x, x0) -> f3 x x0
+  | BuildDef2 (x, x0) -> f4 x x0
+  | BuildProj (x, x0, x1) -> f5 x x0 x1
+  | ImmBuildDef (x, x0) -> f6 x x0
+  | ImmBuildDef2 (x, x0) -> f7 x x0
+  | ImmBuildProj (x, x0, x1) -> f8 x x0 x1
+  | EqTr (x, x0, x1) -> f9 x x0 x1
+  | EqCgr (x, x0, x1) -> f10 x x0 x1
+  | EqCgrP (x, x0, x1, x2) -> f11 x x0 x1 x2
+  | LiaMicromega (x, x0, x1) -> f12 x x0 x1
+  | LiaDiseq (x, x0) -> f13 x x0
+  | SplArith (x, x0, x1, x2) -> f14 x x0 x1 x2
+  | SplDistinctElim (x, x0, x1) -> f15 x x0 x1
+  
+  (** val step_rec :
+      (int -> int array -> 'a1) -> (int -> int -> int -> 'a1) -> (int -> 'a1)
+      -> (int -> 'a1) -> (int -> int -> 'a1) -> (int -> int -> 'a1) -> (int
+      -> int -> int -> 'a1) -> (int -> int -> 'a1) -> (int -> int -> 'a1) ->
+      (int -> int -> int -> 'a1) -> (int -> int -> int list -> 'a1) -> (int
+      -> int -> int option list -> 'a1) -> (int -> int -> int -> int option
+      list -> 'a1) -> (int -> int list -> zArithProof list -> 'a1) -> (int ->
+      int -> 'a1) -> (int -> int -> int -> zArithProof list -> 'a1) -> (int
+      -> int -> int -> 'a1) -> step -> 'a1 **)
+  
+  let step_rec f f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 = function
+  | Res (x, x0) -> f x x0
+  | ImmFlatten (x, x0, x1) -> f0 x x0 x1
+  | CTrue x -> f1 x
+  | CFalse x -> f2 x
+  | BuildDef (x, x0) -> f3 x x0
+  | BuildDef2 (x, x0) -> f4 x x0
+  | BuildProj (x, x0, x1) -> f5 x x0 x1
+  | ImmBuildDef (x, x0) -> f6 x x0
+  | ImmBuildDef2 (x, x0) -> f7 x x0
+  | ImmBuildProj (x, x0, x1) -> f8 x x0 x1
+  | EqTr (x, x0, x1) -> f9 x x0 x1
+  | EqCgr (x, x0, x1) -> f10 x x0 x1
+  | EqCgrP (x, x0, x1, x2) -> f11 x x0 x1 x2
+  | LiaMicromega (x, x0, x1) -> f12 x x0 x1
+  | LiaDiseq (x, x0) -> f13 x x0
+  | SplArith (x, x0, x1, x2) -> f14 x x0 x1 x2
+  | SplDistinctElim (x, x0, x1) -> f15 x x0 x1
+  
+  (** val step_checker :
+      Atom.atom array -> Form.form array -> S.t -> step -> S.t **)
+  
+  let step_checker t_atom t_form s = function
+  | Res (pos, res) -> S.set_resolve s pos res
+  | ImmFlatten (pos, cid, lf) ->
+    S.set_clause s pos
+      (check_flatten t_form (check_hatom t_atom) (check_neg_hatom t_atom) s
+        cid lf)
+  | CTrue pos -> S.set_clause s pos check_True
+  | CFalse pos -> S.set_clause s pos check_False
+  | BuildDef (pos, l) -> S.set_clause s pos (check_BuildDef t_form l)
+  | BuildDef2 (pos, l) -> S.set_clause s pos (check_BuildDef2 t_form l)
+  | BuildProj (pos, l, i) -> S.set_clause s pos (check_BuildProj t_form l i)
+  | ImmBuildDef (pos, cid) ->
+    S.set_clause s pos (check_ImmBuildDef t_form s cid)
+  | ImmBuildDef2 (pos, cid) ->
+    S.set_clause s pos (check_ImmBuildDef2 t_form s cid)
+  | ImmBuildProj (pos, cid, i) ->
+    S.set_clause s pos (check_ImmBuildProj t_form s cid i)
+  | EqTr (pos, l, fl) -> S.set_clause s pos (check_trans t_form t_atom l fl)
+  | EqCgr (pos, l, fl) -> S.set_clause s pos (check_congr t_form t_atom l fl)
+  | EqCgrP (pos, l1, l2, fl) ->
+    S.set_clause s pos (check_congr_pred t_form t_atom l1 l2 fl)
+  | LiaMicromega (pos, cl, c) ->
+    S.set_clause s pos (check_micromega t_form t_atom cl c)
+  | LiaDiseq (pos, l) -> S.set_clause s pos (check_diseq t_form t_atom l)
+  | SplArith (pos, orig, res, l) ->
+    S.set_clause s pos (check_spl_arith t_form t_atom (S.get s orig) res l)
+  | SplDistinctElim (pos, orig, res) ->
+    S.set_clause s pos (check_distinct_elim t_form t_atom (S.get s orig) res)
+  
+  (** val euf_checker :
+      Atom.atom array -> Form.form array -> (C.t -> bool) -> S.t -> step
+      _trace_ -> int -> bool **)
+  
+  let euf_checker t_atom t_form s t0 =
+    _checker_ (step_checker t_atom t_form) s t0
+  
+  type certif =
+  | Certif of int * step _trace_ * int
+  
+  (** val certif_rect :
+      (int -> step _trace_ -> int -> 'a1) -> certif -> 'a1 **)
+  
+  let certif_rect f = function
+  | Certif (x, x0, x1) -> f x x0 x1
+  
+  (** val certif_rec :
+      (int -> step _trace_ -> int -> 'a1) -> certif -> 'a1 **)
+  
+  let certif_rec f = function
+  | Certif (x, x0, x1) -> f x x0 x1
+  
+  (** val add_roots : S.t -> int array -> int array option -> S.t **)
+  
+  let add_roots s d = function
+  | Some ur ->
+    foldi_right (fun i c_index s0 ->
+      let c =
+        if ltb0 c_index (length d)
+        then Cons ((get d c_index), Nil)
+        else C._true
+      in
+      S.set_clause s0 i c) ur s
+  | None -> foldi_right (fun i c s0 -> S.set_clause s0 i (Cons (c, Nil))) d s
+  
+  (** val valid :
+      typ_eqb array -> Atom.tval array -> Atom.atom array -> Form.form array
+      -> int array -> bool **)
+  
+  let valid t_i t_func t_atom t_form d =
+    let rho =
+      Form.interp_state_var (Atom.interp_form_hatom t_i t_func t_atom) t_form
+    in
+    afold_left true (fun b1 b2 -> if b1 then b2 else false) (Lit.interp rho)
+      d
+  
+  (** val checker :
+      typ_eqb array -> Atom.tval array -> Atom.atom array -> Form.form array
+      -> int array -> int array option -> certif -> bool **)
+  
+  let checker t_i t_func t_atom t_form d used_roots = function
+  | Certif (nclauses, t0, confl) ->
+    if if if Form.check_form t_form then Atom.check_atom t_atom else false
+       then Atom.wt t_i t_func t_atom
+       else false
+    then euf_checker t_atom t_form C.is_false
+           (add_roots (S.make nclauses) d used_roots) t0 confl
+    else false
+  
+  (** val checker_b :
+      typ_eqb array -> Atom.tval array -> Atom.atom array -> Form.form array
+      -> int -> bool -> certif -> bool **)
+  
+  let checker_b t_i t_func t_atom t_form l b c =
+    let l0 = if b then Lit.neg l else l in
+    let Certif (nclauses, x, x0) = c in
+    checker t_i t_func t_atom t_form (make nclauses l0) None c
+  
+  (** val checker_eq :
+      typ_eqb array -> Atom.tval array -> Atom.atom array -> Form.form array
+      -> int -> int -> int -> certif -> bool **)
+  
+  let checker_eq t_i t_func t_atom t_form l1 l2 l c =
+    if if negb (Lit.is_pos l)
+       then (match get t_form (Lit.blit l) with
+             | Form.Fiff (l1', l2') ->
+               if eqb0 l1 l1' then eqb0 l2 l2' else false
+             | _ -> false)
+       else false
+    then let Certif (nclauses, x, x0) = c in
+         checker t_i t_func t_atom t_form (make nclauses l) None c
+    else false
+  
+  (** val checker_ext :
+      Atom.atom array -> Form.form array -> int array -> int array option ->
+      certif -> bool **)
+  
+  let checker_ext t_atom t_form d used_roots = function
+  | Certif (nclauses, t0, confl) ->
+    if if Form.check_form t_form then Atom.check_atom t_atom else false
+    then euf_checker t_atom t_form C.is_false
+           (add_roots (S.make nclauses) d used_roots) t0 confl
+    else false
+ end
+
diff --git a/src/extraction/smt_checker.mli b/src/extraction/smt_checker.mli
new file mode 100644
index 0000000..502d6f3
--- /dev/null
+++ b/src/extraction/smt_checker.mli
@@ -0,0 +1,1889 @@
+type __ = Obj.t
+
+type unit0 =
+| Tt
+
+val implb : bool -> bool -> bool
+
+val xorb : bool -> bool -> bool
+
+val negb : bool -> bool
+
+type nat =
+| O
+| S of nat
+
+type 'a option =
+| Some of 'a
+| None
+
+val option_map : ('a1 -> 'a2) -> 'a1 option -> 'a2 option
+
+val fst : ('a1*'a2) -> 'a1
+
+val snd : ('a1*'a2) -> 'a2
+
+type 'a list =
+| Nil
+| Cons of 'a * 'a list
+
+val app : 'a1 list -> 'a1 list -> 'a1 list
+
+val compOpp : ExtrNative.comparison -> ExtrNative.comparison
+
+type compareSpecT =
+| CompEqT
+| CompLtT
+| CompGtT
+
+val compareSpec2Type : ExtrNative.comparison -> compareSpecT
+
+type 'a compSpecT = compareSpecT
+
+val compSpec2Type : 'a1 -> 'a1 -> ExtrNative.comparison -> 'a1 compSpecT
+
+type 'a sig0 =
+  'a
+  (* singleton inductive, whose constructor was exist *)
+
+type sumbool =
+| Left
+| Right
+
+type 'a sumor =
+| Inleft of 'a
+| Inright
+
+val plus : nat -> nat -> nat
+
+val nat_iter : nat -> ('a1 -> 'a1) -> 'a1 -> 'a1
+
+type positive =
+| XI of positive
+| XO of positive
+| XH
+
+type n =
+| N0
+| Npos of positive
+
+type z =
+| Z0
+| Zpos of positive
+| Zneg of positive
+
+val eqb : bool -> bool -> bool
+
+type reflect =
+| ReflectT
+| ReflectF
+
+val iff_reflect : bool -> reflect
+
+module type TotalOrder' = 
+ sig 
+  type t 
+ end
+
+module MakeOrderTac : 
+ functor (O:TotalOrder') ->
+ sig 
+  
+ end
+
+module MaxLogicalProperties : 
+ functor (O:TotalOrder') ->
+ functor (M:sig 
+  val max : O.t -> O.t -> O.t
+ end) ->
+ sig 
+  module Private_Tac : 
+   sig 
+    
+   end
+ end
+
+module Pos : 
+ sig 
+  type t = positive
+  
+  val succ : positive -> positive
+  
+  val add : positive -> positive -> positive
+  
+  val add_carry : positive -> positive -> positive
+  
+  val pred_double : positive -> positive
+  
+  val pred : positive -> positive
+  
+  val pred_N : positive -> n
+  
+  type mask =
+  | IsNul
+  | IsPos of positive
+  | IsNeg
+  
+  val mask_rect : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1
+  
+  val mask_rec : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1
+  
+  val succ_double_mask : mask -> mask
+  
+  val double_mask : mask -> mask
+  
+  val double_pred_mask : positive -> mask
+  
+  val pred_mask : mask -> mask
+  
+  val sub_mask : positive -> positive -> mask
+  
+  val sub_mask_carry : positive -> positive -> mask
+  
+  val sub : positive -> positive -> positive
+  
+  val mul : positive -> positive -> positive
+  
+  val iter : positive -> ('a1 -> 'a1) -> 'a1 -> 'a1
+  
+  val pow : positive -> positive -> positive
+  
+  val square : positive -> positive
+  
+  val div2 : positive -> positive
+  
+  val div2_up : positive -> positive
+  
+  val size_nat : positive -> nat
+  
+  val size : positive -> positive
+  
+  val compare_cont :
+    positive -> positive -> ExtrNative.comparison -> ExtrNative.comparison
+  
+  val compare : positive -> positive -> ExtrNative.comparison
+  
+  val min : positive -> positive -> positive
+  
+  val max : positive -> positive -> positive
+  
+  val eqb : positive -> positive -> bool
+  
+  val leb : positive -> positive -> bool
+  
+  val ltb : positive -> positive -> bool
+  
+  val sqrtrem_step :
+    (positive -> positive) -> (positive -> positive) -> (positive*mask) ->
+    positive*mask
+  
+  val sqrtrem : positive -> positive*mask
+  
+  val sqrt : positive -> positive
+  
+  val gcdn : nat -> positive -> positive -> positive
+  
+  val gcd : positive -> positive -> positive
+  
+  val ggcdn : nat -> positive -> positive -> positive*(positive*positive)
+  
+  val ggcd : positive -> positive -> positive*(positive*positive)
+  
+  val coq_Nsucc_double : n -> n
+  
+  val coq_Ndouble : n -> n
+  
+  val coq_lor : positive -> positive -> positive
+  
+  val coq_land : positive -> positive -> n
+  
+  val ldiff : positive -> positive -> n
+  
+  val coq_lxor : positive -> positive -> n
+  
+  val shiftl_nat : positive -> nat -> positive
+  
+  val shiftr_nat : positive -> nat -> positive
+  
+  val shiftl : positive -> n -> positive
+  
+  val shiftr : positive -> n -> positive
+  
+  val testbit_nat : positive -> nat -> bool
+  
+  val testbit : positive -> n -> bool
+  
+  val iter_op : ('a1 -> 'a1 -> 'a1) -> positive -> 'a1 -> 'a1
+  
+  val to_nat : positive -> nat
+  
+  val of_nat : nat -> positive
+  
+  val of_succ_nat : nat -> positive
+ end
+
+module Coq_Pos : 
+ sig 
+  module Coq__1 : sig 
+   type t = positive
+  end
+  type t = Coq__1.t
+  
+  val succ : positive -> positive
+  
+  val add : positive -> positive -> positive
+  
+  val add_carry : positive -> positive -> positive
+  
+  val pred_double : positive -> positive
+  
+  val pred : positive -> positive
+  
+  val pred_N : positive -> n
+  
+  type mask = Pos.mask =
+  | IsNul
+  | IsPos of positive
+  | IsNeg
+  
+  val mask_rect : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1
+  
+  val mask_rec : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1
+  
+  val succ_double_mask : mask -> mask
+  
+  val double_mask : mask -> mask
+  
+  val double_pred_mask : positive -> mask
+  
+  val pred_mask : mask -> mask
+  
+  val sub_mask : positive -> positive -> mask
+  
+  val sub_mask_carry : positive -> positive -> mask
+  
+  val sub : positive -> positive -> positive
+  
+  val mul : positive -> positive -> positive
+  
+  val iter : positive -> ('a1 -> 'a1) -> 'a1 -> 'a1
+  
+  val pow : positive -> positive -> positive
+  
+  val square : positive -> positive
+  
+  val div2 : positive -> positive
+  
+  val div2_up : positive -> positive
+  
+  val size_nat : positive -> nat
+  
+  val size : positive -> positive
+  
+  val compare_cont :
+    positive -> positive -> ExtrNative.comparison -> ExtrNative.comparison
+  
+  val compare : positive -> positive -> ExtrNative.comparison
+  
+  val min : positive -> positive -> positive
+  
+  val max : positive -> positive -> positive
+  
+  val eqb : positive -> positive -> bool
+  
+  val leb : positive -> positive -> bool
+  
+  val ltb : positive -> positive -> bool
+  
+  val sqrtrem_step :
+    (positive -> positive) -> (positive -> positive) -> (positive*mask) ->
+    positive*mask
+  
+  val sqrtrem : positive -> positive*mask
+  
+  val sqrt : positive -> positive
+  
+  val gcdn : nat -> positive -> positive -> positive
+  
+  val gcd : positive -> positive -> positive
+  
+  val ggcdn : nat -> positive -> positive -> positive*(positive*positive)
+  
+  val ggcd : positive -> positive -> positive*(positive*positive)
+  
+  val coq_Nsucc_double : n -> n
+  
+  val coq_Ndouble : n -> n
+  
+  val coq_lor : positive -> positive -> positive
+  
+  val coq_land : positive -> positive -> n
+  
+  val ldiff : positive -> positive -> n
+  
+  val coq_lxor : positive -> positive -> n
+  
+  val shiftl_nat : positive -> nat -> positive
+  
+  val shiftr_nat : positive -> nat -> positive
+  
+  val shiftl : positive -> n -> positive
+  
+  val shiftr : positive -> n -> positive
+  
+  val testbit_nat : positive -> nat -> bool
+  
+  val testbit : positive -> n -> bool
+  
+  val iter_op : ('a1 -> 'a1 -> 'a1) -> positive -> 'a1 -> 'a1
+  
+  val to_nat : positive -> nat
+  
+  val of_nat : nat -> positive
+  
+  val of_succ_nat : nat -> positive
+  
+  val eq_dec : positive -> positive -> sumbool
+  
+  val peano_rect : 'a1 -> (positive -> 'a1 -> 'a1) -> positive -> 'a1
+  
+  val peano_rec : 'a1 -> (positive -> 'a1 -> 'a1) -> positive -> 'a1
+  
+  type coq_PeanoView =
+  | PeanoOne
+  | PeanoSucc of positive * coq_PeanoView
+  
+  val coq_PeanoView_rect :
+    'a1 -> (positive -> coq_PeanoView -> 'a1 -> 'a1) -> positive ->
+    coq_PeanoView -> 'a1
+  
+  val coq_PeanoView_rec :
+    'a1 -> (positive -> coq_PeanoView -> 'a1 -> 'a1) -> positive ->
+    coq_PeanoView -> 'a1
+  
+  val peanoView_xO : positive -> coq_PeanoView -> coq_PeanoView
+  
+  val peanoView_xI : positive -> coq_PeanoView -> coq_PeanoView
+  
+  val peanoView : positive -> coq_PeanoView
+  
+  val coq_PeanoView_iter :
+    'a1 -> (positive -> 'a1 -> 'a1) -> positive -> coq_PeanoView -> 'a1
+  
+  val eqb_spec : positive -> positive -> reflect
+  
+  val switch_Eq :
+    ExtrNative.comparison -> ExtrNative.comparison -> ExtrNative.comparison
+  
+  val mask2cmp : mask -> ExtrNative.comparison
+  
+  val leb_spec0 : positive -> positive -> reflect
+  
+  val ltb_spec0 : positive -> positive -> reflect
+  
+  module Private_Tac : 
+   sig 
+    
+   end
+  
+  module Private_Rev : 
+   sig 
+    module ORev : 
+     sig 
+      type t = Coq__1.t
+     end
+    
+    module MRev : 
+     sig 
+      val max : t -> t -> t
+     end
+    
+    module MPRev : 
+     sig 
+      module Private_Tac : 
+       sig 
+        
+       end
+     end
+   end
+  
+  module Private_Dec : 
+   sig 
+    val max_case_strong :
+      t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) ->
+      'a1
+    
+    val max_case :
+      t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1
+    
+    val max_dec : t -> t -> sumbool
+    
+    val min_case_strong :
+      t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) ->
+      'a1
+    
+    val min_case :
+      t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1
+    
+    val min_dec : t -> t -> sumbool
+   end
+  
+  val max_case_strong : t -> t -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1
+  
+  val max_case : t -> t -> 'a1 -> 'a1 -> 'a1
+  
+  val max_dec : t -> t -> sumbool
+  
+  val min_case_strong : t -> t -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1
+  
+  val min_case : t -> t -> 'a1 -> 'a1 -> 'a1
+  
+  val min_dec : t -> t -> sumbool
+ end
+
+module N : 
+ sig 
+  type t = n
+  
+  val zero : n
+  
+  val one : n
+  
+  val two : n
+  
+  val succ_double : n -> n
+  
+  val double : n -> n
+  
+  val succ : n -> n
+  
+  val pred : n -> n
+  
+  val succ_pos : n -> positive
+  
+  val add : n -> n -> n
+  
+  val sub : n -> n -> n
+  
+  val mul : n -> n -> n
+  
+  val compare : n -> n -> ExtrNative.comparison
+  
+  val eqb : n -> n -> bool
+  
+  val leb : n -> n -> bool
+  
+  val ltb : n -> n -> bool
+  
+  val min : n -> n -> n
+  
+  val max : n -> n -> n
+  
+  val div2 : n -> n
+  
+  val even : n -> bool
+  
+  val odd : n -> bool
+  
+  val pow : n -> n -> n
+  
+  val square : n -> n
+  
+  val log2 : n -> n
+  
+  val size : n -> n
+  
+  val size_nat : n -> nat
+  
+  val pos_div_eucl : positive -> n -> n*n
+  
+  val div_eucl : n -> n -> n*n
+  
+  val div : n -> n -> n
+  
+  val modulo : n -> n -> n
+  
+  val gcd : n -> n -> n
+  
+  val ggcd : n -> n -> n*(n*n)
+  
+  val sqrtrem : n -> n*n
+  
+  val sqrt : n -> n
+  
+  val coq_lor : n -> n -> n
+  
+  val coq_land : n -> n -> n
+  
+  val ldiff : n -> n -> n
+  
+  val coq_lxor : n -> n -> n
+  
+  val shiftl_nat : n -> nat -> n
+  
+  val shiftr_nat : n -> nat -> n
+  
+  val shiftl : n -> n -> n
+  
+  val shiftr : n -> n -> n
+  
+  val testbit_nat : n -> nat -> bool
+  
+  val testbit : n -> n -> bool
+  
+  val to_nat : n -> nat
+  
+  val of_nat : nat -> n
+  
+  val iter : n -> ('a1 -> 'a1) -> 'a1 -> 'a1
+  
+  val eq_dec : n -> n -> sumbool
+  
+  val discr : n -> positive sumor
+  
+  val binary_rect : 'a1 -> (n -> 'a1 -> 'a1) -> (n -> 'a1 -> 'a1) -> n -> 'a1
+  
+  val binary_rec : 'a1 -> (n -> 'a1 -> 'a1) -> (n -> 'a1 -> 'a1) -> n -> 'a1
+  
+  val peano_rect : 'a1 -> (n -> 'a1 -> 'a1) -> n -> 'a1
+  
+  val peano_rec : 'a1 -> (n -> 'a1 -> 'a1) -> n -> 'a1
+  
+  val leb_spec0 : n -> n -> reflect
+  
+  val ltb_spec0 : n -> n -> reflect
+  
+  module Private_BootStrap : 
+   sig 
+    
+   end
+  
+  val recursion : 'a1 -> (n -> 'a1 -> 'a1) -> n -> 'a1
+  
+  module Private_OrderTac : 
+   sig 
+    module Elts : 
+     sig 
+      type t = n
+     end
+    
+    module Tac : 
+     sig 
+      
+     end
+   end
+  
+  module Private_NZPow : 
+   sig 
+    
+   end
+  
+  module Private_NZSqrt : 
+   sig 
+    
+   end
+  
+  val sqrt_up : n -> n
+  
+  val log2_up : n -> n
+  
+  module Private_NZDiv : 
+   sig 
+    
+   end
+  
+  val lcm : n -> n -> n
+  
+  val eqb_spec : n -> n -> reflect
+  
+  val b2n : bool -> n
+  
+  val setbit : n -> n -> n
+  
+  val clearbit : n -> n -> n
+  
+  val ones : n -> n
+  
+  val lnot : n -> n -> n
+  
+  module Private_Tac : 
+   sig 
+    
+   end
+  
+  module Private_Rev : 
+   sig 
+    module ORev : 
+     sig 
+      type t = n
+     end
+    
+    module MRev : 
+     sig 
+      val max : n -> n -> n
+     end
+    
+    module MPRev : 
+     sig 
+      module Private_Tac : 
+       sig 
+        
+       end
+     end
+   end
+  
+  module Private_Dec : 
+   sig 
+    val max_case_strong :
+      n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) ->
+      'a1
+    
+    val max_case :
+      n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1
+    
+    val max_dec : n -> n -> sumbool
+    
+    val min_case_strong :
+      n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) ->
+      'a1
+    
+    val min_case :
+      n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1
+    
+    val min_dec : n -> n -> sumbool
+   end
+  
+  val max_case_strong : n -> n -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1
+  
+  val max_case : n -> n -> 'a1 -> 'a1 -> 'a1
+  
+  val max_dec : n -> n -> sumbool
+  
+  val min_case_strong : n -> n -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1
+  
+  val min_case : n -> n -> 'a1 -> 'a1 -> 'a1
+  
+  val min_dec : n -> n -> sumbool
+ end
+
+module Z : 
+ sig 
+  type t = z
+  
+  val zero : z
+  
+  val one : z
+  
+  val two : z
+  
+  val double : z -> z
+  
+  val succ_double : z -> z
+  
+  val pred_double : z -> z
+  
+  val pos_sub : positive -> positive -> z
+  
+  val add : z -> z -> z
+  
+  val opp : z -> z
+  
+  val succ : z -> z
+  
+  val pred : z -> z
+  
+  val sub : z -> z -> z
+  
+  val mul : z -> z -> z
+  
+  val pow_pos : z -> positive -> z
+  
+  val pow : z -> z -> z
+  
+  val square : z -> z
+  
+  val compare : z -> z -> ExtrNative.comparison
+  
+  val sgn : z -> z
+  
+  val leb : z -> z -> bool
+  
+  val ltb : z -> z -> bool
+  
+  val geb : z -> z -> bool
+  
+  val gtb : z -> z -> bool
+  
+  val eqb : z -> z -> bool
+  
+  val max : z -> z -> z
+  
+  val min : z -> z -> z
+  
+  val abs : z -> z
+  
+  val abs_nat : z -> nat
+  
+  val abs_N : z -> n
+  
+  val to_nat : z -> nat
+  
+  val to_N : z -> n
+  
+  val of_nat : nat -> z
+  
+  val of_N : n -> z
+  
+  val iter : z -> ('a1 -> 'a1) -> 'a1 -> 'a1
+  
+  val pos_div_eucl : positive -> z -> z*z
+  
+  val div_eucl : z -> z -> z*z
+  
+  val div : z -> z -> z
+  
+  val modulo : z -> z -> z
+  
+  val quotrem : z -> z -> z*z
+  
+  val quot : z -> z -> z
+  
+  val rem : z -> z -> z
+  
+  val even : z -> bool
+  
+  val odd : z -> bool
+  
+  val div2 : z -> z
+  
+  val quot2 : z -> z
+  
+  val log2 : z -> z
+  
+  val sqrtrem : z -> z*z
+  
+  val sqrt : z -> z
+  
+  val gcd : z -> z -> z
+  
+  val ggcd : z -> z -> z*(z*z)
+  
+  val testbit : z -> z -> bool
+  
+  val shiftl : z -> z -> z
+  
+  val shiftr : z -> z -> z
+  
+  val coq_lor : z -> z -> z
+  
+  val coq_land : z -> z -> z
+  
+  val ldiff : z -> z -> z
+  
+  val coq_lxor : z -> z -> z
+  
+  val eq_dec : z -> z -> sumbool
+  
+  module Private_BootStrap : 
+   sig 
+    
+   end
+  
+  val leb_spec0 : z -> z -> reflect
+  
+  val ltb_spec0 : z -> z -> reflect
+  
+  module Private_OrderTac : 
+   sig 
+    module Elts : 
+     sig 
+      type t = z
+     end
+    
+    module Tac : 
+     sig 
+      
+     end
+   end
+  
+  val sqrt_up : z -> z
+  
+  val log2_up : z -> z
+  
+  module Private_NZDiv : 
+   sig 
+    
+   end
+  
+  module Private_Div : 
+   sig 
+    module Quot2Div : 
+     sig 
+      val div : z -> z -> z
+      
+      val modulo : z -> z -> z
+     end
+    
+    module NZQuot : 
+     sig 
+      
+     end
+   end
+  
+  val lcm : z -> z -> z
+  
+  val eqb_spec : z -> z -> reflect
+  
+  val b2z : bool -> z
+  
+  val setbit : z -> z -> z
+  
+  val clearbit : z -> z -> z
+  
+  val lnot : z -> z
+  
+  val ones : z -> z
+  
+  module Private_Tac : 
+   sig 
+    
+   end
+  
+  module Private_Rev : 
+   sig 
+    module ORev : 
+     sig 
+      type t = z
+     end
+    
+    module MRev : 
+     sig 
+      val max : z -> z -> z
+     end
+    
+    module MPRev : 
+     sig 
+      module Private_Tac : 
+       sig 
+        
+       end
+     end
+   end
+  
+  module Private_Dec : 
+   sig 
+    val max_case_strong :
+      z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) ->
+      'a1
+    
+    val max_case :
+      z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1
+    
+    val max_dec : z -> z -> sumbool
+    
+    val min_case_strong :
+      z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) ->
+      'a1
+    
+    val min_case :
+      z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1
+    
+    val min_dec : z -> z -> sumbool
+   end
+  
+  val max_case_strong : z -> z -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1
+  
+  val max_case : z -> z -> 'a1 -> 'a1 -> 'a1
+  
+  val max_dec : z -> z -> sumbool
+  
+  val min_case_strong : z -> z -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1
+  
+  val min_case : z -> z -> 'a1 -> 'a1 -> 'a1
+  
+  val min_dec : z -> z -> sumbool
+ end
+
+val zeq_bool : z -> z -> bool
+
+val nth : nat -> 'a1 list -> 'a1 -> 'a1
+
+val map : ('a1 -> 'a2) -> 'a1 list -> 'a2 list
+
+val fold_right : ('a2 -> 'a1 -> 'a1) -> 'a1 -> 'a2 list -> 'a1
+
+val existsb : ('a1 -> bool) -> 'a1 list -> bool
+
+val forallb : ('a1 -> bool) -> 'a1 list -> bool
+
+type int = ExtrNative.uint
+
+val lsl0 : int -> int -> int
+
+val lsr0 : int -> int -> int
+
+val land0 : int -> int -> int
+
+val lxor0 : int -> int -> int
+
+val sub0 : int -> int -> int
+
+val eqb0 : int -> int -> bool
+
+val ltb0 : int -> int -> bool
+
+val leb0 : int -> int -> bool
+
+val foldi_cont :
+  (int -> ('a1 -> 'a2) -> 'a1 -> 'a2) -> int -> int -> ('a1 -> 'a2) -> 'a1 ->
+  'a2
+
+val foldi_down_cont :
+  (int -> ('a1 -> 'a2) -> 'a1 -> 'a2) -> int -> int -> ('a1 -> 'a2) -> 'a1 ->
+  'a2
+
+val is_zero : int -> bool
+
+val is_even : int -> bool
+
+val compare0 : int -> int -> ExtrNative.comparison
+
+val foldi : (int -> 'a1 -> 'a1) -> int -> int -> 'a1 -> 'a1
+
+val fold : ('a1 -> 'a1) -> int -> int -> 'a1 -> 'a1
+
+val foldi_down : (int -> 'a1 -> 'a1) -> int -> int -> 'a1 -> 'a1
+
+val forallb0 : (int -> bool) -> int -> int -> bool
+
+val existsb0 : (int -> bool) -> int -> int -> bool
+
+val cast : int -> int -> (__ -> __ -> __) option
+
+val reflect_eqb : int -> int -> reflect
+
+type 'a array = 'a ExtrNative.parray
+
+val make : int -> 'a1 -> 'a1 array
+
+val get : 'a1 array -> int -> 'a1
+
+val default : 'a1 array -> 'a1
+
+val set : 'a1 array -> int -> 'a1 -> 'a1 array
+
+val length : 'a1 array -> int
+
+val to_list : 'a1 array -> 'a1 list
+
+val forallbi : (int -> 'a1 -> bool) -> 'a1 array -> bool
+
+val forallb1 : ('a1 -> bool) -> 'a1 array -> bool
+
+val existsb1 : ('a1 -> bool) -> 'a1 array -> bool
+
+val mapi : (int -> 'a1 -> 'a2) -> 'a1 array -> 'a2 array
+
+val foldi_left : (int -> 'a1 -> 'a2 -> 'a1) -> 'a1 -> 'a2 array -> 'a1
+
+val fold_left : ('a1 -> 'a2 -> 'a1) -> 'a1 -> 'a2 array -> 'a1
+
+val foldi_right : (int -> 'a1 -> 'a2 -> 'a2) -> 'a1 array -> 'a2 -> 'a2
+
+module Valuation : 
+ sig 
+  type t = int -> bool
+ end
+
+module Var : 
+ sig 
+  val _true : int
+  
+  val _false : int
+  
+  val interp : Valuation.t -> int -> bool
+ end
+
+module Lit : 
+ sig 
+  val is_pos : int -> bool
+  
+  val blit : int -> int
+  
+  val lit : int -> int
+  
+  val neg : int -> int
+  
+  val nlit : int -> int
+  
+  val _true : int
+  
+  val _false : int
+  
+  val eqb : int -> int -> bool
+  
+  val interp : Valuation.t -> int -> bool
+ end
+
+module C : 
+ sig 
+  type t = int list
+  
+  val interp : Valuation.t -> t -> bool
+  
+  val _true : t
+  
+  val is_false : t -> bool
+  
+  val or_aux : (t -> t -> t) -> int -> t -> t -> int list
+  
+  val coq_or : t -> t -> t
+  
+  val resolve_aux : (t -> t -> t) -> int -> t -> t -> t
+  
+  val resolve : t -> t -> t
+ end
+
+module S : 
+ sig 
+  type t = C.t array
+  
+  val get : t -> int -> C.t
+  
+  val internal_set : t -> int -> C.t -> t
+  
+  val make : int -> t
+  
+  val insert : int -> int list -> int list
+  
+  val sort_uniq : int list -> int list
+  
+  val set_clause : t -> int -> C.t -> t
+  
+  val set_resolve : t -> int -> int array -> t
+ end
+
+val afold_left :
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a2 -> 'a1) -> 'a2 array -> 'a1
+
+val afold_right :
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a2 -> 'a1) -> 'a2 array -> 'a1
+
+val rev_aux : 'a1 list -> 'a1 list -> 'a1 list
+
+val rev : 'a1 list -> 'a1 list
+
+val distinct_aux2 : ('a1 -> 'a1 -> bool) -> bool -> 'a1 -> 'a1 list -> bool
+
+val distinct_aux : ('a1 -> 'a1 -> bool) -> bool -> 'a1 list -> bool
+
+val distinct : ('a1 -> 'a1 -> bool) -> 'a1 list -> bool
+
+val forallb2 : ('a1 -> 'a2 -> bool) -> 'a1 list -> 'a2 list -> bool
+
+module Form : 
+ sig 
+  type form =
+  | Fatom of int
+  | Ftrue
+  | Ffalse
+  | Fnot2 of int * int
+  | Fand of int array
+  | For of int array
+  | Fimp of int array
+  | Fxor of int * int
+  | Fiff of int * int
+  | Fite of int * int * int
+  
+  val form_rect :
+    (int -> 'a1) -> 'a1 -> 'a1 -> (int -> int -> 'a1) -> (int array -> 'a1)
+    -> (int array -> 'a1) -> (int array -> 'a1) -> (int -> int -> 'a1) ->
+    (int -> int -> 'a1) -> (int -> int -> int -> 'a1) -> form -> 'a1
+  
+  val form_rec :
+    (int -> 'a1) -> 'a1 -> 'a1 -> (int -> int -> 'a1) -> (int array -> 'a1)
+    -> (int array -> 'a1) -> (int array -> 'a1) -> (int -> int -> 'a1) ->
+    (int -> int -> 'a1) -> (int -> int -> int -> 'a1) -> form -> 'a1
+  
+  val is_Ftrue : form -> bool
+  
+  val is_Ffalse : form -> bool
+  
+  val interp_aux : (int -> bool) -> (int -> bool) -> form -> bool
+  
+  val t_interp : (int -> bool) -> form array -> bool array
+  
+  val lt_form : int -> form -> bool
+  
+  val wf : form array -> bool
+  
+  val interp_state_var : (int -> bool) -> form array -> int -> bool
+  
+  val interp : (int -> bool) -> form array -> form -> bool
+  
+  val check_form : form array -> bool
+ end
+
+type typ_eqb = { te_eqb : (__ -> __ -> bool);
+                 te_reflect : (__ -> __ -> reflect) }
+
+type te_carrier = __
+
+val te_eqb : typ_eqb -> te_carrier -> te_carrier -> bool
+
+module Typ : 
+ sig 
+  type coq_type =
+  | Tindex of int
+  | TZ
+  | Tbool
+  | Tpositive
+  
+  val type_rect : (int -> 'a1) -> 'a1 -> 'a1 -> 'a1 -> coq_type -> 'a1
+  
+  val type_rec : (int -> 'a1) -> 'a1 -> 'a1 -> 'a1 -> coq_type -> 'a1
+  
+  type ftype = coq_type list*coq_type
+  
+  type interp = __
+  
+  type interp_ftype = __
+  
+  val i_eqb : typ_eqb array -> coq_type -> interp -> interp -> bool
+  
+  val reflect_i_eqb :
+    typ_eqb array -> coq_type -> interp -> interp -> reflect
+  
+  type cast_result =
+  | Cast of (__ -> __ -> __)
+  | NoCast
+  
+  val cast_result_rect :
+    coq_type -> coq_type -> ((__ -> __ -> __) -> 'a1) -> 'a1 -> cast_result
+    -> 'a1
+  
+  val cast_result_rec :
+    coq_type -> coq_type -> ((__ -> __ -> __) -> 'a1) -> 'a1 -> cast_result
+    -> 'a1
+  
+  val cast : coq_type -> coq_type -> cast_result
+  
+  val eqb : coq_type -> coq_type -> bool
+  
+  val reflect_eqb : coq_type -> coq_type -> reflect
+ end
+
+val list_beq : ('a1 -> 'a1 -> bool) -> 'a1 list -> 'a1 list -> bool
+
+val reflect_list_beq :
+  ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> reflect) -> 'a1 list -> 'a1 list ->
+  reflect
+
+module Atom : 
+ sig 
+  type cop =
+  | CO_xH
+  | CO_Z0
+  
+  val cop_rect : 'a1 -> 'a1 -> cop -> 'a1
+  
+  val cop_rec : 'a1 -> 'a1 -> cop -> 'a1
+  
+  type unop =
+  | UO_xO
+  | UO_xI
+  | UO_Zpos
+  | UO_Zneg
+  | UO_Zopp
+  
+  val unop_rect : 'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> unop -> 'a1
+  
+  val unop_rec : 'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> unop -> 'a1
+  
+  type binop =
+  | BO_Zplus
+  | BO_Zminus
+  | BO_Zmult
+  | BO_Zlt
+  | BO_Zle
+  | BO_Zge
+  | BO_Zgt
+  | BO_eq of Typ.coq_type
+  
+  val binop_rect :
+    'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> (Typ.coq_type -> 'a1) ->
+    binop -> 'a1
+  
+  val binop_rec :
+    'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> 'a1 -> (Typ.coq_type -> 'a1) ->
+    binop -> 'a1
+  
+  type nop =
+    Typ.coq_type
+    (* singleton inductive, whose constructor was NO_distinct *)
+  
+  val nop_rect : (Typ.coq_type -> 'a1) -> nop -> 'a1
+  
+  val nop_rec : (Typ.coq_type -> 'a1) -> nop -> 'a1
+  
+  type atom =
+  | Acop of cop
+  | Auop of unop * int
+  | Abop of binop * int * int
+  | Anop of nop * int list
+  | Aapp of int * int list
+  
+  val atom_rect :
+    (cop -> 'a1) -> (unop -> int -> 'a1) -> (binop -> int -> int -> 'a1) ->
+    (nop -> int list -> 'a1) -> (int -> int list -> 'a1) -> atom -> 'a1
+  
+  val atom_rec :
+    (cop -> 'a1) -> (unop -> int -> 'a1) -> (binop -> int -> int -> 'a1) ->
+    (nop -> int list -> 'a1) -> (int -> int list -> 'a1) -> atom -> 'a1
+  
+  val cop_eqb : cop -> cop -> bool
+  
+  val uop_eqb : unop -> unop -> bool
+  
+  val bop_eqb : binop -> binop -> bool
+  
+  val nop_eqb : nop -> nop -> bool
+  
+  val eqb : atom -> atom -> bool
+  
+  val reflect_cop_eqb : cop -> cop -> reflect
+  
+  val reflect_uop_eqb : unop -> unop -> reflect
+  
+  val reflect_bop_eqb : binop -> binop -> reflect
+  
+  val reflect_nop_eqb : nop -> nop -> reflect
+  
+  val reflect_eqb : atom -> atom -> reflect
+  
+  type ('t, 'i) coq_val = { v_type : 't; v_val : 'i }
+  
+  val val_rect : ('a1 -> 'a2 -> 'a3) -> ('a1, 'a2) coq_val -> 'a3
+  
+  val val_rec : ('a1 -> 'a2 -> 'a3) -> ('a1, 'a2) coq_val -> 'a3
+  
+  val v_type : ('a1, 'a2) coq_val -> 'a1
+  
+  val v_val : ('a1, 'a2) coq_val -> 'a2
+  
+  type bval = (Typ.coq_type, Typ.interp) coq_val
+  
+  val coq_Bval :
+    typ_eqb array -> Typ.coq_type -> Typ.interp -> (Typ.coq_type, Typ.interp)
+    coq_val
+  
+  type tval = (Typ.ftype, Typ.interp_ftype) coq_val
+  
+  val coq_Tval :
+    typ_eqb array -> Typ.ftype -> Typ.interp_ftype -> (Typ.ftype,
+    Typ.interp_ftype) coq_val
+  
+  val bvtrue : typ_eqb array -> bval
+  
+  val bvfalse : typ_eqb array -> bval
+  
+  val typ_cop : cop -> Typ.coq_type
+  
+  val typ_uop : unop -> Typ.coq_type*Typ.coq_type
+  
+  val typ_bop : binop -> (Typ.coq_type*Typ.coq_type)*Typ.coq_type
+  
+  val typ_nop : nop -> Typ.coq_type*Typ.coq_type
+  
+  val check_args :
+    (int -> Typ.coq_type) -> int list -> Typ.coq_type list -> bool
+  
+  val check_aux :
+    typ_eqb array -> tval array -> (int -> Typ.coq_type) -> atom ->
+    Typ.coq_type -> bool
+  
+  val check_args_dec :
+    (int -> Typ.coq_type) -> Typ.coq_type -> int list -> Typ.coq_type list ->
+    sumbool
+  
+  val check_aux_dec :
+    typ_eqb array -> tval array -> (int -> Typ.coq_type) -> atom -> sumbool
+  
+  val apply_unop :
+    typ_eqb array -> Typ.coq_type -> Typ.coq_type -> (Typ.interp ->
+    Typ.interp) -> bval -> (Typ.coq_type, Typ.interp) coq_val
+  
+  val apply_binop :
+    typ_eqb array -> Typ.coq_type -> Typ.coq_type -> Typ.coq_type ->
+    (Typ.interp -> Typ.interp -> Typ.interp) -> bval -> bval ->
+    (Typ.coq_type, Typ.interp) coq_val
+  
+  val apply_func :
+    typ_eqb array -> Typ.coq_type list -> Typ.coq_type -> Typ.interp_ftype ->
+    bval list -> bval
+  
+  val interp_cop : typ_eqb array -> cop -> (Typ.coq_type, Typ.interp) coq_val
+  
+  val interp_uop :
+    typ_eqb array -> unop -> bval -> (Typ.coq_type, Typ.interp) coq_val
+  
+  val interp_bop :
+    typ_eqb array -> binop -> bval -> bval -> (Typ.coq_type, Typ.interp)
+    coq_val
+  
+  val compute_interp :
+    typ_eqb array -> (int -> bval) -> Typ.coq_type -> Typ.interp list -> int
+    list -> Typ.interp list option
+  
+  val interp_aux :
+    typ_eqb array -> tval array -> (int -> bval) -> atom -> bval
+  
+  val interp_bool : typ_eqb array -> bval -> bool
+  
+  val t_interp : typ_eqb array -> tval array -> atom array -> bval array
+  
+  val lt_atom : int -> atom -> bool
+  
+  val wf : atom array -> bool
+  
+  val get_type' : typ_eqb array -> bval array -> int -> Typ.coq_type
+  
+  val get_type :
+    typ_eqb array -> tval array -> atom array -> int -> Typ.coq_type
+  
+  val wt : typ_eqb array -> tval array -> atom array -> bool
+  
+  val interp_hatom : typ_eqb array -> tval array -> atom array -> int -> bval
+  
+  val interp : typ_eqb array -> tval array -> atom array -> atom -> bval
+  
+  val interp_form_hatom :
+    typ_eqb array -> tval array -> atom array -> int -> bool
+  
+  val check_atom : atom array -> bool
+ end
+
+val or_of_imp : int array -> int array
+
+val check_True : C.t
+
+val check_False : int list
+
+val check_BuildDef : Form.form array -> int -> C.t
+
+val check_ImmBuildDef : Form.form array -> S.t -> int -> C.t
+
+val check_BuildDef2 : Form.form array -> int -> C.t
+
+val check_ImmBuildDef2 : Form.form array -> S.t -> int -> C.t
+
+val check_BuildProj : Form.form array -> int -> int -> C.t
+
+val check_ImmBuildProj : Form.form array -> S.t -> int -> int -> C.t
+
+val get_eq :
+  Form.form array -> Atom.atom array -> int -> (int -> int -> C.t) -> C.t
+
+val check_trans_aux :
+  Form.form array -> Atom.atom array -> int -> int -> int list -> int -> C.t
+  -> C.t
+
+val check_trans :
+  Form.form array -> Atom.atom array -> int -> int list -> C.t
+
+val build_congr :
+  Form.form array -> Atom.atom array -> int option list -> int list -> int
+  list -> C.t -> C.t
+
+val check_congr :
+  Form.form array -> Atom.atom array -> int -> int option list -> C.t
+
+val check_congr_pred :
+  Form.form array -> Atom.atom array -> int -> int -> int option list -> C.t
+
+type 'c pol =
+| Pc of 'c
+| Pinj of positive * 'c pol
+| PX of 'c pol * positive * 'c pol
+
+val p0 : 'a1 -> 'a1 pol
+
+val p1 : 'a1 -> 'a1 pol
+
+val peq : ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> bool
+
+val mkPinj : positive -> 'a1 pol -> 'a1 pol
+
+val mkPinj_pred : positive -> 'a1 pol -> 'a1 pol
+
+val mkPX :
+  'a1 -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
+
+val mkXi : 'a1 -> 'a1 -> positive -> 'a1 pol
+
+val mkX : 'a1 -> 'a1 -> 'a1 pol
+
+val popp : ('a1 -> 'a1) -> 'a1 pol -> 'a1 pol
+
+val paddC : ('a1 -> 'a1 -> 'a1) -> 'a1 pol -> 'a1 -> 'a1 pol
+
+val psubC : ('a1 -> 'a1 -> 'a1) -> 'a1 pol -> 'a1 -> 'a1 pol
+
+val paddI :
+  ('a1 -> 'a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol ->
+  positive -> 'a1 pol -> 'a1 pol
+
+val psubI :
+  ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) ->
+  'a1 pol -> positive -> 'a1 pol -> 'a1 pol
+
+val paddX :
+  'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol
+  -> positive -> 'a1 pol -> 'a1 pol
+
+val psubX :
+  'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1
+  pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
+
+val padd :
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol ->
+  'a1 pol
+
+val psub :
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
+  -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
+
+val pmulC_aux :
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 -> 'a1
+  pol
+
+val pmulC :
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1
+  -> 'a1 pol
+
+val pmulI :
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol ->
+  'a1 pol -> 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
+
+val pmul :
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
+
+val psquare :
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  bool) -> 'a1 pol -> 'a1 pol
+
+type 'c pExpr =
+| PEc of 'c
+| PEX of positive
+| PEadd of 'c pExpr * 'c pExpr
+| PEsub of 'c pExpr * 'c pExpr
+| PEmul of 'c pExpr * 'c pExpr
+| PEopp of 'c pExpr
+| PEpow of 'c pExpr * n
+
+val mk_X : 'a1 -> 'a1 -> positive -> 'a1 pol
+
+val ppow_pos :
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive -> 'a1 pol
+
+val ppow_N :
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol
+
+val norm_aux :
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol
+
+type 'a bFormula =
+| TT
+| FF
+| X
+| A of 'a
+| Cj of 'a bFormula * 'a bFormula
+| D of 'a bFormula * 'a bFormula
+| N of 'a bFormula
+| I of 'a bFormula * 'a bFormula
+
+type 'term' clause = 'term' list
+
+type 'term' cnf = 'term' clause list
+
+val tt : 'a1 cnf
+
+val ff : 'a1 cnf
+
+val add_term :
+  ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 -> 'a1 clause -> 'a1
+  clause option
+
+val or_clause :
+  ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 clause ->
+  'a1 clause option
+
+val or_clause_cnf :
+  ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 cnf -> 'a1
+  cnf
+
+val or_cnf :
+  ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 cnf -> 'a1 cnf -> 'a1
+  cnf
+
+val and_cnf : 'a1 cnf -> 'a1 cnf -> 'a1 cnf
+
+val xcnf :
+  ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1 ->
+  'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf
+
+val cnf_checker : ('a1 list -> 'a2 -> bool) -> 'a1 cnf -> 'a2 list -> bool
+
+val tauto_checker :
+  ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1 ->
+  'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1 bFormula -> 'a3 list -> bool
+
+val cneqb : ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 -> bool
+
+val cltb : ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 -> bool
+
+type 'c polC = 'c pol
+
+type op1 =
+| Equal
+| NonEqual
+| Strict
+| NonStrict
+
+type 'c nFormula = 'c polC*op1
+
+val opMult : op1 -> op1 -> op1 option
+
+val opAdd : op1 -> op1 -> op1 option
+
+type 'c psatz =
+| PsatzIn of nat
+| PsatzSquare of 'c polC
+| PsatzMulC of 'c polC * 'c psatz
+| PsatzMulE of 'c psatz * 'c psatz
+| PsatzAdd of 'c psatz * 'c psatz
+| PsatzC of 'c
+| PsatzZ
+
+val map_option : ('a1 -> 'a2 option) -> 'a1 option -> 'a2 option
+
+val map_option2 :
+  ('a1 -> 'a2 -> 'a3 option) -> 'a1 option -> 'a2 option -> 'a3 option
+
+val pexpr_times_nformula :
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  bool) -> 'a1 polC -> 'a1 nFormula -> 'a1 nFormula option
+
+val nformula_times_nformula :
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  bool) -> 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula option
+
+val nformula_plus_nformula :
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula -> 'a1
+  nFormula -> 'a1 nFormula option
+
+val eval_Psatz :
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz -> 'a1
+  nFormula option
+
+val check_inconsistent :
+  'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula -> bool
+
+type op2 =
+| OpEq
+| OpNEq
+| OpLe
+| OpGe
+| OpLt
+| OpGt
+
+type 't formula = { flhs : 't pExpr; fop : op2; frhs : 't pExpr }
+
+val norm :
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol
+
+val psub0 :
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
+  -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
+
+val padd0 :
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol ->
+  'a1 pol
+
+type zWitness = z psatz
+
+val psub1 : z pol -> z pol -> z pol
+
+val padd1 : z pol -> z pol -> z pol
+
+val norm0 : z pExpr -> z pol
+
+val xnormalise : z formula -> z nFormula list
+
+val normalise : z formula -> z nFormula cnf
+
+val xnegate : z formula -> z nFormula list
+
+val negate : z formula -> z nFormula cnf
+
+val zunsat : z nFormula -> bool
+
+val zdeduce : z nFormula -> z nFormula -> z nFormula option
+
+val ceiling : z -> z -> z
+
+type zArithProof =
+| DoneProof
+| RatProof of zWitness * zArithProof
+| CutProof of zWitness * zArithProof
+| EnumProof of zWitness * zWitness * zArithProof list
+
+val zgcdM : z -> z -> z
+
+val zgcd_pol : z polC -> z*z
+
+val zdiv_pol : z polC -> z -> z polC
+
+val makeCuttingPlane : z polC -> z polC*z
+
+val genCuttingPlane : z nFormula -> ((z polC*z)*op1) option
+
+val nformula_of_cutting_plane : ((z polC*z)*op1) -> z nFormula
+
+val is_pol_Z0 : z polC -> bool
+
+val eval_Psatz0 : z nFormula list -> zWitness -> z nFormula option
+
+val valid_cut_sign : op1 -> bool
+
+val zChecker : z nFormula list -> zArithProof -> bool
+
+val zTautoChecker : z formula bFormula -> zArithProof list -> bool
+
+val build_positive_atom_aux :
+  (int -> positive option) -> Atom.atom -> positive option
+
+val build_positive : Atom.atom array -> int -> positive option
+
+val build_z_atom_aux : Atom.atom array -> Atom.atom -> z option
+
+val build_z_atom : Atom.atom array -> Atom.atom -> z option
+
+type vmap = positive*Atom.atom list
+
+val find_var_aux : Atom.atom -> positive -> Atom.atom list -> positive option
+
+val find_var : vmap -> Atom.atom -> vmap*positive
+
+val empty_vmap : vmap
+
+val build_pexpr_atom_aux :
+  Atom.atom array -> (vmap -> int -> vmap*z pExpr) -> vmap -> Atom.atom ->
+  vmap*z pExpr
+
+val build_pexpr : Atom.atom array -> vmap -> int -> vmap*z pExpr
+
+val build_op2 : Atom.binop -> op2 option
+
+val build_formula_atom :
+  Atom.atom array -> vmap -> Atom.atom -> (vmap*z formula) option
+
+val build_formula : Atom.atom array -> vmap -> int -> (vmap*z formula) option
+
+val build_not2 : int -> z formula bFormula -> z formula bFormula
+
+val build_hform :
+  Atom.atom array -> (vmap -> int -> (vmap*z formula bFormula) option) ->
+  vmap -> Form.form -> (vmap*z formula bFormula) option
+
+val build_var :
+  Form.form array -> Atom.atom array -> vmap -> int -> (vmap*z formula
+  bFormula) option
+
+val build_form :
+  Form.form array -> Atom.atom array -> vmap -> Form.form -> (vmap*z formula
+  bFormula) option
+
+val build_nlit :
+  Form.form array -> Atom.atom array -> vmap -> int -> (vmap*z formula
+  bFormula) option
+
+val build_clause_aux :
+  Form.form array -> Atom.atom array -> vmap -> int list -> (vmap*z formula
+  bFormula) option
+
+val build_clause :
+  Form.form array -> Atom.atom array -> vmap -> int list -> (vmap*z formula
+  bFormula) option
+
+val get_eq0 :
+  Form.form array -> Atom.atom array -> int -> (int -> int -> C.t) -> C.t
+
+val get_not_le :
+  Form.form array -> Atom.atom array -> int -> (int -> int -> C.t) -> C.t
+
+val check_micromega :
+  Form.form array -> Atom.atom array -> int list -> zArithProof list -> C.t
+
+val check_diseq : Form.form array -> Atom.atom array -> int -> C.t
+
+val check_atom_aux :
+  Atom.atom array -> (int -> int -> bool) -> Atom.atom -> Atom.atom -> bool
+
+val check_hatom : Atom.atom array -> int -> int -> bool
+
+val check_neg_hatom : Atom.atom array -> int -> int -> bool
+
+val remove_not : Form.form array -> int -> int
+
+val get_and : Form.form array -> int -> int array option
+
+val get_or : Form.form array -> int -> int array option
+
+val flatten_op_body :
+  (int -> int array option) -> (int list -> int -> int list) -> int list ->
+  int -> int list
+
+val flatten_op_lit :
+  (int -> int array option) -> int -> int list -> int -> int list
+
+val flatten_and : Form.form array -> int array -> int list
+
+val flatten_or : Form.form array -> int array -> int list
+
+val check_flatten_body :
+  Form.form array -> (int -> int -> bool) -> (int -> int -> bool) -> (int ->
+  int -> bool) -> int -> int -> bool
+
+val check_flatten_aux :
+  Form.form array -> (int -> int -> bool) -> (int -> int -> bool) -> int ->
+  int -> bool
+
+val check_flatten :
+  Form.form array -> (int -> int -> bool) -> (int -> int -> bool) -> S.t ->
+  int -> int -> C.t
+
+val check_spl_arith :
+  Form.form array -> Atom.atom array -> int list -> int -> zArithProof list
+  -> C.t
+
+val check_in : int -> int list -> bool
+
+val check_diseqs_complete_aux :
+  int -> int list -> (int*int) option array -> bool
+
+val check_diseqs_complete : int list -> (int*int) option array -> bool
+
+val check_diseqs :
+  Form.form array -> Atom.atom array -> Typ.coq_type -> int list -> int array
+  -> bool
+
+val check_distinct :
+  Form.form array -> Atom.atom array -> int -> int array -> bool
+
+val check_distinct_two_args :
+  Form.form array -> Atom.atom array -> int -> int -> bool
+
+val check_lit :
+  Form.form array -> Atom.atom array -> (int -> int -> bool) -> int -> int ->
+  bool
+
+val check_form_aux :
+  Form.form array -> Atom.atom array -> (int -> int -> bool) -> Form.form ->
+  Form.form -> bool
+
+val check_hform : Form.form array -> Atom.atom array -> int -> int -> bool
+
+val check_lit' : Form.form array -> Atom.atom array -> int -> int -> bool
+
+val check_distinct_elim :
+  Form.form array -> Atom.atom array -> int list -> int -> int list
+
+type 'step _trace_ = 'step array array
+
+val _checker_ :
+  (S.t -> 'a1 -> S.t) -> (C.t -> bool) -> S.t -> 'a1 _trace_ -> int -> bool
+
+module Euf_Checker : 
+ sig 
+  type step =
+  | Res of int * int array
+  | ImmFlatten of int * int * int
+  | CTrue of int
+  | CFalse of int
+  | BuildDef of int * int
+  | BuildDef2 of int * int
+  | BuildProj of int * int * int
+  | ImmBuildDef of int * int
+  | ImmBuildDef2 of int * int
+  | ImmBuildProj of int * int * int
+  | EqTr of int * int * int list
+  | EqCgr of int * int * int option list
+  | EqCgrP of int * int * int * int option list
+  | LiaMicromega of int * int list * zArithProof list
+  | LiaDiseq of int * int
+  | SplArith of int * int * int * zArithProof list
+  | SplDistinctElim of int * int * int
+  
+  val step_rect :
+    (int -> int array -> 'a1) -> (int -> int -> int -> 'a1) -> (int -> 'a1)
+    -> (int -> 'a1) -> (int -> int -> 'a1) -> (int -> int -> 'a1) -> (int ->
+    int -> int -> 'a1) -> (int -> int -> 'a1) -> (int -> int -> 'a1) -> (int
+    -> int -> int -> 'a1) -> (int -> int -> int list -> 'a1) -> (int -> int
+    -> int option list -> 'a1) -> (int -> int -> int -> int option list ->
+    'a1) -> (int -> int list -> zArithProof list -> 'a1) -> (int -> int ->
+    'a1) -> (int -> int -> int -> zArithProof list -> 'a1) -> (int -> int ->
+    int -> 'a1) -> step -> 'a1
+  
+  val step_rec :
+    (int -> int array -> 'a1) -> (int -> int -> int -> 'a1) -> (int -> 'a1)
+    -> (int -> 'a1) -> (int -> int -> 'a1) -> (int -> int -> 'a1) -> (int ->
+    int -> int -> 'a1) -> (int -> int -> 'a1) -> (int -> int -> 'a1) -> (int
+    -> int -> int -> 'a1) -> (int -> int -> int list -> 'a1) -> (int -> int
+    -> int option list -> 'a1) -> (int -> int -> int -> int option list ->
+    'a1) -> (int -> int list -> zArithProof list -> 'a1) -> (int -> int ->
+    'a1) -> (int -> int -> int -> zArithProof list -> 'a1) -> (int -> int ->
+    int -> 'a1) -> step -> 'a1
+  
+  val step_checker : Atom.atom array -> Form.form array -> S.t -> step -> S.t
+  
+  val euf_checker :
+    Atom.atom array -> Form.form array -> (C.t -> bool) -> S.t -> step
+    _trace_ -> int -> bool
+  
+  type certif =
+  | Certif of int * step _trace_ * int
+  
+  val certif_rect : (int -> step _trace_ -> int -> 'a1) -> certif -> 'a1
+  
+  val certif_rec : (int -> step _trace_ -> int -> 'a1) -> certif -> 'a1
+  
+  val add_roots : S.t -> int array -> int array option -> S.t
+  
+  val valid :
+    typ_eqb array -> Atom.tval array -> Atom.atom array -> Form.form array ->
+    int array -> bool
+  
+  val checker :
+    typ_eqb array -> Atom.tval array -> Atom.atom array -> Form.form array ->
+    int array -> int array option -> certif -> bool
+  
+  val checker_b :
+    typ_eqb array -> Atom.tval array -> Atom.atom array -> Form.form array ->
+    int -> bool -> certif -> bool
+  
+  val checker_eq :
+    typ_eqb array -> Atom.tval array -> Atom.atom array -> Form.form array ->
+    int -> int -> int -> certif -> bool
+  
+  val checker_ext :
+    Atom.atom array -> Form.form array -> int array -> int array option ->
+    certif -> bool
+ end
+
diff --git a/src/extraction/test.ml b/src/extraction/test.ml
new file mode 100644
index 0000000..0b16b7f
--- /dev/null
+++ b/src/extraction/test.ml
@@ -0,0 +1,42 @@
+let _ = Printf.printf "Zchaff_checker.checker \"tests/sat1.cnf\" \"tests/sat1.zlog\" = %b\n" (Zchaff_checker.checker "tests/sat1.cnf" "tests/sat1.zlog")
+let _ = Printf.printf "Zchaff_checker.checker \"tests/sat2.cnf\" \"tests/sat2.zlog\" = %b\n" (Zchaff_checker.checker "tests/sat2.cnf" "tests/sat2.zlog")
+let _ = Printf.printf "Zchaff_checker.checker \"tests/sat3.cnf\" \"tests/sat3.zlog\" = %b\n" (Zchaff_checker.checker "tests/sat3.cnf" "tests/sat3.zlog")
+let _ = Printf.printf "Zchaff_checker.checker \"tests/sat5.cnf\" \"tests/sat5.zlog\" = %b\n" (Zchaff_checker.checker "tests/sat5.cnf" "tests/sat5.zlog")
+let _ = Printf.printf "Zchaff_checker.checker \"tests/sat6.cnf\" \"tests/sat6.zlog\" = %b\n" (Zchaff_checker.checker "tests/sat6.cnf" "tests/sat6.zlog")
+let _ = Printf.printf "Zchaff_checker.checker \"tests/sat7.cnf\" \"tests/sat7.zlog\" = %b\n" (Zchaff_checker.checker "tests/sat7.cnf" "tests/sat7.zlog")
+let _ = Printf.printf "Zchaff_checker.checker \"tests/hole4.cnf\" \"tests/hole4.zlog\" = %b\n" (Zchaff_checker.checker "tests/hole4.cnf" "tests/hole4.zlog")
+let _ = Printf.printf "Zchaff_checker.checker \"tests/cmu-bmc-barrel6.cnf\" \"tests/cmu-bmc-barrel6.zlog\" = %b\n" (Zchaff_checker.checker "tests/cmu-bmc-barrel6.cnf" "tests/cmu-bmc-barrel6.zlog")
+let _ = Printf.printf "Zchaff_checker.checker \"tests/velev-sss-1.0-05.cnf\" \"tests/velev-sss-1.0-05.zlog\" = %b\n" (Zchaff_checker.checker "tests/velev-sss-1.0-05.cnf" "tests/velev-sss-1.0-05.zlog")
+
+
+
+
+let _ = Printf.printf "Verit_checker.checker \"tests/sat1.smt2\" \"tests/sat1.vtlog\" = %b\n" (Verit_checker.checker "tests/sat1.smt2" "tests/sat1.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/sat2.smt2\" \"tests/sat2.vtlog\" = %b\n" (Verit_checker.checker "tests/sat2.smt2" "tests/sat2.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/sat3.smt2\" \"tests/sat3.vtlog\" = %b\n" (Verit_checker.checker "tests/sat3.smt2" "tests/sat3.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/sat4.smt2\" \"tests/sat4.vtlog\" = %b\n" (Verit_checker.checker "tests/sat4.smt2" "tests/sat4.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/sat5.smt2\" \"tests/sat5.vtlog\" = %b\n" (Verit_checker.checker "tests/sat5.smt2" "tests/sat5.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/sat6.smt2\" \"tests/sat6.vtlog\" = %b\n" (Verit_checker.checker "tests/sat6.smt2" "tests/sat6.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/sat7.smt2\" \"tests/sat7.vtlog\" = %b\n" (Verit_checker.checker "tests/sat7.smt2" "tests/sat7.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/sat8.smt2\" \"tests/sat8.vtlog\" = %b\n" (Verit_checker.checker "tests/sat8.smt2" "tests/sat8.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/sat9.smt2\" \"tests/sat9.vtlog\" = %b\n" (Verit_checker.checker "tests/sat9.smt2" "tests/sat9.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/sat11.smt2\" \"tests/sat11.vtlog\" = %b\n" (Verit_checker.checker "tests/sat11.smt2" "tests/sat11.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/sat12.smt2\" \"tests/sat12.vtlog\" = %b\n" (Verit_checker.checker "tests/sat12.smt2" "tests/sat12.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/sat13.smt2\" \"tests/sat13.vtlog\" = %b\n" (Verit_checker.checker "tests/sat13.smt2" "tests/sat13.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/hole4.smt2\" \"tests/hole4.vtlog\" = %b\n" (Verit_checker.checker "tests/hole4.smt2" "tests/hole4.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/uf1.smt2\" \"tests/uf1.vtlog\" = %b\n" (Verit_checker.checker "tests/uf1.smt2" "tests/uf1.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/uf2.smt2\" \"tests/uf2.vtlog\" = %b\n" (Verit_checker.checker "tests/uf2.smt2" "tests/uf2.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/uf3.smt2\" \"tests/uf3.vtlog\" = %b\n" (Verit_checker.checker "tests/uf3.smt2" "tests/uf3.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/uf4.smt2\" \"tests/uf4.vtlog\" = %b\n" (Verit_checker.checker "tests/uf4.smt2" "tests/uf4.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/uf5.smt2\" \"tests/uf5.vtlog\" = %b\n" (Verit_checker.checker "tests/uf5.smt2" "tests/uf5.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/uf6.smt2\" \"tests/uf6.vtlog\" = %b\n" (Verit_checker.checker "tests/uf6.smt2" "tests/uf6.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/uf7.smt2\" \"tests/uf7.vtlog\" = %b\n" (Verit_checker.checker "tests/uf7.smt2" "tests/uf7.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/lia1.smt2\" \"tests/lia1.vtlog\" = %b\n" (Verit_checker.checker "tests/lia1.smt2" "tests/lia1.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/lia2.smt2\" \"tests/lia2.vtlog\" = %b\n" (Verit_checker.checker "tests/lia2.smt2" "tests/lia2.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/lia3.smt2\" \"tests/lia3.vtlog\" = %b\n" (Verit_checker.checker "tests/lia3.smt2" "tests/lia3.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/lia4.smt2\" \"tests/lia4.vtlog\" = %b\n" (Verit_checker.checker "tests/lia4.smt2" "tests/lia4.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/lia5.smt2\" \"tests/lia5.vtlog\" = %b\n" (Verit_checker.checker "tests/lia5.smt2" "tests/lia5.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/lia6.smt2\" \"tests/lia6.vtlog\" = %b\n" (Verit_checker.checker "tests/lia6.smt2" "tests/lia6.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/lia7.smt2\" \"tests/lia7.vtlog\" = %b\n" (Verit_checker.checker "tests/lia7.smt2" "tests/lia7.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/let1.smt2\" \"tests/let1.vtlog\" = %b\n" (Verit_checker.checker "tests/let1.smt2" "tests/let1.vtlog")
+let _ = Printf.printf "Verit_checker.checker \"tests/let2.smt2\" \"tests/let2.vtlog\" = %b\n" (Verit_checker.checker "tests/let2.smt2" "tests/let2.vtlog")
diff --git a/src/extraction/verit_checker.ml b/src/extraction/verit_checker.ml
new file mode 100644
index 0000000..e317dcf
--- /dev/null
+++ b/src/extraction/verit_checker.ml
@@ -0,0 +1,324 @@
+open SmtMisc
+open SmtCertif
+open SmtForm
+open SmtAtom
+open SmtTrace
+open Verit
+open Smtlib2_ast
+open Smtlib2_genConstr
+(* open Smt_checker *)
+
+
+module Mc = Micromega
+
+
+let mkInt = ExtrNative.of_int
+let mkArray = ExtrNative.of_array
+
+
+let rec dump_nat x =
+  match x with
+    | Mc.O -> Smt_checker.O
+    | Mc.S p -> Smt_checker.S (dump_nat p)
+
+
+let rec dump_positive x =
+  match x with
+    | Mc.XH -> Smt_checker.XH
+    | Mc.XO p -> Smt_checker.XO (dump_positive p)
+    | Mc.XI p -> Smt_checker.XI (dump_positive p)
+
+
+let dump_z x =
+  match x with
+    | Mc.Z0 -> Smt_checker.Z0
+    | Mc.Zpos p -> Smt_checker.Zpos (dump_positive p)
+    | Mc.Zneg p -> Smt_checker.Zneg (dump_positive p)
+
+
+let dump_pol e =
+  let rec dump_pol e =
+    match e with
+      | Mc.Pc n -> Smt_checker.Pc (dump_z n)
+      | Mc.Pinj(p,pol) -> Smt_checker.Pinj (dump_positive p, dump_pol pol)
+      | Mc.PX(pol1,p,pol2) -> Smt_checker.PX (dump_pol pol1, dump_positive p, dump_pol pol2) in
+  dump_pol e
+
+
+let dump_psatz e =
+  let rec dump_cone e =
+    match e with
+      | Mc.PsatzIn n -> Smt_checker.PsatzIn (dump_nat n)
+      | Mc.PsatzMulC(e,c) -> Smt_checker.PsatzMulC (dump_pol e, dump_cone c)
+      | Mc.PsatzSquare e -> Smt_checker.PsatzSquare (dump_pol e)
+      | Mc.PsatzAdd(e1,e2) -> Smt_checker.PsatzAdd (dump_cone e1, dump_cone e2)
+      | Mc.PsatzMulE(e1,e2) -> Smt_checker.PsatzMulE (dump_cone e1, dump_cone e2)
+      | Mc.PsatzC p -> Smt_checker.PsatzC (dump_z p)
+      | Mc.PsatzZ -> Smt_checker.PsatzZ in
+  dump_cone e
+
+
+let rec dump_list dump_elt l =
+  match l with
+    | [] -> Smt_checker.Nil
+    | e :: l -> Smt_checker.Cons (dump_elt e, dump_list dump_elt l)
+
+
+let rec dump_proof_term = function
+  | Micromega.DoneProof -> Smt_checker.DoneProof
+  | Micromega.RatProof(cone,rst) ->
+    Smt_checker.RatProof (dump_psatz cone, dump_proof_term rst)
+  | Micromega.CutProof(cone,prf) ->
+    Smt_checker.CutProof (dump_psatz cone, dump_proof_term prf)
+  | Micromega.EnumProof(c1,c2,prfs) ->
+    Smt_checker.EnumProof (dump_psatz c1, dump_psatz c2, dump_list dump_proof_term prfs)
+
+
+
+let to_coq to_lit confl =
+  let out_f f = to_lit f in
+  let out_c c = mkInt (get_pos c) in
+  let step_to_coq c =
+    match c.kind with
+    | Res res ->
+	let size = List.length res.rtail + 3 in
+	let args = Array.make size (mkInt 0) in
+	args.(0) <- mkInt (get_pos res.rc1);
+	args.(1) <- mkInt (get_pos res.rc2);
+	let l = ref res.rtail in
+	for i = 2 to size - 2 do
+	  match !l with
+	  | c::tl ->
+	      args.(i) <- mkInt (get_pos c);
+	      l := tl
+	  | _ -> assert false
+	done;
+	Smt_checker.Euf_Checker.Res (mkInt (get_pos c), mkArray args)
+    | Other other ->
+	begin match other with
+	| ImmFlatten (c',f) -> Smt_checker.Euf_Checker.ImmFlatten (out_c c, out_c c', out_f f)
+        | True -> Smt_checker.Euf_Checker.CTrue (out_c c)
+	| False -> Smt_checker.Euf_Checker.CFalse (out_c c)
+	| BuildDef f -> Smt_checker.Euf_Checker.BuildDef (out_c c, out_f f)
+	| BuildDef2 f -> Smt_checker.Euf_Checker.BuildDef2 (out_c c, out_f f)
+	| BuildProj (f, i) -> Smt_checker.Euf_Checker.BuildProj (out_c c, out_f f, mkInt i)
+	| ImmBuildDef c' -> Smt_checker.Euf_Checker.ImmBuildDef (out_c c, out_c c')
+	| ImmBuildDef2 c' -> Smt_checker.Euf_Checker.ImmBuildDef2 (out_c c, out_c c')
+	| ImmBuildProj(c', i) -> Smt_checker.Euf_Checker.ImmBuildProj (out_c c, out_c c',mkInt i)
+        | EqTr (f, fl) ->
+          let res = List.fold_right (fun f l -> Smt_checker.Cons (out_f f, l)) fl Smt_checker.Nil in
+          Smt_checker.Euf_Checker.EqTr (out_c c, out_f f, res)
+        | EqCgr (f, fl) ->
+          let res = List.fold_right (fun f l -> Smt_checker.Cons ((match f with | Some f -> Smt_checker.Some (out_f f) | None -> Smt_checker.None), l)) fl Smt_checker.Nil in
+          Smt_checker.Euf_Checker.EqCgr (out_c c, out_f f, res)
+        | EqCgrP (f1, f2, fl) ->
+          let res = List.fold_right (fun f l -> Smt_checker.Cons ((match f with | Some f -> Smt_checker.Some (out_f f) | None -> Smt_checker.None), l)) fl Smt_checker.Nil in
+          Smt_checker.Euf_Checker.EqCgrP (out_c c, out_f f1, out_f f2, res)
+	| LiaMicromega (cl,d) ->
+          let cl' = List.fold_right (fun f l -> Smt_checker.Cons (out_f f, l)) cl Smt_checker.Nil in
+          let c' = List.fold_right (fun f l -> Smt_checker.Cons (dump_proof_term f, l)) d Smt_checker.Nil in
+          Smt_checker.Euf_Checker.LiaMicromega (out_c c, cl', c')
+        | LiaDiseq l -> Smt_checker.Euf_Checker.LiaDiseq (out_c c, out_f l)
+        | SplArith (orig,res,l) ->
+          let res' = out_f res in
+          let l' = List.fold_right (fun f l -> Smt_checker.Cons (dump_proof_term f, l)) l Smt_checker.Nil in
+          Smt_checker.Euf_Checker.SplArith (out_c c, out_c orig, res', l')
+	| SplDistinctElim (c',f) -> Smt_checker.Euf_Checker.SplDistinctElim (out_c c, out_c c', out_f f)
+	end
+    | _ -> assert false in
+  let def_step =
+    Smt_checker.Euf_Checker.Res (mkInt 0, mkArray [|mkInt 0|]) in
+  let r = ref confl in
+  let nc = ref 0 in
+  while not (isRoot !r.kind) do r := prev !r; incr nc done;
+  let last_root = !r in
+  let size = !nc in
+  let max = (Parray.trunc_size (Uint63.of_int 4194303)) - 1 in
+  let q,r1 = size / max, size mod max in
+
+  let trace =
+    let len = if r1 = 0 then q + 1 else q + 2 in
+    Array.make len (mkArray [|def_step|]) in
+  for j = 0 to q - 1 do
+    let tracej = Array.make (Parray.trunc_size (Uint63.of_int 4194303)) def_step in
+    for i = 0 to max - 1 do
+      r := next !r;
+      tracej.(i) <- step_to_coq !r;
+    done;
+    trace.(j) <- mkArray tracej
+  done;
+  if r1 <> 0 then begin
+    let traceq = Array.make (r1 + 1) def_step in
+    for i = 0 to r1-1 do
+    r := next !r;
+    traceq.(i) <- step_to_coq !r;
+    done;
+    trace.(q) <- mkArray traceq
+  end;
+
+  (mkArray trace, last_root)
+
+
+let btype_to_coq = function
+  | TZ ->        Smt_checker.Typ.TZ
+  | Tbool ->     Smt_checker.Typ.Tbool
+  | Tpositive -> Smt_checker.Typ.Tpositive
+  | Tindex i ->  Smt_checker.Typ.Tindex (mkInt (SmtAtom.indexed_type_index i))
+
+
+let c_to_coq = function
+  | CO_xH -> Smt_checker.Atom.CO_xH
+  | CO_Z0 -> Smt_checker.Atom.CO_Z0
+
+
+let u_to_coq = function
+  | UO_xO ->   Smt_checker.Atom.UO_xO
+  | UO_xI ->   Smt_checker.Atom.UO_xI
+  | UO_Zpos -> Smt_checker.Atom.UO_Zpos
+  | UO_Zneg -> Smt_checker.Atom.UO_Zneg
+  | UO_Zopp -> Smt_checker.Atom.UO_Zopp
+
+
+let b_to_coq = function
+  | BO_Zplus ->  Smt_checker.Atom.BO_Zplus
+  | BO_Zminus -> Smt_checker.Atom.BO_Zminus
+  | BO_Zmult ->  Smt_checker.Atom.BO_Zmult
+  | BO_Zlt ->    Smt_checker.Atom.BO_Zlt
+  | BO_Zle ->    Smt_checker.Atom.BO_Zle
+  | BO_Zge ->    Smt_checker.Atom.BO_Zge
+  | BO_Zgt ->    Smt_checker.Atom.BO_Zgt
+  | BO_eq t ->   Smt_checker.Atom.BO_eq (btype_to_coq t)
+
+
+let n_to_coq = function
+  | NO_distinct t -> btype_to_coq t
+
+
+let i_to_coq i = mkInt (SmtAtom.indexed_op_index i)
+
+
+let a_to_coq a =
+  let to_coq h = mkInt (Atom.index h) in
+  match a with
+    | Acop op -> Smt_checker.Atom.Acop (c_to_coq op)
+    | Auop (op,h) -> Smt_checker.Atom.Auop (u_to_coq op, to_coq h)
+    | Abop (op,h1,h2) ->
+      Smt_checker.Atom.Abop (b_to_coq op, to_coq h1, to_coq h2)
+    | Anop (op,ha) ->
+      let cop = n_to_coq op in
+      let cargs = Array.fold_right (fun h l -> Smt_checker.Cons (to_coq h, l)) ha Smt_checker.Nil in
+      Smt_checker.Atom.Anop (cop, cargs)
+    | Aapp (op,args) ->
+      let cop = i_to_coq op in
+      let cargs = Array.fold_right (fun h l -> Smt_checker.Cons (to_coq h, l)) args Smt_checker.Nil in
+      Smt_checker.Atom.Aapp (cop, cargs)
+
+
+let atom_interp_tbl reify =
+  let t = Atom.to_array reify (Smt_checker.Atom.Acop Smt_checker.Atom.CO_xH) a_to_coq in
+  mkArray t
+
+
+let form_to_coq hf = mkInt (Form.to_lit hf)
+
+let args_to_coq args =
+  let cargs = Array.make (Array.length args + 1) (mkInt 0) in
+  Array.iteri (fun i hf -> cargs.(i) <- form_to_coq hf) args;
+  mkArray cargs
+
+let pf_to_coq = function
+  | Fatom a -> Smt_checker.Form.Fatom (mkInt (Atom.index a))
+  | Fapp(op,args) ->
+    match op with
+      | Ftrue -> Smt_checker.Form.Ftrue
+      | Ffalse -> Smt_checker.Form.Ffalse
+      | Fand -> Smt_checker.Form.Fand (args_to_coq args)
+      | For  -> Smt_checker.Form.For (args_to_coq args)
+      | Fimp -> Smt_checker.Form.Fimp (args_to_coq args)
+      | Fxor -> if Array.length args = 2 then Smt_checker.Form.Fxor (form_to_coq args.(0), form_to_coq args.(1)) else assert false
+      | Fiff -> if Array.length args = 2 then Smt_checker.Form.Fiff (form_to_coq args.(0), form_to_coq args.(1)) else assert false
+      | Fite -> if Array.length args = 3 then Smt_checker.Form.Fite (form_to_coq args.(0), form_to_coq args.(1), form_to_coq args.(2)) else assert false
+      | Fnot2 i -> Smt_checker.Form.Fnot2 (mkInt i, form_to_coq args.(0))
+
+
+let form_interp_tbl reify =
+  let (_,t) = Form.to_array reify Smt_checker.Form.Ftrue pf_to_coq in
+  mkArray t
+
+
+(* Importing from SMT-LIB v.2 without generating section variables *)
+
+let count_btype = ref 0
+let count_op = ref 0
+
+
+let declare_sort sym =
+  let s = string_of_symbol sym in
+  let res = Tindex (dummy_indexed_type !count_btype) in
+  incr count_btype;
+  VeritSyntax.add_btype s res;
+  res
+
+
+let declare_fun sym arg cod =
+  let s = string_of_symbol sym in
+  let tyl = List.map sort_of_sort arg in
+  let ty = sort_of_sort cod in
+  let op = dummy_indexed_op !count_op (Array.of_list (List.map fst tyl)) (fst ty) in
+  incr count_op;
+  VeritSyntax.add_fun s op;
+  op
+
+
+let declare_commands ra rf acc = function
+  | CDeclareSort (_,sym,_) -> let _ = declare_sort sym in acc
+  | CDeclareFun (_,sym, (_, arg), cod) -> let _ = declare_fun sym arg cod in acc
+  | CAssert (_, t) -> (make_root ra rf t)::acc
+  | _ -> acc
+
+
+let import_smtlib2 ra rf filename =
+  let chan = open_in filename in
+  let lexbuf = Lexing.from_channel chan in
+  let commands = Smtlib2_parse.main Smtlib2_lex.token lexbuf in
+  close_in chan;
+  match commands with
+    | None -> []
+    | Some (Smtlib2_ast.Commands (_,(_,res))) ->
+      List.rev (List.fold_left (declare_commands ra rf) [] res)
+
+
+(* The final checker *)
+
+let this_clear_all () =
+  Verit.clear_all ();
+  count_btype := 0;
+  count_op := 0
+
+
+let checker fsmt fproof =
+  this_clear_all ();
+  let ra = VeritSyntax.ra in
+  let rf = VeritSyntax.rf in
+  let roots = import_smtlib2 ra rf fsmt in
+  let (max_id, confl) = import_trace fproof None in
+  let (tres,last_root) = to_coq (fun i -> mkInt (SmtAtom.Form.to_lit i)) confl in
+  let certif =
+    Smt_checker.Euf_Checker.Certif (mkInt (max_id + 1), tres, mkInt (get_pos confl)) in
+  let used_roots = compute_roots roots last_root in
+  let used_rootsCstr =
+    let l = List.length used_roots in
+    let res = Array.make (l + 1) (mkInt 0) in
+    let i = ref (l-1) in
+    List.iter (fun j -> res.(!i) <- mkInt j; decr i) used_roots;
+    Smt_checker.Some (mkArray res) in
+  let rootsCstr =
+    let res = Array.make (List.length roots + 1) (mkInt 0) in
+    let i = ref 0 in
+    List.iter (fun j -> res.(!i) <- mkInt (SmtAtom.Form.to_lit j); incr i) roots;
+    mkArray res in
+
+  let t_atom = atom_interp_tbl ra in
+  let t_form = form_interp_tbl rf in
+
+  Smt_checker.Euf_Checker.checker_ext t_atom t_form rootsCstr used_rootsCstr certif
diff --git a/src/extraction/zchaff_checker.ml b/src/extraction/zchaff_checker.ml
new file mode 100644
index 0000000..79e87cc
--- /dev/null
+++ b/src/extraction/zchaff_checker.ml
@@ -0,0 +1,103 @@
+open SmtCertif
+open SmtForm
+open SatAtom
+open SmtTrace
+open Zchaff
+open Sat_checker
+
+
+let mkInt = ExtrNative.of_int
+let mkArray = ExtrNative.of_array
+
+
+let make_roots first last =
+  let roots = Array.make (last.id + 2) (mkArray (Array.make 1 (mkInt 0))) in
+  let mk_elem l =
+    let x = match Form.pform l with
+      | Fatom x -> x + 2
+      | _ -> assert false  in
+    mkInt (if Form.is_pos l then x lsl 1 else (x lsl 1) lxor 1) in
+  let r = ref first in
+  while !r.id < last.id do
+    let root = Array.of_list (get_val !r) in
+    let croot = Array.make (Array.length root + 1) (mkInt 0) in
+    Array.iteri (fun i l -> croot.(i) <- mk_elem l) root;
+    roots.(!r.id) <- mkArray croot;
+    r := next !r
+  done;
+  let root = Array.of_list (get_val !r) in
+  let croot = Array.make (Array.length root + 1) (mkInt 0) in
+  Array.iteri (fun i l -> croot.(i) <- mk_elem l) root;
+  roots.(!r.id) <- mkArray croot;
+
+  mkArray roots
+
+
+let to_coq to_lit (cstep,
+                   cRes, cImmFlatten,
+                   cTrue, cFalse, cBuildDef, cBuildDef2, cBuildProj,
+                   cImmBuildProj,cImmBuildDef,cImmBuildDef2,
+                   cEqTr, cEqCgr, cEqCgrP,
+                   cLiaMicromega, cLiaDiseq, cSplArith, cSplDistinctElim) confl =
+  let step_to_coq c =
+    match c.kind with
+      | Res res ->
+	let size = List.length res.rtail + 3 in
+	let args = Array.make size (mkInt 0) in
+	args.(0) <- mkInt (get_pos res.rc1);
+	args.(1) <- mkInt (get_pos res.rc2);
+	let l = ref res.rtail in
+	for i = 2 to size - 2 do
+	  match !l with
+	    | c::tl ->
+	      args.(i) <- mkInt (get_pos c);
+	      l := tl
+	    | _ -> assert false
+	done;
+	Sat_Checker.Res (mkInt (get_pos c), mkArray args)
+      | _ -> assert false in
+  let def_step =
+    Sat_Checker.Res (mkInt 0, mkArray [|mkInt 0|]) in
+  let r = ref confl in
+  let nc = ref 0 in
+  while not (isRoot !r.kind) do r := prev !r; incr nc done;
+  let last_root = !r in
+  let size = !nc in
+  let max = (Parray.trunc_size (Uint63.of_int 4194303)) - 1 in
+  let q,r1 = size / max, size mod max in
+
+  let trace =
+    let len = if r1 = 0 then q + 1 else q + 2 in
+    Array.make len (mkArray [|def_step|]) in
+  for j = 0 to q - 1 do
+    let tracej = Array.make (Parray.trunc_size (Uint63.of_int 4194303)) def_step in
+    for i = 0 to max - 1 do
+      r := next !r;
+      tracej.(i) <- step_to_coq !r;
+    done;
+    trace.(j) <- mkArray tracej
+  done;
+  if r1 <> 0 then begin
+    let traceq = Array.make (r1 + 1) def_step in
+    for i = 0 to r1-1 do
+      r := next !r;
+      traceq.(i) <- step_to_coq !r;
+    done;
+    trace.(q) <- mkArray traceq
+  end;
+
+  (mkArray trace, last_root)
+
+
+let checker fdimacs ftrace =
+  SmtTrace.clear ();
+  let _,first,last,reloc = import_cnf fdimacs in
+  let d = make_roots first last in
+
+  let max_id, confl = import_cnf_trace reloc ftrace first last in
+  let (tres,_) =
+    to_coq (fun _ -> assert false) certif_ops confl in
+  let certif =
+    Sat_Checker.Certif (mkInt (max_id + 1), tres, mkInt (get_pos confl)) in
+
+  Sat_Checker.checker d certif
diff --git a/src/lia/Lia.v b/src/lia/Lia.v
new file mode 100644
index 0000000..0969db0
--- /dev/null
+++ b/src/lia/Lia.v
@@ -0,0 +1,1611 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+Require Import Bool.
+Require Import List.
+Require Import Int63.
+Require Import PArray.
+Require Import RingMicromega.
+Require Import ZMicromega.
+Require Import Tauto.
+Require Import Psatz.
+(* Add LoadPath ".." as SMTCoq. *)
+
+Require Import Misc State.
+Require Import SMT_terms.
+Require Import SMTCoq.euf.Euf.
+
+Local Open Scope array_scope.
+Local Open Scope int63_scope.
+
+Section certif.
+
+  Variable t_form : PArray.array Form.form.
+  Variable t_atom : PArray.array Atom.atom.
+
+  Local Notation get_atom := (PArray.get t_atom) (only parsing).
+  Local Notation get_form := (PArray.get t_form) (only parsing).
+
+  Import EnvRing Atom.
+
+  Register option_map as PrimInline.
+
+  Section BuildPositive.
+    Variable build_positive : hatom -> option positive.
+
+    Definition build_positive_atom_aux (a:atom) : option positive :=
+      match a with
+      | Acop CO_xH => Some xH
+      | Auop UO_xO a => option_map xO (build_positive a)
+      | Auop UO_xI a => option_map xI (build_positive a)
+      | _ => None
+      end.
+
+  End BuildPositive.
+
+  Definition build_positive :=
+    foldi_down_cont
+      (fun i cont h =>
+          build_positive_atom_aux cont (get_atom h))
+      (PArray.length t_atom) 0 (fun _ => None).
+
+  Definition build_positive_atom := build_positive_atom_aux build_positive.
+  Register build_positive_atom as PrimInline.
+
+  Section BuildZ.
+
+    Definition build_z_atom_aux a :=
+      match a with
+      | Auop UO_Zpos a => option_map Zpos (build_positive a)
+      | Acop CO_Z0 => Some Z0
+      | Auop UO_Zneg a => option_map Zneg (build_positive a)
+      | _ => None
+      end.
+
+  End BuildZ.
+
+  Definition build_z h := build_z_atom_aux (get_atom h).
+
+  Definition build_z_atom := build_z_atom_aux.
+
+  Definition vmap := (positive * list Atom.atom)%type.
+
+  Fixpoint find_var_aux h p (l:list Atom.atom) :=
+    match l with
+    | nil => None
+    | h' :: l =>
+      let p := Ppred p in
+      if Atom.eqb h h' then Some p else find_var_aux h p l
+    end.
+
+  Definition find_var (vm:vmap) h :=
+    let (count,map) := vm in
+    match find_var_aux h count map with
+    | Some p => (vm, p)
+    | None => ((Psucc count,h::map), count)
+    end.
+
+  Definition empty_vmap : vmap := (1%positive, nil).
+
+  Section BuildPExpr.
+
+    Variable build_pexpr : vmap -> hatom -> (vmap * PExpr Z).
+
+    Definition build_pexpr_atom_aux (vm:vmap) (h:atom) : vmap * PExpr Z :=
+      match h with
+      | Abop BO_Zplus a1 a2 =>
+        let (vm, pe1) := build_pexpr vm a1 in
+        let (vm, pe2) := build_pexpr vm a2 in
+        (vm, PEadd pe1 pe2)
+      | Abop BO_Zminus a1 a2 =>
+        let (vm, pe1) := build_pexpr vm a1 in
+        let (vm, pe2) := build_pexpr vm a2 in
+        (vm, PEsub pe1 pe2)
+      | Abop BO_Zmult a1 a2 =>
+        let (vm, pe1) := build_pexpr vm a1 in
+        let (vm, pe2) := build_pexpr vm a2 in
+        (vm, PEmul pe1 pe2)
+      | Auop UO_Zopp a =>
+        let (vm, pe) := build_pexpr vm a in
+        (vm, PEopp pe)
+      | _ =>
+        match build_z_atom h with
+        | Some z => (vm, PEc z)
+        | None =>
+          let (vm,p) := find_var vm h in
+          (vm,PEX Z p)
+        end
+      end.
+
+  End BuildPExpr.
+
+  Definition build_pexpr :=
+     foldi_down_cont
+       (fun i cont vm h => build_pexpr_atom_aux cont vm (get_atom h))
+       (PArray.length t_atom) 0 (fun vm _ => (vm,PEc 0%Z)).
+
+  Definition build_pexpr_atom := build_pexpr_atom_aux build_pexpr.
+
+  (* Remark: We do not use OpNeq *)
+  Definition build_op2 op :=
+    match op with
+    | (BO_eq Typ.TZ) => Some OpEq
+    | BO_Zle => Some OpLe
+    | BO_Zge => Some OpGe
+    | BO_Zlt => Some OpLt
+    | BO_Zgt => Some OpGt
+    | _ => None
+    end.
+
+  Definition build_formula_atom vm (a:atom) :=
+    match a with
+    | Abop op a1 a2 =>
+      match build_op2 op with
+      | Some o =>
+        let (vm,pe1) := build_pexpr vm a1 in
+        let (vm,pe2) := build_pexpr vm a2 in
+        Some (vm, Build_Formula pe1 o pe2)
+      | None => None
+      end
+    | _ => None
+    end.
+
+  Definition build_formula vm h :=
+      build_formula_atom vm (get_atom h).
+
+
+  Section Build_form.
+
+    Definition build_not2 i f :=
+      fold (fun f' => N (N (A:=Formula Z) f')) 1 i f.
+
+    Variable build_var : vmap -> var -> option (vmap*BFormula (Formula Z)).
+
+
+    Definition build_hform vm f : option (vmap*BFormula (Formula Z)) :=
+      match f with
+        | Form.Fatom h =>
+          match build_formula vm h with
+            | Some (vm,f) => Some (vm, A f)
+            | None => None
+          end
+        | Form.Ftrue => Some (vm, TT (Formula Z))
+        | Form.Ffalse => Some (vm, FF (Formula Z))
+        | Form.Fnot2 i l =>
+          match build_var vm (Lit.blit l) with
+            | Some (vm, f) =>
+              let f' := build_not2 i f in
+              let f'' := if Lit.is_pos l then f' else N f' in
+              Some (vm,f'')
+            | None => None
+          end
+        | Form.Fand args =>
+          let n := length args in
+          if n == 0 then Some (vm,TT (Formula Z))
+          else
+            foldi (fun i f1 => match f1 with | Some(vm',f1') => let l := (args.[i]) in match build_var vm' (Lit.blit l) with | Some(vm2,f2) => let f2' := if Lit.is_pos l then f2 else N f2 in Some(vm2,Cj f1' f2') | None => None end | None => None end) 1 (n-1) (let l := args.[0] in
+              match build_var vm (Lit.blit l) with
+                | Some (vm',f) => if Lit.is_pos l then Some (vm',f) else Some (vm',N f)
+                | None => None
+              end)
+        | Form.For args =>
+          let n := length args in
+          if n == 0 then Some (vm,FF (Formula Z))
+          else
+            foldi (fun i f1 => match f1 with | Some(vm',f1') => let l := (args.[i]) in match build_var vm' (Lit.blit l) with | Some(vm2,f2) => let f2' := if Lit.is_pos l then f2 else N f2 in Some(vm2,D f1' f2') | None => None end | None => None end) 1 (n-1) (let l := args.[0] in
+              match build_var vm (Lit.blit l) with
+                | Some (vm',f) => if Lit.is_pos l then Some (vm',f) else Some (vm',N f)
+                | None => None
+              end)
+        | Form.Fxor a b =>
+          match build_var vm (Lit.blit a) with
+            | Some (vm1, f1) =>
+              match build_var vm1 (Lit.blit b) with
+                | Some (vm2, f2) =>
+                  let f1' := if Lit.is_pos a then f1 else N f1 in
+                  let f2' := if Lit.is_pos b then f2 else N f2 in
+                  Some (vm2, Cj (D f1' f2') (D (N f1') (N f2')))
+                | None => None
+              end
+            | None => None
+          end
+        | Form.Fimp args =>
+          let n := length args in
+          if n == 0 then Some (vm,TT (Formula Z))
+          else if n <= 1 then
+            let l := args.[0] in
+            match build_var vm (Lit.blit l) with
+              | Some (vm',f) => if Lit.is_pos l then Some (vm',f) else Some (vm',N f)
+              | None => None
+            end
+          else
+            foldi_down (fun i f1 => match f1 with | Some(vm',f1') => let l := (args.[i]) in match build_var vm' (Lit.blit l) with | Some(vm2,f2) => let f2' := if Lit.is_pos l then f2 else N f2 in Some(vm2,I f2' f1') | None => None end | None => None end) (n-2) 0 (let l := args.[n-1] in
+              match build_var vm (Lit.blit l) with
+                | Some (vm',f) => if Lit.is_pos l then Some (vm',f) else Some (vm',N f)
+                | None => None
+              end)
+        | Form.Fiff a b =>
+          match build_var vm (Lit.blit a) with
+            | Some (vm1, f1) =>
+              match build_var vm1 (Lit.blit b) with
+                | Some (vm2, f2) =>
+                  let f1' := if Lit.is_pos a then f1 else N f1 in
+                  let f2' := if Lit.is_pos b then f2 else N f2 in
+                  Some (vm2, Cj (D f1' (N f2')) (D (N f1') f2'))
+                | None => None
+              end
+            | None => None
+          end
+        | Form.Fite a b c =>
+          match build_var vm (Lit.blit a) with
+            | Some (vm1, f1) =>
+              match build_var vm1 (Lit.blit b) with
+                | Some (vm2, f2) =>
+                  match build_var vm2 (Lit.blit c) with
+                    | Some (vm3, f3) =>
+                      let f1' := if Lit.is_pos a then f1 else N f1 in
+                      let f2' := if Lit.is_pos b then f2 else N f2 in
+                      let f3' := if Lit.is_pos c then f3 else N f3 in
+                      Some (vm3, D (Cj f1' f2') (Cj (N f1') f3'))
+                    | None => None
+                  end
+                | None => None
+              end
+            | None => None
+          end
+      end.
+
+  End Build_form.
+
+
+  Definition build_var :=
+    foldi_down_cont
+    (fun i cont vm h => build_hform cont vm (get_form h))
+    (PArray.length t_form) 0 (fun _ _ => None).
+
+  Definition build_form := build_hform build_var.
+
+
+  Definition build_nlit vm l :=
+    let l := Lit.neg l in
+    match build_form vm (get_form (Lit.blit l)) with
+      | Some (vm,f) =>
+        let f := if Lit.is_pos l then f else N f in
+        Some (vm,f)
+      | None => None
+    end.
+
+
+  Fixpoint build_clause_aux vm (cl:list _lit) {struct cl} :
+    option (vmap * BFormula (Formula Z)) :=
+    match cl with
+    | nil => None
+    | l::nil => build_nlit vm l
+    | l::cl =>
+      match build_nlit vm l with
+      | Some (vm,bf1) =>
+        match build_clause_aux vm cl with
+        | Some (vm,bf2) => Some (vm, Cj bf1 bf2)
+        | _ => None
+        end
+      | None => None
+      end
+    end.
+
+  Definition build_clause vm cl :=
+    match build_clause_aux vm cl with
+    | Some (vm, bf) => Some (vm, I bf (FF _))
+    | None => None
+    end.
+
+  Definition get_eq (l:_lit) (f : Atom.hatom -> Atom.hatom -> C.t) :=
+    if Lit.is_pos l then
+      match get_form (Lit.blit l) with
+        | Form.Fatom xa =>
+          match get_atom xa with
+            | Atom.Abop (Atom.BO_eq _) a b => f a b
+            | _ => C._true
+          end
+        | _ => C._true
+      end
+      else C._true.
+  Register get_eq as PrimInline.
+
+  Definition get_not_le (l:_lit) (f : Atom.hatom -> Atom.hatom -> C.t) :=
+    if negb (Lit.is_pos l) then
+    match get_form (Lit.blit l) with
+      | Form.Fatom xa =>
+        match get_atom xa with
+          | Atom.Abop (Atom.BO_Zle) a b => f a b
+          | _ => C._true
+        end
+      | _ => C._true
+    end
+      else C._true.
+  Register get_not_le as PrimInline.
+
+  Definition check_micromega cl c : C.t :=
+    match build_clause empty_vmap cl with
+      | Some (_, bf) =>
+        if ZTautoChecker bf c then cl
+          else C._true
+      | None => C._true
+    end.
+
+  Definition check_diseq l : C.t :=
+    match get_form (Lit.blit l) with
+      |Form.For a =>
+        if PArray.length a == 3 then
+          let a_eq_b := a.[0] in
+          let not_a_le_b := a.[1] in
+          let not_b_le_a := a.[2] in
+          get_eq a_eq_b (fun a b => get_not_le not_a_le_b (fun a' b' => get_not_le not_b_le_a (fun b'' a'' =>
+            if (a == a') && (a == a'') && (b == b') && (b == b'')
+              then (Lit.lit (Lit.blit l))::nil
+              else
+                if (a == b') && (a == b'') && (b == a') && (b == a'')
+                  then (Lit.lit (Lit.blit l))::nil
+                  else C._true)))
+          else C._true
+      | _ => C._true
+    end.
+
+
+  Section Proof.
+
+    Variables (t_i : array typ_eqb)
+              (t_func : array (Atom.tval t_i))
+              (ch_atom : Atom.check_atom t_atom)
+              (ch_form : Form.check_form t_form)
+              (wt_t_atom : Atom.wt t_i t_func t_atom).
+
+    Local Notation check_atom :=
+      (check_aux t_i t_func (get_type t_i t_func t_atom)).
+
+    Local Notation interp_form_hatom :=
+      (Atom.interp_form_hatom t_i t_func t_atom).
+
+    Local Notation rho :=
+      (Form.interp_state_var interp_form_hatom t_form).
+
+    Local Notation t_interp := (t_interp t_i t_func t_atom).
+
+    Local Notation interp_atom :=
+      (interp_aux t_i t_func (get t_interp)).
+
+    Let wf_t_atom : Atom.wf t_atom.
+    Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed.
+
+    Let def_t_atom : default t_atom = Atom.Acop Atom.CO_xH.
+    Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed.
+
+    Let def_t_form : default t_form = Form.Ftrue.
+    Proof.
+      destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [H _]; destruct H; auto.
+    Qed.
+
+    Let wf_t_form : Form.wf t_form.
+    Proof.
+      destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [H _]; destruct H; auto.
+    Qed.
+
+    Let wf_rho : Valuation.wf rho.
+    Proof.
+      destruct (Form.check_form_correct interp_form_hatom _ ch_form); auto.
+    Qed.
+
+    Lemma build_positive_atom_aux_correct :
+       forall (build_positive : hatom -> option positive),
+       (forall (h : hatom) p,
+          build_positive h = Some p ->
+          t_interp.[h] = Bval t_i Typ.Tpositive p) ->
+       forall (a:atom) (p:positive),
+         build_positive_atom_aux build_positive a = Some p ->
+         interp_atom a = Bval t_i Typ.Tpositive p.
+    Proof.
+      intros build_positive Hbuild a; case a; simpl; try discriminate; auto.
+      destruct c; simpl; try discriminate; intros p H1; inversion_clear H1; auto.
+      destruct u; simpl; try discriminate;
+        intros i p; case_eq (build_positive i); simpl; try discriminate; intros q H1 H2; inversion_clear H2; rewrite (Hbuild _ _ H1); auto.
+    Qed.
+
+    Lemma build_positive_correct : forall h p,
+      build_positive h = Some p ->
+      t_interp.[h] = Bval t_i Typ.Tpositive p.
+    Proof.
+      unfold build_positive.
+      apply foldi_down_cont_ind;intros;try discriminate.
+      rewrite t_interp_wf;trivial.
+      apply build_positive_atom_aux_correct with cont;trivial.
+    Qed.
+
+    Lemma build_positive_atom_correct :
+       forall (a:atom) (p:positive),
+         build_positive_atom a = Some p ->
+         interp_atom a = Bval t_i Typ.Tpositive p.
+    Proof.
+     apply build_positive_atom_aux_correct;apply build_positive_correct.
+    Qed.
+
+    Lemma build_z_atom_aux_correct :
+       forall a z,
+         build_z_atom_aux a = Some z ->
+         interp_atom a = Bval t_i Typ.TZ z.
+    Proof.
+     intros a z.
+     destruct a;simpl;try discriminate;auto.
+     destruct c;[discriminate | intros Heq;inversion Heq;trivial].
+     destruct u;try discriminate;
+       case_eq (build_positive i);try discriminate;
+       intros p Hp Heq;inversion Heq;clear Heq;subst;
+       rewrite (build_positive_correct _ _ Hp);trivial.
+    Qed.
+
+    Lemma build_z_correct :
+      forall h z, build_z h = Some z -> t_interp.[h] = Bval t_i Typ.TZ z.
+    Proof.
+     unfold build_z;intros h z;rewrite t_interp_wf;trivial.
+     apply build_z_atom_aux_correct;discriminate.
+    Qed.
+
+    Lemma build_z_atom_correct :
+      forall a z, build_z_atom a = Some z ->
+      interp_atom a = Bval t_i Typ.TZ z.
+    Proof.
+     apply build_z_atom_aux_correct.
+    Qed.
+
+    Definition wf_vmap (vm:vmap) :=
+      (List.length (snd vm) = nat_of_P (fst vm) - 1)%nat /\
+      List.forallb (fun h => check_atom h Typ.TZ) (snd vm).
+
+    Fixpoint bounded_pexpr (p:positive) (pe:PExpr Z) :=
+      match pe with
+      | PEc _ => true
+      | PEX x => Zlt_bool (Zpos x) (Zpos p)
+      | PEadd pe1 pe2
+      | PEsub pe1 pe2
+      | PEmul pe1 pe2 => bounded_pexpr p pe1 && bounded_pexpr p pe2
+      | PEopp pe => bounded_pexpr p pe
+      | PEpow pe _ => bounded_pexpr p pe
+      end.
+
+    Definition bounded_formula (p:positive) (f:Formula Z) :=
+      bounded_pexpr p (f.(Flhs)) &&  bounded_pexpr p (f.(Frhs)).
+
+    Fixpoint bounded_bformula (p:positive) (bf:BFormula (Formula Z)) :=
+      match bf with
+      | TT | FF | X _ => true
+      | A f => bounded_formula p f
+      | Cj bf1 bf2
+      | D bf1 bf2
+      | I bf1 bf2 => bounded_bformula p bf1 && bounded_bformula p bf2
+      | N bf => bounded_bformula p bf
+      end.
+
+    Definition interp_vmap (vm:vmap) p :=
+      match nth_error (snd vm) (nat_of_P (fst vm - p) - 1)%nat  with
+      | Some a =>
+        let (t,v) := interp_atom a in
+        match Typ.cast t Typ.TZ with
+        | Typ.Cast k => k (Typ.interp t_i) v
+        | _ => 0%Z
+        end
+      | _ => 0%Z
+      end.
+
+    Lemma find_var_aux_lt :
+      forall h p lvm pvm,
+      find_var_aux h pvm lvm = Some p ->
+      Datatypes.length lvm = (nat_of_P pvm - 1)%nat ->
+      (nat_of_P p < nat_of_P pvm)%nat.
+    Proof.
+      induction lvm;simpl;try discriminate.
+      intros pvm Heq1 Heq.
+      assert (1 < pvm)%positive.
+       rewrite Plt_lt;change (nat_of_P 1) with 1%nat ;omega.
+      assert (Datatypes.length lvm = nat_of_P (Ppred pvm) - 1)%nat.
+       rewrite Ppred_minus, Pminus_minus;trivial.
+       change (nat_of_P 1) with 1%nat ;try omega.
+      revert Heq1.
+      destruct (Atom.reflect_eqb h a);subst.
+      intros Heq1;inversion Heq1;clear Heq1;subst;omega.
+      intros Heq1;apply IHlvm in Heq1;trivial.
+      apply lt_trans with (1:= Heq1);omega.
+    Qed.
+
+    Lemma build_pexpr_atom_aux_correct_z :
+      forall (h : atom) (vm vm' : vmap) (pe : PExpr Z),
+       check_atom h Typ.TZ ->
+       match build_z_atom h with
+       | Some z => (vm, PEc z)
+       | None => let (vm0, p) := find_var vm h in (vm0, PEX Z p)
+       end = (vm', pe) ->
+       wf_vmap vm ->
+       wf_vmap vm' /\
+       (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+       (forall p,
+           (nat_of_P p < nat_of_P (fst vm))%nat ->
+           nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+           nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+       bounded_pexpr (fst vm') pe /\
+       interp_atom h = Bval t_i Typ.TZ (Zeval_expr (interp_vmap vm') pe).
+    Proof.
+     intros h vm vm' pe Hh.
+     case_eq (build_z_atom h).
+     intros z Hb Heq;inversion Heq;clear Heq;subst.
+     intros (Hwf1, Hwf2).
+     repeat split;auto with zarith.
+     rewrite (build_z_atom_correct _ _ Hb);trivial.
+     intros _;unfold find_var;destruct vm as (pvm,lvm).
+     case_eq (find_var_aux h pvm lvm).
+     intros p Hf Heq;inversion Heq;clear Heq;subst.
+     intros (Hwf1, Hwf2);repeat split;auto with zarith.
+     simpl; unfold is_true;rewrite <- Zlt_is_lt_bool.
+     rewrite <- !Z_of_nat_of_P; apply inj_lt;simpl in Hwf1.
+     apply  find_var_aux_lt with (1:= Hf);trivial.
+     revert lvm pvm p Hf Hwf1 Hwf2.
+     unfold interp_vmap;simpl.
+     induction lvm;simpl;try discriminate.
+     intros pvm p Heq1 Heq.
+     assert (1 < pvm)%positive.
+       rewrite Plt_lt;change (nat_of_P 1) with 1%nat ;omega.
+     assert (Datatypes.length lvm = nat_of_P (Ppred pvm) - 1)%nat.
+     rewrite Ppred_minus, Pminus_minus;trivial.
+     change (nat_of_P 1) with 1%nat ;try omega.
+     revert Heq1.
+     destruct (Atom.reflect_eqb h a);subst.
+     intros Heq1;inversion Heq1;clear Heq1;subst.
+     unfold is_true;rewrite andb_true_iff;intros (H1,H2).
+     assert (1 < nat_of_P pvm)%nat by (rewrite Plt_lt in H;trivial).
+     assert (W:=nat_of_P_pos (Ppred pvm)).
+     assert (nat_of_P (pvm - Ppred pvm) - 1 = 0)%nat.
+      rewrite Pminus_minus;try omega.
+      apply Plt_lt;omega.
+     rewrite H4;simpl.
+     destruct (check_aux_interp_aux _ _ _ wf_t_atom _ _ H1) as (z,Hz).
+     rewrite Hz;trivial.
+     unfold is_true;rewrite andb_true_iff;intros Heq1 (H1,H2).
+     assert (W:= find_var_aux_lt _ _ _ _ Heq1 H0).
+     assert (nat_of_P (pvm - p) - 1 = S (nat_of_P (Ppred pvm - p) - 1))%nat.
+       assert (W1:= W);rewrite <- Plt_lt in W.
+       rewrite !Pminus_minus;trivial.
+       assert (W2:=nat_of_P_pos (Ppred pvm)).
+       omega.
+       rewrite Plt_lt.
+       apply lt_trans with (1:= W1);omega.
+     rewrite H3;simpl;apply IHlvm;trivial.
+     intros _ Heq;inversion Heq;clear Heq;subst;unfold wf_vmap;
+       simpl;intros (Hwf1, Hwf2);repeat split;simpl.
+     rewrite Psucc_S; assert (W:= nat_of_P_pos pvm);omega.
+     rewrite Hh;trivial.
+     rewrite Psucc_S;omega.
+     intros p Hlt;
+      assert (nat_of_P (Psucc pvm - p) - 1 = S (nat_of_P (pvm - p) - 1))%nat.
+       assert (W1:= Hlt);rewrite <- Plt_lt in W1.
+       rewrite !Pminus_minus;trivial.
+       rewrite Psucc_S;omega.
+       rewrite Plt_lt, Psucc_S;omega.
+     rewrite H;trivial.
+     unfold is_true;rewrite <- Zlt_is_lt_bool.
+     rewrite Zpos_succ_morphism;omega.
+     destruct (check_aux_interp_aux _ _ _ wf_t_atom _ _ Hh) as (z,Hz).
+     rewrite Hz;unfold interp_vmap;simpl.
+     assert (nat_of_P (Psucc pvm - pvm) = 1%nat).
+       rewrite Pplus_one_succ_l, Pminus_minus, Pplus_plus.
+       change (nat_of_P 1) with 1%nat;omega.
+       rewrite Plt_lt, Pplus_plus.
+       change (nat_of_P 1) with 1%nat;omega.
+     rewrite H;simpl;rewrite Hz;trivial.
+   Qed.
+
+   Lemma bounded_pexpr_le :
+     forall p p',
+       (nat_of_P p <= nat_of_P p')%nat ->
+        forall pe,
+        bounded_pexpr p pe -> bounded_pexpr p' pe.
+   Proof.
+    unfold is_true;induction pe;simpl;trivial.
+    rewrite <- !Zlt_is_lt_bool; rewrite <- Ple_le in H.
+    intros H1;apply Zlt_le_trans with (1:= H1);trivial.
+    rewrite !andb_true_iff;intros (H1,H2);auto.
+    rewrite !andb_true_iff;intros (H1,H2);auto.
+    rewrite !andb_true_iff;intros (H1,H2);auto.
+   Qed.
+
+   Lemma interp_pexpr_le :
+     forall vm vm',
+       (forall (p : positive),
+         (nat_of_P p < nat_of_P (fst vm))%nat ->
+         nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+         nth_error (snd vm') (nat_of_P (fst vm' - p) - 1)) ->
+     forall pe,
+       bounded_pexpr (fst vm) pe ->
+       Zeval_expr (interp_vmap vm) pe = Zeval_expr (interp_vmap vm') pe.
+   Proof.
+    intros vm vm' Hnth.
+    unfold is_true;induction pe;simpl;trivial.
+    unfold interp_vmap, is_true;rewrite <- Zlt_is_lt_bool.
+    intros Hlt;rewrite Hnth;trivial.
+    rewrite <- Plt_lt;trivial.
+    rewrite andb_true_iff;intros (H1,H2);rewrite IHpe1, IHpe2;trivial.
+    rewrite andb_true_iff;intros (H1,H2);rewrite IHpe1, IHpe2;trivial.
+    rewrite andb_true_iff;intros (H1,H2);rewrite IHpe1, IHpe2;trivial.
+    intros H1;rewrite IHpe;trivial.
+    intros H1;rewrite IHpe;trivial.
+   Qed.
+
+   Lemma build_pexpr_atom_aux_correct :
+      forall (build_pexpr : vmap -> hatom -> vmap * PExpr Z) h i,
+        (forall h' vm vm' pe,
+          h' < h ->
+          Typ.eqb (get_type t_i t_func t_atom h') Typ.TZ ->
+          build_pexpr vm h' = (vm',pe) ->
+          wf_vmap vm ->
+          wf_vmap vm' /\
+          (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+          (forall p,
+           (nat_of_P p < nat_of_P (fst vm))%nat ->
+           nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+           nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+          bounded_pexpr (fst vm') pe /\
+          t_interp.[h'] = Bval t_i Typ.TZ (Zeval_expr (interp_vmap vm') pe))->
+        forall a vm vm' pe,
+          h < i ->
+          lt_atom h a ->
+          check_atom a Typ.TZ ->
+          build_pexpr_atom_aux build_pexpr vm a = (vm',pe) ->
+          wf_vmap vm ->
+          wf_vmap vm' /\
+          (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+          (forall p,
+           (nat_of_P p < nat_of_P (fst vm))%nat ->
+           nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+           nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+          bounded_pexpr (fst vm') pe /\
+          interp_atom a = Bval t_i Typ.TZ (Zeval_expr (interp_vmap vm') pe).
+   Proof.
+     intros build_pexpr h i Hb a.
+Opaque build_z_atom interp_aux.
+     case a;simpl;
+       try (intros;apply build_pexpr_atom_aux_correct_z;trivial;fail).
+
+     intros u; destruct u; intros j vm vm' pe _H_ Hlt Ht;
+       try (intros;apply build_pexpr_atom_aux_correct_z;trivial;fail).
+     generalize (Hb j vm vm').
+     destruct (build_pexpr vm j) as (vm0, pe0); intro W1.
+     intros Heq Hwf;inversion Heq;clear Heq;subst.
+     assert (W:= W1 pe0 Hlt Ht (refl_equal _) Hwf).
+     decompose [and] W;clear W W1.
+     destruct H;repeat split;trivial.
+Transparent interp_aux.
+     simpl;rewrite H4;trivial.
+
+     intro b; destruct b; intros j k vm vm' pe HH Hlt Ht;
+       try (intros;apply build_pexpr_atom_aux_correct_z;trivial;fail).
+
+     generalize (Hb j vm). destruct (build_pexpr vm j) as (vm0,pe0). intro IH.
+     generalize (Hb k vm0). destruct (build_pexpr vm0 k) as (vm1,pe1). intro IH'.
+     simpl in Ht;unfold is_true in Ht;rewrite !andb_true_iff in Ht;
+       decompose [and] Ht;clear Ht.
+     unfold is_true in Hlt;rewrite andb_true_iff in Hlt;destruct Hlt as (Hlt1, Hlt2).
+     intros Heq Hwf;inversion Heq;clear Heq;subst.
+     assert (W:= IH _ _ Hlt1 H (refl_equal _) Hwf);clear IH.
+     decompose [and] W;clear W.
+     assert (W:= IH' _ _ Hlt2 H0 (refl_equal _) H1);clear IH'.
+     decompose [and] W;clear W.
+     destruct H5;repeat split;trivial.
+     apply le_trans with (1:= H3);trivial.
+     intros p Hlt;rewrite H2, H7;trivial.
+     apply lt_le_trans with (1:=Hlt);trivial.
+     simpl;rewrite H9, andb_true_r.
+     apply (bounded_pexpr_le (fst vm0));auto with arith.
+     simpl;rewrite H6, H11;simpl.
+     rewrite (interp_pexpr_le _ _ H7 _ H4);trivial.
+
+     generalize (Hb j vm). destruct (build_pexpr vm j) as (vm0,pe0); intro IH.
+     generalize (Hb k vm0). destruct (build_pexpr vm0 k) as (vm1,pe1). intro IH'.
+     simpl in Ht;unfold is_true in Ht;rewrite !andb_true_iff in Ht;
+       decompose [and] Ht;clear Ht.
+     unfold is_true in Hlt;rewrite andb_true_iff in Hlt;destruct Hlt as (Hlt1, Hlt2).
+     intros Heq Hwf;inversion Heq;clear Heq;subst.
+     assert (W:= IH _ _ Hlt1 H (refl_equal _) Hwf);clear IH.
+     decompose [and] W;clear W.
+     assert (W:= IH' _ _ Hlt2 H0 (refl_equal _) H1);clear IH'.
+     decompose [and] W;clear W.
+     destruct H5;repeat split;trivial.
+     apply le_trans with (1:= H3);trivial.
+     intros p Hlt;rewrite H2, H7;trivial.
+     apply lt_le_trans with (1:=Hlt);trivial.
+     simpl;rewrite H9, andb_true_r.
+     apply (bounded_pexpr_le (fst vm0));auto with arith.
+     simpl;rewrite H6, H11;simpl.
+     rewrite (interp_pexpr_le _ _ H7 _ H4);trivial.
+
+     generalize (Hb j vm). destruct (build_pexpr vm j) as (vm0,pe0); intro IH.
+     generalize (Hb k vm0). destruct (build_pexpr vm0 k) as (vm1,pe1). intro IH'.
+     simpl in Ht;unfold is_true in Ht;rewrite !andb_true_iff in Ht;
+       decompose [and] Ht;clear Ht.
+     unfold is_true in Hlt;rewrite andb_true_iff in Hlt;destruct Hlt as (Hlt1, Hlt2).
+     intros Heq Hwf;inversion Heq;clear Heq;subst.
+     assert (W:= IH _ _ Hlt1 H (refl_equal _) Hwf);clear IH.
+     decompose [and] W;clear W.
+     assert (W:= IH' _ _ Hlt2 H0 (refl_equal _) H1);clear IH'.
+     decompose [and] W;clear W.
+     destruct H5;repeat split;trivial.
+     apply le_trans with (1:= H3);trivial.
+     intros p Hlt;rewrite H2, H7;trivial.
+     apply lt_le_trans with (1:=Hlt);trivial.
+     simpl;rewrite H9, andb_true_r.
+     apply (bounded_pexpr_le (fst vm0));auto with arith.
+     simpl;rewrite H6, H11;simpl.
+     rewrite (interp_pexpr_le _ _ H7 _ H4);trivial.
+   Qed.
+Transparent build_z_atom.
+
+   Lemma build_pexpr_atom_aux_correct' :
+      forall (build_pexpr : vmap -> hatom -> vmap * PExpr Z),
+        (forall h' vm vm' pe,
+          Typ.eqb (get_type t_i t_func t_atom h') Typ.TZ ->
+          build_pexpr vm h' = (vm',pe) ->
+          wf_vmap vm ->
+          wf_vmap vm' /\
+          (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+          (forall p,
+           (nat_of_P p < nat_of_P (fst vm))%nat ->
+           nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+           nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+          bounded_pexpr (fst vm') pe /\
+          t_interp.[h'] = Bval t_i Typ.TZ (Zeval_expr (interp_vmap vm') pe))->
+        forall a vm vm' pe,
+          check_atom a Typ.TZ ->
+          build_pexpr_atom_aux build_pexpr vm a = (vm',pe) ->
+          wf_vmap vm ->
+          wf_vmap vm' /\
+          (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+          (forall p,
+           (nat_of_P p < nat_of_P (fst vm))%nat ->
+           nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+           nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+          bounded_pexpr (fst vm') pe /\
+          interp_atom a = Bval t_i Typ.TZ (Zeval_expr (interp_vmap vm') pe).
+   Proof.
+     intros build_pexpr Hb a.
+Opaque build_z_atom interp_aux.
+     case a;simpl;
+       try (intros;apply build_pexpr_atom_aux_correct_z;trivial;fail).
+     intro u; destruct u; intros i vm vm' pe Ht;
+       try (intros;apply build_pexpr_atom_aux_correct_z;trivial;fail).
+     generalize (Hb i vm); clear Hb.
+     destruct (build_pexpr vm i) as (vm0,pe0); intro IH.
+     intros Heq Hwf;inversion Heq;clear Heq;subst.
+     assert (W:= IH vm' pe0 Ht (refl_equal _) Hwf).
+     decompose [and] W;clear W IH.
+     destruct H;repeat split;trivial.
+Transparent interp_aux.
+     simpl;rewrite H4;trivial.
+
+     intro b; destruct b; intros j k vm vm' pe Ht;
+       try (intros;apply build_pexpr_atom_aux_correct_z;trivial;fail).
+     generalize (Hb j vm).
+     destruct (build_pexpr vm j) as (vm0,pe0); intro IH.
+     generalize (Hb k vm0); clear Hb.
+     destruct (build_pexpr vm0 k) as (vm1,pe1); intro IH'.
+     simpl in Ht;unfold is_true in Ht;rewrite !andb_true_iff in Ht;
+       decompose [and] Ht;clear Ht.
+     intros Heq Hwf;inversion Heq;clear Heq;subst.
+     assert (W:= IH _ _ H (refl_equal _) Hwf);clear IH.
+     decompose [and] W;clear W.
+     assert (W:= IH' _ _ H0 (refl_equal _) H1);clear IH'.
+     decompose [and] W;clear W.
+     destruct H5;repeat split;trivial.
+     apply le_trans with (1:= H3);trivial.
+     intros p Hlt;rewrite H2, H7;trivial.
+     apply lt_le_trans with (1:=Hlt);trivial.
+     simpl;rewrite H9, andb_true_r.
+     apply (bounded_pexpr_le (fst vm0));auto with arith.
+     simpl;rewrite H6, H11;simpl.
+     rewrite (interp_pexpr_le _ _ H7 _ H4);trivial.
+
+     generalize (Hb j vm).
+     destruct (build_pexpr vm j) as (vm0,pe0); intro IH.
+     generalize (Hb k vm0); clear Hb.
+     destruct (build_pexpr vm0 k) as (vm1,pe1); intro IH'.
+     simpl in Ht;unfold is_true in Ht;rewrite !andb_true_iff in Ht;
+       decompose [and] Ht;clear Ht.
+     intros Heq Hwf;inversion Heq;clear Heq;subst.
+     assert (W:= IH _ _ H (refl_equal _) Hwf);clear IH.
+     decompose [and] W;clear W.
+     assert (W:= IH' _ _ H0 (refl_equal _) H1);clear IH'.
+     decompose [and] W;clear W.
+     destruct H5;repeat split;trivial.
+     apply le_trans with (1:= H3);trivial.
+     intros p Hlt;rewrite H2, H7;trivial.
+     apply lt_le_trans with (1:=Hlt);trivial.
+     simpl;rewrite H9, andb_true_r.
+     apply (bounded_pexpr_le (fst vm0));auto with arith.
+     simpl;rewrite H6, H11;simpl.
+     rewrite (interp_pexpr_le _ _ H7 _ H4);trivial.
+
+     generalize (Hb j vm).
+     destruct (build_pexpr vm j) as (vm0,pe0); intro IH.
+     generalize (Hb k vm0); clear Hb.
+     destruct (build_pexpr vm0 k) as (vm1,pe1); intro IH'.
+     simpl in Ht;unfold is_true in Ht;rewrite !andb_true_iff in Ht;
+       decompose [and] Ht;clear Ht.
+     intros Heq Hwf;inversion Heq;clear Heq;subst.
+     assert (W:= IH _ _ H (refl_equal _) Hwf);clear IH.
+     decompose [and] W;clear W.
+     assert (W:= IH' _ _ H0 (refl_equal _) H1);clear IH'.
+     decompose [and] W;clear W.
+     destruct H5;repeat split;trivial.
+     apply le_trans with (1:= H3);trivial.
+     intros p Hlt;rewrite H2, H7;trivial.
+     apply lt_le_trans with (1:=Hlt);trivial.
+     simpl;rewrite H9, andb_true_r.
+     apply (bounded_pexpr_le (fst vm0));auto with arith.
+     simpl;rewrite H6, H11;simpl.
+     rewrite (interp_pexpr_le _ _ H7 _ H4);trivial.
+Qed.
+Transparent build_z_atom.
+
+   Lemma build_pexpr_correct_aux :
+        forall h vm vm' pe,
+          (to_Z h < to_Z (length t_atom))%Z ->
+          Typ.eqb (get_type t_i t_func t_atom h) Typ.TZ ->
+          build_pexpr vm h = (vm',pe) ->
+          wf_vmap vm ->
+          wf_vmap vm' /\
+          (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+          (forall p,
+           (nat_of_P p < nat_of_P (fst vm))%nat ->
+           nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+           nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+          bounded_pexpr (fst vm') pe /\
+          t_interp.[h] = Bval t_i Typ.TZ (Zeval_expr (interp_vmap vm') pe).
+   Proof.
+     unfold build_pexpr.
+     apply foldi_down_cont_ZInd.
+     intros z Hz h vm vm' pe Hh.
+     assert (W:=to_Z_bounded h);rewrite to_Z_0 in Hz.
+     elimtype False;omega.
+     intros i cont Hpos Hlen Hrec.
+     intros h vm vm' pe;unfold is_true;rewrite <-ltb_spec;intros.
+     rewrite t_interp_wf;trivial.
+     apply build_pexpr_atom_aux_correct with cont h i;trivial.
+     intros;apply Hrec;auto.
+     unfold is_true in H3;rewrite ltb_spec in H, H3;omega.
+     unfold wf, is_true in wf_t_atom.
+     rewrite forallbi_spec in wf_t_atom.
+     apply wf_t_atom.
+     rewrite ltb_spec in H;rewrite leb_spec in Hlen;rewrite ltb_spec;omega.
+     unfold wt, is_true in wt_t_atom.
+     rewrite forallbi_spec in wt_t_atom.
+     change (is_true(Typ.eqb (get_type t_i t_func t_atom h) Typ.TZ)) in H0.
+     rewrite Typ.eqb_spec in H0;rewrite <- H0.
+     apply wt_t_atom.
+     rewrite ltb_spec in H;rewrite leb_spec in Hlen;rewrite ltb_spec;omega.
+   Qed.
+
+   Lemma build_pexpr_correct :
+        forall h vm vm' pe,
+          Typ.eqb (get_type t_i t_func t_atom h) Typ.TZ ->
+          build_pexpr vm h = (vm',pe) ->
+          wf_vmap vm ->
+          wf_vmap vm' /\
+          (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+          (forall p,
+           (nat_of_P p < nat_of_P (fst vm))%nat ->
+           nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+           nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+          bounded_pexpr (fst vm') pe /\
+          t_interp.[h] = Bval t_i Typ.TZ (Zeval_expr (interp_vmap vm') pe).
+   Proof.
+     intros.
+     case_eq (h < length t_atom);intros.
+     apply build_pexpr_correct_aux;trivial.
+     rewrite <- ltb_spec;trivial.
+     revert H;unfold get_type,get_type'.
+     rewrite PArray.get_outofbound, default_t_interp.
+     revert H0.
+     unfold build_pexpr.
+     case_eq (0 < length t_atom);intros Heq.
+     rewrite foldi_down_cont_gt;trivial.
+     rewrite PArray.get_outofbound;trivial.
+     Opaque build_z_atom.
+     rewrite def_t_atom;simpl.
+     intros HH H;revert HH H1;apply build_pexpr_atom_aux_correct_z;trivial.
+     rewrite foldi_down_cont_eq;trivial.
+     rewrite PArray.get_outofbound;trivial.
+     rewrite def_t_atom;simpl.
+     intros HH H;revert HH H1;apply build_pexpr_atom_aux_correct_z;trivial.
+     rewrite <- not_true_iff_false, ltb_spec, to_Z_0 in Heq.
+     assert (W:= to_Z_bounded (length t_atom)).
+     apply to_Z_inj;rewrite to_Z_0;omega.
+     rewrite length_t_interp;trivial.
+   Qed.
+Transparent build_z_atom.
+
+   Lemma build_pexpr_atom_correct :
+      forall a vm vm' pe,
+          check_atom a Typ.TZ ->
+          build_pexpr_atom_aux build_pexpr vm a = (vm',pe) ->
+          wf_vmap vm ->
+          wf_vmap vm' /\
+          (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+          (forall p,
+           (nat_of_P p < nat_of_P (fst vm))%nat ->
+           nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+           nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+          bounded_pexpr (fst vm') pe /\
+          interp_atom a = Bval t_i Typ.TZ (Zeval_expr (interp_vmap vm') pe).
+    Proof.
+      apply build_pexpr_atom_aux_correct';apply build_pexpr_correct.
+    Qed.
+
+   Lemma build_formula_atom_correct :
+        forall a vm vm' f t,
+          check_atom a t ->
+          build_formula_atom vm a = Some (vm',f) ->
+          wf_vmap vm ->
+          wf_vmap vm' /\
+          (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+          (forall p,
+           (nat_of_P p < nat_of_P (fst vm))%nat ->
+           nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+           nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+          bounded_formula (fst vm') f /\
+          (interp_bool t_i (interp_atom a) <->Zeval_formula (interp_vmap vm') f).
+    Proof.
+      intros a vm vm' f t.
+      destruct a;simpl;try discriminate.
+      case_eq (build_op2 b);try discriminate.
+      intros o Heq Ht.
+      assert (Typ.eqb Typ.Tbool t && Typ.eqb (get_type t_i t_func t_atom i) Typ.TZ && Typ.eqb (get_type t_i t_func t_atom i0) Typ.TZ).
+        destruct b;try discriminate;trivial.
+        destruct t0;try discriminate;trivial.
+      unfold is_true in H;rewrite !andb_true_iff in H;decompose [and] H;clear H.
+      case_eq (build_pexpr vm i);intros vm0 pe1 Heq1.
+      case_eq (build_pexpr vm0 i0);intros vm1 pe2 Heq2.
+      intros H Hwf;inversion H;clear H;subst.
+      assert (W1:= build_pexpr_correct _ _ _ _ H3 Heq1 Hwf).
+      decompose [and] W1;clear W1.
+      assert (W1:= build_pexpr_correct _ _ _ _ H1 Heq2 H).
+      decompose [and] W1;clear W1.
+      split;trivial.
+      split;[ apply le_trans with (1:= H4);trivial | ].
+      split.
+       intros p Hlt;rewrite H0, H8;trivial.
+       apply lt_le_trans with (1:= Hlt);trivial.
+      split.
+       unfold bounded_formula;simpl;rewrite H10, andb_true_r.
+       apply (bounded_pexpr_le (fst vm0));auto with arith.
+      rewrite (interp_pexpr_le _ _ H8 _ H5) in H7.
+      rewrite H7,H12;destruct b;try discriminate;simpl in Heq |- *;
+      inversion Heq;clear Heq;subst;simpl.
+      symmetry;apply Zlt_is_lt_bool.
+      rewrite Zle_is_le_bool;tauto.
+      rewrite Zge_iff_le.
+        unfold Zge_bool;rewrite <- Zcompare_antisym.
+        rewrite Zle_is_le_bool;unfold Zle_bool.
+        destruct
+          (Zeval_expr (interp_vmap vm') pe2 ?= Zeval_expr (interp_vmap vm') pe1)%Z;
+          simpl;tauto.
+      symmetry;apply Zgt_is_gt_bool.
+      destruct t0;inversion H13;clear H13;subst.
+      simpl.
+      symmetry;apply (Zeq_is_eq_bool (Zeval_expr (interp_vmap vm') pe1) (Zeval_expr (interp_vmap vm') pe2)).
+    Qed.
+
+    Lemma build_formula_correct :
+       forall h' vm vm' f,
+          build_formula vm h' = Some (vm',f) ->
+          wf_vmap vm ->
+          wf_vmap vm' /\
+          (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+          (forall p,
+           (nat_of_P p < nat_of_P (fst vm))%nat ->
+           nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+           nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+          bounded_formula (fst vm') f /\
+          (interp_form_hatom h' <-> Zeval_formula (interp_vmap vm') f).
+    Proof.
+      unfold build_formula;intros h.
+      unfold Atom.interp_form_hatom, Atom.interp_hatom.
+      rewrite t_interp_wf;trivial.
+      intros;apply build_formula_atom_correct with
+        (get_type t_i t_func t_atom h);trivial.
+      unfold wt, is_true in wt_t_atom;rewrite forallbi_spec in wt_t_atom.
+      case_eq (h < length t_atom);intros Heq;unfold get_type;auto.
+      unfold get_type'.
+      rewrite !PArray.get_outofbound, default_t_interp, def_t_atom;trivial; try reflexivity.
+      rewrite length_t_interp;trivial.
+    Qed.
+
+
+    Lemma build_not2_pos_correct : forall vm f l i,
+      bounded_bformula (fst vm) f -> (rho (Lit.blit l) <-> eval_f (Zeval_formula (interp_vmap vm)) f) -> Lit.is_pos l -> bounded_bformula (fst vm) (build_not2 i f) /\ (Form.interp interp_form_hatom t_form (Form.Fnot2 i l) <-> eval_f (Zeval_formula (interp_vmap vm)) (build_not2 i f)).
+    Proof.
+      simpl; intros vm f l i H1 H2 H3; split; unfold build_not2.
+      apply fold_ind; auto.
+      apply (fold_ind2 _ _ (fun b f' => b = true <-> eval_f (Zeval_formula (interp_vmap vm)) f')).
+      unfold Lit.interp; rewrite H3; auto.
+      intros b f' H4; rewrite negb_involutive; simpl; split.
+      intros Hb H5; apply H5; rewrite <- H4; auto.
+      intro H5; case_eq b; auto; intro H6; elim H5; intro H7; rewrite <- H4 in H7; rewrite H7 in H6; discriminate.
+    Qed.
+
+
+    Lemma build_not2_neg_correct : forall vm f l i,
+      bounded_bformula (fst vm) f -> (rho (Lit.blit l) <-> eval_f (Zeval_formula (interp_vmap vm)) f) -> Lit.is_pos l = false -> bounded_bformula (fst vm) (N (build_not2 i f)) /\ (Form.interp interp_form_hatom t_form (Form.Fnot2 i l) <-> eval_f (Zeval_formula (interp_vmap vm)) (N (build_not2 i f))).
+    Proof.
+      simpl; intros vm f l i H1 H2 H3; split; unfold build_not2.
+      apply fold_ind; auto.
+      apply (fold_ind2 _ _ (fun b f' => b = true <-> ~ eval_f (Zeval_formula (interp_vmap vm)) f')).
+      unfold Lit.interp; rewrite H3; unfold Var.interp; split.
+      intros H4 H5; rewrite <- H2 in H5; rewrite H5 in H4; discriminate.
+      intro H4; case_eq (rho (Lit.blit l)); auto; intro H5; elim H4; rewrite <- H2; auto.
+      intros b f' H4; rewrite negb_involutive; simpl; split.
+      intros Hb H5; apply H5; rewrite <- H4; auto.
+      intro H5; case_eq b; auto; intro H6; elim H5; intro H7; rewrite <- H4 in H7; rewrite H7 in H6; discriminate.
+    Qed.
+
+
+    Lemma bounded_bformula_le :
+     forall p p',
+       (nat_of_P p <= nat_of_P p')%nat ->
+        forall bf,
+        bounded_bformula p bf -> bounded_bformula p' bf.
+    Proof.
+      unfold is_true;induction bf;simpl;trivial.
+      destruct a;unfold bounded_formula;simpl.
+      rewrite andb_true_iff;intros (H1, H2).
+      rewrite (bounded_pexpr_le _ _ H _ H1), (bounded_pexpr_le _ _ H _ H2);trivial.
+      rewrite !andb_true_iff;intros (H1, H2);auto.
+      rewrite !andb_true_iff;intros (H1, H2);auto.
+      rewrite !andb_true_iff;intros (H1, H2);auto.
+    Qed.
+
+    Lemma interp_bformula_le :
+     forall vm vm',
+       (forall (p : positive),
+         (nat_of_P p < nat_of_P (fst vm))%nat ->
+         nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+         nth_error (snd vm') (nat_of_P (fst vm' - p) - 1)) ->
+     forall bf,
+       bounded_bformula (fst vm) bf ->
+       (eval_f (Zeval_formula (interp_vmap vm)) bf <->
+       eval_f (Zeval_formula (interp_vmap vm')) bf).
+    Proof.
+      intros vm vm' Hnth.
+      unfold is_true;induction bf;simpl;try tauto.
+      destruct a;unfold bounded_formula;simpl.
+      rewrite andb_true_iff;intros (H1, H2).
+      rewrite !(interp_pexpr_le _ _ Hnth);tauto.
+      rewrite andb_true_iff;intros (H1,H2);rewrite IHbf1, IHbf2;tauto.
+      rewrite andb_true_iff;intros (H1,H2);rewrite IHbf1, IHbf2;tauto.
+      rewrite andb_true_iff;intros (H1,H2);rewrite IHbf1, IHbf2;tauto.
+    Qed.
+
+
+    Lemma build_hform_correct :
+      forall (build_var : vmap -> var -> option (vmap*BFormula (Formula Z))),
+        (forall v vm vm' bf,
+          build_var vm v = Some (vm', bf) ->
+          wf_vmap vm ->
+          wf_vmap vm' /\
+          (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+          (forall p,
+            (nat_of_P p < nat_of_P (fst vm))%nat ->
+            nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+            nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+          bounded_bformula (fst vm') bf /\
+          (Var.interp rho v <-> eval_f (Zeval_formula (interp_vmap vm')) bf)) ->
+        forall f vm vm' bf,
+          build_hform build_var vm f = Some (vm', bf) ->
+          wf_vmap vm ->
+          wf_vmap vm' /\
+          (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+          (forall p,
+            (nat_of_P p < nat_of_P (fst vm))%nat ->
+            nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+            nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+          bounded_bformula (fst vm') bf /\
+          (Form.interp interp_form_hatom t_form f <-> eval_f (Zeval_formula (interp_vmap vm')) bf).
+    Proof.
+      unfold build_hform; intros build_var Hbv [h| | |i l|l|l|l|a b|a b|a b c] vm vm' bf; try discriminate.
+      (* Fatom *)
+      case_eq (build_formula vm h); try discriminate; intros [vm0 f] Heq H1 H2; inversion H1; subst vm0; subst bf; apply build_formula_correct; auto.
+      (* Ftrue *)
+      intros H H1; inversion H; subst vm'; subst bf; split; auto; split; [omega| ]; do 4 split; auto.
+      (* Ffalse *)
+      intros H H1; inversion H; subst vm'; subst bf; split; auto; split; [omega| ]; do 3 (split; auto); discriminate.
+      (* Fnot2 *)
+      case_eq (build_var vm (Lit.blit l)); try discriminate; intros [vm0 f] Heq H H1; inversion H; subst vm0; subst bf; destruct (Hbv _ _ _ _ Heq H1) as [H2 [H3 [H4 [H5 H6]]]]; do 3 (split; auto); case_eq (Lit.is_pos l); [apply build_not2_pos_correct|apply build_not2_neg_correct]; auto.
+      (* Fand *)
+      simpl; unfold afold_left; case (length l == 0).
+      intro H; inversion H; subst vm'; subst bf; simpl; intro H1; split; auto; split; [omega| ]; do 3 (split; auto).
+      revert vm' bf; apply (foldi_ind2 _ _ (fun f1 b => forall vm' bf, f1 = Some (vm', bf) -> wf_vmap vm -> wf_vmap vm' /\ (Pos.to_nat (fst vm) <= Pos.to_nat (fst vm'))%nat /\ (forall p : positive, (Pos.to_nat p < Pos.to_nat (fst vm))%nat -> nth_error (snd vm) (Pos.to_nat (fst vm - p) - 1) = nth_error (snd vm') (Pos.to_nat (fst vm' - p) - 1)) /\ bounded_bformula (fst vm') bf /\ (b = true <-> eval_f (Zeval_formula (interp_vmap vm')) bf))).
+      intros vm' bf; case_eq (build_var vm (Lit.blit (l .[ 0]))); try discriminate; intros [vm0 f] Heq; case_eq (Lit.is_pos (l .[ 0])); intros Heq2 H1 H2; inversion H1; subst vm'; subst bf; destruct (Hbv _ _ _ _ Heq H2) as [H10 [H11 [H12 [H13 H14]]]]; do 4 (split; auto); unfold Lit.interp; rewrite Heq2; auto; simpl; split.
+      intros H3 H4; rewrite <- H14 in H4; rewrite H4 in H3; discriminate.
+      intro H3; case_eq (Var.interp rho (Lit.blit (l .[ 0]))); auto; intro H4; elim H3; rewrite <- H14; auto.
+      intros i a b _ H1; case a; try discriminate; intros [vm0 f0] IH vm' bf; case_eq (build_var vm0 (Lit.blit (l .[ i]))); try discriminate; intros [vm1 f1] Heq H2 H3; inversion H2; subst vm'; subst bf; destruct (IH _ _ (refl_equal (Some (vm0, f0))) H3) as [H5 [H6 [H7 [H8 H9]]]]; destruct (Hbv _ _ _ _ Heq H5) as [H10 [H11 [H12 [H13 H14]]]]; split; auto; split; [eauto with arith| ]; split.
+      intros p H15; rewrite H7; auto; apply H12; eauto with arith.
+      split.
+      simpl; rewrite (bounded_bformula_le _ _ H11 _ H8); case (Lit.is_pos (l .[ i])); rewrite H13; auto.
+      simpl; rewrite (interp_bformula_le _ _ H12 _ H8) in H9; rewrite <- H9; case_eq (Lit.is_pos (l .[ i])); intro Heq2; simpl; rewrite <- H14; unfold Lit.interp; rewrite Heq2; split; case (Var.interp rho (Lit.blit (l .[ i]))); try rewrite andb_true_r; try rewrite andb_false_r; try (intros; split; auto); try discriminate; intros [H20 H21]; auto.
+      (* For *)
+      simpl; unfold afold_left; case (length l == 0).
+      intro H; inversion H; subst vm'; subst bf; simpl; intro H1; split; auto; split; [omega| ]; do 3 (split; auto); discriminate.
+      revert vm' bf; apply (foldi_ind2 _ _ (fun f1 b => forall vm' bf, f1 = Some (vm', bf) -> wf_vmap vm -> wf_vmap vm' /\ (Pos.to_nat (fst vm) <= Pos.to_nat (fst vm'))%nat /\ (forall p : positive, (Pos.to_nat p < Pos.to_nat (fst vm))%nat -> nth_error (snd vm) (Pos.to_nat (fst vm - p) - 1) = nth_error (snd vm') (Pos.to_nat (fst vm' - p) - 1)) /\ bounded_bformula (fst vm') bf /\ (b = true <-> eval_f (Zeval_formula (interp_vmap vm')) bf))).
+      intros vm' bf; case_eq (build_var vm (Lit.blit (l .[ 0]))); try discriminate; intros [vm0 f] Heq; case_eq (Lit.is_pos (l .[ 0])); intros Heq2 H1 H2; inversion H1; subst vm'; subst bf; destruct (Hbv _ _ _ _ Heq H2) as [H10 [H11 [H12 [H13 H14]]]]; do 4 (split; auto); unfold Lit.interp; rewrite Heq2; auto; simpl; split.
+      intros H3 H4; rewrite <- H14 in H4; rewrite H4 in H3; discriminate.
+      intro H3; case_eq (Var.interp rho (Lit.blit (l .[ 0]))); auto; intro H4; elim H3; rewrite <- H14; auto.
+      intros i a b _ H1; case a; try discriminate; intros [vm0 f0] IH vm' bf; case_eq (build_var vm0 (Lit.blit (l .[ i]))); try discriminate; intros [vm1 f1] Heq H2 H3; inversion H2; subst vm'; subst bf; destruct (IH _ _ (refl_equal (Some (vm0, f0))) H3) as [H5 [H6 [H7 [H8 H9]]]]; destruct (Hbv _ _ _ _ Heq H5) as [H10 [H11 [H12 [H13 H14]]]]; split; auto; split; [eauto with arith| ]; split.
+      intros p H15; rewrite H7; auto; apply H12; eauto with arith.
+      split.
+      simpl; rewrite (bounded_bformula_le _ _ H11 _ H8); case (Lit.is_pos (l .[ i])); rewrite H13; auto.
+      simpl; rewrite (interp_bformula_le _ _ H12 _ H8) in H9; rewrite <- H9; case_eq (Lit.is_pos (l .[ i])); intro Heq2; simpl; rewrite <- H14; unfold Lit.interp; rewrite Heq2; split; case (Var.interp rho (Lit.blit (l .[ i]))); try rewrite orb_false_r; try rewrite orb_true_r; auto; try (intros [H20|H20]; auto; discriminate); right; intro H20; discriminate.
+      (* Fimp *)
+      simpl; unfold afold_right; case (length l == 0).
+      intro H; inversion H; subst vm'; subst bf; simpl; intro H1; split; auto; split; [omega| ]; do 3 (split; auto).
+      case (length l <= 1).
+      case_eq (build_var vm (Lit.blit (l .[ 0]))); try discriminate; intros [vm0 f] Heq; case_eq (Lit.is_pos (l .[ 0])); intros Heq2 H1 H2; inversion H1; subst vm'; subst bf; destruct (Hbv _ _ _ _ Heq H2) as [H3 [H4 [H5 [H6 H7]]]]; do 4 (split; auto); unfold Lit.interp; rewrite Heq2; auto; simpl; split.
+      intros H8 H9; rewrite <- H7 in H9; rewrite H9 in H8; discriminate.
+      intro H8; case_eq (Var.interp rho (Lit.blit (l .[ 0]))); auto; intro H9; rewrite H7 in H9; elim H8; auto.
+      revert vm' bf; apply (foldi_down_ind2 _ _ (fun f1 b => forall vm' bf, f1 = Some (vm', bf) -> wf_vmap vm -> wf_vmap vm' /\ (Pos.to_nat (fst vm) <= Pos.to_nat (fst vm'))%nat /\ (forall p : positive, (Pos.to_nat p < Pos.to_nat (fst vm))%nat -> nth_error (snd vm) (Pos.to_nat (fst vm - p) - 1) = nth_error (snd vm') (Pos.to_nat (fst vm' - p) - 1)) /\ bounded_bformula (fst vm') bf /\ (b = true <-> eval_f (Zeval_formula (interp_vmap vm')) bf))).
+      intros vm' bf; case_eq (build_var vm (Lit.blit (l .[ length l - 1]))); try discriminate; intros [vm0 f] Heq; case_eq (Lit.is_pos (l .[ length l - 1])); intros Heq2 H1 H2; inversion H1; subst vm'; subst bf; destruct (Hbv _ _ _ _ Heq H2) as [H10 [H11 [H12 [H13 H14]]]]; do 4 (split; auto); unfold Lit.interp; rewrite Heq2; auto; simpl; split.
+      intros H3 H4; rewrite <- H14 in H4; rewrite H4 in H3; discriminate.
+      intro H3; case_eq (Var.interp rho (Lit.blit (l .[ length l - 1]))); auto; intro H4; elim H3; rewrite <- H14; auto.
+      intros i a b _ H1; case a; try discriminate; intros [vm0 f0] IH vm' bf; case_eq (build_var vm0 (Lit.blit (l .[ i]))); try discriminate; intros [vm1 f1] Heq H2 H3; inversion H2; subst vm'; subst bf; destruct (IH _ _ (refl_equal (Some (vm0, f0))) H3) as [H5 [H6 [H7 [H8 H9]]]]; destruct (Hbv _ _ _ _ Heq H5) as [H10 [H11 [H12 [H13 H14]]]]; split; auto; split; [eauto with arith| ]; split.
+      intros p H15; rewrite H7; auto; apply H12; eauto with arith.
+      split.
+      simpl; rewrite (bounded_bformula_le _ _ H11 _ H8); case (Lit.is_pos (l .[ i])); rewrite H13; auto.
+      simpl; rewrite (interp_bformula_le _ _ H12 _ H8) in H9; rewrite <- H9; case_eq (Lit.is_pos (l .[ i])); intro Heq2; simpl; rewrite <- H14; unfold Lit.interp; rewrite Heq2; split; case (Var.interp rho (Lit.blit (l .[ i]))); auto; try discriminate; simpl; intro H; apply H; discriminate.
+      (* Fxor *)
+      simpl; case_eq (build_var vm (Lit.blit a)); try discriminate; intros [vm1 f1] Heq1; case_eq (build_var vm1 (Lit.blit b)); try discriminate; intros [vm2 f2] Heq2 H1 H2; inversion H1; subst vm'; subst bf; destruct (Hbv _ _ _ _ Heq1 H2) as [H3 [H4 [H5 [H6 H7]]]]; destruct (Hbv _ _ _ _ Heq2 H3) as [H8 [H9 [H10 [H11 H12]]]]; split; auto; split; [eauto with arith| ]; split.
+      intros p H18; rewrite H5; auto; rewrite H10; eauto with arith.
+      split.
+      case (Lit.is_pos a); case (Lit.is_pos b); simpl; rewrite H11; rewrite (bounded_bformula_le _ _ H9 _ H6); auto.
+      simpl; rewrite (interp_bformula_le _ _ H10 _ H6) in H7; case_eq (Lit.is_pos a); intro Ha; case_eq (Lit.is_pos b); intro Hb; unfold Lit.interp; rewrite Ha, Hb; simpl; rewrite <- H12; rewrite <- H7; (case (Var.interp rho (Lit.blit a)); case (Var.interp rho (Lit.blit b))); split; auto; try discriminate; simpl.
+      intros [_ [H20|H20]]; elim H20; reflexivity.
+      intros _; split; [left; reflexivity|right; intro H20; discriminate].
+      intros _; split; [right; reflexivity|left; intro H20; discriminate].
+      intros [[H20|H20] _]; discriminate.
+      intros [_ [H20|H20]]; elim H20; [reflexivity|discriminate].
+      intros [[H20|H20] _]; [discriminate|elim H20; reflexivity].
+      intros _; split; [right|left]; discriminate.
+      intros [[H20|H20] _]; [elim H20; reflexivity|discriminate].
+      intros [_ [H20|H20]]; elim H20; [discriminate|reflexivity].
+      intros _; split; [left|right]; discriminate.
+      intros [[H20|H20] _]; elim H20; reflexivity.
+      intros _; split; [right; discriminate|left; intro H21; apply H21; reflexivity].
+      intros _; split; [left; discriminate|right; intro H21; apply H21; reflexivity].
+      intros [_ [H20|H20]]; elim H20; discriminate.
+      (* Fiff *)
+      simpl; case_eq (build_var vm (Lit.blit a)); try discriminate; intros [vm1 f1] Heq1; case_eq (build_var vm1 (Lit.blit b)); try discriminate; intros [vm2 f2] Heq2 H1 H2; inversion H1; subst vm'; subst bf; destruct (Hbv _ _ _ _ Heq1 H2) as [H3 [H4 [H5 [H6 H7]]]]; destruct (Hbv _ _ _ _ Heq2 H3) as [H8 [H9 [H10 [H11 H12]]]]; split; auto; split; [eauto with arith| ]; split.
+      intros p H18; rewrite H5; auto; rewrite H10; eauto with arith.
+      split.
+      case (Lit.is_pos a); case (Lit.is_pos b); simpl; rewrite H11; rewrite (bounded_bformula_le _ _ H9 _ H6); auto.
+      simpl; rewrite (interp_bformula_le _ _ H10 _ H6) in H7; case_eq (Lit.is_pos a); intro Ha; case_eq (Lit.is_pos b); intro Hb; unfold Lit.interp; rewrite Ha, Hb; simpl; rewrite <- H12; rewrite <- H7; (case (Var.interp rho (Lit.blit a)); case (Var.interp rho (Lit.blit b))); split; auto; try discriminate; simpl.
+      intros [_ [H20|H20]]; [elim H20; reflexivity|discriminate].
+      intros [[H20|H20] _]; [discriminate|elim H20; reflexivity].
+      intros _; split; [right|left]; discriminate.
+      intros [_ [H20|H20]]; elim H20; reflexivity.
+      intros _; split; [left; reflexivity|right; discriminate].
+      intros _; split; [right; intro H20; apply H20; reflexivity|left; discriminate].
+      intros [[H20|H20] _]; [ |elim H20]; discriminate.
+      intros [[H20|H20] _]; elim H20; reflexivity.
+      intros _; split; [right; discriminate|left; intro H20; apply H20; reflexivity].
+      intros _; split; [left; discriminate|right; reflexivity].
+      intros [_ [H20|H20]]; [elim H20| ]; discriminate.
+      intros [[H20|H20] _]; elim H20; [reflexivity|discriminate].
+      intros [_ [H20|H20]]; elim H20; [discriminate|reflexivity].
+      intros _; split; [left|right]; discriminate.
+      (* Fite *)
+      simpl; case_eq (build_var vm (Lit.blit a)); try discriminate; intros [vm1 f1] Heq1; case_eq (build_var vm1 (Lit.blit b)); try discriminate; intros [vm2 f2] Heq2; case_eq (build_var vm2 (Lit.blit c)); try discriminate; intros [vm3 f3] Heq3 H1 H2; inversion H1; subst vm'; subst bf; destruct (Hbv _ _ _ _ Heq1 H2) as [H3 [H4 [H5 [H6 H7]]]]; destruct (Hbv _ _ _ _ Heq2 H3) as [H8 [H9 [H10 [H11 H12]]]]; destruct (Hbv _ _ _ _ Heq3 H8) as [H13 [H14 [H15 [H16 H17]]]]; split; auto; split; [eauto with arith| ]; split.
+      intros p H18; rewrite H5; auto; rewrite H10; eauto with arith.
+      assert (H18: (Pos.to_nat (fst vm1) <= Pos.to_nat (fst vm3))%nat) by eauto with arith.
+      split.
+      case (Lit.is_pos a); case (Lit.is_pos b); case (Lit.is_pos c); simpl; rewrite H16; rewrite (bounded_bformula_le _ _ H14 _ H11); rewrite (bounded_bformula_le _ _ H18 _ H6); auto.
+      simpl; rewrite (interp_bformula_le _ _ H15 _ H11) in H12; rewrite (interp_bformula_le _ vm3) in H7; [ |intros p Hp; rewrite H10; eauto with arith|auto]; case_eq (Lit.is_pos a); intro Ha; case_eq (Lit.is_pos b); intro Hb; case_eq (Lit.is_pos c); intro Hc; unfold Lit.interp; rewrite Ha, Hb, Hc; simpl; rewrite <- H17; rewrite <- H12; rewrite <- H7; (case (Var.interp rho (Lit.blit a)); [case (Var.interp rho (Lit.blit b))|case (Var.interp rho (Lit.blit c))]); split; auto; try discriminate; try (intros [[H20 H21]|[H20 H21]]; auto); try (intros _; left; split; auto; discriminate); try (intros _; right; split; auto; discriminate); try (elim H20; discriminate); try (elim H21; discriminate); try (simpl; intro H; left; split; auto; discriminate); try (revert H; case (Var.interp rho (Lit.blit c)); discriminate); try (revert H; case (Var.interp rho (Lit.blit b)); discriminate); try (intro H20; rewrite H20 in H; discriminate); simpl.
+      intro H; right; split; auto.
+      intro H; right; split; auto.
+      intro H; right; split; auto.
+      intro H20; rewrite H20 in H; discriminate.
+      revert H21; case (Var.interp rho (Lit.blit c)); auto.
+      right; split; auto; intro H20; rewrite H20 in H; discriminate.
+      revert H21; case (Var.interp rho (Lit.blit c)); auto.
+      intro H; right; split; auto.
+      intro H; right; split; auto.
+      intro H; left; split; try discriminate; revert H; case (Var.interp rho (Lit.blit b)); discriminate.
+      revert H21; case (Var.interp rho (Lit.blit b)); auto.
+      intro H; left; split; try discriminate; revert H; case (Var.interp rho (Lit.blit b)); discriminate.
+      revert H21; case (Var.interp rho (Lit.blit b)); auto.
+      intro H; right; split; auto; revert H; case (Var.interp rho (Lit.blit c)); discriminate.
+      revert H21; case (Var.interp rho (Lit.blit c)); auto.
+      intro H; right; split; auto; revert H; case (Var.interp rho (Lit.blit c)); discriminate.
+      revert H21; case (Var.interp rho (Lit.blit c)); auto.
+      intro H; left; split; auto; revert H; case (Var.interp rho (Lit.blit b)); discriminate.
+      revert H21; case (Var.interp rho (Lit.blit b)); auto.
+      intro H; left; split; auto; revert H; case (Var.interp rho (Lit.blit b)); discriminate.
+      revert H21; case (Var.interp rho (Lit.blit b)); auto.
+    Qed.
+
+
+    Lemma build_var_correct : forall v vm vm' bf,
+      build_var vm v = Some (vm', bf) ->
+      wf_vmap vm ->
+      wf_vmap vm' /\
+      (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+      (forall p,
+        (nat_of_P p < nat_of_P (fst vm))%nat ->
+        nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+        nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+      bounded_bformula (fst vm') bf /\
+      (Var.interp rho v <-> eval_f (Zeval_formula (interp_vmap vm')) bf).
+    Proof.
+      unfold build_var; apply foldi_down_cont_ind; try discriminate.
+      intros i cont _ Hlen Hrec v vm vm' bf; unfold is_true; intros H1 H2; replace (Var.interp rho v) with (Form.interp interp_form_hatom t_form (t_form.[v])).
+      apply (build_hform_correct cont); auto.
+      unfold Var.interp; rewrite <- wf_interp_form; auto.
+    Qed.
+
+
+    Lemma build_form_correct : forall f vm vm' bf,
+      build_form vm f = Some (vm', bf) ->
+      wf_vmap vm ->
+      wf_vmap vm' /\
+      (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+      (forall p,
+        (nat_of_P p < nat_of_P (fst vm))%nat ->
+        nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+        nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+      bounded_bformula (fst vm') bf /\
+      (Form.interp interp_form_hatom t_form f <-> eval_f (Zeval_formula (interp_vmap vm')) bf).
+    Proof. apply build_hform_correct; apply build_var_correct. Qed.
+
+
+    Lemma build_nlit_correct : forall l vm vm' bf,
+       build_nlit vm l = Some (vm', bf) ->
+       wf_vmap vm ->
+       wf_vmap vm' /\
+       (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+       (forall p,
+           (nat_of_P p < nat_of_P (fst vm))%nat ->
+           nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+           nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+       bounded_bformula (fst vm') bf /\
+       (negb (Lit.interp rho l) <-> eval_f (Zeval_formula (interp_vmap vm')) bf).
+    Proof.
+      unfold build_nlit; intros l vm vm' bf; case_eq (build_form vm (t_form .[ Lit.blit (Lit.neg l)])); try discriminate.
+      intros [vm1 f] Heq H1 H2; inversion H1; subst vm1; subst bf; case_eq (Lit.is_pos (Lit.neg l)); intro Heq2.
+      replace (negb (Lit.interp rho l)) with (Form.interp interp_form_hatom t_form (t_form .[ Lit.blit (Lit.neg l)])).
+      apply build_form_correct; auto.
+      unfold Lit.interp; replace (Lit.is_pos l) with false.
+      rewrite negb_involutive; unfold Var.interp; rewrite <- wf_interp_form; auto; rewrite Lit.blit_neg; auto.
+      rewrite Lit.is_pos_neg in Heq2; case_eq (Lit.is_pos l); auto; intro H; rewrite H in Heq2; discriminate.
+      simpl; destruct (build_form_correct (t_form .[ Lit.blit (Lit.neg l)]) vm vm' f Heq H2) as [H3 [H4 [H5 [H6 [H7 H8]]]]]; do 4 (split; auto); split.
+      intros H9 H10; pose (H11 := H8 H10); unfold Lit.interp in H9; replace (Lit.is_pos l) with true in H9.
+      unfold Var.interp in H9; rewrite <- wf_interp_form in H11; auto; rewrite Lit.blit_neg in H11; rewrite H11 in H9; discriminate.
+       rewrite Lit.is_pos_neg in Heq2; case_eq (Lit.is_pos l); auto; intro H; rewrite H in Heq2; discriminate.
+       intro H9; case_eq (Lit.interp rho l); intro Heq3; auto; elim H9; apply H7; unfold Lit.interp in Heq3; replace (Lit.is_pos l) with true in Heq3.
+       unfold Var.interp in Heq3; rewrite <- wf_interp_form; auto; rewrite Lit.blit_neg; auto.
+       rewrite Lit.is_pos_neg in Heq2; case_eq (Lit.is_pos l); auto; intro H; rewrite H in Heq2; discriminate.
+    Qed.
+
+
+    Lemma build_clause_aux_correct :
+        forall cl vm vm' bf,
+          build_clause_aux vm cl = Some (vm',bf) ->
+          wf_vmap vm ->
+          wf_vmap vm' /\
+          (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+          (forall p,
+            (nat_of_P p < nat_of_P (fst vm))%nat ->
+            nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+            nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+          bounded_bformula (fst vm') bf /\
+          (negb (C.interp rho cl) <-> eval_f (Zeval_formula (interp_vmap vm')) bf).
+    Proof.
+      induction cl;try discriminate.
+      case_eq cl.
+      intros _; simpl;intros;rewrite orb_false_r;apply build_nlit_correct;trivial.
+      intros i l Heq vm vm' bf;rewrite <- Heq at 2.
+      change (build_clause_aux vm (a :: i :: l) ) with
+        ( match build_nlit vm a with
+          | Some (vm0, bf1) =>
+          match build_clause_aux vm0 (i::l) with
+          | Some (vm1, bf2) => Some (vm1, Cj bf1 bf2)
+          | None => None
+          end
+         | None => None
+         end).
+      case_eq (build_nlit vm a);try discriminate.
+      intros (vm0, bf1) Heq1 Heq2 Hwf.
+      rewrite <- Heq in Heq2.
+      assert (W:= build_nlit_correct _ _ _ _ Heq1 Hwf).
+      decompose [and] W;clear W.
+      revert Heq2; case_eq (build_clause_aux vm0 cl);try discriminate.
+      intros (vm1, fb2) Heq2 W;inversion W;clear W Heq;subst.
+      assert (W:= IHcl _ _ _ Heq2 H);decompose [and] W;clear W.
+      split;trivial.
+      split.
+       apply le_trans with (1:= H1);trivial.
+      split.
+        intros p Hlt;rewrite H0, H5;trivial.
+        apply lt_le_trans with (1:= Hlt);trivial.
+      split.
+       simpl;rewrite H7, andb_true_r.
+       apply bounded_bformula_le with (2:= H2);trivial.
+      simpl.
+       unfold is_true;
+       rewrite <- (interp_bformula_le _ _ H5), <- H4, <- H9, negb_orb,andb_true_iff;
+       tauto.
+    Qed.
+
+   Lemma  build_clause_correct :
+        forall cl vm vm' bf,
+          build_clause vm cl = Some (vm',bf) ->
+          wf_vmap vm ->
+          wf_vmap vm' /\
+          (nat_of_P (fst vm) <= nat_of_P (fst vm'))%nat /\
+          (forall p,
+            (nat_of_P p < nat_of_P (fst vm))%nat ->
+            nth_error (snd vm) (nat_of_P (fst vm - p) - 1) =
+            nth_error (snd vm')(nat_of_P (fst vm' - p) - 1)) /\
+          bounded_bformula (fst vm') bf /\
+          (C.interp rho cl <-> eval_f (Zeval_formula (interp_vmap vm')) bf).
+   Proof.
+    unfold build_clause;intros cl vm vm' bf.
+    case_eq (build_clause_aux vm cl);try discriminate.
+    intros (vm1, bf1) Heq W Hwf;inversion W;clear W;subst.
+    assert (W:= build_clause_aux_correct _ _ _ _ Heq Hwf).
+    decompose [and] W;clear W.
+    repeat (split;[trivial;fail | ]).
+    split;simpl.
+    rewrite H2;reflexivity.
+    unfold is_true in *;
+       destruct (C.interp rho cl);split;simpl;trivial;try discriminate;
+    try tauto.
+    intros _ HH;destruct H4.
+    apply H4 in HH;discriminate.
+   Qed.
+
+   Local Notation hinterp := (Atom.interp_hatom t_i t_func t_atom).
+   Local Notation interp := (Atom.interp t_i t_func t_atom).
+
+   Lemma get_eq_interp :
+     forall (l:_lit) (f:Atom.hatom -> Atom.hatom -> C.t),
+       (forall xa, t_form.[Lit.blit l] = Form.Fatom xa ->
+         forall t a b, t_atom.[xa] = Atom.Abop (Atom.BO_eq t) a b ->
+           Lit.is_pos l ->
+           rho (Lit.blit l) =
+           Atom.interp_bool t_i
+           (Atom.apply_binop t_i t t Typ.Tbool (Typ.i_eqb t_i t)
+             (hinterp a) (hinterp b)) ->
+           Typ.eqb (get_type t_i t_func t_atom a) t -> Typ.eqb (get_type t_i t_func t_atom b) t ->
+           C.interp rho (f a b)) ->
+       C.interp rho (get_eq l f).
+   Proof.
+     intros l f Hf;unfold get_eq.
+     destruct (Lit.is_pos l); case_eq (t_form.[Lit.blit l]);trivial;intros;
+     try(case_eq (t_atom.[i]);trivial;intros); try (apply valid_C_true; trivial).
+     destruct b; try (apply valid_C_true; trivial).
+     generalize wt_t_atom;unfold Atom.wt;unfold is_true;
+       rewrite PArray.forallbi_spec;intros.
+     assert (i < length t_atom).
+     apply PArray.get_not_default_lt.
+     rewrite H0, def_t_atom;discriminate.
+     apply H1 in H2;clear H1;rewrite H0 in H2;simpl in H2.
+     rewrite !andb_true_iff in H2;decompose [and] H2;clear H2.
+     apply Hf with (2:= H0);trivial. auto.
+     rewrite wf_interp_form, H;simpl.
+     unfold Atom.interp_form_hatom, Atom.interp_hatom at 1;simpl.
+     rewrite Atom.t_interp_wf, H0;simpl;trivial.
+     trivial.
+   Qed.
+
+   Lemma get_not_le_interp :
+     forall (l:_lit) (f:Atom.hatom -> Atom.hatom -> C.t),
+       (forall xa, t_form.[Lit.blit l] = Form.Fatom xa ->
+         forall a b, t_atom.[xa] = Atom.Abop Atom.BO_Zle a b ->
+           negb (Lit.is_pos l) ->
+           rho (Lit.blit l) =
+           Atom.interp_bool t_i
+           (Atom.apply_binop t_i Typ.TZ Typ.TZ Typ.Tbool Zle_bool
+             (hinterp a) (hinterp b)) ->
+           Typ.eqb (get_type t_i t_func t_atom a) Typ.TZ -> Typ.eqb (get_type t_i t_func t_atom b) Typ.TZ ->
+           C.interp rho (f a b)) ->
+       C.interp rho (get_not_le l f).
+   Proof.
+     intros l f Hf;unfold get_not_le.
+     destruct (Lit.is_pos l); case_eq (t_form.[Lit.blit l]);trivial;intros;
+     try(case_eq (t_atom.[i]);trivial;intros); try (apply valid_C_true; trivial).
+     destruct b; try (apply valid_C_true; trivial).
+     generalize wt_t_atom;unfold Atom.wt;unfold is_true;
+       rewrite PArray.forallbi_spec;intros.
+     assert (i < length t_atom).
+     apply PArray.get_not_default_lt.
+     rewrite H0, def_t_atom;discriminate.
+     apply H1 in H2;clear H1;rewrite H0 in H2;simpl in H2.
+     rewrite !andb_true_iff in H2;decompose [and] H2;clear H2.
+     simpl; apply Hf with (2:= H0);trivial. auto.
+     rewrite wf_interp_form, H;simpl.
+     unfold Atom.interp_form_hatom, Atom.interp_hatom at 1;simpl.
+     rewrite Atom.t_interp_wf, H0;simpl;trivial.
+     trivial.
+   Qed.
+
+
+   Lemma interp_binop_eqb_antisym:
+     forall a b va vb,
+       interp_atom a = Bval t_i Typ.TZ va -> interp_atom b = Bval t_i Typ.TZ vb ->
+       (interp_bool t_i
+         (apply_binop t_i Typ.TZ Typ.TZ Typ.Tbool (Typ.i_eqb t_i Typ.TZ)
+           (interp a) (interp b)) = false) ->
+       negb
+       (interp_bool t_i
+         (apply_binop t_i Typ.TZ Typ.TZ Typ.Tbool Z.leb
+           (interp a) (interp b))) = false ->
+       negb
+       (interp_bool t_i
+            (apply_binop t_i Typ.TZ Typ.TZ Typ.Tbool Z.leb
+              (interp b) (interp a))) = false ->
+       False.
+   Proof.
+     intros a b va vb HHa HHb.
+     unfold Atom.interp, Atom.interp_hatom.
+     rewrite HHa, HHb; simpl.
+     intros.
+     case_eq (va <=? vb); intros; subst.
+     case_eq (vb <=? va); intros; subst.
+     apply Zle_bool_imp_le in H2.
+     apply Zle_bool_imp_le in H3.
+     apply Zeq_bool_neq in H.
+     (*pour la beauté du geste!*) lia.
+     rewrite H3 in H1; simpl in H1; elim diff_true_false; trivial.
+     rewrite H2 in H0; simpl in H1; elim diff_true_false; trivial.
+   Qed.
+
+
+   Lemma valid_check_micromega :
+     forall cl c, C.valid rho (check_micromega cl c).
+   Proof.
+     unfold check_micromega; intros cl c.
+     case_eq (build_clause empty_vmap cl).
+     intros (vm1, bf) Heq.
+     destruct (build_clause_correct _ _ _ _ Heq).
+      red;simpl;auto.
+     decompose [and] H0.
+     case_eq (ZTautoChecker bf c);intros Heq2.
+     unfold C.valid;rewrite H5.
+     apply ZTautoChecker_sound with c;trivial.
+     apply C.interp_true.
+     destruct (Form.check_form_correct interp_form_hatom _ ch_form);trivial.
+     intros _;apply C.interp_true.
+     destruct (Form.check_form_correct interp_form_hatom _ ch_form);trivial.
+   Qed.
+
+
+   Lemma valid_check_diseq :
+     forall c, C.valid rho (check_diseq c).
+   Proof.
+     unfold check_diseq; intro c.
+     case_eq (t_form.[Lit.blit c]);intros;subst; try (unfold C.valid; apply valid_C_true; trivial).
+     case_eq ((length a) == 3); intros; try (unfold C.valid; apply valid_C_true; trivial).
+     apply eqb_correct in H0.
+     apply get_eq_interp; intros.
+     apply get_not_le_interp; intros.
+     apply get_not_le_interp; intros.
+     case_eq ((a0 == a1) && (a0 == b1) && (b == b0) && (b == a2)); intros; subst;
+       try (unfold C.valid; apply valid_C_true; trivial).
+     repeat(apply andb_prop in H19; destruct H19).
+     apply Int63Properties.eqb_spec in H19;apply Int63Properties.eqb_spec in H20;apply Int63Properties.eqb_spec in H21;apply Int63Properties.eqb_spec in H22;subst.
+     unfold C.interp; simpl; rewrite orb_false_r.
+     unfold Lit.interp; rewrite Lit.is_pos_lit.
+     unfold Var.interp; rewrite Lit.blit_lit.
+     rewrite wf_interp_form, H;simpl.
+     case_eq (Lit.interp rho (a.[0]) || Lit.interp rho (a.[1]) || Lit.interp rho (a.[2])).
+     intros;repeat (rewrite orb_true_iff in H19);destruct H19. destruct H19.
+     apply (afold_left_orb_true int 0); subst; auto.
+     apply ltb_spec;rewrite H0;compute;trivial.
+     apply (afold_left_orb_true int 1); auto.
+     apply ltb_spec;rewrite H0;compute;trivial.
+     apply (afold_left_orb_true int 2); auto.
+     apply ltb_spec;rewrite H0;compute;trivial.
+     intros; repeat (rewrite orb_false_iff in H19);destruct H19. destruct H19.
+     unfold Lit.interp in H19.
+     rewrite H3 in H19; unfold Var.interp in H19; rewrite H4 in H19.
+     unfold Lit.interp in H21.
+     pose (H24 := H15). apply negb_true_iff in H24.
+     rewrite H24 in H21.
+     unfold Var.interp in H21; rewrite H16 in H21.
+     unfold Lit.interp in H23.
+     pose (H25 := H9). apply negb_true_iff in H25.
+     rewrite H25 in H23.
+     unfold Var.interp in H23; rewrite H10 in H23.
+     assert (t = Typ.TZ).
+     generalize H12. clear H12.
+     destruct (Typ.reflect_eqb (get_type t_i t_func t_atom b0) Typ.TZ) as [H12|H12]; [intros _|discriminate].
+     generalize H6. clear H6.
+     destruct (Typ.reflect_eqb (get_type t_i t_func t_atom b0) t) as [H6|H6]; [intros _|discriminate].
+     rewrite <- H6. auto.
+     rewrite H26 in H19.
+     case_eq (interp_atom (t_atom .[ b1])); intros t1 v1 Heq1.
+     assert (H50: t1 = Typ.TZ).
+     unfold get_type, get_type' in H18. rewrite t_interp_wf in H18; trivial. rewrite Heq1 in H18. simpl in H18. rewrite Typ.eqb_spec in H18. assumption.
+     subst t1.
+     case_eq (interp_atom (t_atom .[ a2])); intros t2 v2 Heq2.
+     assert (H50: t2 = Typ.TZ).
+     unfold get_type, get_type' in H17. rewrite t_interp_wf in H17; trivial. rewrite Heq2 in H17. simpl in H17. rewrite Typ.eqb_spec in H17. assumption.
+     subst t2.
+     subst;elim (interp_binop_eqb_antisym (t_atom.[b1]) (t_atom.[a2]) v1 v2);trivial.
+       unfold interp_hatom in H19; do 2 rewrite t_interp_wf in H19; trivial.
+       unfold interp_hatom in H23; do 2 rewrite t_interp_wf in H23; trivial.
+       unfold interp_hatom in H21; do 2 rewrite t_interp_wf in H21; trivial.
+     trivial.
+     destruct H19.
+     case_eq ((a0 == b0) && (a0 == a2) && (b == a1) && (b == b1)); intros; subst;
+       try (unfold C.valid; apply valid_C_true; trivial).
+     repeat(apply andb_prop in H19; destruct H19).
+     apply Int63Properties.eqb_spec in H19;apply Int63Properties.eqb_spec in H20;apply Int63Properties.eqb_spec in H21;apply Int63Properties.eqb_spec in H22;subst.
+     unfold C.interp; simpl; rewrite orb_false_r.
+     unfold Lit.interp; rewrite Lit.is_pos_lit.
+     unfold Var.interp; rewrite Lit.blit_lit.
+     rewrite wf_interp_form, H;simpl.
+     case_eq (Lit.interp rho (a.[0]) || Lit.interp rho (a.[1]) || Lit.interp rho (a.[2])).
+     intros;repeat (rewrite orb_true_iff in H19);destruct H19. destruct H19.
+     apply (afold_left_orb_true int 0); auto.
+     apply ltb_spec;rewrite H0;compute;trivial.
+     apply (afold_left_orb_true int 1); auto.
+     apply ltb_spec;rewrite H0;compute;trivial.
+     apply (afold_left_orb_true int 2); auto.
+     apply ltb_spec;rewrite H0;compute;trivial.
+     intros; repeat (rewrite orb_false_iff in H19);destruct H19. destruct H19.
+     unfold Lit.interp in H19.
+     rewrite H3 in H19; unfold Var.interp in H19; rewrite H4 in H19.
+     unfold Lit.interp in H21.
+     case_eq (Lit.is_pos (a.[2])); intros.
+     apply negb_true_iff in H15;rewrite H15 in H24; discriminate.
+     rewrite H24 in H21.
+     unfold Var.interp in H21;rewrite H16 in H21.
+     unfold Lit.interp in H23.
+     case_eq (Lit.is_pos (a.[1])); intros.
+     apply negb_true_iff in H9; rewrite H9 in H25; discriminate.
+     rewrite H25 in H23.
+     unfold Var.interp in H23; rewrite H10 in H23.
+     rewrite <-H22, <- H20 in H21.
+     assert (t = Typ.TZ).
+       rewrite Typ.eqb_spec in H6; rewrite Typ.eqb_spec in H18; subst; auto.
+     rewrite H26 in H19.
+     case_eq (interp_atom (t_atom .[ b0])); intros t1 v1 Heq1.
+     assert (H50: t1 = Typ.TZ).
+     unfold get_type, get_type' in H12. rewrite t_interp_wf in H12; trivial. rewrite Heq1 in H12. simpl in H12. rewrite Typ.eqb_spec in H12. assumption.
+     subst t1.
+     case_eq (interp_atom (t_atom .[ a1])); intros t2 v2 Heq2.
+     assert (H50: t2 = Typ.TZ).
+     unfold get_type, get_type' in H11. rewrite t_interp_wf in H11; trivial. rewrite Heq2 in H11. simpl in H11. rewrite Typ.eqb_spec in H11. assumption.
+     subst t2.
+     elim (interp_binop_eqb_antisym (t_atom.[b0]) (t_atom.[a1]) v1 v2); trivial.
+       unfold interp_hatom in H19; do 2 rewrite t_interp_wf in H19; trivial.
+       unfold interp_hatom in H21; do 2 rewrite t_interp_wf in H21; trivial.
+       unfold interp_hatom in H23; do 2 rewrite t_interp_wf in H23; trivial.
+     trivial.
+   Qed.
+
+ End Proof.
+
+End certif.
diff --git a/src/lia/lia.ml b/src/lia/lia.ml
new file mode 100644
index 0000000..97415b9
--- /dev/null
+++ b/src/lia/lia.ml
@@ -0,0 +1,208 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+(*** Linking SMT Terms to Micromega Terms ***)
+open Term
+open Coqlib
+open Declare
+open Decl_kinds
+open Entries
+open Util
+open Micromega
+open Coq_micromega
+open Errors
+
+open SmtMisc
+open SmtForm
+open SmtAtom
+
+(* morphism for expression over Z *)
+
+let rec pos_of_int i =
+  if i <= 1
+  then XH
+  else
+    if i land 1 = 0
+    then XO(pos_of_int (i lsr 1))
+    else XI(pos_of_int (i lsr 1))
+
+let z_of_int i =
+  if i = 0
+  then Z0
+  else
+    if i > 0
+    then Zpos (pos_of_int i)
+    else Zneg (pos_of_int (-i))
+
+type my_tbl =
+    {tbl:(hatom,int) Hashtbl.t; mutable count:int}
+
+let get_atom_var tbl ha =
+  try Hashtbl.find tbl.tbl ha
+  with Not_found ->
+    let v = tbl.count in
+    Hashtbl.add tbl.tbl ha v;
+    tbl.count <- v + 1;
+    v
+
+let create_tbl n = {tbl=Hashtbl.create n;count=1}
+
+let rec smt_Atom_to_micromega_pos ha =
+  match Atom.atom ha with
+  | Auop(UO_xO, ha) ->
+      Micromega.XO (smt_Atom_to_micromega_pos ha)
+  | Auop(UO_xI, ha) ->
+      Micromega.XI (smt_Atom_to_micromega_pos ha)
+  | Acop CO_xH -> Micromega.XH
+  | _ -> raise Not_found
+
+let smt_Atom_to_micromega_Z ha =
+  match Atom.atom ha with
+  | Auop(UO_Zpos, ha) ->
+      Micromega.Zpos (smt_Atom_to_micromega_pos ha)
+  | Auop(UO_Zneg, ha) ->
+      Micromega.Zneg (smt_Atom_to_micromega_pos ha)
+  | Acop CO_Z0 -> Micromega.Z0
+  | _ -> raise Not_found
+
+let rec smt_Atom_to_micromega_pExpr tbl ha =
+  match Atom.atom ha with
+  | Abop (BO_Zplus, ha, hb) ->
+      let a = smt_Atom_to_micromega_pExpr tbl ha in
+      let b = smt_Atom_to_micromega_pExpr tbl hb in
+      PEadd(a, b)
+  | Abop (BO_Zmult, ha, hb) ->
+      let a = smt_Atom_to_micromega_pExpr tbl ha in
+      let b = smt_Atom_to_micromega_pExpr tbl hb in
+      PEmul(a, b)
+  | Abop (BO_Zminus, ha, hb) ->
+      let a = smt_Atom_to_micromega_pExpr tbl ha in
+      let b = smt_Atom_to_micromega_pExpr tbl hb in
+      PEsub(a, b)
+  | Auop (UO_Zopp, ha) ->
+      let a = smt_Atom_to_micromega_pExpr tbl ha in
+      PEopp a
+  | _ ->
+      try PEc (smt_Atom_to_micromega_Z ha)
+      with Not_found ->
+	let v = get_atom_var tbl ha in
+	PEX (pos_of_int v)
+
+
+(* morphism for LIA proposition (=, >, ...) *)
+
+let smt_binop_to_micromega_formula tbl op ha hb =
+  let op =
+    match op with
+    | BO_Zlt -> OpLt
+    | BO_Zle -> OpLe
+    | BO_Zge -> OpGe
+    | BO_Zgt -> OpGt
+    | BO_eq _ -> OpEq
+    | _ -> error
+	  "lia.ml: smt_binop_to_micromega_formula expecting a formula"
+  in
+  let lhs = smt_Atom_to_micromega_pExpr tbl ha in
+  let rhs = smt_Atom_to_micromega_pExpr tbl hb in
+  {flhs = lhs; fop = op; frhs = rhs }
+
+let rec smt_Atom_to_micromega_formula tbl ha =
+  match Atom.atom ha with
+    | Abop (op,ha,hb) -> smt_binop_to_micromega_formula tbl op ha hb
+    | _ -> error
+	  "lia.ml: smt_Atom_to_micromega_formula was expecting an LIA formula"
+
+(* specialized fold *)
+
+let default_constr = mkInt 0
+let default_tag = Mutils.Tag.from 0
+(* morphism for general formulas *)
+
+let binop_array g tbl op def t =
+  let n = Array.length t in
+  if n = 0 then
+    def
+  else
+    let aux = ref (g tbl t.(0)) in
+    for i = 1 to (n-1) do
+      aux := op !aux (g tbl t.(i))
+    done;
+    !aux
+
+let rec smt_Form_to_coq_micromega_formula tbl l =
+  let v =
+    match Form.pform l with
+      | Fatom ha ->
+	A (smt_Atom_to_micromega_formula tbl ha,
+	   default_tag,default_constr)
+      | Fapp (Ftrue, _) -> TT
+      | Fapp (Ffalse, _) -> FF
+      | Fapp (Fand, l) -> binop_array smt_Form_to_coq_micromega_formula tbl (fun x y -> C (x,y)) TT l
+      | Fapp (For, l) -> binop_array smt_Form_to_coq_micromega_formula tbl (fun x y -> D (x,y)) FF l
+      | Fapp (Fxor, l) -> failwith "todo:Fxor"
+      | Fapp (Fimp, l) -> binop_array smt_Form_to_coq_micromega_formula tbl (fun x y -> I (x,None,y)) TT l
+      | Fapp (Fiff, l) -> failwith "todo:Fiff"
+      | Fapp (Fite, l) -> failwith "todo:Fite"
+      | Fapp (Fnot2 _, l) ->
+        if Array.length l <> 1 then
+          failwith "Lia.smt_Form_to_coq_micromega_formula: wrong number of arguments for Fnot2"
+        else
+          smt_Form_to_coq_micromega_formula tbl l.(0)
+  in
+  if Form.is_pos l then v
+  else N(v)
+
+let binop_list tbl op def l =
+  match l with
+  | [] -> def
+  | f::l -> List.fold_left (fun x y -> op x (smt_Form_to_coq_micromega_formula tbl y)) (smt_Form_to_coq_micromega_formula tbl f) l
+
+
+(* let rec binop_list tbl op def l = *)
+(*   match l with *)
+(*   | [] -> def *)
+(*   | [f] -> smt_Form_to_coq_micromega_formula tbl f *)
+(*   | f::l -> *)
+(*       op (smt_Form_to_coq_micromega_formula tbl f) (binop_list tbl op def l) *)
+
+(* and smt_Form_to_coq_micromega_formula tbl l = *)
+(*   let v = *)
+(*     match Form.pform l with *)
+(*       | Fatom ha -> *)
+(* 	A (smt_Atom_to_micromega_formula tbl ha, *)
+(* 	   default_tag,default_constr) *)
+(*       | Fapp (Ftrue, _) -> TT *)
+(*       | Fapp (Ffalse, _) -> FF *)
+(*       | Fapp (Fand, l) -> binop_list tbl (fun x y -> C (x,y)) TT l *)
+(*       | Fapp (For, l) -> binop_list tbl (fun x y -> D (x,y)) FF l *)
+(*       | Fapp (Fxor, l) -> failwith "todo:Fxor" *)
+(*       | Fapp (Fimp, l) -> binop_list tbl (fun x y -> I (x,None,y)) TT l *)
+(*       | Fapp (Fiff, l) -> failwith "todo:Fiff" *)
+(*       | Fapp (Fite, l) -> failwith "todo:Fite" *)
+(*       | Fapp (Fnot2 _, l) -> smt_Form_to_coq_micromega_formula tbl l *)
+(*   in *)
+(*   if Form.is_pos l then v *)
+(*   else N(v) *)
+
+
+let smt_clause_to_coq_micromega_formula tbl cl =
+  binop_list tbl (fun x y -> C(x,y)) TT (List.map Form.neg cl)
+
+(* call to micromega solver *)
+let build_lia_certif cl =
+  let tbl = create_tbl 13 in
+  let f = I(smt_clause_to_coq_micromega_formula tbl cl, None, FF) in
+  tbl, f, tauto_lia f
+
diff --git a/src/spl/Arithmetic.v b/src/spl/Arithmetic.v
new file mode 100644
index 0000000..a3e3162
--- /dev/null
+++ b/src/spl/Arithmetic.v
@@ -0,0 +1,94 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+(*** Spl -- a small checker for simplifications ***)
+
+(* Add LoadPath ".." as SMTCoq. *)
+(* Add LoadPath "../lia" as SMTCoq.lia. *)
+Require Import List PArray Bool Int63 ZMicromega.
+Require Import Misc State SMT_terms.
+Require Lia.
+
+Local Open Scope array_scope.
+Local Open Scope int63_scope.
+
+
+(* Arbritrary arithmetic simplifications *)
+
+Section Arith.
+
+  Variable t_form : PArray.array Form.form.
+  Variable t_atom : PArray.array Atom.atom.
+
+  Local Notation build_clause := (Lia.build_clause t_form t_atom).
+
+
+  Definition check_spl_arith orig res l :=
+    match orig with
+      | li::nil =>
+        let cl := (Lit.neg li)::res::nil in
+        match build_clause Lia.empty_vmap cl with
+          | Some (_, bf) =>
+            if ZTautoChecker bf l then res::nil
+            else C._true
+          | None => C._true
+        end
+      | _ => C._true
+    end.
+
+
+  Section Valid.
+
+    Variables (t_i : array typ_eqb)
+              (t_func : array (Atom.tval t_i))
+              (ch_atom : Atom.check_atom t_atom)
+              (ch_form : Form.check_form t_form)
+              (wt_t_atom : Atom.wt t_i t_func t_atom).
+
+    Local Notation interp_form_hatom :=
+      (Atom.interp_form_hatom t_i t_func t_atom).
+    Local Notation rho :=
+      (Form.interp_state_var interp_form_hatom t_form).
+
+
+    Let wf_rho : Valuation.wf rho.
+    Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form); auto. Qed.
+
+    Hint Immediate wf_rho.
+
+
+    Lemma valid_check_spl_arith :
+      forall orig, C.valid rho orig ->
+        forall res l, C.valid rho (check_spl_arith orig res l).
+    Proof.
+      unfold check_spl_arith; intros [ |li [ |t q]].
+      (* Case nil *)
+      intros; apply C.interp_true; auto.
+      (* List with one element *)
+      intros H res l; case_eq (build_clause Lia.empty_vmap (Lit.neg li :: res :: nil)); [ |intros; apply C.interp_true; auto].
+      intros (vm1, bf) Heq; destruct (Lia.build_clause_correct _ _ _ t_func ch_atom ch_form wt_t_atom _ _ _ _ Heq) as [H1 H0].
+      red; simpl; auto.
+      decompose [and] H0; case_eq (ZTautoChecker bf l); [intros Heq3|intros; apply C.interp_true; auto].
+      unfold C.valid; replace (C.interp rho (res :: nil)) with (C.interp rho (Lit.neg li :: res :: nil)).
+      rewrite H6; apply ZTautoChecker_sound with l;trivial.
+      simpl; replace (Lit.interp rho (Lit.neg li)) with false; auto.
+      rewrite Lit.interp_neg; unfold C.valid in H; simpl in H; rewrite orb_false_r in H; rewrite H; auto.
+      (* List with at least two elements *)
+      intros; apply C.interp_true; auto.
+    Qed.
+
+  End Valid.
+
+End Arith.
diff --git a/src/spl/Operators.v b/src/spl/Operators.v
new file mode 100644
index 0000000..90483db
--- /dev/null
+++ b/src/spl/Operators.v
@@ -0,0 +1,549 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+(*** Spl -- a small checker for simplifications ***)
+
+(* Add LoadPath ".." as SMTCoq. *)
+(* Add LoadPath "../lia" as SMTCoq.lia. *)
+Require Import List PArray Bool Int63 ZMicromega.
+Require Import Misc State SMT_terms.
+Require Lia.
+
+Local Open Scope array_scope.
+Local Open Scope int63_scope.
+
+
+(* Simplification of SMTLIB-2 operators *)
+
+Section Operators.
+
+  Import Form.
+
+  Variable t_form : PArray.array Form.form.
+  Variable t_atom : PArray.array Atom.atom.
+
+  Local Notation get_form := (PArray.get t_form).
+  Local Notation get_atom := (PArray.get t_atom).
+
+
+  Fixpoint check_in x l :=
+    match l with
+      | nil => false
+      | t::q => if x == t then true else check_in x q
+    end.
+
+
+  Lemma check_in_spec : forall x l, check_in x l = true <-> In x l.
+  Proof.
+    intro x; induction l as [ |t q IHq]; simpl.
+    split; intro H; try discriminate; elim H.
+    case_eq (x == t).
+    rewrite eqb_spec; intro; subst t; split; auto.
+    intro H; rewrite IHq; split; auto; intros [H1|H1]; auto; rewrite H1, eqb_refl in H; discriminate.
+  Qed.
+
+
+  Fixpoint check_diseqs_complete_aux a dist t :=
+    match dist with
+      | nil => true
+      | b::q => if PArray.existsb (fun (x:option (int*int)) =>
+        match x with
+          | Some (a',b') => ((a == a') && (b == b')) || ((a == b') && (b == a'))
+          | None => false
+        end
+      ) t then check_diseqs_complete_aux a q t else false
+    end.
+
+
+  Lemma check_diseqs_complete_aux_spec : forall a dist t,
+    check_diseqs_complete_aux a dist t = true <->
+    forall y, In y dist -> exists i, i < length t /\
+      (t.[i] = Some (a,y) \/ t.[i] = Some (y,a)).
+  Proof.
+    intros a dist t; induction dist as [ |b q IHq]; simpl; split; auto.
+    intros _ y H; inversion H.
+    case_eq (PArray.existsb (fun x : option (int * int) => match x with | Some (a', b') => (a == a') && (b == b') || (a == b') && (b == a') | None => false end) t); try discriminate; rewrite PArray.existsb_spec; intros [i [H1 H2]]; rewrite IHq; clear IHq; intros H3 y [H4|H4]; auto; subst y; exists i; split; auto; generalize H2; case (t .[ i]); try discriminate; intros [a' b']; rewrite orb_true_iff, !andb_true_iff, !Int63Properties.eqb_spec; intros [[H4 H5]|[H4 H5]]; subst a' b'; auto.
+    intro H1; case_eq (PArray.existsb (fun x : option (int * int) => match x with | Some (a', b') => (a == a') && (b == b') || (a == b') && (b == a') | None => false end) t).
+    intros _; rewrite IHq; clear IHq; intros y Hy; apply H1; auto.
+    rewrite array_existsb_false_spec; destruct (H1 b (or_introl (refl_equal b))) as [i [H2 H3]]; intro H; rewrite <- (H _ H2); destruct H3 as [H3|H3]; rewrite H3; rewrite !eqb_refl; auto; rewrite orb_true_r; auto.
+  Qed.
+
+
+  Lemma check_diseqs_complete_aux_false_spec : forall a dist t,
+    check_diseqs_complete_aux a dist t = false <->
+    exists y, In y dist /\ forall i, i < length t ->
+      (t.[i] <> Some (a,y) /\ t.[i] <> Some (y,a)).
+  Proof.
+    intros a dist t; induction dist as [ |b q IHq]; simpl; split; try discriminate.
+    intros [y [H _]]; elim H.
+    case_eq (PArray.existsb (fun x : option (int * int) => match x with | Some (a', b') => (a == a') && (b == b') || (a == b') && (b == a') | None => false end) t).
+    intros _; rewrite IHq; clear IHq; intros [y [H3 H4]]; exists y; auto.
+    rewrite array_existsb_false_spec; intros H _; exists b; split; auto; intros i Hi; split; intro H1; generalize (H _ Hi); rewrite H1, !eqb_refl; try discriminate; rewrite orb_true_r; discriminate.
+    intros [y [H1 H2]]; case_eq (PArray.existsb (fun x : option (int * int) => match x with | Some (a', b') => (a == a') && (b == b') || (a == b') && (b == a') | None => false end) t); auto; rewrite PArray.existsb_spec; intros [i [H3 H4]]; rewrite IHq; clear IHq; exists y; destruct H1 as [H1|H1]; auto; subst y; case_eq (t.[i]); [intros [a' b'] Heq|intro Heq]; rewrite Heq in H4; try discriminate; rewrite orb_true_iff, !andb_true_iff, !eqb_spec in H4; destruct H4 as [[H4 H5]|[H4 H5]]; subst a' b'; generalize (H2 _ H3); rewrite Heq; intros [H4 H5]; [elim H4|elim H5]; auto.
+  Qed.
+
+
+  Fixpoint check_diseqs_complete dist t :=
+    match dist with
+      | nil => true
+      | a::q => if check_diseqs_complete_aux a q t then check_diseqs_complete q t else false
+    end.
+
+
+  Lemma check_diseqs_complete_spec : forall dist t,
+    check_diseqs_complete dist t = true <->
+    forall x y, In2 x y dist -> exists i, i < length t /\
+      (t.[i] = Some (x,y) \/ t.[i] = Some (y,x)).
+  Proof.
+    intros dist t; induction dist as [ |a q IHq]; simpl; split; auto.
+    intros _ x y H; inversion H.
+    case_eq (check_diseqs_complete_aux a q t); try discriminate; rewrite check_diseqs_complete_aux_spec, IHq; clear IHq; intros H1 H2 x y H3; inversion H3; auto.
+    intro H; case_eq (check_diseqs_complete_aux a q t).
+    rewrite IHq; clear IHq; intros _ x y H1; apply H; constructor 2; auto.
+    rewrite check_diseqs_complete_aux_false_spec; clear IHq; intros [y [H1 H2]]; destruct (H _ _ (In2_hd _ a _ _ H1)) as [i [H3 [H4|H4]]]; elim (H2 _ H3); rewrite H4; intros H5 H6; [elim H5|elim H6]; auto.
+  Qed.
+
+
+  Lemma check_diseqs_complete_false_spec : forall dist t,
+    check_diseqs_complete dist t = false <->
+    exists x y, In2 x y dist /\ forall i, i < length t ->
+      (t.[i] <> Some (x,y) /\ t.[i] <> Some (y,x)).
+  Proof.
+    intros dist t; induction dist as [ |a q IHq]; simpl; split; try discriminate.
+    intros [x [y [H _]]]; inversion H.
+    case_eq (check_diseqs_complete_aux a q t).
+    rewrite IHq; clear IHq; intros _ [x [y [H2 H3]]]; inversion H2; clear H2; subst q; exists x; exists y; split; auto; constructor 2.
+    constructor 1; auto.
+    constructor 2; auto.
+    rewrite check_diseqs_complete_aux_false_spec; intros [y [H1 H2]] _; clear IHq; exists a; exists y; split; auto; constructor; auto.
+    intros [x [y [H1 H2]]]; case_eq (check_diseqs_complete_aux a q t); auto; rewrite IHq; clear IHq; inversion H1; clear H1.
+    subst x q; rewrite check_diseqs_complete_aux_spec; intro H; destruct (H _ H0) as [i [H1 H3]]; elim (H2 _ H1); intros H4 H5; destruct H3; [elim H4|elim H5]; auto.
+    subst k q; intros _; exists x; exists y; split; auto.
+  Qed.
+
+
+  Definition check_diseqs ty dist diseq :=
+    let t := PArray.mapi (fun _ t =>
+      if Lit.is_pos t then None else
+        match get_form (Lit.blit t) with
+          | Fatom a =>
+            match get_atom a with
+              | Atom.Abop (Atom.BO_eq A) h1 h2 =>
+                if (Typ.eqb ty A) && (negb (h1 == h2)) && (check_in h1 dist) && (check_in h2 dist) then
+                  Some (h1,h2)
+                else
+                  None
+              | _ => None
+            end
+          | _ => None
+        end
+    ) diseq in
+    PArray.forallb (fun x => match x with | None => false | _ => true end) t &&
+    check_diseqs_complete dist t.
+
+
+  Lemma check_diseqs_spec : forall A dist diseq,
+    check_diseqs A dist diseq = true <->
+    ((forall i, i < length diseq ->
+      let t := diseq.[i] in
+        ~ Lit.is_pos t /\
+        exists a, get_form (Lit.blit t) = Fatom a /\
+          exists h1 h2, get_atom a = Atom.Abop (Atom.BO_eq A) h1 h2 /\
+            h1 <> h2 /\ (In2 h1 h2 dist \/ In2 h2 h1 dist))
+    /\
+    (forall x y, In2 x y dist -> exists i, i < length diseq /\
+      let t := diseq.[i] in
+        ~ Lit.is_pos t /\
+        exists a, get_form (Lit.blit t) = Fatom a /\
+          x <> y /\
+          (get_atom a = Atom.Abop (Atom.BO_eq A) x y \/
+            get_atom a = Atom.Abop (Atom.BO_eq A) y x))).
+  Proof.
+    intros A dist diseq; unfold check_diseqs; rewrite andb_true_iff, PArray.forallb_spec, check_diseqs_complete_spec, length_mapi; split; intros [H1 H2]; split.
+    clear H2; intros i Hi; generalize (H1 _ Hi); rewrite get_mapi; auto; case_eq (Lit.is_pos (diseq .[ i])); try discriminate; intro Heq1; case_eq (get_form (Lit.blit (diseq .[ i]))); try discriminate; intros a Heq2; case_eq (get_atom a); try discriminate; intros [ | | | | | | |B]; try discriminate; intros h1 h2 Heq3; case_eq (Typ.eqb A B); try discriminate; change (Typ.eqb A B = true) with (is_true (Typ.eqb A B)); rewrite Typ.eqb_spec; intro; subst B; case_eq (h1 == h2); try discriminate; rewrite eqb_false_spec; intro H2; case_eq (check_in h1 dist); try discriminate; case_eq (check_in h2 dist); try discriminate; rewrite !check_in_spec; intros H3 H4 _; split; try discriminate; exists a; split; auto; exists h1, h2; repeat split; auto; rewrite <- In2_In; auto.
+    clear H1; intros x y Hxy; destruct (H2 _ _ Hxy) as [i [H1 H4]]; clear H2; rewrite get_mapi in H4; auto; exists i; split; auto; generalize H4; case_eq (Lit.is_pos (diseq .[ i])); intro Heq; try (intros [H|H]; discriminate); case_eq (get_form (Lit.blit (diseq .[ i]))); [intros a| | |intros a1 a2|intros a1|intros a1|intros a1|intros a1 a2|intros a1 a2|intros a1 a2 a3]; intro Heq2; try (intros [H|H]; discriminate); case_eq (get_atom a); [intros a1|intros a1 a2|intros [ | | | | | | |B] h1 h2|intros a1 a2|intros a1 a2]; intro Heq3; try (intros [H|H]; discriminate); case_eq (Typ.eqb A B); try (intros _ [H|H]; discriminate); change (Typ.eqb A B = true) with (is_true (Typ.eqb A B)); rewrite Typ.eqb_spec; intro; subst B; case_eq (h1 == h2); try (intros _ [H|H]; discriminate); rewrite eqb_false_spec; intro H10; case (check_in h1 dist); try (intros [H|H]; discriminate); case (check_in h2 dist); try (intros [H|H]; discriminate); simpl; intro H3; split; try discriminate; exists a; split; auto; destruct H3 as [H3|H3]; inversion H3; subst; auto.
+    clear H2; intros i Hi; rewrite get_mapi; auto; destruct (H1 _ Hi) as [H2 [a [H3 [h1 [h2 [H4 [H5 H6]]]]]]]; clear H1; replace (Lit.is_pos (diseq .[ i])) with false by (case_eq (Lit.is_pos (diseq .[ i])); auto); rewrite H3, H4, Typ.eqb_refl; simpl; replace (h1 == h2) with false by (case_eq (h1 == h2); auto; rewrite eqb_spec; intro H; elim H5; auto); simpl; rewrite <- In2_In, <- !check_in_spec in H6; auto; destruct H6 as [H6 H7]; rewrite H6, H7; auto.
+    clear H1; intros x y Hxy; destruct (H2 _ _ Hxy) as [i [H1 [H3 [a [H4 [H6 H5]]]]]]; clear H2; exists i; split; auto; rewrite get_mapi; auto; replace (Lit.is_pos (diseq .[ i])) with false by (case_eq (Lit.is_pos (diseq .[ i])); auto); rewrite H4; assert (H7 := or_introl (In2 y x dist) Hxy); rewrite <- In2_In, <- !check_in_spec in H7; auto; destruct H7 as [H7 H8]; destruct H5 as [H5|H5]; rewrite H5, Typ.eqb_refl; [replace (x == y) with false by (case_eq (x == y); auto; rewrite eqb_spec; auto)|replace (y == x) with false by (case_eq (y == x); auto; rewrite eqb_spec; auto)]; simpl; rewrite H7, H8; auto.
+  Qed.
+
+
+  (* Definition check_diseqs ty dist diseq := *)
+  (*   PArray.forallb (fun t => *)
+  (*     if Lit.is_pos t then false else *)
+  (*       match get_form (Lit.blit t) with *)
+  (*         | Fatom a => *)
+  (*           match get_atom a with *)
+  (*             | Atom.Abop (Atom.BO_eq A) h1 h2 => *)
+  (*               (Typ.eqb ty A) && (negb (h1 == h2)) && (check_in h1 dist) && (check_in h2 dist) *)
+  (*             | _ => false *)
+  (*           end *)
+  (*         | _ => false *)
+  (*       end) diseq. *)
+
+
+  (* Lemma check_diseqs_spec : forall A dist diseq, *)
+  (*   check_diseqs A dist diseq <-> forall i, i < length diseq -> *)
+  (*     let t := diseq.[i] in *)
+  (*     ~ Lit.is_pos t /\ *)
+  (*     exists a, get_form (Lit.blit t) = Fatom a /\ *)
+  (*       exists h1 h2, get_atom a = Atom.Abop (Atom.BO_eq A) h1 h2 /\ *)
+  (*         (h1 <> h2) /\ ((In2 h1 h2 dist) \/ (In2 h2 h1 dist)). *)
+  (* Proof. *)
+  (*   intros A dist diseq; unfold check_diseqs; unfold is_true at 1; rewrite PArray.forallb_spec; split. *)
+  (*   intros H i Hi; generalize (H _ Hi); clear H; case (Lit.is_pos (diseq .[ i])); try discriminate; case (get_form (Lit.blit (diseq .[ i]))); try discriminate; intros a H1; split; try discriminate; exists a; split; auto; generalize H1; clear H1; case (get_atom a); try discriminate; intros [ | | | | | | |B] h1 h2; try discriminate; rewrite !andb_true_iff; change (check_in h1 dist = true) with (is_true (check_in h1 dist)); change (check_in h2 dist = true) with (is_true (check_in h2 dist)); rewrite !check_in_spec; intros [[[H1 H4] H2] H3]; change (is_true (Typ.eqb A B)) in H1; rewrite Typ.eqb_spec in H1; subst B; exists h1; exists h2; split; auto; assert (H5: h1 <> h2) by (intro H; rewrite H, eqb_refl in H4; discriminate); split; auto; rewrite <- In2_In; auto. *)
+  (*   intros H i Hi; generalize (H _ Hi); clear H; case (Lit.is_pos (diseq .[ i])); try (intros [H _]; elim H; reflexivity); intros [_ [a [H1 [h1 [h2 [H2 [H3 H4]]]]]]]; rewrite H1, H2; rewrite !andb_true_iff; rewrite <- (In2_In H3) in H4; destruct H4 as [H4 H5]; change (check_in h1 dist = true) with (is_true (check_in h1 dist)); change (check_in h2 dist = true) with (is_true (check_in h2 dist)); rewrite !check_in_spec; repeat split; auto; case_eq (h1 == h2); auto; try (rewrite Typ.eqb_refl; auto); rewrite eqb_spec; intro; subst h1; elim H3; auto. *)
+  (* Qed. *)
+
+
+  Definition check_distinct ha diseq :=
+    match get_atom ha with
+      | Atom.Anop (Atom.NO_distinct ty) dist =>
+        check_diseqs ty dist diseq
+      | _ => false
+    end.
+
+
+  Lemma check_distinct_spec : forall ha diseq,
+    check_distinct ha diseq = true <-> exists A dist,
+      get_atom ha = Atom.Anop (Atom.NO_distinct A) dist /\
+      check_diseqs A dist diseq = true.
+  Proof.
+    intros ha diseq; unfold check_distinct; split.
+    case (get_atom ha); try discriminate; intros [A] l H; exists A; exists l; auto.
+    intros [A [dist [H1 H2]]]; rewrite H1; auto.
+  Qed.
+
+
+  Definition check_distinct_two_args f1 f2 :=
+    match get_form f1, get_form f2 with
+      | Fatom ha, Fatom hb =>
+        match get_atom ha, get_atom hb with
+          | Atom.Anop (Atom.NO_distinct ty) (x::y::nil), Atom.Abop (Atom.BO_eq ty') x' y' => (Typ.eqb ty ty') && (((x == x') && (y == y')) || ((x == y') && (y == x')))
+          | _, _ => false
+        end
+      | _, _ => false
+    end.
+
+
+  Lemma check_distinct_two_args_spec : forall f1 f2,
+    check_distinct_two_args f1 f2 = true <-> exists ha hb ty x y,
+      get_form f1 = Fatom ha /\
+      get_form f2 = Fatom hb /\
+      get_atom ha = Atom.Anop (Atom.NO_distinct ty) (x::y::nil) /\
+      (get_atom hb = Atom.Abop (Atom.BO_eq ty) x y \/
+       get_atom hb = Atom.Abop (Atom.BO_eq ty) y x).
+  Proof.
+    intros f1 f2; unfold check_distinct_two_args; split.
+    case (get_form f1); try discriminate; intro ha; case (get_form f2); try discriminate; intro hb; case_eq (get_atom ha); try discriminate; intros [A] [ |x [ |y [ |l]]] Heq1; try discriminate; case_eq (get_atom hb); try discriminate; intros [ | | | | | | |B] x' y' Heq2; try discriminate; rewrite !andb_true_iff, orb_true_iff, !andb_true_iff; change (Typ.eqb A B = true) with (is_true (Typ.eqb A B)); rewrite Typ.eqb_spec, !Int63Properties.eqb_spec; intros [H1 [[H2 H3]|[H2 H3]]]; subst B x' y'; exists ha, hb, A, x, y; auto.
+    intros [ha [hb [A [x [y [H1 [H2 [H3 [H4|H4]]]]]]]]]; rewrite H1, H2, H3, H4, Typ.eqb_refl, !eqb_refl; auto; rewrite orb_true_r; auto.
+  Qed.
+
+
+  Section Valid1.
+
+    Variables (t_i : array typ_eqb)
+              (t_func : array (Atom.tval t_i))
+              (ch_atom : Atom.check_atom t_atom)
+              (ch_form : Form.check_form t_form)
+              (wt_t_atom : Atom.wt t_i t_func t_atom).
+
+    Local Notation interp_form_hatom :=
+      (Atom.interp_form_hatom t_i t_func t_atom).
+    Local Notation rho :=
+      (Form.interp_state_var interp_form_hatom t_form).
+
+    Let wf_t_atom : Atom.wf t_atom.
+    Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed.
+
+    Let default_t_atom : default t_atom = Atom.Acop Atom.CO_xH.
+    Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed.
+
+    Lemma default_t_form : default t_form = Ftrue.
+    Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [[H _] _]; auto. Qed.
+
+    Lemma wf_t_form : wf t_form.
+    Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [[_ H] _]; auto. Qed.
+
+    Local Hint Immediate wf_t_atom default_t_atom default_t_form wf_t_form.
+
+    Lemma interp_check_distinct : forall ha diseq,
+      check_distinct ha diseq = true ->
+      interp_form_hatom ha = afold_left bool int true andb (Lit.interp rho) diseq.
+    Proof.
+      intros ha diseq; rewrite check_distinct_spec; intros [A [dist [H1 H2]]]; rewrite check_diseqs_spec in H2; destruct H2 as [H2 H3]; unfold Atom.interp_form_hatom, Atom.interp_bool, Atom.interp_hatom; rewrite Atom.t_interp_wf; auto; rewrite H1; simpl; generalize (Atom.compute_interp_spec_rev t_i (get (Atom.t_interp t_i t_func t_atom)) A dist); case (Atom.compute_interp t_i (get (Atom.t_interp t_i t_func t_atom)) A nil); simpl.
+      intros l H4; case_eq (distinct (Typ.i_eqb t_i A) (rev l)).
+      rewrite distinct_spec; intro H5; symmetry; apply afold_left_andb_true; intros i Hi; destruct (H2 _ Hi) as [H9 [a [H10 [h1 [h2 [H6 [H7 H8]]]]]]]; unfold Lit.interp; replace (Lit.is_pos (diseq .[ i])) with false by (case_eq (Lit.is_pos (diseq .[ i])); auto); unfold Var.interp; rewrite Form.wf_interp_form; auto; rewrite H10; simpl; rewrite Atom.t_interp_wf; auto; rewrite H6; simpl; unfold Atom.apply_binop; unfold Atom.wt in wt_t_atom; unfold is_true in wt_t_atom; rewrite forallbi_spec in wt_t_atom; assert (H11: a < length t_atom).
+      case_eq (a < length t_atom); auto; intro H11; rewrite (get_outofbound _ _ _ H11) in H6; rewrite default_t_atom in H6; inversion H6.
+      generalize (wt_t_atom _ H11); rewrite H6; simpl; rewrite !andb_true_iff; change (Typ.eqb (Atom.get_type' t_i (Atom.t_interp t_i t_func t_atom) h1) A = true) with (is_true (Typ.eqb (Atom.get_type' t_i (Atom.t_interp t_i t_func t_atom) h1) A)); change (Typ.eqb (Atom.get_type' t_i (Atom.t_interp t_i t_func t_atom) h2) A = true) with (is_true (Typ.eqb (Atom.get_type' t_i (Atom.t_interp t_i t_func t_atom) h2) A)); rewrite !Typ.eqb_spec; intros [[_ H13] H12]; generalize (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom h1); rewrite H13; intros [v1 HH1]; generalize (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom h2); rewrite H12; intros [v2 HH2]; rewrite HH1, HH2; simpl; rewrite Typ.cast_refl; simpl; destruct H8 as [H8|H8]; [ |rewrite Typ.i_eqb_sym]; rewrite H5; auto; rewrite H4; [exists h2; exists h1|exists h1; exists h2]; auto.
+      rewrite distinct_false_spec; intros [v2 [v1 [H5 H6]]]; rewrite H4 in H5; destruct H5 as [a [b [H5 [H7 H8]]]]; clear H4; change (Typ.i_eqb t_i A v2 v1 = true) with (is_true (Typ.i_eqb t_i A v2 v1)) in H6; rewrite Typ.i_eqb_spec in H6; subst v2; clear H2; destruct (H3 _ _ H5) as [i [H2 [H4 [hb [H6 [H9 H10]]]]]]; clear H3; symmetry; apply (afold_left_andb_false _ i); auto; unfold Lit.interp; replace (Lit.is_pos (diseq .[ i])) with false by (case_eq (Lit.is_pos (diseq .[ i])); auto); unfold Var.interp; rewrite Form.wf_interp_form; auto; rewrite H6; simpl; rewrite Atom.t_interp_wf; auto; destruct H10 as [H10|H10]; rewrite H10; simpl; rewrite H7, H8; simpl; rewrite Typ.cast_refl; simpl; replace (Typ.i_eqb t_i A v1 v1) with true; auto; symmetry; change (is_true (Typ.i_eqb t_i A v1 v1)); rewrite Typ.i_eqb_spec; auto.
+      intros [a [H20 H21]]; assert (H4: ha < length t_atom).
+      case_eq (ha < length t_atom); auto; intro Heq; generalize H1; rewrite get_outofbound; auto; rewrite default_t_atom; discriminate.
+      unfold Atom.wt in wt_t_atom; unfold is_true in wt_t_atom; rewrite forallbi_spec in wt_t_atom; generalize (wt_t_atom _ H4); rewrite H1; simpl; rewrite andb_true_iff, forallb_forall; intros [_ H5]; assert (H6 := H5 _ H20); generalize (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom a); intros [va Ha]; rewrite Ha in H21; simpl in H21; elim H21; apply Typ.eqb_spec; auto.
+    Qed.
+
+    Lemma interp_check_distinct_two_args : forall f1 f2,
+      check_distinct_two_args f1 f2 = true ->
+      rho f1 = negb (rho f2).
+    Proof.
+      intros f1 f2; rewrite check_distinct_two_args_spec; intros [ha [hb [A [x [y [H1 [H2 [H3 [H4|H4]]]]]]]]]; unfold Form.interp_state_var; assert (H5: f1 < length t_form) by (case_eq (f1 < length t_form); auto; intro Heq; generalize H1; rewrite get_outofbound; auto; rewrite default_t_form; discriminate); assert (H6: f2 < length t_form) by (case_eq (f2 < length t_form); auto; intro Heq; generalize H2; rewrite get_outofbound; auto; rewrite default_t_form; discriminate); rewrite !Form.t_interp_wf; auto; rewrite H1, H2; simpl; unfold Atom.interp_form_hatom, Atom.interp_hatom; rewrite !Atom.t_interp_wf; auto; rewrite H3, H4; simpl; unfold Atom.wt,is_true in wt_t_atom; rewrite forallbi_spec in wt_t_atom; assert (H7: hb < length t_atom) by (case_eq (hb < length t_atom); auto; intro Heq; generalize H4; rewrite get_outofbound; auto; rewrite default_t_atom; discriminate); generalize (wt_t_atom _ H7); rewrite H4; simpl; case (Atom.get_type' t_i (Atom.t_interp t_i t_func t_atom) hb); try discriminate; simpl; rewrite andb_true_iff; change (Typ.eqb (Atom.get_type' t_i (Atom.t_interp t_i t_func t_atom) x) A = true) with (is_true (Typ.eqb (Atom.get_type' t_i (Atom.t_interp t_i t_func t_atom) x) A)); change (Typ.eqb (Atom.get_type' t_i (Atom.t_interp t_i t_func t_atom) y) A = true) with (is_true (Typ.eqb (Atom.get_type' t_i (Atom.t_interp t_i t_func t_atom) y) A)); rewrite !Typ.eqb_spec; intros [H8 H9]; generalize (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom x), (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom y); rewrite H8, H9; intros [v1 HH1] [v2 HH2]; rewrite HH1, HH2; simpl; rewrite Typ.cast_refl; auto; rewrite Typ.i_eqb_sym; auto.
+    Qed.
+
+
+    (* Lemma interp_check_distinct : forall ha diseq, *)
+    (*   check_distinct ha diseq -> *)
+    (*   interp_form_hatom ha -> afold_left bool int true andb (Lit.interp rho) diseq. *)
+    (* Proof. *)
+  (*     intros ha diseq; rewrite check_distinct_spec; intros [A [dist [H1 H]]]; rewrite check_diseqs_spec in H; unfold Atom.interp_form_hatom, Atom.interp_bool, Atom.interp_hatom; rewrite Atom.t_interp_wf; auto; rewrite H1; simpl; generalize (Atom.compute_interp_spec_rev t_i (get (Atom.t_interp t_i t_func t_atom)) A dist); case (Atom.compute_interp t_i (get (Atom.t_interp t_i t_func t_atom)) A nil); simpl. *)
+  (*     intros l H2; unfold is_true; rewrite distinct_spec; intro H3; apply afold_left_andb_true; intros i Hi; destruct (H _ Hi) as [H4 [a [H5 [h1 [h2 [H6 [H7 H8]]]]]]]; unfold Lit.interp; replace (Lit.is_pos (diseq .[ i])) with false by (case_eq (Lit.is_pos (diseq .[ i])); auto); unfold Var.interp; rewrite Form.wf_interp_form; auto; rewrite H5; simpl; rewrite Atom.t_interp_wf; auto; rewrite H6; simpl; unfold Atom.apply_binop; unfold Atom.wt in wt_t_atom; unfold is_true in wt_t_atom; rewrite forallbi_spec in wt_t_atom; assert (H10: a < length t_atom). *)
+  (*     case_eq (a < length t_atom); auto; intro H10; rewrite (get_outofbound _ _ _ H10) in H6; rewrite default_t_atom in H6; inversion H6. *)
+  (*     generalize (wt_t_atom _ H10); rewrite H6; simpl; rewrite !andb_true_iff. change (Typ.eqb (Atom.get_type t_i t_func t_atom h1) A = true) with (is_true (Typ.eqb (Atom.get_type t_i t_func t_atom h1) A)); change (Typ.eqb (Atom.get_type t_i t_func t_atom h2) A = true) with (is_true (Typ.eqb (Atom.get_type t_i t_func t_atom h2) A)); rewrite !Typ.eqb_spec; intros [[_ H11] H12]; generalize (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom h1); rewrite H11; intros [v1 HH1]; generalize (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom h2); rewrite H12; intros [v2 HH2]; rewrite HH1, HH2; simpl; rewrite Typ.cast_refl; simpl; destruct H8 as [H8|H8]; [ |rewrite Typ.i_eqb_sym]; rewrite H3; auto; rewrite H2; [exists h2; exists h1|exists h1; exists h2]; auto. *)
+  (*     intros [a [H2 H3]] _; assert (H4: ha < length t_atom). *)
+  (*     case_eq (ha < length t_atom); auto; intro Heq; generalize H1; rewrite get_outofbound; auto; rewrite default_t_atom; discriminate. *)
+  (*     unfold Atom.wt in wt_t_atom; unfold is_true in wt_t_atom; rewrite forallbi_spec in wt_t_atom; generalize (wt_t_atom _ H4); rewrite H1; simpl; rewrite andb_true_iff, forallb_forall; intros [_ H5]; assert (H6 := H5 _ H2); generalize (Atom.check_aux_interp_hatom _ t_func _ wf_t_atom a); intros [va Ha]; rewrite Ha in H3; simpl in H3; elim H3; apply Typ.eqb_spec; auto. *)
+  (*   Qed. *)
+
+  End Valid1.
+
+
+  Section AUX.
+
+    Variable check_var : var -> var -> bool.
+
+    Definition check_lit l1 l2 :=
+      (l1 == l2) || ((Bool.eqb (Lit.is_pos l1) (Lit.is_pos l2)) && (check_var (Lit.blit l1) (Lit.blit l2))) || ((Bool.eqb (Lit.is_pos l1) (negb (Lit.is_pos l2))) && (check_distinct_two_args (Lit.blit l1) (Lit.blit l2))).
+
+    (* Definition check_lit l1 l2 := *)
+    (*   (l1 == l2) || ((Lit.is_pos l1) && (Lit.is_pos l2) && (check_var (Lit.blit l1) (Lit.blit l2))) || ((negb (Lit.is_pos l1)) && (negb (Lit.is_pos l2)) && (check_var (Lit.blit l2) (Lit.blit l1))). *)
+
+    Definition check_form_aux a b :=
+      match a, b with
+        | Fatom ha, Fand diseq => check_distinct ha diseq
+        | Fatom a, Fatom b => a == b
+        | Ftrue, Ftrue => true
+        | Ffalse, Ffalse => true
+        | Fnot2 i1 l1, Fnot2 i2 l2 => (i1 == i2) && (check_lit l1 l2)
+        | Fand a1, Fand a2 => (length a1 == length a2) && (forallbi (fun i l => check_lit l (a2.[i])) a1)
+        | For a1, For a2 => (length a1 == length a2) && (forallbi (fun i l => check_lit l (a2.[i])) a1)
+        | Fimp a1, Fimp a2 => (length a1 == length a2) && (forallbi (fun i l => check_lit l (a2.[i])) a1)
+          (* (length a1 == length a2) && (forallbi (fun i l => if i < length a1 - 1 then check_lit (a2.[i]) l else check_lit l (a2.[i])) a1) *)
+        | Fxor l1 l2, Fxor j1 j2 => check_lit l1 j1 && check_lit l2 j2
+          (* check_lit l1 j1 && check_lit j1 l1 && check_lit l2 j2 && check_lit j2 l2 *)
+          (* (* let a := check_lit l1 j1 in *) *)
+          (* (* let b := check_lit l2 j2 in *) *)
+          (* (* let c := check_lit l1 j2 in *) *)
+          (* (* let d := check_lit l2 j1 in *) *)
+          (* (* let e := check_lit j1 l1 in *) *)
+          (* (* let f := check_lit j1 l2 in *) *)
+          (* (*   negb (((negb a) && b && (negb c)) || (c && e && (negb f)) || (b && (negb e) && f) || (a && (negb b) && (negb d))) *) *)
+        | Fiff l1 l2, Fiff j1 j2 => check_lit l1 j1 && check_lit l2 j2
+          (* check_lit l1 j1 && check_lit j1 l1 && check_lit l2 j2 && check_lit j2 l2 *)
+        | Fite l1 l2 l3, Fite j1 j2 j3 => check_lit l1 j1 && check_lit l2 j2 && check_lit l3 j3
+          (* check_lit l1 j1 && check_lit j1 l1 && check_lit l2 j2 && check_lit l3 j3 *)
+        | _, _ => false
+      end.
+
+    Variables (t_i : array typ_eqb)
+              (t_func : array (Atom.tval t_i))
+              (ch_atom : Atom.check_atom t_atom)
+              (ch_form : Form.check_form t_form)
+              (wt_t_atom : Atom.wt t_i t_func t_atom).
+
+    Local Notation interp_form_hatom :=
+      (Atom.interp_form_hatom t_i t_func t_atom).
+    Local Notation rho :=
+      (Form.interp_state_var interp_form_hatom t_form).
+
+    Hypothesis interp_check_var : forall x y,
+      check_var x y -> Var.interp rho x = Var.interp rho y.
+
+    (* Hypothesis interp_check_var : forall x y, *)
+    (*   check_var x y -> Var.interp rho x -> Var.interp rho y. *)
+
+    (* Local Hint Resolve interp_check_var. *)
+
+    Lemma interp_check_lit : forall l1 l2,
+      check_lit l1 l2 -> Lit.interp rho l1 = Lit.interp rho l2.
+    Proof.
+      unfold check_lit; intros l1 l2; unfold is_true; rewrite !orb_true_iff, !andb_true_iff; intros [[H1|[H1 H2]]|[H1 H2]].
+      rewrite eqb_spec in H1; rewrite H1; auto.
+      rewrite Bool.eqb_true_iff in H1; unfold Lit.interp; rewrite H1, (interp_check_var _ _ H2); auto.
+      generalize H1; unfold Lit.interp; case (Lit.is_pos l1); case (Lit.is_pos l2); try discriminate; intros _; unfold Var.interp; rewrite (interp_check_distinct_two_args _ t_func ch_atom ch_form wt_t_atom _ _ H2); auto; case (rho (Lit.blit l2)); auto.
+    Qed.
+
+    (* Lemma interp_check_lit : forall l1 l2, *)
+    (*   check_lit l1 l2 -> Lit.interp rho l1 -> Lit.interp rho l2 = true. *)
+    (* Proof. *)
+    (*   unfold check_lit; intros l1 l2; unfold is_true; rewrite !orb_true_iff, !andb_true_iff; intros [[H1|[[H1 H2] H3]]|[[H1 H2] H3]]. *)
+    (*   rewrite Int63Properties.eqb_spec in H1; subst l1; auto. *)
+    (*   unfold Lit.interp; rewrite H1, H2; apply interp_check_var; auto. *)
+    (*   unfold Lit.interp; case_eq (Lit.is_pos l1); intro Heq; rewrite Heq in H1; try discriminate; clear Heq H1; case_eq (Lit.is_pos l2); intro Heq; rewrite Heq in H2; try discriminate; clear Heq H2; case_eq (Var.interp rho (Lit.blit l1)); try discriminate; intros H4 _; case_eq (Var.interp rho (Lit.blit l2)); auto; intro H5; rewrite (interp_check_var _ _ H3 H5) in H4; discriminate. *)
+    (* Qed. *)
+
+    (* Local Hint Resolve interp_check_lit. *)
+
+    Lemma interp_check_form_aux : forall a b,
+      check_form_aux a b ->
+      Form.interp interp_form_hatom t_form a = Form.interp interp_form_hatom t_form b.
+    Proof.
+      intros [a| | |i1 l1|a1|a1|a1|l1 l2|l1 l2|l1 l2 l3] [b| | |j1 m1|a2|a2|a2|j1 j2|j1 j2|j1 j2 j3]; simpl; try discriminate;auto.
+      (* Atom *)
+      unfold is_true; rewrite Int63Properties.eqb_spec; intro; subst a; auto.
+      (* Interesting case *)
+      apply interp_check_distinct; auto.
+      (* Double negation *)
+      unfold is_true; rewrite andb_true_iff, Int63Properties.eqb_spec; intros [H1 H2]; subst j1. rewrite (interp_check_lit _ _ H2). auto.
+      (* Conjunction *)
+      unfold is_true; rewrite andb_true_iff, eqb_spec, forallbi_spec; intros [H1 H2]; apply afold_left_eq; auto; intros i Hi; apply interp_check_lit; auto.
+      (* Disjunction *)
+      unfold is_true; rewrite andb_true_iff, eqb_spec, forallbi_spec; intros [H1 H2]; apply afold_left_eq; auto; intros i Hi; apply interp_check_lit; auto.
+      (* Implication *)
+      unfold is_true; rewrite andb_true_iff, eqb_spec, forallbi_spec; intros [H1 H2]; apply afold_right_eq; auto; intros i Hi; apply interp_check_lit; auto.
+      (* Xor *)
+      unfold is_true; rewrite andb_true_iff; intros [H1 H2]; rewrite (interp_check_lit _ _ H1), (interp_check_lit _ _ H2); auto.
+      (* Iff *)
+      unfold is_true; rewrite andb_true_iff; intros [H1 H2]; rewrite (interp_check_lit _ _ H1), (interp_check_lit _ _ H2); auto.
+      (* Ite *)
+      unfold is_true; rewrite !andb_true_iff; intros [[H1 H2] H3]; rewrite (interp_check_lit _ _ H1), (interp_check_lit _ _ H2), (interp_check_lit _ _ H3); auto.
+    Qed.
+
+    (* Lemma interp_check_lit_equiv : forall l1 l2, *)
+    (*   check_lit l1 l2 -> check_lit l2 l1 -> *)
+    (*   Lit.interp rho l1 = Lit.interp rho l2. *)
+    (* Proof. *)
+    (*   intros l1 l2 H1 H2; generalize (interp_check_lit _ _ H1) (interp_check_lit _ _ H2); case (Lit.interp rho l1); case (Lit.interp rho l2); auto; symmetry; auto. *)
+    (* Qed. *)
+
+    (* Lemma interp_check_form_aux : forall a b, *)
+    (*   check_form_aux a b -> *)
+    (*   Form.interp interp_form_hatom t_form a -> Form.interp interp_form_hatom t_form b. *)
+    (* Proof. *)
+    (*   intros [a| | |i1 l1|a1|a1|a1|l1 l2|l1 l2|l1 l2 l3] [b| | |j1 m1|a2|a2|a2|j1 j2|j1 j2|j1 j2 j3]; simpl; try discriminate;auto. *)
+    (*   (* Atom *) *)
+    (*   unfold is_true; rewrite Int63Properties.eqb_spec; intro; subst a; auto. *)
+    (*   (* Interesting case *) *)
+    (*   apply interp_check_distinct; auto. *)
+    (*   (* Double negation *) *)
+    (*   unfold is_true; rewrite andb_true_iff, Int63Properties.eqb_spec; intros [H1 H2]; subst j1; apply (fold_ind2 _ _ (fun x y => x = true -> y = true)). *)
+    (*   apply interp_check_lit; auto. *)
+    (*   intros a b; case a; try discriminate; intros H _; rewrite H; auto. *)
+    (*   (* Conjunction *) *)
+    (*   unfold is_true; rewrite andb_true_iff, Int63Properties.eqb_spec; intros [H1 H2]; rewrite forallbi_spec in H2; intro H3; assert (H4 := afold_left_andb_true_inv _ _ _ H3); clear H3; apply afold_left_andb_true; rewrite <- H1; intros i Hi; eapply interp_check_lit; eauto. *)
+    (*   (* Disjunction *) *)
+    (*   unfold is_true; rewrite andb_true_iff, Int63Properties.eqb_spec; intros [H1 H2]; rewrite forallbi_spec in H2; intro H3; assert (H4 := afold_left_orb_true_inv _ _ _ H3); clear H3; destruct H4 as [i [H3 H4]]; eapply afold_left_orb_true. *)
+    (*   rewrite <- H1; eauto. *)
+    (*   eapply interp_check_lit; eauto. *)
+    (*   (* Implication *) *)
+    (*   unfold is_true; rewrite andb_true_iff, Int63Properties.eqb_spec; intros [H1 H2]; rewrite forallbi_spec in H2; intro H3; apply afold_right_implb_true; case_eq (length a1 == 0); intro Heq. *)
+    (*   left; rewrite eqb_spec in Heq; rewrite <- H1; auto. *)
+    (*   destruct (afold_right_implb_true_inv _ _ _ H3) as [H4|[[i [H4 H5]]|H4]]. *)
+    (*   rewrite H4 in Heq; discriminate. *)
+    (*   right; left; exists i; rewrite <- H1; split; auto; case_eq (Lit.interp rho (a2 .[ i])); auto; intro H6; assert (H7: i < length a1 = true). *)
+    (*   rewrite ltb_spec in *; rewrite eqb_false_spec in Heq; rewrite to_Z_sub_1_diff in H4; auto; omega. *)
+    (*   generalize (H2 _ H7); rewrite H4; intro H8; rewrite (interp_check_lit _ _ H8 H6) in H5; auto. *)
+    (*   right; case_eq (existsbi (fun i l => (i < length a2 - 1) && (negb (Lit.interp rho l))) a2). *)
+    (*   rewrite existsbi_spec; intros [i [_ H5]]; rewrite andb_true_iff in H5; destruct H5 as [H5 H6]; left; exists i; split; auto; generalize H6; case (Lit.interp rho (a2 .[ i])); auto; discriminate. *)
+    (*   rewrite existsbi_false_spec; intro H; right; intros i Hi; assert (Hi' := Hi); rewrite <- H1 in Hi'; generalize (H2 _ Hi') (H _ Hi); rewrite <- H1; case (i < length a1 - 1); simpl. *)
+    (*   intros _; case (Lit.interp rho (a2 .[ i])); auto; discriminate. *)
+    (*   intros H5 _; apply (interp_check_lit _ _ H5); apply H4; auto. *)
+    (*   (* Xor *) *)
+    (*   unfold is_true; rewrite !andb_true_iff; intros [[[H1 H2] H3] H4]; rewrite (interp_check_lit_equiv _ _ H1 H2), (interp_check_lit_equiv _ _ H3 H4); auto. *)
+    (*   (* Iff *) *)
+    (*   unfold is_true; rewrite !andb_true_iff; intros [[[H1 H2] H3] H4]; rewrite (interp_check_lit_equiv _ _ H1 H2), (interp_check_lit_equiv _ _ H3 H4); auto. *)
+    (*   (* Ite *) *)
+    (*   unfold is_true; rewrite !andb_true_iff; intros [[[H1 H2] H3] H4]; rewrite (interp_check_lit_equiv _ _ H1 H2); case (Lit.interp rho j1); apply interp_check_lit; auto. *)
+    (* Qed. *)
+
+  End AUX.
+
+  Definition check_hform h1 h2 :=
+    foldi_down_cont
+    (fun _ cont h1 h2 => (h1 == h2) || check_form_aux cont (get_form h1) (get_form h2))
+    (PArray.length t_form) 0 (fun h1 h2 => false) h1 h2.
+
+  Definition check_form := check_form_aux check_hform.
+
+  Definition check_lit' := check_lit check_hform.
+
+  Fixpoint check_distinct_elim input res :=
+    match input with
+      | nil => nil
+      | l::q => if check_lit' l res then res::q else l::(check_distinct_elim q res)
+    end.
+
+
+  Section Valid.
+
+    Variables (t_i : array typ_eqb)
+              (t_func : array (Atom.tval t_i))
+              (ch_atom : Atom.check_atom t_atom)
+              (ch_form : Form.check_form t_form)
+              (wt_t_atom : Atom.wt t_i t_func t_atom).
+
+    Local Notation interp_form_hatom :=
+      (Atom.interp_form_hatom t_i t_func t_atom).
+    Local Notation rho :=
+      (Form.interp_state_var interp_form_hatom t_form).
+
+
+    Let wf_rho : Valuation.wf rho.
+    Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form); auto. Qed.
+
+    Let default_t_form : default t_form = Ftrue.
+    Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [[H _] _]; auto. Qed.
+
+    Let wf_t_form : wf t_form.
+    Proof. destruct (Form.check_form_correct interp_form_hatom _ ch_form) as [[_ H] _]; auto. Qed.
+
+    Local Hint Immediate wf_rho default_t_form wf_t_form.
+
+
+    Lemma interp_check_hform : forall h1 h2,
+      check_hform h1 h2 -> Var.interp rho h1 = Var.interp rho h2.
+    Proof.
+      unfold check_hform; apply foldi_down_cont_ind; try discriminate. intros i cont _ _ Hrec h1 h2. unfold is_true; rewrite orb_true_iff; intros [H|H].
+      rewrite Int63Properties.eqb_spec in H; rewrite H; auto.
+      unfold Var.interp; rewrite !wf_interp_form; auto; eapply interp_check_form_aux; eauto.
+    Qed.
+
+    Local Hint Resolve interp_check_hform.
+
+
+    Lemma interp_check_form : forall a b,
+      check_form a b ->
+      Form.interp interp_form_hatom t_form a = Form.interp interp_form_hatom t_form b.
+    Proof. apply interp_check_form_aux, interp_check_hform; auto. Qed.
+
+
+    Lemma interp_check_lit' : forall l res,
+      check_lit' l res -> Lit.interp rho l = Lit.interp rho res.
+    Proof. apply interp_check_lit, interp_check_hform; auto. Qed.
+
+
+    Lemma valid_check_distinct_elim :
+      forall input, C.valid rho input ->
+        forall res, C.valid rho (check_distinct_elim input res).
+    Proof.
+      induction input as [ |l c IHc]; auto; simpl; unfold C.valid; simpl; rewrite orb_true_iff; intros [H|H] res.
+      case_eq (check_lit' l res); intro Heq; simpl.
+      rewrite <- (interp_check_lit' _ _ Heq), H; auto.
+      rewrite H; auto.
+      case (check_lit' l res).
+      simpl; rewrite H, orb_true_r; auto.
+      simpl; rewrite (IHc H), orb_true_r; auto.
+    Qed.
+
+  End Valid.
+
+End Operators.
diff --git a/src/spl/Syntactic.v b/src/spl/Syntactic.v
new file mode 100644
index 0000000..d7d2594
--- /dev/null
+++ b/src/spl/Syntactic.v
@@ -0,0 +1,531 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+(*** Spl -- a small checker for simplifications ***)
+
+(* Add LoadPath ".." as SMTCoq. *)
+(* Add LoadPath "../lia" as SMTCoq.lia. *)
+Require Import List PArray Bool Int63 ZMicromega.
+Require Import Misc State SMT_terms.
+Require Lia.
+
+Local Open Scope array_scope.
+Local Open Scope int63_scope.
+
+
+(* Flattening and small arithmetic simplifications *)
+
+Section CheckAtom.
+
+  Import Atom.
+
+  Variable t_i : PArray.array typ_eqb.
+  Variable t_func : PArray.array (tval t_i).
+  Variable t_atom : PArray.array atom.
+
+  Local Notation get_atom := (PArray.get t_atom).
+
+  Section AUX.
+
+    Variable check_hatom : hatom -> hatom -> bool.
+
+    Definition check_atom_aux a b :=
+      match a, b with
+        | Acop o1, Acop o2 => cop_eqb o1 o2
+
+        (* Two ways to define a negative integer *)
+        | Auop UO_Zopp p1, Auop UO_Zneg q =>
+          match get_atom p1 with
+            | Auop UO_Zpos p => check_hatom p q
+            | _ => false
+          end
+        | Auop UO_Zneg p, Auop UO_Zopp q1 =>
+          match get_atom q1 with
+            | Auop UO_Zpos q => check_hatom p q
+            | _ => false
+          end
+
+        | Auop o1 a, Auop o2 b => uop_eqb o1 o2 && check_hatom a b
+        | Abop o1 a1 a2, Abop o2 b1 b2 =>
+          match o1, o2 with
+            | BO_Zplus, BO_Zplus
+            | BO_Zmult, BO_Zmult => (check_hatom a1 b1 && check_hatom a2 b2) || (check_hatom a1 b2 && check_hatom a2 b1)
+            | BO_Zminus, BO_Zminus
+            | BO_Zlt, BO_Zlt
+            | BO_Zle, BO_Zle
+            | BO_Zge, BO_Zge
+            | BO_Zgt, BO_Zgt  => check_hatom a1 b1 && check_hatom a2 b2
+            | BO_Zge, BO_Zle
+            | BO_Zle, BO_Zge
+            | BO_Zgt, BO_Zlt
+            | BO_Zlt, BO_Zgt => check_hatom a1 b2 && check_hatom a2 b1
+            | BO_eq t1, BO_eq t2 =>
+              Typ.eqb t1 t2 &&
+              ((check_hatom a1 b1 && check_hatom a2 b2) ||
+                (check_hatom a1 b2 && check_hatom a2 b1))
+            | _, _ => false
+          end
+        | Anop o1 l1, Anop o2 l2 =>
+          match o1, o2 with
+            | NO_distinct t1, NO_distinct t2 => Typ.eqb t1 t2 && list_beq check_hatom l1 l2
+          end
+        | Aapp f1 aargs, Aapp f2 bargs =>(f1 == f2) && list_beq check_hatom aargs bargs
+
+        | _, _ => false
+      end.
+
+
+    Hypothesis check_hatom_correct : forall h1 h2, check_hatom h1 h2 ->
+      interp_hatom t_i t_func t_atom h1 = interp_hatom t_i t_func t_atom h2.
+    Hypothesis Hwf: wf t_atom.
+    Hypothesis Hd: default t_atom = Acop CO_xH.
+
+
+    Lemma list_beq_correct : forall l1 l2,
+      list_beq check_hatom l1 l2 = true ->
+      List.map (interp_hatom t_i t_func t_atom) l1 =
+      List.map (interp_hatom t_i t_func t_atom) l2.
+    Proof.
+      induction l1 as [ |h1 l1 IHl1]; intros [ |h2 l2]; simpl; try discriminate; auto; rewrite andb_true_iff; intros [H1 H2]; rewrite (IHl1 _ H2); rewrite (check_hatom_correct _ _ H1); auto.
+    Qed.
+
+
+    Lemma list_beq_compute_interp : forall t l1 l2,
+      list_beq check_hatom l1 l2 = true -> forall acc,
+      compute_interp t_i (interp_hatom t_i t_func t_atom) t acc l1 =
+      compute_interp t_i (interp_hatom t_i t_func t_atom) t acc l2.
+    Proof.
+      intro t; induction l1 as [ |h1 l1 IHl1]; intros [ |h2 l2]; simpl; try discriminate; auto; rewrite andb_true_iff; intros [H1 H2] acc; rewrite (check_hatom_correct _ _ H1); destruct (interp_hatom t_i t_func t_atom h2) as [ta va]; destruct (Typ.cast ta t) as [ka| ]; auto.
+    Qed.
+
+
+    Lemma check_atom_aux_correct : forall a1 a2, check_atom_aux a1 a2 ->
+      interp t_i t_func t_atom a1 = interp t_i t_func t_atom a2.
+    Proof.
+      intros [op1|op1 i1|op1 i1 j1|op1 li1|f1 args1]; simpl.
+      (* Constants *)
+      intros [op2|op2 i2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; pose (H:=reflect_cop_eqb op1 op2); inversion H; try discriminate; subst op1; auto.
+      (* Unary operators *)
+      intros [op2|op2 i2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; try (case op1; discriminate).
+      case op1; case op2; try discriminate; try (unfold is_true; rewrite andb_true_iff; intros [_ H]; rewrite (check_hatom_correct _ _ H); auto).
+      case_eq (get_atom i2); try discriminate; intros [ | | | | ] i Heq H; try discriminate; simpl; unfold apply_unop; rewrite (check_hatom_correct _ _ H); unfold interp_hatom; rewrite (t_interp_wf _ _ _ Hwf Hd i2), Heq; simpl; unfold apply_unop; destruct (t_interp t_i t_func t_atom .[ i]) as [A v]; destruct (Typ.cast A Typ.Tpositive) as [k| ]; auto.
+      case_eq (get_atom i1); try discriminate; intros [ | | | | ] i Heq H; try discriminate; simpl; unfold apply_unop; rewrite <- (check_hatom_correct _ _ H); unfold interp_hatom; rewrite (t_interp_wf _ _ _ Hwf Hd i1), Heq; simpl; unfold apply_unop; destruct (t_interp t_i t_func t_atom .[ i]) as [A v]; destruct (Typ.cast A Typ.Tpositive) as [k| ]; auto.
+      (* Binary operators *)
+      intros [op2|op2 i2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; case op1; case op2; try discriminate; try (unfold is_true; rewrite andb_true_iff; intros [H1 H2]; rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2); auto).
+      unfold is_true, interp_bop, apply_binop. rewrite orb_true_iff, !andb_true_iff. intros [[H1 H2]|[H1 H2]]; rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2); destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.add_comm; reflexivity.
+      unfold is_true, interp_bop, apply_binop. rewrite orb_true_iff, !andb_true_iff. intros [[H1 H2]|[H1 H2]]; rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2); destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.mul_comm; reflexivity.
+      unfold interp_bop, apply_binop; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.gtb_ltb; auto.
+      unfold interp_bop, apply_binop; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.geb_leb; auto.
+      unfold interp_bop, apply_binop; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.geb_leb; auto.
+      unfold interp_bop, apply_binop; destruct (interp_hatom t_i t_func t_atom j2) as [B v2]; destruct (interp_hatom t_i t_func t_atom i2) as [A v1]; destruct (Typ.cast B Typ.TZ) as [k2| ]; destruct (Typ.cast A Typ.TZ) as [k1| ]; auto; rewrite Z.gtb_ltb; auto.
+      intros A B; unfold is_true; rewrite andb_true_iff, orb_true_iff; change (Typ.eqb B A = true) with (is_true (Typ.eqb B A)); rewrite Typ.eqb_spec; intros [H2 [H1|H1]]; subst B; rewrite andb_true_iff in H1; destruct H1 as [H1 H2]; rewrite (check_hatom_correct _ _ H1), (check_hatom_correct _ _ H2); auto; simpl; unfold apply_binop; destruct (interp_hatom t_i t_func t_atom j2) as [B v1]; destruct (interp_hatom t_i t_func t_atom i2) as [C v2]; destruct (Typ.cast B A) as [k1| ]; destruct (Typ.cast C A) as [k2| ]; auto; rewrite Typ.i_eqb_sym; auto.
+      (* N-ary operators *)
+      intros [op2|op2 i2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; destruct op1 as [t1]; destruct op2 as [t2]; unfold is_true; rewrite andb_true_iff; change (Typ.eqb t1 t2 = true) with (is_true (Typ.eqb t1 t2)); rewrite Typ.eqb_spec; intros [H1 H2]; subst t2; rewrite (list_beq_compute_interp _ _ _ H2); auto.
+      (* Application *)
+      intros [op2|op2 i2|op2 i2 j2|op2 li2|f2 args2]; simpl; try discriminate; unfold is_true; rewrite andb_true_iff, Int63Properties.eqb_spec; intros [H2 H1]; subst f2; rewrite (list_beq_correct _ _ H1); auto.
+    Qed.
+
+  End AUX.
+
+  Definition check_hatom h1 h2 :=
+    foldi_down_cont
+    (fun _ cont h1 h2 => (h1 == h2) || check_atom_aux cont (t_atom.[h1]) (t_atom.[h2]))
+    (PArray.length t_atom) 0 (fun h1 h2 => false) h1 h2.
+
+  Definition check_atom := check_atom_aux check_hatom.
+
+  Definition check_neg_hatom h1 h2 :=
+    match get_atom h1, get_atom h2 with
+      | Abop op1 a1 a2, Abop op2 b1 b2 =>
+        match op1, op2 with
+          | BO_Zlt, BO_Zle => check_hatom a1 b2 && check_hatom a2 b1
+          | BO_Zlt, BO_Zge => check_hatom a1 b1 && check_hatom a2 b2
+          | BO_Zle, BO_Zlt => check_hatom a1 b2 && check_hatom a2 b1
+          | BO_Zle, BO_Zgt => check_hatom a1 b1 && check_hatom a2 b2
+          | BO_Zge, BO_Zlt => check_hatom a1 b1 && check_hatom a2 b2
+          | BO_Zge, BO_Zgt => check_hatom a1 b2 && check_hatom a2 b1
+          | BO_Zgt, BO_Zle => check_hatom a1 b1 && check_hatom a2 b2
+          | BO_Zgt, BO_Zge => check_hatom a1 b2 && check_hatom a2 b1
+          | _, _ => false
+        end
+      | _, _ => false
+    end.
+
+  (* TODO : move this *)
+  Lemma Zge_is_ge_bool : forall x y, (x >= y) <-> (Zge_bool x y = true).
+  Proof.
+    intros x y;assert (W:=Zge_cases x y);destruct (Zge_bool x y).
+    split;auto.
+    split;[intros;elimtype false;auto with zarith | discriminate].
+  Qed.
+
+
+  (* Correctness of check_atom *)
+
+  Lemma check_hatom_correct : wf t_atom ->
+    default t_atom = Acop CO_xH ->
+    forall h1 h2, check_hatom h1 h2 ->
+      interp_hatom t_i t_func t_atom h1 = interp_hatom t_i t_func t_atom h2.
+  Proof.
+   unfold check_hatom;intros Hwf Hdef.
+   apply foldi_down_cont_ind;try discriminate.
+   intros i cont _ _ Hrec h1 h2.
+   unfold is_true; rewrite orb_true_iff; intros [H|H].
+   rewrite Int63Properties.eqb_spec in H; rewrite H; reflexivity.
+   unfold interp_hatom;rewrite !t_interp_wf;trivial.
+   apply check_atom_aux_correct with cont;trivial.
+  Qed.
+
+
+   Lemma check_atom_correct : wf t_atom ->
+    default t_atom = Acop CO_xH ->
+    forall a1 a2, check_atom a1 a2 ->
+        interp t_i t_func t_atom a1 = interp t_i t_func t_atom a2.
+  Proof.
+   intros Hwf Hdef;unfold check_atom;apply check_atom_aux_correct; auto.
+   apply check_hatom_correct;trivial.
+  Qed.
+
+
+  Lemma check_hatom_correct_bool : wf t_atom ->
+    default t_atom = Acop CO_xH ->
+    forall h1 h2, check_hatom h1 h2 ->
+      interp_form_hatom t_i t_func t_atom h1 = interp_form_hatom t_i t_func t_atom h2.
+  Proof.
+    unfold interp_form_hatom; intros H1 H2 h1 h2 H3; rewrite (check_hatom_correct H1 H2 h1 h2 H3); auto.
+  Qed.
+
+
+  (* Correctness of check_neg_atom *)
+
+  Lemma check_neg_hatom_correct : wt t_i t_func t_atom ->
+    wf t_atom -> default t_atom = Acop CO_xH ->
+    forall h1 h2, check_neg_hatom h1 h2 ->
+      match interp_hatom t_i t_func t_atom h1, interp_hatom t_i t_func t_atom h2 with
+        | Val Typ.Tbool v1, Val Typ.Tbool v2 => v1 = negb v2
+        | Val _ _, Val _ _ => False
+      end.
+  Proof.
+    unfold wt; unfold is_true at 1; rewrite forallbi_spec; intros Hwt Hwf Hdef h1 h2; unfold check_neg_hatom; case_eq (get_atom h1); try discriminate; intros b1 t11 t12 H1; case_eq (get_atom h2); try discriminate; intros b2 t21 t22 H2; assert (H7: h1 < length t_atom) by (apply PArray.get_not_default_lt; rewrite H1, Hdef; discriminate); generalize (Hwt _ H7); rewrite H1; simpl; generalize H1; case b1; try discriminate; clear H1 b1; simpl; intro H1; case (get_type' t_i (t_interp t_i t_func t_atom) h1); try discriminate; simpl; rewrite andb_true_iff; intros [H30 H31]; change (is_true (Typ.eqb (get_type' t_i (t_interp t_i t_func t_atom) t11) Typ.TZ)) in H30; change (is_true (Typ.eqb (get_type' t_i (t_interp t_i t_func t_atom) t12) Typ.TZ)) in H31; rewrite Typ.eqb_spec in H30, H31; generalize (check_aux_interp_hatom _ t_func _ Hwf t11), (check_aux_interp_hatom _ t_func _ Hwf t12); rewrite H30, H31; intros [v1 Hv1] [v2 Hv2]; generalize H2; case b2; try discriminate; clear H2 b2; intro H2; unfold is_true; rewrite andb_true_iff; intros [H3 H4]; generalize (check_hatom_correct Hwf Hdef _ _ H3), (check_hatom_correct Hwf Hdef _ _ H4); unfold interp_hatom; intros H5 H6; rewrite t_interp_wf; auto; rewrite H1; simpl; rewrite Hv1, Hv2; simpl; rewrite t_interp_wf; auto; rewrite H2; simpl; rewrite <- H5; rewrite <- H6, Hv1, Hv2; simpl.
+    rewrite Z.ltb_antisym; auto.
+    rewrite Z.geb_leb, Z.ltb_antisym; auto.
+    rewrite Z.leb_antisym; auto.
+    rewrite Z.gtb_ltb, Z.leb_antisym; auto.
+    rewrite Z.geb_leb, Z.leb_antisym; auto.
+    rewrite Z.geb_leb, Z.gtb_ltb, Z.leb_antisym; auto.
+    rewrite Z.gtb_ltb, Z.ltb_antisym; auto.
+    rewrite Z.geb_leb, Z.gtb_ltb, Z.ltb_antisym; auto.
+  Qed.
+
+
+  Lemma check_neg_hatom_correct_bool : wt t_i t_func t_atom ->
+    wf t_atom -> default t_atom = Acop CO_xH ->
+    forall h1 h2, check_neg_hatom h1 h2 ->
+      interp_form_hatom t_i t_func t_atom h1 = negb (interp_form_hatom t_i t_func t_atom h2).
+  Proof.
+    unfold interp_form_hatom. intros Hwt H1 H2 h1 h2 H3. unfold interp_bool. generalize (check_neg_hatom_correct Hwt H1 H2 _ _ H3). case (interp_hatom t_i t_func t_atom h1). case (interp_hatom t_i t_func t_atom h2). simpl. intros [i| | | ] v1 [j| | | ] v2; intro H; inversion H. rewrite Typ.cast_refl. auto.
+  Qed.
+
+End CheckAtom.
+
+
+(* Flattening *)
+
+Section FLATTEN.
+
+  Import Form.
+
+  Variable t_form : PArray.array form.
+
+  Local Notation get_form := (PArray.get t_form).
+
+  Definition remove_not l :=
+    match get_form (Lit.blit l) with
+      | Fnot2 _ l' => if Lit.is_pos l then l' else Lit.neg l'
+      | _ => l
+    end.
+
+  Definition get_and l :=
+    let l := remove_not l in
+      if Lit.is_pos l then
+        match get_form (Lit.blit l) with
+          | Fand args => Some args
+          | _ => None
+        end
+        else None.
+
+  Definition get_or l :=
+    let l := remove_not l in
+      if Lit.is_pos l then
+        match get_form (Lit.blit l) with
+          | For args => Some args
+          | _ => None
+        end
+        else None.
+
+  Definition flatten_op_body (get_op:_lit -> option (array _lit))
+    (frec : list _lit -> _lit -> list _lit)
+    (largs:list _lit) (l:_lit) : list _lit :=
+    match get_op l with
+      | Some a => PArray.fold_left frec largs a
+      | None => l::largs
+    end.
+  Register flatten_op_body as PrimInline.
+
+
+  Definition flatten_op_lit (get_op:_lit -> option (array _lit)) max :=
+    foldi_cont (fun _ => flatten_op_body get_op) 0 max (fun largs l => l::largs).
+
+  Definition flatten_and t :=
+    PArray.fold_left (flatten_op_lit get_and (PArray.length t_form)) nil t.
+
+  Definition flatten_or t :=
+    PArray.fold_left (flatten_op_lit get_or (PArray.length t_form)) nil t.
+
+
+  Variable check_atom check_neg_atom : atom -> atom -> bool.
+
+  Definition check_flatten_body frec (l lf:_lit) :=
+    let l := remove_not l in
+      let lf := remove_not lf in
+        if l == lf then true
+          else if 1 land (l lxor lf) == 0 then
+            match get_form (Lit.blit l), get_form (Lit.blit lf) with
+              | Fatom a1, Fatom a2 => check_atom a1 a2
+              | Ftrue, Ftrue => true
+              | Ffalse, Ffalse => true
+              | Fand args1, Fand args2 =>
+                let args1 := flatten_and args1 in
+                  let args2 := flatten_and args2 in
+                    forallb2 frec args1 args2
+              | For args1, For args2 =>
+                let args1 := flatten_or args1 in
+                  let args2 := flatten_or args2 in
+                    forallb2 frec args1 args2
+              | Fxor l1 l2, Fxor lf1 lf2 =>
+                frec l1 lf1 && frec l2 lf2
+              | Fimp args1, Fimp args2 =>
+                if PArray.length args1 == PArray.length args2 then
+                  PArray.forallbi (fun i l => frec l (args2.[i])) args1
+                  else false
+              | Fiff l1 l2, Fiff lf1 lf2 =>
+                frec l1 lf1 && frec l2 lf2
+              | Fite l1 l2 l3, Fite lf1 lf2 lf3 =>
+                frec l1 lf1 && frec l2 lf2 && frec l3 lf3
+              | _, _ => false
+            end
+            else
+              match get_form (Lit.blit l), get_form (Lit.blit lf) with
+                | Fatom a1, Fatom a2 => check_neg_atom a1 a2
+                | _, _ => false (* We maybe need to extend the rule here ... *)
+              end.
+  Register check_flatten_body as PrimInline.
+
+  Definition check_flatten_aux l lf :=
+    foldi_cont (fun _ => check_flatten_body) 0 (PArray.length t_form) (fun _ _ => false) l lf.
+
+  Definition check_flatten s cid lf :=
+    match S.get s cid with
+      | l :: nil =>
+        if check_flatten_aux l lf then lf::nil else C._true
+      | _ => C._true
+    end.
+
+
+  (** Correctness proofs *)
+  Variable interp_atom : atom -> bool.
+  Hypothesis default_thf : default t_form = Ftrue.
+  Hypothesis wf_thf : wf t_form.
+  Hypothesis check_atom_correct :
+    forall a1 a2, check_atom a1 a2 -> interp_atom a1 = interp_atom a2.
+  Hypothesis check_neg_atom_correct :
+    forall a1 a2, check_neg_atom a1 a2 -> interp_atom a1 = negb (interp_atom a2).
+
+  Local Notation interp_var := (interp_state_var interp_atom t_form).
+  Local Notation interp_lit := (Lit.interp interp_var).
+
+  Lemma interp_Fnot2 : forall i l, interp interp_atom t_form (Fnot2 i l) = interp_lit l.
+  Proof.
+    intros i l;simpl;apply fold_ind;trivial.
+    intros a;rewrite negb_involutive;trivial.
+  Qed.
+
+  Lemma remove_not_correct :
+    forall l, interp_lit (remove_not l) = interp_lit l.
+  Proof.
+    unfold remove_not;intros l.
+    case_eq (get_form (Lit.blit l));intros;trivial.
+    unfold Lit.interp, Var.interp.
+    rewrite (wf_interp_form interp_atom t_form default_thf wf_thf (Lit.blit l)), H, interp_Fnot2.
+    destruct(Lit.is_pos l);trivial.
+    rewrite Lit.is_pos_neg, Lit.blit_neg;unfold Lit.interp;destruct (Lit.is_pos i0);trivial.
+    rewrite negb_involutive;trivial.
+  Qed.
+
+  Lemma get_and_correct : forall l args, get_and l = Some args ->
+    interp_lit l = interp interp_atom t_form (Fand args).
+  Proof.
+    unfold get_and;intros l args.
+    rewrite <- remove_not_correct;unfold Lit.interp;generalize (remove_not l).
+    intros l';unfold Var.interp.
+    destruct (Lit.is_pos l');[ | discriminate].
+    rewrite wf_interp_form;trivial.
+    destruct (get_form (Lit.blit l'));intros Heq;inversion Heq;trivial.
+  Qed.
+
+  Lemma get_or_correct : forall l args, get_or l = Some args ->
+    interp_lit l = interp interp_atom t_form (For args).
+  Proof.
+    unfold get_or;intros l args.
+    rewrite <- remove_not_correct;unfold Lit.interp;generalize (remove_not l).
+    intros l';unfold Var.interp.
+    destruct (Lit.is_pos l');[ | discriminate].
+    rewrite wf_interp_form;trivial.
+    destruct (get_form (Lit.blit l'));intros Heq;inversion Heq;trivial.
+  Qed.
+
+  Lemma flatten_and_correct : forall args,
+    List.fold_right (fun l res => andb res (interp_lit l)) true (flatten_and args) =
+    afold_left _ _ true andb interp_lit args.
+  Proof.
+    intros;rewrite afold_left_spec;auto;unfold flatten_and.
+    set (t:= true);unfold t at 2;
+      change true with
+        (List.fold_right (fun (l : int) (res : bool) => res && interp_lit l) true nil).
+    unfold t;clear t.
+    rewrite !fold_left_to_list.
+    generalize (@nil int);induction (to_list args);simpl;trivial.
+    intros l0;rewrite IHl.
+    clear IHl;f_equal; unfold flatten_op_lit.
+    clear l;revert a l0;apply foldi_cont_ind;simpl;trivial.
+    intros i cont _ Hle Hrec a l;unfold flatten_op_body.
+    case_eq (get_and a);intros;trivial.
+    rewrite get_and_correct with (1:= H);simpl.
+    rewrite afold_left_spec; auto; rewrite !fold_left_to_list.
+    rewrite <- !fold_left_rev_right.
+    clear H a;revert l;induction (List.rev (to_list a0));simpl.
+    intros l;rewrite andb_true_r;trivial.
+    intros;rewrite Hrec, IHl, andb_assoc;trivial.
+  Qed.
+
+  Lemma flatten_or_correct : forall args,
+    List.fold_right (fun l res => orb res (interp_lit l)) false (flatten_or args) =
+    afold_left _ _ false orb interp_lit args.
+  Proof.
+    intros;rewrite afold_left_spec;auto;unfold flatten_or.
+    set (t:= false);unfold t at 2;
+      change false with
+        (List.fold_right (fun (l : int) (res : bool) => res || interp_lit l) false nil).
+    unfold t;clear t.
+    rewrite !fold_left_to_list.
+    generalize (@nil int);induction (to_list args);simpl;trivial.
+    intros l0;rewrite IHl.
+    clear IHl;f_equal; unfold flatten_op_lit.
+    clear l;revert a l0;apply foldi_cont_ind;simpl;trivial.
+    intros i cont _ Hle Hrec a l;unfold flatten_op_body.
+    case_eq (get_or a);intros;trivial.
+    rewrite get_or_correct with (1:= H);simpl.
+    rewrite afold_left_spec; auto; rewrite !fold_left_to_list.
+    rewrite <- !fold_left_rev_right.
+    clear H a;revert l;induction (List.rev (to_list a0));simpl.
+    intros l;rewrite orb_false_r;trivial.
+    intros;rewrite Hrec, IHl, orb_assoc;trivial.
+  Qed.
+
+  Lemma check_flatten_aux_correct : forall l lf,
+    check_flatten_aux l lf = true ->
+    interp_lit l = interp_lit lf.
+  Proof.
+    unfold check_flatten_aux.
+    apply foldi_cont_ind.
+    discriminate.
+    intros i cont _ Hle Hrec l lf;unfold check_flatten_body.
+    rewrite <- (remove_not_correct l), <- (remove_not_correct lf).
+    generalize (remove_not l) (remove_not lf);clear l lf;intros l lf.
+    destruct (reflect_eqb l lf);[ intros;subst;trivial | ].
+    destruct (reflect_eqb (1 land (l lxor lf)) 0).
+    unfold Lit.interp.
+    assert (Lit.is_pos l = Lit.is_pos lf).
+    unfold Lit.is_pos.
+    rewrite <- eqb_spec, land_comm in e.
+    change (is_true (is_even (l lxor lf))) in e.
+    rewrite is_even_xor in e.
+    destruct (is_even l);destruct (is_even lf);trivial;discriminate.
+    rewrite H;match goal with
+                |- ?P -> _ =>
+                assert (W:P -> Var.interp interp_var (Lit.blit l) = Var.interp interp_var (Lit.blit lf));
+                  [ | intros;rewrite W;trivial]
+              end.
+    unfold Var.interp;rewrite !wf_interp_form;trivial.
+    clear e n H.
+    destruct (get_form (Lit.blit l));
+      destruct (get_form (Lit.blit lf));intros;try discriminate;simpl;trivial.
+     (* atom *)
+    apply check_atom_correct;trivial.
+     (* and *)
+    rewrite <- !flatten_and_correct.
+    revert H;generalize (flatten_and a) (flatten_and a0);clear a a0.
+    induction l0;intros l1;destruct l1;simpl;trivial;try discriminate.
+    rewrite andb_true_iff;intros (H1, H2).
+    rewrite (Hrec _ _ H1), (IHl0 _ H2);trivial.
+     (* or *)
+    rewrite <- !flatten_or_correct.
+    revert H;generalize (flatten_or a) (flatten_or a0);clear a a0.
+    induction l0;intros l1;destruct l1;simpl;trivial;try discriminate.
+    rewrite andb_true_iff;intros (H1, H2).
+    rewrite (Hrec _ _ H1), (IHl0 _ H2);trivial.
+     (* implb *)
+    revert H;destruct (reflect_eqb (length a) (length a0));[intros|discriminate].
+    apply afold_right_eq;trivial.
+    rewrite forallbi_spec in H;auto.
+     (* xorb *)
+    unfold is_true in H;rewrite andb_true_iff in H;destruct H as [H H0].
+    rewrite (Hrec _ _ H), (Hrec _ _ H0);trivial.
+    (* eqb (i.e iff) *)
+    unfold is_true in H;rewrite andb_true_iff in H;destruct H as [H H0].
+    rewrite (Hrec _ _ H), (Hrec _ _ H0);trivial.
+     (* ifb *)
+    unfold is_true in H;rewrite !andb_true_iff in H;destruct H as [[H H0] H1].
+    rewrite (Hrec _ _ H), (Hrec _ _ H0), (Hrec _ _ H1);trivial.
+     (** opposite sign *)
+    assert (Lit.is_pos l = negb (Lit.is_pos lf)).
+    unfold Lit.is_pos.
+    rewrite <- eqb_spec, land_comm in n0.
+    change (~is_true (is_even (l lxor lf))) in n0.
+    rewrite is_even_xor in n0.
+    destruct (is_even l);destruct (is_even lf);trivial;elim n0;reflexivity.
+    unfold Lit.interp;rewrite H. match goal with
+                                  |- ?P -> _ =>
+                                  assert (W:P -> Var.interp interp_var (Lit.blit l) = negb (Var.interp interp_var (Lit.blit lf)));
+                                    [ | intros;rewrite W;trivial]
+                                end.
+    unfold Var.interp;rewrite !wf_interp_form;trivial.
+    destruct (get_form (Lit.blit l));try discriminate.
+    destruct (get_form (Lit.blit lf));try discriminate.
+    apply check_neg_atom_correct.
+    rewrite negb_involutive;destruct (Lit.is_pos lf);trivial.
+  Qed.
+
+  Hypothesis Hwf: Valuation.wf interp_var.
+
+  Lemma valid_check_flatten : forall s, S.valid interp_var s ->
+    forall cid lf, C.valid interp_var (check_flatten s cid lf).
+  Proof.
+    unfold check_flatten; intros s Hs cid lf; case_eq (S.get s cid).
+    intros; apply C.interp_true; auto.
+    intros i [ |l q] Heq; try apply C.interp_true; auto; case_eq (check_flatten_aux i lf); intro Heq2; try apply C.interp_true; auto; unfold C.valid; simpl; rewrite <- (check_flatten_aux_correct _ _ Heq2); unfold S.valid in Hs; generalize (Hs cid); rewrite Heq; auto.
+  Qed.
+
+End FLATTEN.
diff --git a/src/trace/coqTerms.ml b/src/trace/coqTerms.ml
new file mode 100644
index 0000000..1ee6448
--- /dev/null
+++ b/src/trace/coqTerms.ml
@@ -0,0 +1,187 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Coqlib
+
+let gen_constant modules constant = lazy (gen_constant_in_modules "SMT" modules constant)
+
+(* Int63 *)
+let int63_modules = [["Coq";"Numbers";"Cyclic";"Int63";"Int63Native"]]
+
+let cint = gen_constant int63_modules "int"
+let ceq63 = gen_constant int63_modules "eqb"
+
+(* PArray *)
+let parray_modules = [["Coq";"Array";"PArray"]]
+
+let carray = gen_constant parray_modules "array"
+
+(* Positive *)
+let positive_modules = [["Coq";"Numbers";"BinNums"];
+                        ["Coq";"PArith";"BinPosDef";"Pos"]]
+
+let cpositive = gen_constant positive_modules "positive"
+let cxI = gen_constant positive_modules "xI"
+let cxO = gen_constant positive_modules "xO"
+let cxH = gen_constant positive_modules "xH"
+let ceqbP = gen_constant positive_modules "eqb"
+
+(* Z *)
+let z_modules = [["Coq";"Numbers";"BinNums"];
+                 ["Coq";"ZArith";"BinInt"];
+                 ["Coq";"ZArith";"BinInt";"Z"]]
+
+let cZ = gen_constant z_modules "Z"
+let cZ0 = gen_constant z_modules "Z0"
+let cZpos = gen_constant z_modules "Zpos"
+let cZneg = gen_constant z_modules "Zneg"
+let copp = gen_constant z_modules "opp"
+let cadd = gen_constant z_modules "add"
+let csub = gen_constant z_modules "sub"
+let cmul = gen_constant z_modules "mul"
+let cltb = gen_constant z_modules "ltb"
+let cleb = gen_constant z_modules "leb"
+let cgeb = gen_constant z_modules "geb"
+let cgtb = gen_constant z_modules "gtb"
+(* Je ne comprends pas pourquoi ça fonctionne avec Zeq_bool et pas avec
+   Z.eqb *)
+(* let ceqbZ = gen_constant z_modules "eqb" *)
+let ceqbZ = gen_constant [["Coq";"ZArith";"Zbool"]] "Zeq_bool"
+
+(* Booleans *)
+let bool_modules = [["Coq";"Bool";"Bool"]]
+
+let cbool = gen_constant init_modules "bool"
+let ctrue = gen_constant init_modules "true"
+let cfalse = gen_constant init_modules "false"
+let candb = gen_constant init_modules "andb"
+let corb = gen_constant init_modules "orb"
+let cxorb = gen_constant init_modules "xorb"
+let cnegb = gen_constant init_modules "negb"
+let cimplb = gen_constant init_modules "implb"
+let ceqb = gen_constant  bool_modules "eqb"
+let cifb = gen_constant bool_modules "ifb"
+let creflect = gen_constant bool_modules "reflect"
+
+(* Lists *)
+let clist = gen_constant init_modules "list"
+let cnil = gen_constant init_modules "nil"
+let ccons = gen_constant init_modules "cons"
+
+
+(* Option *)
+let coption = gen_constant init_modules "option"
+let cSome = gen_constant init_modules "Some"
+let cNone = gen_constant init_modules "None"
+
+(* Pairs *)
+let cpair = gen_constant init_modules "pair"
+
+(* Logical Operators *)
+let cnot = gen_constant init_modules "not"
+let ceq = gen_constant init_modules "eq"
+let crefl_equal = gen_constant init_modules "eq_refl"
+
+(* SMT_terms *)
+
+let smt_modules = [ ["SMTCoq";"Misc"];
+		    ["SMTCoq";"State"];
+		    ["SMTCoq";"SMT_terms"];
+		    ["SMTCoq";"SMT_terms";"Typ"];
+		    ["SMTCoq";"SMT_terms";"Form"];
+		    ["SMTCoq";"SMT_terms";"Atom"]
+		  ]
+
+let cdistinct = gen_constant smt_modules "distinct"
+
+let ctype = gen_constant smt_modules "type"
+let cTZ = gen_constant smt_modules "TZ"
+let cTbool = gen_constant smt_modules "Tbool"
+let cTpositive = gen_constant smt_modules "Tpositive"
+let cTindex = gen_constant smt_modules "Tindex"
+
+let ctyp_eqb = gen_constant smt_modules "typ_eqb"
+let cTyp_eqb = gen_constant smt_modules "Typ_eqb"
+let cte_carrier = gen_constant smt_modules "te_carrier"
+let cte_eqb = gen_constant smt_modules "te_eqb"
+let cunit_typ_eqb = gen_constant smt_modules "unit_typ_eqb"
+
+let ctval =  gen_constant smt_modules "tval"
+let cTval =  gen_constant smt_modules "Tval"
+
+let cCO_xH = gen_constant smt_modules "CO_xH"
+let cCO_Z0 = gen_constant smt_modules "CO_Z0"
+
+let cUO_xO = gen_constant smt_modules "UO_xO"
+let cUO_xI = gen_constant smt_modules "UO_xI"
+let cUO_Zpos = gen_constant smt_modules "UO_Zpos"
+let cUO_Zneg = gen_constant smt_modules "UO_Zneg"
+let cUO_Zopp = gen_constant smt_modules "UO_Zopp"
+
+let cBO_Zplus = gen_constant smt_modules "BO_Zplus"
+let cBO_Zminus = gen_constant smt_modules "BO_Zminus"
+let cBO_Zmult = gen_constant smt_modules "BO_Zmult"
+let cBO_Zlt = gen_constant smt_modules "BO_Zlt"
+let cBO_Zle = gen_constant smt_modules "BO_Zle"
+let cBO_Zge = gen_constant smt_modules "BO_Zge"
+let cBO_Zgt = gen_constant smt_modules "BO_Zgt"
+let cBO_eq = gen_constant smt_modules "BO_eq"
+
+let cNO_distinct = gen_constant smt_modules "NO_distinct"
+
+let catom = gen_constant smt_modules "atom"
+let cAcop = gen_constant smt_modules "Acop"
+let cAuop = gen_constant smt_modules "Auop"
+let cAbop = gen_constant smt_modules "Abop"
+let cAnop = gen_constant smt_modules "Anop"
+let cAapp = gen_constant smt_modules "Aapp"
+
+let cform  = gen_constant smt_modules "form"
+let cFatom = gen_constant smt_modules "Fatom"
+let cFtrue = gen_constant smt_modules "Ftrue"
+let cFfalse = gen_constant smt_modules "Ffalse"
+let cFnot2 = gen_constant smt_modules "Fnot2"
+let cFand = gen_constant smt_modules "Fand"
+let cFor = gen_constant smt_modules "For"
+let cFxor = gen_constant smt_modules "Fxor"
+let cFimp = gen_constant smt_modules "Fimp"
+let cFiff = gen_constant smt_modules "Fiff"
+let cFite = gen_constant smt_modules "Fite"
+
+let cis_true = gen_constant smt_modules "is_true"
+
+let make_certif_ops modules = 
+ (gen_constant modules "step", 
+  gen_constant modules "Res", gen_constant modules "ImmFlatten", 
+  gen_constant modules "CTrue", gen_constant modules "CFalse", 
+  gen_constant modules "BuildDef", gen_constant modules "BuildDef2", 
+  gen_constant modules "BuildProj", 
+  gen_constant modules "ImmBuildProj", gen_constant modules"ImmBuildDef", 
+  gen_constant modules"ImmBuildDef2",
+  gen_constant modules "EqTr", gen_constant modules "EqCgr", gen_constant modules "EqCgrP", 
+  gen_constant modules "LiaMicromega", gen_constant modules "LiaDiseq", gen_constant modules "SplArith", gen_constant modules "SplDistinctElim")
+  
+
+(** Usefull construction *)
+
+let ceq_refl_true = 
+  lazy (SmtMisc.mklApp crefl_equal [|Lazy.force cbool;Lazy.force ctrue|])
+
+let eq_refl_true () = Lazy.force ceq_refl_true
+
+let vm_cast_true t = 
+  Term.mkCast(eq_refl_true (),
+	      Term.VMcast, 
+	      SmtMisc.mklApp ceq [|Lazy.force cbool; t; Lazy.force ctrue|])
diff --git a/src/trace/satAtom.ml b/src/trace/satAtom.ml
new file mode 100644
index 0000000..ca72504
--- /dev/null
+++ b/src/trace/satAtom.ml
@@ -0,0 +1,65 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+open SmtMisc
+open CoqTerms
+
+module Atom = 
+  struct 
+
+    type t = int 
+
+    let index a = a
+
+    let equal a1 a2 = a1 == a2
+
+    let is_bool_type a = true
+
+    type reify_tbl =
+        { mutable count : int;
+	          tbl : (Term.constr, int) Hashtbl.t 
+	}
+
+    let create () = 
+      { count = 0;
+	tbl =  Hashtbl.create 17 }
+
+    let declare reify a = 
+      let res = reify.count in
+      Hashtbl.add reify.tbl a res;
+      reify.count <- res + 1;
+      res
+
+    let get reify a =
+      try Hashtbl.find reify.tbl a 
+      with Not_found -> declare reify a
+
+    let atom_tbl reify =
+      let t = Array.make (reify.count + 1) (Lazy.force ctrue) in
+      let set c i = t.(i) <- c in
+      Hashtbl.iter set reify.tbl;
+      t
+
+    let interp_tbl reify =
+      Term.mkArray (Lazy.force cbool, atom_tbl reify)
+
+  end
+
+module Form = SmtForm.Make(Atom)
+module Trace = SmtTrace.MakeOpt(Form)
+module Cnf = SmtCnf.MakeCnf(Form)
+
+      
+
diff --git a/src/trace/smtAtom.ml b/src/trace/smtAtom.ml
new file mode 100644
index 0000000..3164692
--- /dev/null
+++ b/src/trace/smtAtom.ml
@@ -0,0 +1,748 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+open SmtMisc
+open CoqTerms
+
+(** Syntaxified version of Coq type *)
+type indexed_type = Term.constr gen_hashed
+
+let dummy_indexed_type i = {index = i; hval = Term.mkProp}
+let indexed_type_index i = i.index
+
+type btype =
+  | TZ
+  | Tbool
+  | Tpositive
+  | Tindex of indexed_type
+
+module Btype = 
+  struct 
+
+    let index_tbl = Hashtbl.create 17 
+
+    let index_to_coq i =
+      let i = i.index in 
+      try Hashtbl.find index_tbl i
+      with Not_found ->
+	let interp = mklApp cTindex [|mkInt i|] in
+	Hashtbl.add index_tbl i interp;
+	interp
+
+    let equal t1 t2 =
+      match t1,t2 with
+        | Tindex i, Tindex j -> i.index == j.index
+        | _ -> t1 == t2
+
+    let to_coq = function 
+      | TZ -> Lazy.force cTZ
+      | Tbool -> Lazy.force cTbool
+      | Tpositive -> Lazy.force cTpositive
+      | Tindex i -> index_to_coq i
+
+    let to_smt fmt = function
+      | TZ -> Format.fprintf fmt "Int"
+      | Tbool -> Format.fprintf fmt "Bool"
+      | Tpositive -> Format.fprintf fmt "Int"
+      | Tindex i -> Format.fprintf fmt "Tindex_%i" i.index
+
+    (* reify table *)
+    type reify_tbl = 
+        { mutable count : int;
+	          tbl : (Term.constr, btype) Hashtbl.t
+	}
+
+    let create () = 
+      let htbl = Hashtbl.create 17 in  
+      Hashtbl.add htbl (Lazy.force cZ) TZ;
+      Hashtbl.add htbl (Lazy.force cbool) Tbool;
+      (* Hashtbl.add htbl (Lazy.force cpositive) Tpositive; *)
+      { count = 0;
+	tbl = htbl }
+
+    let declare reify t typ_eqb =
+      (* TODO: allows to have only typ_eqb *)
+      assert (not (Hashtbl.mem reify.tbl t));
+      let res = Tindex {index = reify.count; hval = typ_eqb} in
+      Hashtbl.add reify.tbl t res;
+      reify.count <- reify.count + 1;
+      res
+
+    let of_coq reify t =
+      try
+        Hashtbl.find reify.tbl t
+      with | Not_found ->
+        let eq_t = declare_new_variable (Names.id_of_string "eq") (Term.mkArrow t (Term.mkArrow t (Lazy.force cbool))) in
+        let x = mkName "x" in
+        let y = mkName "y" in
+        let rx = Term.mkRel 2 in
+        let ry = Term.mkRel 1 in
+        let eq_refl = Term.mkProd (x,t,Term.mkProd (y,t,mklApp creflect [|mklApp ceq [|t;rx;ry|];mklApp (lazy eq_t) [|rx;ry|]|])) in
+        let eq_refl_v = declare_new_variable (Names.id_of_string ("eq_refl")) eq_refl in
+        let ce = mklApp cTyp_eqb [|t;eq_t;eq_refl_v|] in
+        declare reify t ce
+
+    let interp_tbl reify =
+      let t = Array.make (reify.count + 1) (Lazy.force cunit_typ_eqb) in
+      let set _ = function 
+	| Tindex it -> t.(it.index) <- it.hval
+	| _ -> () in
+      Hashtbl.iter set reify.tbl;
+      Term.mkArray (Lazy.force ctyp_eqb, t)
+
+    let to_list reify =
+      let set _ t acc = match t with
+	| Tindex it -> (it.index,it)::acc
+	| _ -> acc in
+      Hashtbl.fold set reify.tbl []
+
+    let interp_to_coq reify = function
+      | TZ -> Lazy.force cZ
+      | Tbool -> Lazy.force cbool
+      | Tpositive -> Lazy.force cpositive
+      | Tindex c -> mklApp cte_carrier [|c.hval|]
+
+  end
+
+(** Operators *)
+
+type cop = 
+   | CO_xH
+   | CO_Z0
+
+type uop =
+   | UO_xO
+   | UO_xI
+   | UO_Zpos 
+   | UO_Zneg
+   | UO_Zopp
+
+type bop = 
+   | BO_Zplus
+   | BO_Zminus
+   | BO_Zmult
+   | BO_Zlt
+   | BO_Zle
+   | BO_Zge
+   | BO_Zgt
+   | BO_eq of btype
+
+type nop =
+  | NO_distinct of btype
+
+type op_def = { 
+    tparams : btype array; 
+    tres : btype; 
+    op_val : Term.constr }
+
+type indexed_op = op_def gen_hashed 
+
+let dummy_indexed_op i dom codom = {index = i; hval = {tparams = dom; tres = codom; op_val = Term.mkProp}}
+let indexed_op_index op = op.index
+
+type op = 
+  | Cop of cop
+  | Uop of uop
+  | Bop of bop
+  | Nop of nop
+  | Iop of indexed_op
+
+module Op =
+  struct 
+    let c_to_coq = function
+      | CO_xH -> Lazy.force cCO_xH
+      | CO_Z0 -> Lazy.force cCO_Z0
+
+    let c_type_of = function
+      | CO_xH -> Tpositive
+      | CO_Z0 -> TZ
+
+    let interp_cop = function
+      | CO_xH -> Lazy.force cxH
+      | CO_Z0 -> Lazy.force cZ0
+
+    let u_to_coq = function 
+      | UO_xO -> Lazy.force cUO_xO
+      | UO_xI -> Lazy.force cUO_xI
+      | UO_Zpos -> Lazy.force cUO_Zpos 
+      | UO_Zneg -> Lazy.force cUO_Zneg
+      | UO_Zopp -> Lazy.force cUO_Zopp
+
+    let u_type_of = function 
+      | UO_xO | UO_xI -> Tpositive
+      | UO_Zpos | UO_Zneg | UO_Zopp -> TZ
+
+    let u_type_arg = function 
+      | UO_xO | UO_xI | UO_Zpos | UO_Zneg -> Tpositive
+      | UO_Zopp -> TZ
+
+    let interp_uop = function
+      | UO_xO -> Lazy.force cxO
+      | UO_xI -> Lazy.force cxI
+      | UO_Zpos -> Lazy.force cZpos
+      | UO_Zneg -> Lazy.force cZneg
+      | UO_Zopp -> Lazy.force copp
+
+    let eq_tbl = Hashtbl.create 17 
+
+    let eq_to_coq t =
+      try Hashtbl.find eq_tbl t 
+      with Not_found ->
+	let op = mklApp cBO_eq [|Btype.to_coq t|] in
+	Hashtbl.add eq_tbl t op;
+	op
+     
+    let b_to_coq = function
+      | BO_Zplus -> Lazy.force cBO_Zplus
+      | BO_Zminus -> Lazy.force cBO_Zminus
+      | BO_Zmult -> Lazy.force cBO_Zmult
+      | BO_Zlt -> Lazy.force cBO_Zlt
+      | BO_Zle -> Lazy.force cBO_Zle
+      | BO_Zge -> Lazy.force cBO_Zge
+      | BO_Zgt -> Lazy.force cBO_Zgt
+      | BO_eq t -> eq_to_coq t
+
+    let b_type_of = function
+      | BO_Zplus | BO_Zminus | BO_Zmult -> TZ
+      | BO_Zlt | BO_Zle | BO_Zge | BO_Zgt | BO_eq _ -> Tbool
+
+    let b_type_args = function
+      | BO_Zplus | BO_Zminus | BO_Zmult 
+      | BO_Zlt | BO_Zle | BO_Zge | BO_Zgt -> (TZ,TZ)
+      | BO_eq t -> (t,t)
+
+    let interp_eq = function
+      | TZ -> Lazy.force ceqbZ
+      | Tbool -> Lazy.force ceqb
+      | Tpositive -> Lazy.force ceqbP
+      | Tindex i -> mklApp cte_eqb [|i.hval|]
+
+    let interp_bop = function
+      | BO_Zplus -> Lazy.force cadd
+      | BO_Zminus -> Lazy.force csub
+      | BO_Zmult -> Lazy.force cmul
+      | BO_Zlt -> Lazy.force cltb
+      | BO_Zle -> Lazy.force cleb
+      | BO_Zge -> Lazy.force cgeb
+      | BO_Zgt -> Lazy.force cgtb
+      | BO_eq t -> interp_eq t
+
+    let n_to_coq = function
+      | NO_distinct t -> mklApp cNO_distinct [|Btype.to_coq t|]
+
+    let n_type_of = function
+      | NO_distinct _ -> Tbool
+
+    let n_type_args = function
+      | NO_distinct ty -> ty
+
+    let interp_distinct = function
+      | TZ -> Lazy.force cZ
+      | Tbool -> Lazy.force cbool
+      | Tpositive -> Lazy.force cpositive
+      | Tindex i -> mklApp cte_carrier [|i.hval|]
+
+    let interp_nop = function
+      | NO_distinct ty -> mklApp cdistinct [|interp_distinct ty;interp_eq ty|]
+
+    let i_to_coq i = mkInt i.index
+
+    let i_type_of i = i.hval.tres
+
+    let i_type_args i = i.hval.tparams
+	  
+    (* reify table *)
+    type reify_tbl =
+        { mutable count : int;
+	          tbl : (Term.constr, indexed_op) Hashtbl.t
+	}
+
+    let create () = 
+      { count = 0;
+	tbl =  Hashtbl.create 17 }
+
+    let declare reify op tparams tres =
+      assert (not (Hashtbl.mem reify.tbl op));
+      let v = { tparams = tparams; tres = tres; op_val = op } in
+      let res = {index = reify.count; hval = v } in
+      Hashtbl.add reify.tbl op res;
+      reify.count <- reify.count + 1;
+      res
+
+    let of_coq reify op =
+      Hashtbl.find reify.tbl op
+
+
+    let interp_tbl tval mk_Tval reify =
+      let t = Array.make (reify.count + 1) 
+	  (mk_Tval [||] Tbool (Lazy.force ctrue))  in
+      let set _ v = 
+	t.(v.index) <- mk_Tval v.hval.tparams v.hval.tres v.hval.op_val in
+      Hashtbl.iter set reify.tbl;
+      Term.mkArray (tval, t)
+
+    let to_list reify =
+      let set _ op acc =
+        let value = op.hval in
+        (op.index,value.tparams,value.tres,op)::acc in
+      Hashtbl.fold set reify.tbl []
+
+    let c_equal op1 op2 = op1 == op2
+
+    let u_equal op1 op2 = op1 == op2
+
+    let b_equal op1 op2 =
+      match op1,op2 with
+        | BO_eq t1, BO_eq t2 -> Btype.equal t1 t2
+        | _ -> op1 == op2
+
+    let n_equal op1 op2 =
+      match op1,op2 with
+        | NO_distinct t1, NO_distinct t2 -> Btype.equal t1 t2
+
+    let i_equal op1 op2 = op1.index == op2.index
+
+  end
+
+
+(** Definition of atoms *)
+
+type atom = 
+  | Acop of cop
+  | Auop of uop * hatom 
+  | Abop of bop * hatom * hatom 
+  | Anop of nop * hatom array
+  | Aapp of indexed_op * hatom array
+
+and hatom = atom gen_hashed
+
+(* let pp_acop = function *)
+(*   | CO_xH -> "CO_xH" *)
+(*   | CO_Z0 -> "CO_Z0" *)
+
+(* let pp_auop = function *)
+(*   | UO_xO -> "UO_xO" *)
+(*   | UO_xI -> "UO_xI" *)
+(*   | UO_Zpos -> "UO_Zpos" *)
+(*   | UO_Zneg -> "UO_Zneg" *)
+(*   | UO_Zopp -> "UO_Zopp" *)
+
+(* let pp_abop = function *)
+(*   | BO_Zplus -> "BO_Zplus" *)
+(*   | BO_Zminus -> "BO_Zminus" *)
+(*   | BO_Zmult -> "BO_Zmult" *)
+(*   | BO_Zlt -> "BO_Zlt" *)
+(*   | BO_Zle -> "BO_Zle" *)
+(*   | BO_Zge -> "BO_Zge" *)
+(*   | BO_Zgt -> "BO_Zgt" *)
+(*   | BO_eq _ -> "(BO_eq ??)" *)
+
+(* let rec pp_atom = function *)
+(*   | Acop c -> "(Acop "^(pp_acop c)^")" *)
+(*   | Auop (u,b) -> "(Auop "^(pp_auop u)^" "^(pp_atom b.hval)^")" *)
+(*   | Abop (b,c,d) -> "(Abop "^(pp_abop b)^" "^(pp_atom c.hval)^" "^(pp_atom d.hval)^")" *)
+(*   | Aapp (op,a) -> "(Aapp "^(string_of_int op.index)^" ("^(Array.fold_left (fun acc h -> acc^" "^(pp_atom h.hval)) "" a)^"))" *)
+
+module HashedAtom =
+  struct 
+    type t = atom
+
+    let equal a b =
+      match a, b with
+      | Acop opa, Acop opb -> Op.c_equal opa opb
+      | Auop(opa,ha), Auop(opb,hb) -> Op.u_equal opa opb && ha.index == hb.index
+      | Abop(opa,ha1,ha2), Abop(opb,hb1,hb2) ->
+	  Op.b_equal opa opb && ha1.index == hb1.index && ha2.index == hb2.index
+      | Anop (opa,ha), Anop (opb,hb) ->
+        let na = Array.length ha in
+        let nb = Array.length hb in
+        let i = ref (-1) in
+        Op.n_equal opa opb && na == nb && Array.fold_left (fun b h -> incr i; b && h.index == hb.(!i).index) true ha
+      | Aapp (va,ha), Aapp (vb,hb) ->
+        let na = Array.length ha in
+        let nb = Array.length hb in
+        let i = ref (-1) in
+        Op.i_equal va vb && na == nb && Array.fold_left (fun b h -> incr i; b && h.index == hb.(!i).index) true ha
+      | _, _ -> false
+
+    let hash = function
+      |	Acop op -> ((Hashtbl.hash op) lsl 3) lxor 1
+      | Auop (op,h) ->
+          (( (h.index lsl 3) + (Hashtbl.hash op)) lsl 3) lxor 2
+      | Abop (op,h1,h2) ->
+          (((( (h1.index lsl 2) + h2.index) lsl 3) + Hashtbl.hash op) lsl 3) lxor 3
+      | Anop (op, args) ->
+          let hash_args =
+            match Array.length args with
+            | 0 -> 0
+            | 1 -> args.(0).index
+            | 2 -> args.(1).index lsl 2 + args.(0).index
+            | _ -> args.(2).index lsl 4 + args.(1).index lsl 2 + args.(0).index in
+          (hash_args lsl 5 + (Hashtbl.hash op) lsl 3) lxor 4
+      | Aapp (op, args) ->
+          let hash_args =
+            match Array.length args with
+            | 0 -> 0
+            | 1 -> args.(0).index
+            | 2 -> args.(1).index lsl 2 + args.(0).index
+            | _ -> args.(2).index lsl 4 + args.(1).index lsl 2 + args.(0).index in
+          (hash_args lsl 5 + op.index lsl 3) lxor 4
+
+  end
+
+module HashAtom = Hashtbl.Make(HashedAtom)
+
+module Atom = 
+  struct 
+
+    type t = hatom
+
+    let atom h = h.hval
+    let index h = h.index 
+
+    let equal h1 h2 = h1.index == h2.index
+
+    let type_of h =
+      match h.hval with
+      | Acop op -> Op.c_type_of op
+      | Auop (op,_) -> Op.u_type_of op
+      | Abop (op,_,_) -> Op.b_type_of op
+      | Anop (op,_) -> Op.n_type_of op
+      | Aapp (op,_) -> Op.i_type_of op
+
+    let is_bool_type h = Btype.equal (type_of h) Tbool
+
+
+    let rec compute_int = function
+      | Acop c ->
+        (match c with
+          | CO_xH -> 1
+          | CO_Z0 -> 0)
+      | Auop (op,h) ->
+        (match op with
+          | UO_xO -> 2*(compute_hint h)
+          | UO_xI -> 2*(compute_hint h) + 1
+          | UO_Zpos -> compute_hint h
+          | UO_Zneg -> - (compute_hint h)
+          | UO_Zopp -> assert false)
+      | _ -> assert false
+
+    and compute_hint h = compute_int (atom h)
+
+    let to_smt_int fmt i =
+      let s1 = if i < 0 then "(- " else "" in
+      let s2 = if i < 0 then ")" else "" in
+      let j = if i < 0 then -i else i in
+      Format.fprintf fmt "%s%i%s" s1 j s2
+
+    let rec to_smt fmt h = to_smt_atom fmt (atom h)
+
+    and to_smt_atom fmt = function
+      | Acop _ as a -> to_smt_int fmt (compute_int a)
+      | Auop (UO_Zopp,h) ->
+        Format.fprintf fmt "(- ";
+        to_smt fmt h;
+        Format.fprintf fmt ")"
+      | Auop _ as a -> to_smt_int fmt (compute_int a)
+      | Abop (op,h1,h2) -> to_smt_bop fmt op h1 h2
+      | Anop (op,a) -> to_smt_nop fmt op a
+      | Aapp (op,a) ->
+        if Array.length a = 0 then (
+          Format.fprintf fmt "op_%i" op.index;
+        ) else (
+          Format.fprintf fmt "(op_%i" op.index;
+          Array.iter (fun h -> Format.fprintf fmt " "; to_smt fmt h) a;
+          Format.fprintf fmt ")"
+        )
+
+    and to_smt_bop fmt op h1 h2 =
+      let s = match op with
+        | BO_Zplus -> "+"
+        | BO_Zminus -> "-"
+        | BO_Zmult -> "*"
+        | BO_Zlt -> "<"
+        | BO_Zle -> "<="
+        | BO_Zge -> ">="
+        | BO_Zgt -> ">"
+        | BO_eq _ -> "=" in
+      Format.fprintf fmt "(%s " s;
+      to_smt fmt h1;
+      Format.fprintf fmt " ";
+      to_smt fmt h2;
+      Format.fprintf fmt ")"
+
+    and to_smt_nop fmt op a =
+      let s = match op with
+        | NO_distinct _ -> "distinct" in
+      Format.fprintf fmt "(%s" s;
+      Array.iter (fun h -> Format.fprintf fmt " "; to_smt fmt h) a;
+      Format.fprintf fmt ")"
+
+
+
+    exception NotWellTyped of atom
+
+    let check a =
+      match a with
+      | Acop _ -> ()
+      | Auop(op,h) -> 
+	  if not (Btype.equal (Op.u_type_arg op) (type_of h)) then
+	    raise (NotWellTyped a)
+      | Abop(op,h1,h2) ->
+	  let (t1,t2) = Op.b_type_args op in
+	  if not (Btype.equal t1 (type_of h1) && Btype.equal t2 (type_of h2))
+	  then raise (NotWellTyped a)
+      | Anop(op,ha) ->
+        let ty = Op.n_type_args op in
+        Array.iter (fun h -> if not (Btype.equal ty (type_of h)) then raise (NotWellTyped a)) ha
+      | Aapp(op,args) ->
+	  let tparams = Op.i_type_args op in
+	  Array.iteri (fun i t -> 
+	    if not (Btype.equal t (type_of args.(i))) then
+		raise (NotWellTyped a)) tparams
+
+    type reify_tbl =
+        { mutable count : int;
+	          tbl : hatom HashAtom.t 
+	}
+
+    let create () = 
+      { count = 0;
+	tbl =  HashAtom.create 17 }
+
+    let clear reify =
+      reify.count <- 0;
+      HashAtom.clear reify.tbl
+
+    let declare reify a = 
+      check a;
+      let res = {index = reify.count; hval = a} in
+      HashAtom.add reify.tbl a res;
+      reify.count <- reify.count + 1;
+      res
+
+    let get reify a =
+      try HashAtom.find reify.tbl a 
+      with Not_found -> declare reify a
+
+
+    (** Given a coq term, build the corresponding atom *)
+    type coq_cst =
+      | CCxH
+      | CCZ0
+      | CCxO
+      | CCxI
+      | CCZpos
+      | CCZneg
+      | CCZopp
+      | CCZplus
+      | CCZminus
+      | CCZmult
+      | CCZlt
+      | CCZle
+      | CCZge
+      | CCZgt
+      | CCeqb
+      | CCeqbP
+      | CCeqbZ
+      | CCunknown
+
+    let op_tbl () =
+      let tbl = Hashtbl.create 29 in
+      let add (c1,c2) = Hashtbl.add tbl (Lazy.force c1) c2 in
+      List.iter add
+	[ cxH,CCxH; cZ0,CCZ0;
+          cxO,CCxO; cxI,CCxI; cZpos,CCZpos; cZneg,CCZneg; copp,CCZopp;
+          cadd,CCZplus; csub,CCZminus; cmul,CCZmult; cltb,CCZlt;
+          cleb,CCZle; cgeb,CCZge; cgtb,CCZgt; ceqb,CCeqb; ceqbP,CCeqbP;
+          ceqbZ, CCeqbZ
+        ];
+      tbl
+
+    let op_tbl = lazy (op_tbl ())
+
+    let of_coq rt ro reify env sigma c =
+      let op_tbl = Lazy.force op_tbl in
+      let get_cst c =
+	try Hashtbl.find op_tbl c with Not_found -> CCunknown in
+      let mk_cop op = get reify (Acop op) in
+      let rec mk_hatom h =
+	let c, args = Term.decompose_app h in
+	match get_cst c with
+          | CCxH -> mk_cop CO_xH
+          | CCZ0 -> mk_cop CO_Z0
+          | CCxO -> mk_uop UO_xO args
+          | CCxI -> mk_uop UO_xI args
+          | CCZpos -> mk_uop UO_Zpos args
+          | CCZneg -> mk_uop UO_Zneg args
+          | CCZopp -> mk_uop UO_Zopp args
+          | CCZplus -> mk_bop BO_Zplus args
+          | CCZminus -> mk_bop BO_Zminus args
+          | CCZmult -> mk_bop BO_Zmult args
+          | CCZlt -> mk_bop BO_Zlt args
+          | CCZle -> mk_bop BO_Zle args
+          | CCZge -> mk_bop BO_Zge args
+          | CCZgt -> mk_bop BO_Zgt args
+          | CCeqb -> mk_bop (BO_eq Tbool) args
+          | CCeqbP -> mk_bop (BO_eq Tpositive) args
+          | CCeqbZ -> mk_bop (BO_eq TZ) args
+	  | CCunknown -> mk_unknown c args (Retyping.get_type_of env sigma h)
+
+      and mk_uop op = function
+        | [a] -> let h = mk_hatom a in get reify (Auop (op,h))
+        | _ -> assert false
+
+      and mk_bop op = function
+        | [a1;a2] ->
+          let h1 = mk_hatom a1 in
+          let h2 = mk_hatom a2 in
+          get reify (Abop (op,h1,h2))
+        | _ -> assert false
+
+      and mk_unknown c args ty =
+        let hargs = Array.of_list (List.map mk_hatom args) in
+        let op =
+          try Op.of_coq ro c
+          with | Not_found ->
+            let targs = Array.map type_of hargs in
+            let tres = Btype.of_coq rt ty in
+            Op.declare ro c targs tres in
+        get reify (Aapp (op,hargs)) in
+
+       mk_hatom c
+
+
+    let to_coq h = mkInt h.index
+
+    let a_to_coq a =
+      match a with
+      | Acop op -> mklApp cAcop [|Op.c_to_coq op|]
+      | Auop (op,h) -> mklApp cAuop [|Op.u_to_coq op; to_coq h|]
+      | Abop (op,h1,h2) -> 
+	  mklApp cAbop [|Op.b_to_coq op;to_coq h1; to_coq h2|]
+      | Anop (op,ha) ->
+        let cop = Op.n_to_coq op in
+        let cargs = Array.fold_right (fun h l -> mklApp ccons [|Lazy.force cint; to_coq h; l|]) ha (mklApp cnil [|Lazy.force cint|]) in
+        mklApp cAnop [|cop; cargs|]
+      | Aapp (op,args) ->
+        let cop = Op.i_to_coq op in
+        let cargs = Array.fold_right (fun h l -> mklApp ccons [|Lazy.force cint; to_coq h; l|]) args (mklApp cnil [|Lazy.force cint|]) in
+        mklApp cAapp [|cop; cargs|]
+
+    let dft_atom = lazy (mklApp cAcop [| Lazy.force cCO_xH |])
+
+    let to_array reify dft f =
+      let t = Array.make (reify.count + 1) dft in
+      let set _ h = t.(h.index) <- f h.hval in
+      HashAtom.iter set reify.tbl;
+      t
+
+    let interp_tbl reify =
+      let t = to_array reify (Lazy.force dft_atom) a_to_coq in
+      Term.mkArray (Lazy.force catom, t)
+
+
+    (** Producing a Coq term corresponding to the interpretation of an atom *)
+    let interp_to_coq atom_tbl a =
+      let rec interp_atom a =
+	let l = index a in
+	try Hashtbl.find atom_tbl l
+	with Not_found ->
+	  let pc =
+	    match atom a with
+              | Acop c -> Op.interp_cop c
+              | Auop (op,h) -> Term.mkApp (Op.interp_uop op, [|interp_atom h|])
+              | Abop (op,h1,h2) -> Term.mkApp (Op.interp_bop op, [|interp_atom h1; interp_atom h2|])
+              | Anop (NO_distinct ty as op,ha) ->
+                let cop = Op.interp_nop op in
+                let typ = Op.interp_distinct ty in
+                let cargs = Array.fold_right (fun h l -> mklApp ccons [|typ; interp_atom h; l|]) ha (mklApp cnil [|typ|]) in
+                Term.mkApp (cop,[|cargs|])
+              | Aapp (op,t) -> Term.mkApp (op.hval.op_val, Array.map interp_atom t) in
+	  Hashtbl.add atom_tbl l pc;
+	  pc in
+      interp_atom a
+
+
+    (* Generation of atoms *)
+
+    let mk_nop op reify a = get reify (Anop (op,a))
+
+    let mk_binop op reify h1 h2 = get reify (Abop (op, h1, h2))
+
+    let mk_unop op reify h = get reify (Auop (op, h))
+
+    let rec hatom_pos_of_int reify i =
+      if i <= 1 then
+        get reify (Acop CO_xH)
+      else
+        if i land 1 = 0
+        then mk_unop UO_xO reify (hatom_pos_of_int reify (i lsr 1))
+        else mk_unop UO_xI reify (hatom_pos_of_int reify (i lsr 1))
+
+    let hatom_Z_of_int reify i =
+      if i = 0 then
+        get reify (Acop CO_Z0)
+      else
+        if i > 0
+        then mk_unop UO_Zpos reify (hatom_pos_of_int reify i)
+        else mk_unop UO_Zneg reify (hatom_pos_of_int reify (-i))
+
+    let rec hatom_pos_of_bigint reify i =
+      if Big_int.le_big_int i Big_int.unit_big_int then
+        get reify (Acop CO_xH)
+      else
+        let (q,r) = Big_int.quomod_big_int i (Big_int.big_int_of_int 2) in
+        if Big_int.eq_big_int r Big_int.zero_big_int then
+          mk_unop UO_xO reify (hatom_pos_of_bigint reify q)
+        else
+          mk_unop UO_xI reify (hatom_pos_of_bigint reify q)
+
+    let hatom_Z_of_bigint reify i =
+      if Big_int.eq_big_int i Big_int.zero_big_int then
+        get reify (Acop CO_Z0)
+      else
+        if Big_int.gt_big_int i Big_int.zero_big_int then
+          mk_unop UO_Zpos reify (hatom_pos_of_bigint reify i)
+        else
+          mk_unop UO_Zneg reify (hatom_pos_of_bigint reify (Big_int.minus_big_int i))
+
+    let mk_eq reify ty h1 h2 =
+      let op = BO_eq ty in
+      try
+        HashAtom.find reify.tbl (Abop (op, h1, h2))
+      with
+        | Not_found ->
+          try
+            HashAtom.find reify.tbl (Abop (op, h2, h1))
+          with
+            | Not_found ->
+              declare reify (Abop (op, h1, h2))
+
+    let mk_lt = mk_binop BO_Zlt
+    let mk_le = mk_binop BO_Zle
+    let mk_gt = mk_binop BO_Zgt
+    let mk_ge = mk_binop BO_Zge
+    let mk_plus = mk_binop BO_Zplus
+    let mk_minus = mk_binop BO_Zminus
+    let mk_mult = mk_binop BO_Zmult
+    let mk_opp = mk_unop UO_Zopp
+    let mk_distinct reify ty = mk_nop (NO_distinct ty) reify
+
+  end
+
+
+module Form = SmtForm.Make(Atom)
+module Trace = SmtTrace.MakeOpt(Form)
diff --git a/src/trace/smtAtom.mli b/src/trace/smtAtom.mli
new file mode 100644
index 0000000..8eadb49
--- /dev/null
+++ b/src/trace/smtAtom.mli
@@ -0,0 +1,175 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+type indexed_type
+
+val dummy_indexed_type: int -> indexed_type
+val indexed_type_index : indexed_type -> int
+
+type btype =
+  | TZ
+  | Tbool
+  | Tpositive
+  | Tindex of indexed_type
+
+module Btype : 
+    sig
+      
+      val equal : btype -> btype -> bool
+	  
+      val to_coq : btype -> Term.constr
+
+      val to_smt : Format.formatter -> btype -> unit
+
+      type reify_tbl
+	  
+      val create : unit -> reify_tbl
+
+      val declare : reify_tbl -> Term.constr -> Term.constr -> btype
+
+      val of_coq : reify_tbl -> Term.constr -> btype
+
+      val interp_tbl : reify_tbl -> Term.constr
+
+      val to_list : reify_tbl -> (int * indexed_type) list
+
+      val interp_to_coq : reify_tbl -> btype -> Term.constr
+
+    end
+
+(** Operators *)
+
+type cop = 
+   | CO_xH
+   | CO_Z0
+
+type uop =
+   | UO_xO
+   | UO_xI
+   | UO_Zpos 
+   | UO_Zneg
+   | UO_Zopp
+
+type bop = 
+   | BO_Zplus
+   | BO_Zminus
+   | BO_Zmult
+   | BO_Zlt
+   | BO_Zle
+   | BO_Zge
+   | BO_Zgt
+   | BO_eq of btype
+
+type nop =
+  | NO_distinct of btype
+
+type indexed_op
+
+val dummy_indexed_op: int -> btype array -> btype -> indexed_op
+val indexed_op_index : indexed_op -> int
+
+module Op :
+  sig
+	  
+    type reify_tbl
+
+    val create : unit -> reify_tbl
+
+    val declare : reify_tbl -> Term.constr -> btype array -> btype -> indexed_op
+
+    val of_coq : reify_tbl -> Term.constr -> indexed_op
+
+    val interp_tbl : Term.constr -> 
+      (btype array -> btype -> Term.constr -> Term.constr) -> 
+      reify_tbl -> Term.constr 
+
+    val to_list : reify_tbl -> (int * (btype array) * btype * indexed_op) list
+
+  end
+
+
+(** Definition of atoms *)
+
+type hatom 
+
+type atom = 
+  | Acop of cop
+  | Auop of uop * hatom 
+  | Abop of bop * hatom * hatom 
+  | Anop of nop * hatom array
+  | Aapp of indexed_op * hatom array
+
+
+
+module Atom : 
+    sig 
+
+      type t = hatom
+
+      val equal : hatom -> hatom -> bool
+
+      val index : hatom -> int
+
+      val atom : hatom -> atom
+ 
+      val type_of : hatom -> btype
+
+      val to_smt : Format.formatter -> t -> unit
+
+      exception NotWellTyped of atom
+
+      type reify_tbl 
+
+      val create : unit -> reify_tbl
+
+      val clear : reify_tbl -> unit
+
+      val get : reify_tbl -> atom -> hatom
+
+      (** Given a coq term, build the corresponding atom *)
+      val of_coq : Btype.reify_tbl -> Op.reify_tbl -> reify_tbl ->
+        Environ.env -> Evd.evar_map -> Term.constr -> t
+
+      val to_coq : hatom -> Term.constr
+
+      val to_array : reify_tbl -> 'a -> (atom -> 'a) -> 'a array
+
+      val interp_tbl : reify_tbl -> Term.constr
+
+      val interp_to_coq : (int, Term.constr) Hashtbl.t ->
+	t -> Term.constr
+
+      (* Generation of atoms *)
+      val hatom_Z_of_int : reify_tbl -> int -> hatom
+      val hatom_Z_of_bigint : reify_tbl -> Big_int.big_int -> hatom
+      val mk_eq : reify_tbl -> btype -> hatom -> hatom -> hatom
+      val mk_lt : reify_tbl -> hatom -> hatom -> hatom
+      val mk_le : reify_tbl -> hatom -> hatom -> hatom
+      val mk_gt : reify_tbl -> hatom -> hatom -> hatom
+      val mk_ge : reify_tbl -> hatom -> hatom -> hatom
+      val mk_plus : reify_tbl -> hatom -> hatom -> hatom
+      val mk_minus : reify_tbl -> hatom -> hatom -> hatom
+      val mk_mult : reify_tbl -> hatom -> hatom -> hatom
+      val mk_opp : reify_tbl -> hatom -> hatom
+      val mk_distinct : reify_tbl -> btype -> hatom array -> hatom
+
+    end
+
+
+module Form : SmtForm.FORM with type hatom = hatom
+module Trace : sig
+  val share_prefix : Form.t SmtCertif.clause -> int -> unit
+end
diff --git a/src/trace/smtCertif.ml b/src/trace/smtCertif.ml
new file mode 100644
index 0000000..76036a5
--- /dev/null
+++ b/src/trace/smtCertif.ml
@@ -0,0 +1,140 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open SmtForm
+
+type used = int
+
+type clause_id  = int
+
+type 'hform rule =
+  | ImmFlatten of 'hform clause * 'hform 
+
+  (* CNF Transformations *)
+  | True       
+     (*  * true             : {true} 
+     *)
+  | False 
+     (* * false             : {(not false)} 
+     *)
+  | BuildDef of 'hform (* the first literal of the clause *)       
+     (*  * and_neg          : {(and a_1 ... a_n) (not a_1) ... (not a_n)}
+         * or_pos           : {(not (or a_1 ... a_n)) a_1 ... a_n} 
+         * implies_pos      : {(not (implies a b)) (not a) b}
+         * xor_pos1         : {(not (xor a b)) a b}
+         * xor_neg1         : {(xor a b) a (not b)}
+         * equiv_pos1       : {(not (iff a b)) a (not b)}
+         * equiv_neg1       : {(iff a b) (not a) (not b)}
+         * ite_pos1         : {(not (if_then_else a b c)) a c}
+         * ite_neg1         : {(if_then_else a b c) a (not c)}
+     *)
+  | BuildDef2 of 'hform (* the first literal of the clause *) 
+     (* * xor_pos2          : {(not (xor a b)) (not a) (not b)}
+        * xor_neg2          : {(xor a b) (not a) b}
+        * equiv_pos2        : {(not (iff a b)) (not a) b}
+        * equiv_neg2        : {(iff a b) a b}
+        * ite_pos2          : {(not (if_then_else a b c)) (not a) b}
+        * ite_neg2          : {(if_then_else a b c) (not a) (not b)}
+
+     *)
+  | BuildProj of 'hform * int 
+     (*  * or_neg           : {(or a_1 ... a_n) (not a_i)}
+         * and_pos          : {(not (and a_1 ... a_n)) a_i} 
+         * implies_neg1     : {(implies a b) a}
+         * implies_neg2     : {(implies a b) (not b)}
+     *)
+
+  (* Immediate CNF transformation : CNF transformation + Reso *)
+  | ImmBuildDef of 'hform clause 
+     (* * not_and           : {(not (and a_1 ... a_n))} --> {(not a_1) ... (not a_n)}
+        * or                : {(or a_1 ... a_n)} --> {a_1 ... a_n}
+        * implies           : {(implies a b)} --> {(not a) b}
+        * xor1              : {(xor a b)} --> {a b}
+        * not_xor1          : {(not (xor a b))} --> {a (not b)}
+        * equiv2            : {(iff a b)} --> {a (not b)}
+        * not_equiv2        : {(not (iff a b))} --> {(not a) (not b)}
+        * ite1              : {(if_then_else a b c)} --> {a c}
+        * not_ite1          : {(not (if_then_else a b c))} --> {a (not c)}
+     *)
+  | ImmBuildDef2 of 'hform clause
+     (* * xor2              : {(xor a b)} --> {(not a) (not b)}
+        * not_xor2          : {(not (xor a b))} --> {(not a) b}
+        * equiv1            : {(iff a b)} --> {(not a) b}
+        * not_equiv1        : {(not (iff a b))} --> {a b}
+        * ite2              : {(if_then_else a b c)} --> {(not a) b}
+        * not_ite2          : {(not (if_then_else a b c))} --> {(not a) (not b)}
+     *)
+  | ImmBuildProj of 'hform clause * int
+     (*  * and               : {(and a_1 ... a_n)} --> {a_i} 
+         * not_or            : {(not (or a_1 ... a_n))} --> {(not a_i)}
+         * not_implies1      : {(not (implies a b))} --> {a}
+         * not_implies2      : {(not (implies a b))} --> {(not b)}
+     *)
+
+  (* Equality *)
+  | EqTr of 'hform * 'hform list
+    (*  * eq_reflexive     : {(= x x)}
+        * eq_transitive    : {(not (= x_1 x_2)) ... (not (= x_{n-1} x_n)) (= x_1 x_n)}
+    *)
+  | EqCgr of 'hform * ('hform option) list
+    (*  * eq_congruent     : {(not (= x_1 y_1)) ... (not (= x_n y_n)) 
+                                   (= (f x_1 ... x_n) (f y_1 ... y_n))}
+    *)
+  | EqCgrP of 'hform * 'hform * ('hform option) list
+    (*  * eq_congruent_pred : {(not (= x_1 y_1)) ... (not (= x_n y_n)) 
+                                   (not (p x_1 ... x_n)) (p y_1 ... y_n)}
+    *)
+
+  (* Linear arithmetic *)
+  | LiaMicromega of 'hform list * Certificate.Mc.zArithProof list
+  | LiaDiseq of 'hform
+
+  (* Arithmetic simplifications *)
+  | SplArith of 'hform clause * 'hform * Certificate.Mc.zArithProof list
+
+  (* Elimination of operators *)
+  | SplDistinctElim of 'hform clause * 'hform
+
+and 'hform clause = {
+            id    : clause_id;
+    mutable kind  : 'hform clause_kind;
+    mutable pos   : int option;
+    mutable used  : used;
+    mutable prev  : 'hform clause option;
+    mutable next  : 'hform clause option;
+            value : 'hform list option
+              (* This field should be defined for rules which can create atoms :
+                 EqTr, EqCgr, EqCgrP, Lia, Dlde, Lra *)
+}
+
+and 'hform clause_kind =
+  | Root
+  | Same of 'hform clause
+  | Res of 'hform resolution
+  | Other of 'hform rule
+
+and 'hform resolution = {
+  mutable rc1   : 'hform clause;
+  mutable rc2   : 'hform clause;
+  mutable rtail : 'hform clause list}
+
+let used_clauses r =
+  match r with
+  | ImmBuildProj (c, _) | ImmBuildDef c | ImmBuildDef2 c
+  | ImmFlatten (c,_)  | SplArith (c,_,_) | SplDistinctElim (c,_) -> [c]
+  | True | False | BuildDef _ | BuildDef2 _ | BuildProj _
+  | EqTr _ | EqCgr _ | EqCgrP _
+  | LiaMicromega _ | LiaDiseq _ -> []
diff --git a/src/trace/smtCnf.ml b/src/trace/smtCnf.ml
new file mode 100644
index 0000000..d159db0
--- /dev/null
+++ b/src/trace/smtCnf.ml
@@ -0,0 +1,264 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open SmtForm
+open SmtCertif
+open SmtTrace
+
+module MakeCnf (Form:FORM) =
+  struct 
+
+    type form_info = 
+      | Immediate of bool (* true if the positive literal is set *) 
+      | Done (* means that the equivalence clauses have been generated *)
+      | Todo (* nothing has been done, process the cnf transformation *)
+
+    let info = Hashtbl.create 17 
+
+    let init_last = 
+      let last = SmtTrace.mk_scertif Root None in
+      SmtTrace.clear ();
+      last
+
+    let last = ref init_last
+
+    let cnf_todo = ref [] 
+
+    let clear () = 
+      Hashtbl.clear info;
+      last := init_last;
+      cnf_todo := []
+
+    let push_cnf args = cnf_todo := args :: !cnf_todo
+
+    let get_info l =
+      try Hashtbl.find info (Form.index l)
+      with Not_found -> Todo 
+
+    let set_done l =
+      Hashtbl.add info (Form.index l) Done
+
+    let set_immediate l = 
+      Hashtbl.add info (Form.index l) (Immediate (Form.is_pos l))
+
+    let test_immediate l = 
+      match get_info l with
+      | Immediate b -> b = Form.is_pos l 
+      | _ -> false
+
+    let check_trivial cl =
+      List.exists test_immediate cl 
+
+    let link_Other other cl =
+      if not (check_trivial cl) then 
+	let c = mkOther other (Some cl) in
+	link !last c;
+	last := c
+
+    let both_lit l = if Form.is_pos l then Form.neg l,l else l, Form.neg l 
+
+    let or_of_imp args =  
+      Array.mapi (fun i l -> 
+	if i = Array.length args - 1 then l else Form.neg l) args 
+
+    let rec cnf l =
+      match get_info l with
+      | Immediate _ | Done -> ()
+      | Todo -> 
+	  match Form.pform l with
+	  | Fatom _ -> ()
+
+	  | Fapp (op,args) ->
+	      match op with
+	      | Ftrue | Ffalse -> () 
+
+	      | Fand ->
+		  let nl,pl = both_lit l in
+		  let nargs = Array.map Form.neg args in
+		  link_Other (BuildDef pl) (pl::Array.to_list nargs);
+		  Array.iteri (fun i l' -> 
+		    link_Other (BuildProj (nl,i)) [nl;l']) args;
+		  set_done l;
+		  Array.iter cnf args
+
+	      | For ->
+		  let nl,pl = both_lit l in
+		  link_Other (BuildDef nl) (nl::Array.to_list args);
+		  Array.iteri (fun i l' -> 
+		    link_Other (BuildProj(pl,i)) [pl;Form.neg l']) args;
+		  set_done l;
+		  Array.iter cnf args
+
+	      | Fimp ->
+		  let args = or_of_imp args in
+		  let nl,pl = both_lit l in
+		  link_Other (BuildDef nl) (nl::Array.to_list args);
+		  Array.iteri (fun i l' -> 
+		    link_Other (BuildProj(pl,i)) [pl;Form.neg l']) args;
+		  set_done l;
+		  Array.iter cnf args
+	
+	      | Fxor -> 
+		  let nl,pl = both_lit l in
+		  let a, b = args.(0), args.(1) in
+		  let na, nb = Form.neg a, Form.neg b in
+		  link_Other (BuildDef nl) [nl;a;b];
+		  link_Other (BuildDef pl) [pl;a;nb];
+		  link_Other (BuildDef2 nl) [nl;na;nb];
+		  link_Other (BuildDef2 pl) [pl;na;b];
+		  set_done l;
+		  cnf a;
+		  cnf b
+		
+	      | Fiff ->
+		  let nl,pl = both_lit l in
+		  let a, b = args.(0), args.(1) in
+		  let na, nb = Form.neg a, Form.neg b in
+		  link_Other (BuildDef nl) [nl;a;nb];
+		  link_Other (BuildDef pl) [pl;na;nb];
+		  link_Other (BuildDef2 nl) [pl;na;b];
+		  link_Other (BuildDef2 pl) [pl;a;b];
+		  set_done l;
+		  cnf a;
+		  cnf b
+
+	      | Fite ->
+		  let nl,pl = both_lit l in
+		  let a, b, c = args.(0), args.(1), args.(2) in
+		  let na, nb, nc = Form.neg a, Form.neg b, Form.neg c in
+		  link_Other (BuildDef nl) [nl;a;c];
+		  link_Other (BuildDef pl) [pl;a;nc];
+		  link_Other (BuildDef2 nl) [nl;na;b];
+		  link_Other (BuildDef2 pl) [pl;na;nb];
+		  set_done l;
+		  cnf a;
+		  cnf b;
+		  cnf c
+
+	      | Fnot2 _ -> cnf args.(0)
+ 
+    exception Cnf_done
+
+    let rec imm_link_Other other l =
+      if not (test_immediate l) then
+	let c = mkOther other (Some [l]) in
+	link !last c;
+	last := c;
+	imm_cnf c
+
+    and imm_cnf c =
+      let l = 
+	match c.value with
+	| Some [l] -> 
+	    begin match Form.pform l with
+	    | Fapp (Fnot2 _, args) -> 
+		let l' = args.(0) in
+		if Form.is_pos l then l'
+		else Form.neg l'
+	    | _ -> l
+	    end
+	| _ -> assert false in
+      match get_info l with
+      | Immediate b -> if b = Form.is_neg l then raise Cnf_done
+      | Done -> assert false
+      | Todo ->
+	  set_immediate l;
+
+	  match Form.pform l with
+	  | Fatom _ -> ()
+
+	  | Fapp (op,args) ->
+	      match op with
+	      | Ftrue | Ffalse -> ()
+
+	      | Fand ->
+		  if Form.is_pos l then 
+		    Array.iteri (fun i l' -> 
+		      imm_link_Other (ImmBuildProj(c,i)) l') args
+		  else begin
+		    let nargs = Array.map Form.neg args in
+		    link_Other (ImmBuildDef c) (Array.to_list nargs);
+		    push_cnf args
+		  end
+
+	      | For ->
+		  if Form.is_pos l then begin
+		    link_Other (ImmBuildDef c) (Array.to_list args);
+		    push_cnf args
+		  end else 
+		    Array.iteri (fun i l' ->
+		      imm_link_Other (ImmBuildProj(c,i)) (Form.neg l')) args
+
+	      | Fimp ->
+		  let args = or_of_imp args in
+		  if Form.is_pos l then begin
+		    link_Other (ImmBuildDef c) (Array.to_list args);
+		    push_cnf args
+		  end else 
+		    Array.iteri (fun i l' ->
+		      imm_link_Other (ImmBuildProj(c,i)) (Form.neg l')) args
+
+	      | Fxor -> 
+		  let args1 = 
+		    if Form.is_pos l then [args.(0);args.(1)]
+		    else [args.(0);Form.neg args.(1)] in
+		  let args2 =
+		    if Form.is_pos l then [Form.neg args.(0);Form.neg args.(1)] 
+		    else  [Form.neg args.(0); args.(1)] in
+		  link_Other (ImmBuildDef c) args1;
+		  link_Other (ImmBuildDef2 c) args2;
+		  push_cnf args
+		
+	      | Fiff ->
+		  let args1 = 
+		    if Form.is_pos l then [args.(0);Form.neg args.(1)]
+		    else [Form.neg args.(0);Form.neg args.(1)] in
+		  let args2 =
+		    if Form.is_pos l then [Form.neg args.(0);args.(1)] 
+		    else  [args.(0); args.(1)] in
+		  link_Other (ImmBuildDef c) args1;
+		  link_Other (ImmBuildDef2 c) args2;
+		  push_cnf args
+
+	      | Fite ->
+		  let args1 = 
+		    if Form.is_pos l then [args.(0);Form.neg args.(2)]
+		    else [args.(0);Form.neg args.(2)] in
+		  let args2 =
+		    if Form.is_pos l then [Form.neg args.(0);args.(1)] 
+		    else  [Form.neg args.(0); Form.neg args.(1)] in
+		  link_Other (ImmBuildDef c) args1;
+		  link_Other (ImmBuildDef2 c) args2;
+		  push_cnf args
+
+              | Fnot2 _ -> assert false
+
+    let make_cnf reify c =
+      let ftrue = Form.get reify (Fapp(Ftrue, [||])) in
+      let ffalse = Form.get reify (Fapp(Ffalse, [||])) in
+      last := c;
+      link_Other True [ftrue];
+      link_Other False [Form.neg ffalse];
+      (try 
+	imm_cnf c;
+	List.iter (Array.iter cnf) !cnf_todo
+      with Cnf_done -> ());
+      let res = !last in
+      clear ();
+      res
+
+  end
+
diff --git a/src/trace/smtForm.ml b/src/trace/smtForm.ml
new file mode 100644
index 0000000..6075b3f
--- /dev/null
+++ b/src/trace/smtForm.ml
@@ -0,0 +1,510 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+open Util
+open SmtMisc
+open CoqTerms
+open Errors
+
+module type ATOM = 
+  sig 
+
+    type t 
+    val index : t -> int
+
+    val equal : t -> t -> bool
+
+    val is_bool_type : t -> bool
+
+  end 
+
+
+type fop =
+  | Ftrue
+  | Ffalse
+  | Fand
+  | For
+  | Fxor
+  | Fimp
+  | Fiff
+  | Fite
+  | Fnot2 of int
+
+type ('a,'f) gen_pform = 
+  | Fatom of 'a
+  | Fapp of fop * 'f array
+
+
+module type FORM =
+  sig 
+    type hatom 
+    type t
+    type pform = (hatom, t) gen_pform
+
+      val pform_true : pform
+      val pform_false : pform
+
+      val equal : t -> t -> bool
+
+      val to_lit : t -> int
+      val index : t -> int
+      val pform : t -> pform
+
+      val neg : t -> t
+      val is_pos : t -> bool
+      val is_neg : t -> bool
+
+      val to_smt : (Format.formatter -> hatom -> unit) -> Format.formatter -> t -> unit
+
+      (* Building formula from positive formula *)
+      exception NotWellTyped of pform
+      type reify 
+      val create : unit -> reify 
+      val clear : reify -> unit
+      val get : reify -> pform -> t
+      
+      (** Give a coq term, build the corresponding formula *)  
+      val of_coq : (Term.constr -> hatom) -> reify -> Term.constr -> t
+   
+      (** Flattening of [Fand] and [For], removing of [Fnot2]  *)
+      val flatten : reify -> t -> t
+
+      (** Producing Coq terms *) 
+
+      val to_coq : t -> Term.constr
+
+      val pform_tbl : reify -> pform array
+
+      val to_array : reify -> 'a -> (pform -> 'a) -> int * 'a array
+      val interp_tbl : reify -> Term.constr * Term.constr
+      val nvars : reify -> int 
+      (** Producing a Coq term corresponding to the interpretation 
+          of a formula *)
+      (** [interp_atom] map [hatom] to coq term, it is better if it produce
+          shared terms. *)
+      val interp_to_coq : 
+	  (hatom -> Term.constr) -> (int, Term.constr) Hashtbl.t -> 
+	    t -> Term.constr
+  end
+
+module Make (Atom:ATOM) =
+  struct 
+
+    type hatom = Atom.t 
+
+    type pform = (Atom.t, t) gen_pform
+ 
+    and hpform = pform gen_hashed
+	  
+    and t = 
+      | Pos of hpform
+      | Neg of hpform 
+
+    let pform_true = Fapp (Ftrue,[||])
+    let pform_false = Fapp (Ffalse,[||])
+
+    let equal h1 h2 = 
+      match h1, h2 with
+      | Pos hp1, Pos hp2 -> hp1.index == hp2.index
+      | Neg hp1, Neg hp2 -> hp1.index == hp2.index
+      | _, _ -> false
+
+    let index = function
+      | Pos hp -> hp.index
+      | Neg hp -> hp.index
+
+    let to_lit = function
+      | Pos hp -> hp.index * 2
+      | Neg hp -> hp.index * 2 + 1
+
+    let neg = function
+      | Pos hp -> Neg hp
+      | Neg hp -> Pos hp
+	    
+    let is_pos = function
+      | Pos _ -> true
+      | _ -> false
+	    
+    let is_neg = function
+      | Neg _ -> true
+      | _ -> false
+
+    let pform = function
+      | Pos hp -> hp.hval
+      | Neg hp -> hp.hval
+
+
+    let rec to_smt atom_to_smt fmt = function
+      | Pos hp -> to_smt_pform atom_to_smt fmt hp.hval
+      | Neg hp ->
+        Format.fprintf fmt "(not ";
+        to_smt_pform atom_to_smt fmt hp.hval;
+        Format.fprintf fmt ")"
+
+    and to_smt_pform atom_to_smt fmt = function
+      | Fatom a -> atom_to_smt fmt a
+      | Fapp (op,args) -> to_smt_op atom_to_smt fmt op args
+
+    and to_smt_op atom_to_smt fmt op args =
+      let s = match op with
+        | Ftrue -> "true"
+        | Ffalse -> "false"
+        | Fand -> "and"
+        | For -> "or"
+        | Fxor -> "xor"
+        | Fimp -> "=>"
+        | Fiff -> "="
+        | Fite -> "ite"
+        | Fnot2 _ -> "" in
+      let (s1,s2) = if Array.length args = 0 then ("","") else ("(",")") in
+      Format.fprintf fmt "%s%s" s1 s;
+      Array.iter (fun h -> Format.fprintf fmt " "; to_smt atom_to_smt fmt h) args;
+      Format.fprintf fmt "%s" s2
+
+
+    module HashedForm =
+      struct 
+	
+	type t = pform
+	      
+	let equal pf1 pf2 = 
+	  match pf1, pf2 with
+	  | Fatom ha1, Fatom ha2 -> Atom.equal ha1 ha2
+	  | Fapp(op1,args1), Fapp(op2,args2) ->
+	      op1 = op2 && 
+	      Array.length args1 == Array.length args2 &&
+	      (try 
+		for i = 0 to Array.length args1 - 1 do
+		  if not (equal args1.(i) args2.(i)) then raise Not_found 
+		done;
+		true
+	      with Not_found -> false)
+	  | _, _ -> false
+
+	let hash pf = 
+	  match pf with
+	  | Fatom ha1 -> Atom.index ha1 * 2 
+	  | Fapp(op, args) -> 
+	      let hash_args =
+		match Array.length args with
+		| 0 -> 0
+		| 1 -> to_lit args.(0)
+		| 2 -> (to_lit args.(1)) lsl 2 + to_lit args.(0)
+		| _ -> 
+		    (to_lit args.(2)) lsl 4 + (to_lit args.(1)) lsl 2 +
+		      to_lit args.(0) in
+	      (hash_args * 10 + Hashtbl.hash op) * 2 + 1
+		
+      end
+
+    module HashForm = Hashtbl.Make (HashedForm)
+
+    type reify = {
+	mutable count : int;
+                tbl : t HashForm.t 
+      }  
+
+    exception NotWellTyped of pform
+   	
+    let check pf = 
+      match pf with
+      | Fatom ha ->  if not (Atom.is_bool_type ha) then raise (NotWellTyped pf)
+      | Fapp (op, args) ->
+	  match op with
+	  | Ftrue | Ffalse -> 
+	      if Array.length args <> 0 then raise (NotWellTyped pf)
+	  | Fnot2 _ -> 
+	      if Array.length args <> 1 then raise (NotWellTyped pf)
+	  | Fand | For -> ()
+	  | Fxor | Fimp | Fiff ->
+	      if Array.length args <> 2 then raise (NotWellTyped pf)
+	  | Fite ->
+	      if Array.length args <> 3 then raise (NotWellTyped pf)
+
+    let declare reify pf =
+      check pf;
+      let res = Pos {index = reify.count; hval = pf} in
+      HashForm.add reify.tbl pf res;
+      reify.count <- reify.count + 1;
+      res
+
+    let create () =
+      let reify = 
+	{ count = 0; 
+	  tbl =  HashForm.create 17 } in
+      let _ = declare reify pform_true in
+      let _ = declare reify pform_false in
+      reify
+
+    let clear r =
+      r.count <- 0;
+      HashForm.clear r.tbl;
+      let _ = declare r pform_true in
+      let _ = declare r pform_false in
+      ()
+
+    let get reify pf =
+      try HashForm.find reify.tbl pf 
+      with Not_found -> declare reify pf
+
+
+    (** Given a coq term, build the corresponding formula *)  
+    type coq_cst = 
+      | CCtrue
+      | CCfalse
+      | CCnot
+      | CCand
+      | CCor
+      | CCxor
+      | CCimp
+      | CCiff
+      | CCifb
+      | CCunknown
+
+    let op_tbl () =
+      let tbl = Hashtbl.create 29 in
+      let add (c1,c2) = Hashtbl.add tbl (Lazy.force c1) c2 in
+      List.iter add 
+	[
+	 ctrue,CCtrue; cfalse,CCfalse;
+	 candb,CCand; corb,CCor; cxorb,CCxor; cimplb,CCimp; cnegb,CCnot;
+         ceqb,CCiff; cifb,CCifb ];
+      tbl
+
+    let op_tbl = lazy (op_tbl ())
+
+    let empty_args = [||]
+
+    let of_coq atom_of_coq reify c =
+      let op_tbl = Lazy.force op_tbl in
+      let get_cst c = 
+	try Hashtbl.find op_tbl c with Not_found -> CCunknown in
+      let rec mk_hform h =
+	let c, args = Term.decompose_app h in
+	match get_cst c with
+	| CCtrue  -> get reify (Fapp(Ftrue,empty_args))
+	| CCfalse -> get reify (Fapp(Ffalse,empty_args))
+	| CCnot -> mk_fnot 1 args
+	| CCand -> mk_fand [] args
+	| CCor  -> mk_for [] args
+	| CCxor -> op2 (fun l -> Fapp(Fxor,l)) args
+	| CCiff -> op2 (fun l -> Fapp(Fiff,l)) args
+	| CCimp ->
+          (match args with
+            | [b1;b2] ->
+              let l1 = mk_hform b1 in
+              let l2 = mk_hform b2 in
+              get reify (Fapp (Fimp, [|l1;l2|]))
+            | _ -> error "SmtForm.Form.of_coq: wrong number of arguments for implb")
+	| CCifb ->
+	    (* We should also be able to syntaxify if then else *)
+	    begin match args with
+	    | [b1;b2;b3] ->
+		let l1 = mk_hform b1 in
+		let l2 = mk_hform b2 in
+		let l3 = mk_hform b3 in
+		get reify (Fapp(Fite, [|l1;l2;l3|]))
+	    | _ -> error "SmtForm.Form.of_coq: wrong number of arguments for ifb"
+	    end
+	| _ -> 
+	    let a = atom_of_coq  h in
+            get reify (Fatom a)
+
+      and op2 f args =
+	match args with
+	| [b1;b2] ->
+	    let l1 = mk_hform b1 in
+            let l2 = mk_hform b2 in
+            get reify (f [|l1; l2|])
+	| _ ->  error "SmtForm.Form.of_coq: wrong number of arguments"
+	  
+      and mk_fnot i args =
+	match args with
+	| [t] -> 
+	    let c,args = Term.decompose_app t in
+	    if c = Lazy.force cnegb then
+              mk_fnot (i+1) args
+	    else 
+              let q,r = i lsr 1 , i land 1 in
+              let l = mk_hform t in
+              let l = if r = 0 then l else neg l in
+	      if q = 0 then l
+	      else get reify (Fapp(Fnot2 q, [|l|]))
+	| _ -> error "SmtForm.Form.mk_hform: wrong number of arguments for negb"
+	  
+      and mk_fand acc args = 
+	match args with
+	| [t1;t2] -> 
+	    let l2 = mk_hform t2 in
+	    let c, args = Term.decompose_app t1 in
+	    if c = Lazy.force candb then
+              mk_fand (l2::acc) args
+	    else 
+	      let l1 = mk_hform t1 in
+	      get reify (Fapp(Fand, Array.of_list  (l1::l2::acc)))
+	| _ -> error "SmtForm.Form.mk_hform: wrong number of arguments for andb" 
+
+      and mk_for acc args = 
+	match args with
+	| [t1;t2] -> 
+	    let l2 = mk_hform t2 in
+	    let c, args = Term.decompose_app t1 in
+	    if c = Lazy.force corb then
+              mk_for (l2::acc) args
+	    else 
+	      let l1 = mk_hform t1 in
+	      get reify (Fapp(For, Array.of_list (l1::l2::acc)))
+	| _ -> error "SmtForm.Form.mk_hform: wrong number of arguments for orb" in
+
+      let l = mk_hform c in
+      l
+
+    (** Flattening of Fand and For, removing of Fnot2 *)
+    let set_sign f f' =
+      if is_pos f then f' else neg f'
+
+    let rec flatten reify f = 
+      match pform f with
+      | Fatom _ -> f
+      | Fapp(Fnot2 _,args) -> set_sign f (flatten reify args.(0))
+      | Fapp(Fand, args) -> set_sign f (flatten_and reify [] (Array.to_list args))
+      | Fapp(For,args) -> set_sign f (flatten_or reify [] (Array.to_list args))
+      | Fapp(op,args) ->
+          (* TODO change Fimp into For ? *)
+	  set_sign f (get reify (Fapp(op, Array.map (flatten reify) args)))
+
+    and flatten_and reify acc args =
+      match args with
+      | [] -> get reify (Fapp(Fand, Array.of_list (List.rev acc)))
+      | a::args ->
+	  (* TODO change (not For) and (not Fimp) into Fand *)
+	  match pform a with
+	  | Fapp(Fand, args') when is_pos a ->
+	      let args = Array.fold_right (fun a args -> a::args) args' args in
+	      flatten_and reify acc args
+	  | _ -> flatten_and reify (flatten reify a :: acc) args
+
+    and flatten_or reify acc args =
+      (* TODO change Fimp and (not Fand) into For *)
+      match args with
+      | [] -> get reify (Fapp(For, Array.of_list (List.rev acc)))
+      | a::args ->
+	  match pform a with
+	  | Fapp(For, args') when is_pos a ->
+	      let args = Array.fold_right (fun a args -> a::args) args' args in
+	      flatten_or reify acc args
+	  | _ -> flatten_or reify (flatten reify a :: acc) args
+
+    (** Producing Coq terms *) 
+
+    let to_coq hf = mkInt (to_lit hf)
+
+    let args_to_coq args =
+      let cargs = Array.make (Array.length args + 1) (mkInt 0) in
+      Array.iteri (fun i hf -> cargs.(i) <- to_coq hf) args;
+      Term.mkArray (Lazy.force cint, cargs)
+	
+    let pf_to_coq = function
+      | Fatom a -> mklApp cFatom [|mkInt (Atom.index a)|]	
+      | Fapp(op,args) ->
+        match op with
+	| Ftrue -> Lazy.force cFtrue
+	| Ffalse -> Lazy.force cFfalse
+	| Fand -> mklApp cFand [| args_to_coq args|]
+	| For  -> mklApp cFor [| args_to_coq args|]
+	| Fimp -> mklApp cFimp [| args_to_coq args|]
+	| Fxor -> mklApp cFxor (Array.map to_coq args)
+	| Fiff -> mklApp cFiff (Array.map to_coq args)
+	| Fite -> mklApp cFite (Array.map to_coq args)
+	| Fnot2 i -> mklApp cFnot2 [|mkInt i; to_coq args.(0)|]
+
+    let pform_tbl reify =
+      let t = Array.make reify.count pform_true in
+      let set _ h =
+	match h with
+	| Pos hp -> t.(hp.index) <- hp.hval
+	| _ -> assert false in
+      HashForm.iter set reify.tbl;
+      t
+
+    let to_array reify dft f =
+      let t = Array.make (reify.count + 1) dft in
+      let set _ h =
+	match h with
+	| Pos hp -> t.(hp.index) <- f hp.hval
+	| _ -> assert false in
+      HashForm.iter set reify.tbl;
+      (reify.count, t)
+
+    let interp_tbl reify =
+      let (i,t) = to_array reify (Lazy.force cFtrue) pf_to_coq in
+      (mkInt i, Term.mkArray (Lazy.force cform, t))
+
+    let nvars reify = reify.count
+    (** Producing a Coq term corresponding to the interpretation of a formula *)
+    (** [interp_atom] map [Atom.t] to coq term, it is better if it produce
+	shared terms. *)
+    let interp_to_coq interp_atom form_tbl f =
+      let rec interp_form f = 
+	let l = to_lit f in
+	try Hashtbl.find form_tbl l 
+	with Not_found ->
+	  if is_neg f then 
+	    let pc = interp_form (neg f) in
+	    let nc = mklApp cnegb [|pc|] in
+	    Hashtbl.add form_tbl l nc;
+	    nc
+	  else
+	    let pc = 
+	      match pform f with
+	      | Fatom a -> interp_atom a
+	      | Fapp(op, args) ->
+		  match op with
+		  | Ftrue -> Lazy.force ctrue
+		  | Ffalse -> Lazy.force cfalse
+		  | Fand -> interp_args candb args
+		  | For -> interp_args corb args
+		  | Fxor -> interp_args cxorb args
+		  | Fimp -> 
+		      let r = ref (interp_form args.(Array.length args - 1)) in
+		      for i = Array.length args - 2 downto 0 do
+			r := mklApp cimplb [|interp_form args.(i); !r|]
+		      done;
+		      !r
+		  | Fiff -> interp_args ceqb args
+		  | Fite -> 
+		      (* TODO with if here *)
+		      mklApp cifb (Array.map interp_form args)
+		  | Fnot2 n -> 
+		      let r = ref (interp_form args.(0)) in
+		      for i = 1 to n do	r := mklApp cnegb [|!r|] done;
+		      !r in 
+	    Hashtbl.add form_tbl l pc;
+	    pc
+      and interp_args op args =
+	let r = ref (interp_form args.(0)) in
+	for i = 1 to Array.length args - 1 do
+	  r := mklApp op [|!r;interp_form args.(i)|] 
+	done;
+	!r in
+      interp_form f
+
+  end
+	
+
+	  
+
+    
+
+  
diff --git a/src/trace/smtForm.mli b/src/trace/smtForm.mli
new file mode 100644
index 0000000..118ecf5
--- /dev/null
+++ b/src/trace/smtForm.mli
@@ -0,0 +1,99 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+module type ATOM = 
+  sig 
+
+    type t 
+    val index : t -> int
+
+    val equal : t -> t -> bool
+
+    val is_bool_type : t -> bool
+
+  end 
+
+
+type fop =
+  | Ftrue
+  | Ffalse
+  | Fand
+  | For
+  | Fxor
+  | Fimp
+  | Fiff
+  | Fite
+  | Fnot2 of int
+
+ 
+type ('a,'f) gen_pform = 
+  | Fatom of 'a
+  | Fapp of fop * 'f array
+
+module type FORM =
+  sig 
+    type hatom 
+    type t
+    type pform = (hatom, t) gen_pform
+
+      val pform_true : pform
+      val pform_false : pform
+
+      val equal : t -> t -> bool
+
+      val to_lit : t -> int
+      val index : t -> int
+      val pform : t -> pform
+
+      val neg : t -> t
+      val is_pos : t -> bool
+      val is_neg : t -> bool
+
+      val to_smt : (Format.formatter -> hatom -> unit) -> Format.formatter -> t -> unit
+
+      (* Building formula from positive formula *)
+      exception NotWellTyped of pform
+      type reify 
+      val create : unit -> reify
+      val clear : reify -> unit
+      val get : reify -> pform -> t
+      
+      (** Given a coq term, build the corresponding formula *)  
+      val of_coq : (Term.constr -> hatom) -> reify -> Term.constr -> t
+   
+      (** Flattening of [Fand] and [For], removing of [Fnot2]  *)
+      val flatten : reify -> t -> t
+
+      (** Producing Coq terms *) 
+
+      val to_coq : t -> Term.constr
+
+      val pform_tbl : reify -> pform array
+
+      val to_array : reify -> 'a -> (pform -> 'a) -> int * 'a array
+      val interp_tbl : reify -> Term.constr * Term.constr
+      val nvars : reify -> int 
+      (** Producing a Coq term corresponding to the interpretation 
+          of a formula *)
+      (** [interp_atom] map [hatom] to coq term, it is better if it produce
+          shared terms. *)
+      val interp_to_coq : 
+	  (hatom -> Term.constr) -> (int, Term.constr) Hashtbl.t -> 
+	    t -> Term.constr
+  end
+
+module Make (Atom:ATOM) : FORM with type hatom = Atom.t
+
+	
diff --git a/src/trace/smtMisc.ml b/src/trace/smtMisc.ml
new file mode 100644
index 0000000..02e5f26
--- /dev/null
+++ b/src/trace/smtMisc.ml
@@ -0,0 +1,47 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(** Sharing of coq Int *)
+let cInt_tbl = Hashtbl.create 17 
+
+let mkInt i = 
+  try Hashtbl.find cInt_tbl i 
+  with Not_found ->
+    let ci = Term.mkInt (Uint63.of_int i) in
+    Hashtbl.add cInt_tbl i ci;
+    ci
+
+(** Generic representation of shared object *)
+type 'a gen_hashed = { index : int; hval : 'a }
+
+(** Functions over constr *)
+
+let mklApp f args = Term.mkApp (Lazy.force f, args)
+
+(* TODO : Set -> Type *)
+let coqtype = lazy Term.mkSet
+
+let declare_new_type t =
+  Command.declare_assumption false (Decl_kinds.Local,Decl_kinds.Definitional) (Lazy.force coqtype) [] false None (Pp.dummy_loc,t);
+  Term.mkVar t
+
+let declare_new_variable v constr_t =
+  Command.declare_assumption false (Decl_kinds.Local,Decl_kinds.Definitional) constr_t [] false None (Pp.dummy_loc,v);
+  Term.mkVar v
+
+let mkName s =
+  let id = Names.id_of_string s in
+  Names.Name id
diff --git a/src/trace/smtTrace.ml b/src/trace/smtTrace.ml
new file mode 100644
index 0000000..8420ca1
--- /dev/null
+++ b/src/trace/smtTrace.ml
@@ -0,0 +1,465 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+open SmtMisc
+open CoqTerms
+open SmtCertif
+
+let notUsed = 0
+
+let next_id = ref 0 
+
+let clear () = next_id := 0
+
+let next_id () =
+  let id = !next_id in
+  incr next_id;
+  id
+
+(** Basic functions over small certificates *)
+
+let mk_scertif kind ov = 
+  {
+   id   = next_id ();
+   kind = kind;
+   pos  = None;
+   used = notUsed;
+   prev = None;
+   next = None;
+   value = ov 
+ }
+  
+(** Roots *)
+
+
+let mkRootGen ov = 
+  let pos = next_id () in
+  {
+   id   = pos;
+   kind = Root;
+   pos  = Some pos;
+   used = notUsed;
+   prev = None;
+   next = None;
+   value = ov 
+ }
+
+(* let mkRoot = mkRootGen None *)
+let mkRootV v = mkRootGen (Some v)
+ 
+let isRoot k = k == Root 
+
+(** Resolutions *)
+
+let mkRes c1 c2 tl = 
+  mk_scertif (Res { rc1 = c1; rc2 = c2; rtail = tl }) None
+
+let isRes k =
+  match k with
+    | Res _ -> true
+    | _ -> false
+
+
+(** Other *)
+
+let mkOther r ov = mk_scertif (Other r) ov
+
+
+(** Moving into the trace *)
+let next c =
+  match c.next with
+  | Some c1 -> c1
+  | None -> assert false
+
+let has_prev c =
+  match c.prev with
+    | Some _ -> true
+    | None -> false
+
+let prev c =
+  match c.prev with
+  | Some c1 -> c1
+  | None -> Printf.printf "prev %i\n" c.id;flush stdout;assert false
+
+let link c1 c2 =
+  c1.next <- Some c2;
+  c2.prev <- Some c1
+
+let clear_links c =
+  c.prev <- None;
+  c.next <- None
+
+let skip c =
+  link (prev c) (next c);
+  clear_links c
+
+let insert_before c cprev =
+  link (prev c) cprev;
+  link cprev c
+
+let get_res c s =
+  match c.kind with
+  | Res res -> res
+  | _ -> Printf.printf "get_res %s\n" s; assert false
+
+let get_other c s =
+  match c.kind with
+  | Other res -> res
+  | _ -> Printf.printf "get_other %s\n" s; assert false
+
+let get_val c =
+  match c.value with
+  | None -> assert false
+  | Some cl -> cl
+
+let rec repr c =
+  match c.kind with
+  | Root | Res _ | Other _ -> c
+  | Same c -> repr c
+
+let set_same c nc =
+  c.kind <- Same (repr nc);
+  skip c
+
+let rec get_pos c =
+  match c.kind with
+  | Root | Res _ | Other _ ->
+      begin match c.pos with
+      | Some n -> n
+      | _ -> assert false
+      end
+  | Same c -> get_pos c 
+
+let eq_clause c1 c2 = (repr c1).id = (repr c2).id
+
+(* Selection of useful rules *)
+let select c =
+  let mark c =
+    if not (isRoot c.kind) then c.used <- 1 in
+  mark c;
+  let r = ref c in
+  while not (isRoot !r.kind) do
+    let p = prev !r in
+    (match !r.kind with
+      | Res res ->
+      if !r.used == 1 then begin
+        !r.used <- notUsed;
+        (* let res = get_res !r "select" in *)
+        mark res.rc1; mark res.rc2;
+        List.iter mark res.rtail
+      end else
+        skip !r;
+      | Same _ ->
+        skip !r
+      | _ ->
+      if !r.used == 1 then 
+	begin
+          !r.used <- notUsed;
+          let rl = get_other !r "select" in
+          List.iter mark (used_clauses rl)
+	end 
+      else skip !r;
+    );
+    r := p
+  done
+
+ 
+
+
+(* Compute the number of occurence of each_clause *)
+
+let rec occur c =
+  match c.kind with
+  | Root -> c.used <- c.used + 1
+  | Res res ->
+      if c.used == notUsed then 
+	begin occur res.rc1; occur res.rc2; List.iter occur res.rtail end;
+      c.used <- c.used + 1
+  | Other res ->
+      if c.used == notUsed then List.iter occur (used_clauses res);
+      c.used <- c.used + 1;
+  | Same c' ->
+    occur c';
+    c.used <- c.used + 1
+
+(* Allocate clause *)
+
+let alloc c =
+  let free_pos = ref [] in
+
+  (* free the unused roots *)
+
+  let r = ref c in
+  while isRoot !r.kind do
+    if !r.used == notUsed then begin
+      free_pos := get_pos !r :: !free_pos;
+    end;
+    r := next !r;
+  done;
+
+  (* r is the first clause defined by resolution or another rule,
+     normaly the first used *)
+  let last_set = ref (get_pos (prev !r)) in
+
+  let decr_clause c =
+    let rc = repr c in
+      assert (rc.used > notUsed);
+    rc.used <- rc.used - 1;
+    if rc.used = notUsed then
+      free_pos := get_pos rc :: !free_pos in
+
+  let decr_res res =
+    decr_clause res.rc1;
+    decr_clause res.rc2;
+    List.iter decr_clause res.rtail in
+
+  let decr_other o =
+    List.iter decr_clause (used_clauses o) in
+
+  while !r.next <> None do
+    let n = next !r in
+      assert (!r.used <> notUsed);
+    if isRes !r.kind then
+      decr_res (get_res !r "alloc")
+    else
+      decr_other (get_other !r "alloc");
+    begin match !free_pos with
+    | p::free -> free_pos := free; !r.pos <- Some p
+    | _ -> incr last_set; !r.pos <- Some !last_set
+    end;
+    r := n
+  done;
+  begin match !free_pos with
+  | p::free -> free_pos := free; !r.pos <- Some p
+  | _ -> incr last_set; !r.pos <- Some !last_set
+  end;
+  !last_set
+
+
+(* A naive allocation for debugging *)
+
+let naive_alloc c =
+  let r = ref c in
+  while isRoot !r.kind do
+    r := next !r
+  done;
+  let last_set = ref (get_pos (prev !r)) in
+  while !r.next <> None do
+    let n = next !r in
+    incr last_set; !r.pos <- Some !last_set;
+    r := n
+  done;
+  incr last_set; !r.pos <- Some !last_set;
+  !last_set
+
+
+(* This function is currently inlined in verit/verit.ml and zchaff/zchaff.ml *)
+
+let build_certif first_root confl =
+  select confl;
+  occur confl;
+  alloc first_root
+
+
+let to_coq to_lit (cstep,
+    cRes, cImmFlatten,
+    cTrue, cFalse, cBuildDef, cBuildDef2, cBuildProj,
+    cImmBuildProj,cImmBuildDef,cImmBuildDef2,  
+    cEqTr, cEqCgr, cEqCgrP, 
+    cLiaMicromega, cLiaDiseq, cSplArith, cSplDistinctElim) confl =
+  let out_f f = to_lit f in
+  let out_c c = mkInt (get_pos c) in
+  let step_to_coq c =
+    match c.kind with
+    | Res res -> 
+	let size = List.length res.rtail + 3 in
+	let args = Array.make size (mkInt 0) in
+	args.(0) <- mkInt (get_pos res.rc1);
+	args.(1) <- mkInt (get_pos res.rc2);
+	let l = ref res.rtail in
+	for i = 2 to size - 2 do
+	  match !l with
+	  | c::tl -> 
+	      args.(i) <- mkInt (get_pos c);
+	      l := tl
+	  | _ -> assert false 
+	done;
+	mklApp cRes [|mkInt (get_pos c); Term.mkArray (Lazy.force cint, args)|]
+    | Other other ->
+	begin match other with
+	| ImmFlatten (c',f) -> mklApp cImmFlatten [|out_c c;out_c c'; out_f f|]
+        | True -> mklApp cTrue [|out_c c|]
+	| False -> mklApp cFalse [|out_c c|]
+	| BuildDef f -> mklApp cBuildDef [|out_c c; out_f f|]
+	| BuildDef2 f -> mklApp cBuildDef2 [|out_c c;out_f f|]
+	| BuildProj (f, i) -> mklApp cBuildProj [|out_c c; out_f f;mkInt i|]
+	| ImmBuildDef c' -> mklApp cImmBuildDef [|out_c c; out_c c'|]
+	| ImmBuildDef2 c' -> mklApp cImmBuildDef2 [|out_c c;out_c c'|]
+	| ImmBuildProj(c', i) -> mklApp cImmBuildProj [|out_c c; out_c c';mkInt i|]
+        | EqTr (f, fl) ->
+          let res = List.fold_right (fun f l -> mklApp ccons [|Lazy.force cint; out_f f; l|]) fl (mklApp cnil [|Lazy.force cint|]) in
+          mklApp cEqTr [|out_c c; out_f f; res|]
+        | EqCgr (f, fl) ->
+          let res = List.fold_right (fun f l -> mklApp ccons [|mklApp coption [|Lazy.force cint|]; (match f with | Some f -> mklApp cSome [|Lazy.force cint; out_f f|] | None -> mklApp cNone [|Lazy.force cint|]); l|]) fl (mklApp cnil [|mklApp coption [|Lazy.force cint|]|]) in
+          mklApp cEqCgr [|out_c c; out_f f; res|]
+        | EqCgrP (f1, f2, fl) ->
+          let res = List.fold_right (fun f l -> mklApp ccons [|mklApp coption [|Lazy.force cint|]; (match f with | Some f -> mklApp cSome [|Lazy.force cint; out_f f|] | None -> mklApp cNone [|Lazy.force cint|]); l|]) fl (mklApp cnil [|mklApp coption [|Lazy.force cint|]|]) in
+          mklApp cEqCgrP [|out_c c; out_f f1; out_f f2; res|]
+	| LiaMicromega (cl,d) ->
+          let cl' = List.fold_right (fun f l -> mklApp ccons [|Lazy.force cint; out_f f; l|]) cl (mklApp cnil [|Lazy.force cint|]) in
+          let c' = List.fold_right (fun f l -> mklApp ccons [|Lazy.force Coq_micromega.M.coq_proofTerm; Coq_micromega.dump_proof_term f; l|]) d (mklApp cnil [|Lazy.force Coq_micromega.M.coq_proofTerm|]) in
+          mklApp cLiaMicromega [|out_c c; cl'; c'|]
+        | LiaDiseq l -> mklApp cLiaDiseq [|out_c c; out_f l|]
+        | SplArith (orig,res,l) ->
+          let res' = out_f res in
+          let l' = List.fold_right (fun f l -> mklApp ccons [|Lazy.force Coq_micromega.M.coq_proofTerm; Coq_micromega.dump_proof_term f; l|]) l (mklApp cnil [|Lazy.force Coq_micromega.M.coq_proofTerm|]) in
+          mklApp cSplArith [|out_c c; out_c orig; res'; l'|]
+	| SplDistinctElim (c',f) -> mklApp cSplDistinctElim [|out_c c;out_c c'; out_f f|]
+	end
+    | _ -> assert false in
+  let step = Lazy.force cstep in
+  let def_step = 
+    mklApp cRes [|mkInt 0; Term.mkArray (Lazy.force cint, [|mkInt 0|]) |] in
+  let r = ref confl in
+  let nc = ref 0 in
+  while not (isRoot !r.kind) do r := prev !r; incr nc done;
+  let last_root = !r in
+  let size = !nc in
+  let max = (Parray.trunc_size (Uint63.of_int 4194303)) - 1 in
+  let q,r1 = size / max, size mod max in
+
+  let trace = 
+    let len = if r1 = 0 then q + 1 else q + 2 in
+    Array.make len (Term.mkArray (step, [|def_step|])) in
+  for j = 0 to q - 1 do
+    let tracej = Array.make (Parray.trunc_size (Uint63.of_int 4194303)) def_step in
+    for i = 0 to max - 1 do
+      r := next !r;
+      tracej.(i) <- step_to_coq !r; 
+    done;
+    trace.(j) <- Term.mkArray (step, tracej)
+  done;
+  if r1 <> 0 then begin
+    let traceq = Array.make (r1 + 1) def_step in
+    for i = 0 to r1-1 do 
+    r := next !r; 
+    traceq.(i) <- step_to_coq !r; 
+    done;
+    trace.(q) <- Term.mkArray (step, traceq)
+  end;
+
+  (Term.mkArray (mklApp carray [|step|], trace), last_root)
+
+
+
+(** Optimization of the trace *)
+
+module MakeOpt (Form:SmtForm.FORM) = 
+  struct 
+    (* Share the certificate building a common clause *)
+    let share_value c =
+      let tbl = Hashtbl.create 17 in
+      let to_lits v = List.map (Form.to_lit) v in
+      let process c = 
+	match c.value with
+	| None -> ()
+	| Some v ->
+	    let lits = to_lits v in
+	    try
+	      let c' = Hashtbl.find tbl lits in
+	      set_same c c'
+	    with Not_found  -> Hashtbl.add tbl lits c in
+      let r = ref c in
+      while !r.next <> None do
+	let next = next !r in
+	process !r;
+	r := next 
+      done;
+      process !r
+
+   (* Sharing of the common prefix *)
+
+    module HashedHeadRes =
+      struct
+
+	type t = Form.t resolution
+
+	let equal r1 r2 =
+	  eq_clause r1.rc1 r2.rc1 && eq_clause r1.rc2 r2.rc2
+
+	let hash r = (repr r.rc1).id * 19 + (repr r.rc2).id
+
+      end
+
+    module HRtbl = Hashtbl.Make (HashedHeadRes)
+
+    let common_head tl1 tl2 =
+      let rec aux rhd tl1 tl2 =
+	match tl1, tl2 with
+	| [], _ -> List.rev rhd, tl1, tl2
+	| _, [] -> List.rev rhd, tl1, tl2
+	| c1::tl1', c2::tl2' ->
+	    if eq_clause c1 c2 then aux (repr c1 :: rhd) tl1' tl2'
+	    else List.rev rhd, tl1, tl2
+      in aux [] tl1 tl2
+	
+    let share_prefix first_c n =
+      let tbl = HRtbl.create (min n Sys.max_array_length) in
+      let rec share c2 =
+	if isRes c2.kind then (
+	  let res2 = get_res c2 "share_prefix1" in
+	  try
+            let c1 = HRtbl.find tbl res2 in
+            let res1 = get_res c1 "share_prefix2" in
+	    (* res1 and res2 have the same head *)
+            let head, tl1, tl2 = common_head res1.rtail res2.rtail in
+            match tl1, tl2 with
+            | [], [] ->
+		set_same c2 c1;
+            | [], c2'::tl2' ->
+		res2.rc1 <- c1;
+		res2.rc2 <- c2';
+		res2.rtail <- tl2';
+		share c2
+            | c1'::tl1', [] ->
+		skip c2;
+		HRtbl.remove tbl res1;
+		insert_before c1 c2;
+		res1.rc1 <- c2;
+		res1.rc2 <- c1';
+		res1.rtail <- tl1';
+		share c1
+            | c1'::tl1', c2'::tl2' ->
+		let c = mkRes res1.rc1 res1.rc2 head in
+		HRtbl.remove tbl res1;
+		insert_before c1 c;
+		res1.rc1 <- c;
+		res1.rc2 <- c1';
+		res1.rtail <- tl1';
+		res2.rc1 <- c;
+		res2.rc2 <- c2';
+		res2.rtail <- tl2';
+		share c;
+		share c1;
+		share c2
+	  with Not_found -> HRtbl.add tbl res2 c2
+	 ) in
+      let r = ref first_c in
+      while !r.next <> None do
+	let n = next !r in
+	share !r;
+	r := n
+      done
+
+  end
diff --git a/src/trace/smt_tactic.ml4 b/src/trace/smt_tactic.ml4
new file mode 100644
index 0000000..219810d
--- /dev/null
+++ b/src/trace/smt_tactic.ml4
@@ -0,0 +1,55 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+VERNAC COMMAND EXTEND Parse_certif_zchaff
+| [ "Parse_certif_zchaff" 
+    ident(dimacs) ident(trace) string(fdimacs) string(fproof) ] ->
+  [
+    Zchaff.parse_certif dimacs trace fdimacs fproof
+  ]
+| [ "Zchaff_Checker" string(fdimacs) string(fproof) ] ->
+  [
+    Zchaff.checker fdimacs fproof
+  ]
+| [ "Zchaff_Theorem" ident(name) string(fdimacs) string(fproof) ] ->
+  [
+    Zchaff.theorem name fdimacs fproof
+  ] 
+END
+
+VERNAC COMMAND EXTEND Parse_certif_verit
+| [ "Parse_certif_verit"
+    ident(t_i) ident(t_func) ident(t_atom) ident(t_form) ident(root) ident(used_roots) ident(trace) string(fsmt) string(fproof) ] ->
+  [
+    Verit.parse_certif t_i t_func t_atom t_form root used_roots trace fsmt fproof
+  ]
+| [ "Verit_Checker" string(fsmt) string(fproof) ] ->
+  [
+    Verit.checker fsmt fproof
+  ]
+| [ "Verit_Theorem" ident(name) string(fsmt) string(fproof) ] ->
+  [
+    Verit.theorem name fsmt fproof
+  ]
+END
+
+TACTIC EXTEND zchaff
+| [ "zchaff" ] -> [ Zchaff.tactic ]
+END
+
+TACTIC EXTEND verit
+| [ "verit" ] -> [ Verit.tactic ]
+END
diff --git a/src/verit/smtlib2_ast.ml b/src/verit/smtlib2_ast.ml
new file mode 100644
index 0000000..cce4625
--- /dev/null
+++ b/src/verit/smtlib2_ast.ml
@@ -0,0 +1,189 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq, originally belong to The Alt-ergo theorem prover           *)
+(*     Copyright (C) 2006-2010                                            *)
+(*                                                                        *)
+(*     Sylvain Conchon                                                    *)
+(*     Evelyne Contejean                                                  *)
+(*     Stephane Lescuyer                                                  *)
+(*     Mohamed Iguernelala                                                *)
+(*     Alain Mebsout                                                      *)
+(*                                                                        *)
+(*     CNRS - INRIA - Universite Paris Sud                                *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Smtlib2_util
+
+type loc = Lexing.position * Lexing.position
+
+type specconstant =
+  | SpecConstsDec of loc * string
+  | SpecConstNum of loc * string
+  | SpecConstString of loc * string
+  | SpecConstsHex of loc * string
+  | SpecConstsBinary of loc * string
+
+type symbol =
+  | Symbol of loc * string
+  | SymbolWithOr of loc * string
+
+type sexpr =
+  | SexprSpecConst of loc * specconstant
+  | SexprSymbol of loc * symbol
+  | SexprKeyword of loc * string
+  | SexprInParen of loc * (loc * sexpr list)
+
+type attributevalue =
+  | AttributeValSpecConst of loc * specconstant
+  | AttributeValSymbol of loc * symbol
+  | AttributeValSexpr of loc * (loc * sexpr list)
+
+type attribute =
+  | AttributeKeyword of loc * string
+  | AttributeKeywordValue of loc * string * attributevalue
+
+type an_option = AnOptionAttribute of loc * attribute
+
+type infoflag = InfoFlagKeyword of loc * string
+
+type identifier =
+  | IdSymbol of loc * symbol
+  | IdUnderscoreSymNum of loc * symbol * (loc * string list)
+
+type sort =
+  | SortIdentifier of loc * identifier
+  | SortIdSortMulti of loc * identifier * (loc * sort list)
+
+type qualidentifier =
+  | QualIdentifierId of loc * identifier
+  | QualIdentifierAs of loc * identifier * sort
+
+type sortedvar =
+  | SortedVarSymSort of loc * symbol * sort
+
+type varbinding = VarBindingSymTerm of loc * symbol * term
+
+and term =
+  | TermSpecConst of loc * specconstant
+  | TermQualIdentifier of loc * qualidentifier
+  | TermQualIdTerm of loc * qualidentifier * (loc * term list)
+  | TermLetTerm of loc * (loc * varbinding list) * term
+  | TermForAllTerm of loc * (loc * sortedvar list) * term
+  | TermExistsTerm of loc * (loc * sortedvar list) * term
+  | TermExclimationPt of loc * term * (loc * attribute list)
+
+type command =
+  | CSetLogic of loc * symbol
+  | CSetOption of loc * an_option
+  | CSetInfo of loc * attribute
+  | CDeclareSort of loc * symbol * string
+  | CDefineSort of loc * symbol * (loc * symbol list) * sort
+  | CDeclareFun of loc * symbol * (loc * sort list) * sort
+  | CDefineFun of loc * symbol * (loc * sortedvar list) * sort * term
+  | CPush of loc * string
+  | CPop of loc * string
+  | CAssert of loc * term
+  | CCheckSat of loc
+  | CGetAssert of loc
+  | CGetProof of loc
+  | CGetUnsatCore of loc
+  | CGetValue of loc * (loc * term list)
+  | CGetAssign of loc
+  | CGetOption of loc * string
+  | CGetInfo of loc * infoflag
+  | CExit of loc
+
+type commands = Commands of loc * (loc * command list)
+
+
+(* loc stands for pos (position) and extradata *)
+
+let loc_an_option = function
+  | AnOptionAttribute(d,_) -> d
+
+let loc_attribute = function
+  | AttributeKeyword(d,_) -> d
+  | AttributeKeywordValue(d,_,_) -> d
+
+let loc_attributevalue = function
+  | AttributeValSpecConst(d,_) -> d
+  | AttributeValSymbol(d,_) -> d
+  | AttributeValSexpr(d,_) -> d
+
+let loc_command = function
+  | CSetLogic(d,_) -> d
+  | CSetOption(d,_) -> d
+  | CSetInfo(d,_) -> d
+  | CDeclareSort(d,_,_) -> d
+  | CDefineSort(d,_,_,_) -> d
+  | CDeclareFun(d,_,_,_) -> d
+  | CDefineFun(d,_,_,_,_) -> d
+  | CPush(d,_) -> d
+  | CPop(d,_) -> d
+  | CAssert(d,_) -> d
+  | CCheckSat(d) -> d
+  | CGetAssert(d) -> d
+  | CGetProof(d) -> d
+  | CGetUnsatCore(d) -> d
+  | CGetValue(d,_) -> d
+  | CGetAssign(d) -> d
+  | CGetOption(d,_) -> d
+  | CGetInfo(d,_) -> d
+  | CExit(d) -> d
+
+let loc_commands = function
+  | Commands(d,_) -> d
+
+let loc_identifier = function
+  | IdSymbol(d,_) -> d
+  | IdUnderscoreSymNum(d,_,_) -> d
+
+let loc_infoflag = function
+  | InfoFlagKeyword(d,_) -> d
+
+let loc_qualidentifier = function
+  | QualIdentifierId(d,_) -> d
+  | QualIdentifierAs(d,_,_) -> d
+
+let loc_sexpr = function
+  | SexprSpecConst(d,_) -> d
+  | SexprSymbol(d,_) -> d
+  | SexprKeyword(d,_) -> d
+  | SexprInParen(d,_) -> d
+
+let loc_sort = function
+  | SortIdentifier(d,_) -> d
+  | SortIdSortMulti(d,_,_) -> d
+
+let loc_sortedvar = function
+  | SortedVarSymSort(d,_,_) -> d
+
+let loc_specconstant = function
+  | SpecConstsDec(d,_) -> d
+  | SpecConstNum(d,_) -> d
+  | SpecConstString(d,_) -> d
+  | SpecConstsHex(d,_) -> d
+  | SpecConstsBinary(d,_) -> d
+
+let loc_symbol = function
+  | Symbol(d,_) -> d
+  | SymbolWithOr(d,_) -> d
+
+let loc_term = function
+  | TermSpecConst(d,_) -> d
+  | TermQualIdentifier(d,_) -> d
+  | TermQualIdTerm(d,_,_) -> d
+  | TermLetTerm(d,_,_) -> d
+  | TermForAllTerm(d,_,_) -> d
+  | TermExistsTerm(d,_,_) -> d
+  | TermExclimationPt(d,_,_) -> d
+
+let loc_varbinding = function
+  | VarBindingSymTerm(d,_,_) -> d
+
+let loc_couple = fst
+
+let loc_of e = loc_commands e;;
diff --git a/src/verit/smtlib2_genConstr.ml b/src/verit/smtlib2_genConstr.ml
new file mode 100644
index 0000000..f11d650
--- /dev/null
+++ b/src/verit/smtlib2_genConstr.ml
@@ -0,0 +1,226 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Smtlib2_ast
+open SmtAtom
+open SmtForm
+open SmtMisc
+open CoqTerms
+
+
+(* For debugging *)
+
+let pp_symbol s =
+  let pp_position p = "{pos_fname = "^p.Lexing.pos_fname^"; pos_lnum = "^(string_of_int p.Lexing.pos_lnum)^"; pos_bol = "^(string_of_int p.Lexing.pos_bol)^"; pos_cnum = "^(string_of_int p.Lexing.pos_cnum)^"}" in
+
+  let pp_loc (p1,p2) = "("^(pp_position p1)^", "^(pp_position p2)^")" in
+
+  match s with
+    | Symbol (l,s) -> "Symbol ("^(pp_loc l)^", "^s^")"
+    | SymbolWithOr (l,s) -> "SymbolWithOr ("^(pp_loc l)^", "^s^")"
+
+
+(* Main functions *)
+
+let string_of_symbol = function | Symbol (_,s) | SymbolWithOr (_,s) -> s
+
+
+let identifier_of_qualidentifier = function
+  | QualIdentifierId (_,id) | QualIdentifierAs (_,id,_) -> id
+
+
+let string_type s = match s with
+  | "Bool" -> Tbool
+  | "Int" -> TZ
+  | _ -> VeritSyntax.get_btype s
+
+
+let sort_of_string s = (string_type s, [])
+
+
+let sort_of_symbol s = sort_of_string (string_of_symbol s)
+
+
+let string_of_identifier = function
+  | IdSymbol (_,s) -> (string_of_symbol s)
+  | IdUnderscoreSymNum (_,s,(_,l)) ->
+    List.fold_left (fun c c' -> c^"_"^c') (string_of_symbol s) l
+
+
+let string_of_qualidentifier id = string_of_identifier (identifier_of_qualidentifier id)
+
+
+let rec sort_of_sort = function
+  | SortIdentifier (_,id) -> sort_of_string (string_of_identifier id)
+  | SortIdSortMulti (_,id,(_,l)) ->
+    (string_type (string_of_identifier id), List.map sort_of_sort l)
+
+
+let declare_sort rt sym =
+  let s = string_of_symbol sym in
+  let cons_t = declare_new_type (Names.id_of_string ("Smt_sort_"^s)) in
+  let eq_t = declare_new_variable (Names.id_of_string ("eq_"^s)) (Term.mkArrow cons_t (Term.mkArrow cons_t (Lazy.force cbool))) in
+  let x = mkName "x" in
+  let y = mkName "y" in
+  let rx = Term.mkRel 2 in
+  let ry = Term.mkRel 1 in
+  let eq_refl = Term.mkProd (x,cons_t,Term.mkProd (y,cons_t,mklApp creflect [|mklApp ceq [|cons_t;rx;ry|];mklApp (lazy eq_t) [|rx;ry|]|])) in
+  let eq_refl_v = declare_new_variable (Names.id_of_string ("eq_refl_"^s)) eq_refl in
+  let ce = mklApp cTyp_eqb [|cons_t;eq_t;eq_refl_v|] in
+  let res = Btype.declare rt cons_t ce in
+  VeritSyntax.add_btype s res;
+  res
+
+
+let declare_fun rt ro sym arg cod =
+  let s = string_of_symbol sym in
+  let tyl = List.map sort_of_sort arg in
+  let ty = sort_of_sort cod in
+
+  let coqTy = List.fold_right (fun typ c -> Term.mkArrow (Btype.interp_to_coq rt (fst typ)) c) tyl (Btype.interp_to_coq rt (fst ty)) in
+  let cons_v = declare_new_variable (Names.id_of_string ("Smt_var_"^s)) coqTy in
+
+  let op = Op.declare ro cons_v (Array.of_list (List.map fst tyl)) (fst ty) in
+  VeritSyntax.add_fun s op;
+  op
+
+
+let make_root_specconstant ra = function
+  | SpecConstsDec _ -> failwith "Smtlib2_genConstr.make_root_specconstant: decimals not implemented yet"
+  | SpecConstNum (_,s) ->
+    (try
+      let i = int_of_string s in
+      Atom.hatom_Z_of_int ra i
+    with
+      | Failure _ ->
+        let i = Big_int.big_int_of_string s in
+        Atom.hatom_Z_of_bigint ra i)
+  | SpecConstString _ -> failwith "Smtlib2_genConstr.make_root_specconstant: strings not implemented yet"
+  | SpecConstsHex _ -> failwith "Smtlib2_genConstr.make_root_specconstant: hexadecimals not implemented yet"
+  | SpecConstsBinary _ -> failwith "Smtlib2_genConstr.make_root_specconstant: binaries not implemented yet"
+
+
+type atom_form = | Atom of SmtAtom.Atom.t | Form of SmtAtom.Form.t
+
+
+let make_root ra rf t =
+
+  let hlets = Hashtbl.create 17 in
+
+  let rec make_root_term = function
+    | TermSpecConst (_,c) -> Atom (make_root_specconstant ra c)
+    | TermQualIdentifier (_,id) ->
+      let v = string_of_qualidentifier id in
+      (try Hashtbl.find hlets v with
+        | Not_found ->
+          make_root_app v [])
+    | TermQualIdTerm (_,id,(_,l)) ->
+      let v = string_of_qualidentifier id in
+      make_root_app v l
+    | TermLetTerm (_,(_,l),t) ->
+      List.iter (fun (VarBindingSymTerm (_, sym, u)) ->
+        let u' = make_root_term u in
+        let s' = string_of_symbol sym in
+        Hashtbl.add hlets s' u') l;
+      make_root_term t
+    | TermForAllTerm _ -> failwith "Smtlib2_genConstr.make_root_term: ForAll not implemented yet"
+    | TermExistsTerm _ -> failwith "Smtlib2_genConstr.make_root_term: Exists not implemented yet"
+    | TermExclimationPt (_,t,_) -> make_root_term t
+
+  and make_root_app v l =
+    match (v,l) with
+      | "=", [a;b] ->
+        (match make_root_term a, make_root_term b with
+          | Atom a', Atom b' ->
+            (match Atom.type_of a' with
+              | Tbool -> Form (Form.get rf (Fapp (Fiff, [|Form.get rf (Fatom a'); Form.get rf (Fatom b')|])))
+              | ty -> Atom (Atom.mk_eq ra ty a' b'))
+          | _, _ -> assert false)
+      | "<", [a;b] ->
+        (match make_root_term a, make_root_term b with
+          | Atom a', Atom b' -> Atom (Atom.mk_lt ra a' b')
+          | _, _ -> assert false)
+      | "<=", [a;b] ->
+        (match make_root_term a, make_root_term b with
+          | Atom a', Atom b' -> Atom (Atom.mk_le ra a' b')
+          | _, _ -> assert false)
+      | ">", [a;b] ->
+        (match make_root_term a, make_root_term b with
+          | Atom a', Atom b' -> Atom (Atom.mk_gt ra a' b')
+          | _, _ -> assert false)
+      | ">=", [a;b] ->
+        (match make_root_term a, make_root_term b with
+          | Atom a', Atom b' -> Atom (Atom.mk_ge ra a' b')
+          | _, _ -> assert false)
+      | "+", [a;b] ->
+        (match make_root_term a, make_root_term b with
+          | Atom a', Atom b' -> Atom (Atom.mk_plus ra a' b')
+          | _, _ -> assert false)
+      | "-", [a;b] ->
+        (match make_root_term a, make_root_term b with
+          | Atom a', Atom b' -> Atom (Atom.mk_minus ra a' b')
+          | _, _ -> assert false)
+      | "*", [a;b] ->
+        (match make_root_term a, make_root_term b with
+          | Atom a', Atom b' -> Atom (Atom.mk_mult ra a' b')
+          | _, _ -> assert false)
+      | "-", [a] ->
+        (match make_root_term a with
+          | Atom a' -> Atom (Atom.mk_opp ra a')
+          | _ -> assert false)
+      | "distinct", _ ->
+        let make_h h =
+          match make_root_term h with
+            | Atom h' -> h'
+            | _ -> assert false in
+        let a = Array.make (List.length l) (make_h (List.hd l)) in
+        let i = ref (-1) in
+        List.iter (fun h ->
+          incr i;
+          a.(!i) <- make_h h) l;
+        Atom (Atom.mk_distinct ra (Atom.type_of a.(0)) a)
+      | "true", _ -> Form (Form.get rf Form.pform_true)
+      | "false", _ -> Form (Form.get rf Form.pform_false)
+      | "and", _ ->
+        Form (Form.get rf (Fapp (Fand, Array.of_list (List.map make_root l))))
+      | "or", _ ->
+        Form (Form.get rf (Fapp (For, Array.of_list (List.map make_root l))))
+      | "xor", _ ->
+        Form (Form.get rf (Fapp (Fxor, Array.of_list (List.map make_root l))))
+      | "=>", _ ->
+        Form (Form.get rf (Fapp (Fimp, Array.of_list (List.map make_root l))))
+      | "ite", _ ->
+        Form (Form.get rf (Fapp (Fite, Array.of_list (List.map make_root l))))
+      | "not", [a] -> Form (Form.neg (make_root a))
+      | _, _ ->
+        let op = VeritSyntax.get_fun v in
+        let l' = List.map (fun t -> match make_root_term t with
+          | Atom h -> h | Form _ -> assert false) l in
+        Atom (Atom.get ra (Aapp (op, Array.of_list l')))
+
+  and make_root t =
+    match make_root_term t with
+      | Atom h -> Form.get rf (Fatom h)
+      | Form f -> f in
+
+  make_root t
+
+
+let declare_commands rt ro ra rf acc = function
+  | CDeclareSort (_,sym,_) -> let _ = declare_sort rt sym in acc
+  | CDeclareFun (_,sym, (_, arg), cod) ->
+    let _ = declare_fun rt ro sym arg cod in acc
+  | CAssert (_, t) -> (make_root ra rf t)::acc
+  | _ -> acc
diff --git a/src/verit/smtlib2_lex.mll b/src/verit/smtlib2_lex.mll
new file mode 100644
index 0000000..f235403
--- /dev/null
+++ b/src/verit/smtlib2_lex.mll
@@ -0,0 +1,88 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq, originally belong to The Alt-ergo theorem prover           *)
+(*     Copyright (C) 2006-2010                                            *)
+(*                                                                        *)
+(*     Sylvain Conchon                                                    *)
+(*     Evelyne Contejean                                                  *)
+(*     Stephane Lescuyer                                                  *)
+(*     Mohamed Iguernelala                                                *)
+(*     Alain Mebsout                                                      *)
+(*                                                                        *)
+(*     CNRS - INRIA - Universite Paris Sud                                *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+{
+open Lexing
+open Smtlib2_parse
+
+
+let newline lexbuf =
+    let pos = lexbuf.lex_curr_p in
+    lexbuf.lex_curr_p <-
+      { pos with pos_lnum = pos.pos_lnum + 1; pos_bol = pos.pos_cnum;
+        pos_cnum=0 }
+
+}
+
+rule token = parse
+| ['\t' ' ' ]+
+    { token lexbuf }
+| ';'  (_ # '\n')*
+     { token lexbuf }
+| ['\n']+ as str
+     { newline lexbuf;
+       Smtlib2_util.line := (!Smtlib2_util.line + (String.length str));
+       token lexbuf }
+| "_"              { UNDERSCORE }
+| "("              { LPAREN }
+| ")"              { RPAREN }
+| "as"             { AS }
+| "let"            { LET }
+| "forall"         { FORALL }
+| "exists"         { EXISTS }
+| "!"              { EXCLIMATIONPT }
+| "set-logic"      { SETLOGIC }
+| "set-option"     { SETOPTION }
+| "set-info"       { SETINFO }
+| "declare-sort"   { DECLARESORT }
+| "define-sort"    { DEFINESORT }
+| "declare-fun"    { DECLAREFUN }
+| "define-fun"     { DEFINEFUN }
+| "push"           { PUSH }
+| "pop"            { POP }
+| "assert"         { ASSERT }
+| "check-sat"      { CHECKSAT }
+| "get-assertions" { GETASSERT }
+| "get-proof"      { GETPROOF }
+| "get-unsat-core" { GETUNSATCORE }
+| "get-value"      { GETVALUE }
+| "get-assignment" { GETASSIGN }
+| "get-option"     { GETOPTION }
+| "get-info"       { GETINFO }
+| "exit"           { EXIT }
+|  '#' 'x' ['0'-'9' 'A'-'F' 'a'-'f']+  as str
+    { HEXADECIMAL(str) }
+|  '#' 'b' ['0'-'1']+  as str
+    { BINARY(str) }
+|  '|' ([ '!'-'~' ' ' '\n' '\t' '\r'] # ['\\' '|'])* '|'  as str
+    { ASCIIWOR(str) }
+|  ':' ['a'-'z' 'A'-'Z' '0'-'9' '+' '-' '/' '*' '=' '%' '?' '!' '.' '$' '_' '~' '&' '^' '<' '>' '@']+  as str
+    { KEYWORD(str) }
+|  ['a'-'z' 'A'-'Z' '+' '-' '/' '*' '=''%' '?' '!' '.' '$' '_' '~' '&' '^' '<' '>' '@'] ['a'-'z' 'A'-'Z' '0'-'9' '+' '-' '/' '*' '=''%' '?' '!' '.' '$' '_' '~' '&' '^' '<' '>' '@']*  as str
+    { SYMBOL(str) }
+|  '"' (([ '!'-'~' ' ' '\n' '\t' '\r' ] # ['\\' '"']) | ('\\' ['!'-'~' ' ' '\n' '\t' '\r'] ))* '"' as str
+    { STRINGLIT(str) }
+|  ( '0' | ['1'-'9'] ['0'-'9']* )  as str
+    { NUMERAL(str) }
+|  ( '0' | ['1'-'9'] ['0'-'9']* ) '.' ['0'-'9']+ as str
+    { DECIMAL(str) }
+| eof
+    { EOF }
+| _
+    {failwith(
+      (Lexing.lexeme lexbuf) ^
+	": lexing error on line "^(string_of_int !Smtlib2_util.line))}{}
diff --git a/src/verit/smtlib2_parse.mly b/src/verit/smtlib2_parse.mly
new file mode 100644
index 0000000..b4e02a7
--- /dev/null
+++ b/src/verit/smtlib2_parse.mly
@@ -0,0 +1,299 @@
+/**************************************************************************/
+/*                                                                        */
+/*     SMTCoq, originally belong to The Alt-ergo theorem prover           */
+/*     Copyright (C) 2006-2010                                            */
+/*                                                                        */
+/*     Sylvain Conchon                                                    */
+/*     Evelyne Contejean                                                  */
+/*     Stephane Lescuyer                                                  */
+/*     Mohamed Iguernelala                                                */
+/*     Alain Mebsout                                                      */
+/*                                                                        */
+/*     CNRS - INRIA - Universite Paris Sud                                */
+/*                                                                        */
+/*   This file is distributed under the terms of the CeCILL-C licence     */
+/*                                                                        */
+/**************************************************************************/
+
+%{
+   open Smtlib2_ast
+
+   let loc () = symbol_start_pos (), symbol_end_pos ()
+
+%}
+
+%start main
+
+/* general */
+%token EXCLIMATIONPT
+%token UNDERSCORE
+%token AS
+%token EXISTS
+%token FORALL
+%token LET
+
+/* commands */
+%token SETLOGIC
+%token SETOPTION
+%token SETINFO
+%token DECLARESORT
+%token DEFINESORT
+%token DECLAREFUN
+%token DEFINEFUN
+%token PUSH
+%token POP
+%token ASSERT
+%token CHECKSAT
+%token GETASSERT
+%token GETPROOF
+%token GETUNSATCORE
+%token GETVALUE
+%token GETASSIGN
+%token GETOPTION
+%token GETINFO
+%token EXIT
+
+/* Other tokens */
+%token LPAREN
+%token RPAREN
+%token EOF
+
+%token <string> NUMERAL
+%token <string> DECIMAL
+%token <string> HEXADECIMAL
+%token <string> BINARY
+%token <string> STRINGLIT
+%token <string> ASCIIWOR
+%token <string> KEYWORD
+%token <string> SYMBOL
+
+
+%type <Smtlib2_ast.commands option> main
+%type <Smtlib2_ast.an_option> an_option
+%type <Smtlib2_ast.attribute> attribute
+%type <Smtlib2_ast.attributevalue> attributevalue
+%type <Smtlib2_ast.command> command
+%type <Smtlib2_ast.commands> commands
+%type <Smtlib2_ast.identifier> identifier
+%type <Smtlib2_ast.infoflag> infoflag
+%type <Smtlib2_ast.qualidentifier> qualidentifier
+%type <Smtlib2_ast.sexpr> sexpr
+%type <Smtlib2_ast.sort> sort
+%type <Smtlib2_ast.sortedvar> sortedvar
+%type <Smtlib2_ast.specconstant> specconstant
+%type <Smtlib2_ast.symbol> symbol
+%type <Smtlib2_ast.term> term
+%type <Smtlib2_ast.varbinding> varbinding
+
+/* %type <Smtlib2_ast.attributevalsexpr_attributevalue_sexpr5> attributevalsexpr_attributevalue_sexpr5 */
+/* %type <Smtlib2_ast.commanddeclarefun_command_sort13> commanddeclarefun_command_sort13 */
+/* %type <Smtlib2_ast.commanddefinefun_command_sortedvar15> commanddefinefun_command_sortedvar15 */
+/* %type <Smtlib2_ast.commanddefinesort_command_symbol11> commanddefinesort_command_symbol11 */
+/* %type <Smtlib2_ast.commandgetvalue_command_term24> commandgetvalue_command_term24 */
+/* %type <Smtlib2_ast.commands_commands_command30> commands_commands_command30 */
+/* %type <Smtlib2_ast.sexprinparen_sexpr_sexpr41> sexprinparen_sexpr_sexpr41 */
+/* %type <Smtlib2_ast.sortidsortmulti_sort_sort44> sortidsortmulti_sort_sort44 */
+/* %type <Smtlib2_ast.termexclimationpt_term_attribute64> termexclimationpt_term_attribute64 */
+/* %type <Smtlib2_ast.termexiststerm_term_sortedvar62> termexiststerm_term_sortedvar62 */
+/* %type <Smtlib2_ast.termforallterm_term_sortedvar60> termforallterm_term_sortedvar60 */
+/* %type <Smtlib2_ast.termletterm_term_varbinding58> termletterm_term_varbinding58 */
+/* %type <Smtlib2_ast.termqualidterm_term_term56> termqualidterm_term_term56 */
+/* %type <Smtlib2_ast.idunderscoresymnum_identifier_numeral33> idunderscoresymnum_identifier_numeral33 */
+%%
+
+main:
+| commands { Some($1) }
+| EOF { None }
+;
+
+an_option:
+| attribute { AnOptionAttribute(loc_attribute $1, $1) }
+;
+
+attribute:
+| KEYWORD { AttributeKeyword(loc (), $1) }
+| KEYWORD attributevalue { AttributeKeywordValue(loc (), $1, $2) }
+;
+
+sexpr_list:
+/*sexprinparen_sexpr_sexpr41:*/
+/*attributevalsexpr_attributevalue_sexpr5:*/
+| { (loc (), []) }
+| sexpr sexpr_list { let (_, l1) = $2 in (loc_sexpr $1, ($1)::(l1)) }
+;
+
+attributevalue:
+| specconstant { AttributeValSpecConst(loc_specconstant $1, $1) }
+| symbol { AttributeValSymbol(loc_symbol $1, $1) }
+| LPAREN sexpr_list RPAREN { AttributeValSexpr(loc (), $2) }
+;
+
+symbol_list: /*commanddefinesort_command_symbol11:*/
+| { (loc (), []) }
+| symbol symbol_list { let (_, l1) = $2 in (loc_symbol $1, ($1)::(l1)) }
+;
+
+sort_list0: /*commanddeclarefun_command_sort13:*/
+| { (loc (), []) }
+| sort sort_list0 { let (_, l1) = $2 in (loc_sort $1, ($1)::(l1)) }
+;
+
+sortedvar_list: /*commanddefinefun_command_sortedvar15:*/
+| { (loc (), []) }
+| sortedvar sortedvar_list
+    { let (_, l1) = $2 in (loc_sortedvar $1, ($1)::(l1)) }
+;
+
+command:
+| LPAREN SETLOGIC symbol RPAREN
+    { CSetLogic(loc (), $3) }
+| LPAREN SETOPTION an_option RPAREN
+    { CSetOption(loc (), $3) }
+| LPAREN SETINFO attribute RPAREN
+    { CSetInfo(loc (), $3) }
+| LPAREN DECLARESORT symbol NUMERAL RPAREN
+    { CDeclareSort(loc (), $3, $4) }
+| LPAREN DEFINESORT symbol LPAREN symbol_list RPAREN sort RPAREN
+    { CDefineSort(loc (), $3, $5, $7) }
+| LPAREN DECLAREFUN symbol LPAREN sort_list0 RPAREN sort RPAREN
+    { CDeclareFun(loc (), $3, $5, $7) }
+| LPAREN DEFINEFUN symbol LPAREN sortedvar_list RPAREN sort term RPAREN
+    { CDefineFun(loc (), $3, $5, $7, $8) }
+| LPAREN PUSH NUMERAL RPAREN
+    { CPush(loc (), $3) }
+| LPAREN POP NUMERAL RPAREN
+    { CPop(loc (), $3) }
+| LPAREN ASSERT term RPAREN
+    { CAssert(loc (), $3) }
+| LPAREN CHECKSAT RPAREN
+    { CCheckSat(loc ()) }
+| LPAREN GETASSERT RPAREN
+    { CGetAssert(loc ()) }
+| LPAREN GETPROOF RPAREN
+    { CGetProof(loc ()) }
+| LPAREN GETUNSATCORE RPAREN
+    { CGetUnsatCore(loc ()) }
+| LPAREN GETVALUE LPAREN term_list1 RPAREN RPAREN
+    { CGetValue(loc (), $4) }
+| LPAREN GETASSIGN RPAREN
+    { CGetAssign(loc ()) }
+| LPAREN GETOPTION KEYWORD RPAREN
+    { CGetOption(loc (), $3) }
+| LPAREN GETINFO infoflag RPAREN
+    { CGetInfo(loc (), $3) }
+| LPAREN EXIT RPAREN
+    { CExit(loc ()) }
+;
+
+
+command_list: /*commands_commands_command30:*/
+| { (loc (), []) }
+| command command_list { let (_, l1) = $2 in (loc_command $1, ($1)::(l1)) }
+;
+
+commands:
+| command_list { Commands(loc_couple $1, $1) }
+;
+
+numeral_list: /*idunderscoresymnum_identifier_numeral33:*/
+| NUMERAL { (loc (), ($1)::[]) }
+| NUMERAL numeral_list { let (_, l1) = $2 in (loc (), ($1)::(l1)) }
+;
+
+identifier:
+| symbol { IdSymbol(loc_symbol $1, $1) }
+| LPAREN UNDERSCORE symbol numeral_list RPAREN
+    { IdUnderscoreSymNum(loc (), $3, $4) }
+;
+
+infoflag:
+| KEYWORD { InfoFlagKeyword(loc (), $1) }
+;
+
+qualidentifier:
+| identifier { QualIdentifierId(loc_identifier $1, $1) }
+| LPAREN AS identifier sort RPAREN { QualIdentifierAs(loc (), $3, $4) }
+;
+
+sexpr:
+| specconstant { SexprSpecConst(loc_specconstant $1, $1) }
+| symbol { SexprSymbol(loc_symbol $1, $1) }
+| KEYWORD { SexprKeyword(loc (), $1) }
+| LPAREN sexpr_list RPAREN { SexprInParen(loc (), $2) }
+;
+
+
+sort_list1: /*sortidsortmulti_sort_sort44:*/
+| sort { (loc_sort $1, ($1)::[]) }
+| sort sort_list1 { let (_, l1) = $2 in (loc_sort $1, ($1)::(l1)) }
+;
+
+sort:
+| identifier { SortIdentifier(loc_identifier $1, $1) }
+| LPAREN identifier sort_list1 RPAREN { SortIdSortMulti(loc (), $2, $3) }
+;
+
+sortedvar:
+| LPAREN symbol sort RPAREN { SortedVarSymSort(loc (), $2, $3) }
+;
+
+specconstant:
+| DECIMAL { SpecConstsDec(loc (), $1) }
+| NUMERAL { SpecConstNum(loc (), $1) }
+| STRINGLIT { SpecConstString(loc (), $1) }
+| HEXADECIMAL { SpecConstsHex(loc (), $1) }
+| BINARY { SpecConstsBinary(loc (), $1) }
+;
+
+symbol:
+| SYMBOL { Symbol(loc (), $1) }
+| ASCIIWOR { SymbolWithOr(loc (), $1) }
+;
+
+term_list1:
+/*termqualidterm_term_term56:*/
+/*commandgetvalue_command_term24:*/
+| term { (loc_term $1, ($1)::[]) }
+| term term_list1 { let (_, l1) = $2 in (loc_term $1, ($1)::(l1)) }
+;
+
+varbinding_list1: /*termletterm_term_varbinding58:*/
+| varbinding { (loc_varbinding $1, ($1)::[]) }
+| varbinding varbinding_list1
+    { let (_, l1) = $2 in (loc_varbinding $1, ($1)::(l1)) }
+;
+
+sortedvar_list1:
+/*termforallterm_term_sortedvar60:*/
+/*termexiststerm_term_sortedvar62:*/
+| sortedvar { (loc_sortedvar $1, ($1)::[]) }
+| sortedvar sortedvar_list1
+    { let (_, l1) = $2 in (loc_sortedvar $1, ($1)::(l1)) }
+;
+
+attribute_list1: /*termexclimationpt_term_attribute64:*/
+| attribute { (loc_attribute $1, ($1)::[]) }
+| attribute attribute_list1
+    { let (_, l1) = $2 in (loc_attribute $1, ($1)::(l1)) }
+;
+
+term:
+| specconstant
+    { TermSpecConst(loc_specconstant $1, $1) }
+| qualidentifier
+    { TermQualIdentifier(loc_qualidentifier $1, $1) }
+| LPAREN qualidentifier term_list1 RPAREN
+    { TermQualIdTerm(loc (), $2, $3) }
+| LPAREN LET LPAREN varbinding_list1 RPAREN term RPAREN
+    { TermLetTerm(loc (), $4, $6) }
+| LPAREN FORALL LPAREN sortedvar_list1 RPAREN term RPAREN
+    { TermForAllTerm(loc (), $4, $6) }
+| LPAREN EXISTS LPAREN sortedvar_list1 RPAREN term RPAREN
+    { TermExistsTerm(loc (), $4, $6) }
+| LPAREN EXCLIMATIONPT term attribute_list1 RPAREN
+    { TermExclimationPt(loc (), $3, $4) }
+;
+
+varbinding:
+| LPAREN symbol term RPAREN { VarBindingSymTerm(loc (), $2, $3) }
+;
diff --git a/src/verit/smtlib2_util.ml b/src/verit/smtlib2_util.ml
new file mode 100644
index 0000000..1ce5e46
--- /dev/null
+++ b/src/verit/smtlib2_util.ml
@@ -0,0 +1,29 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq, originally belong to The Alt-ergo theorem prover           *)
+(*     Copyright (C) 2006-2010                                            *)
+(*                                                                        *)
+(*     Sylvain Conchon                                                    *)
+(*     Evelyne Contejean                                                  *)
+(*     Stephane Lescuyer                                                  *)
+(*     Mohamed Iguernelala                                                *)
+(*     Alain Mebsout                                                      *)
+(*                                                                        *)
+(*     CNRS - INRIA - Universite Paris Sud                                *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* auto-generated by gt *)
+
+(* no extra data from grammar file. *)
+type extradata = unit;;
+let initial_data() = ();;
+
+let file = ref "stdin";;
+let line = ref 1;;
+type pos = int;;
+let string_of_pos p = "line "^(string_of_int p);;
+let cur_pd() = (!line, initial_data());;   (* "pd": pos + extradata *)
+type pd = pos * extradata;;
diff --git a/src/verit/verit.ml b/src/verit/verit.ml
new file mode 100644
index 0000000..87e74a6
--- /dev/null
+++ b/src/verit/verit.ml
@@ -0,0 +1,542 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open Entries
+open Declare
+open Decl_kinds
+
+open SmtMisc
+open CoqTerms
+open SmtForm
+open SmtCertif
+open SmtTrace
+open SmtAtom
+
+
+let debug = false
+
+
+(* Interpretation tables *)
+
+let mk_ftype cod dom =
+  let typeb = Lazy.force ctype in
+  let typea = mklApp clist [|typeb|] in
+  let a = Array.fold_right (fun bt acc -> mklApp ccons [|typeb; Btype.to_coq bt; acc|]) cod (mklApp cnil [|typeb|]) in
+  let b = Btype.to_coq dom in
+  mklApp cpair [|typea;typeb;a;b|]
+
+let make_t_i rt = Btype.interp_tbl rt
+let make_t_func ro t_i = Op.interp_tbl (mklApp ctval [|t_i|]) (fun cod dom value -> mklApp cTval [|t_i; mk_ftype cod dom; value|]) ro
+
+
+(******************************************************************************)
+(** Given a SMT-LIB2 file and a verit trace build                      *)
+(*  the corresponding object                                                  *)
+(******************************************************************************)
+
+
+let import_smtlib2 rt ro ra rf filename =
+  let chan = open_in filename in
+  let lexbuf = Lexing.from_channel chan in
+  let commands = Smtlib2_parse.main Smtlib2_lex.token lexbuf in
+  close_in chan;
+  match commands with
+    | None -> []
+    | Some (Smtlib2_ast.Commands (_,(_,res))) ->
+      List.rev (List.fold_left (Smtlib2_genConstr.declare_commands rt ro ra rf) [] res)
+
+
+let import_trace filename first =
+  let chan = open_in filename in
+  let lexbuf = Lexing.from_channel chan in
+  let confl_num = ref (-1) in
+  let first_num = ref (-1) in
+  let is_first = ref true in
+  let line = ref 1 in
+  (* let _ = Parsing.set_trace true in *)
+  try
+    while true do
+      confl_num := VeritParser.line VeritLexer.token lexbuf;
+      if !is_first then (
+        is_first := false;
+        first_num := !confl_num
+      );
+      incr line
+    done;
+    raise VeritLexer.Eof
+  with
+    | VeritLexer.Eof ->
+      close_in chan;
+      let first =
+        let aux = VeritSyntax.get_clause !first_num in
+        match first, aux.value with
+          | Some (root,l), Some (fl::nil) ->
+            if Form.equal l fl then
+              aux
+            else (
+              aux.kind <- Other (ImmFlatten(root,fl));
+              SmtTrace.link root aux;
+              root
+            )
+          | _,_ -> aux in
+      let confl = VeritSyntax.get_clause !confl_num in
+      SmtTrace.select confl;
+      (* Trace.share_prefix first (2 * last.id); *)
+      occur confl;
+      (alloc first, confl)
+    | Parsing.Parse_error -> failwith ("Verit.import_trace: parsing error line "^(string_of_int !line))
+
+
+let euf_checker_modules = [ ["SMTCoq";"Trace";"Euf_Checker"] ]
+
+let certif_ops = CoqTerms.make_certif_ops euf_checker_modules
+let cCertif = gen_constant euf_checker_modules "Certif"
+
+
+let clear_all () =
+  SmtTrace.clear ();
+  VeritSyntax.clear ()
+
+
+let compute_roots roots last_root =
+  let r = ref last_root in
+  while (has_prev !r) do
+    r := prev !r
+  done;
+
+  let rec find_root i root = function
+    | [] -> assert false
+    | t::q -> if Form.equal t root then (i,q) else find_root (i+1) root q in
+
+  let rec used_roots acc i roots r =
+    if isRoot r.kind then
+      match r.value with
+        | Some [root] ->
+          let (j,roots') = find_root i root roots in
+          used_roots (j::acc) (j+1) roots' (next r)
+        | _ -> assert false
+    else
+      acc in
+
+  used_roots [] 0 roots !r
+
+
+let parse_certif t_i t_func t_atom t_form root used_root trace fsmt fproof =
+  clear_all ();
+  let rt = Btype.create () in
+  let ro = Op.create () in
+  let ra = VeritSyntax.ra in
+  let rf = VeritSyntax.rf in
+  let roots = import_smtlib2 rt ro ra rf fsmt in
+  let (max_id, confl) = import_trace fproof None in
+  let (tres, last_root) = SmtTrace.to_coq (fun i -> mkInt (Form.to_lit i)) certif_ops confl in
+  let certif =
+   mklApp cCertif [|mkInt (max_id + 1); tres;mkInt (get_pos confl)|] in
+  let ce4 =
+    { const_entry_body = certif;
+      const_entry_type = None;
+      const_entry_secctx = None;
+      const_entry_opaque = false;
+      const_entry_inline_code = false} in
+  let _ = declare_constant trace (DefinitionEntry ce4, IsDefinition Definition) in
+  let used_roots = compute_roots roots last_root in
+  let roots =
+    let res = Array.make (List.length roots + 1) (mkInt 0) in
+    let i = ref 0 in
+    List.iter (fun j -> res.(!i) <- mkInt (Form.to_lit j); incr i) roots;
+    Term.mkArray (Lazy.force cint, res) in
+  let used_roots =
+    let l = List.length used_roots in
+    let res = Array.make (l + 1) (mkInt 0) in
+    let i = ref (l-1) in
+    List.iter (fun j -> res.(!i) <- mkInt j; decr i) used_roots;
+    mklApp cSome [|mklApp carray [|Lazy.force cint|]; Term.mkArray (Lazy.force cint, res)|] in
+  let ce3 =
+    { const_entry_body = roots;
+      const_entry_type = None;
+      const_entry_secctx = None;
+      const_entry_opaque = false;
+      const_entry_inline_code = false} in
+  let _ = declare_constant root (DefinitionEntry ce3, IsDefinition Definition) in
+  let ce3' =
+    { const_entry_body = used_roots;
+      const_entry_type = None;
+      const_entry_secctx = None;
+      const_entry_opaque = false;
+      const_entry_inline_code = false} in
+  let _ = declare_constant used_root (DefinitionEntry ce3', IsDefinition Definition) in
+  let t_i' = make_t_i rt in
+  let t_func' = make_t_func ro t_i' in
+  let ce5 =
+    { const_entry_body = t_i';
+      const_entry_type = None;
+      const_entry_secctx = None;
+      const_entry_opaque = false;
+      const_entry_inline_code = false} in
+  let _ = declare_constant t_i (DefinitionEntry ce5, IsDefinition Definition) in
+  let ce6 =
+    { const_entry_body = t_func';
+      const_entry_type = None;
+      const_entry_secctx = None;
+      const_entry_opaque = false;
+      const_entry_inline_code = false} in
+  let _ = declare_constant t_func (DefinitionEntry ce6, IsDefinition Definition) in
+  let ce1 =
+    { const_entry_body = Atom.interp_tbl ra;
+      const_entry_type = None;
+      const_entry_secctx = None;
+      const_entry_opaque = false;
+      const_entry_inline_code = false} in
+  let _ = declare_constant t_atom (DefinitionEntry ce1, IsDefinition Definition) in
+  let ce2 =
+    { const_entry_body = snd (Form.interp_tbl rf);
+      const_entry_type = None;
+      const_entry_secctx = None;
+      const_entry_opaque = false;
+      const_entry_inline_code = false} in
+  let _ = declare_constant t_form (DefinitionEntry ce2, IsDefinition Definition) in
+  ()
+
+
+let ccertif = gen_constant euf_checker_modules "certif"
+let cchecker = gen_constant euf_checker_modules "checker"
+let cchecker_correct = gen_constant euf_checker_modules "checker_correct"
+
+let interp_roots roots =
+  let interp = Form.interp_to_coq (Atom.interp_to_coq (Hashtbl.create 17)) (Hashtbl.create 17) in
+  match roots with
+    | [] -> Lazy.force ctrue
+    | f::roots -> List.fold_left (fun acc f -> mklApp candb [|acc; interp f|]) (interp f) roots
+
+let theorem name fsmt fproof =
+  clear_all ();
+  let rt = Btype.create () in
+  let ro = Op.create () in
+  let ra = VeritSyntax.ra in
+  let rf = VeritSyntax.rf in
+  let roots = import_smtlib2 rt ro ra rf fsmt in
+  let (max_id, confl) = import_trace fproof None in
+  let (tres,last_root) = SmtTrace.to_coq (fun i -> mkInt (Form.to_lit i)) certif_ops confl in
+  let certif =
+    mklApp cCertif [|mkInt (max_id + 1); tres;mkInt (get_pos confl)|] in
+  let used_roots = compute_roots roots last_root in
+  let used_rootsCstr =
+    let l = List.length used_roots in
+    let res = Array.make (l + 1) (mkInt 0) in
+    let i = ref (l-1) in
+    List.iter (fun j -> res.(!i) <- mkInt j; decr i) used_roots;
+    mklApp cSome [|mklApp carray [|Lazy.force cint|]; Term.mkArray (Lazy.force cint, res)|] in
+  let rootsCstr =
+    let res = Array.make (List.length roots + 1) (mkInt 0) in
+    let i = ref 0 in
+    List.iter (fun j -> res.(!i) <- mkInt (Form.to_lit j); incr i) roots;
+    Term.mkArray (Lazy.force cint, res) in
+
+  let t_atom = Atom.interp_tbl ra in
+  let t_form = snd (Form.interp_tbl rf) in
+  let t_i = make_t_i rt in
+  let t_func = make_t_func ro t_i in
+
+  let theorem_concl = mklApp cnot [|mklApp cis_true [|interp_roots roots|]|] in
+  let theorem_proof =
+   Term.mkLetIn (mkName "used_roots", used_rootsCstr, mklApp coption [|mklApp carray [|Lazy.force cint|]|], (*7*)
+   Term.mkLetIn (mkName "t_atom", t_atom, mklApp carray [|Lazy.force catom|], (*6*)
+   Term.mkLetIn (mkName "t_form", t_form, mklApp carray [|Lazy.force cform|], (*5*)
+   Term.mkLetIn (mkName "d", rootsCstr, mklApp carray [|Lazy.force cint|], (*4*)
+   Term.mkLetIn (mkName "c", certif, Lazy.force ccertif, (*3*)
+   Term.mkLetIn (mkName "t_i", t_i, mklApp carray [|Lazy.force ctyp_eqb|], (*2*)
+   Term.mkLetIn (mkName "t_func", t_func, mklApp carray [|mklApp ctval [|t_i|]|], (*1*)
+   mklApp cchecker_correct
+     [|Term.mkRel 2; Term.mkRel 1; Term.mkRel 6; Term.mkRel 5; Term.mkRel 4; Term.mkRel 7; Term.mkRel 3;
+	vm_cast_true
+	  (mklApp cchecker [|Term.mkRel 2; Term.mkRel 1; Term.mkRel 6; Term.mkRel 5; Term.mkRel 4; Term.mkRel 7; Term.mkRel 3|])|]))))))) in
+  let ce =
+    { const_entry_body = theorem_proof;
+      const_entry_type = Some theorem_concl;
+      const_entry_secctx = None;
+      const_entry_opaque = true;
+      const_entry_inline_code = false} in
+  let _ = declare_constant name (DefinitionEntry ce, IsDefinition Definition) in
+    ()
+
+
+let checker fsmt fproof =
+  let t1 = Unix.time () in  (* for debug *)
+  clear_all ();
+  let t2 = Unix.time () in  (* for debug *)
+  let rt = Btype.create () in
+  let ro = Op.create () in
+  let ra = VeritSyntax.ra in
+  let rf = VeritSyntax.rf in
+  let t3 = Unix.time () in  (* for debug *)
+  let roots = import_smtlib2 rt ro ra rf fsmt in
+  let t4 = Unix.time () in  (* for debug *)
+  let (max_id, confl) = import_trace fproof None in
+  let t5 = Unix.time () in  (* for debug *)
+  let (tres,last_root) = SmtTrace.to_coq (fun i -> mkInt (Form.to_lit i)) certif_ops confl in
+  let t6 = Unix.time () in  (* for debug *)
+  let certif =
+    mklApp cCertif [|mkInt (max_id + 1); tres;mkInt (get_pos confl)|] in
+  let t7 = Unix.time () in  (* for debug *)
+  let used_roots = compute_roots roots last_root in
+  let t8 = Unix.time () in  (* for debug *)
+  let used_rootsCstr =
+    let l = List.length used_roots in
+    let res = Array.make (l + 1) (mkInt 0) in
+    let i = ref (l-1) in
+    List.iter (fun j -> res.(!i) <- mkInt j; decr i) used_roots;
+    mklApp cSome [|mklApp carray [|Lazy.force cint|]; Term.mkArray (Lazy.force cint, res)|] in
+  let t9 = Unix.time () in  (* for debug *)
+  let rootsCstr =
+    let res = Array.make (List.length roots + 1) (mkInt 0) in
+    let i = ref 0 in
+    List.iter (fun j -> res.(!i) <- mkInt (Form.to_lit j); incr i) roots;
+    Term.mkArray (Lazy.force cint, res) in
+  let t10 = Unix.time () in  (* for debug *)
+
+  let t_i = make_t_i rt in
+  let t11 = Unix.time () in  (* for debug *)
+  let t_func = make_t_func ro t_i in
+  let t12 = Unix.time () in  (* for debug *)
+  let t_atom = Atom.interp_tbl ra in
+  let t13 = Unix.time () in  (* for debug *)
+  let t_form = snd (Form.interp_tbl rf) in
+  let t14 = Unix.time () in  (* for debug *)
+
+  let tm = mklApp cchecker [|t_i; t_func; t_atom; t_form; rootsCstr; used_rootsCstr; certif|] in
+  let t15 = Unix.time () in  (* for debug *)
+
+  let res = Vnorm.cbv_vm (Global.env ()) tm (Lazy.force CoqTerms.cbool) in
+  let t16 = Unix.time () in  (* for debug *)
+  Format.eprintf "     = %s\n     : bool@."
+    (if Term.eq_constr res (Lazy.force CoqTerms.ctrue) then
+        "true" else "false");
+  let t17 = Unix.time () in  (* for debug *)
+
+  (* let expr = Constrextern.extern_constr true Environ.empty_env tm in *)
+  (* let t16 = Unix.time () in  (\* for debug *\) *)
+  (* let res_aux1 = Glob_term.CbvVm None in *)
+  (* let t17 = Unix.time () in  (\* for debug *\) *)
+  (* let res_aux2 = Vernacexpr.VernacCheckMayEval(Some res_aux1, None, expr) in *)
+  (* let t18 = Unix.time () in  (\* for debug *\) *)
+  (* Vernacentries.interp res_aux2; *)
+  (* let t19 = Unix.time () in  (\* for debug *\) *)
+
+  if debug then (
+    Printf.printf"Clear: %f
+Create hashtables: %f
+Import SMT-LIB: %f
+Import trace: %f
+Compute trace: %f
+Build certif: %f
+Build roots: %f
+Compute used roots: %f
+Build used roots: %f
+Build  t_i: %f
+Build t_func: %f
+Build t_atom: %f
+Build t_form: %f
+Build checker call: %f
+Compute checker call: %f
+Print result: %f\n" (t2-.t1) (t3-.t2) (t4-.t3) (t5-.t4) (t6-.t5) (t7-.t6) (t8-.t7) (t9-.t8) (t10-.t9) (t11-.t10) (t12-.t11) (t13-.t12) (t14-.t13) (t15-.t14) (t16-.t15) (t17-.t16);
+(*     Printf.printf"Clear: %f *)
+(* Create hashtables: %f *)
+(* Import SMT-LIB: %f *)
+(* Import trace: %f *)
+(* Compute trace: %f *)
+(* Build certif: %f *)
+(* Build roots: %f *)
+(* Compute used roots: %f *)
+(* Build used roots: %f *)
+(* Build  t_i: %f *)
+(* Build t_func: %f *)
+(* Build t_atom: %f *)
+(* Build t_form: %f *)
+(* Build checker call: %f *)
+(* Build constr: %f *)
+(* Build conclusion1: %f *)
+(* Build conclusion2: %f *)
+(* Build conclusion: %f\n" (t2-.t1) (t3-.t2) (t4-.t3) (t5-.t4) (t6-.t5) (t7-.t6) (t8-.t7) (t9-.t8) (t10-.t9) (t11-.t10) (t12-.t11) (t13-.t12) (t14-.t13) (t15-.t14) (t16-.t15) (t17-.t16) (t18-.t17) (t19-.t18); *)
+    flush stdout)
+
+
+(******************************************************************************)
+(** Given a Coq formula build the proof                                       *)
+(******************************************************************************)
+
+let export out_channel rt ro l =
+  let fmt = Format.formatter_of_out_channel out_channel in
+  Format.fprintf fmt "(set-logic QF_UFLIA)@.";
+
+  List.iter (fun (i,t) ->
+    let s = "Tindex_"^(string_of_int i) in
+    VeritSyntax.add_btype s (Tindex t);
+    Format.fprintf fmt "(declare-sort %s 0)@." s
+  ) (Btype.to_list rt);
+
+  List.iter (fun (i,cod,dom,op) ->
+    let s = "op_"^(string_of_int i) in
+    VeritSyntax.add_fun s op;
+    Format.fprintf fmt "(declare-fun %s (" s;
+    let is_first = ref true in
+    Array.iter (fun t -> if !is_first then is_first := false else Format.fprintf fmt " "; Btype.to_smt fmt t) cod;
+    Format.fprintf fmt ") ";
+    Btype.to_smt fmt dom;
+    Format.fprintf fmt ")@."
+  ) (Op.to_list ro);
+
+  Format.fprintf fmt "(assert ";
+  Form.to_smt Atom.to_smt fmt l;
+  Format.fprintf fmt ")@\n(check-sat)@\n(exit)@."
+
+
+let call_verit rt ro fl root =
+  let (filename, outchan) = Filename.open_temp_file "verit_coq" ".smt2" in
+  export outchan rt ro fl;
+  close_out outchan;
+  let logfilename = (Filename.chop_extension filename)^".vtlog" in
+
+  let command = "veriT --proof-prune --proof-merge --proof-with-sharing --cnf-definitional --disable-ackermann --input=smtlib2 --proof="^logfilename^" "^filename in
+  Format.eprintf "%s@." command;
+  let t0 = Sys.time () in
+  let exit_code = Sys.command command in
+  let t1 = Sys.time () in
+  Format.eprintf "Verit = %.5f@." (t1-.t0);
+  if exit_code <> 0 then
+    failwith ("Verit.call_verit: command "^command^
+	      " exited with code "^(string_of_int exit_code));
+  try
+    import_trace logfilename (Some root)
+  with
+    | VeritSyntax.Sat -> Errors.error "veriT can't prove this"
+
+
+let cchecker_b_correct =
+  gen_constant euf_checker_modules "checker_b_correct"
+let cchecker_b = gen_constant euf_checker_modules "checker_b"
+let cchecker_eq_correct =
+  gen_constant euf_checker_modules "checker_eq_correct"
+let cchecker_eq = gen_constant euf_checker_modules "checker_eq"
+
+
+let build_body rt ro ra rf l b (max_id, confl) =
+  let (tres,_) = SmtTrace.to_coq Form.to_coq certif_ops confl in
+  let certif =
+    mklApp cCertif [|mkInt (max_id + 1); tres;mkInt (get_pos confl)|] in
+
+  let t_atom = Atom.interp_tbl ra in
+  let t_form = snd (Form.interp_tbl rf) in
+  let t_i = make_t_i rt in
+  let t_func = make_t_func ro t_i in
+
+  let ntatom = mkName "t_atom" in
+  let ntform = mkName "t_form" in
+  let nc = mkName "c" in
+  let nti = mkName "t_i" in
+  let ntfunc = mkName "t_func" in
+
+  let vtatom = Term.mkRel 5 in
+  let vtform = Term.mkRel 4 in
+  let vc = Term.mkRel 3 in
+  let vti = Term.mkRel 2 in
+  let vtfunc = Term.mkRel 1 in
+
+  Term.mkLetIn (ntatom, t_atom, mklApp carray [|Lazy.force catom|],
+  Term.mkLetIn (ntform, t_form, mklApp carray [|Lazy.force cform|],
+  Term.mkLetIn (nc, certif, Lazy.force ccertif,
+  Term.mkLetIn (nti, Term.lift 3 t_i, mklApp carray [|Lazy.force ctyp_eqb|],
+  Term.mkLetIn (ntfunc, Term.lift 4 t_func, mklApp carray [|mklApp ctval [|t_i|]|],
+  mklApp cchecker_b_correct
+	 [|vti;vtfunc;vtatom; vtform; l; b; vc;
+	   vm_cast_true (mklApp cchecker_b [|vti;vtfunc;vtatom;vtform;l;b;vc|])|])))))
+
+
+let build_body_eq rt ro ra rf l1 l2 l (max_id, confl) =
+  let (tres,_) = SmtTrace.to_coq Form.to_coq certif_ops confl in
+  let certif =
+    mklApp cCertif [|mkInt (max_id + 1); tres;mkInt (get_pos confl)|] in
+
+  let t_atom = Atom.interp_tbl ra in
+  let t_form = snd (Form.interp_tbl rf) in
+  let t_i = make_t_i rt in
+  let t_func = make_t_func ro t_i in
+
+  let ntatom = mkName "t_atom" in
+  let ntform = mkName "t_form" in
+  let nc = mkName "c" in
+  let nti = mkName "t_i" in
+  let ntfunc = mkName "t_func" in
+
+  let vtatom = Term.mkRel 5 in
+  let vtform = Term.mkRel 4 in
+  let vc = Term.mkRel 3 in
+  let vti = Term.mkRel 2 in
+  let vtfunc = Term.mkRel 1 in
+
+  Term.mkLetIn (ntatom, t_atom, mklApp carray [|Lazy.force catom|],
+  Term.mkLetIn (ntform, t_form, mklApp carray [|Lazy.force cform|],
+  Term.mkLetIn (nc, certif, Lazy.force ccertif,
+  Term.mkLetIn (nti, Term.lift 3 t_i, mklApp carray [|Lazy.force ctyp_eqb|],
+  Term.mkLetIn (ntfunc, Term.lift 4 t_func, mklApp carray [|mklApp ctval [|t_i|]|],
+  mklApp cchecker_eq_correct
+	 [|vti;vtfunc;vtatom; vtform; l1; l2; l; vc;
+	   vm_cast_true (mklApp cchecker_eq [|vti;vtfunc;vtatom;vtform;l1;l2;l;vc|])|])))))
+
+
+let get_arguments concl =
+  let f, args = Term.decompose_app concl in
+  match args with
+  | [ty;a;b] when f = Lazy.force ceq && ty = Lazy.force cbool -> a, b
+  | [a] when f = Lazy.force cis_true -> a, Lazy.force ctrue
+  | _ -> failwith ("Verit.tactic: can only deal with equality over bool")
+
+
+let make_proof rt ro rf l =
+  let fl = Form.flatten rf l in
+  let root = SmtTrace.mkRootV [l] in
+  call_verit rt ro fl (root,l)
+
+
+let tactic gl =
+  clear_all ();
+  let rt = Btype.create () in
+  let ro = Op.create () in
+  let ra = VeritSyntax.ra in
+  let rf = VeritSyntax.rf in
+
+  let env = Tacmach.pf_env gl in
+  let sigma = Tacmach.project gl in
+  let t = Tacmach.pf_concl gl in
+
+  let (forall_let, concl) = Term.decompose_prod_assum t in
+  let env = Environ.push_rel_context forall_let env in
+  let a, b = get_arguments concl in
+  let body =
+    if (b = Lazy.force ctrue || b = Lazy.force cfalse) then
+      let l = Form.of_coq (Atom.of_coq rt ro ra env sigma) rf a in
+      let l' = if b = Lazy.force ctrue then Form.neg l else l in
+      let max_id_confl = make_proof rt ro rf l' in
+      build_body rt ro ra rf (Form.to_coq l) b max_id_confl
+    else
+      let l1 = Form.of_coq (Atom.of_coq rt ro ra env sigma) rf a in
+      let l2 = Form.of_coq (Atom.of_coq rt ro ra env sigma) rf b in
+      let l = Form.neg (Form.get rf (Fapp(Fiff,[|l1;l2|]))) in
+      let max_id_confl = make_proof rt ro rf l in
+      build_body_eq rt ro ra rf (Form.to_coq l1) (Form.to_coq l2) (Form.to_coq l) max_id_confl in
+  let compose_lam_assum forall_let body =
+    List.fold_left (fun t rd -> Term.mkLambda_or_LetIn rd t) body forall_let in
+  let res = compose_lam_assum forall_let body in
+  Tactics.exact_no_check res gl
diff --git a/src/verit/veritLexer.mll b/src/verit/veritLexer.mll
new file mode 100644
index 0000000..3314fae
--- /dev/null
+++ b/src/verit/veritLexer.mll
@@ -0,0 +1,148 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+{
+  open VeritParser
+  exception Eof
+
+  let typ_table = Hashtbl.create 53
+  let _ =
+    List.iter (fun (kwd, tok) -> Hashtbl.add typ_table kwd tok)
+      [ "input", INPU;
+        "deep_res", DEEP;
+        "true", TRUE;
+        "false", FALS;
+        "and_pos", ANDP;
+        "and_neg", ANDN;
+        "or_pos", ORP;
+        "or_neg", ORN;
+        "xor_pos1", XORP1;
+        "xor_pos2", XORP2;
+        "xor_neg1", XORN1;
+        "xor_neg2", XORN2;
+        "implies_pos", IMPP;
+        "implies_neg1", IMPN1;
+        "implies_neg2", IMPN2;
+        "equiv_pos1", EQUP1;
+        "equiv_pos2", EQUP2;
+        "equiv_neg1", EQUN1;
+        "equiv_neg2", EQUN2;
+        "ite_pos1", ITEP1;
+        "ite_pos2", ITEP2;
+        "ite_neg1", ITEN1;
+        "ite_neg2", ITEN2;
+        "eq_reflexive", EQRE;
+        "eq_transitive", EQTR;
+        "eq_congruent", EQCO;
+        "eq_congruent_pred", EQCP;
+        "dl_generic", DLGE;
+        "lia_generic", LAGE;
+        "la_generic", LAGE;
+        "la_tautology", LATA;
+        "dl_disequality", DLDE;
+        "la_disequality", LADE;
+        "forall_inst", FINS;
+        "exists_inst", EINS;
+        "skolem_ex_ax", SKEA;
+        "skolem_all_ax", SKAA;
+        "qnt_simplify_ax", QNTS;
+        "qnt_merge_ax", QNTM;
+        "resolution", RESO;
+        "and", AND;
+        "not_or", NOR;
+        "or", OR;
+        "not_and", NAND;
+        "xor1", XOR1;
+        "xor2", XOR2;
+        "not_xor1", NXOR1;
+        "not_xor2", NXOR2;
+        "implies", IMP;
+        "not_implies1", NIMP1;
+        "not_implies2", NIMP2;
+        "equiv1", EQU1;
+        "equiv2", EQU2;
+        "not_equiv1", NEQU1;
+        "not_equiv2", NEQU2;
+        "ite1", ITE1;
+        "ite2", ITE2;
+        "not_ite1", NITE1;
+        "not_ite2", NITE2;
+        "tmp_alphaconv", TPAL;
+        "tmp_LA_pre", TLAP;
+        "tmp_let_elim", TPLE;
+        "tmp_nary_elim", TPNE;
+        "tmp_distinct_elim", TPDE;
+        "tmp_simp_arith", TPSA;
+        "tmp_ite_elim", TPIE;
+        "tmp_macrosubst", TPMA;
+        "tmp_betared", TPBR;
+        "tmp_bfun_elim", TPBE;
+        "tmp_sk_connector", TPSC;
+        "tmp_pm_process", TPPP;
+        "tmp_qnt_tidy", TPQT;
+        "tmp_qnt_simplify", TPQS;
+        "tmp_skolemize", TPSK;
+        "subproof", SUBP ]
+}
+
+
+let digit = [ '0'-'9' ]
+let alpha = [ 'a'-'z' 'A' - 'Z' ]
+let blank = [' ' '\t']
+let newline = ['\n' '\r']
+let var = alpha (alpha|digit|'_')*
+let bindvar = '?' var+
+let int = '-'? digit+
+
+
+rule token = parse
+  | blank +                    { token lexbuf }
+  | newline +                  { EOL }
+
+  | ":"                        { COLON }
+  | "#"                        { SHARP }
+
+  | "("                        { LPAR }
+  | ")"                        { RPAR }
+
+  | "not"                      { NOT }
+  | "xor"                      { XOR }
+  | "ite"                      { ITE }
+  | "="                        { EQ }
+  | "<"                        { LT }
+  | "<="                       { LEQ }
+  | ">"                        { GT }
+  | ">="                       { GEQ }
+  | "+"                        { PLUS }
+  | "-"                        { MINUS }
+  | "~"                        { OPP }
+  | "*"                        { MULT }
+  | "=>"                       { IMP }
+  | "let"                      { LET }
+  | "distinct"                 { DIST }
+
+  | "Formula is Satisfiable"   { SAT }
+
+  | int                        { try INT (int_of_string (Lexing.lexeme lexbuf))
+	                         with _ -> 
+                                   BIGINT 
+                                     (Big_int.big_int_of_string 
+					(Lexing.lexeme lexbuf)) }
+  | var                        { let v = Lexing.lexeme lexbuf in
+                                 try Hashtbl.find typ_table v with
+                                   | Not_found -> VAR v }
+  | bindvar                    { BINDVAR (Lexing.lexeme lexbuf) }
+
+  | eof                        { raise Eof }
diff --git a/src/verit/veritParser.mly b/src/verit/veritParser.mly
new file mode 100644
index 0000000..f36b857
--- /dev/null
+++ b/src/verit/veritParser.mly
@@ -0,0 +1,204 @@
+/**************************************************************************/
+/*                                                                        */
+/*     SMTCoq                                                             */
+/*     Copyright (C) 2011 - 2015                                          */
+/*                                                                        */
+/*     Michaël Armand                                                     */
+/*     Benjamin Grégoire                                                  */
+/*     Chantal Keller                                                     */
+/*                                                                        */
+/*     Inria - École Polytechnique - MSR-Inria Joint Lab                  */
+/*                                                                        */
+/*   This file is distributed under the terms of the CeCILL-C licence     */
+/*                                                                        */
+/**************************************************************************/
+
+%{
+  open SmtAtom
+  open SmtForm
+  open VeritSyntax
+%}
+
+
+/*
+  définition des lexèmes
+*/
+
+%token EOL SAT
+%token COLON SHARP
+%token LPAR RPAR
+%token NOT XOR ITE EQ LT LEQ GT GEQ PLUS MINUS MULT OPP LET DIST
+%token INPU DEEP TRUE FALS ANDP ANDN ORP ORN XORP1 XORP2 XORN1 XORN2 IMPP IMPN1 IMPN2 EQUP1 EQUP2 EQUN1 EQUN2 ITEP1 ITEP2 ITEN1 ITEN2 EQRE EQTR EQCO EQCP DLGE LAGE LATA DLDE LADE FINS EINS SKEA SKAA QNTS QNTM RESO AND NOR OR NAND XOR1 XOR2 NXOR1 NXOR2 IMP NIMP1 NIMP2 EQU1 EQU2 NEQU1 NEQU2 ITE1 ITE2 NITE1 NITE2 TPAL TLAP TPLE TPNE TPDE TPSA TPIE TPMA TPBR TPBE TPSC TPPP TPQT TPQS TPSK SUBP
+%token <int> INT
+%token <Big_int.big_int> BIGINT
+%token <string> VAR BINDVAR
+
+/* type de "retour" du parseur : une clause */
+%type <int> line
+%start line
+
+
+%%
+
+line:
+  | SAT                                                    { raise Sat }
+  | INT COLON LPAR typ clause                   RPAR EOL   { mk_clause ($1,$4,$5,[]) }
+  | INT COLON LPAR typ clause clause_ids_params RPAR EOL   { mk_clause ($1,$4,$5,$6) }
+;
+
+typ:
+  | INPU                                                   { Inpu  }
+  | DEEP                                                   { Deep  }
+  | TRUE                                                   { True  }
+  | FALS                                                   { Fals  }
+  | ANDP                                                   { Andp  }
+  | ANDN                                                   { Andn  }
+  | ORP                                                    { Orp   }
+  | ORN                                                    { Orn   }
+  | XORP1                                                  { Xorp1 }
+  | XORP2                                                  { Xorp2 }
+  | XORN1                                                  { Xorn1 }
+  | XORN2                                                  { Xorn2 }
+  | IMPP                                                   { Impp  }
+  | IMPN1                                                  { Impn1 }
+  | IMPN2                                                  { Impn2 }
+  | EQUP1                                                  { Equp1 }
+  | EQUP2                                                  { Equp2 }
+  | EQUN1                                                  { Equn1 }
+  | EQUN2                                                  { Equn2 }
+  | ITEP1                                                  { Itep1 }
+  | ITEP2                                                  { Itep2 }
+  | ITEN1                                                  { Iten1 }
+  | ITEN2                                                  { Iten2 }
+  | EQRE                                                   { Eqre  }
+  | EQTR                                                   { Eqtr  }
+  | EQCO                                                   { Eqco  }
+  | EQCP                                                   { Eqcp  }
+  | DLGE                                                   { Dlge  }
+  | LAGE                                                   { Lage  }
+  | LATA                                                   { Lata  }
+  | DLDE                                                   { Dlde  }
+  | LADE                                                   { Lade  }
+  | FINS                                                   { Fins  }
+  | EINS                                                   { Eins  }
+  | SKEA                                                   { Skea  }
+  | SKAA                                                   { Skaa  }
+  | QNTS                                                   { Qnts  }
+  | QNTM                                                   { Qntm  }
+  | RESO                                                   { Reso  }
+  | AND                                                    { And   }
+  | NOR                                                    { Nor   }
+  | OR                                                     { Or    }
+  | NAND                                                   { Nand  }
+  | XOR1                                                   { Xor1  }
+  | XOR2                                                   { Xor2  }
+  | NXOR1                                                  { Nxor1 }
+  | NXOR2                                                  { Nxor2 }
+  | IMP                                                    { Imp   }
+  | NIMP1                                                  { Nimp1 }
+  | NIMP2                                                  { Nimp2 }
+  | EQU1                                                   { Equ1  }
+  | EQU2                                                   { Equ2  }
+  | NEQU1                                                  { Nequ1 }
+  | NEQU2                                                  { Nequ2 }
+  | ITE1                                                   { Ite1  }
+  | ITE2                                                   { Ite2  }
+  | NITE1                                                  { Nite1 }
+  | NITE2                                                  { Nite2 }
+  | TPAL                                                   { Tpal  }
+  | TLAP                                                   { Tlap  }
+  | TPLE                                                   { Tple  }
+  | TPNE                                                   { Tpne  }
+  | TPDE                                                   { Tpde  }
+  | TPSA                                                   { Tpsa  }
+  | TPIE                                                   { Tpie  }
+  | TPMA                                                   { Tpma  }
+  | TPBR                                                   { Tpbr  }
+  | TPBE                                                   { Tpbe  }
+  | TPSC                                                   { Tpsc  }
+  | TPPP                                                   { Tppp  }
+  | TPQT                                                   { Tpqt  }
+  | TPQS                                                   { Tpqs  }
+  | TPSK                                                   { Tpsk  }
+  | SUBP                                                   { Subp  }
+;
+
+clause:
+  | LPAR          RPAR                                     { [] }
+  | LPAR lit_list RPAR                                     { $2 }
+;
+
+lit_list:
+  | lit                                                    { [$1] }
+  | lit lit_list                                           { $1::$2 }
+;
+
+lit:   /* returns a SmtAtom.Form.t */
+  | name_term                                              { lit_of_atom_form_lit rf $1 }
+  | LPAR NOT lit RPAR                                      { Form.neg $3 }
+;
+
+name_term:   /* returns a SmtAtom.Form.pform or a SmtAtom.hatom */
+  | SHARP INT                                              { get_solver $2 }
+  | SHARP INT COLON LPAR term RPAR                         { let res = $5 in add_solver $2 res; res }
+  | TRUE                                                   { Form Form.pform_true }
+  | FALS                                                   { Form Form.pform_false }
+  | VAR                                                    { Atom (Atom.get ra (Aapp (get_fun $1,[||]))) }
+  | BINDVAR                                                { Hashtbl.find hlets $1 }
+  | INT                                                    { Atom (Atom.hatom_Z_of_int ra $1) }
+  | BIGINT                                                 { Atom (Atom.hatom_Z_of_bigint ra $1) }
+;
+
+term:   /* returns a SmtAtom.Form.pform or a SmtAtom.hatom */
+  | LPAR term RPAR                                         { $2 }
+
+  /* Formulae */
+  | TRUE                                                   { Form Form.pform_true }
+  | FALS                                                   { Form Form.pform_false }
+  | AND lit_list                                           { Form (Fapp (Fand, Array.of_list $2)) }
+  | OR lit_list                                            { Form (Fapp (For, Array.of_list $2)) }
+  | IMP lit_list                                           { Form (Fapp (Fimp, Array.of_list $2)) }
+  | XOR lit_list                                           { Form (Fapp (Fxor, Array.of_list $2)) }
+  | ITE lit_list                                           { Form (Fapp (Fite, Array.of_list $2)) }
+
+  /* Atoms */
+  | INT                                                    { Atom (Atom.hatom_Z_of_int ra $1) }
+  | BIGINT                                                 { Atom (Atom.hatom_Z_of_bigint ra $1) }
+  | LT name_term name_term                                 { match $2,$3 with |Atom h1, Atom h2 -> Atom (Atom.mk_lt ra h1 h2) | _,_ -> assert false }
+  | LEQ name_term name_term                                { match $2,$3 with |Atom h1, Atom h2 -> Atom (Atom.mk_le ra h1 h2) | _,_ -> assert false }
+  | GT name_term name_term                                 { match $2,$3 with |Atom h1, Atom h2 -> Atom (Atom.mk_gt ra h1 h2) | _,_ -> assert false }
+  | GEQ name_term name_term                                { match $2,$3 with |Atom h1, Atom h2 -> Atom (Atom.mk_ge ra h1 h2) | _,_ -> assert false }
+  | PLUS name_term name_term                               { match $2,$3 with |Atom h1, Atom h2 -> Atom (Atom.mk_plus ra h1 h2) | _,_ -> assert false }
+  | MULT name_term name_term                               { match $2,$3 with |Atom h1, Atom h2 -> Atom (Atom.mk_mult ra h1 h2) | _,_ -> assert false }
+  | MINUS name_term name_term                              { match $2,$3 with |Atom h1, Atom h2 -> Atom (Atom.mk_minus ra h1 h2) | _,_ -> assert false }
+  | MINUS name_term                                        { match $2 with | Atom h -> Atom (Atom.mk_opp ra h) | _ -> assert false }
+  | OPP name_term                                          { match $2 with | Atom h -> Atom (Atom.mk_opp ra h) | _ -> assert false }
+  | DIST args                                              { let a = Array.of_list $2 in Atom (Atom.mk_distinct ra (Atom.type_of a.(0)) a) }
+  | VAR                                                    { Atom (Atom.get ra (Aapp (get_fun $1, [||]))) }
+  | VAR args                                               { Atom (Atom.get ra (Aapp (get_fun $1, Array.of_list $2))) }
+
+  /* Both */
+  | EQ name_term name_term                                 { let t1 = $2 in let t2 = $3 in match t1,t2 with | Atom h1, Atom h2 when (match Atom.type_of h1 with | Tbool -> false | _ -> true) -> Atom (Atom.mk_eq ra (Atom.type_of h1) h1 h2) | _, _ -> Form (Fapp (Fiff, [|lit_of_atom_form_lit rf t1; lit_of_atom_form_lit rf t2|])) }
+  | LET LPAR bindlist RPAR name_term                       { $3; $5 }
+  | BINDVAR                                                { Hashtbl.find hlets $1 }
+;
+
+bindlist:
+  | LPAR BINDVAR name_term RPAR                            { Hashtbl.add hlets $2 $3 }
+  | LPAR BINDVAR lit RPAR                                  { Hashtbl.add hlets $2 (Lit $3) }
+  | LPAR BINDVAR name_term RPAR bindlist                   { Hashtbl.add hlets $2 $3; $5 }
+  | LPAR BINDVAR lit RPAR bindlist                         { Hashtbl.add hlets $2 (Lit $3); $5 }
+
+args:
+  | name_term                                              { match $1 with Atom h -> [h] | _ -> assert false }
+  | name_term args                                         { match $1 with Atom h -> h::$2 | _ -> assert false }
+;
+
+clause_ids_params:
+  | int_list                                               { $1 }
+;
+
+int_list:
+  | INT                                                    { [$1] }
+  | INT int_list                                           { let x1 = $1 in let x2 = $2 in x1::x2 }
+;
diff --git a/src/verit/veritSyntax.ml b/src/verit/veritSyntax.ml
new file mode 100644
index 0000000..c60d34f
--- /dev/null
+++ b/src/verit/veritSyntax.ml
@@ -0,0 +1,355 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open SmtAtom
+open SmtForm
+open SmtCertif
+open SmtTrace
+
+
+(*** Syntax of veriT proof traces ***)
+
+exception Sat
+
+type typ = | Inpu | Deep | True | Fals | Andp | Andn | Orp | Orn | Xorp1 | Xorp2 | Xorn1 | Xorn2 | Impp | Impn1 | Impn2 | Equp1 | Equp2 | Equn1 | Equn2 | Itep1 | Itep2 | Iten1 | Iten2 | Eqre | Eqtr | Eqco | Eqcp | Dlge | Lage | Lata | Dlde | Lade | Fins | Eins | Skea | Skaa | Qnts | Qntm | Reso | And | Nor | Or | Nand | Xor1 | Xor2 | Nxor1 | Nxor2 | Imp | Nimp1 | Nimp2 | Equ1 | Equ2 | Nequ1 | Nequ2 | Ite1 | Ite2 | Nite1 | Nite2 | Tpal | Tlap | Tple | Tpne | Tpde | Tpsa | Tpie | Tpma | Tpbr | Tpbe | Tpsc | Tppp | Tpqt | Tpqs | Tpsk | Subp
+
+
+(* About equality *)
+
+let get_eq l =
+  match Form.pform l with
+    | Fatom ha ->
+      (match Atom.atom ha with
+        | Abop (BO_eq _,a,b) -> (a,b)
+        | _ -> failwith "VeritSyntax.get_eq: equality was expected")
+    | _ -> failwith "VeritSyntax.get_eq: equality was expected"
+
+let get_at l =
+  match Form.pform l with
+    | Fatom ha -> ha
+    | _ -> failwith "VeritSyntax.get_eq: equality was expected"
+
+let is_eq l =
+  match Form.pform l with
+    | Fatom ha ->
+      (match Atom.atom ha with
+        | Abop (BO_eq _,_,_) -> true
+        | _ -> false)
+    | _ -> failwith "VeritSyntax.get_eq: atom was expected"
+
+
+(* Transitivity *)
+
+let rec process_trans a b prem res =
+  try
+    let (l,(c,c')) = List.find (fun (l,(a',b')) -> (a' = b || b' = b)) prem in
+    let prem = List.filter (fun l' -> l' <> (l,(c,c'))) prem in
+    let c = if c = b then c' else c in
+    if a = c
+    then List.rev (l::res)
+    else process_trans a c prem (l::res)
+  with
+    |Not_found -> if a = b then [] else assert false
+
+
+let mkTrans p =
+  let (concl,prem) = List.partition Form.is_pos p in
+  match concl with
+    |[c] ->
+      let a,b = get_eq c in
+      let prem_val = List.map (fun l -> (l,get_eq l)) prem in
+      let cert = (process_trans a b prem_val []) in
+      Other (EqTr (c,cert))
+    |_ -> failwith "VeritSyntax.mkTrans: no conclusion or more than one conclusion in transitivity"
+
+
+(* Congruence *)
+
+let rec process_congr a_args b_args prem res =
+  match a_args,b_args with
+    | a::a_args,b::b_args ->
+      (* if a = b *)
+      (* then process_congr a_args b_args prem (None::res) *)
+      (* else *)
+        let (l,(a',b')) = List.find (fun (l,(a',b')) -> (a = a' && b = b')||(a = b' && b = a')) prem in
+        process_congr a_args b_args prem ((Some l)::res)
+    | [],[] -> List.rev res
+    | _ -> failwith "VeritSyntax.process_congr: incorrect number of arguments in function application"
+
+
+let mkCongr p =
+  let (concl,prem) = List.partition Form.is_pos p in
+  match concl with
+    |[c] ->
+      let a,b = get_eq c in
+      let prem_val = List.map (fun l -> (l,get_eq l)) prem in
+      (match Atom.atom a, Atom.atom b with
+        | Abop(aop,a1,a2), Abop(bop,b1,b2) when (aop = bop) ->
+          let a_args = [a1;a2] in
+          let b_args = [b1;b2] in
+          let cert = process_congr a_args b_args prem_val [] in
+          Other (EqCgr (c,cert))
+        | Auop (aop,a), Auop (bop,b) when (aop = bop) ->
+          let a_args = [a] in
+          let b_args = [b] in
+          let cert = process_congr a_args b_args prem_val [] in
+          Other (EqCgr (c,cert))
+        | Aapp (a_f,a_args), Aapp (b_f,b_args) ->
+          if a_f = b_f then
+            let cert = process_congr (Array.to_list a_args) (Array.to_list b_args) prem_val [] in
+            Other (EqCgr (c,cert))
+          else failwith "VeritSyntax.mkCongr: left function is different from right fucntion"
+        | _, _ -> failwith "VeritSyntax.mkCongr: atoms are not applications")
+    |_ -> failwith "VeritSyntax.mkCongr: no conclusion or more than one conclusion in congruence"
+
+
+let mkCongrPred p =
+  let (concl,prem) = List.partition Form.is_pos p in
+  let (prem,prem_P) = List.partition is_eq prem in
+  match concl with
+    |[c] ->
+      (match prem_P with
+        |[p_p] ->
+          let prem_val = List.map (fun l -> (l,get_eq l)) prem in
+          (match Atom.atom (get_at c), Atom.atom (get_at p_p) with
+            | Abop(aop,a1,a2), Abop(bop,b1,b2) when (aop = bop) ->
+              let a_args = [a1;a2] in
+              let b_args = [b1;b2] in
+              let cert = process_congr a_args b_args prem_val [] in
+              Other (EqCgrP (p_p,c,cert))
+            | Aapp (a_f,a_args), Aapp (b_f,b_args) ->
+              if a_f = b_f then
+                let cert = process_congr (Array.to_list a_args) (Array.to_list b_args) prem_val [] in
+                Other (EqCgrP (p_p,c,cert))
+              else failwith "VeritSyntax.mkCongrPred: unmatching predicates"
+            | _ -> failwith "VeritSyntax.mkCongrPred : not pred app")
+        |_ ->  failwith "VeritSyntax.mkCongr: no or more than one predicate app premice in congruence")
+    |[] ->  failwith "VeritSyntax.mkCongrPred: no conclusion in congruence"
+    |_ -> failwith "VeritSyntax.mkCongrPred: more than one conclusion in congruence"
+
+
+(* Linear arithmetic *)
+
+let mkMicromega cl =
+  let _tbl, _f, cert = Lia.build_lia_certif cl in
+  let c =
+    match cert with
+      | None -> failwith "VeritSyntax.mkMicromega: micromega can't solve this"
+      | Some c -> c in
+  Other (LiaMicromega (cl,c))
+
+
+let mkSplArith orig cl =
+  let res =
+    match cl with
+      | res::nil -> res
+      | _ -> failwith "VeritSyntax.mkSplArith: wrong number of literals in the resulting clause" in
+  try
+    let orig' =
+      match orig.value with
+        | Some [orig'] -> orig'
+        | _ -> failwith "VeritSyntax.mkSplArith: wrong number of literals in the premise clause" in
+    let _tbl, _f, cert = Lia.build_lia_certif [Form.neg orig';res] in
+    let c =
+      match cert with
+        | None -> failwith "VeritSyntax.mkSplArith: micromega can't solve this"
+        | Some c -> c in
+    Other (SplArith (orig,res,c))
+  with
+    | _ -> Other (ImmFlatten (orig, res))
+
+
+(* Elimination of operators *)
+
+let mkDistinctElim old value =
+  let rec find_res l1 l2 =
+    match l1,l2 with
+      | t1::q1,t2::q2 -> if t1 == t2 then find_res q1 q2 else t2
+      | _, _ -> assert false in
+  let l1 = match old.value with
+    | Some l -> l
+    | None -> assert false in
+  Other (SplDistinctElim (old,find_res l1 value))
+
+
+(* Generating clauses *)
+
+let clauses : (int,Form.t clause) Hashtbl.t = Hashtbl.create 17
+let get_clause id =
+  try Hashtbl.find clauses id
+  with | Not_found -> failwith ("VeritSyntax.get_clause : clause number "^(string_of_int id)^" not found\n")
+let add_clause id cl = Hashtbl.add clauses id cl
+let clear_clauses () = Hashtbl.clear clauses
+
+let mk_clause (id,typ,value,ids_params) =
+  let kind =
+    match typ with
+      (* Roots *)
+      | Inpu -> Root
+      (* Cnf conversion *)
+      | True -> Other SmtCertif.True
+      | Fals -> Other False
+      | Andn | Orp | Impp | Xorp1 | Xorn1 | Equp1 | Equn1 | Itep1 | Iten1 ->
+        (match value with
+          | l::_ -> Other (BuildDef l)
+          | _ -> assert false)
+      | Xorp2 | Xorn2 | Equp2 | Equn2 | Itep2 | Iten2 ->
+        (match value with
+          | l::_ -> Other (BuildDef2 l)
+          | _ -> assert false)
+      | Orn | Andp ->
+        (match value,ids_params with
+          | l::_, [p] -> Other (BuildProj (l,p))
+          | _ -> assert false)
+      | Impn1 ->
+        (match value with
+          | l::_ -> Other (BuildProj (l,0))
+          | _ -> assert false)
+      | Impn2 ->
+        (match value with
+          | l::_ -> Other (BuildProj (l,1))
+          | _ -> assert false)
+      | Nand | Or | Imp | Xor1 | Nxor1 | Equ2 | Nequ2 | Ite1 | Nite1 ->
+        (match ids_params with
+          | [id] -> Other (ImmBuildDef (get_clause id))
+          | _ -> assert false)
+      | Xor2 | Nxor2 | Equ1 | Nequ1 | Ite2 | Nite2 ->
+        (match ids_params with
+          | [id] -> Other (ImmBuildDef2 (get_clause id))
+          | _ -> assert false)
+      | And | Nor ->
+        (match ids_params with
+          | [id;p] -> Other (ImmBuildProj (get_clause id,p))
+          | _ -> assert false)
+      | Nimp1 ->
+        (match ids_params with
+          | [id] -> Other (ImmBuildProj (get_clause id,0))
+          | _ -> assert false)
+      | Nimp2 ->
+        (match ids_params with
+          | [id] -> Other (ImmBuildProj (get_clause id,1))
+          | _ -> assert false)
+      (* Equality *)
+      | Eqre -> mkTrans value
+      | Eqtr -> mkTrans value
+      | Eqco -> mkCongr value
+      | Eqcp -> mkCongrPred value
+      (* Linear integer arithmetic *)
+      | Dlge | Lage | Lata -> mkMicromega value
+      | Lade               -> mkMicromega value (* TODO: utiliser un solveur plus simple *)
+      | Dlde ->
+        (match value with
+          | l::_ -> Other (LiaDiseq l)
+          | _ -> assert false)
+      (* Resolution *)
+      | Reso ->
+        (match ids_params with
+          | cl1::cl2::q ->
+            let res = {rc1 = get_clause cl1; rc2 = get_clause cl2; rtail = List.map get_clause q} in
+            Res res
+          | _ -> assert false)
+      (* Simplifications *)
+      | Tpal ->
+        (match ids_params with
+          | id::_ -> Same (get_clause id)
+          | _ -> assert false)
+      | Tple ->
+        (match ids_params with
+          | id::_ -> Same (get_clause id)
+          | _ -> assert false)
+      | Tpde ->
+        (match ids_params with
+          | id::_ -> mkDistinctElim (get_clause id) value
+          | _ -> assert false)
+      | Tpsa | Tlap ->
+        (match ids_params with
+          | id::_ -> mkSplArith (get_clause id) value
+          | _ -> assert false)
+       (* Not implemented *)
+      | Deep -> failwith "VeritSyntax.ml: rule deep_res not implemented yet"
+      | Fins -> failwith "VeritSyntax.ml: rule forall_inst not implemented yet"
+      | Eins -> failwith "VeritSyntax.ml: rule exists_inst not implemented yet"
+      | Skea -> failwith "VeritSyntax.ml: rule skolem_ex_ax not implemented yet"
+      | Skaa -> failwith "VeritSyntax.ml: rule skolem_all_ax not implemented yet"
+      | Qnts -> failwith "VeritSyntax.ml: rule qnt_simplify_ax not implemented yet"
+      | Qntm -> failwith "VeritSyntax.ml: rule qnt_merge_ax not implemented yet"
+      | Tpne -> failwith "VeritSyntax.ml: rule tmp_nary_elim not implemented yet"
+      | Tpie -> failwith "VeritSyntax.ml: rule tmp_ite_elim not implemented yet"
+      | Tpma -> failwith "VeritSyntax.ml: rule tmp_macrosubst not implemented yet"
+      | Tpbr -> failwith "VeritSyntax.ml: rule tmp_betared not implemented yet"
+      | Tpbe -> failwith "VeritSyntax.ml: rule tmp_bfun_elim not implemented yet"
+      | Tpsc -> failwith "VeritSyntax.ml: rule tmp_sk_connector not implemented yet"
+      | Tppp -> failwith "VeritSyntax.ml: rule tmp_pm_process not implemented yet"
+      | Tpqt -> failwith "VeritSyntax.ml: rule tmp_qnt_tidy not implemented yet"
+      | Tpqs -> failwith "VeritSyntax.ml: rule tmp_qnt_simplify not implemented yet"
+      | Tpsk -> failwith "VeritSyntax.ml: rule tmp_skolemize not implemented yet"
+      | Subp -> failwith "VeritSyntax.ml: rule subproof not implemented yet"
+  in
+  let cl =
+    (* TODO: change this into flatten when necessary *)
+    if SmtTrace.isRoot kind then SmtTrace.mkRootV value
+    else SmtTrace.mk_scertif kind (Some value) in
+  add_clause id cl;
+  if id > 1 then SmtTrace.link (get_clause (id-1)) cl;
+  id
+
+
+type atom_form_lit =
+  | Atom of SmtAtom.Atom.t
+  | Form of SmtAtom.Form.pform
+  | Lit of SmtAtom.Form.t
+
+let lit_of_atom_form_lit rf = function
+  | Atom a -> Form.get rf (Fatom a)
+  | Form f -> Form.get rf f
+  | Lit l -> l
+
+let solver : (int,atom_form_lit) Hashtbl.t = Hashtbl.create 17
+let get_solver id =
+  try Hashtbl.find solver id
+  with | Not_found -> failwith ("VeritSyntax.get_solver : solver variable number "^(string_of_int id)^" not found\n")
+let add_solver id cl = Hashtbl.add solver id cl
+let clear_solver () = Hashtbl.clear solver
+
+let btypes : (string,btype) Hashtbl.t = Hashtbl.create 17
+let get_btype id =
+  try Hashtbl.find btypes id
+  with | Not_found -> failwith ("VeritSyntax.get_btype : sort symbol \""^id^"\" not found\n")
+let add_btype id cl = Hashtbl.add btypes id cl
+let clear_btypes () = Hashtbl.clear btypes
+
+let funs : (string,indexed_op) Hashtbl.t = Hashtbl.create 17
+let get_fun id =
+  try Hashtbl.find funs id
+  with | Not_found -> failwith ("VeritSyntax.get_fun : function symbol \""^id^"\" not found\n")
+let add_fun id cl = Hashtbl.add funs id cl
+let clear_funs () = Hashtbl.clear funs
+
+
+let ra = Atom.create ()
+let rf = Form.create ()
+
+let hlets : (string, atom_form_lit) Hashtbl.t = Hashtbl.create 17
+
+
+let clear () =
+  clear_clauses ();
+  clear_solver ();
+  clear_btypes ();
+  clear_funs ();
+  Atom.clear ra;
+  Form.clear rf;
+  Hashtbl.clear hlets
diff --git a/src/verit/veritSyntax.mli b/src/verit/veritSyntax.mli
new file mode 100644
index 0000000..9813b54
--- /dev/null
+++ b/src/verit/veritSyntax.mli
@@ -0,0 +1,44 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+exception Sat
+
+type typ = | Inpu | Deep | True | Fals | Andp | Andn | Orp | Orn | Xorp1 | Xorp2 | Xorn1 | Xorn2 | Impp | Impn1 | Impn2 | Equp1 | Equp2 | Equn1 | Equn2 | Itep1 | Itep2 | Iten1 | Iten2 | Eqre | Eqtr | Eqco | Eqcp | Dlge | Lage | Lata | Dlde | Lade | Fins | Eins | Skea | Skaa | Qnts | Qntm | Reso | And | Nor | Or | Nand | Xor1 | Xor2 | Nxor1 | Nxor2 | Imp | Nimp1 | Nimp2 | Equ1 | Equ2 | Nequ1 | Nequ2 | Ite1 | Ite2 | Nite1 | Nite2 | Tpal | Tlap | Tple | Tpne | Tpde | Tpsa | Tpie | Tpma | Tpbr | Tpbe | Tpsc | Tppp | Tpqt | Tpqs | Tpsk | Subp
+
+val get_clause : int -> SmtAtom.Form.t SmtCertif.clause
+val add_clause : int -> SmtAtom.Form.t SmtCertif.clause -> unit
+
+val mk_clause : SmtCertif.clause_id * typ * SmtAtom.Form.t list * SmtCertif.clause_id list -> SmtCertif.clause_id
+
+type atom_form_lit =
+  | Atom of SmtAtom.Atom.t
+  | Form of SmtAtom.Form.pform
+  | Lit of SmtAtom.Form.t
+val lit_of_atom_form_lit : SmtAtom.Form.reify -> atom_form_lit -> SmtAtom.Form.t
+val get_solver : int -> atom_form_lit
+val add_solver : int -> atom_form_lit -> unit
+
+val get_btype : string -> SmtAtom.btype
+val add_btype : string -> SmtAtom.btype -> unit
+
+val get_fun : string -> SmtAtom.indexed_op
+val add_fun : string -> SmtAtom.indexed_op -> unit
+
+val ra : SmtAtom.Atom.reify_tbl
+val rf : SmtAtom.Form.reify
+
+val hlets : (string, atom_form_lit) Hashtbl.t
+
+val clear : unit -> unit
diff --git a/src/zchaff/cnfParser.ml b/src/zchaff/cnfParser.ml
new file mode 100644
index 0000000..9a21675
--- /dev/null
+++ b/src/zchaff/cnfParser.ml
@@ -0,0 +1,57 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+open SatParser
+
+
+let skip_comment lb =
+  while blank_check_string lb "c" do skip_line lb done
+
+let parse_p_cnf lb =
+  skip_comment lb;
+  blank_match_string lb "p";
+  blank_match_string lb "cnf";
+  let nvar = input_blank_int lb in
+  let _ = input_blank_int lb in
+  nvar
+
+let mklit nvars reify l =
+  let sign = l > 0 in
+  let x = (if sign then l else - l) - 1 in
+  assert (0 <= x && x < nvars); 
+  let p = SatAtom.Form.get reify (SmtForm.Fatom x) in
+  if sign then p else SatAtom.Form.neg p
+
+let rec parse_clause nvars reify lb =
+  let i = input_blank_int lb in
+  if i = 0 then []
+  else mklit nvars reify i :: parse_clause nvars reify lb
+
+let rec parse_clauses nvars reify lb last =
+  if is_start_int lb then
+    let c = SmtTrace.mkRootV (parse_clause nvars reify lb) in
+    SmtTrace.link last c;
+    parse_clauses nvars reify lb c
+  else last 
+
+let parse_cnf filename =
+  let reify = SatAtom.Form.create () in
+  let lb = open_file "CNF" filename in
+  let nvars = parse_p_cnf lb in
+  let first = SmtTrace.mkRootV (parse_clause nvars reify lb) in
+  let last = parse_clauses nvars reify lb first in
+  close lb;
+  nvars, first, last
+
diff --git a/src/zchaff/satParser.ml b/src/zchaff/satParser.ml
new file mode 100644
index 0000000..731d499
--- /dev/null
+++ b/src/zchaff/satParser.ml
@@ -0,0 +1,178 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+type lex_buff = {
+            buff       : string;
+    mutable curr_char  : int;
+    mutable buff_end   : int;
+            in_ch      : in_channel
+  }
+
+let buff_length = 1024
+
+let open_file s name =
+  try
+    let in_channel = open_in name in
+    let buff = String.create buff_length in
+    let buff_end = input in_channel buff 0 buff_length in
+    { buff = buff; curr_char = 0; buff_end = buff_end; in_ch = in_channel }
+  with _ ->
+    Printf.printf ("%s file %s does not exists.\n") s name;
+    exit 1
+
+let close lb =
+  lb.buff_end <- 0;
+  close_in lb.in_ch
+
+let eof lb = lb.buff_end == 0
+
+let curr_char lb =
+  if eof lb then raise End_of_file
+  else lb.buff.[lb.curr_char]
+
+let refill lb =
+  let ne = input lb.in_ch lb.buff 0 buff_length in
+  lb.curr_char <- 0;
+  lb.buff_end <- ne
+
+(* Unsafe function *)
+let is_space c = c == ' ' || c == '\t'
+
+let is_space_ret c = c == ' ' || c == '\n' || c == '\t'
+
+
+let skip to_skip lb =
+  while not (eof lb) && to_skip lb.buff.[lb.curr_char] do
+    while lb.curr_char < lb.buff_end && to_skip lb.buff.[lb.curr_char] do
+      lb.curr_char <- lb.curr_char + 1
+    done;
+    if lb.curr_char = lb.buff_end then refill lb
+  done
+
+let skip_space lb = skip is_space lb
+let skip_blank lb = skip is_space_ret lb
+
+
+let skip_string lb s =
+  let slen = String.length s in
+  let pos = ref 0 in
+  while !pos < slen && not (eof lb) && lb.buff.[lb.curr_char] == s.[!pos] do
+    lb.curr_char <- lb.curr_char + 1;
+    incr pos;
+    while !pos < slen &&  lb.curr_char < lb.buff_end && lb.buff.[lb.curr_char] == s.[!pos] do
+      lb.curr_char <- lb.curr_char + 1;
+      incr pos
+    done;
+    if lb.curr_char = lb.buff_end then refill lb
+  done;
+  !pos = slen
+
+let match_string lb s =
+  if not (skip_string lb s) then raise (Invalid_argument ("match_string "^s))
+
+let aux_buff = String.create buff_length
+let aux_be = ref 0
+let aux_pi = ref 0
+let aux_cc = ref 0
+
+let save_lb lb =
+  aux_cc := lb.curr_char;
+  aux_be := lb.buff_end;
+  aux_pi := pos_in lb.in_ch;
+  String.blit lb.buff !aux_cc aux_buff !aux_cc (!aux_be - !aux_cc)
+
+let restore_lb lb =
+  lb.curr_char <- !aux_cc;
+  lb.buff_end <- !aux_be;
+  seek_in lb.in_ch !aux_pi;
+  String.blit aux_buff !aux_cc lb.buff !aux_cc (!aux_be - !aux_cc)
+
+let check_string lb s =
+  let slen = String.length s in
+  if String.length s <= lb.buff_end - lb.curr_char then
+    let cc = lb.curr_char in
+    let pos = ref 0 in
+    while !pos < slen && lb.buff.[lb.curr_char] == s.[!pos] do
+      lb.curr_char <- lb.curr_char + 1;
+      incr pos
+    done;
+    if !pos = slen then begin
+      if lb.curr_char = lb.buff_end then refill lb;
+      true
+    end else begin
+      lb.curr_char <- cc;
+      false
+    end
+  else begin
+    save_lb lb;
+    let b = skip_string lb s in
+    if not b then restore_lb lb;
+    b
+  end
+
+let blank_check_string lb s =
+  skip_blank lb;
+  check_string lb s
+
+let blank_match_string lb s =
+  skip_blank lb;
+  match_string lb s
+
+let is_digit c =
+  '0' <= c && c <= '9'
+
+let is_start_int lb =
+  skip_blank lb;
+  not (eof lb) && (is_digit lb.buff.[lb.curr_char] || lb.buff.[lb.curr_char] == '-')
+
+let input_int lb =
+  if eof lb then raise End_of_file
+  else begin
+    let sign =
+      if lb.buff.[lb.curr_char] == '-' then begin
+	lb.curr_char <- lb.curr_char + 1;
+	if lb.curr_char = lb.buff_end then refill lb;
+	-1
+      end else
+	1 in
+    if eof lb then raise End_of_file;
+    if not (is_digit lb.buff.[lb.curr_char]) then raise (Invalid_argument "input_int");
+    let n = ref (Char.code lb.buff.[lb.curr_char] - Char.code '0') in
+    lb.curr_char <- lb.curr_char + 1;
+    if lb.curr_char = lb.buff_end then refill lb;
+    while not (eof lb) && is_digit lb.buff.[lb.curr_char] do
+      while lb.curr_char < lb.buff_end && is_digit lb.buff.[lb.curr_char] do
+	n := !n*10 + (Char.code lb.buff.[lb.curr_char] - Char.code '0');
+	lb.curr_char <- lb.curr_char + 1
+      done;
+      if lb.curr_char = lb.buff_end then refill lb
+    done;
+    sign * !n
+  end
+
+let input_blank_int lb =
+  skip_blank lb;
+  input_int lb
+
+
+let skip_line lb =
+  let notfound = ref true in
+  while not (eof lb) && !notfound do
+    while lb.curr_char < lb.buff_end && !notfound do
+      if lb.buff.[lb.curr_char] == '\n' then notfound := false;
+      lb.curr_char <- lb.curr_char + 1
+    done;
+    if lb.curr_char = lb.buff_end then refill lb
+  done
diff --git a/src/zchaff/zchaff.ml b/src/zchaff/zchaff.ml
new file mode 100644
index 0000000..b94a0cc
--- /dev/null
+++ b/src/zchaff/zchaff.ml
@@ -0,0 +1,532 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open Entries
+open Declare
+open Decl_kinds
+
+open SmtMisc
+open CoqTerms
+open SmtForm
+open SmtCertif
+open SmtTrace
+open SatAtom
+open SmtMisc
+
+
+(* Detection of trivial clauses *)
+
+let rec is_trivial cl =
+  match cl with
+  | l :: cl -> 
+      let nl = Form.neg l in
+      List.exists (fun l' -> Form.equal nl l') cl || is_trivial cl
+  | [] -> false
+
+
+(* Pretty printing *)
+
+let string_of_op = function
+  | Ftrue -> "true"
+  | Ffalse -> "false"
+  | Fand -> "and"
+  | For -> "or"
+  | Fxor -> "xor"
+  | Fimp -> "imp"
+  | Fiff -> "iff"
+  | Fite -> "ite"
+  | Fnot2 i -> "!"^string_of_int i
+
+let rec pp_form fmt l = 
+  Format.fprintf fmt "(#%i %a %a)" (Form.to_lit l)pp_sign l pp_pform (Form.pform l)
+and pp_sign fmt l = 
+  if Form.is_pos l then () 
+  else Format.fprintf fmt "-"
+and pp_pform fmt p = 
+  match p with
+  | Fatom x -> Format.fprintf fmt "x%i" x
+  | Fapp(op,args) ->
+      Format.fprintf fmt "%s" (string_of_op op);
+      Array.iter (fun a -> Format.fprintf fmt "%a " pp_form a) args
+
+let pp_value fmt c = 
+  match c.value with
+  | Some cl ->
+      Format.fprintf fmt "VAL = {";
+      List.iter (Format.fprintf fmt "%a " pp_form) cl;
+      Format.fprintf fmt "}@."
+  | _ -> Format.fprintf fmt "Val = empty@."
+
+
+let pp_kind fmt c = 
+  match c.kind with
+  | Root -> Format.fprintf fmt "Root"
+  | Res res -> 
+      Format.fprintf fmt "(Res %i %i " res.rc1.id res.rc2.id;
+      List.iter (fun c -> Format.fprintf fmt "%i " c.id) res.rtail;
+      Format.fprintf fmt ") "
+  | Other other ->
+    begin match other with
+    | ImmFlatten (c,l) -> 
+	Format.fprintf fmt "(ImmFlatten %i %a)"
+	  c.id pp_form l
+    | True -> Format.fprintf fmt "True"
+    | False -> Format.fprintf fmt "False"
+    | BuildDef l -> Format.fprintf fmt "(BuildDef %a)" pp_form l
+    | BuildDef2 l -> Format.fprintf fmt "(BuildDef2 %a)" pp_form l
+    | BuildProj (l,i) -> Format.fprintf fmt "(BuildProj %a %i)" pp_form l i
+    | ImmBuildProj (c,i) ->Format.fprintf fmt "(ImmBuildProj %i %i)" c.id i
+    | ImmBuildDef c -> Format.fprintf fmt "(ImmBuildDef %i)" c.id
+    | ImmBuildDef2 c -> Format.fprintf fmt "(ImmBuildDef %i)" c.id
+    | _ -> assert false
+    end
+  | Same c -> Format.fprintf fmt "(Same %i)" c.id
+
+let rec pp_trace fmt c = 
+  Format.fprintf fmt "%i = %a %a" c.id pp_kind c pp_value c;
+  if c.next <> None then pp_trace fmt (next c)
+
+
+(******************************************************************************)
+(** Given a cnf (dimacs) files and a resolve_trace build                      *)
+(*  the corresponding object                                                  *) 
+(******************************************************************************)
+
+
+let import_cnf filename = 
+  let nvars, first, last = CnfParser.parse_cnf filename in
+  let reloc = Hashtbl.create 17 in
+  let count = ref 0 in
+  let r = ref first in
+  while !r.next <> None do
+    if not (is_trivial (get_val !r)) then begin
+      Hashtbl.add reloc !count !r;
+      incr count
+    end;
+    r := next !r
+  done;
+  if not (is_trivial (get_val !r)) then Hashtbl.add reloc !count !r;
+  nvars,first,last,reloc
+
+let import_cnf_trace reloc filename first last =
+  (* Format.fprintf Format.err_formatter "init@."; *)
+  (* pp_trace Format.err_formatter first; *)
+  let confl = ZchaffParser.parse_proof reloc filename last in
+  (* Format.fprintf Format.err_formatter "zchaff@."; *)
+  (* pp_trace Format.err_formatter first; *)
+  SmtTrace.select confl;
+  (* Format.fprintf Format.err_formatter "select@."; *)
+  (* pp_trace Format.err_formatter first; *)
+  Trace.share_prefix first (2 * last.id);
+  (* Format.fprintf Format.err_formatter "share_prefix@."; *)
+  (* pp_trace Format.err_formatter first; *)
+  occur confl;
+  let res = alloc first, confl in
+  res
+
+let make_roots first last =
+  let cint = Lazy.force cint in
+  let roots = Array.make (last.id + 2) (Term.mkArray (cint, Array.make 1 (mkInt 0))) in
+  let mk_elem l = 
+    let x = match Form.pform l with
+    | Fatom x -> x + 2
+    | _ -> assert false  in
+    mkInt (if Form.is_pos l then x lsl 1 else (x lsl 1) lxor 1) in
+  let r = ref first in
+  while !r.id < last.id do
+    let root = Array.of_list (get_val !r) in
+    let croot = Array.make (Array.length root + 1) (mkInt 0) in
+    Array.iteri (fun i l -> croot.(i) <- mk_elem l) root;
+    roots.(!r.id) <- Term.mkArray (cint, croot);
+    r := next !r 
+  done;
+  let root = Array.of_list (get_val !r) in
+  let croot = Array.make (Array.length root + 1) (mkInt 0) in
+  Array.iteri (fun i l -> croot.(i) <- mk_elem l) root;
+  roots.(!r.id) <- Term.mkArray (cint, croot);
+
+  Term.mkArray (mklApp carray [|cint|], roots)
+
+let interp_roots first last =
+  let tbl = Hashtbl.create 17 in
+  let mk_elem l = 
+    let x = match Form.pform l with
+    | Fatom x -> x
+    | _ -> assert false in
+    let ph = x lsl 1 in
+    let h = if Form.is_pos l then ph else ph lxor 1 in
+    try Hashtbl.find tbl h 
+    with Not_found ->
+      let p = Term.mkApp (Term.mkRel 1, [|mkInt (x+1)|]) in
+      let np = mklApp cnegb [|p|] in
+      Hashtbl.add tbl ph p;
+      Hashtbl.add tbl (ph lxor 1) np;
+      if Form.is_pos l then p else np in
+  let interp_root c =
+    match get_val c with
+    | [] -> Lazy.force cfalse
+    | l :: cl -> 
+	List.fold_left (fun acc l -> mklApp corb [|acc; mk_elem l|]) 
+	  (mk_elem l) cl in
+  let res = ref (interp_root first) in
+  if first.id <> last.id then begin
+    let r = ref (next first) in
+    while !r.id <= last.id do
+      res := mklApp candb [|!res;interp_root !r|];
+      r := next !r
+    done;
+  end;
+  !res
+
+let sat_checker_modules = [ ["SMTCoq";"Trace";"Sat_Checker"] ]
+
+let certif_ops = CoqTerms.make_certif_ops sat_checker_modules 
+let cCertif = gen_constant sat_checker_modules "Certif" 
+
+let parse_certif dimacs trace fdimacs ftrace =
+  SmtTrace.clear ();
+  let _,first,last,reloc = import_cnf fdimacs in
+  let d = make_roots first last in
+  let ce1 =
+    { const_entry_body = d;
+      const_entry_type = None;
+      const_entry_secctx = None;
+      const_entry_opaque = false;
+      const_entry_inline_code = false} in
+  let _ = declare_constant dimacs (DefinitionEntry ce1, IsDefinition Definition) in
+
+  let max_id, confl = import_cnf_trace reloc ftrace first last in
+  let (tres,_) = SmtTrace.to_coq (fun _ -> assert false) certif_ops confl in
+  let certif = 
+   mklApp cCertif [|mkInt (max_id + 1); tres;mkInt (get_pos confl)|] in 
+  let ce2 =
+    { const_entry_body = certif;
+      const_entry_type = None;
+      const_entry_secctx = None;
+      const_entry_opaque = false;
+      const_entry_inline_code = false} in
+  let _ = declare_constant trace (DefinitionEntry ce2, IsDefinition Definition) in
+  ()
+
+let cdimacs = gen_constant sat_checker_modules "dimacs"
+let ccertif = gen_constant sat_checker_modules "certif"
+let ctheorem_checker = gen_constant sat_checker_modules "theorem_checker"
+let cchecker = gen_constant sat_checker_modules "checker"
+
+let theorem name fdimacs ftrace =   
+  SmtTrace.clear ();
+  let _,first,last,reloc = import_cnf fdimacs in
+  let d = make_roots first last in
+
+  let max_id, confl = import_cnf_trace reloc ftrace first last in
+  let (tres,_) =
+    SmtTrace.to_coq (fun _ -> assert false) certif_ops confl in
+  let certif =
+   mklApp cCertif [|mkInt (max_id + 1);tres;mkInt (get_pos confl)|] in 
+
+  let theorem_concl = mklApp cnot [|mklApp cis_true [|interp_roots first last|] |] in
+  let vtype = Term.mkProd(Names.Anonymous, Lazy.force cint, Lazy.force cbool) in
+  let theorem_type = 
+    Term.mkProd (mkName "v", vtype, theorem_concl) in
+  let theorem_proof =
+   Term.mkLetIn (mkName "d", d, Lazy.force cdimacs,
+   Term.mkLetIn (mkName "c", certif, Lazy.force ccertif,
+   Term.mkLambda (mkName "v", vtype,
+   mklApp ctheorem_checker
+               [| Term.mkRel 3(*d*); Term.mkRel 2(*c*);
+		  vm_cast_true 
+		    (mklApp cchecker [|Term.mkRel 3(*d*); Term.mkRel 2(*c*)|]);
+                  Term.mkRel 1(*v*)|]))) in
+  let ce =
+    { const_entry_body = theorem_proof;
+      const_entry_type = Some theorem_type;
+      const_entry_secctx = None;
+      const_entry_opaque = true;
+      const_entry_inline_code = false} in
+  let _ = declare_constant name (DefinitionEntry ce, IsDefinition Definition) in
+  ()
+
+
+let checker fdimacs ftrace =
+  SmtTrace.clear ();
+  let _,first,last,reloc = import_cnf fdimacs in
+  let d = make_roots first last in
+
+  let max_id, confl = import_cnf_trace reloc ftrace first last in
+  let (tres,_) =
+    SmtTrace.to_coq (fun _ -> assert false) certif_ops confl in
+  let certif =
+    mklApp cCertif [|mkInt (max_id + 1);tres;mkInt (get_pos confl)|] in
+
+  let tm = mklApp cchecker [|d; certif|] in
+  let expr = Constrextern.extern_constr true Environ.empty_env tm in
+  Vernacentries.interp (Vernacexpr.VernacCheckMayEval (Some (Glob_term.CbvVm None), None, expr))
+
+
+
+
+  
+(******************************************************************************)
+(** Given a Coq formula build the proof                                       *)
+(******************************************************************************)
+
+let export_clause fmt cl =
+  List.iter 
+    (fun l -> Format.fprintf fmt "%s%i " 
+	(if Form.is_pos l then "" else "-") (Form.index l + 1)) cl;
+  Format.fprintf fmt "0@\n"
+
+let export out_channel nvars first =
+  let fmt = Format.formatter_of_out_channel out_channel in 
+  let reloc = Hashtbl.create 17 in
+  let count = ref 0 in
+  (* count the number of non trivial clause *)
+  let r = ref first in
+  let add_count c = 
+    match c.value with
+    | Some cl -> if not (is_trivial cl) then incr count
+    | _ -> () in
+  while !r.next <> None do add_count !r; r := next !r done;
+  add_count !r;
+  Format.fprintf fmt "p cnf %i %i@." nvars !count;
+  count := 0; r := first; 
+  (* ouput clause *)
+  let out c = 
+    match c.value with
+    | Some cl -> 
+	if not (is_trivial cl) then begin
+	  Hashtbl.add reloc !count c;
+	  incr count;
+	  export_clause fmt cl
+	end
+    | None -> assert false in
+  while !r.next <> None do out !r; r := next !r done;
+  out !r;
+  Format.fprintf fmt "@.";
+  reloc, !r
+
+
+(* Call zchaff *)
+
+let call_zchaff nvars root =
+  let (filename, outchan) = Filename.open_temp_file "zchaff_coq" ".cnf" in
+  let resfilename = (Filename.chop_extension filename)^".zlog" in
+  let reloc, last = export outchan nvars root in
+  close_out outchan;
+  let command = "zchaff "^filename^" > "^resfilename in
+  Format.eprintf "%s@." command;
+  let t0 = Sys.time () in
+  let exit_code = Sys.command command in
+  let t1 = Sys.time () in
+  Format.eprintf "Zchaff = %.5f@." (t1-.t0);  
+  if exit_code <> 0 then 
+    failwith ("Zchaff.call_zchaff: command "^command^
+	      " exited with code "^(string_of_int exit_code));
+  let logfilename = (Filename.chop_extension filename)^".log" in
+  let command2 = "mv resolve_trace "^logfilename in
+  let exit_code2 = Sys.command command2 in
+  if exit_code2 <> 0 then 
+      failwith ("Zchaff.call_zchaff: command "^command2^
+                " exited with code "^(string_of_int exit_code2));
+  (* import_cnf_trace reloc logfilename root last  *)
+  (reloc, resfilename, logfilename, last)
+
+
+(* Build the problem that it may be understoof by zchaff *)
+
+let cnf_checker_modules = [ ["SMTCoq";"Trace";"Cnf_Checker"] ]
+
+let certif_ops = CoqTerms.make_certif_ops cnf_checker_modules 
+let ccertif = gen_constant cnf_checker_modules "certif" 
+let cCertif = gen_constant cnf_checker_modules "Certif" 
+let cchecker_b_correct = 
+  gen_constant cnf_checker_modules "checker_b_correct" 
+let cchecker_b = gen_constant cnf_checker_modules "checker_b" 
+let cchecker_eq_correct = 
+  gen_constant cnf_checker_modules "checker_eq_correct" 
+let cchecker_eq = gen_constant cnf_checker_modules "checker_eq" 
+
+let build_body reify_atom reify_form l b (max_id, confl) = 
+  let ntvar = mkName "t_var" in
+  let ntform = mkName "t_form" in
+  let nc = mkName "c" in
+  let tvar = Atom.interp_tbl reify_atom in
+  let _, tform = Form.interp_tbl reify_form in
+  let (tres,_) =
+    SmtTrace.to_coq Form.to_coq certif_ops confl in
+  let certif =
+    mklApp cCertif [|mkInt (max_id + 1);tres;mkInt (get_pos confl)|] in
+  let vtvar = Term.mkRel 3 in
+  let vtform = Term.mkRel 2 in
+  let vc = Term.mkRel 1 in
+  Term.mkLetIn (ntvar, tvar, mklApp carray [|Lazy.force cbool|],
+  Term.mkLetIn (ntform, tform, mklApp carray [|Lazy.force cform|],
+  Term.mkLetIn (nc, certif, Lazy.force ccertif, 
+  mklApp cchecker_b_correct 
+	 [|vtvar; vtform; l; b; vc; 
+	   vm_cast_true (mklApp cchecker_b [|vtform;l;b;vc|])|])))
+
+
+let build_body_eq reify_atom reify_form l1 l2 l (max_id, confl) =
+  let ntvar = mkName "t_var" in
+  let ntform = mkName "t_form" in
+  let nc = mkName "c" in
+  let tvar = Atom.interp_tbl reify_atom in
+  let _, tform = Form.interp_tbl reify_form in
+  let (tres,_) =
+    SmtTrace.to_coq Form.to_coq certif_ops confl in
+  let certif =
+    mklApp cCertif [|mkInt (max_id + 1);tres;mkInt (get_pos confl)|] in 
+  let vtvar = Term.mkRel 3 in
+  let vtform = Term.mkRel 2 in
+  let vc = Term.mkRel 1 in
+  Term.mkLetIn (ntvar, tvar, mklApp carray [|Lazy.force cbool|],
+  Term.mkLetIn (ntform, tform, mklApp carray [|Lazy.force cform|],
+  Term.mkLetIn (nc, certif, Lazy.force ccertif, 
+  mklApp cchecker_eq_correct 
+         [|vtvar; vtform; l1; l2; l; vc;
+	   vm_cast_true (mklApp cchecker_eq [|vtform;l1;l2;l;vc|])|])))
+
+let get_arguments concl = 
+  let f, args = Term.decompose_app concl in
+  match args with
+  | [ty;a;b] when f = Lazy.force ceq && ty = Lazy.force cbool -> a, b
+  | [a] when f = Lazy.force cis_true -> a, Lazy.force ctrue
+  | _ -> failwith ("Zchaff.tactic :can only deal with equality over bool")
+
+
+(* Check that the result is Unsat, otherwise raise a model *)
+
+exception Sat of int list
+exception Finished
+
+let input_int file =
+  let rec input_int acc flag =
+    let c = input_char file in
+    if c = '-' then
+      input_int acc true
+    else if c = '0' then
+      input_int (10*acc) flag
+    else if c = '1' then
+      input_int (10*acc+1) flag
+    else if c = '2' then
+      input_int (10*acc+2) flag
+    else if c = '3' then
+      input_int (10*acc+3) flag
+    else if c = '4' then
+      input_int (10*acc+4) flag
+    else if c = '5' then
+      input_int (10*acc+5) flag
+    else if c = '6' then
+      input_int (10*acc+6) flag
+    else if c = '7' then
+      input_int (10*acc+7) flag
+    else if c = '8' then
+      input_int (10*acc+8) flag
+    else if c = '9' then
+      input_int (10*acc+9) flag
+    else if c = ' ' then
+      if flag then -acc else acc
+    else raise Finished in
+  input_int 0 false
+
+let check_unsat filename =
+  let f = open_in filename in
+  let rec get_model acc =
+    try
+      let i = input_int f in
+      get_model (i::acc)
+    with
+      | Finished -> acc in
+  try
+    while true do
+      let l = input_line f in
+      let n = String.length l in
+      if n >= 8 && String.sub l 0 8 = "Instance" then
+        if n >= 20 && String.sub l 9 11 = "Satisfiable" then
+          raise (Sat (get_model []))
+        else
+          raise End_of_file
+    done
+  with
+    | End_of_file -> close_in f
+
+
+(* Pre-process the proof given by zchaff *)
+
+let make_proof pform_tbl atom_tbl env reify_form l =
+  let fl = Form.flatten reify_form l in
+  let root = SmtTrace.mkRootV [l] in
+  let _ = 
+    if Form.equal l fl then Cnf.make_cnf reify_form root 
+    else
+      let first_c = SmtTrace.mkOther (ImmFlatten(root,fl)) (Some [fl]) in
+      SmtTrace.link root first_c;
+      Cnf.make_cnf reify_form first_c in
+  let (reloc, resfilename, logfilename, last) =
+    call_zchaff (Form.nvars reify_form) root in
+  (try check_unsat resfilename with
+    | Sat model -> Errors.error (List.fold_left (fun acc i ->
+      let index = if i > 0 then i-1 else -i-1 in
+      let ispos = i > 0 in
+      try (
+        let f = pform_tbl.(index) in
+        match f with
+          | Fatom a ->
+            let t = atom_tbl.(a) in
+            let value = if ispos then " = true" else " = false" in
+            acc^"  "^(Pp.string_of_ppcmds (Printer.pr_constr_env env t))^value
+          | Fapp _ -> acc
+      ) with | Invalid_argument _ -> acc (* Because cnf computation does not put the new formulas in the table... Perhaps it should? *)
+    ) "zchaff found a counterexample:\n" model)
+  );
+  import_cnf_trace reloc logfilename root last
+
+
+(* The whole tactic *)
+
+let tactic gl =
+  SmtTrace.clear ();
+
+  let env = Tacmach.pf_env gl in
+  (* let sigma = Tacmach.project gl in *)
+  let t = Tacmach.pf_concl gl in
+
+  let (forall_let, concl) = Term.decompose_prod_assum t in
+  let a, b = get_arguments concl in
+  let reify_atom = Atom.create () in
+  let reify_form = Form.create () in
+  let body = 
+    if (b = Lazy.force ctrue || b = Lazy.force cfalse) then
+      let l = Form.of_coq (Atom.get reify_atom) reify_form a in
+      let l' = if b = Lazy.force ctrue then Form.neg l else l in
+      let atom_tbl = Atom.atom_tbl reify_atom in
+      let pform_tbl = Form.pform_tbl reify_form in
+      let max_id_confl = make_proof pform_tbl atom_tbl (Environ.push_rel_context forall_let env) reify_form l' in
+      build_body reify_atom reify_form (Form.to_coq l) b max_id_confl 
+    else
+      let l1 = Form.of_coq (Atom.get reify_atom) reify_form a in
+      let l2 = Form.of_coq (Atom.get reify_atom) reify_form b in
+      let l = Form.neg (Form.get reify_form (Fapp(Fiff,[|l1;l2|]))) in
+      let atom_tbl = Atom.atom_tbl reify_atom in
+      let pform_tbl = Form.pform_tbl reify_form in
+      let max_id_confl = make_proof pform_tbl atom_tbl (Environ.push_rel_context forall_let env) reify_form l in
+      build_body_eq reify_atom reify_form 
+	(Form.to_coq l1) (Form.to_coq l2) (Form.to_coq l) max_id_confl in
+  let compose_lam_assum forall_let body =
+    List.fold_left (fun t rd -> Term.mkLambda_or_LetIn rd t) body forall_let in
+  let res = compose_lam_assum forall_let body in
+  Tactics.exact_no_check res gl
diff --git a/src/zchaff/zchaffParser.ml b/src/zchaff/zchaffParser.ml
new file mode 100644
index 0000000..c5bcb09
--- /dev/null
+++ b/src/zchaff/zchaffParser.ml
@@ -0,0 +1,161 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     SMTCoq                                                             *)
+(*     Copyright (C) 2011 - 2015                                          *)
+(*                                                                        *)
+(*     Michaël Armand                                                     *)
+(*     Benjamin Grégoire                                                  *)
+(*     Chantal Keller                                                     *)
+(*                                                                        *)
+(*     Inria - École Polytechnique - MSR-Inria Joint Lab                  *)
+(*                                                                        *)
+(*   This file is distributed under the terms of the CeCILL-C licence     *)
+(*                                                                        *)
+(**************************************************************************)
+open SatParser
+open SmtForm
+open SmtCertif
+open SmtTrace
+
+let _CL = "CL:"
+let _INF = "<="
+let _VAR = "VAR:"
+let _L = "L:"
+let _V = "V:"
+let _A = "A:"
+let _LITS = "Lits:"
+let _CONF = "CONF:"
+let _EQ = "=="
+
+(** Parsing of zchaff proof *)
+
+let alloc_res last c1 c2 tail =
+  let c = mkRes c1 c2 tail in
+  link last c;
+  c
+
+let rec parse_tailres reloc lb =
+  if is_start_int lb then
+    let cl_id = Hashtbl.find reloc (input_int lb) in
+    cl_id :: parse_tailres reloc lb
+  else []
+
+let parse_resolution reloc lb last =
+  let id = input_blank_int lb in
+  blank_match_string lb _INF;
+  let c1 = Hashtbl.find reloc (input_blank_int lb) in
+  let c2 =  Hashtbl.find reloc (input_blank_int lb) in
+  let tl = parse_tailres reloc lb in
+  let c = alloc_res last c1 c2 tl in
+  Hashtbl.add reloc id c;
+  c
+
+let parse_CL reloc lb last =
+  let last = ref last in
+  while blank_check_string lb _CL do
+    last := parse_resolution reloc lb !last 
+  done;
+  !last
+
+
+(* Parsing of the VAR and CONF part *)
+
+let var_of_lit l = l lsr 1
+
+type var_key =
+  | Var of int
+  | Level of int
+
+type 'hform var_decl = {
+          var      : int;
+          ante     : 'hform clause;
+          ante_val : int list;
+  mutable vclause  : 'hform clause option
+}
+
+type 'hform parse_var_info = (var_key, 'hform var_decl) Hashtbl.t
+
+let var_of_lit l = l lsr 1
+
+let parse_zclause lb =
+  let zc = ref [var_of_lit (input_blank_int lb)] in
+  while is_start_int lb do
+    zc := var_of_lit (input_int lb) :: !zc;
+  done;
+  !zc
+
+let parse_VAR_CONF reloc lb last =
+  let max_level = ref (-1) in
+  let vartbl = Hashtbl.create 100 in
+  (* parsing of the VAR part *)
+  while blank_check_string lb _VAR do
+    let x = input_blank_int lb in
+    blank_match_string lb _L;
+    let lv = input_blank_int lb in
+    blank_match_string lb _V;
+    let _ = input_blank_int lb in
+    blank_match_string lb _A;
+    let ante = Hashtbl.find reloc (input_blank_int lb) in
+    blank_match_string lb _LITS;
+    let ante_val = parse_zclause lb in
+    max_level := max !max_level lv;
+    let vd = { var = x; ante = ante; ante_val = ante_val; vclause = None } in
+    Hashtbl.add vartbl (Var x) vd;
+    Hashtbl.add vartbl (Level lv) vd;
+  done;
+  (* Adding the resolution *)
+  let rec build_res0 l =
+    match l with
+    | [] -> []
+    | y :: l ->
+      let yd =
+	try Hashtbl.find vartbl (Var y)
+        with Not_found ->
+	  Printf.printf "Var %i not found.\n" y;raise Not_found in
+      match yd.vclause with
+      | Some cy -> cy :: build_res0 l
+      | _ -> assert false in
+  let rec build_res1 x l =
+    match l with
+    | [] -> assert false
+    | y :: l ->
+      if x = y then build_res0 l
+      else
+	let yd =
+	  try Hashtbl.find vartbl (Var y)
+	  with Not_found ->
+	    Printf.printf "Var %i not found.\n" y;raise Not_found in
+	match yd.vclause with
+	| Some cy -> cy :: build_res1 x l
+	| _ -> assert false in
+  let last = ref last in
+  for lv = 0 to !max_level do
+    try
+      let vd = Hashtbl.find vartbl (Level lv) in
+      let c =
+	match build_res1 vd.var vd.ante_val with
+	| [] -> vd.ante
+	| c2::tl -> 
+	    last := alloc_res !last vd.ante c2 tl; !last in
+      vd.vclause <- Some c;
+    with Not_found -> ()
+  done;
+  (* parsing of the CONF *)
+  blank_match_string lb _CONF;
+  let conf = 
+    let id = input_blank_int lb in
+    Hashtbl.find reloc id in
+  blank_match_string lb _EQ;
+  let conf_val = parse_zclause lb in
+  match build_res0 conf_val with
+  | [] -> assert false
+  | c2::tl -> alloc_res !last conf c2 tl
+
+
+let parse_proof reloc filename last =
+  let lb = open_file "Proof" filename in
+  let last = parse_CL reloc lb last in
+  let last = parse_VAR_CONF reloc lb last in
+  close lb;
+  last
+