Imported Upstream version 8.0pl1upstream/8.0pl1

31 files changed, 11697 insertions, 0 deletions

diff --git a/contrib/interface/COPYRIGHT b/contrib/interface/COPYRIGHT
new file mode 100644
index 00000000..2fb11c6b
--- /dev/null
+++ b/contrib/interface/COPYRIGHT
@@ -0,0 +1,19 @@
+(*****************************************************************************)
+(*                                                                           *)
+(*            Coq support for the Pcoq Graphical Interface of Coq            *)
+(*                                                                           *)
+(*        Copyright (C) 1999-2004 INRIA Sophia-Antipolis (Lemme team)        *)
+(*                                                                           *)
+(*****************************************************************************)
+
+The current directory contrib/interface implements Coq support for the
+Pcoq Graphical Interface of Coq. It has been developed by Yves Bertot
+with contributions from Loïc Pottier and Laurence Rideau.
+
+The Pcoq Graphical Interface (see http://www-sop.inria.fr/lemme/pcoq)
+is developed by the Lemme team at INRIA Sophia-Antipolis (see
+http://www-sop.inria.fr/lemme)
+
+The files of the current directory are distributed under the terms of
+the GNU Lesser General Public License Version 2.1.
+
diff --git a/contrib/interface/ascent.mli b/contrib/interface/ascent.mli
new file mode 100644
index 00000000..61d0d5a3
--- /dev/null
+++ b/contrib/interface/ascent.mli
@@ -0,0 +1,784 @@
+type ct_AST =
+    CT_coerce_ID_OR_INT_to_AST of ct_ID_OR_INT
+  | CT_coerce_ID_OR_STRING_to_AST of ct_ID_OR_STRING
+  | CT_coerce_SINGLE_OPTION_VALUE_to_AST of ct_SINGLE_OPTION_VALUE
+  | CT_astnode of ct_ID * ct_AST_LIST
+  | CT_astpath of ct_ID_LIST
+  | CT_astslam of ct_ID_OPT * ct_AST
+and ct_AST_LIST =
+    CT_ast_list of ct_AST list
+and ct_BINARY =
+    CT_binary of int
+and ct_BINDER =
+    CT_coerce_DEF_to_BINDER of ct_DEF
+  | CT_binder of ct_ID_OPT_NE_LIST * ct_FORMULA
+  | CT_binder_coercion of ct_ID_OPT_NE_LIST * ct_FORMULA
+and ct_BINDER_LIST =
+    CT_binder_list of ct_BINDER list
+and ct_BINDER_NE_LIST =
+    CT_binder_ne_list of ct_BINDER * ct_BINDER list
+and ct_BINDING =
+    CT_binding of ct_ID_OR_INT * ct_FORMULA
+and ct_BINDING_LIST =
+    CT_binding_list of ct_BINDING list
+and ct_BOOL =
+    CT_false
+  | CT_true
+and ct_CASE =
+    CT_case of string
+and ct_CLAUSE =
+    CT_clause of ct_HYP_LOCATION_LIST_OR_STAR * ct_STAR_OPT
+and ct_COERCION_OPT =
+    CT_coerce_NONE_to_COERCION_OPT of ct_NONE
+  | CT_coercion_atm
+and ct_COFIXTAC =
+    CT_cofixtac of ct_ID * ct_FORMULA
+and ct_COFIX_REC =
+    CT_cofix_rec of ct_ID * ct_BINDER_LIST * ct_FORMULA * ct_FORMULA
+and ct_COFIX_REC_LIST =
+    CT_cofix_rec_list of ct_COFIX_REC * ct_COFIX_REC list
+and ct_COFIX_TAC_LIST =
+    CT_cofix_tac_list of ct_COFIXTAC list
+and ct_COMMAND =
+    CT_coerce_COMMAND_LIST_to_COMMAND of ct_COMMAND_LIST
+  | CT_coerce_EVAL_CMD_to_COMMAND of ct_EVAL_CMD
+  | CT_coerce_SECTION_BEGIN_to_COMMAND of ct_SECTION_BEGIN
+  | CT_coerce_THEOREM_GOAL_to_COMMAND of ct_THEOREM_GOAL
+  | CT_abort of ct_ID_OPT_OR_ALL
+  | CT_abstraction of ct_ID * ct_FORMULA * ct_INT_LIST
+  | CT_add_field of ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_BINDING_LIST
+  | CT_add_natural_feature of ct_NATURAL_FEATURE * ct_ID
+  | CT_addpath of ct_STRING * ct_ID_OPT
+  | CT_arguments_scope of ct_ID * ct_ID_OPT_LIST
+  | CT_bind_scope of ct_ID * ct_ID_NE_LIST
+  | CT_cd of ct_STRING_OPT
+  | CT_check of ct_FORMULA
+  | CT_class of ct_ID
+  | CT_close_scope of ct_ID
+  | CT_coercion of ct_LOCAL_OPT * ct_IDENTITY_OPT * ct_ID * ct_ID * ct_ID
+  | CT_cofix_decl of ct_COFIX_REC_LIST
+  | CT_compile_module of ct_VERBOSE_OPT * ct_ID * ct_STRING_OPT
+  | CT_declare_module of ct_ID * ct_MODULE_BINDER_LIST * ct_MODULE_TYPE_CHECK * ct_MODULE_EXPR
+  | CT_define_notation of ct_STRING * ct_FORMULA * ct_MODIFIER_LIST * ct_ID_OPT
+  | CT_definition of ct_DEFN * ct_ID * ct_BINDER_LIST * ct_DEF_BODY * ct_FORMULA_OPT
+  | CT_delim_scope of ct_ID * ct_ID
+  | CT_delpath of ct_STRING
+  | CT_derive_depinversion of ct_INV_TYPE * ct_ID * ct_FORMULA * ct_SORT_TYPE
+  | CT_derive_inversion of ct_INV_TYPE * ct_INT_OPT * ct_ID * ct_ID
+  | CT_derive_inversion_with of ct_INV_TYPE * ct_ID * ct_FORMULA * ct_SORT_TYPE
+  | CT_explain_proof of ct_INT_LIST
+  | CT_explain_prooftree of ct_INT_LIST
+  | CT_export_id of ct_ID_NE_LIST
+  | CT_extract_to_file of ct_STRING * ct_ID_NE_LIST
+  | CT_extraction of ct_ID_OPT
+  | CT_fix_decl of ct_FIX_REC_LIST
+  | CT_focus of ct_INT_OPT
+  | CT_go of ct_INT_OR_LOCN
+  | CT_guarded
+  | CT_hint_destruct of ct_ID * ct_INT * ct_DESTRUCT_LOCATION * ct_FORMULA * ct_TACTIC_COM * ct_ID_LIST
+  | CT_hint_extern of ct_INT * ct_FORMULA * ct_TACTIC_COM * ct_ID_LIST
+  | CT_hintrewrite of ct_ORIENTATION * ct_FORMULA_NE_LIST * ct_ID * ct_TACTIC_COM
+  | CT_hints of ct_ID * ct_ID_NE_LIST * ct_ID_LIST
+  | CT_hints_immediate of ct_FORMULA_NE_LIST * ct_ID_LIST
+  | CT_hints_resolve of ct_FORMULA_NE_LIST * ct_ID_LIST
+  | CT_hyp_search_pattern of ct_FORMULA * ct_IN_OR_OUT_MODULES
+  | CT_implicits of ct_ID * ct_ID_LIST_OPT
+  | CT_import_id of ct_ID_NE_LIST
+  | CT_ind_scheme of ct_SCHEME_SPEC_LIST
+  | CT_infix of ct_STRING * ct_ID * ct_MODIFIER_LIST * ct_ID_OPT
+  | CT_inline of ct_ID_NE_LIST
+  | CT_inspect of ct_INT
+  | CT_kill_node of ct_INT
+  | CT_load of ct_VERBOSE_OPT * ct_ID_OR_STRING
+  | CT_local_close_scope of ct_ID
+  | CT_local_define_notation of ct_STRING * ct_FORMULA * ct_MODIFIER_LIST * ct_ID_OPT
+  | CT_local_hint_destruct of ct_ID * ct_INT * ct_DESTRUCT_LOCATION * ct_FORMULA * ct_TACTIC_COM * ct_ID_LIST
+  | CT_local_hint_extern of ct_INT * ct_FORMULA * ct_TACTIC_COM * ct_ID_LIST
+  | CT_local_hints of ct_ID * ct_ID_NE_LIST * ct_ID_LIST
+  | CT_local_hints_immediate of ct_FORMULA_NE_LIST * ct_ID_LIST
+  | CT_local_hints_resolve of ct_FORMULA_NE_LIST * ct_ID_LIST
+  | CT_local_infix of ct_STRING * ct_ID * ct_MODIFIER_LIST * ct_ID_OPT
+  | CT_local_open_scope of ct_ID
+  | CT_local_reserve_notation of ct_STRING * ct_MODIFIER_LIST
+  | CT_locate of ct_ID
+  | CT_locate_file of ct_STRING
+  | CT_locate_lib of ct_ID
+  | CT_locate_notation of ct_STRING
+  | CT_mind_decl of ct_CO_IND * ct_IND_SPEC_LIST
+  | CT_ml_add_path of ct_STRING
+  | CT_ml_declare_modules of ct_STRING_NE_LIST
+  | CT_ml_print_modules
+  | CT_ml_print_path
+  | CT_module of ct_ID * ct_MODULE_BINDER_LIST * ct_MODULE_TYPE_CHECK * ct_MODULE_EXPR
+  | CT_module_type_decl of ct_ID * ct_MODULE_BINDER_LIST * ct_MODULE_TYPE_OPT
+  | CT_no_inline of ct_ID_NE_LIST
+  | CT_omega_flag of ct_OMEGA_MODE * ct_OMEGA_FEATURE
+  | CT_opaque of ct_ID_NE_LIST
+  | CT_open_scope of ct_ID
+  | CT_print
+  | CT_print_about of ct_ID
+  | CT_print_all
+  | CT_print_classes
+  | CT_print_coercions
+  | CT_print_grammar of ct_GRAMMAR
+  | CT_print_graph
+  | CT_print_hint of ct_ID_OPT
+  | CT_print_hintdb of ct_ID_OR_STAR
+  | CT_print_id of ct_ID
+  | CT_print_implicit of ct_ID
+  | CT_print_loadpath
+  | CT_print_module of ct_ID
+  | CT_print_module_type of ct_ID
+  | CT_print_modules
+  | CT_print_natural of ct_ID
+  | CT_print_natural_feature of ct_NATURAL_FEATURE
+  | CT_print_opaqueid of ct_ID
+  | CT_print_path of ct_ID * ct_ID
+  | CT_print_proof of ct_ID
+  | CT_print_scope of ct_ID
+  | CT_print_scopes
+  | CT_print_section of ct_ID
+  | CT_print_states
+  | CT_print_tables
+  | CT_print_universes of ct_STRING_OPT
+  | CT_print_visibility of ct_ID_OPT
+  | CT_proof of ct_FORMULA
+  | CT_proof_no_op
+  | CT_proof_with of ct_TACTIC_COM
+  | CT_pwd
+  | CT_quit
+  | CT_read_module of ct_ID
+  | CT_rec_ml_add_path of ct_STRING
+  | CT_recaddpath of ct_STRING * ct_ID_OPT
+  | CT_record of ct_COERCION_OPT * ct_ID * ct_BINDER_LIST * ct_FORMULA * ct_ID_OPT * ct_RECCONSTR_LIST
+  | CT_remove_natural_feature of ct_NATURAL_FEATURE * ct_ID
+  | CT_require of ct_IMPEXP * ct_SPEC_OPT * ct_ID_NE_LIST_OR_STRING
+  | CT_reserve of ct_ID_NE_LIST * ct_FORMULA
+  | CT_reserve_notation of ct_STRING * ct_MODIFIER_LIST
+  | CT_reset of ct_ID
+  | CT_reset_section of ct_ID
+  | CT_restart
+  | CT_restore_state of ct_ID
+  | CT_resume of ct_ID_OPT
+  | CT_save of ct_THM_OPT * ct_ID_OPT
+  | CT_scomments of ct_SCOMMENT_CONTENT_LIST
+  | CT_search of ct_ID * ct_IN_OR_OUT_MODULES
+  | CT_search_about of ct_ID_OR_STRING_NE_LIST * ct_IN_OR_OUT_MODULES
+  | CT_search_pattern of ct_FORMULA * ct_IN_OR_OUT_MODULES
+  | CT_search_rewrite of ct_FORMULA * ct_IN_OR_OUT_MODULES
+  | CT_section_end of ct_ID
+  | CT_section_struct of ct_SECTION_BEGIN * ct_SECTION_BODY * ct_COMMAND
+  | CT_set_natural of ct_ID
+  | CT_set_natural_default
+  | CT_set_option of ct_TABLE
+  | CT_set_option_value of ct_TABLE * ct_SINGLE_OPTION_VALUE
+  | CT_set_option_value2 of ct_TABLE * ct_ID_OR_STRING_NE_LIST
+  | CT_sethyp of ct_INT
+  | CT_setundo of ct_INT
+  | CT_show_existentials
+  | CT_show_goal of ct_INT_OPT
+  | CT_show_implicit of ct_INT
+  | CT_show_intro
+  | CT_show_intros
+  | CT_show_node
+  | CT_show_proof
+  | CT_show_proofs
+  | CT_show_script
+  | CT_show_tree
+  | CT_solve of ct_INT * ct_TACTIC_COM * ct_DOTDOT_OPT
+  | CT_suspend
+  | CT_syntax_macro of ct_ID * ct_FORMULA * ct_INT_OPT
+  | CT_tactic_definition of ct_TAC_DEF_NE_LIST
+  | CT_test_natural_feature of ct_NATURAL_FEATURE * ct_ID
+  | CT_theorem_struct of ct_THEOREM_GOAL * ct_PROOF_SCRIPT
+  | CT_time of ct_COMMAND
+  | CT_transparent of ct_ID_NE_LIST
+  | CT_undo of ct_INT_OPT
+  | CT_unfocus
+  | CT_unset_option of ct_TABLE
+  | CT_unsethyp
+  | CT_unsetundo
+  | CT_user_vernac of ct_ID * ct_VARG_LIST
+  | CT_variable of ct_VAR * ct_BINDER_NE_LIST
+  | CT_write_module of ct_ID * ct_STRING_OPT
+and ct_COMMAND_LIST =
+    CT_command_list of ct_COMMAND * ct_COMMAND list
+and ct_COMMENT =
+    CT_comment of string
+and ct_COMMENT_S =
+    CT_comment_s of ct_COMMENT list
+and ct_CONSTR =
+    CT_constr of ct_ID * ct_FORMULA
+  | CT_constr_coercion of ct_ID * ct_FORMULA
+and ct_CONSTR_LIST =
+    CT_constr_list of ct_CONSTR list
+and ct_CONTEXT_HYP_LIST =
+    CT_context_hyp_list of ct_PREMISE_PATTERN list
+and ct_CONTEXT_PATTERN =
+    CT_coerce_FORMULA_to_CONTEXT_PATTERN of ct_FORMULA
+  | CT_context of ct_ID_OPT * ct_FORMULA
+and ct_CONTEXT_RULE =
+    CT_context_rule of ct_CONTEXT_HYP_LIST * ct_CONTEXT_PATTERN * ct_TACTIC_COM
+  | CT_def_context_rule of ct_TACTIC_COM
+and ct_CONVERSION_FLAG =
+    CT_beta
+  | CT_delta
+  | CT_evar
+  | CT_iota
+  | CT_zeta
+and ct_CONVERSION_FLAG_LIST =
+    CT_conversion_flag_list of ct_CONVERSION_FLAG list
+and ct_CONV_SET =
+    CT_unf of ct_ID list
+  | CT_unfbut of ct_ID list
+and ct_CO_IND =
+    CT_co_ind of string
+and ct_DECL_NOTATION_OPT =
+    CT_coerce_NONE_to_DECL_NOTATION_OPT of ct_NONE
+  | CT_decl_notation of ct_STRING * ct_FORMULA * ct_ID_OPT
+and ct_DEF =
+    CT_def of ct_ID_OPT * ct_FORMULA
+and ct_DEFN =
+    CT_defn of string
+and ct_DEFN_OR_THM =
+    CT_coerce_DEFN_to_DEFN_OR_THM of ct_DEFN
+  | CT_coerce_THM_to_DEFN_OR_THM of ct_THM
+and ct_DEF_BODY =
+    CT_coerce_CONTEXT_PATTERN_to_DEF_BODY of ct_CONTEXT_PATTERN
+  | CT_coerce_EVAL_CMD_to_DEF_BODY of ct_EVAL_CMD
+  | CT_type_of of ct_FORMULA
+and ct_DEF_BODY_OPT =
+    CT_coerce_DEF_BODY_to_DEF_BODY_OPT of ct_DEF_BODY
+  | CT_coerce_FORMULA_OPT_to_DEF_BODY_OPT of ct_FORMULA_OPT
+and ct_DEP =
+    CT_dep of string
+and ct_DESTRUCTING =
+    CT_coerce_NONE_to_DESTRUCTING of ct_NONE
+  | CT_destructing
+and ct_DESTRUCT_LOCATION =
+    CT_conclusion_location
+  | CT_discardable_hypothesis
+  | CT_hypothesis_location
+and ct_DOTDOT_OPT =
+    CT_coerce_NONE_to_DOTDOT_OPT of ct_NONE
+  | CT_dotdot
+and ct_EQN =
+    CT_eqn of ct_MATCH_PATTERN_NE_LIST * ct_FORMULA
+and ct_EQN_LIST =
+    CT_eqn_list of ct_EQN list
+and ct_EVAL_CMD =
+    CT_eval of ct_INT_OPT * ct_RED_COM * ct_FORMULA
+and ct_FIXTAC =
+    CT_fixtac of ct_ID * ct_INT * ct_FORMULA
+and ct_FIX_BINDER =
+    CT_coerce_FIX_REC_to_FIX_BINDER of ct_FIX_REC
+  | CT_fix_binder of ct_ID * ct_INT * ct_FORMULA * ct_FORMULA
+and ct_FIX_BINDER_LIST =
+    CT_fix_binder_list of ct_FIX_BINDER * ct_FIX_BINDER list
+and ct_FIX_REC =
+    CT_fix_rec of ct_ID * ct_BINDER_NE_LIST * ct_ID_OPT *
+      ct_FORMULA * ct_FORMULA
+and ct_FIX_REC_LIST =
+    CT_fix_rec_list of ct_FIX_REC * ct_FIX_REC list
+and ct_FIX_TAC_LIST =
+    CT_fix_tac_list of ct_FIXTAC list
+and ct_FORMULA =
+    CT_coerce_BINARY_to_FORMULA of ct_BINARY
+  | CT_coerce_ID_to_FORMULA of ct_ID
+  | CT_coerce_NUM_to_FORMULA of ct_NUM
+  | CT_coerce_SORT_TYPE_to_FORMULA of ct_SORT_TYPE
+  | CT_coerce_TYPED_FORMULA_to_FORMULA of ct_TYPED_FORMULA
+  | CT_appc of ct_FORMULA * ct_FORMULA_NE_LIST
+  | CT_arrowc of ct_FORMULA * ct_FORMULA
+  | CT_bang of ct_FORMULA
+  | CT_cases of ct_MATCHED_FORMULA_NE_LIST * ct_FORMULA_OPT * ct_EQN_LIST
+  | CT_cofixc of ct_ID * ct_COFIX_REC_LIST
+  | CT_elimc of ct_CASE * ct_FORMULA_OPT * ct_FORMULA * ct_FORMULA_LIST
+  | CT_existvarc
+  | CT_fixc of ct_ID * ct_FIX_BINDER_LIST
+  | CT_if of ct_FORMULA * ct_RETURN_INFO * ct_FORMULA * ct_FORMULA
+  | CT_inductive_let of ct_FORMULA_OPT * ct_ID_OPT_NE_LIST * ct_FORMULA * ct_FORMULA
+  | CT_labelled_arg of ct_ID * ct_FORMULA
+  | CT_lambdac of ct_BINDER_NE_LIST * ct_FORMULA
+  | CT_let_tuple of ct_ID_OPT_NE_LIST * ct_RETURN_INFO * ct_FORMULA * ct_FORMULA
+  | CT_letin of ct_DEF * ct_FORMULA
+  | CT_notation of ct_STRING * ct_FORMULA_LIST
+  | CT_num_encapsulator of ct_NUM_TYPE * ct_FORMULA
+  | CT_prodc of ct_BINDER_NE_LIST * ct_FORMULA
+  | CT_proj of ct_FORMULA * ct_FORMULA_NE_LIST
+and ct_FORMULA_LIST =
+    CT_formula_list of ct_FORMULA list
+and ct_FORMULA_NE_LIST =
+    CT_formula_ne_list of ct_FORMULA * ct_FORMULA list
+and ct_FORMULA_OPT =
+    CT_coerce_FORMULA_to_FORMULA_OPT of ct_FORMULA
+  | CT_coerce_ID_OPT_to_FORMULA_OPT of ct_ID_OPT
+and ct_FORMULA_OR_INT =
+    CT_coerce_FORMULA_to_FORMULA_OR_INT of ct_FORMULA
+  | CT_coerce_ID_OR_INT_to_FORMULA_OR_INT of ct_ID_OR_INT
+and ct_GRAMMAR =
+    CT_grammar_none
+and ct_HYP_LOCATION =
+    CT_coerce_UNFOLD_to_HYP_LOCATION of ct_UNFOLD
+  | CT_intype of ct_ID * ct_INT_LIST
+  | CT_invalue of ct_ID * ct_INT_LIST
+and ct_HYP_LOCATION_LIST_OR_STAR =
+    CT_coerce_STAR_to_HYP_LOCATION_LIST_OR_STAR of ct_STAR
+  | CT_hyp_location_list of ct_HYP_LOCATION list
+and ct_ID =
+    CT_ident of string
+  | CT_metac of ct_INT
+  | CT_metaid of string
+and ct_IDENTITY_OPT =
+    CT_coerce_NONE_to_IDENTITY_OPT of ct_NONE
+  | CT_identity
+and ct_ID_LIST =
+    CT_id_list of ct_ID list
+and ct_ID_LIST_LIST =
+    CT_id_list_list of ct_ID_LIST list
+and ct_ID_LIST_OPT =
+    CT_coerce_ID_LIST_to_ID_LIST_OPT of ct_ID_LIST
+  | CT_coerce_NONE_to_ID_LIST_OPT of ct_NONE
+and ct_ID_NE_LIST =
+    CT_id_ne_list of ct_ID * ct_ID list
+and ct_ID_NE_LIST_OR_STAR =
+    CT_coerce_ID_NE_LIST_to_ID_NE_LIST_OR_STAR of ct_ID_NE_LIST
+  | CT_coerce_STAR_to_ID_NE_LIST_OR_STAR of ct_STAR
+and ct_ID_NE_LIST_OR_STRING =
+    CT_coerce_ID_NE_LIST_to_ID_NE_LIST_OR_STRING of ct_ID_NE_LIST
+  | CT_coerce_STRING_to_ID_NE_LIST_OR_STRING of ct_STRING
+and ct_ID_OPT =
+    CT_coerce_ID_to_ID_OPT of ct_ID
+  | CT_coerce_NONE_to_ID_OPT of ct_NONE
+and ct_ID_OPT_LIST =
+    CT_id_opt_list of ct_ID_OPT list
+and ct_ID_OPT_NE_LIST =
+    CT_id_opt_ne_list of ct_ID_OPT * ct_ID_OPT list
+and ct_ID_OPT_OR_ALL =
+    CT_coerce_ID_OPT_to_ID_OPT_OR_ALL of ct_ID_OPT
+  | CT_all
+and ct_ID_OR_INT =
+    CT_coerce_ID_to_ID_OR_INT of ct_ID
+  | CT_coerce_INT_to_ID_OR_INT of ct_INT
+and ct_ID_OR_INT_OPT =
+    CT_coerce_ID_OPT_to_ID_OR_INT_OPT of ct_ID_OPT
+  | CT_coerce_ID_OR_INT_to_ID_OR_INT_OPT of ct_ID_OR_INT
+  | CT_coerce_INT_OPT_to_ID_OR_INT_OPT of ct_INT_OPT
+and ct_ID_OR_STAR =
+    CT_coerce_ID_to_ID_OR_STAR of ct_ID
+  | CT_coerce_STAR_to_ID_OR_STAR of ct_STAR
+and ct_ID_OR_STRING =
+    CT_coerce_ID_to_ID_OR_STRING of ct_ID
+  | CT_coerce_STRING_to_ID_OR_STRING of ct_STRING
+and ct_ID_OR_STRING_NE_LIST =
+    CT_id_or_string_ne_list of ct_ID_OR_STRING * ct_ID_OR_STRING list
+and ct_IMPEXP =
+    CT_coerce_NONE_to_IMPEXP of ct_NONE
+  | CT_export
+  | CT_import
+and ct_IND_SPEC =
+    CT_ind_spec of ct_ID * ct_BINDER_LIST * ct_FORMULA * ct_CONSTR_LIST * ct_DECL_NOTATION_OPT
+and ct_IND_SPEC_LIST =
+    CT_ind_spec_list of ct_IND_SPEC list
+and ct_INT =
+    CT_int of int
+and ct_INTRO_PATT =
+    CT_coerce_ID_to_INTRO_PATT of ct_ID
+  | CT_disj_pattern of ct_INTRO_PATT_LIST * ct_INTRO_PATT_LIST list
+and ct_INTRO_PATT_LIST =
+    CT_intro_patt_list of ct_INTRO_PATT list
+and ct_INTRO_PATT_OPT =
+    CT_coerce_ID_OPT_to_INTRO_PATT_OPT of ct_ID_OPT
+  | CT_coerce_INTRO_PATT_to_INTRO_PATT_OPT of ct_INTRO_PATT
+and ct_INT_LIST =
+    CT_int_list of ct_INT list
+and ct_INT_NE_LIST =
+    CT_int_ne_list of ct_INT * ct_INT list
+and ct_INT_OPT =
+    CT_coerce_INT_to_INT_OPT of ct_INT
+  | CT_coerce_NONE_to_INT_OPT of ct_NONE
+and ct_INT_OR_LOCN =
+    CT_coerce_INT_to_INT_OR_LOCN of ct_INT
+  | CT_coerce_LOCN_to_INT_OR_LOCN of ct_LOCN
+and ct_INT_OR_NEXT =
+    CT_coerce_INT_to_INT_OR_NEXT of ct_INT
+  | CT_next_level
+and ct_INV_TYPE =
+    CT_inv_clear
+  | CT_inv_regular
+  | CT_inv_simple
+and ct_IN_OR_OUT_MODULES =
+    CT_coerce_NONE_to_IN_OR_OUT_MODULES of ct_NONE
+  | CT_in_modules of ct_ID_NE_LIST
+  | CT_out_modules of ct_ID_NE_LIST
+and ct_LET_CLAUSE =
+    CT_let_clause of ct_ID * ct_TACTIC_OPT * ct_LET_VALUE
+and ct_LET_CLAUSES =
+    CT_let_clauses of ct_LET_CLAUSE * ct_LET_CLAUSE list
+and ct_LET_VALUE =
+    CT_coerce_DEF_BODY_to_LET_VALUE of ct_DEF_BODY
+  | CT_coerce_TACTIC_COM_to_LET_VALUE of ct_TACTIC_COM
+and ct_LOCAL_OPT =
+    CT_coerce_NONE_to_LOCAL_OPT of ct_NONE
+  | CT_local
+and ct_LOCN =
+    CT_locn of string
+and ct_MATCHED_FORMULA =
+    CT_coerce_FORMULA_to_MATCHED_FORMULA of ct_FORMULA
+  | CT_formula_as of ct_FORMULA * ct_ID_OPT
+  | CT_formula_as_in of ct_FORMULA * ct_ID_OPT * ct_FORMULA
+  | CT_formula_in of ct_FORMULA * ct_FORMULA
+and ct_MATCHED_FORMULA_NE_LIST =
+    CT_matched_formula_ne_list of ct_MATCHED_FORMULA * ct_MATCHED_FORMULA list
+and ct_MATCH_PATTERN =
+    CT_coerce_ID_OPT_to_MATCH_PATTERN of ct_ID_OPT
+  | CT_coerce_NUM_to_MATCH_PATTERN of ct_NUM
+  | CT_pattern_app of ct_MATCH_PATTERN * ct_MATCH_PATTERN_NE_LIST
+  | CT_pattern_as of ct_MATCH_PATTERN * ct_ID_OPT
+  | CT_pattern_delimitors of ct_NUM_TYPE * ct_MATCH_PATTERN
+  | CT_pattern_notation of ct_STRING * ct_MATCH_PATTERN_LIST
+and ct_MATCH_PATTERN_LIST =
+    CT_match_pattern_list of ct_MATCH_PATTERN list
+and ct_MATCH_PATTERN_NE_LIST =
+    CT_match_pattern_ne_list of ct_MATCH_PATTERN * ct_MATCH_PATTERN list
+and ct_MATCH_TAC_RULE =
+    CT_match_tac_rule of ct_CONTEXT_PATTERN * ct_LET_VALUE
+and ct_MATCH_TAC_RULES =
+    CT_match_tac_rules of ct_MATCH_TAC_RULE * ct_MATCH_TAC_RULE list
+and ct_MODIFIER =
+    CT_entry_type of ct_ID * ct_ID
+  | CT_format of ct_STRING
+  | CT_lefta
+  | CT_nona
+  | CT_only_parsing
+  | CT_righta
+  | CT_set_item_level of ct_ID_NE_LIST * ct_INT_OR_NEXT
+  | CT_set_level of ct_INT
+and ct_MODIFIER_LIST =
+    CT_modifier_list of ct_MODIFIER list
+and ct_MODULE_BINDER =
+    CT_module_binder of ct_ID_NE_LIST * ct_MODULE_TYPE
+and ct_MODULE_BINDER_LIST =
+    CT_module_binder_list of ct_MODULE_BINDER list
+and ct_MODULE_EXPR =
+    CT_coerce_ID_OPT_to_MODULE_EXPR of ct_ID_OPT
+  | CT_module_app of ct_MODULE_EXPR * ct_MODULE_EXPR
+and ct_MODULE_TYPE =
+    CT_coerce_ID_to_MODULE_TYPE of ct_ID
+  | CT_module_type_with_def of ct_MODULE_TYPE * ct_ID * ct_FORMULA
+  | CT_module_type_with_mod of ct_MODULE_TYPE * ct_ID * ct_ID
+and ct_MODULE_TYPE_CHECK =
+    CT_coerce_MODULE_TYPE_OPT_to_MODULE_TYPE_CHECK of ct_MODULE_TYPE_OPT
+  | CT_only_check of ct_MODULE_TYPE
+and ct_MODULE_TYPE_OPT =
+    CT_coerce_ID_OPT_to_MODULE_TYPE_OPT of ct_ID_OPT
+  | CT_coerce_MODULE_TYPE_to_MODULE_TYPE_OPT of ct_MODULE_TYPE
+and ct_NATURAL_FEATURE =
+    CT_contractible
+  | CT_implicit
+  | CT_nat_transparent
+and ct_NONE =
+    CT_none
+and ct_NUM =
+    CT_int_encapsulator of string
+and ct_NUM_TYPE =
+    CT_num_type of string
+and ct_OMEGA_FEATURE =
+    CT_coerce_STRING_to_OMEGA_FEATURE of ct_STRING
+  | CT_flag_action
+  | CT_flag_system
+  | CT_flag_time
+and ct_OMEGA_MODE =
+    CT_set
+  | CT_switch
+  | CT_unset
+and ct_ORIENTATION =
+    CT_lr
+  | CT_rl
+and ct_PATTERN =
+    CT_pattern_occ of ct_INT_LIST * ct_FORMULA
+and ct_PATTERN_NE_LIST =
+    CT_pattern_ne_list of ct_PATTERN * ct_PATTERN list
+and ct_PATTERN_OPT =
+    CT_coerce_NONE_to_PATTERN_OPT of ct_NONE
+  | CT_coerce_PATTERN_to_PATTERN_OPT of ct_PATTERN
+and ct_PREMISE =
+    CT_coerce_TYPED_FORMULA_to_PREMISE of ct_TYPED_FORMULA
+  | CT_eval_result of ct_FORMULA * ct_FORMULA * ct_FORMULA
+  | CT_premise of ct_ID * ct_FORMULA
+and ct_PREMISES_LIST =
+    CT_premises_list of ct_PREMISE list
+and ct_PREMISE_PATTERN =
+    CT_premise_pattern of ct_ID_OPT * ct_CONTEXT_PATTERN
+and ct_PROOF_SCRIPT =
+    CT_proof_script of ct_COMMAND list
+and ct_RECCONSTR =
+    CT_defrecconstr of ct_ID_OPT * ct_FORMULA * ct_FORMULA_OPT
+  | CT_defrecconstr_coercion of ct_ID_OPT * ct_FORMULA * ct_FORMULA_OPT
+  | CT_recconstr of ct_ID_OPT * ct_FORMULA
+  | CT_recconstr_coercion of ct_ID_OPT * ct_FORMULA
+and ct_RECCONSTR_LIST =
+    CT_recconstr_list of ct_RECCONSTR list
+and ct_REC_TACTIC_FUN =
+    CT_rec_tactic_fun of ct_ID * ct_ID_OPT_NE_LIST * ct_TACTIC_COM
+and ct_REC_TACTIC_FUN_LIST =
+    CT_rec_tactic_fun_list of ct_REC_TACTIC_FUN * ct_REC_TACTIC_FUN list
+and ct_RED_COM =
+    CT_cbv of ct_CONVERSION_FLAG_LIST * ct_CONV_SET
+  | CT_fold of ct_FORMULA_LIST
+  | CT_hnf
+  | CT_lazy of ct_CONVERSION_FLAG_LIST * ct_CONV_SET
+  | CT_pattern of ct_PATTERN_NE_LIST
+  | CT_red
+  | CT_simpl of ct_PATTERN_OPT
+  | CT_unfold of ct_UNFOLD_NE_LIST
+and ct_RETURN_INFO =
+    CT_coerce_NONE_to_RETURN_INFO of ct_NONE
+  | CT_as_and_return of ct_ID_OPT * ct_FORMULA
+  | CT_return of ct_FORMULA
+and ct_RULE =
+    CT_rule of ct_PREMISES_LIST * ct_FORMULA
+and ct_RULE_LIST =
+    CT_rule_list of ct_RULE list
+and ct_SCHEME_SPEC =
+    CT_scheme_spec of ct_ID * ct_DEP * ct_FORMULA * ct_SORT_TYPE
+and ct_SCHEME_SPEC_LIST =
+    CT_scheme_spec_list of ct_SCHEME_SPEC * ct_SCHEME_SPEC list
+and ct_SCOMMENT_CONTENT =
+    CT_coerce_FORMULA_to_SCOMMENT_CONTENT of ct_FORMULA
+  | CT_coerce_ID_OR_STRING_to_SCOMMENT_CONTENT of ct_ID_OR_STRING
+and ct_SCOMMENT_CONTENT_LIST =
+    CT_scomment_content_list of ct_SCOMMENT_CONTENT list
+and ct_SECTION_BEGIN =
+    CT_section of ct_ID
+and ct_SECTION_BODY =
+    CT_section_body of ct_COMMAND list
+and ct_SIGNED_INT =
+    CT_coerce_INT_to_SIGNED_INT of ct_INT
+  | CT_minus of ct_INT
+and ct_SIGNED_INT_LIST =
+    CT_signed_int_list of ct_SIGNED_INT list
+and ct_SINGLE_OPTION_VALUE =
+    CT_coerce_INT_to_SINGLE_OPTION_VALUE of ct_INT
+  | CT_coerce_STRING_to_SINGLE_OPTION_VALUE of ct_STRING
+and ct_SORT_TYPE =
+    CT_sortc of string
+and ct_SPEC_LIST =
+    CT_coerce_BINDING_LIST_to_SPEC_LIST of ct_BINDING_LIST
+  | CT_coerce_FORMULA_LIST_to_SPEC_LIST of ct_FORMULA_LIST
+and ct_SPEC_OPT =
+    CT_coerce_NONE_to_SPEC_OPT of ct_NONE
+  | CT_spec
+and ct_STAR =
+    CT_star
+and ct_STAR_OPT =
+    CT_coerce_NONE_to_STAR_OPT of ct_NONE
+  | CT_coerce_STAR_to_STAR_OPT of ct_STAR
+and ct_STRING =
+    CT_string of string
+and ct_STRING_NE_LIST =
+    CT_string_ne_list of ct_STRING * ct_STRING list
+and ct_STRING_OPT =
+    CT_coerce_NONE_to_STRING_OPT of ct_NONE
+  | CT_coerce_STRING_to_STRING_OPT of ct_STRING
+and ct_TABLE =
+    CT_coerce_ID_to_TABLE of ct_ID
+  | CT_table of ct_ID * ct_ID
+and ct_TACTIC_ARG =
+    CT_coerce_EVAL_CMD_to_TACTIC_ARG of ct_EVAL_CMD
+  | CT_coerce_FORMULA_OR_INT_to_TACTIC_ARG of ct_FORMULA_OR_INT
+  | CT_coerce_TACTIC_COM_to_TACTIC_ARG of ct_TACTIC_COM
+  | CT_coerce_TERM_CHANGE_to_TACTIC_ARG of ct_TERM_CHANGE
+  | CT_void
+and ct_TACTIC_ARG_LIST =
+    CT_tactic_arg_list of ct_TACTIC_ARG * ct_TACTIC_ARG list
+and ct_TACTIC_COM =
+    CT_abstract of ct_ID_OPT * ct_TACTIC_COM
+  | CT_absurd of ct_FORMULA
+  | CT_any_constructor of ct_TACTIC_OPT
+  | CT_apply of ct_FORMULA * ct_SPEC_LIST
+  | CT_assert of ct_ID_OPT * ct_FORMULA
+  | CT_assumption
+  | CT_auto of ct_INT_OPT
+  | CT_auto_with of ct_INT_OPT * ct_ID_NE_LIST_OR_STAR
+  | CT_autorewrite of ct_ID_NE_LIST * ct_TACTIC_OPT
+  | CT_autotdb of ct_INT_OPT
+  | CT_case_type of ct_FORMULA
+  | CT_casetac of ct_FORMULA * ct_SPEC_LIST
+  | CT_cdhyp of ct_ID
+  | CT_change of ct_FORMULA * ct_CLAUSE
+  | CT_change_local of ct_PATTERN * ct_FORMULA * ct_CLAUSE
+  | CT_clear of ct_ID_NE_LIST
+  | CT_clear_body of ct_ID_NE_LIST
+  | CT_cofixtactic of ct_ID_OPT * ct_COFIX_TAC_LIST
+  | CT_condrewrite_lr of ct_TACTIC_COM * ct_FORMULA * ct_SPEC_LIST * ct_ID_OPT
+  | CT_condrewrite_rl of ct_TACTIC_COM * ct_FORMULA * ct_SPEC_LIST * ct_ID_OPT
+  | CT_constructor of ct_INT * ct_SPEC_LIST
+  | CT_contradiction
+  | CT_contradiction_thm of ct_FORMULA * ct_SPEC_LIST
+  | CT_cut of ct_FORMULA
+  | CT_cutrewrite_lr of ct_FORMULA * ct_ID_OPT
+  | CT_cutrewrite_rl of ct_FORMULA * ct_ID_OPT
+  | CT_dauto of ct_INT_OPT * ct_INT_OPT
+  | CT_dconcl
+  | CT_decompose_list of ct_ID_NE_LIST * ct_FORMULA
+  | CT_decompose_record of ct_FORMULA
+  | CT_decompose_sum of ct_FORMULA
+  | CT_depinversion of ct_INV_TYPE * ct_ID_OR_INT * ct_INTRO_PATT_OPT * ct_FORMULA_OPT
+  | CT_deprewrite_lr of ct_ID
+  | CT_deprewrite_rl of ct_ID
+  | CT_destruct of ct_ID_OR_INT
+  | CT_dhyp of ct_ID
+  | CT_discriminate_eq of ct_ID_OR_INT_OPT
+  | CT_do of ct_ID_OR_INT * ct_TACTIC_COM
+  | CT_eapply of ct_FORMULA * ct_SPEC_LIST
+  | CT_eauto of ct_ID_OR_INT_OPT * ct_ID_OR_INT_OPT
+  | CT_eauto_with of ct_ID_OR_INT_OPT * ct_ID_OR_INT_OPT * ct_ID_NE_LIST_OR_STAR
+  | CT_elim of ct_FORMULA * ct_SPEC_LIST * ct_USING
+  | CT_elim_type of ct_FORMULA
+  | CT_exact of ct_FORMULA
+  | CT_exists of ct_SPEC_LIST
+  | CT_fail of ct_ID_OR_INT * ct_STRING_OPT
+  | CT_first of ct_TACTIC_COM * ct_TACTIC_COM list
+  | CT_firstorder of ct_TACTIC_OPT
+  | CT_firstorder_using of ct_TACTIC_OPT * ct_ID_NE_LIST
+  | CT_firstorder_with of ct_TACTIC_OPT * ct_ID_NE_LIST
+  | CT_fixtactic of ct_ID_OPT * ct_INT * ct_FIX_TAC_LIST
+  | CT_formula_marker of ct_FORMULA
+  | CT_fresh of ct_STRING_OPT
+  | CT_generalize of ct_FORMULA_NE_LIST
+  | CT_generalize_dependent of ct_FORMULA
+  | CT_idtac of ct_STRING_OPT
+  | CT_induction of ct_ID_OR_INT
+  | CT_info of ct_TACTIC_COM
+  | CT_injection_eq of ct_ID_OR_INT_OPT
+  | CT_instantiate of ct_INT * ct_FORMULA * ct_CLAUSE
+  | CT_intro of ct_ID_OPT
+  | CT_intro_after of ct_ID_OPT * ct_ID
+  | CT_intros of ct_INTRO_PATT_LIST
+  | CT_intros_until of ct_ID_OR_INT
+  | CT_inversion of ct_INV_TYPE * ct_ID_OR_INT * ct_INTRO_PATT_OPT * ct_ID_LIST
+  | CT_left of ct_SPEC_LIST
+  | CT_let_ltac of ct_LET_CLAUSES * ct_LET_VALUE
+  | CT_lettac of ct_ID_OPT * ct_FORMULA * ct_CLAUSE
+  | CT_match_context of ct_CONTEXT_RULE * ct_CONTEXT_RULE list
+  | CT_match_context_reverse of ct_CONTEXT_RULE * ct_CONTEXT_RULE list
+  | CT_match_tac of ct_TACTIC_COM * ct_MATCH_TAC_RULES
+  | CT_move_after of ct_ID * ct_ID
+  | CT_new_destruct of ct_FORMULA_OR_INT * ct_USING * ct_INTRO_PATT_OPT
+  | CT_new_induction of ct_FORMULA_OR_INT * ct_USING * ct_INTRO_PATT_OPT
+  | CT_omega
+  | CT_orelse of ct_TACTIC_COM * ct_TACTIC_COM
+  | CT_parallel of ct_TACTIC_COM * ct_TACTIC_COM list
+  | CT_pose of ct_ID_OPT * ct_FORMULA
+  | CT_progress of ct_TACTIC_COM
+  | CT_prolog of ct_FORMULA_LIST * ct_INT
+  | CT_rec_tactic_in of ct_REC_TACTIC_FUN_LIST * ct_TACTIC_COM
+  | CT_reduce of ct_RED_COM * ct_CLAUSE
+  | CT_refine of ct_FORMULA
+  | CT_reflexivity
+  | CT_rename of ct_ID * ct_ID
+  | CT_repeat of ct_TACTIC_COM
+  | CT_replace_with of ct_FORMULA * ct_FORMULA
+  | CT_rewrite_lr of ct_FORMULA * ct_SPEC_LIST * ct_ID_OPT
+  | CT_rewrite_rl of ct_FORMULA * ct_SPEC_LIST * ct_ID_OPT
+  | CT_right of ct_SPEC_LIST
+  | CT_ring of ct_FORMULA_LIST
+  | CT_simple_user_tac of ct_ID * ct_TACTIC_ARG_LIST
+  | CT_simplify_eq of ct_ID_OR_INT_OPT
+  | CT_specialize of ct_INT_OPT * ct_FORMULA * ct_SPEC_LIST
+  | CT_split of ct_SPEC_LIST
+  | CT_subst of ct_ID_LIST
+  | CT_superauto of ct_INT_OPT * ct_ID_LIST * ct_DESTRUCTING * ct_USINGTDB
+  | CT_symmetry of ct_CLAUSE
+  | CT_tac_double of ct_ID_OR_INT * ct_ID_OR_INT
+  | CT_tacsolve of ct_TACTIC_COM * ct_TACTIC_COM list
+  | CT_tactic_fun of ct_ID_OPT_NE_LIST * ct_TACTIC_COM
+  | CT_then of ct_TACTIC_COM * ct_TACTIC_COM list
+  | CT_transitivity of ct_FORMULA
+  | CT_trivial
+  | CT_trivial_with of ct_ID_NE_LIST_OR_STAR
+  | CT_truecut of ct_ID_OPT * ct_FORMULA
+  | CT_try of ct_TACTIC_COM
+  | CT_use of ct_FORMULA
+  | CT_use_inversion of ct_ID_OR_INT * ct_FORMULA * ct_ID_LIST
+  | CT_user_tac of ct_ID * ct_TARG_LIST
+and ct_TACTIC_OPT =
+    CT_coerce_NONE_to_TACTIC_OPT of ct_NONE
+  | CT_coerce_TACTIC_COM_to_TACTIC_OPT of ct_TACTIC_COM
+and ct_TAC_DEF =
+    CT_tac_def of ct_ID * ct_TACTIC_COM
+and ct_TAC_DEF_NE_LIST =
+    CT_tac_def_ne_list of ct_TAC_DEF * ct_TAC_DEF list
+and ct_TARG =
+    CT_coerce_BINDING_to_TARG of ct_BINDING
+  | CT_coerce_COFIXTAC_to_TARG of ct_COFIXTAC
+  | CT_coerce_FIXTAC_to_TARG of ct_FIXTAC
+  | CT_coerce_FORMULA_OR_INT_to_TARG of ct_FORMULA_OR_INT
+  | CT_coerce_PATTERN_to_TARG of ct_PATTERN
+  | CT_coerce_SCOMMENT_CONTENT_to_TARG of ct_SCOMMENT_CONTENT
+  | CT_coerce_SIGNED_INT_LIST_to_TARG of ct_SIGNED_INT_LIST
+  | CT_coerce_SINGLE_OPTION_VALUE_to_TARG of ct_SINGLE_OPTION_VALUE
+  | CT_coerce_SPEC_LIST_to_TARG of ct_SPEC_LIST
+  | CT_coerce_TACTIC_COM_to_TARG of ct_TACTIC_COM
+  | CT_coerce_TARG_LIST_to_TARG of ct_TARG_LIST
+  | CT_coerce_UNFOLD_to_TARG of ct_UNFOLD
+  | CT_coerce_UNFOLD_NE_LIST_to_TARG of ct_UNFOLD_NE_LIST
+and ct_TARG_LIST =
+    CT_targ_list of ct_TARG list
+and ct_TERM_CHANGE =
+    CT_check_term of ct_FORMULA
+  | CT_inst_term of ct_ID * ct_FORMULA
+and ct_TEXT =
+    CT_coerce_ID_to_TEXT of ct_ID
+  | CT_text_formula of ct_FORMULA
+  | CT_text_h of ct_TEXT list
+  | CT_text_hv of ct_TEXT list
+  | CT_text_op of ct_TEXT list
+  | CT_text_path of ct_SIGNED_INT_LIST
+  | CT_text_v of ct_TEXT list
+and ct_THEOREM_GOAL =
+    CT_goal of ct_FORMULA
+  | CT_theorem_goal of ct_DEFN_OR_THM * ct_ID * ct_BINDER_LIST * ct_FORMULA
+and ct_THM =
+    CT_thm of string
+and ct_THM_OPT =
+    CT_coerce_NONE_to_THM_OPT of ct_NONE
+  | CT_coerce_THM_to_THM_OPT of ct_THM
+and ct_TYPED_FORMULA =
+    CT_typed_formula of ct_FORMULA * ct_FORMULA
+and ct_UNFOLD =
+    CT_coerce_ID_to_UNFOLD of ct_ID
+  | CT_unfold_occ of ct_ID * ct_INT_NE_LIST
+and ct_UNFOLD_NE_LIST =
+    CT_unfold_ne_list of ct_UNFOLD * ct_UNFOLD list
+and ct_USING =
+    CT_coerce_NONE_to_USING of ct_NONE
+  | CT_using of ct_FORMULA * ct_SPEC_LIST
+and ct_USINGTDB =
+    CT_coerce_NONE_to_USINGTDB of ct_NONE
+  | CT_usingtdb
+and ct_VAR =
+    CT_var of string
+and ct_VARG =
+    CT_coerce_AST_to_VARG of ct_AST
+  | CT_coerce_AST_LIST_to_VARG of ct_AST_LIST
+  | CT_coerce_BINDER_to_VARG of ct_BINDER
+  | CT_coerce_BINDER_LIST_to_VARG of ct_BINDER_LIST
+  | CT_coerce_BINDER_NE_LIST_to_VARG of ct_BINDER_NE_LIST
+  | CT_coerce_FORMULA_LIST_to_VARG of ct_FORMULA_LIST
+  | CT_coerce_FORMULA_OPT_to_VARG of ct_FORMULA_OPT
+  | CT_coerce_FORMULA_OR_INT_to_VARG of ct_FORMULA_OR_INT
+  | CT_coerce_ID_OPT_OR_ALL_to_VARG of ct_ID_OPT_OR_ALL
+  | CT_coerce_ID_OR_INT_OPT_to_VARG of ct_ID_OR_INT_OPT
+  | CT_coerce_INT_LIST_to_VARG of ct_INT_LIST
+  | CT_coerce_SCOMMENT_CONTENT_to_VARG of ct_SCOMMENT_CONTENT
+  | CT_coerce_STRING_OPT_to_VARG of ct_STRING_OPT
+  | CT_coerce_TACTIC_OPT_to_VARG of ct_TACTIC_OPT
+  | CT_coerce_VARG_LIST_to_VARG of ct_VARG_LIST
+and ct_VARG_LIST =
+    CT_varg_list of ct_VARG list
+and ct_VERBOSE_OPT =
+    CT_coerce_NONE_to_VERBOSE_OPT of ct_NONE
+  | CT_verbose
+;;
diff --git a/contrib/interface/blast.ml b/contrib/interface/blast.ml
new file mode 100755
index 00000000..d5236a7a
--- /dev/null
+++ b/contrib/interface/blast.ml
@@ -0,0 +1,628 @@
+(* Une tactique qui tente de démontrer toute seule le but courant,
+   interruptible par pcoq (si dans le fichier C:\WINDOWS\free il y a un A)
+*)
+open Ctast;;
+open Termops;;
+open Nameops;;
+open Auto;;
+open Clenv;;
+open Command;;
+open Ctast;;
+open Declarations;;
+open Declare;;
+open Eauto;;
+open Environ;;
+open Equality;;
+open Evd;;
+open Hipattern;;
+open Inductive;;
+open Names;;
+open Pattern;;
+open Pbp;;
+open Pfedit;;
+open Pp;;
+open Printer
+open Proof_trees;;
+open Proof_type;;
+open Rawterm;;
+open Reduction;;
+open Refiner;;
+open Sign;;
+open String;;
+open Tacmach;;
+open Tacred;;
+open Tacticals;;
+open Tactics;;
+open Term;;
+open Typing;;
+open Util;;
+open Vernacentries;;
+open Vernacinterp;;
+open Evar_refiner;;
+
+
+let parse_com   = Pcoq.parse_string Pcoq.Constr.constr;;
+let parse_tac  t =
+    try (Pcoq.parse_string Pcoq.Tactic.tactic t)
+    with _ -> (msgnl (hov 0 (str"pas parsé: " ++ str t));
+	       failwith "tactic")
+;;
+
+let is_free () =
+   let st =open_in_bin ((Sys.getenv "HOME")^"/.free") in
+   let c=input_char st in
+   close_in st;
+   c = 'A'
+;;
+
+(* marche pas *)
+(*
+let is_free () =
+   msgnl (hov 0 [< 'str"Isfree========= "; 'fNL >]);
+   let s = Stream.of_channel stdin in
+   msgnl (hov 0 [< 'str"Isfree s "; 'fNL >]);
+   try (Stream.empty s;
+        msgnl (hov 0 [< 'str"Isfree empty "; 'fNL >]);
+        true)
+   with _ -> (msgnl (hov 0 [< 'str"Isfree not empty "; 'fNL >]);
+              false)
+;;
+*)
+let free_try tac g =
+    if is_free()
+    then (tac g)
+    else (failwith "not free")
+;;
+let adrel (x,t) e =
+    match x with 
+      Name(xid) -> Environ.push_rel (x,None,t) e
+    | Anonymous -> Environ.push_rel (x,None,t) e
+(* les constantes ayant une définition apparaissant dans x *)
+let rec def_const_in_term_rec vl x = 
+     match (kind_of_term x) with
+     Prod(n,t,c)->
+        let vl = (adrel (n,t) vl) in def_const_in_term_rec vl c
+   | Lambda(n,t,c) ->
+        let vl = (adrel (n,t) vl) in def_const_in_term_rec vl c
+   | App(f,args) -> def_const_in_term_rec vl f
+   | Sort(Prop(Null)) -> Prop(Null)
+   | Sort(c) -> c
+   | Ind(ind) ->
+          let (mib, mip) = Global.lookup_inductive ind in
+          mip.mind_sort
+   | Construct(c) ->
+          def_const_in_term_rec vl (mkInd (inductive_of_constructor c))
+   | Case(_,x,t,a) 
+        -> def_const_in_term_rec vl x
+   | Cast(x,t)-> def_const_in_term_rec vl t
+   | Const(c)  -> def_const_in_term_rec vl (lookup_constant c vl).const_type
+   | _ -> def_const_in_term_rec vl (type_of vl Evd.empty x)
+;;
+let def_const_in_term_ x =
+    def_const_in_term_rec  (Global.env()) (strip_outer_cast x)
+;;
+(*************************************************************************
+ recopiés de refiner.ml, car print_subscript pas exportée dans refiner.mli 
+ modif de print_info_script avec pr_bar
+*)
+
+let pr_bar () = str "|"
+
+let rec print_info_script sigma osign pf =
+  let {evar_hyps=sign; evar_concl=cl} = pf.goal in
+  match pf.ref with
+    | None -> (mt ())
+    | Some(r,spfl) ->
+        pr_rule r ++
+           match spfl with
+             | [] ->
+		   (str " " ++ fnl())
+             | [pf1] ->
+                 if pf1.ref = None then 
+		   (str " " ++ fnl())
+                 else 
+		   (str";" ++ brk(1,3) ++
+		      print_info_script sigma sign pf1)
+             | _ -> ( str";[" ++ fnl() ++
+                       prlist_with_sep pr_bar
+                         (print_info_script sigma sign) spfl ++
+                       str"]")
+
+let format_print_info_script sigma osign pf = 
+  hov 0 (print_info_script sigma osign pf)
+    
+let print_subscript sigma sign pf = 
+ (* if is_tactic_proof pf then 
+    format_print_info_script sigma sign (subproof_of_proof pf)
+  else *)
+    format_print_info_script sigma sign pf
+(****************)
+
+let pp_string x =
+   msgnl_with Format.str_formatter x;
+   Format.flush_str_formatter ()
+;;
+
+(***********************************************************************
+   copié de tactics/eauto.ml
+*)
+
+(***************************************************************************)
+(* A tactic similar to Auto, but using EApply, Assumption and e_give_exact *)
+(***************************************************************************)
+
+let unify_e_resolve  (c,clenv) gls = 
+  let (wc,kONT) = startWalk gls in
+  let clenv' = connect_clenv wc clenv in
+  let _ = clenv_unique_resolver false clenv' gls in
+  vernac_e_resolve_constr c gls
+
+let rec e_trivial_fail_db db_list local_db goal =
+  let tacl = 
+    registered_e_assumption ::
+    (tclTHEN Tactics.intro 
+       (function g'->
+	  let d = pf_last_hyp g' in
+	  let hintl = make_resolve_hyp (pf_env g') (project g') d in
+          (e_trivial_fail_db db_list
+	     (Hint_db.add_list hintl local_db) g'))) ::
+    (List.map fst (e_trivial_resolve db_list local_db (pf_concl goal)) )
+  in 
+  tclFIRST (List.map tclCOMPLETE tacl) goal 
+
+and e_my_find_search db_list local_db hdc concl = 
+  let hdc = head_of_constr_reference hdc in
+  let hintl =
+    if occur_existential concl then 
+      list_map_append (Hint_db.map_all hdc) (local_db::db_list)
+    else 
+      list_map_append (Hint_db.map_auto (hdc,concl)) (local_db::db_list)
+  in 
+  let tac_of_hint = 
+    fun ({pri=b; pat = p; code=t} as patac) -> 
+      (b, 
+       let tac =
+	 match t with
+	   | Res_pf (term,cl) -> unify_resolve (term,cl)
+	   | ERes_pf (term,cl) -> unify_e_resolve (term,cl)
+	   | Give_exact (c) -> e_give_exact_constr c
+	   | Res_pf_THEN_trivial_fail (term,cl) ->
+               tclTHEN (unify_e_resolve (term,cl)) 
+		 (e_trivial_fail_db db_list local_db)
+	   | Unfold_nth c -> unfold_constr c
+	   | Extern tacast -> Auto.conclPattern concl 
+	       (out_some p) tacast
+       in 
+       (free_try tac,fmt_autotactic t))
+       (*i
+	 fun gls -> pPNL (fmt_autotactic t); Format.print_flush (); 
+                     try tac gls
+		     with e when Logic.catchable_exception(e) -> 
+                            (Format.print_string "Fail\n"; 
+			     Format.print_flush (); 
+			     raise e)
+       i*)
+  in 
+  List.map tac_of_hint hintl
+    
+and e_trivial_resolve db_list local_db gl = 
+  try 
+    Auto.priority 
+      (e_my_find_search db_list local_db 
+	 (List.hd (head_constr_bound gl [])) gl)
+  with Bound | Not_found -> []
+
+let e_possible_resolve db_list local_db gl =
+  try List.map snd (e_my_find_search db_list local_db 
+		      (List.hd (head_constr_bound gl [])) gl)
+  with Bound | Not_found -> []
+
+let assumption_tac_list id = apply_tac_list (e_give_exact_constr (mkVar id))
+
+let find_first_goal gls = 
+  try first_goal gls with UserError _ -> assert false
+
+(*s The following module [SearchProblem] is used to instantiate the generic
+    exploration functor [Explore.Make]. *)
+      
+module MySearchProblem = struct
+
+  type state = { 
+    depth : int; (*r depth of search before failing *)
+    tacres : goal list sigma * validation;
+    last_tactic : std_ppcmds;
+    dblist : Auto.Hint_db.t list;
+    localdb :  Auto.Hint_db.t list }
+		 
+  let success s = (sig_it (fst s.tacres)) = []
+
+  let rec filter_tactics (glls,v) = function
+    | [] -> []
+    | (tac,pptac) :: tacl -> 
+	try 
+	  let (lgls,ptl) = apply_tac_list tac glls in 
+	  let v' p = v (ptl p) in
+	  ((lgls,v'),pptac) :: filter_tactics (glls,v) tacl
+	with e when Logic.catchable_exception e ->
+	  filter_tactics (glls,v) tacl
+
+  let rec list_addn n x l = 
+    if n = 0 then l else x :: (list_addn (pred n) x l)
+
+  (* Ordering of states is lexicographic on depth (greatest first) then
+     number of remaining goals. *)
+  let compare s s' =
+    let d = s'.depth - s.depth in
+    let nbgoals s = List.length (sig_it (fst s.tacres)) in
+    if d <> 0 then d else nbgoals s - nbgoals s'
+
+  let branching s = 
+    if s.depth = 0 then 
+      []
+    else      
+      let lg = fst s.tacres in
+      let nbgl = List.length (sig_it lg) in
+      assert (nbgl > 0);
+      let g = find_first_goal lg in
+      let assumption_tacs = 
+	let l = 
+	  filter_tactics s.tacres
+	    (List.map 
+	       (fun id -> (e_give_exact_constr (mkVar id),
+			   (str "Exact" ++ spc()++ pr_id id)))
+	       (pf_ids_of_hyps g))
+	in
+	List.map (fun (res,pp) -> { depth = s.depth; tacres = res;
+				    last_tactic = pp; dblist = s.dblist;
+				    localdb = List.tl s.localdb }) l
+      in
+      let intro_tac = 
+	List.map 
+	  (fun ((lgls,_) as res,pp) -> 
+	     let g' = first_goal lgls in 
+	     let hintl = 
+	       make_resolve_hyp (pf_env g') (project g') (pf_last_hyp g')
+	     in
+             let ldb = Hint_db.add_list hintl (List.hd s.localdb) in
+	     { depth = s.depth; tacres = res; 
+	       last_tactic = pp; dblist = s.dblist;
+	       localdb = ldb :: List.tl s.localdb })
+	  (filter_tactics s.tacres [Tactics.intro,(str "Intro" )])
+      in
+      let rec_tacs = 
+	let l = 
+	  filter_tactics s.tacres
+	    (e_possible_resolve s.dblist (List.hd s.localdb) (pf_concl g))
+	in
+	List.map 
+	  (fun ((lgls,_) as res, pp) -> 
+	     let nbgl' = List.length (sig_it lgls) in
+	     if nbgl' < nbgl then
+	       { depth = s.depth; tacres = res; last_tactic = pp;
+		 dblist = s.dblist; localdb = List.tl s.localdb }
+	     else 
+	       { depth = pred s.depth; tacres = res; 
+		 dblist = s.dblist; last_tactic = pp;
+		 localdb = 
+		   list_addn (nbgl'-nbgl) (List.hd s.localdb) s.localdb })
+	  l
+      in
+      List.sort compare (assumption_tacs @ intro_tac @ rec_tacs)
+
+  let pp s = 
+    msg (hov 0 (str " depth="++ int s.depth ++ spc() ++
+		  s.last_tactic ++ str "\n"))
+
+end
+
+module MySearch = Explore.Make(MySearchProblem)
+
+let make_initial_state n gl dblist localdb =
+  { MySearchProblem.depth = n;
+    MySearchProblem.tacres = tclIDTAC gl;
+    MySearchProblem.last_tactic = (mt ());
+    MySearchProblem.dblist = dblist;
+    MySearchProblem.localdb = [localdb] }
+
+let e_depth_search debug p db_list local_db gl =
+  try
+    let tac = if debug then MySearch.debug_depth_first else MySearch.depth_first in
+    let s = tac (make_initial_state p gl db_list local_db) in
+    s.MySearchProblem.tacres
+  with Not_found -> error "EAuto: depth first search failed"
+
+let e_breadth_search debug n db_list local_db gl =
+  try
+    let tac = 
+      if debug then MySearch.debug_breadth_first else MySearch.breadth_first 
+    in
+    let s = tac (make_initial_state n gl db_list local_db) in
+    s.MySearchProblem.tacres
+  with Not_found -> error "EAuto: breadth first search failed"
+
+let e_search_auto debug (n,p) db_list gl = 
+  let local_db = make_local_hint_db gl in 
+  if n = 0 then 
+    e_depth_search debug p db_list local_db gl
+  else 
+    e_breadth_search debug n db_list local_db gl
+
+let eauto debug np dbnames = 
+  let db_list =
+    List.map
+      (fun x -> 
+	 try Stringmap.find x !searchtable
+	 with Not_found -> error ("EAuto: "^x^": No such Hint database"))
+      ("core"::dbnames) 
+  in
+  tclTRY (e_search_auto debug np db_list)
+
+let full_eauto debug n gl = 
+  let dbnames = stringmap_dom !searchtable in
+  let dbnames =  list_subtract dbnames ["v62"] in
+  let db_list = List.map (fun x -> Stringmap.find x !searchtable) dbnames in
+  let local_db = make_local_hint_db gl in
+  tclTRY (e_search_auto debug n db_list) gl
+
+let my_full_eauto n gl = full_eauto false (n,0) gl
+
+(**********************************************************************
+   copié de tactics/auto.ml on a juste modifié search_gen
+*)
+let searchtable_map name = 
+  Stringmap.find name !searchtable
+
+(* local_db is a Hint database containing the hypotheses of current goal *)
+(* Papageno : cette fonction a été pas mal simplifiée depuis que la base
+  de Hint impérative a été remplacée par plusieurs bases fonctionnelles *)
+
+let rec trivial_fail_db db_list local_db gl =
+  let intro_tac = 
+    tclTHEN intro 
+      (fun g'->
+	 let hintl = make_resolve_hyp (pf_env g') (project g') (pf_last_hyp g')
+	 in trivial_fail_db db_list (Hint_db.add_list hintl local_db) g')
+  in
+  tclFIRST 
+    (assumption::intro_tac::
+     (List.map tclCOMPLETE 
+	(trivial_resolve db_list local_db (pf_concl gl)))) gl
+
+and my_find_search db_list local_db hdc concl =
+  let tacl = 
+    if occur_existential concl then 
+      list_map_append (fun db -> Hint_db.map_all hdc db) (local_db::db_list)
+    else 
+      list_map_append (fun db -> Hint_db.map_auto (hdc,concl) db)
+      	(local_db::db_list)
+  in
+  List.map 
+    (fun ({pri=b; pat=p; code=t} as patac) -> 
+       (b,
+	match t with
+	  | Res_pf (term,cl)  -> unify_resolve (term,cl)
+	  | ERes_pf (_,c) -> (fun gl -> error "eres_pf")
+	  | Give_exact c  -> exact_check c
+	  | Res_pf_THEN_trivial_fail (term,cl) -> 
+	      tclTHEN 
+		(unify_resolve (term,cl)) 
+		(trivial_fail_db db_list local_db)
+	  | Unfold_nth c -> unfold_constr c
+	  | Extern tacast -> 
+	      conclPattern concl (out_some p) tacast))
+    tacl
+
+and trivial_resolve db_list local_db cl = 
+  try 
+    let hdconstr = List.hd (head_constr_bound cl []) in
+    priority 
+      (my_find_search db_list local_db (head_of_constr_reference hdconstr) cl)
+  with Bound | Not_found -> 
+    []
+
+(**************************************************************************)
+(*                       The classical Auto tactic                        *)
+(**************************************************************************)
+
+let possible_resolve db_list local_db cl =
+  try 
+    let hdconstr = List.hd (head_constr_bound cl []) in
+    List.map snd 
+      (my_find_search db_list local_db (head_of_constr_reference hdconstr) cl)
+  with Bound | Not_found -> 
+    []
+
+let decomp_unary_term c gls = 
+  let typc = pf_type_of gls c in 
+  let hd = List.hd (head_constr typc) in 
+  if Hipattern.is_conjunction hd then 
+    simplest_case c gls 
+  else 
+    errorlabstrm "Auto.decomp_unary_term" (str "not a unary type")
+
+let decomp_empty_term c gls = 
+  let typc = pf_type_of gls c in 
+  let (hd,_) = decompose_app typc in 
+  if Hipattern.is_empty_type hd then 
+    simplest_case c gls 
+  else 
+    errorlabstrm "Auto.decomp_empty_term" (str "not an empty type")
+
+
+(* decomp is an natural number giving an indication on decomposition 
+   of conjunction in hypotheses, 0 corresponds to no decomposition *)
+(* n is the max depth of search *)
+(* local_db contains the local Hypotheses *)
+
+let rec search_gen decomp n db_list local_db extra_sign goal =
+  if n=0 then error "BOUND 2";
+  let decomp_tacs = match decomp with 
+    | 0 -> [] 
+    | p -> 
+	(tclTRY_sign decomp_empty_term extra_sign)
+	::
+	(List.map 
+	   (fun id -> tclTHEN (decomp_unary_term (mkVar id)) 
+		(tclTHEN 
+		   (clear [id])
+		   (free_try (search_gen decomp p db_list local_db []))))
+	   (pf_ids_of_hyps goal)) 
+  in
+  let intro_tac = 
+    tclTHEN intro 
+      (fun g' -> 
+	 let (hid,_,htyp as d) = pf_last_hyp g' in
+	 let hintl = 
+	   try 
+	     [make_apply_entry (pf_env g') (project g')
+		(true,false) 
+		hid (mkVar hid,body_of_type htyp)]
+	   with Failure _ -> [] 
+	 in
+         (free_try
+	  (search_gen decomp n db_list (Hint_db.add_list hintl local_db) [d])
+	  g'))
+  in
+  let rec_tacs = 
+    List.map 
+      (fun ntac -> 
+	 tclTHEN ntac
+	   (free_try
+	    (search_gen decomp (n-1) db_list local_db empty_named_context)))
+      (possible_resolve db_list local_db (pf_concl goal))
+  in 
+  tclFIRST (assumption::(decomp_tacs@(intro_tac::rec_tacs))) goal
+
+
+let search = search_gen 0
+
+let default_search_depth = ref 5
+			     
+let full_auto n gl = 
+  let dbnames = stringmap_dom !searchtable in
+  let dbnames = list_subtract dbnames ["v62"] in
+  let db_list = List.map (fun x -> searchtable_map x) dbnames in
+  let hyps = pf_hyps gl in
+  tclTRY (search n db_list (make_local_hint_db gl) hyps) gl
+  
+let default_full_auto gl = full_auto !default_search_depth gl
+(************************************************************************)
+
+let blast_tactic = ref (free_try default_full_auto)
+;;
+
+let blast_auto = (free_try default_full_auto)
+(*                  (tclTHEN (free_try default_full_auto)
+			  (free_try (my_full_eauto 2)))
+*)
+;;
+let blast_simpl = (free_try (reduce (Simpl None) onConcl))
+;;
+let blast_induction1 = 
+    (free_try (tclTHEN (tclTRY intro)
+		       (tclTRY (tclLAST_HYP simplest_elim))))
+;;
+let blast_induction2 = 
+    (free_try (tclTHEN (tclTRY (tclTHEN intro intro))
+		       (tclTRY (tclLAST_HYP simplest_elim))))
+;;
+let blast_induction3 = 
+    (free_try (tclTHEN (tclTRY (tclTHEN intro (tclTHEN intro intro)))
+		       (tclTRY (tclLAST_HYP simplest_elim))))
+;;
+
+blast_tactic :=
+  (tclORELSE (tclCOMPLETE blast_auto)
+  (tclORELSE (tclCOMPLETE (tclTHEN blast_simpl blast_auto))
+  (tclORELSE (tclCOMPLETE (tclTHEN blast_induction1
+                          (tclTHEN blast_simpl blast_auto)))
+  (tclORELSE (tclCOMPLETE (tclTHEN blast_induction2
+                          (tclTHEN blast_simpl blast_auto)))
+             (tclCOMPLETE (tclTHEN blast_induction3
+                          (tclTHEN blast_simpl blast_auto)))))))
+;;
+(*
+blast_tactic := (tclTHEN (free_try default_full_auto)
+			 (free_try (my_full_eauto 4)))
+;;
+*)
+
+let vire_extvar s =
+   let interro = ref false in
+   let interro_pos = ref 0 in
+   for i=0 to (length s)-1 do
+     if get s i = '?'
+     then (interro := true;
+           interro_pos := i)
+     else if (!interro && 
+              (List.mem (get s i)
+			['0';'1';'2';'3';'4';'5';'6';'7';'8';'9']))
+     then set s i ' '
+     else interro:=false
+   done;
+   s
+;;
+
+let blast gls =
+   let leaf g = {
+      open_subgoals = 1;
+      goal = g;
+      ref = None } in
+     try (let (sgl,v) as res = !blast_tactic gls in
+	  let {it=lg} = sgl in
+          if lg = [] 
+          then (let pf = v (List.map leaf (sig_it sgl)) in
+                let sign = (sig_it gls).evar_hyps in
+                let x = print_subscript 
+                     (sig_sig gls) sign pf in
+		msgnl (hov 0 (str"Blast ==> " ++ x));
+                let x = print_subscript 
+                     (sig_sig gls) sign pf in
+                let tac_string =
+                pp_string  (hov 0 x ) in
+    (* on remplace les ?1 ?2 ... de refine par ? *)
+		parse_tac ((vire_extvar tac_string)
+			   ^ ".")
+	  )
+	  else (msgnl (hov 0 (str"Blast failed to prove the goal..."));
+		failwith "echec de blast"))
+     with _ -> failwith "echec de blast"
+;;
+
+let blast_tac display_function = function 
+          | (n::_) as l -> 
+                 (function g ->
+                    let exp_ast = (blast g) in
+                     (display_function exp_ast;
+                       tclIDTAC g))
+          |  _ -> failwith "expecting other arguments";;
+
+let blast_tac_txt = 
+  blast_tac
+    (function x -> msgnl(Pptactic.pr_glob_tactic (Tacinterp.glob_tactic x)));;
+
+(* Obsolète ?
+overwriting_add_tactic "Blast1" blast_tac_txt;;
+*)
+
+(*
+Grammar tactic ne_numarg_list : list :=
+  ne_numarg_single [numarg($n)] ->[$n]
+| ne_numarg_cons [numarg($n) ne_numarg_list($ns)] -> [ $n ($LIST $ns) ].
+Grammar tactic simple_tactic : ast :=
+  blast1 [ "Blast1" ne_numarg_list($ns) ] ->
+         [ (Blast1 ($LIST $ns)) ].
+
+
+
+PATH=/usr/local/bin:/usr/bin:$PATH
+COQTOP=d:/Tools/coq-7.0-3mai
+CAMLLIB=/usr/local/lib/ocaml
+CAMLP4LIB=/usr/local/lib/camlp4
+export CAMLLIB
+export COQTOP
+export CAMLP4LIB 
+d:/Tools/coq-7.0-3mai/bin/coqtop.byte.exe 
+Drop.
+#use "/cygdrive/D/Tools/coq-7.0-3mai/dev/base_include";;
+*)
diff --git a/contrib/interface/blast.mli b/contrib/interface/blast.mli
new file mode 100644
index 00000000..21c29bc9
--- /dev/null
+++ b/contrib/interface/blast.mli
@@ -0,0 +1,5 @@
+val blast_tac : (Tacexpr.raw_tactic_expr -> 'a) ->
+    int list ->
+    Proof_type.goal Tacmach.sigma ->
+    Proof_type.goal list Proof_type.sigma * Proof_type.validation;;
+
diff --git a/contrib/interface/centaur.ml4 b/contrib/interface/centaur.ml4
new file mode 100644
index 00000000..7bf12f3b
--- /dev/null
+++ b/contrib/interface/centaur.ml4
@@ -0,0 +1,700 @@
+(*i camlp4deps: "parsing/grammar.cma" i*)
+
+(*Toplevel loop for the communication between Coq and Centaur *)
+open Names;;
+open Nameops;;
+open Util;;
+open Ast;;
+open Term;;
+open Pp;;
+open Libnames;;
+open Libobject;;
+open Library;;
+open Vernacinterp;;
+open Evd;;
+open Proof_trees;;
+open Termast;;
+open Tacmach;;
+open Pfedit;;
+open Proof_type;;
+open Parsing;;
+open Environ;;
+open Declare;;
+open Declarations;;
+open Rawterm;;
+open Reduction;;
+open Classops;;
+open Vernacinterp;;
+open Vernac;;
+open Command;;
+open Protectedtoplevel;;
+open Coqast;;
+open Line_oriented_parser;;
+open Xlate;;
+open Vtp;;
+open Ascent;;
+open Translate;;
+open Name_to_ast;;
+open Pbp;;
+open Blast;;
+(* open Dad;; *)
+open Debug_tac;;
+open Search;;
+open Constrintern;;
+open Nametab;;
+open Showproof;;
+open Showproof_ct;;
+open Tacexpr;;
+open Vernacexpr;;
+
+let pcoq_started = ref None;;
+
+let if_pcoq f a =
+  if !pcoq_started <> None then f a else error "Pcoq is not started";;
+
+let text_proof_flag = ref "en";;
+
+let current_proof_name () = 
+  try 
+    string_of_id (get_current_proof_name ())
+  with
+      UserError("Pfedit.get_proof", _) -> "";;
+
+let current_goal_index = ref 0;;
+
+let guarded_force_eval_stream (s : std_ppcmds) = 
+  let l = ref [] in
+  let f elt = l:= elt :: !l in 
+  (try  Stream.iter f s with
+  | _ -> f (Stream.next (str "error guarded_force_eval_stream")));
+  Stream.of_list (List.rev !l);;
+
+
+let rec string_of_path p =
+    match p with [] -> "\n"
+              | i::p -> (string_of_int i)^" "^ (string_of_path p)
+;;
+let print_path p =
+    output_results_nl (str "Path:" ++ str  (string_of_path p))
+;;
+
+let kill_proof_node index =
+ let paths = History.historical_undo (current_proof_name()) index in
+ let _ =  List.iter
+            (fun path -> (traverse_to path;
+                          Pfedit.mutate weak_undo_pftreestate;
+			  traverse_to []))
+          paths in
+ History.border_length (current_proof_name());;
+
+
+(*Message functions, the text of these messages is recognized by the protocols *)
+(*of CtCoq                                                                     *)
+let ctf_header message_name request_id =
+ fnl () ++ str "message" ++ fnl() ++ str message_name ++ fnl() ++
+ int request_id ++ fnl();;
+
+let ctf_acknowledge_command request_id command_count opt_exn =
+  let goal_count, goal_index = 
+    if refining() then
+      let g_count =
+        List.length 
+          (fst (frontier (proof_of_pftreestate (get_pftreestate ())))) in
+        g_count, (min g_count !current_goal_index)
+    else
+      (0, 0) in
+   (ctf_header "acknowledge" request_id ++
+    int command_count ++ fnl() ++
+    int goal_count ++ fnl () ++
+    int goal_index ++ fnl () ++
+    str (current_proof_name()) ++ fnl() ++
+    (match opt_exn with
+      Some e -> Cerrors.explain_exn e
+    | None -> mt ()) ++ fnl() ++ str "E-n-d---M-e-s-s-a-g-e" ++ fnl ());;
+
+let ctf_undoResults = ctf_header "undo_results";;
+
+let ctf_TextMessage = ctf_header "text_proof";;
+
+let ctf_SearchResults = ctf_header "search_results";;
+
+let ctf_OtherGoal = ctf_header "other_goal";;
+
+let ctf_Location = ctf_header "location";;
+
+let ctf_StateMessage = ctf_header "state";;
+
+let ctf_PathGoalMessage () =
+ fnl () ++ str "message" ++ fnl () ++ str "single_goal" ++ fnl ();;
+
+let ctf_GoalReqIdMessage = ctf_header "single_goal_state";;
+
+let ctf_NewStateMessage = ctf_header "fresh_state";;
+
+let ctf_SavedMessage () = fnl () ++ str "message" ++ fnl () ++
+			  str "saved" ++ fnl();;
+
+let ctf_KilledMessage req_id ngoals =
+ ctf_header "killed" req_id ++ int ngoals ++ fnl ();;
+
+let ctf_AbortedAllMessage () =
+  fnl() ++ str "message" ++ fnl() ++ str "aborted_all" ++ fnl();;
+
+let ctf_AbortedMessage request_id na =
+  ctf_header "aborted_proof" request_id ++ str na ++ fnl () ++ 
+  str "E-n-d---M-e-s-s-a-g-e" ++ fnl ();;
+
+let ctf_UserErrorMessage request_id stream =
+ let stream = guarded_force_eval_stream stream in
+ ctf_header "user_error" request_id ++ stream ++ fnl() ++
+ str "E-n-d---M-e-s-s-a-g-e" ++ fnl();;
+
+let ctf_ResetInitialMessage () =
+ fnl () ++ str "message" ++ fnl () ++ str "reset_initial" ++ fnl ();;
+
+let ctf_ResetIdentMessage request_id s =
+ ctf_header "reset_ident" request_id ++ str s ++ fnl () ++
+  str  "E-n-d---M-e-s-s-a-g-e" ++ fnl();;
+
+type vtp_tree =
+  | P_rl of ct_RULE_LIST
+  | P_r of ct_RULE
+  | P_s_int of ct_SIGNED_INT_LIST
+  | P_pl of ct_PREMISES_LIST
+  | P_cl of ct_COMMAND_LIST
+  | P_t of ct_TACTIC_COM
+  | P_text of ct_TEXT
+  | P_ids of ct_ID_LIST;;
+
+let print_tree t = 
+  (match t with
+  | P_rl x -> fRULE_LIST x
+  | P_r x -> fRULE x
+  | P_s_int x -> fSIGNED_INT_LIST x
+  | P_pl x -> fPREMISES_LIST x
+  | P_cl x -> fCOMMAND_LIST x
+  | P_t x -> fTACTIC_COM x
+  | P_text x -> fTEXT x
+  | P_ids x -> fID_LIST x);
+  print_string "e\nblabla\n";;
+
+
+
+let break_happened = ref false;;
+
+let output_results stream vtp_tree =
+    let _ = Sys.signal Sys.sigint
+       (Sys.Signal_handle(fun i -> (break_happened := true;()))) in
+    msg stream;
+    match vtp_tree with
+      Some t -> print_tree t
+    | None -> ();;
+
+let output_results_nl stream =
+    let _ = Sys.signal Sys.sigint
+       (Sys.Signal_handle(fun i -> break_happened := true;()))
+    in
+    msgnl stream;;
+
+
+let rearm_break () =
+    let _ = Sys.signal Sys.sigint (Sys.Signal_handle(fun i -> raise Sys.Break))
+    in ();;
+
+let check_break () =
+   if (!break_happened) then
+    begin
+      break_happened := false;
+      raise Sys.Break
+    end
+   else ();;
+
+let print_past_goal index =
+ let path = History.get_path_for_rank (current_proof_name()) index in
+ try traverse_to path;
+     let pf = proof_of_pftreestate (get_pftreestate ()) in
+     output_results  (ctf_PathGoalMessage ())
+       (Some (P_r (translate_goal pf.goal)))
+ with
+   | Invalid_argument s ->
+      ((try traverse_to [] with _ -> ());
+       error "No focused proof (No proof-editing in progress)")
+   | e -> (try traverse_to [] with _ -> ()); raise e
+;;
+
+let show_nth n =
+  try
+    let pf = proof_of_pftreestate (get_pftreestate()) in
+    if (!text_proof_flag<>"off") then
+       (if n=0
+	   then output_results (ctf_TextMessage !global_request_id)
+                               (Some (P_text (show_proof !text_proof_flag [])))
+           else			       
+	   let path = History.get_nth_open_path (current_proof_name()) n in
+	   output_results (ctf_TextMessage !global_request_id)
+                          (Some (P_text (show_proof !text_proof_flag path))))
+    else
+      output_results (ctf_GoalReqIdMessage !global_request_id)
+      (let goal = List.nth (fst (frontier pf))
+                   (n - 1) in
+      (Some (P_r (translate_goal goal))))
+  with
+  | Invalid_argument s -> 
+       error "No focused proof (No proof-editing in progress)";;
+
+(* The rest of the file contains commands that are changed from the plain
+   Coq distribution *)
+
+let ctv_SEARCH_LIST = ref ([] : ct_PREMISE list);;
+
+(*
+let filter_by_module_from_varg_list l =
+  let dir_list, b = Vernacentries.interp_search_restriction l in
+    Search.filter_by_module_from_list (dir_list, b);;
+*)
+
+let add_search (global_reference:global_reference) assumptions cstr =
+  try 
+  let id_string =
+    string_of_qualid (Nametab.shortest_qualid_of_global Idset.empty
+			global_reference) in
+  let ast = 
+    try
+      CT_premise (CT_ident id_string, translate_constr false assumptions cstr)
+    with Not_found ->
+      CT_premise (CT_ident id_string,
+                  CT_coerce_ID_to_FORMULA(
+                    CT_ident ("Error printing" ^ id_string))) in
+    ctv_SEARCH_LIST:= ast::!ctv_SEARCH_LIST
+  with e -> msgnl (str "add_search raised an exception"); raise e;;
+
+(*
+let make_error_stream node_string =
+  str "The syntax of " ++ str node_string ++
+  str " is inconsistent with the vernac interpreter entry";;
+*)
+
+let ctf_EmptyGoalMessage id =
+  fnl () ++ str "Empty Goal is a no-op.  Fun oh fun." ++ fnl ();;
+
+
+let print_check judg =
+ let {uj_val=value; uj_type=typ} = judg in
+ let value_ct_ast = 
+     (try translate_constr false (Global.env()) value 
+      with UserError(f,str) ->
+           raise(UserError(f,
+			   Ast.print_ast 
+				(ast_of_constr true (Global.env()) value) ++
+			      fnl () ++ str ))) in
+ let type_ct_ast =
+     (try translate_constr false (Global.env()) typ
+      with UserError(f,str) ->
+           raise(UserError(f, Ast.print_ast (ast_of_constr true (Global.env())
+					       value) ++ fnl() ++ str))) in
+ ((ctf_SearchResults !global_request_id),
+ (Some  (P_pl
+  (CT_premises_list
+  [CT_coerce_TYPED_FORMULA_to_PREMISE
+    (CT_typed_formula(value_ct_ast,type_ct_ast)
+    )]))));;
+
+let ct_print_eval ast red_fun env judg =
+((if refining() then traverse_to []);
+let {uj_val=value; uj_type=typ} = judg in
+let nvalue = red_fun value
+(* // Attention , ici il faut peut être utiliser des environnemenst locaux *)
+and ntyp = nf_betaiota typ in
+(ctf_SearchResults !global_request_id,
+ Some (P_pl
+  (CT_premises_list
+  [CT_eval_result
+    (xlate_formula ast,
+    translate_constr false env nvalue,
+    translate_constr false env ntyp)]))));;
+
+
+
+(* The following function is copied from globpr in env/printer.ml *)
+let globcv x =
+    match x with
+      | Node(_,"MUTIND", (Path(_,sp))::(Num(_,tyi))::_) ->
+	    convert_qualid
+	      (Nametab.shortest_qualid_of_global Idset.empty (IndRef(sp,tyi)))
+      | Node(_,"MUTCONSTRUCT",(Path(_,sp))::(Num(_,tyi))::(Num(_,i))::_) ->
+	  convert_qualid
+            (Nametab.shortest_qualid_of_global Idset.empty
+	       (ConstructRef ((sp, tyi), i)))
+  | _ -> failwith "globcv : unexpected value";;
+
+let pbp_tac_pcoq =
+    pbp_tac (function (x:raw_tactic_expr) -> 
+      output_results
+        (ctf_header "pbp_results" !global_request_id)
+       (Some (P_t(xlate_tactic x))));;
+
+let blast_tac_pcoq =
+    blast_tac (function (x:raw_tactic_expr) -> 
+      output_results
+	(ctf_header "pbp_results" !global_request_id)
+       (Some (P_t(xlate_tactic x))));;
+
+(* <\cpa> 
+let dad_tac_pcoq =
+  dad_tac(function x -> 
+    output_results
+    (ctf_header "pbp_results" !global_request_id)
+    (Some (P_t(xlate_tactic x))));;
+</cpa> *)
+
+let search_output_results () =
+  output_results
+       (ctf_SearchResults !global_request_id)
+       (Some (P_pl (CT_premises_list
+                      (List.rev !ctv_SEARCH_LIST))));;
+
+
+let debug_tac2_pcoq tac =
+      (fun g ->
+	let the_goal = ref (None : goal sigma option) in
+	let the_ast = ref tac in
+	let the_path = ref ([] : int list) in
+	try
+	  let result = report_error tac the_goal the_ast the_path [] g in
+	  (errorlabstrm "DEBUG TACTIC"
+	     (str "no error here " ++ fnl () ++ pr_goal (sig_it g) ++
+	      fnl () ++ str "the tactic is" ++ fnl () ++
+	      Pptactic.pr_glob_tactic tac);
+	   result)
+	with
+	  e ->
+	    match !the_goal with
+	      None -> raise e
+	    | Some g -> 
+                (output_results
+		   (ctf_Location !global_request_id)
+		   (Some (P_s_int
+			    (CT_signed_int_list
+                               (List.map
+                                  (fun n -> CT_coerce_INT_to_SIGNED_INT
+                                                 (CT_int n))
+                                  (clean_path tac 
+					       (List.rev !the_path)))))));
+	    	(output_results
+		   (ctf_OtherGoal !global_request_id)
+		   (Some (P_r (translate_goal (sig_it g)))));
+	    raise e);;
+
+let rec selectinspect n env =
+    match env with
+      [] -> []
+    | a::tl ->
+      if n = 0 then
+         []
+      else
+         match a with
+           (sp, Lib.Leaf lobj) -> a::(selectinspect (n -1 ) tl)
+         | _ -> (selectinspect n tl);;
+
+open Term;;
+
+let inspect n =
+  let env = Global.env() in
+  let add_search2 x y = add_search x env y in
+  let l = selectinspect n (Lib.contents_after None) in
+    ctv_SEARCH_LIST := [];
+    List.iter
+      (fun a ->
+	 try
+           (match a with
+             	oname, Lib.Leaf lobj ->
+		  (match oname, object_tag lobj with
+                       (sp,_), "VARIABLE" ->
+			 let (_, _, v) = get_variable (basename sp) in
+			   add_search2 (Nametab.locate (qualid_of_sp sp)) v
+		     | (sp,kn), "CONSTANT" ->
+			 let {const_type=typ} = Global.lookup_constant kn in
+			   add_search2 (Nametab.locate (qualid_of_sp sp)) typ
+		     | (sp,kn), "MUTUALINDUCTIVE" ->
+			 add_search2 (Nametab.locate (qualid_of_sp sp))
+			   (Pretyping.understand Evd.empty (Global.env())
+			      (RRef(dummy_loc, IndRef(kn,0))))
+		     | _ -> failwith ("unexpected value 1 for "^ 
+				      (string_of_id (basename (fst oname)))))
+              | _ -> failwith "unexpected value")
+	 with e -> ())
+      l;
+    output_results
+      (ctf_SearchResults !global_request_id)
+      (Some
+         (P_pl (CT_premises_list (List.rev !ctv_SEARCH_LIST))));;
+
+let ct_int_to_TARG n = 
+	CT_coerce_FORMULA_OR_INT_to_TARG
+	  (CT_coerce_ID_OR_INT_to_FORMULA_OR_INT
+	     (CT_coerce_INT_to_ID_OR_INT (CT_int n)));;
+
+let pair_list_to_ct l =
+    CT_user_tac(CT_ident "pair_int_list",
+		CT_targ_list
+		  (List.map (fun (a,b) ->
+			       CT_coerce_TACTIC_COM_to_TARG
+				 (CT_user_tac
+				    (CT_ident "pair_int",
+				     CT_targ_list
+				       [ct_int_to_TARG a; ct_int_to_TARG b])))
+		     l));;
+
+(* Annule toutes les commandes qui s'appliquent sur les sous-buts du
+   but auquel a été appliquée la n-ième tactique *)
+let logical_kill n =
+  let path = History.get_path_for_rank (current_proof_name()) n in
+  begin
+    traverse_to path;
+    Pfedit.mutate weak_undo_pftreestate;
+    (let kept_cmds, undone_cmds, remaining_goals, current_goal =
+      History.logical_undo (current_proof_name()) n in
+       output_results (ctf_undoResults !global_request_id)
+	 (Some
+	    (P_t
+	       (CT_user_tac
+		  (CT_ident "log_undo_result",
+		   CT_targ_list
+		     [CT_coerce_TACTIC_COM_to_TARG (pair_list_to_ct kept_cmds);
+		      CT_coerce_TACTIC_COM_to_TARG(pair_list_to_ct undone_cmds);
+		      ct_int_to_TARG remaining_goals;
+		      ct_int_to_TARG current_goal])))));
+    traverse_to []
+  end;;
+
+let simulate_solve n tac =
+  let path = History.get_nth_open_path (current_proof_name()) n in
+  solve_nth n (Tacinterp.hide_interp tac (get_end_tac()));
+  traverse_to path;
+  Pfedit.mutate weak_undo_pftreestate;
+  traverse_to []
+
+let kill_node_verbose n =
+  let ngoals = kill_proof_node n in
+  output_results_nl (ctf_KilledMessage !global_request_id ngoals)
+
+let set_text_mode s = text_proof_flag := s
+
+let pcoq_reset_initial() =
+  output_results(ctf_AbortedAllMessage()) None;
+  Vernacentries.abort_refine Lib.reset_initial ();
+  output_results(ctf_ResetInitialMessage()) None;;
+
+let pcoq_reset x =
+  if refining() then
+    output_results (ctf_AbortedAllMessage ()) None;
+    Vernacentries.abort_refine Lib.reset_name (dummy_loc,x);
+    output_results
+      (ctf_ResetIdentMessage !global_request_id (string_of_id x)) None;;
+
+
+VERNAC ARGUMENT EXTEND text_mode
+| [ "fr" ] -> [ "fr" ]
+| [ "en" ] -> [ "en" ]
+| [ "Off" ] -> [ "off" ]
+END
+
+VERNAC COMMAND EXTEND TextMode
+| [ "Text" "Mode" text_mode(s) ] -> [ set_text_mode s ]
+END
+
+VERNAC COMMAND EXTEND OutputGoal
+  [ "Goal" ] -> [ output_results_nl(ctf_EmptyGoalMessage "") ]
+END
+
+VERNAC COMMAND EXTEND OutputGoal
+  [ "Goal" "Cmd" natural(n) "with" tactic(tac) ] -> [ simulate_solve n tac ]
+END
+
+VERNAC COMMAND EXTEND KillProofAfter
+| [ "Kill" "Proof" "after"  natural(n) ] -> [ kill_node_verbose n ]
+END
+
+VERNAC COMMAND EXTEND KillProofAt
+| [ "Kill" "Proof" "at"  natural(n) ] -> [ kill_node_verbose n ]
+END
+
+VERNAC COMMAND EXTEND KillSubProof
+  [ "Kill" "SubProof" natural(n) ] -> [ logical_kill n ]
+END
+
+VERNAC COMMAND EXTEND PcoqReset
+  [ "Pcoq" "Reset" ident(x) ] -> [ pcoq_reset x ]
+END
+
+VERNAC COMMAND EXTEND PcoqResetInitial
+  [ "Pcoq" "ResetInitial" ] -> [ pcoq_reset_initial() ]
+END
+
+let start_proof_hook () =
+  History.start_proof (current_proof_name());
+  current_goal_index := 1
+
+let solve_hook n =
+  let name = current_proof_name () in
+  let old_n_count = History.border_length name in
+  let pf = proof_of_pftreestate (get_pftreestate ()) in
+  let n_goals = (List.length (fst (frontier pf))) + 1 - old_n_count in
+  begin
+    current_goal_index := n;
+    History.push_command name  n n_goals
+  end
+
+let abort_hook s = output_results_nl (ctf_AbortedMessage !global_request_id s)
+
+let interp_search_about_item = function
+  | SearchRef qid -> GlobSearchRef (Nametab.global qid)
+  | SearchString s -> GlobSearchString s
+
+let pcoq_search s l =
+  ctv_SEARCH_LIST:=[];
+  begin match s with
+  | SearchAbout sl -> 
+      raw_search_about (filter_by_module_from_list l) add_search
+	(List.map interp_search_about_item sl)
+  | SearchPattern c ->
+      let _,pat = interp_constrpattern Evd.empty (Global.env()) c in
+      raw_pattern_search (filter_by_module_from_list l) add_search pat
+  | SearchRewrite c ->
+      let _,pat = interp_constrpattern Evd.empty (Global.env()) c in
+      raw_search_rewrite (filter_by_module_from_list l) add_search pat;
+  | SearchHead locqid ->
+      filtered_search
+	(filter_by_module_from_list l) add_search (Nametab.global locqid)
+  end;
+  search_output_results()
+
+(* Check sequentially whether the pattern is one of the premises *)
+let rec hyp_pattern_filter pat name a c =
+  let c1 = strip_outer_cast c in
+    match kind_of_term c with
+      | Prod(_, hyp, c2) -> 
+	  (try
+(*	     let _ = msgnl ((str "WHOLE ") ++ (Printer.prterm c)) in
+             let _ = msgnl ((str "PAT ") ++ (Printer.pr_pattern pat)) in *)
+             if Matching.is_matching pat hyp then
+	       (msgnl (str "ok"); true)
+	     else
+	       false
+           with UserError _ -> false) or
+	  hyp_pattern_filter pat name a c2
+      | _ -> false;;
+
+let hyp_search_pattern c l =
+  let _, pat = interp_constrpattern Evd.empty (Global.env()) c in
+    ctv_SEARCH_LIST := [];
+    gen_filtered_search
+      (fun s a c -> (filter_by_module_from_list l s a c &&
+		     (if hyp_pattern_filter pat s a c then
+		   	(msgnl (str "ok2"); true) else false)))
+      (fun s a c -> (msgnl (str "ok3"); add_search s a c));
+    output_results
+      (ctf_SearchResults !global_request_id)
+      (Some
+	 (P_pl (CT_premises_list (List.rev !ctv_SEARCH_LIST))));;
+let pcoq_print_name ref =
+  let results = xlate_vernac_list (name_to_ast ref) in
+  output_results 
+    (fnl () ++ str "message" ++ fnl () ++ str "PRINT_VALUE" ++ fnl ())
+    (Some (P_cl results))
+
+let pcoq_print_check j =
+  let a,b = print_check j in output_results a b
+
+let pcoq_print_eval redfun env c j =
+  let strm, vtp = ct_print_eval c redfun env j in
+  output_results strm vtp;;
+
+open Vernacentries
+
+let pcoq_show_goal = function
+  | Some n -> show_nth n
+  | None ->
+      if !pcoq_started = Some true (* = debug *) then
+	msg (Pfedit.pr_open_subgoals ())
+      else errorlabstrm "show_goal"
+	(str "Show must be followed by an integer in Centaur mode");;
+
+let pcoq_hook = {
+  start_proof = start_proof_hook;
+  solve = solve_hook;
+  abort = abort_hook;
+  search = pcoq_search;
+  print_name = pcoq_print_name;
+  print_check = pcoq_print_check;
+  print_eval = pcoq_print_eval;
+  show_goal = pcoq_show_goal
+}
+
+
+TACTIC EXTEND Pbp
+| [ "Pbp" ident_opt(idopt) natural_list(nl) ] -> 
+    [ if_pcoq pbp_tac_pcoq idopt nl ]
+END
+
+TACTIC EXTEND CtDebugTac
+| [ "DebugTac" tactic(t) ] -> [ if_pcoq debug_tac2_pcoq (fst t) ]
+END
+
+TACTIC EXTEND CtDebugTac2
+| [ "DebugTac2" tactic(t) ] -> [ if_pcoq debug_tac2_pcoq (fst t) ]
+END
+
+
+let start_pcoq_mode debug = 
+  begin
+    pcoq_started := Some debug;
+(* <\cpa> 
+    start_dad();
+</cpa> *)
+    declare_in_coq();
+(* The following ones are added to enable rich comments in pcoq *)
+(* TODO ...
+    add_tactic "Image" (fun _ -> tclIDTAC);
+*)
+(* "Comments" moved to Vernacentries, other obsolete ?
+    List.iter (fun (a,b) -> vinterp_add a b) command_creations;
+*)
+(* Now hooks in Vernacentries
+    List.iter (fun (a,b) -> overwriting_vinterp_add a b) command_changes;
+    if not debug then
+      List.iter (fun (a,b) -> overwriting_vinterp_add a b) non_debug_changes;
+*)
+    set_pcoq_hook pcoq_hook;
+  end;;
+
+
+let start_pcoq () =
+  start_pcoq_mode false;
+  set_acknowledge_command ctf_acknowledge_command;
+  set_start_marker "CENTAUR_RESERVED_TOKEN_start_command";
+  set_end_marker "CENTAUR_RESERVED_TOKEN_end_command";
+  raise Vernacexpr.ProtectedLoop;;
+
+let start_pcoq_debug () =
+  start_pcoq_mode true;
+  set_acknowledge_command ctf_acknowledge_command;
+  set_start_marker "--->";
+  set_end_marker "<---";
+  raise Vernacexpr.ProtectedLoop;;
+
+VERNAC COMMAND EXTEND HypSearchPattern
+  [ "HypSearchPattern" constr(pat) ] -> [ hyp_search_pattern pat ([], false) ]
+END
+
+VERNAC COMMAND EXTEND StartPcoq
+  [ "Start" "Pcoq" "Mode" ] -> [ start_pcoq () ]
+END
+
+VERNAC COMMAND EXTEND Pcoq_inspect
+  [ "Pcoq_inspect" ] -> [ inspect 15 ]
+END
+
+VERNAC COMMAND EXTEND StartPcoqDebug
+| [ "Start" "Pcoq" "Debug" "Mode" ] -> [ start_pcoq_debug () ]
+END
diff --git a/contrib/interface/ctast.ml b/contrib/interface/ctast.ml
new file mode 100644
index 00000000..67279bb8
--- /dev/null
+++ b/contrib/interface/ctast.ml
@@ -0,0 +1,76 @@
+(* A copy of pre V7 ast *)
+
+open Names
+open Libnames
+
+type loc = Util.loc
+
+type t =
+  | Node of loc * string * t list
+  | Nvar of loc * string
+  | Slam of loc * string option * t
+  | Num of loc * int
+  | Id of loc * string
+  | Str of loc * string
+  | Path of loc * string list
+  | Dynamic of loc * Dyn.t
+
+let section_path sl =
+  match List.rev sl with
+    | s::pa ->
+	Libnames.encode_kn
+	  (make_dirpath (List.map id_of_string pa))
+	  (id_of_string s)
+    | [] -> invalid_arg "section_path"
+
+let is_meta s = String.length s > 0 && s.[0] == '$'
+
+let purge_str s =
+  if String.length s == 0 || s.[0] <> '$' then s
+  else String.sub s 1 (String.length s - 1)
+
+let rec ct_to_ast = function
+  | Node (loc,a,b) -> Coqast.Node (loc,a,List.map ct_to_ast b)
+  | Nvar (loc,a) ->
+      if is_meta a then Coqast.Nmeta (loc,purge_str a)
+      else Coqast.Nvar (loc,id_of_string a)
+  | Slam (loc,Some a,b) ->
+      if is_meta a then Coqast.Smetalam (loc,purge_str a,ct_to_ast b)
+      else Coqast.Slam (loc,Some (id_of_string a),ct_to_ast b)
+  | Slam (loc,None,b) -> Coqast.Slam (loc,None,ct_to_ast b)
+  | Num (loc,a) -> Coqast.Num (loc,a)
+  | Id (loc,a) -> Coqast.Id (loc,a)
+  | Str (loc,a) -> Coqast.Str (loc,a)
+  | Path (loc,sl) -> Coqast.Path (loc,section_path sl)
+  | Dynamic (loc,a) -> Coqast.Dynamic (loc,a)
+
+let rec ast_to_ct = function x -> failwith "ast_to_ct: not TODO?"
+(*
+  | Coqast.Node (loc,a,b) -> Node (loc,a,List.map ast_to_ct b)
+  | Coqast.Nvar (loc,a) -> Nvar (loc,string_of_id a)
+  | Coqast.Nmeta (loc,a) -> Nvar (loc,"$"^a)
+  | Coqast.Slam (loc,Some a,b) ->
+   Slam (loc,Some (string_of_id a),ast_to_ct b)
+  | Coqast.Slam (loc,None,b) -> Slam (loc,None,ast_to_ct b)
+  | Coqast.Smetalam (loc,a,b) -> Slam (loc,Some ("$"^a),ast_to_ct b)
+  | Coqast.Num (loc,a) -> Num (loc,a)
+  | Coqast.Id (loc,a) -> Id (loc,a)
+  | Coqast.Str (loc,a) -> Str (loc,a)
+  | Coqast.Path (loc,a) ->
+    let (sl,bn) = Libnames.decode_kn a in
+    Path(loc, (List.map string_of_id
+                (List.rev (repr_dirpath sl))) @ [string_of_id bn])
+  | Coqast.Dynamic (loc,a) -> Dynamic (loc,a)
+*)
+
+let loc = function
+  | Node (loc,_,_) -> loc
+  | Nvar (loc,_) -> loc
+  | Slam (loc,_,_) -> loc
+  | Num (loc,_) -> loc
+  | Id (loc,_) -> loc
+  | Str (loc,_) -> loc
+  | Path (loc,_) -> loc
+  | Dynamic (loc,_) -> loc
+
+let str s = Str(Util.dummy_loc,s)
diff --git a/contrib/interface/dad.ml b/contrib/interface/dad.ml
new file mode 100644
index 00000000..ec989296
--- /dev/null
+++ b/contrib/interface/dad.ml
@@ -0,0 +1,382 @@
+(* This file contains an ml version of drag-and-drop. *)
+
+(* #use "/net/home/bertot/experiments/pcoq/src/dad/dad.ml" *)
+
+open Names;;
+open Term;;
+open Rawterm;;
+open Util;;
+open Environ;;
+open Tactics;;
+open Tacticals;;
+open Pattern;;
+open Matching;;
+open Reduction;;
+open Constrextern;;
+open Constrintern;;
+open Vernacinterp;;
+open Libnames;;
+open Nametab
+
+open Proof_type;;
+open Proof_trees;;
+open Tacmach;;
+open Typing;;
+open Pp;;
+
+open Paths;;
+
+open Topconstr;;
+open Genarg;;
+open Tacexpr;;
+open Rawterm;;
+
+(* In a first approximation, drag-and-drop rules are like in CtCoq
+   1/ a pattern,
+   2,3/ Two paths: start and end positions,
+   4/ the degree: the number of steps the algorithm should go up from the
+      longest common prefix,
+   5/ the tail path: the suffix of the longest common prefix of length the
+      degree,
+   6/ the command pattern, where meta variables are represented by objects
+      of the form Node(_,"META"; [Num(_,i)])
+*)
+
+
+type dad_rule =
+    constr_expr * int list * int list * int * int list
+    * raw_atomic_tactic_expr;;
+
+(* This value will be used systematically when constructing objects *)
+
+let zz = Util.dummy_loc;;
+
+(* This function receives a length n, a path p, and a term and returns a
+   couple whose first component is the subterm designated by the prefix
+   of p of length n, and the second component is the rest of the path *)
+
+let rec get_subterm  (depth:int) (path: int list) (constr:constr) =
+  match depth, path, kind_of_term constr with
+    0, l, c -> (constr,l)
+  | n, 2::a::tl, App(func,arr) -> 
+      get_subterm (n - 2) tl arr.(a-1)
+  | _,l,_ -> failwith (int_list_to_string 
+                        "wrong path or wrong form of term"
+                        l);;
+
+(* This function maps a substitution on an abstract syntax tree.  The
+   first argument, an object of type env, is necessary to
+   transform constr terms into abstract syntax trees.  The second argument is
+   the substitution, a list of pairs linking an integer and a constr term. *)
+
+let rec map_subst (env :env) (subst:patvar_map) = function
+  | CPatVar (_,(_,i)) ->
+      let constr = List.assoc i subst in
+      extern_constr false env constr
+  | x -> map_constr_expr_with_binders (map_subst env) (fun _ x -> x) subst x;;
+
+let map_subst_tactic env subst = function
+  | TacExtend (loc,("Rewrite" as x),[b;cbl]) ->
+      let c,bl = out_gen rawwit_constr_with_bindings cbl in
+      assert (bl = NoBindings);
+      let c = (map_subst env subst c,NoBindings) in
+      TacExtend (loc,x,[b;in_gen rawwit_constr_with_bindings c])
+  | _ -> failwith "map_subst_tactic: unsupported tactic"
+
+(* This function is really the one that is important. *)
+let rec find_cmd (l:(string * dad_rule) list) env constr p p1 p2 =
+  match l with
+    [] -> failwith "nothing happens"
+  | (name, (pat, p_f, p_l, deg, p_r, cmd))::tl ->
+     let length = List.length p in
+     try
+       if deg > length then
+         failwith "internal"
+       else
+         let term_to_match, p_r = 
+             try 
+                get_subterm (length - deg) p constr
+             with
+                Failure s -> failwith "internal" in
+         let _, constr_pat = 
+            interp_constrpattern Evd.empty (Global.env())
+               ((*ct_to_ast*) pat) in
+         let subst = matches constr_pat term_to_match in
+         if (is_prefix p_f (p_r@p1)) & (is_prefix p_l (p_r@p2)) then
+           TacAtom (zz, map_subst_tactic env subst cmd)
+         else
+	   failwith "internal"
+     with
+       Failure "internal" -> find_cmd tl env constr p p1 p2
+     | PatternMatchingFailure -> find_cmd tl env constr p p1 p2;;
+
+
+let dad_rule_list = ref ([]: (string * dad_rule) list);;
+
+(*
+(* \\ This function is also used in pbp. *)
+let rec tactic_args_to_ints = function
+    [] -> []
+  | (Integer n)::l -> n::(tactic_args_to_ints l)
+  | _ -> failwith "expecting only numbers";;
+
+(* We assume that the two lists of integers for the tactic are simply
+   given in one list, separated by a dummy tactic. *)
+let rec part_tac_args l = function
+    [] -> l,[]
+  | (Tacexp a)::tl -> l, (tactic_args_to_ints tl)
+  | (Integer n)::tl -> part_tac_args (n::l) tl
+  | _ -> failwith "expecting only numbers and the word \"to\"";;
+
+
+(* The dad_tac tactic takes a display_function as argument.  This makes
+   it possible to use it in pcoq, but also in other contexts, just by
+   changing the output routine. *)
+let dad_tac display_function = function
+   l -> let p1, p2 = part_tac_args [] l in
+        (function g ->
+           let (p_a, p1prime, p2prime) = decompose_path (List.rev p1,p2) in
+           (display_function 
+            (find_cmd (!dad_rule_list) (pf_env g)
+	       (pf_concl g) p_a p1prime p2prime));
+            tclIDTAC g);;
+*)
+let dad_tac display_function p1 p2 g =
+  let (p_a, p1prime, p2prime) = decompose_path (p1,p2) in
+  (display_function 
+    (find_cmd (!dad_rule_list) (pf_env g) (pf_concl g) p_a p1prime p2prime));
+  tclIDTAC g;;
+
+(* Now we enter dad rule list management. *)
+
+let add_dad_rule name patt p1 p2 depth pr command =
+  dad_rule_list := (name, 
+		    (patt, p1, p2, depth, pr, command))::!dad_rule_list;;
+
+let rec remove_if_exists name = function
+    [] -> false, []
+  | ((a,b) as rule1)::tl -> if a = name then 
+               let result1, l = (remove_if_exists name tl) in
+               true, l
+             else
+               let result1, l = remove_if_exists name tl in
+               result1, (rule1::l);;
+
+let remove_dad_rule name =
+  let result1, result2 = remove_if_exists name !dad_rule_list in
+  if result1 then
+    failwith("No such name among the drag and drop rules " ^ name)
+  else
+     dad_rule_list := result2;;
+
+let dad_rule_names () =
+    List.map (function (s,_) -> s) !dad_rule_list;;
+
+(* this function is inspired from matches_core in pattern.ml *)
+let constrain ((n : patvar),(pat : constr_pattern)) sigma =
+  if List.mem_assoc n sigma then
+    if pat = (List.assoc n sigma) then sigma
+    else failwith "internal"
+  else 
+    (n,pat)::sigma
+    
+(* This function is inspired from matches_core in pattern.ml *)
+let more_general_pat pat1 pat2 = 
+  let rec match_rec sigma p1 p2 =
+    match p1, p2 with
+      | PMeta (Some n), m -> constrain (n,m) sigma
+
+      | PMeta None, m -> sigma
+
+      | PRef (VarRef sp1), PRef(VarRef sp2) when sp1 = sp2 -> sigma
+
+      | PVar v1, PVar v2 when v1 = v2 -> sigma
+
+      | PRef ref1, PRef ref2 when ref1 = ref2 -> sigma
+
+      | PRel n1, PRel n2 when n1 = n2 -> sigma
+
+      | PSort (RProp c1), PSort (RProp c2) when c1 = c2 -> sigma
+
+      | PSort (RType _), PSort (RType _) -> sigma
+
+      | PApp (c1,arg1), PApp (c2,arg2) ->
+        (try array_fold_left2 match_rec (match_rec sigma c1 c2) arg1 arg2
+         with Invalid_argument _ -> failwith "internal")
+      | _ -> failwith "unexpected case in more_general_pat" in 
+  try let _ = match_rec [] pat1 pat2 in true
+  with Failure "internal" -> false;;
+
+let more_general r1 r2 =
+  match r1,r2 with
+    (_,(patt1,p11,p12,_,_,_)),
+    (_,(patt2,p21,p22,_,_,_)) ->
+	(more_general_pat patt1 patt2) &
+      (is_prefix p11 p21) & (is_prefix p12 p22);;
+
+let not_less_general r1 r2 = 
+  not (match r1,r2 with
+    (_,(patt1,p11,p12,_,_,_)),
+    (_,(patt2,p21,p22,_,_,_)) ->
+	(more_general_pat patt1 patt2) &
+      (is_prefix p21 p11) & (is_prefix p22 p12));;
+
+let rec add_in_list_sorting rule1 = function
+    [] -> [rule1]
+  | (b::tl) as this_list ->
+      if more_general rule1 b  then
+	b::(add_in_list_sorting rule1 tl)
+      else if not_less_general rule1 b then
+	let tl2 = add_in_list_sorting_aux rule1 tl in
+	(match tl2 with
+	  [] -> rule1::this_list
+	| _ -> b::tl2)
+      else
+	rule1::this_list
+and add_in_list_sorting_aux rule1 = function
+    [] -> []
+  | b::tl -> 
+      if more_general rule1 b then
+      	b::(add_in_list_sorting rule1 tl)
+      else
+	let tl2 = add_in_list_sorting_aux rule1 tl in
+	(match tl2 with
+	  [] -> []
+	| _ -> rule1::tl2);;
+
+let rec sort_list = function
+    [] -> [] 
+  | a::l -> add_in_list_sorting a (sort_list l);;
+
+let mk_dad_meta n = CPatVar (zz,(true,Nameops.make_ident "DAD" (Some n)));;
+let mk_rewrite lr ast =
+  let b = in_gen rawwit_bool lr in
+  let cb = in_gen rawwit_constr_with_bindings ((*Ctast.ct_to_ast*) ast,NoBindings) in
+  TacExtend (zz,"Rewrite",[b;cb])
+
+open Vernacexpr
+
+let dad_status = ref false;;
+
+let start_dad () = dad_status := true;;
+
+let add_dad_rule_fn name pat p1 p2 tac =
+  let pr = match decompose_path (p1, p2) with pr, _, _ -> pr in
+  add_dad_rule name pat p1 p2 (List.length pr) pr tac;;
+
+(* To be parsed by camlp4
+
+(*i camlp4deps: "parsing/grammar.cma" i*)
+
+VERNAC COMMAND EXTEND AddDadRule
+  [ "Add" "Dad" "Rule" string(name) constr(pat)
+    "From" natural_list(p1) "To" natural_list(p2) tactic(tac) ] ->
+  [ add_dad_rule_fn name pat p1 p2 tac ]
+END
+
+*)
+
+let mk_id s = mkIdentC (id_of_string s);;
+let mkMetaC = mk_dad_meta;;
+
+add_dad_rule "distributivity-inv"
+(mkAppC(mk_id("mult"),[mkAppC(mk_id("plus"),[mkMetaC(4);mkMetaC(3)]);mkMetaC(2)]))
+[2; 2]
+[2; 1]
+1
+[2]
+(mk_rewrite true (mkAppC(mk_id( "mult_plus_distr"),[(mk_dad_meta 4) ;(mk_dad_meta 3) ;(mk_dad_meta 2) ])));
+
+add_dad_rule "distributivity1-r"
+(mkAppC(mk_id("plus"),[mkAppC(mk_id("mult"),[mkMetaC(4);mkMetaC(2)]);mkAppC(mk_id("mult"),[mkMetaC(3);mkMetaC(2)])]))
+[2; 2; 2; 2]
+[]
+0
+[]
+(mk_rewrite false (mkAppC(mk_id("mult_plus_distr"),[(mk_dad_meta 4) ;(mk_dad_meta 3) ;(mk_dad_meta 2) ])));
+
+add_dad_rule "distributivity1-l"
+(mkAppC(mk_id("plus"),[mkAppC(mk_id("mult"),[mkMetaC(4);mkMetaC(2)]);mkAppC(mk_id("mult"),[mkMetaC(3);mkMetaC(2)])]))
+[2; 1; 2; 2]
+[]
+0
+[]
+(mk_rewrite false (mkAppC(mk_id( "mult_plus_distr"),[(mk_dad_meta 4) ;(mk_dad_meta 3) ;(mk_dad_meta 2) ])));
+
+add_dad_rule "associativity"
+(mkAppC(mk_id("plus"),[mkAppC(mk_id("plus"),[mkMetaC(4);mkMetaC(3)]);mkMetaC(2)]))
+[2; 1]
+[]
+0
+[]
+(mk_rewrite true (mkAppC(mk_id( "plus_assoc_r"),[(mk_dad_meta 4) ;(mk_dad_meta 3) ;(mk_dad_meta 2) ])));
+
+add_dad_rule "minus-identity-lr"
+(mkAppC(mk_id("minus"),[mkMetaC(2);mkMetaC(2)]))
+[2; 1]
+[2; 2]
+1
+[2]
+(mk_rewrite false (mkAppC(mk_id( "minus_n_n"),[(mk_dad_meta 2) ])));
+
+add_dad_rule "minus-identity-rl"
+(mkAppC(mk_id("minus"),[mkMetaC(2);mkMetaC(2)]))
+[2; 2]
+[2; 1]
+1
+[2]
+(mk_rewrite false (mkAppC(mk_id( "minus_n_n"),[(mk_dad_meta 2) ])));
+
+add_dad_rule "plus-sym-rl"
+(mkAppC(mk_id("plus"),[mkMetaC(3);mkMetaC(2)]))
+[2; 2]
+[2; 1]
+1
+[2]
+(mk_rewrite true (mkAppC(mk_id( "plus_sym"),[(mk_dad_meta 3) ;(mk_dad_meta 2) ])));
+
+add_dad_rule "plus-sym-lr"
+(mkAppC(mk_id("plus"),[mkMetaC(3);mkMetaC(2)]))
+[2; 1]
+[2; 2]
+1
+[2]
+(mk_rewrite true (mkAppC(mk_id( "plus_sym"),[(mk_dad_meta 3) ;(mk_dad_meta 2) ])));
+
+add_dad_rule "absorb-0-r-rl"
+(mkAppC(mk_id("plus"),[mkMetaC(2);mk_id("O")]))
+[2; 2]
+[1]
+0
+[]
+(mk_rewrite false (mkAppC(mk_id( "plus_n_O"),[(mk_dad_meta 2) ])));
+
+add_dad_rule "absorb-0-r-lr"
+(mkAppC(mk_id("plus"),[mkMetaC(2);mk_id("O")]))
+[1]
+[2; 2]
+0
+[]
+(mk_rewrite false (mkAppC(mk_id( "plus_n_O"),[(mk_dad_meta 2) ])));
+
+add_dad_rule "plus-permute-lr"
+(mkAppC(mk_id("plus"),[mkMetaC(4);mkAppC(mk_id("plus"),[mkMetaC(3);mkMetaC(2)])]))
+[2; 1]
+[2; 2; 2; 1]
+1
+[2]
+(mk_rewrite true (mkAppC(mk_id( "plus_permute"),[(mk_dad_meta 4) ;(mk_dad_meta 3) ;(mk_dad_meta 2) ])));
+
+add_dad_rule "plus-permute-rl"
+(mkAppC(mk_id("plus"),[mkMetaC(4);mkAppC(mk_id("plus"),[mkMetaC(3);mkMetaC(2)])]))
+[2; 2; 2; 1]
+[2; 1]
+1
+[2]
+(mk_rewrite true (mkAppC(mk_id( "plus_permute"),[(mk_dad_meta 4) ;(mk_dad_meta 3) ;(mk_dad_meta 2) ])));;
+
+vinterp_add "StartDad"
+   (function
+     | [] ->
+       (function () -> start_dad())
+     | _ -> errorlabstrm "StartDad" (mt()));;
diff --git a/contrib/interface/dad.mli b/contrib/interface/dad.mli
new file mode 100644
index 00000000..f556c192
--- /dev/null
+++ b/contrib/interface/dad.mli
@@ -0,0 +1,10 @@
+open Proof_type;;
+open Tacmach;;
+open Topconstr;;
+
+val dad_rule_names : unit -> string list;;
+val start_dad : unit -> unit;;
+val dad_tac : (Tacexpr.raw_tactic_expr -> 'a) -> int list -> int list -> goal sigma ->
+                  goal list sigma * validation;;
+val add_dad_rule : string -> constr_expr -> (int list) -> (int list) ->
+                   int -> (int list) -> Tacexpr.raw_atomic_tactic_expr -> unit;;
diff --git a/contrib/interface/debug_tac.ml4 b/contrib/interface/debug_tac.ml4
new file mode 100644
index 00000000..bf596b28
--- /dev/null
+++ b/contrib/interface/debug_tac.ml4
@@ -0,0 +1,570 @@
+(*i camlp4deps: "parsing/grammar.cma" i*)
+
+open Ast;;
+open Coqast;;
+open Tacmach;;
+open Tacticals;;
+open Proof_trees;;
+open Pp;;
+open Pptactic;;
+open Util;;
+open Proof_type;;
+open Tacexpr;;
+open Genarg;;
+
+(* Compacting and uncompacting proof commands *)
+
+type report_tree =
+    Report_node of bool *int * report_tree list
+  | Mismatch of int * int
+  | Tree_fail of report_tree
+  | Failed of int;;
+
+type report_card =
+    Ngoals of int
+  | Goals_mismatch of int
+  | Recursive_fail of report_tree
+  | Fail;;
+
+type card_holder = report_card ref;;
+type report_holder = report_tree list ref;;
+
+(* This tactical receives an integer and a tactic and checks that the
+   tactic produces that number of goals.  It never fails but signals failure
+   by updating the boolean reference given as third argument to false.
+   It is especially suited for use in checked_thens below. *)
+
+let check_subgoals_count : card_holder -> int -> bool ref -> tactic -> tactic =
+  fun card_holder count flag t g ->
+    try
+      let (gls, v) as result = t g in
+      let len = List.length (sig_it gls) in
+      card_holder :=
+      (if len = count then
+	  (flag := true;
+	  Ngoals count)
+       else
+          (flag := false;
+          Goals_mismatch len));
+      result
+    with
+      e -> card_holder := Fail;
+           flag := false;
+           tclIDTAC g;;
+
+let no_failure = function
+    [Report_node(true,_,_)] -> true
+  | _ -> false;;
+
+let check_subgoals_count2 
+    : card_holder -> int -> bool ref -> (report_holder -> tactic) -> tactic =
+  fun card_holder count flag t g ->
+    let new_report_holder = ref ([] : report_tree list) in
+    let (gls, v) as result = t new_report_holder g in
+    let succeeded = no_failure !new_report_holder in
+    let len = List.length (sig_it gls) in
+    card_holder :=
+      (if (len = count) & succeeded then
+	(flag := true;
+	 Ngoals count)
+      else
+	(flag := false;
+	 Recursive_fail (List.hd !new_report_holder)));
+    result;;
+
+(*
+let traceable = function
+    Node(_, "TACTICLIST", a::b::tl) -> true
+  | _ -> false;;
+*)
+let traceable = function
+  | TacThen _ | TacThens _ -> true
+  | _ -> false;;
+
+let rec collect_status = function
+    Report_node(true,_,_)::tl -> collect_status tl
+  | [] -> true
+  | _ -> false;;
+
+(* This tactical receives a tactic and executes it, reporting information
+   about success in the report holder and a boolean reference. *)
+
+let count_subgoals : card_holder -> bool ref -> tactic -> tactic =
+  fun card_holder flag t g ->
+    try
+      let (gls, _) as result = t g in
+      card_holder := (Ngoals(List.length (sig_it gls)));
+      flag := true;
+      result
+    with
+      e -> card_holder := Fail;
+           flag := false;
+           tclIDTAC g;;
+   
+let count_subgoals2
+    : card_holder -> bool ref -> (report_holder -> tactic) -> tactic =
+  fun card_holder flag t g ->
+    let new_report_holder = ref([] : report_tree list) in
+    let (gls, v) as result = t new_report_holder g in
+    let succeeded = no_failure !new_report_holder in
+    if succeeded then
+      (flag := true;
+       card_holder := Ngoals (List.length (sig_it gls)))
+    else
+      (flag := false;
+       card_holder := Recursive_fail(List.hd !new_report_holder));
+    result;;
+
+let rec local_interp : glob_tactic_expr -> report_holder -> tactic = function
+(*
+    Node(_, "TACTICLIST", [a;Node(_, "TACLIST", l)]) ->
+      (fun report_holder -> checked_thens report_holder a l)
+  | Node(_, "TACTICLIST", a::((Node(_, "TACLIST", l))as b)::c::tl) ->
+      local_interp(ope ("TACTICLIST", (ope("TACTICLIST", [a;b]))::c::tl))
+  | Node(_, "TACTICLIST", [a;b]) ->
+      (fun report_holder -> checked_then report_holder a b)
+  | Node(_, "TACTICLIST", a::b::c::tl) ->
+	local_interp(ope ("TACTICLIST", (ope("TACTICLIST", [a;b]))::c::tl))
+  | ast ->
+      (fun report_holder g ->
+	try
+	  let (gls, _) as result = Tacinterp.interp ast g in
+	  report_holder := (Report_node(true, List.length (sig_it gls), []))
+			    ::!report_holder;
+	  result
+	with e -> (report_holder := (Failed 1)::!report_holder;
+		   tclIDTAC g))
+*)
+    TacThens (a,l) ->
+      (fun report_holder -> checked_thens report_holder a l)
+  | TacThen (a,b) ->
+      (fun report_holder -> checked_then report_holder a b)
+  | t ->
+      (fun report_holder g ->
+	try
+	  let (gls, _) as result = Tacinterp.eval_tactic t g in
+	  report_holder := (Report_node(true, List.length (sig_it gls), []))
+			    ::!report_holder;
+	  result
+	with e -> (report_holder := (Failed 1)::!report_holder;
+		   tclIDTAC g))
+
+
+(* This tactical receives a tactic and a list of tactics as argument.
+   It applies the first tactic and then maps the list of tactics to
+   various produced sub-goals.  This tactic will never fail, but reports
+   are added in the report_holder in the following way:
+   - In case of partial success, a new report_tree is added to the report_holder
+   - In case of failure of the first tactic, with no more indications
+     then Failed 0 is added to the report_holder,
+   - In case of partial failure of the first tactic then (Failed n) is added to
+     the report holder.
+   - In case of success of the first tactic, but count mismatch, then
+     Mismatch n is added to the report holder. *)
+
+and checked_thens: report_holder -> glob_tactic_expr -> glob_tactic_expr list -> tactic = 
+  (fun report_holder t1 l g ->
+    let flag = ref true in
+    let traceable_t1 = traceable t1 in
+    let card_holder = ref Fail in
+    let new_holder = ref ([]:report_tree list) in
+    let tac_t1 = 
+      if traceable_t1 then
+	(check_subgoals_count2 card_holder (List.length l)
+           flag (local_interp t1))
+      else
+	(check_subgoals_count card_holder (List.length l)
+           flag (Tacinterp.eval_tactic t1)) in
+    let (gls, _) as result = 
+      tclTHEN_i tac_t1
+	(fun i ->
+	  if !flag then
+	    (fun g -> 
+              let tac_i = (List.nth l i) in
+	      if traceable tac_i then
+                 local_interp tac_i new_holder g
+              else
+		 try
+		   let (gls,_) as result = Tacinterp.eval_tactic tac_i g in
+		   let len = List.length (sig_it gls) in
+				   new_holder :=
+		     (Report_node(true, len, []))::!new_holder;
+		   result
+		 with
+			       e -> (new_holder := (Failed 1)::!new_holder;
+			 tclIDTAC g))
+	  else
+	    tclIDTAC) g in
+      let new_goal_list = sig_it gls in
+      (if !flag then
+	report_holder := 
+	  (Report_node(collect_status !new_holder,
+		    (List.length new_goal_list),
+		    List.rev !new_holder))::!report_holder
+      else
+	report_holder :=
+	  (match !card_holder with
+	    Goals_mismatch(n) -> Mismatch(n, List.length l)
+	  | Recursive_fail tr -> Tree_fail tr
+	  | Fail -> Failed 1
+	  | _ -> errorlabstrm "check_thens"
+                  (str "this case should not happen in check_thens"))::
+	  !report_holder);
+      result)
+
+(* This tactical receives two tactics as argument, it executes the
+   first tactic and applies the second one to all the produced goals,
+   reporting information about the success of all tactics in the report
+   holder. It never fails. *)
+
+and checked_then: report_holder -> glob_tactic_expr -> glob_tactic_expr -> tactic =
+  (fun report_holder t1 t2 g ->
+    let flag = ref true in
+    let card_holder = ref Fail in
+    let tac_t1 =
+      if traceable t1 then
+	(count_subgoals2 card_holder flag (local_interp t1))
+      else
+	(count_subgoals card_holder flag (Tacinterp.eval_tactic t1)) in
+    let new_tree_holder = ref ([] : report_tree list) in
+    let (gls, _) as result =
+      tclTHEN tac_t1
+	(fun (g:goal sigma) -> 
+	  if !flag then
+	    if traceable t2 then
+	      local_interp t2 new_tree_holder g
+	    else
+	      try
+		let (gls, _) as result = Tacinterp.eval_tactic t2 g in
+	      	new_tree_holder :=
+		  (Report_node(true, List.length (sig_it gls),[]))::
+		  !new_tree_holder;
+		result
+	      with
+		e ->
+		  (new_tree_holder := ((Failed 1)::!new_tree_holder);
+		   tclIDTAC g)
+	  else
+	    tclIDTAC g) g in
+    (if !flag then
+      report_holder :=
+	(Report_node(collect_status !new_tree_holder,
+		     List.length (sig_it gls),
+		     List.rev !new_tree_holder))::!report_holder
+    else
+      report_holder :=
+	(match !card_holder with
+	  Recursive_fail tr -> Tree_fail tr
+	| Fail -> Failed 1
+	| _ -> error "this case should not happen in check_then")::!report_holder);
+    result);;
+
+(* This tactic applies the given tactic only to those subgoals designated
+   by the list of integers given as extra arguments.
+ *)
+
+let on_then = function [t1;t2;l] ->
+  let t1 = out_gen wit_tactic t1 in
+  let t2 = out_gen wit_tactic t2 in
+  let l = out_gen (wit_list0 wit_int) l in
+  tclTHEN_i (Tacinterp.eval_tactic t1)
+    (fun i ->
+      if List.mem (i + 1) l then
+      	(Tacinterp.eval_tactic t2)
+      else
+	tclIDTAC)
+  | _ -> anomaly "bad arguments for on_then";;
+
+let mkOnThen t1 t2 selected_indices =
+  let a = in_gen rawwit_tactic t1 in
+  let b = in_gen rawwit_tactic t2 in
+  let l = in_gen (wit_list0 rawwit_int) selected_indices in
+  TacAtom (dummy_loc, TacExtend (dummy_loc, "OnThen", [a;b;l]));;
+
+(* Analyzing error reports *)
+
+(*
+let rec select_success n = function
+    [] -> []
+  | Report_node(true,_,_)::tl -> (Num((0,0),n))::select_success (n+1) tl
+  | _::tl -> select_success (n+1) tl;;
+*)
+let rec select_success n = function
+    [] -> []
+  | Report_node(true,_,_)::tl -> n::select_success (n+1) tl
+  | _::tl -> select_success (n+1) tl;;
+
+(*
+let rec expand_tactic = function
+    Node(loc1, "TACTICLIST", [a;Node(loc2,"TACLIST", l)]) ->
+      Node(loc1, "TACTICLIST",
+	   [expand_tactic a;
+	     Node(loc2, "TACLIST", List.map expand_tactic l)])
+  | Node(loc1, "TACTICLIST", a::((Node(loc2, "TACLIST", l))as b)::c::tl) ->
+      expand_tactic (Node(loc1, "TACTICLIST",
+			  (Node(loc1, "TACTICLIST", [a;b]))::c::tl))
+  | Node(loc1, "TACTICLIST", [a;b]) ->
+      Node(loc1, "TACTICLIST",[expand_tactic a;expand_tactic b])
+  | Node(loc1, "TACTICLIST", a::b::c::tl) ->
+      expand_tactic (Node(loc1, "TACTICLIST",
+			  (Node(loc1, "TACTICLIST", [a;b]))::c::tl))
+  | any -> any;;
+*)
+(* Useless: already in binary form...
+let rec expand_tactic = function
+    TacThens (a,l) -> TacThens (expand_tactic a, List.map expand_tactic l)
+  | TacThen (a,b) -> TacThen (expand_tactic a, expand_tactic b)
+  | any -> any;;
+*)
+
+(*
+let rec reconstruct_success_tac ast = 
+  match ast with
+    Node(_, "TACTICLIST", [a;Node(_,"TACLIST",l)]) ->
+      (function 
+	  Report_node(true, n, l) -> ast
+      	| Report_node(false, n, rl) ->
+	    ope("TACTICLIST",[a;ope("TACLIST", 
+				    List.map2 reconstruct_success_tac l rl)])
+      	| Failed n -> ope("Idtac",[])
+      	| Tree_fail r -> reconstruct_success_tac a r
+      	| Mismatch (n,p) -> a)
+  | Node(_, "TACTICLIST", [a;b]) ->
+      (function
+	  Report_node(true, n, l) -> ast
+	| Report_node(false, n, rl) ->
+	    let selected_indices = select_success 1 rl in
+	    ope("OnThen", a::b::selected_indices)
+	| Failed n -> ope("Idtac",[])
+	| Tree_fail r -> reconstruct_success_tac a r
+	| _ -> error "this error case should not happen in a THEN tactic")
+  | _ -> 
+      (function
+	  Report_node(true, n, l) -> ast
+	| Failed n -> ope("Idtac",[])
+	| _ ->
+	    errorlabstrm
+	      "this error case should not happen on an unknown tactic"
+              (str "error in reconstruction with " ++ fnl () ++
+	       (gentacpr ast)));;
+*)
+let rec reconstruct_success_tac (tac:glob_tactic_expr) =
+  match tac with
+    TacThens (a,l) ->
+      (function 
+	  Report_node(true, n, l) -> tac
+      	| Report_node(false, n, rl) ->
+	    TacThens (a,List.map2 reconstruct_success_tac l rl)
+      	| Failed n -> TacId ""
+      	| Tree_fail r -> reconstruct_success_tac a r
+      	| Mismatch (n,p) -> a)
+  | TacThen (a,b) ->
+      (function
+	  Report_node(true, n, l) -> tac
+	| Report_node(false, n, rl) ->
+	    let selected_indices = select_success 1 rl in
+	    TacAtom (dummy_loc,TacExtend (dummy_loc,"OnThen",
+	      [in_gen globwit_tactic a;
+	       in_gen globwit_tactic b;
+	       in_gen (wit_list0 globwit_int) selected_indices]))
+	| Failed n -> TacId ""
+	| Tree_fail r -> reconstruct_success_tac a r
+	| _ -> error "this error case should not happen in a THEN tactic")
+  | _ -> 
+      (function
+	  Report_node(true, n, l) -> tac
+	| Failed n -> TacId ""
+	| _ ->
+	    errorlabstrm
+	      "this error case should not happen on an unknown tactic"
+              (str "error in reconstruction with " ++ fnl () ++
+	       (pr_glob_tactic tac)));;
+	  
+
+let rec path_to_first_error = function
+| Report_node(true, _, l) ->
+  let rec find_first_error n = function
+  | (Report_node(true, _, _))::tl -> find_first_error (n + 1) tl
+  | it::tl -> n, it
+  | [] -> error "no error detected" in
+  let p, t = find_first_error 1 l in
+    p::(path_to_first_error t)
+| _ -> [];;
+
+(*
+let rec flatten_then_list tail = function
+  | Node(_, "TACTICLIST", [a;b]) ->
+      flatten_then_list ((flatten_then b)::tail) a
+  | ast -> ast::tail
+and flatten_then = function
+    Node(_, "TACTICLIST", [a;b]) ->
+      ope("TACTICLIST", flatten_then_list [flatten_then b] a)
+  | Node(_, "TACLIST", l) ->
+      ope("TACLIST", List.map flatten_then l)
+  | Node(_, "OnThen", t1::t2::l) ->
+      ope("OnThen", (flatten_then t1)::(flatten_then t2)::l)
+  | ast -> ast;;
+*)
+
+let debug_tac = function
+    [(Tacexp ast)] ->
+      (fun g -> 
+      	let report = ref ([] : report_tree list) in
+      	let result = local_interp ast report g in
+      	let clean_ast = (* expand_tactic *) ast in
+      	let report_tree =
+          try List.hd !report with
+	    Failure "hd" -> (msgnl (str "report is empty"); Failed 1) in
+      	let success_tac = 
+	  reconstruct_success_tac clean_ast report_tree in
+        let compact_success_tac = (* flatten_then *) success_tac in
+      	msgnl (fnl () ++
+	       str "=========    Successful tactic    =============" ++
+               fnl () ++
+	       pr_glob_tactic compact_success_tac ++ fnl () ++
+	       str "========= End of successful tactic ============");
+      	result)
+  | _ -> error "wrong arguments for debug_tac";;
+
+(* TODO ... used ?
+add_tactic "DebugTac" debug_tac;;
+*)
+
+(*
+hide_tactic "OnThen" on_then;;
+*)
+Refiner.add_tactic "OnThen" on_then;;
+
+(*
+let rec clean_path p ast l = 
+  match ast, l with
+    Node(_, "TACTICLIST", ([_;_] as tacs)), fst::tl ->
+       fst::(clean_path 0 (List.nth tacs (fst - 1)) tl)
+  | Node(_, "TACTICLIST", tacs), 2::tl ->
+     let rank = (List.length tacs) - p in
+     rank::(clean_path 0 (List.nth tacs (rank - 1)) tl)
+  | Node(_, "TACTICLIST", tacs), 1::tl ->
+      clean_path (p+1) ast tl
+  | Node(_, "TACLIST", tacs), fst::tl ->
+      fst::(clean_path 0 (List.nth tacs (fst - 1)) tl)
+  | _, [] -> []
+  | _, _ -> failwith "this case should not happen in clean_path";;
+*)
+let rec clean_path tac l = 
+  match tac, l with
+  | TacThen (a,b), fst::tl ->
+      fst::(clean_path (if fst = 1 then a else b) tl)
+  | TacThens (a,l), 1::tl ->
+      1::(clean_path a tl)
+  | TacThens (a,tacs), 2::fst::tl ->
+      2::fst::(clean_path (List.nth tacs (fst - 1)) tl)
+  | _, [] -> []
+  | _, _ -> failwith "this case should not happen in clean_path";;
+
+let rec report_error
+    : glob_tactic_expr -> goal sigma option ref -> glob_tactic_expr ref -> int list ref -> 
+      int list -> tactic =
+  fun tac the_goal the_ast returned_path path -> 
+    match tac with
+      TacThens (a,l) ->
+      let the_card_holder = ref Fail in
+      let the_flag = ref false in
+      let the_exn = ref (Failure "") in
+      tclTHENS
+	(fun g ->
+	  let result =
+	    check_subgoals_count 
+	      the_card_holder
+	      (List.length l) 
+	      the_flag
+	      (fun g2 -> 
+		try 
+		  (report_error a the_goal the_ast returned_path (1::path) g2)
+	  	with
+		  e -> (the_exn := e; raise e))
+	      g in
+	  if !the_flag then
+	    result
+	  else
+	    (match !the_card_holder with
+			Fail -> 
+			  the_ast := TacThens (!the_ast, l);
+			  raise !the_exn
+	    | Goals_mismatch p -> 
+		the_ast := tac;
+		returned_path := path;
+		error ("Wrong number of tactics: expected " ^
+		       (string_of_int (List.length l)) ^ " received " ^
+		       (string_of_int p))
+	    | _ -> error "this should not happen"))
+        (let rec fold_num n = function
+	    [] -> []
+	  | t::tl -> (report_error t the_goal the_ast returned_path (n::2::path))::
+	      (fold_num (n + 1) tl) in
+	fold_num 1 l)
+    | TacThen (a,b) ->
+	let the_count = ref 1 in
+	tclTHEN
+	  (fun g ->
+	    try
+	      report_error a the_goal the_ast returned_path (1::path) g
+	    with
+	      e ->
+		(the_ast := TacThen (!the_ast, b);
+		 raise e))
+	  (fun g ->
+	    try
+	      let result = 
+		report_error b the_goal the_ast returned_path (2::path) g in
+	      the_count := !the_count + 1;
+	      result
+	    with
+	      e ->
+		if !the_count > 1 then
+		  msgnl
+		    (str "in branch no " ++ int !the_count ++
+		     str " after tactic " ++ pr_glob_tactic a);
+		raise e)
+    | tac ->
+	(fun g ->
+	  try
+	   Tacinterp.eval_tactic tac g
+	  with
+	    e ->
+	      (the_ast := tac;
+	       the_goal := Some g;
+	       returned_path := path;
+	       raise e));;
+
+let strip_some = function
+    Some n -> n
+  | None -> failwith "No optional value";;
+
+let descr_first_error tac =
+      (fun g ->
+	let the_goal = ref (None : goal sigma option) in
+	let the_ast = ref tac in
+	let the_path = ref ([] : int list) in
+	try
+	  let result = report_error tac the_goal the_ast the_path [] g in
+	  msgnl (str "no Error here");
+	  result
+	with
+	  e ->
+	    (msgnl (str "Execution of this tactic raised message " ++ fnl () ++
+		    fnl () ++ Cerrors.explain_exn e ++ fnl () ++
+		    fnl () ++ str "on goal"  ++ fnl () ++
+		    pr_goal (sig_it (strip_some !the_goal)) ++ fnl () ++
+		    str "faulty tactic is" ++ fnl () ++ fnl () ++
+		    pr_glob_tactic ((*flatten_then*) !the_ast) ++ fnl ());
+	     tclIDTAC g))
+
+(* TODO ... used ??
+add_tactic "DebugTac2" descr_first_error;;
+*)
+
+(*
+TACTIC EXTEND DebugTac2
+  [ ??? ] -> [ descr_first_error tac ]
+END
+*)
diff --git a/contrib/interface/debug_tac.mli b/contrib/interface/debug_tac.mli
new file mode 100644
index 00000000..ded714b6
--- /dev/null
+++ b/contrib/interface/debug_tac.mli
@@ -0,0 +1,6 @@
+
+val report_error : Tacexpr.glob_tactic_expr ->
+    Proof_type.goal Proof_type.sigma option ref ->
+    Tacexpr.glob_tactic_expr ref -> int list ref -> int list -> Tacmach.tactic;;
+
+val clean_path : Tacexpr.glob_tactic_expr -> int list -> int list;;
diff --git a/contrib/interface/history.ml b/contrib/interface/history.ml
new file mode 100644
index 00000000..f73c2084
--- /dev/null
+++ b/contrib/interface/history.ml
@@ -0,0 +1,373 @@
+open Paths;;
+
+type tree = {mutable index : int;
+             parent : tree option;
+             path_to_root : int list;
+             mutable is_open : bool;
+             mutable sub_proofs : tree list};;
+
+type prf_info = {
+    mutable prf_length : int;
+    mutable ranks_and_goals : (int * int * tree) list;
+    mutable border : tree list;
+    prf_struct : tree};;
+
+let theorem_proofs = ((Hashtbl.create 17): 
+			(string, prf_info) Hashtbl.t);;
+
+
+let rec mk_trees_for_goals path tree rank k n =
+  if k = (n + 1) then
+    []
+  else
+    { index = rank;
+      parent = tree;
+      path_to_root = k::path;
+      is_open = true;
+      sub_proofs = [] } ::(mk_trees_for_goals  path tree rank (k+1) n);;
+
+
+let push_command s rank ngoals =
+  let ({prf_length = this_length;
+ 	ranks_and_goals = these_ranks;
+	border = this_border} as proof_info) =
+         Hashtbl.find theorem_proofs s in
+  let rec push_command_aux n = function
+      [] -> failwith "the given rank was too large"
+    | a::l ->
+	if n = 1 then
+	 let {path_to_root = p} = a in
+	 let new_trees = mk_trees_for_goals p (Some a) (this_length + 1) 1 ngoals in
+	 new_trees,(new_trees@l),a
+	else
+	  let new_trees, res, this_tree = push_command_aux (n-1) l in
+	  new_trees,(a::res),this_tree in
+  let new_trees, new_border, this_tree =
+      push_command_aux rank this_border in
+  let new_length = this_length + 1 in
+  begin
+    proof_info.border <- new_border;
+    proof_info.prf_length <- new_length;
+    proof_info.ranks_and_goals <- (rank, ngoals, this_tree)::these_ranks;
+    this_tree.index <- new_length;
+    this_tree.is_open <- false;
+    this_tree.sub_proofs <- new_trees
+  end;;
+
+let get_tree_for_rank thm_name rank = 
+  let {ranks_and_goals=l;prf_length=n} = 
+         Hashtbl.find theorem_proofs thm_name in
+  let rec get_tree_aux = function
+      [] ->
+ 	failwith 
+         "inconsistent values for thm_name and rank in get_tree_for_rank"
+    | (_,_,({index=i} as tree))::tl ->
+	if i = rank then
+	  tree
+	else
+	  get_tree_aux tl in
+  get_tree_aux l;;
+
+let get_path_for_rank thm_name rank =
+  let {path_to_root=l}=get_tree_for_rank thm_name rank in
+  l;;
+
+let rec list_descendants_aux l tree =
+  let {index = i; is_open = open_status; sub_proofs = tl} = tree in
+  let res = (List.fold_left list_descendants_aux  l tl) in
+  if open_status then i::res else res;;
+
+let list_descendants thm_name rank =
+  list_descendants_aux [] (get_tree_for_rank thm_name rank);;
+
+let parent_from_rank thm_name rank =
+  let {parent=mommy} = get_tree_for_rank thm_name rank in
+  match mommy with
+   Some x -> Some x.index
+  | None -> None;;
+
+let first_child_command thm_name rank =
+  let {sub_proofs = l} = get_tree_for_rank thm_name rank in
+  let rec first_child_rec = function 
+      [] -> None
+    | {index=i;is_open=b}::l -> 
+	if b then
+	  (first_child_rec l)
+	else
+ 	  Some i in
+  first_child_rec l;;
+
+type index_or_rank = Is_index of int | Is_rank of int;;
+
+let first_child_command_or_goal thm_name rank =
+  let proof_info = Hashtbl.find theorem_proofs thm_name in
+  let {sub_proofs=l}=get_tree_for_rank thm_name rank in
+  match l with
+    [] -> None
+  | ({index=i;is_open=b} as t)::_ -> 
+      if b then
+	let rec get_rank n = function
+	    [] -> failwith "A goal is lost in first_child_command_or_goal"
+	  | a::l ->
+	      if a==t then
+		n
+	      else
+		get_rank (n + 1) l in
+	Some(Is_rank(get_rank 1 proof_info.border))
+      else
+	Some(Is_index i);;
+
+let next_sibling thm_name rank =
+  let ({parent=mommy} as t)=get_tree_for_rank thm_name rank in
+  match mommy with
+    None -> None
+  |  Some real_mommy ->
+  let {sub_proofs=l}=real_mommy in
+  let rec next_sibling_aux b = function
+      (opt_first, []) -> 
+	if b then
+	  opt_first
+	else
+	  failwith "inconsistency detected in next_sibling"
+    | (opt_first, {is_open=true}::l) -> 
+	next_sibling_aux b (opt_first, l)
+    | (Some(first),({index=i; is_open=false} as t')::l) ->
+	if b then
+	  Some i
+	else
+	  next_sibling_aux (t == t') (Some first,l)
+    | None,({index=i;is_open=false} as t')::l ->
+  	next_sibling_aux (t == t') ((Some i), l)
+  in
+  Some (next_sibling_aux false (None, l));;
+
+
+let prefix l1 l2 =
+  let l1rev = List.rev l1 in
+  let l2rev = List.rev l2 in
+  is_prefix l1rev l2rev;;
+
+let rec remove_all_prefixes p = function
+    [] -> []
+  | a::l -> 
+      if is_prefix p a then
+ 	(remove_all_prefixes p l)
+      else
+	a::(remove_all_prefixes p l);;
+
+let recompute_border tree =
+  let rec recompute_border_aux tree acc =
+    let {is_open=b;sub_proofs=l}=tree in
+    if b then
+      tree::acc
+    else
+      List.fold_right recompute_border_aux l acc in
+  recompute_border_aux tree [];;
+ 
+   
+let historical_undo thm_name rank =
+  let ({ranks_and_goals=l} as proof_info)=
+       Hashtbl.find theorem_proofs thm_name in
+  let rec undo_aux acc = function
+      [] ->  failwith "bad rank provided for undoing in historical_undo"
+    | (r, n, ({index=i} as tree))::tl  ->
+	let this_path_reversed = List.rev tree.path_to_root in
+	let res = remove_all_prefixes this_path_reversed acc in
+	if i = rank then
+	  begin
+	    proof_info.prf_length <- i-1;
+	    proof_info.ranks_and_goals <- tl;
+	    tree.is_open <- true;
+	    tree.sub_proofs <- [];
+	    proof_info.border <- recompute_border proof_info.prf_struct;
+            this_path_reversed::res 
+	  end
+	else
+	  begin
+	    tree.is_open <- true;
+	    tree.sub_proofs <- [];
+	    undo_aux (this_path_reversed::res) tl
+	  end
+  in
+  List.map List.rev (undo_aux [] l);;
+
+(* The following function takes a list of trees and compute the
+   number of elements whose path is lexically smaller or a suffixe of
+   the path given as a first argument.  This works under the precondition that
+   the list is lexicographically order. *)
+
+let rec logical_undo_on_border the_tree rev_path = function
+    [] -> (0,[the_tree])
+  | ({path_to_root=p}as tree)::tl ->
+    let p_rev = List.rev p in
+    if is_prefix rev_path p_rev then
+      let (k,res) = (logical_undo_on_border the_tree rev_path tl) in
+          (k+1,res)
+    else if lex_smaller p_rev rev_path then
+      let (k,res) = (logical_undo_on_border the_tree rev_path tl) in
+          (k,tree::res)
+    else
+          (0, the_tree::tree::tl);;
+   
+
+let logical_undo thm_name rank =
+  let ({ranks_and_goals=l; border=last_border} as proof_info)=
+           Hashtbl.find theorem_proofs thm_name in
+  let ({path_to_root=ref_path} as ref_tree)=get_tree_for_rank thm_name rank in
+  let rev_ref_path = List.rev ref_path in
+  let rec logical_aux lex_smaller_offset family_width = function
+      [] -> failwith "this case should never happen in logical_undo"
+    | (r,n,({index=i;path_to_root=this_path; sub_proofs=these_goals} as tree))::
+        tl ->
+        let this_path_rev = List.rev this_path in
+        let new_rank, new_offset, new_width, kept =
+	  if is_prefix rev_ref_path this_path_rev then
+	    (r + lex_smaller_offset), lex_smaller_offset,
+              (family_width + 1 - n), false 
+	  else if lex_smaller this_path_rev rev_ref_path then
+            r, (lex_smaller_offset -  1 + n), family_width, true
+          else
+            (r + 1 - family_width+ lex_smaller_offset),
+	    lex_smaller_offset, family_width, true in
+        if i=rank then
+	  [i,new_rank],[], tl, rank
+        else
+          let ranks_undone, ranks_kept, ranks_and_goals, current_rank =
+	    (logical_aux new_offset new_width tl) in
+          begin
+	    if kept then
+	      begin
+	      	tree.index <- current_rank;
+	    	ranks_undone, ((i,new_rank)::ranks_kept),
+	    	((new_rank, n, tree)::ranks_and_goals), 
+                (current_rank + 1)
+	      end
+	    else
+	      ((i,new_rank)::ranks_undone), ranks_kept,
+	      ranks_and_goals, current_rank
+	  end in
+  let number_suffix, new_border = 
+     logical_undo_on_border ref_tree rev_ref_path last_border in
+  let changed_ranks_undone, changed_ranks_kept, new_ranks_and_goals,
+    new_length_plus_one = logical_aux 0 number_suffix l in
+  let the_goal_index =
+    let rec compute_goal_index n = function
+	[] -> failwith "this case should never happen in logical undo (2)"
+      |	{path_to_root=path}::tl ->
+	  if List.rev path = (rev_ref_path) then
+	    n
+	  else
+	    compute_goal_index (n+1) tl in
+    compute_goal_index 1 new_border in
+  begin
+    ref_tree.is_open <- true;
+    ref_tree.sub_proofs <- [];
+    proof_info.border <- new_border;
+    proof_info.ranks_and_goals <- new_ranks_and_goals;
+    proof_info.prf_length <- new_length_plus_one - 1;
+    changed_ranks_undone, changed_ranks_kept, proof_info.prf_length, 
+    the_goal_index
+  end;;
+	
+let start_proof thm_name =
+   let the_tree = 
+      {index=0;parent=None;path_to_root=[];is_open=true;sub_proofs=[]} in
+   Hashtbl.add theorem_proofs thm_name
+     {prf_length=0;
+      ranks_and_goals=[];
+      border=[the_tree];
+      prf_struct=the_tree};;
+      
+let dump_sequence chan s =
+    match (Hashtbl.find theorem_proofs s) with
+    {ranks_and_goals=l}->
+      let rec dump_rec = function
+	  [] -> ()
+  	| (r,n,_)::tl ->
+	    dump_rec tl;
+	    output_string chan (string_of_int r);
+	    output_string chan ",";
+	    output_string chan (string_of_int n);
+	    output_string chan "\n" in
+      begin
+      	dump_rec l;
+	output_string chan "end\n"
+      end;;
+
+      
+let proof_info_as_string s =
+  let res = ref "" in
+  match (Hashtbl.find theorem_proofs s) with
+  {prf_struct=tree} ->
+  let open_goal_counter = ref 0 in
+  let rec dump_rec = function
+    {index=i;sub_proofs=trees;parent=the_parent;is_open=op} ->
+    begin
+      (match the_parent with
+         None ->
+	   if op then
+	     res := !res ^  "\"open goal\"\n"
+       | Some {index=j} -> 
+           begin
+             res := !res ^  (string_of_int j);
+             res := !res ^  " -> ";
+	     if op then
+	       begin
+		 res := !res ^  "\"open goal ";
+		 open_goal_counter := !open_goal_counter + 1;
+		 res := !res ^  (string_of_int !open_goal_counter);
+		 res := !res ^  "\"\n";
+	       end
+	     else
+	       begin
+		 res := !res ^  (string_of_int i);
+		 res := !res ^  "\n"
+	       end
+           end);
+      	List.iter dump_rec trees
+     end in
+  dump_rec tree;
+  !res;;
+
+
+let dump_proof_info chan s = 
+  match (Hashtbl.find theorem_proofs s) with
+  {prf_struct=tree} ->
+  let open_goal_counter = ref 0 in
+  let rec dump_rec = function
+    {index=i;sub_proofs=trees;parent=the_parent;is_open=op} ->
+    begin
+      (match the_parent with
+         None ->
+	   if op then
+	     output_string chan "\"open goal\"\n"
+       | Some {index=j} -> 
+           begin
+             output_string chan (string_of_int j);
+             output_string chan " -> ";
+	     if op then
+	       begin
+		 output_string chan "\"open goal ";
+		 open_goal_counter := !open_goal_counter + 1;
+		 output_string chan (string_of_int !open_goal_counter);
+		 output_string chan "\"\n";
+	       end
+	     else
+	       begin
+		 output_string chan (string_of_int i);
+		 output_string chan "\n"
+	       end
+           end);
+      	List.iter dump_rec trees
+     end in
+  dump_rec tree;;
+
+let get_nth_open_path s n =
+  match Hashtbl.find theorem_proofs s with
+    {border=l} ->
+    let {path_to_root=p}=List.nth l (n - 1) in
+    p;;
+
+let border_length s =
+  match Hashtbl.find theorem_proofs s with
+    {border=l} -> List.length l;;
diff --git a/contrib/interface/history.mli b/contrib/interface/history.mli
new file mode 100644
index 00000000..053883f0
--- /dev/null
+++ b/contrib/interface/history.mli
@@ -0,0 +1,12 @@
+type prf_info;;
+
+val start_proof : string -> unit;;
+val historical_undo : string -> int -> int list list
+val logical_undo : string -> int -> (int * int) list * (int * int) list * int * int
+val dump_sequence : out_channel -> string -> unit
+val proof_info_as_string : string -> string
+val dump_proof_info : out_channel -> string -> unit
+val push_command : string -> int -> int -> unit
+val get_path_for_rank : string -> int -> int list
+val get_nth_open_path : string -> int -> int list
+val border_length : string -> int
diff --git a/contrib/interface/line_parser.ml4 b/contrib/interface/line_parser.ml4
new file mode 100755
index 00000000..b5669351
--- /dev/null
+++ b/contrib/interface/line_parser.ml4
@@ -0,0 +1,241 @@
+(* line-oriented Syntactic analyser for a Coq parser *)
+(* This parser expects a very small number of commands, each given on a complete
+line.  Some of these commands are then followed by a text fragment terminated
+by a precise keyword, which is also expected to appear alone on a line. *)
+
+(* The main parsing loop procedure is "parser_loop", given at the end of this
+file.  It read lines one by one and checks whether they can be parsed using
+a very simple parser.  This very simple parser uses a lexer, which is also given
+in this file.  
+
+The lexical analyser:
+ There are only 5 sorts of tokens *)
+type simple_tokens = Tspace | Tid of string | Tint of int | Tstring of string |
+      Tlbracket | Trbracket;;
+
+(* When recognizing identifiers or strings, the lexical analyser accumulates
+   the characters in a buffer, using the command add_in_buff.  To recuperate
+   the characters, one can use get_buff (this code was inspired by the
+   code in src/meta/lexer.ml of Coq revision 6.1) *)
+let add_in_buff,get_buff =
+  let buff = ref (String.create 80) in
+    (fun i x -> 
+       let len = String.length !buff in
+        if i >= len then (buff := !buff ^ (String.create len);());
+         String.set !buff i x;
+         succ i),
+     (fun len -> String.sub !buff 0 len);;
+
+(* Identifiers are [a-zA-Z_][.a-zA-Z0-9_]*.  When arriving here the first
+   character has already been recognized. *)
+let rec ident len = parser
+  [<''_' | '.' | 'a'..'z' | 'A'..'Z' | '0'..'9' as c; s >] ->
+    ident (add_in_buff len c) s
+| [< >] -> let str = get_buff len in Tid(str);;
+
+(* While recognizing integers, one constructs directly the integer value.
+   The ascii code of '0' is important for this. *)
+let code0 = Char.code '0';;
+
+let get_digit c =  Char.code c - code0;;
+
+(* Integers are [0-9]*
+   The variable intval is the integer value of the text that has already
+   been recognized.  As for identifiers, the first character has already been
+   recognized. *)
+
+let rec parse_int intval = parser
+  [< ''0'..'9' as c ; i=parse_int (10 * intval + get_digit c)>] -> i
+| [< >] -> Tint intval;;
+      
+(* The string lexer is borrowed from the string parser of Coq V6.1 
+   This may be a problem if convention have changed in Coq,
+   However this parser is only used to recognize file names which should
+   not contain too many special characters *)
+
+let rec spec_char = parser
+  [< ''n' >] -> '\n' 
+| [< ''t' >] -> '\t'
+| [< ''b' >] -> '\008' 
+| [< ''r' >] -> '\013'
+| [< ''0'..'9' as c; v= (spec1 (get_digit c)) >] ->
+    Char.chr v
+| [< 'x >] -> x
+
+and spec1 v = parser
+  [< ''0'..'9' as c; s >] -> spec1 (10*v+(get_digit c)) s
+| [< >] -> v
+;;
+
+(* This is the actual string lexical analyser.  Strings are
+   QUOT([^QUOT\\]|\\[0-9]*|\\[^0-9])QUOT (the word QUOT is used
+   to represents double quotation characters, that cannot be used
+   freely, even inside comments. *)
+
+let rec string len = parser
+  [< ''"' >] -> len
+| [<''\\' ;
+      len = (parser [< ''\n' >] -> len
+             | [< c=spec_char >] -> add_in_buff len c);
+      s >] -> string len s
+| [< 'x; s >] -> string (add_in_buff len x) s;;
+
+(* The lexical analyser repeats the recognized given by next_token:
+   spaces and tabulations are ignored, identifiers, integers,
+   strings, opening and closing square brackets.  Lexical errors are
+   ignored ! *)
+let rec next_token = parser count
+  [< '' ' | '\t'; tok = next_token >] -> tok
+| [< ''_' | 'a'..'z' | 'A'..'Z' as c;i = (ident (add_in_buff 0 c))>] -> i
+| [< ''0'..'9' as c ; i = (parse_int (get_digit c))>] -> i
+| [< ''"' ; len = (string 0) >] -> Tstring (get_buff len)
+| [< ''[' >] -> Tlbracket
+| [< '']' >] -> Trbracket
+| [< '_ ; x = next_token >] -> x;;
+
+(* A very simple lexical analyser to recognize a integer value behind 
+   blank characters *)
+
+let rec next_int = parser count
+  [< '' ' | '\t'; v = next_int >] -> v
+| [< ''0'..'9' as c; i = (parse_int (get_digit c))>] ->
+     (match i with
+        Tint n -> n
+     |  _ -> failwith "unexpected branch in next_int");;
+
+(* This is the actual lexical analyser, implemented as a function on a stream.
+   It will be used with the Stream.from primitive to construct a function
+   of type char Stream.t -> simple_token option Stream.t *)
+let token_stream cs _ =
+ try  let tok = next_token cs in
+      Some tok
+ with Stream.Failure -> None;;
+
+(* Two of the actions of the parser request that one reads the rest of
+   the input up to a specific string stop_string.  This is done
+   with a function that transform the input_channel into a pair of
+   char Stream.t, reading from the input_channel all the lines to
+   the stop_string first. *)
+
+
+let rec gather_strings stop_string input_channel =
+   let buff = input_line input_channel in
+   if buff = stop_string then
+     []
+   else
+     (buff::(gather_strings stop_string input_channel));;
+
+
+(* the result of this function is supposed to be used in a Stream.from
+   construction. *)
+
+let line_list_to_stream string_list =
+   let count = ref 0 in
+   let buff = ref "" in
+   let reserve = ref string_list in
+   let current_length = ref 0 in
+   (fun i -> if (i - !count) >= !current_length then
+               begin
+                  count := !count + !current_length + 1;
+                  match !reserve with
+		  | [] -> None
+                  | s1::rest -> 
+                    begin
+                      buff := s1;
+                      current_length := String.length !buff;
+		      reserve := rest;
+                      Some '\n'
+                    end
+               end
+             else
+               Some(String.get !buff (i - !count)));;
+ 
+
+(* In older revisions of this file you would find a function that
+   does line oriented breakdown of the input channel without resorting to
+   a list of lines.  However, the need for the list of line appeared when
+   we wanted to have  a channel and a list of strings describing the same
+   data, one for regular parsing and the other for error recovery. *)
+
+let channel_to_stream_and_string_list stop_string input_channel =
+   let string_list = gather_strings stop_string input_channel in
+   (line_list_to_stream string_list, string_list);;
+
+let flush_until_end_of_stream char_stream =
+ Stream.iter (function _ -> ()) char_stream;;
+
+(* There are only 5 kinds of lines recognized by our little parser.
+   Unrecognized lines are ignored. *)
+type parser_request =
+  | PRINT_VERSION
+  | PARSE_STRING of string
+      (* parse_string <int> [<ident>] then text and && END--OF--DATA *)
+  | QUIET_PARSE_STRING
+      (* quiet_parse_string then text and && END--OF--DATA *)
+  | PARSE_FILE of string
+      (* parse_file <int> <string> *)
+  | ADD_PATH of string
+      (* add_path <int> <string> *)
+  | ADD_REC_PATH of string * string
+      (* add_rec_path <int> <string> <ident> *)
+  | LOAD_SYNTAX of string
+      (* load_syntax_file <int> <ident> *)
+  | GARBAGE
+;;
+
+(* The procedure parser_loop should never terminate while the input_channel is
+   not closed. This procedure receives the functions called for each sentence
+   as arguments.  Thus the code is completely independent from the Coq sources. *)
+let parser_loop functions input_channel =
+  let print_version_action,
+      parse_string_action,
+      quiet_parse_string_action,
+      parse_file_action,
+      add_path_action,
+      add_rec_path_action,
+      load_syntax_action = functions in
+  let rec parser_loop_rec input_channel =
+  (let line = input_line input_channel in
+  let reqid, parser_request = 
+      try 
+      (match Stream.from (token_stream (Stream.of_string line)) with
+        parser
+        | [< 'Tid "print_version" >] ->
+                     0, PRINT_VERSION
+        | [< 'Tid "parse_string" ; 'Tint reqid ; 'Tlbracket ;
+             'Tid phylum ; 'Trbracket >] 
+                  -> reqid,PARSE_STRING phylum
+        | [< 'Tid "quiet_parse_string" >] ->
+                     0,QUIET_PARSE_STRING
+        | [< 'Tid "parse_file" ; 'Tint reqid ; 'Tstring fname >] ->
+                     reqid, PARSE_FILE fname
+        | [< 'Tid "add_rec_path"; 'Tint reqid ; 'Tstring directory ;  'Tid alias >]
+            -> reqid, ADD_REC_PATH(directory, alias)
+        | [< 'Tid "add_path"; 'Tint reqid ; 'Tstring directory >]
+            -> reqid, ADD_PATH directory
+        | [< 'Tid "load_syntax_file"; 'Tint reqid; 'Tid module_name >] ->
+               reqid, LOAD_SYNTAX module_name
+	| [< 'Tid "quit_parser" >] -> raise End_of_file
+        | [< >] -> 0, GARBAGE)
+       with
+         Stream.Failure | Stream.Error _ -> 0,GARBAGE in
+   match parser_request with
+     PRINT_VERSION -> print_version_action ()
+   | PARSE_STRING phylum ->
+     let regular_stream, string_list =
+        channel_to_stream_and_string_list "&& END--OF--DATA" input_channel in
+      parse_string_action reqid phylum (Stream.from regular_stream)
+        string_list;()
+   | QUIET_PARSE_STRING ->
+     let regular_stream, string_list =
+        channel_to_stream_and_string_list "&& END--OF--DATA" input_channel in
+       quiet_parse_string_action
+        (Stream.from regular_stream);()
+   | PARSE_FILE file_name ->
+        parse_file_action reqid file_name
+   | ADD_PATH path -> add_path_action reqid path
+   | ADD_REC_PATH(path, alias) -> add_rec_path_action reqid path alias
+   | LOAD_SYNTAX syn -> load_syntax_action reqid syn
+   | GARBAGE -> ());
+   parser_loop_rec input_channel in
+   parser_loop_rec input_channel;;
diff --git a/contrib/interface/line_parser.mli b/contrib/interface/line_parser.mli
new file mode 100644
index 00000000..b0b043c7
--- /dev/null
+++ b/contrib/interface/line_parser.mli
@@ -0,0 +1,5 @@
+val parser_loop :
+  (unit -> unit) * (int -> string -> char Stream.t -> string list -> 'a) *
+  (char Stream.t -> 'b) * (int -> string -> unit) * (int -> string -> unit) *
+  (int -> string -> string -> unit) * (int -> string -> unit) -> in_channel -> 'c
+val flush_until_end_of_stream : 'a Stream.t -> unit
diff --git a/contrib/interface/name_to_ast.ml b/contrib/interface/name_to_ast.ml
new file mode 100644
index 00000000..eaff0968
--- /dev/null
+++ b/contrib/interface/name_to_ast.ml
@@ -0,0 +1,252 @@
+open Sign;;
+open Classops;;
+open Names;;
+open Nameops
+open Coqast;;
+open Ast;;
+open Termast;;
+open Term;;
+open Impargs;;
+open Reduction;;
+open Libnames;;
+open Libobject;;
+open Environ;;
+open Declarations;;
+open Prettyp;;
+open Inductive;;
+open Util;;
+open Pp;;
+open Declare;;
+open Nametab
+open Vernacexpr;;
+open Decl_kinds;;
+open Constrextern;;
+open Topconstr;;
+
+(* This function converts the parameter binders of an inductive definition,
+   in particular you have to be careful to handle each element in the
+   context containing all previously defined variables.  This squeleton
+   of this procedure is taken from the function print_env in pretty.ml *)
+let convert_env =
+    let convert_binder env (na, b, c) =
+      match b with 
+       | Some b -> LocalRawDef ((dummy_loc,na), extern_constr true env b)
+       | None -> LocalRawAssum ([dummy_loc,na], extern_constr true env c) in
+    let rec cvrec env = function
+       [] -> []
+     | b::rest -> (convert_binder env b)::(cvrec (push_rel b env) rest) in
+    cvrec (Global.env());;
+
+(* let mib string = 
+     let sp = Nametab.sp_of_id CCI (id_of_string string) in
+     let lobj = Lib.map_leaf (objsp_of sp) in
+     let (cmap, _) = outMutualInductive lobj in
+     Listmap.map cmap CCI;; *)
+
+(* This function is directly inspired by print_impl_args in pretty.ml *)
+
+let impl_args_to_string_by_pos = function
+    [] -> None
+  | [i] -> Some(" position " ^ (string_of_int i) ^ " is implicit.")
+  | l -> Some (" positions " ^
+                (List.fold_right (fun i s -> (string_of_int i) ^ " " ^ s)
+                     l
+                     " are implicit."));;
+
+(* This function is directly inspired by implicit_args_id in pretty.ml *)
+
+let impl_args_to_string l = 
+  impl_args_to_string_by_pos (positions_of_implicits l)
+
+let implicit_args_id_to_ast_list id l ast_list = 
+    (match impl_args_to_string l with
+           None -> ast_list
+         | Some(s) -> CommentString s::
+                      CommentString ("For " ^ (string_of_id id))::
+                      ast_list);;
+
+(* This function construct an ast to enumerate the implicit positions for an
+   inductive type and its constructors. It is obtained directly from
+   implicit_args_msg in pretty.ml.  *)
+
+let implicit_args_to_ast_list sp mipv =
+    let implicit_args_descriptions = 
+      let ast_list = ref [] in
+       	(Array.iteri
+           (fun i mip  ->
+	      let imps = implicits_of_global (IndRef (sp, i)) in
+		      (ast_list :=
+	      	implicit_args_id_to_ast_list mip.mind_typename imps !ast_list;
+	      	Array.iteri
+		  (fun j idc ->
+		     let impls = implicits_of_global
+		       (ConstructRef ((sp,i),j+1)) in
+		       ast_list := 
+		       implicit_args_id_to_ast_list idc impls !ast_list)
+		  mip.mind_consnames))
+	  mipv;
+	 !ast_list) in
+      match implicit_args_descriptions with
+	  [] -> []
+	| _ -> [VernacComments (List.rev implicit_args_descriptions)];;
+	      
+let convert_qualid qid =
+  let d, id = Libnames.repr_qualid qid in
+    match repr_dirpath d with
+	[] -> nvar id
+      | d -> ope("QUALID", List.fold_left (fun l s -> (nvar s)::l)
+		   [nvar id] d);;
+
+(* This function converts constructors for an inductive definition to a
+   Coqast.t.  It is obtained directly from print_constructors in pretty.ml *)
+
+let convert_constructors envpar names types =
+  let array_idC = 
+    array_map2 
+      (fun n t -> 
+	let coercion_flag = false (* arbitrary *) in
+	(coercion_flag, ((dummy_loc,n), extern_constr true envpar t)))
+      names types in
+  Array.to_list array_idC;;
+  
+(* this function converts one inductive type in a possibly multiple inductive
+   definition *)
+
+let convert_one_inductive sp tyi =
+  let (ref, params, arity, cstrnames, cstrtypes) = build_inductive sp tyi in
+  let env = Global.env () in
+  let envpar = push_rel_context params env in
+  let sp = sp_of_global (IndRef (sp, tyi)) in
+  ((dummy_loc,basename sp), None,
+   convert_env(List.rev params),
+   (extern_constr true envpar arity),
+   convert_constructors envpar cstrnames cstrtypes);;
+
+(* This function converts a Mutual inductive definition to a Coqast.t.
+   It is obtained directly from print_mutual in pretty.ml.  However, all
+   references to kinds have been removed and it treats only CCI stuff. *)
+
+let mutual_to_ast_list sp mib =
+  let mipv = (Global.lookup_mind sp).mind_packets in
+  let _, l =
+    Array.fold_right
+      (fun mi (n,l) -> (n+1, (convert_one_inductive sp n)::l)) mipv (0, []) in
+  VernacInductive (mib.mind_finite, l)
+  :: (implicit_args_to_ast_list sp mipv);;
+
+let constr_to_ast v = 
+  extern_constr true (Global.env()) v;;
+
+let implicits_to_ast_list implicits =
+  match (impl_args_to_string implicits) with
+    | None -> []
+    | Some s -> [VernacComments [CommentString s]];;
+
+(*
+let make_variable_ast name typ implicits =
+   (ope("VARIABLE",
+    [string "VARIABLE";
+     ope("BINDERLIST",
+         [ope("BINDER",
+            [(constr_to_ast (body_of_type typ));
+             nvar name])])]))::(implicits_to_ast_list implicits)
+    ;;
+*)
+let make_variable_ast name typ implicits =
+  (VernacAssumption
+    ((Local,Definitional),
+     [false,([dummy_loc,name], constr_to_ast (body_of_type typ))]))
+  ::(implicits_to_ast_list implicits);;
+    
+
+let make_definition_ast name c typ implicits =
+  VernacDefinition ((Global,Definition), (dummy_loc,name), DefineBody ([], None,
+    (constr_to_ast c), Some (constr_to_ast (body_of_type typ))),
+    (fun _ _ -> ()))
+  ::(implicits_to_ast_list implicits);;
+
+(* This function is inspired by print_constant *)
+let constant_to_ast_list kn =
+  let cb = Global.lookup_constant kn in
+  let c = cb.const_body in
+  let typ = cb.const_type in
+  let l = implicits_of_global (ConstRef kn) in
+  (match c with
+      None -> 
+	make_variable_ast (id_of_label (label kn)) typ l
+    | Some c1 ->
+	make_definition_ast (id_of_label (label kn)) (Declarations.force c1) typ l)
+
+let variable_to_ast_list sp =
+  let (id, c, v) = get_variable sp in
+  let l = implicits_of_global (VarRef sp) in
+    (match c with
+	 None -> 
+	   make_variable_ast id v l
+       | Some c1 ->
+	   make_definition_ast id c1 v l);;
+
+(* this function is taken from print_inductive in file pretty.ml *)
+
+let inductive_to_ast_list sp =
+  let mib = Global.lookup_mind sp in
+  mutual_to_ast_list sp mib
+
+(* this function is inspired by print_leaf_entry from pretty.ml *)
+
+let leaf_entry_to_ast_list ((sp,kn),lobj) =
+  let tag = object_tag lobj in
+  match tag with
+  | "VARIABLE" -> variable_to_ast_list (basename sp)
+  | "CONSTANT" -> constant_to_ast_list kn
+  | "INDUCTIVE" -> inductive_to_ast_list kn
+  | s -> 
+      errorlabstrm 
+      	"print" (str ("printing of unrecognized object " ^
+		      s ^ " has been required"));;
+
+
+
+
+(* this function is inspired by print_name *)
+let name_to_ast ref =
+  let (loc,qid) = qualid_of_reference ref in
+  let l = 
+    try
+      let sp = Nametab.locate_obj qid in
+      let (sp,lobj) = 
+      	let (sp,entry) =
+          List.find (fun en -> (fst (fst en)) = sp) (Lib.contents_after None)
+      	in
+	  match entry with
+            | Lib.Leaf obj -> (sp,obj)
+            | _ -> raise Not_found
+      in
+    	leaf_entry_to_ast_list (sp,lobj)
+    with Not_found -> 
+      try 
+    	match Nametab.locate qid with
+	  | ConstRef sp -> constant_to_ast_list sp
+	  | IndRef (sp,_) -> inductive_to_ast_list sp
+	  | ConstructRef ((sp,_),_) -> inductive_to_ast_list sp
+	  | VarRef sp -> variable_to_ast_list sp
+  	with Not_found -> 
+	  try  (* Var locale de but, pas var de section... donc pas d'implicits *)
+	    let dir,name = repr_qualid qid in 
+	      if (repr_dirpath dir) <> [] then raise Not_found;
+	      let (_,c,typ) = Global.lookup_named name in 
+		(match c with
+		     None -> make_variable_ast name typ []
+		   | Some c1 -> make_definition_ast name c1 typ [])
+	  with Not_found ->
+	    try
+	      let sp = Nametab.locate_syntactic_definition qid in
+		errorlabstrm "print"
+      		  (str "printing of syntax definitions not implemented")
+	    with Not_found ->
+	      errorlabstrm "print"
+		(pr_qualid qid ++
+		 spc () ++ str "not a defined object")
+  in
+  VernacList (List.map (fun x -> (dummy_loc,x)) l)
+
diff --git a/contrib/interface/name_to_ast.mli b/contrib/interface/name_to_ast.mli
new file mode 100644
index 00000000..0eca0a1e
--- /dev/null
+++ b/contrib/interface/name_to_ast.mli
@@ -0,0 +1,2 @@
+val name_to_ast : Libnames.reference -> Vernacexpr.vernac_expr;;
+val convert_qualid : Libnames.qualid -> Coqast.t;;
diff --git a/contrib/interface/parse.ml b/contrib/interface/parse.ml
new file mode 100644
index 00000000..3f0b2d2e
--- /dev/null
+++ b/contrib/interface/parse.ml
@@ -0,0 +1,488 @@
+open Util;;
+open System;;
+open Pp;;
+open Libnames;;
+open Library;;
+open Ascent;;
+open Vtp;;
+open Xlate;;
+open Line_parser;;
+open Pcoq;;
+open Vernacexpr;;
+open Mltop;;
+
+type parsed_tree =
+  | P_cl of ct_COMMAND_LIST
+  | P_c of ct_COMMAND
+  | P_t of ct_TACTIC_COM
+  | P_f of ct_FORMULA
+  | P_id of ct_ID
+  | P_s of ct_STRING
+  | P_i of ct_INT;;
+
+let print_parse_results n msg =
+  print_string "message\nparsed\n";
+  print_int n;
+  print_string "\n";
+  (match msg with
+  | P_cl x -> fCOMMAND_LIST x
+  | P_c x -> fCOMMAND x
+  | P_t x -> fTACTIC_COM x
+  | P_f x -> fFORMULA x
+  | P_id x -> fID x
+  | P_s x -> fSTRING x
+  | P_i x -> fINT x);
+  print_string "e\nblabla\n";
+  flush stdout;;
+
+let ctf_SyntaxErrorMessage reqid pps =
+ fnl () ++ str "message" ++ fnl () ++ str "syntax_error" ++ fnl () ++
+   int reqid ++ fnl () ++
+   pps ++ fnl () ++ str "E-n-d---M-e-s-s-a-g-e" ++ fnl ();;
+let ctf_SyntaxWarningMessage reqid pps =
+  fnl () ++  str "message" ++ fnl () ++ str "syntax_warning" ++ fnl () ++
+  int reqid ++ fnl () ++ pps ++ fnl () ++ str "E-n-d---M-e-s-s-a-g-e" ++ fnl();;
+
+let ctf_FileErrorMessage reqid pps =
+  fnl () ++ str "message" ++ fnl () ++ str "file_error" ++ fnl () ++
+  int reqid ++ fnl () ++ pps ++ fnl () ++ str "E-n-d---M-e-s-s-a-g-e" ++
+  fnl ();;
+
+(*
+(*In the code for CoqV6.2, the require_module call is encapsulated in
+  a function "without_mes_ambig".  Here I have supposed that this
+  function has no effect on parsing *)
+let try_require_module import specif names =
+ try Library.require_module 
+   (if specif = "UNSPECIFIED" then None
+    else Some (specif = "SPECIFICATION"))
+   (List.map 
+     (fun name ->
+       (dummy_loc,Libnames.make_short_qualid (Names.id_of_string name)))
+      names)
+   (import = "IMPORT")
+ with
+   | e -> msgnl (str "Reinterning of " ++ prlist str names ++ str " failed");;
+*)
+(*
+let try_require_module_from_file import specif name fname =
+ try Library.require_module_from_file (if specif = "UNSPECIFIED" then None
+  else Some (specif = "SPECIFICATION")) (Some (Names.id_of_string name)) fname (import = "IMPORT")
+ with
+ | e -> msgnl (str "Reinterning of " ++ str name ++ str " failed");;
+*)
+(*
+let execute_when_necessary ast =
+ (match ast with
+  | Node (_, "GRAMMAR", ((Nvar (_, s)) :: ((Node (_, "ASTLIST", al)) :: []))) ->
+   Metasyntax.add_grammar_obj s (List.map Ctast.ct_to_ast al)
+(* Obsolete
+  | Node (_, "TOKEN", ((Str (_, s)) :: [])) -> Metasyntax.add_token_obj s
+*)
+  | Node (_, "Require",
+            ((Str (_, import)) ::
+              ((Str (_, specif)) :: l))) ->
+   let mnames = List.map (function
+     | (Nvar (_, m)) -> m
+     | _ -> error "parse_string_action : bad require expression") l in
+   try_require_module import specif mnames
+  | Node (_, "RequireFrom",
+            ((Str (_, import)) ::
+              ((Str (_, specif)) ::
+                ((Nvar (_, mname)) :: ((Str (_, file_name)) :: []))))) ->
+   try_require_module_from_file import specif mname file_name
+  | _ -> ()); ast;;
+*)
+
+let execute_when_necessary v =
+ (match v with
+  | VernacGrammar _ -> Vernacentries.interp v
+  | VernacOpenCloseScope sc -> Vernacentries.interp v
+  | VernacRequire (_,_,l) ->
+      (try 
+	Vernacentries.interp v
+       with _ ->
+	 let l=prlist_with_sep spc pr_reference l in
+	 msgnl (str "Reinterning of " ++ l ++ str " failed"))
+  | VernacRequireFrom (_,_,f) ->
+      (try 
+	Vernacentries.interp v
+       with _ ->
+	 msgnl (str "Reinterning of " ++ Util.pr_str f ++ str " failed"))
+  | _ -> ()); v;;
+
+let parse_to_dot =
+  let rec dot st = match Stream.next st with
+    | ("", ".") -> ()
+    | ("EOI", "") -> raise End_of_file
+    | _ -> dot st in
+    Gram.Entry.of_parser "Coqtoplevel.dot" dot;;
+
+let rec discard_to_dot stream =
+  try Gram.Entry.parse parse_to_dot (Gram.parsable stream) with
+  | Stdpp.Exc_located(_, Token.Error _) -> discard_to_dot stream;;
+
+let rec decompose_string_aux s n =
+    try let index = String.index_from s n '\n' in
+            (String.sub s n (index - n))::
+            (decompose_string_aux s (index + 1))
+    with Not_found -> [String.sub s n ((String.length s) - n)];;
+
+let decompose_string s n =
+  match decompose_string_aux s n with
+      ""::tl -> tl
+    | a -> a;;
+
+let make_string_list file_chan fst_pos snd_pos =
+    let len = (snd_pos - fst_pos) in
+    let s = String.create len in
+    begin
+      seek_in file_chan fst_pos;
+      really_input file_chan s 0 len;
+      decompose_string s 0;
+    end;;
+
+let rec get_sub_aux string_list snd_pos =
+    match string_list with
+      [] -> []
+    | s::l ->
+      let len = String.length s in
+        if len >= snd_pos then
+          if snd_pos < 0 then
+            []
+          else
+            [String.sub s 0 snd_pos]
+        else
+          s::(get_sub_aux l (snd_pos - len - 1));;
+
+let rec get_substring_list string_list fst_pos snd_pos =
+  match string_list with
+    [] -> []
+  | s::l -> 
+    let len = String.length s in
+    if fst_pos > len then
+       get_substring_list l (fst_pos - len - 1) (snd_pos - len - 1)
+    else
+       (* take into account the fact that carriage returns are not in the *)
+       (* strings. *)
+       let fst_pos2 = if fst_pos = 0 then 1 else fst_pos in
+       if snd_pos > len then
+         String.sub s (fst_pos2 - 1) (len + 1 - fst_pos2)::
+         (get_sub_aux l (snd_pos - len - 2))
+       else
+         let gap = (snd_pos - fst_pos2) in
+         if gap < 0 then
+            []
+         else
+            [String.sub s (fst_pos2 - 1) gap];;
+
+(* When parsing a list of commands, we try to recover error messages for
+   each individual command. *)
+
+type parse_result =
+  | ParseOK of Vernacexpr.vernac_expr located option
+  | ParseError of string * string list
+
+let embed_string s =
+  CT_coerce_STRING_OPT_to_VARG (CT_coerce_STRING_to_STRING_OPT (CT_string s))
+
+let make_parse_error_item s l =
+  CT_user_vernac (CT_ident s, CT_varg_list (List.map embed_string l))
+
+let parse_command_list reqid stream string_list =
+    let rec parse_whole_stream () =
+    let this_pos = Stream.count stream in
+    let first_ast = 
+        try ParseOK (Gram.Entry.parse Pcoq.main_entry (Gram.parsable stream))
+        with
+        | (Stdpp.Exc_located(l, Stream.Error txt)) as e -> 
+          begin
+             msgnl (ctf_SyntaxWarningMessage reqid (Cerrors.explain_exn e));
+             try
+                discard_to_dot stream;
+                msgnl (str "debug" ++ fnl () ++ int this_pos ++ fnl () ++
+		       int (Stream.count stream));
+(*
+                Some( Node(l, "PARSING_ERROR",
+                        List.map Ctast.str
+                        (get_substring_list string_list this_pos
+                            (Stream.count stream))))
+*)
+		ParseError ("PARSING_ERROR",
+                  get_substring_list string_list this_pos
+		    (Stream.count stream))
+             with End_of_file -> ParseOK None
+           end
+        | e-> 
+          begin
+            discard_to_dot stream;
+(*
+            Some(Node((0,0), "PARSING_ERROR2",
+                   List.map Ctast.str
+		   (get_substring_list string_list this_pos
+                     (Stream.count stream))))
+*)
+	    ParseError ("PARSING_ERROR2",
+	      get_substring_list string_list this_pos (Stream.count stream))
+          end in
+    match first_ast with
+    | ParseOK (Some (loc,ast)) ->
+        let ast0 = (execute_when_necessary ast) in
+          (try xlate_vernac ast
+	  with e ->
+(*
+	    xlate_vernac 
+              (Node((0,0), "PARSING_ERROR2",
+               List.map Ctast.str
+		 (get_substring_list string_list this_pos
+		    (Stream.count stream)))))::parse_whole_stream()
+*)
+	    make_parse_error_item "PARSING_ERROR2" 
+		     (get_substring_list string_list this_pos
+		       (Stream.count stream)))::parse_whole_stream()
+    | ParseOK None -> []
+    | ParseError (s,l) -> 
+	(make_parse_error_item s l)::parse_whole_stream()
+ in
+    match parse_whole_stream () with
+    | first_one::tail -> (P_cl (CT_command_list(first_one, tail)))
+    | [] -> raise (UserError ("parse_string", (str "empty text.")));;
+
+(*When parsing a string using a phylum, the string is first transformed
+  into a Coq Ast using the regular Coq parser, then it is transformed into
+  the right ascent term using xlate functions, then it is transformed into
+  a stream, using the right vtp function. There is a special case for commands,
+  since some of these must be executed!*)
+let parse_string_action reqid phylum char_stream string_list =
+ try let msg =
+      match phylum with
+      | "COMMAND_LIST" ->
+        parse_command_list reqid char_stream string_list
+      | "COMMAND" ->
+       P_c
+        (xlate_vernac
+        (execute_when_necessary
+        (Gram.Entry.parse Pcoq.Vernac_.vernac_eoi (Gram.parsable char_stream))))
+      | "TACTIC_COM" ->
+       P_t
+        (xlate_tactic (Gram.Entry.parse Pcoq.Tactic.tactic_eoi 
+                         (Gram.parsable char_stream)))
+      | "FORMULA" ->
+       P_f
+        (xlate_formula
+	   (Gram.Entry.parse 
+              (Pcoq.eoi_entry Pcoq.Constr.lconstr) (Gram.parsable char_stream)))
+      | "ID" -> P_id (CT_ident
+                        (Libnames.string_of_qualid 
+			 (snd 
+			       (Gram.Entry.parse  (Pcoq.eoi_entry Pcoq.Prim.qualid)
+						 (Gram.parsable char_stream)))))
+      | "STRING" ->
+	  P_s
+         (CT_string (Gram.Entry.parse Pcoq.Prim.string 
+                  (Gram.parsable char_stream)))
+      | "INT" ->
+	  P_i (CT_int (Gram.Entry.parse Pcoq.Prim.natural
+                              (Gram.parsable char_stream)))
+      | _ -> error "parse_string_action : bad phylum" in
+      print_parse_results reqid msg
+ with
+ | Stdpp.Exc_located(l,Match_failure(_,_,_)) ->
+    flush_until_end_of_stream char_stream;
+    msgnl (ctf_SyntaxErrorMessage reqid
+              (Cerrors.explain_exn 
+                 (Stdpp.Exc_located(l,Stream.Error "match failure"))))
+ | e ->
+    flush_until_end_of_stream char_stream;
+    msgnl (ctf_SyntaxErrorMessage reqid (Cerrors.explain_exn e));;
+
+
+let quiet_parse_string_action char_stream =
+ try let _ = 
+         Gram.Entry.parse Pcoq.Vernac_.vernac_eoi (Gram.parsable char_stream) in
+     ()
+ with
+ | _ -> flush_until_end_of_stream char_stream; ();;
+
+
+let parse_file_action reqid file_name =
+ try let file_chan = open_in file_name in
+     (* file_chan_err, stream_err are the channel and stream  used to 
+        get the text when a syntax error occurs *)
+     let file_chan_err = open_in file_name in 
+     let stream = Stream.of_channel file_chan in
+     let stream_err = Stream.of_channel file_chan_err in
+     let rec discard_to_dot () =
+       try Gram.Entry.parse parse_to_dot (Gram.parsable stream)
+       with Stdpp.Exc_located(_,Token.Error _) -> discard_to_dot() in
+       match let rec parse_whole_file () =
+	 let this_pos = Stream.count stream in
+           match 
+             try
+	       ParseOK(Gram.Entry.parse Pcoq.main_entry (Gram.parsable stream))
+             with
+               | Stdpp.Exc_located(l,Stream.Error txt) -> 
+                   msgnl (ctf_SyntaxWarningMessage reqid
+			    (str "Error with file" ++ spc () ++
+			     str file_name ++ fnl () ++
+			     Cerrors.explain_exn 
+				 (Stdpp.Exc_located(l,Stream.Error txt))));
+		   (try 
+		      begin
+                      	discard_to_dot ();
+                    	ParseError ("PARSING_ERROR",
+				   (make_string_list file_chan_err this_pos 
+			       	      (Stream.count stream)))
+		      end
+                    with End_of_file -> ParseOK None)
+               | e ->
+                   begin
+                     Gram.Entry.parse parse_to_dot (Gram.parsable stream);
+                     ParseError ("PARSING_ERROR2",
+			       (make_string_list file_chan this_pos
+				  (Stream.count stream)))
+                   end
+		   
+             with
+               | ParseOK (Some (_,ast)) ->
+		   let ast0=(execute_when_necessary ast) in 
+		   let term =
+                     (try xlate_vernac ast
+		      with e ->
+                    	print_string ("translation error between " ^
+				      (string_of_int this_pos) ^
+				      " " ^
+				      (string_of_int (Stream.count stream)) ^
+				      "\n");
+			make_parse_error_item "PARSING_ERROR2"
+			  (make_string_list file_chan_err this_pos
+			    (Stream.count stream))) in 
+		     term::parse_whole_file ()
+               | ParseOK None -> []
+	       | ParseError (s,l) -> 
+		   (make_parse_error_item s l)::parse_whole_file () in
+         parse_whole_file () with
+	   | first_one :: tail ->
+	       print_parse_results reqid
+		 (P_cl (CT_command_list (first_one, tail)))
+	   | [] -> raise (UserError ("parse_file_action", str "empty file."))
+       with
+	 | Stdpp.Exc_located(l,Match_failure(_,_,_)) ->
+	     msgnl
+	       (ctf_SyntaxErrorMessage reqid
+		  (str "Error with file" ++ spc () ++ str file_name ++ 
+		   fnl () ++
+		     Cerrors.explain_exn
+		       (Stdpp.Exc_located(l,Stream.Error "match failure"))))
+	 | e ->
+	     msgnl
+	       (ctf_SyntaxErrorMessage reqid
+		  (str "Error with file" ++ spc () ++ str file_name ++
+		   fnl () ++ Cerrors.explain_exn e));;
+
+let add_rec_path_action reqid string_arg ident_arg =
+  let directory_name = glob string_arg in
+    begin
+      add_rec_path directory_name (Libnames.dirpath_of_string ident_arg)
+    end;;
+	
+
+let add_path_action reqid string_arg =
+  let directory_name = glob string_arg in
+    begin
+      add_path directory_name Names.empty_dirpath
+    end;;
+
+let print_version_action () =
+  msgnl (mt ());
+  msgnl (str "$Id: parse.ml,v 1.22 2004/04/21 08:36:58 barras Exp $");;
+
+let load_syntax_action reqid module_name =
+ msg (str "loading " ++ str module_name ++ str "... ");
+ try
+      (let qid = Libnames.make_short_qualid (Names.id_of_string module_name) in
+      read_library (dummy_loc,qid);
+      msg (str "opening... ");
+      Declaremods.import_module false (Nametab.locate_module qid); 
+      msgnl (str "done" ++ fnl ());
+      ())
+ with
+ | UserError (label, pp_stream) ->
+ (*This one may be necessary to make sure that the message won't be indented *)
+ msgnl (mt ());
+ msgnl
+  (fnl () ++ str "error while loading syntax module " ++ str module_name ++
+   str ": " ++ str label ++ fnl () ++ pp_stream)
+ | e ->
+  msgnl (mt ());
+  msgnl
+   (fnl () ++ str "message" ++ fnl () ++ str "load_error" ++ fnl () ++
+    int reqid ++ fnl ());
+  ();;
+
+let coqparser_loop inchan =
+ (parser_loop : (unit -> unit) *
+                (int -> string -> char Stream.t -> string list -> unit) *
+                (char Stream.t -> unit) * (int -> string -> unit) *
+                (int -> string -> unit) * (int -> string -> string -> unit) *
+                (int -> string -> unit) -> in_channel -> unit)
+ (print_version_action, parse_string_action, quiet_parse_string_action, parse_file_action,
+ add_path_action, add_rec_path_action, load_syntax_action) inchan;;
+
+if !Sys.interactive then ()
+ else 
+Libobject.relax true;
+(let coqdir = 
+   try Sys.getenv "COQDIR"
+   with Not_found -> 
+     let coqdir = Coq_config.coqlib in
+       if Sys.file_exists coqdir then
+	 coqdir
+       else
+	 (msgnl (str "could not find the value of COQDIR"); exit 1) in
+     begin
+       add_rec_path (Filename.concat coqdir "theories")
+	 (Names.make_dirpath [Nameops.coq_root]);
+       add_rec_path (Filename.concat coqdir "contrib")
+	 (Names.make_dirpath [Nameops.coq_root])
+     end;
+(let vernacrc =
+   try
+     Sys.getenv "VERNACRC"
+   with
+       Not_found -> 
+	 List.fold_left 
+	   (fun s1 s2 -> (Filename.concat s1 s2))
+	   coqdir [ "contrib"; "interface"; "vernacrc"] in
+   try
+     (Gramext.warning_verbose := false;
+      Esyntax.warning_verbose := false;
+      coqparser_loop (open_in vernacrc))
+   with
+     | End_of_file -> ()
+     | e ->
+	 (msgnl (Cerrors.explain_exn e);
+	  msgnl (str "could not load the VERNACRC file"));
+	 try
+	   msgnl (str vernacrc)
+	 with
+	     e -> ());
+(try let user_vernacrc =
+   try Some(Sys.getenv "USERVERNACRC")
+   with
+     | Not_found as e ->
+	 msgnl (str "no .vernacrc file"); None in
+   (match user_vernacrc with
+      	Some f -> coqparser_loop (open_in f)
+      | None -> ())
+ with
+   | End_of_file -> ()
+   | e ->
+       msgnl (Cerrors.explain_exn e);
+       msgnl (str "error in your .vernacrc file"));
+msgnl (str "Starting Centaur Specialized Parser Loop");
+try
+  coqparser_loop stdin
+with 
+  | End_of_file -> ()
+  | e -> msgnl(Cerrors.explain_exn e))
diff --git a/contrib/interface/paths.ml b/contrib/interface/paths.ml
new file mode 100644
index 00000000..b1244d15
--- /dev/null
+++ b/contrib/interface/paths.ml
@@ -0,0 +1,26 @@
+let int_list_to_string s l =
+    List.fold_left 
+       (fun s -> (fun v -> s ^ " " ^ (string_of_int v)))
+       s
+       l;;
+
+(* Given two paths, this function returns the longest common prefix and the
+   two suffixes. *)
+let rec decompose_path
+     : (int list * int list) -> (int list * int list * int list) =
+   function
+       (a::l,b::m) when a = b ->
+         let (c,p1,p2) = decompose_path (l,m) in
+         (a::c,p1,p2)
+     |  p1,p2 -> [], p1, p2;;
+
+let rec is_prefix p1 p2 = match p1,p2 with
+  [], _ -> true
+| a::tl1, b::tl2 when a = b -> is_prefix tl1 tl2
+| _ -> false;;
+
+let rec lex_smaller p1 p2 = match p1,p2 with
+  [], _ -> true
+| a::tl1, b::tl2 when a < b -> true
+| a::tl1, b::tl2 when a = b -> lex_smaller tl1 tl2
+| _ -> false;;
\ No newline at end of file
diff --git a/contrib/interface/paths.mli b/contrib/interface/paths.mli
new file mode 100644
index 00000000..26620723
--- /dev/null
+++ b/contrib/interface/paths.mli
@@ -0,0 +1,4 @@
+val decompose_path : (int list * int list) -> (int list * int list * int list);;
+val int_list_to_string : string -> int list -> string;;
+val is_prefix : int list -> int list -> bool;;
+val lex_smaller : int list -> int list -> bool;;
diff --git a/contrib/interface/pbp.ml b/contrib/interface/pbp.ml
new file mode 100644
index 00000000..e0f88ba6
--- /dev/null
+++ b/contrib/interface/pbp.ml
@@ -0,0 +1,758 @@
+(* A proof by pointing algorithm. *)
+open Util;;
+open Names;;
+open Term;;
+open Tactics;;
+open Tacticals;;
+open Hipattern;;
+open Pattern;;
+open Matching;;
+open Reduction;;
+open Rawterm;;
+open Environ;;
+
+open Proof_trees;;
+open Proof_type;;
+open Tacmach;;
+open Tacexpr;;
+open Typing;;
+open Pp;;
+open Libnames;;
+open Genarg;;
+open Topconstr;;
+open Termops;;
+
+let zz = Util.dummy_loc;;
+
+let hyp_radix = id_of_string "H";;
+
+let next_global_ident = next_global_ident_away true
+
+(* get_hyp_by_name : goal sigma -> string -> constr,
+   looks up for an hypothesis (or a global constant), from its name *)
+let get_hyp_by_name g name =
+  let evd = project g in
+  let env = pf_env g in
+  try (let judgment = 
+         Pretyping.understand_judgment 
+          evd env (RVar(zz, name)) in
+       ("hyp",judgment.uj_type))
+(* je sais, c'est pas beau, mais je ne sais pas trop me servir de look_up...
+   Loïc *)
+  with _ -> (let c = Nametab.global (Ident (zz,name)) in
+             ("cste",type_of (Global.env()) Evd.empty (constr_of_reference c)))
+;;
+
+type pbp_atom =
+  | PbpTryAssumption of identifier option
+  | PbpTryClear of identifier list
+  | PbpGeneralize of identifier * identifier list
+  | PbpLApply of identifier (* = CutAndApply *)
+  | PbpIntros of intro_pattern_expr list
+  | PbpSplit
+  (* Existential *)
+  | PbpExists of identifier
+  (* Or *)
+  | PbpLeft
+  | PbpRight
+  (* Head *)
+  | PbpApply of identifier
+  | PbpElim of identifier * identifier list;;
+
+(* Invariant: In PbpThens ([a1;...;an],[t1;...;tp]), all tactics
+   [a1]..[an-1] are atomic (or try of an atomic) tactic and produce
+   exactly one goal, and [an] produces exactly p subgoals
+
+   In [PbpThen [a1;..an]], all tactics are (try of) atomic tactics and
+   produces exactly one subgoal, except the last one which may complete the
+   goal
+
+   Convention: [PbpThen []] is Idtac and [PbpThen t] is a coercion
+   from atomic to composed tactic
+*)
+
+type pbp_sequence =
+  | PbpThens of pbp_atom list * pbp_sequence list
+  | PbpThen of pbp_atom list
+
+(* This flattens sequences of tactics producing just one subgoal *)
+let chain_tactics tl1 = function
+  | PbpThens (tl2, tl3) -> PbpThens (tl1@tl2, tl3)
+  | PbpThen tl2 -> PbpThen (tl1@tl2)
+
+type pbp_rule = (identifier list *
+                    identifier list *
+                    bool *
+                    identifier option *
+                    (types, constr) kind_of_term *
+                    int list *
+                    (identifier list ->
+                     identifier list ->
+                     bool ->
+                       identifier option -> (types, constr) kind_of_term -> int list -> pbp_sequence)) ->
+                    pbp_sequence option;;
+
+
+let make_named_intro id = PbpIntros [IntroIdentifier id];;
+
+let make_clears str_list = PbpThen [PbpTryClear str_list]
+
+let add_clear_names_if_necessary tactic clear_names =
+    match clear_names with
+      [] -> tactic
+    | l -> chain_tactics [PbpTryClear l] tactic;;
+
+let make_final_cmd f optname clear_names constr path =
+    add_clear_names_if_necessary (f optname constr path) clear_names;;
+
+let (rem_cast:pbp_rule) = function
+    (a,c,cf,o, Cast(f,_), p, func) ->
+      Some(func a c cf o (kind_of_term f) p)
+  | _ -> None;;
+
+let (forall_intro: pbp_rule) = function
+  (avoid,
+   clear_names,
+   clear_flag,
+   None,
+   Prod(Name x, _, body),
+   (2::path),
+   f) ->
+     let x' = next_global_ident x avoid in
+      Some(chain_tactics [make_named_intro x']
+	      (f (x'::avoid)
+		clear_names clear_flag None (kind_of_term body) path))
+| _ -> None;;
+
+let (imply_intro2: pbp_rule) = function
+  avoid, clear_names,
+  clear_flag, None, Prod(Anonymous, _, body), 2::path, f ->
+   let h' = next_global_ident hyp_radix avoid in
+     Some(chain_tactics [make_named_intro h']
+          (f (h'::avoid) clear_names clear_flag None (kind_of_term body) path))
+  | _ -> None;;
+
+      
+(*
+let (imply_intro1: pbp_rule) = function
+  avoid, clear_names,
+  clear_flag, None, Prod(Anonymous, prem, body), 1::path, f ->
+   let h' = next_global_ident hyp_radix avoid in
+   let str_h' = h' in
+     Some(chain_tactics [make_named_intro str_h']
+            (f (h'::avoid) clear_names clear_flag (Some str_h') 
+		(kind_of_term prem) path))
+  | _ -> None;;
+*)
+
+let make_var id = CRef (Ident(zz, id))
+
+let make_app f l = CApp (zz,(None,f),List.map (fun x -> (x,None)) l)
+
+let make_pbp_pattern x =
+  make_app (make_var (id_of_string "PBP_META"))
+     [make_var (id_of_string ("Value_for_" ^ (string_of_id x)))]
+
+let rec make_then = function
+  | [] -> TacId ""
+  | [t] -> t
+  | t1::t2::l -> make_then (TacThen (t1,t2)::l)
+
+let make_pbp_atomic_tactic = function
+  | PbpTryAssumption None -> TacTry (TacAtom (zz, TacAssumption))
+  | PbpTryAssumption (Some a) ->
+      TacTry (TacAtom (zz, TacExact (make_var a)))
+  | PbpExists x -> 
+      TacAtom (zz, TacSplit (true,ImplicitBindings [make_pbp_pattern x]))
+  | PbpGeneralize (h,args) ->
+      let l = List.map make_pbp_pattern args in
+      TacAtom (zz, TacGeneralize [make_app (make_var h) l])
+  | PbpLeft -> TacAtom (zz, TacLeft NoBindings)
+  | PbpRight -> TacAtom (zz, TacRight NoBindings)
+  | PbpIntros l -> TacAtom (zz, TacIntroPattern l)
+  | PbpLApply h -> TacAtom (zz, TacLApply (make_var h))
+  | PbpApply h -> TacAtom (zz, TacApply (make_var h,NoBindings))
+  | PbpElim (hyp_name, names) ->
+      let bind = List.map (fun s ->(zz,NamedHyp s,make_pbp_pattern s)) names in
+      TacAtom
+	(zz, TacElim ((make_var hyp_name,ExplicitBindings bind),None))
+  | PbpTryClear l -> 
+      TacTry (TacAtom (zz, TacClear (List.map (fun s -> AI (zz,s)) l)))
+  | PbpSplit -> TacAtom (zz, TacSplit (false,NoBindings));;
+
+let rec make_pbp_tactic = function
+  | PbpThen tl -> make_then (List.map make_pbp_atomic_tactic tl)
+  | PbpThens (l,tl) ->
+      TacThens
+        (make_then (List.map make_pbp_atomic_tactic l),
+	 List.map make_pbp_tactic tl)
+
+let (forall_elim: pbp_rule) = function
+  avoid, clear_names, clear_flag, 
+  Some h, Prod(Name x, _, body), 2::path, f ->
+  let h' = next_global_ident hyp_radix avoid in
+  let clear_names' = if clear_flag then h::clear_names else clear_names in
+    Some
+     (chain_tactics [PbpGeneralize (h,[x]); make_named_intro h']
+        (f (h'::avoid) clear_names' true (Some h') (kind_of_term body) path))
+  | _ -> None;;
+
+
+let (imply_elim1: pbp_rule) = function
+  avoid, clear_names, clear_flag,
+  Some h, Prod(Anonymous, prem, body), 1::path, f ->
+  let clear_names' = if clear_flag then h::clear_names else clear_names in
+  let h' = next_global_ident hyp_radix avoid in
+  let str_h' = (string_of_id h') in
+  Some(PbpThens
+	  ([PbpLApply h],
+	   [chain_tactics [make_named_intro h'] (make_clears (h::clear_names));
+	    f avoid clear_names' false None (kind_of_term prem) path]))
+  | _ -> None;;
+
+
+let (imply_elim2: pbp_rule) = function
+  avoid, clear_names, clear_flag,
+  Some h, Prod(Anonymous, prem, body), 2::path, f ->
+  let clear_names' = if clear_flag then h::clear_names else clear_names in
+  let h' = next_global_ident hyp_radix avoid in
+  Some(PbpThens
+	 ([PbpLApply h],
+          [chain_tactics [make_named_intro h']
+              (f (h'::avoid) clear_names' false (Some h') 
+		      (kind_of_term body) path);
+           make_clears clear_names]))
+  | _ -> None;;
+
+let reference dir s = Coqlib.gen_reference "Pbp" ("Init"::dir) s
+
+let constant dir s =  Coqlib.gen_constant "Pbp" ("Init"::dir) s
+
+let andconstr: unit -> constr = Coqlib.build_coq_and;;
+let prodconstr () = constant ["Datatypes"] "prod";;
+let exconstr = Coqlib.build_coq_ex;;
+let sigconstr () = constant ["Specif"] "sig";;
+let sigTconstr () = (Coqlib.build_sigma_type()).Coqlib.typ;;
+let orconstr = Coqlib.build_coq_or;;
+let sumboolconstr = Coqlib.build_coq_sumbool;;
+let sumconstr() = constant ["Datatypes"] "sum";;
+let notconstr = Coqlib.build_coq_not;;
+let notTconstr () = constant ["Logic_Type"] "notT";;
+
+let is_matching_local a b = is_matching (pattern_of_constr a) b;;
+
+let rec (or_and_tree_to_intro_pattern: identifier list -> 
+	   constr -> int list -> 
+	     intro_pattern_expr * identifier list * identifier *constr
+	     * int list * int * int) =
+fun avoid c path -> match kind_of_term c, path with
+  | (App(oper, [|c1; c2|]), 2::a::path)
+    when ((is_matching_local (andconstr()) oper) or
+	  (is_matching_local (prodconstr()) oper)) & (a = 1 or a = 2) ->
+      let id2 = next_global_ident hyp_radix avoid in
+      let cont_expr = if a = 1 then c1 else c2 in
+      let cont_patt, avoid_names, id, c, path, rank, total_branches = 
+	or_and_tree_to_intro_pattern (id2::avoid) cont_expr path in
+      let patt_list = 
+	if a = 1 then
+	  [cont_patt; IntroIdentifier id2]
+	else
+	  [IntroIdentifier id2; cont_patt] in
+      	(IntroOrAndPattern[patt_list], avoid_names, id, c, path, rank, 
+	 total_branches)
+  | (App(oper, [|c1; c2|]), 2::3::path)
+    when ((is_matching_local (exconstr()) oper) or
+	  (is_matching_local (sigconstr()) oper)) ->
+      (match (kind_of_term c2) with 
+	   Lambda (Name x, _, body) ->
+	     let id1 = next_global_ident x avoid in
+	     let cont_patt, avoid_names, id, c, path, rank, total_branches =
+	       or_and_tree_to_intro_pattern (id1::avoid) body path in
+	     (IntroOrAndPattern[[IntroIdentifier id1; cont_patt]],
+	      avoid_names, id, c, path, rank, total_branches)
+	 | _ -> assert false)
+  | (App(oper, [|c1; c2|]), 2::a::path)
+      when ((is_matching_local (orconstr ()) oper) or
+            (is_matching_local (sumboolconstr ()) oper) or
+	    (is_matching_local (sumconstr ()) oper)) & (a = 1 or a = 2) ->
+      let id2 = next_global_ident hyp_radix avoid in
+      let cont_expr = if a = 1 then c1 else c2 in
+      let cont_patt, avoid_names, id, c, path, rank, total_branches =
+ 	or_and_tree_to_intro_pattern (id2::avoid) cont_expr path in
+      let new_rank = if a = 1 then rank else rank+1 in
+      let patt_list =
+	if a = 1 then
+	  [[cont_patt];[IntroIdentifier id2]]
+	else
+	  [[IntroIdentifier id2];[cont_patt]] in
+	(IntroOrAndPattern patt_list, 
+	 avoid_names, id, c, path, new_rank, total_branches+1)
+  | (_, path) -> let id = next_global_ident hyp_radix avoid in
+      (IntroIdentifier id, (id::avoid), id, c, path, 1, 1);;
+
+let auxiliary_goals clear_names clear_flag this_name n_aux others =
+  let clear_cmd = 
+    make_clears (if clear_flag then (this_name ::clear_names) else clear_names) in
+  let rec clear_list = function
+      0 -> others
+    | n -> clear_cmd::(clear_list (n - 1)) in
+  clear_list n_aux;;
+
+
+let (imply_intro3: pbp_rule) = function
+    avoid, clear_names, clear_flag, None, Prod(Anonymous, prem, body),
+    1::path, f ->
+      let intro_patt, avoid_names, id, c, p, rank, total_branches =
+	or_and_tree_to_intro_pattern avoid prem path in
+	if total_branches = 1 then
+	  Some(chain_tactics [PbpIntros [intro_patt]]
+		 (f avoid_names clear_names clear_flag (Some id)
+		    (kind_of_term c) path))
+	else
+	  Some
+	    (PbpThens
+	       ([PbpIntros [intro_patt]],
+	    	auxiliary_goals clear_names clear_flag id
+		  (rank - 1)
+		  ((f avoid_names clear_names clear_flag (Some id)
+		      (kind_of_term c) path)::
+		     auxiliary_goals clear_names clear_flag id 
+		     (total_branches - rank) [])))
+  | _ -> None;;
+		 
+
+
+let (and_intro: pbp_rule) = function
+    avoid, clear_names, clear_flag,
+    None, App(and_oper, [|c1; c2|]), 2::a::path, f 
+      ->
+      if ((is_matching_local (andconstr()) and_oper) or
+          (is_matching_local (prodconstr ()) and_oper)) & (a = 1 or a = 2) then
+      	let cont_term = if a = 1 then c1 else c2 in
+      	let cont_cmd = f avoid clear_names false None 
+			 (kind_of_term cont_term) path in
+      	let clear_cmd = make_clears clear_names in
+      	let cmds =
+            (if a = 1 
+	    then [cont_cmd;clear_cmd] 
+	    else [clear_cmd;cont_cmd]) in
+      	Some (PbpThens ([PbpSplit],cmds))
+      else None
+  | _ -> None;;
+
+let exists_from_lambda avoid clear_names clear_flag c2 path f =
+  match kind_of_term c2 with
+    Lambda(Name x, _, body) -> 
+      Some (PbpThens ([PbpExists x],
+		      [f avoid clear_names false None (kind_of_term body) path]))
+  | _ -> None;;
+
+
+let (ex_intro: pbp_rule) = function
+    avoid, clear_names, clear_flag, None,
+    App(oper, [| c1; c2|]), 2::3::path, f
+      when (is_matching_local (exconstr ()) oper)
+ 	or (is_matching_local (sigconstr ()) oper) ->
+	  exists_from_lambda avoid clear_names clear_flag c2 path f
+  | _ -> None;;
+
+let (exT_intro : pbp_rule) = function
+    avoid, clear_names, clear_flag, None,
+    App(oper, [| c1; c2|]), 2::2::2::path, f
+      when (is_matching_local (sigTconstr ()) oper) ->
+	exists_from_lambda avoid clear_names clear_flag c2 path f
+  | _ -> None;;
+
+let (or_intro: pbp_rule) = function
+    avoid, clear_names, clear_flag, None,
+    App(or_oper, [|c1; c2 |]), 2::a::path, f ->
+      if ((is_matching_local (orconstr ()) or_oper) or
+        (is_matching_local (sumboolconstr ()) or_oper) or 
+	(is_matching_local (sumconstr ()) or_oper))
+	  & (a = 1 or a = 2) then
+	let cont_term = if a = 1 then c1 else c2 in
+	let fst_cmd = if a = 1 then PbpLeft else PbpRight in
+	let cont_cmd = f avoid clear_names false None 
+			 (kind_of_term cont_term) path in
+	Some(chain_tactics [fst_cmd] cont_cmd)
+      else
+	None
+  | _ -> None;;
+	
+let dummy_id = id_of_string "Dummy";;
+
+let (not_intro: pbp_rule) = function
+    avoid, clear_names, clear_flag, None,
+    App(not_oper, [|c1|]), 2::1::path, f ->
+      if(is_matching_local (notconstr ()) not_oper) or 
+	(is_matching_local (notTconstr ()) not_oper) then
+	let h' = next_global_ident hyp_radix avoid in
+	Some(chain_tactics [make_named_intro h']
+	       (f (h'::avoid) clear_names false (Some h') 
+		  (kind_of_term c1) path))
+      else
+ 	None
+  | _ -> None;;
+
+
+
+
+let elim_with_bindings hyp_name names =
+  PbpElim (hyp_name, names);;
+
+(* This function is used to follow down a path, while staying on the spine of
+   successive products (universal quantifications or implications).
+   Arguments are the current observed constr object and the path that remains
+   to be followed, and an integer indicating how many products have already been
+   crossed.
+   Result is:
+     - a list of string indicating the names of universally quantified variables.
+     - a list of integers indicating the positions of the successive 
+       universally quantified variables.
+     - an integer indicating the number of non-dependent products.
+     - the last constr object encountered during the walk down, and
+     - the remaining path.
+
+   For instance the following session should happen:
+  let tt = raw_constr_of_com (Evd.mt_evd())(gLOB(initial_sign()))
+     (parse_com "(P:nat->Prop)(x:nat)(P x)->(P x)") in
+     down_prods (tt, [2;2;2], 0)
+  ---> ["P","x"],[0;1], 1, <<(P x)>>, []
+*)
+
+
+let rec down_prods: (types, constr) kind_of_term * (int list) * int -> 
+           identifier list * (int list) * int * (types, constr) kind_of_term *
+  (int list) = 
+   function
+     Prod(Name x, _, body), 2::path, k ->
+	let res_sl, res_il, res_i, res_cstr, res_p 
+	    = down_prods (kind_of_term body, path, k+1) in
+	x::res_sl, (k::res_il), res_i, res_cstr, res_p
+   | Prod(Anonymous, _, body), 2::path, k ->
+        let res_sl, res_il, res_i, res_cstr, res_p 
+	    = down_prods (kind_of_term body, path, k+1) in
+	res_sl, res_il, res_i+1, res_cstr, res_p
+   | cstr, path, _ -> [], [], 0, cstr, path;;
+
+exception Pbp_internal of int list;;
+
+(* This function should be usable to check that a type can be used by the
+   Apply command.  Basically, c is supposed to be the head of some
+   type, where l gives the ranks of all universally quantified variables.
+   It check that these universally quantified variables occur in the head.
+
+   The knowledge I have on constr structures is incomplete.
+*)
+let (check_apply: (types, constr) kind_of_term -> (int list) -> bool) = 
+   function c -> function l ->
+   let rec delete n = function
+     | [] -> []
+     | p::tl -> if n = p then tl else p::(delete n tl) in
+   let rec check_rec l = function
+   | App(f, array) ->
+       Array.fold_left (fun l c -> check_rec l (kind_of_term c))
+	 (check_rec l (kind_of_term f)) array
+   | Const _ -> l
+   | Ind _ -> l
+   | Construct _ -> l
+   | Var _ -> l
+   | Rel p ->
+       let result = delete p l in
+       if result = [] then
+	 raise (Pbp_internal [])
+       else
+	 result
+   | _ -> raise (Pbp_internal l) in
+   try 
+     (check_rec l c) = []
+   with Pbp_internal l -> l = [];;
+
+let (mk_db_indices: int list -> int -> int list) =
+  function int_list -> function nprems ->
+   let total = (List.length int_list) + nprems  in
+   let rec mk_db_aux = function
+     [] -> []
+   | a::l -> (total - a)::(mk_db_aux l) in
+   mk_db_aux int_list;;
+     
+
+(* This proof-by-pointing rule is quite complicated, as it attempts to foresee
+   usages of head tactics.  A first operation is to follow the path as far
+   as possible while staying on the spine of products (function down_prods)
+   and then to check whether the next step will be an elim step.  If the 
+   answer is true, then the built command takes advantage of the power of
+   head tactics.  *)
+
+let (head_tactic_patt: pbp_rule) = function
+    avoid, clear_names, clear_flag, Some h, cstr, path, f ->
+    (match down_prods (cstr, path, 0) with
+    | (str_list, _, nprems, App(oper,[|c1; c2|]), b::a::path)
+      when (((is_matching_local (exconstr ()) oper) (* or
+	      (is_matching_local (sigconstr ()) oper) *))  && a = 3) ->
+		   (match (kind_of_term c2) with
+		     Lambda(Name x, _,body) ->
+		       Some(PbpThens
+		    		 ([elim_with_bindings h str_list],
+				   let x' = next_global_ident x avoid in
+				   let cont_body =
+				     Prod(Name x', c1,
+					    mkProd(Anonymous, body, 
+						   mkVar(dummy_id))) in
+				   let cont_tac 
+				       = f avoid (h::clear_names) false None
+				       cont_body (2::1::path) in
+				   cont_tac::(auxiliary_goals
+						       clear_names clear_flag
+						       h nprems [])))
+		     | _ -> None)
+    | (str_list, _, nprems, 
+       App(oper,[|c1|]), 2::1::path) 
+      	when
+ 	  (is_matching_local (notconstr ()) oper) or
+ 	  (is_matching_local (notTconstr ()) oper) ->
+	 Some(chain_tactics [elim_with_bindings h str_list]
+		 (f avoid clear_names false None (kind_of_term c1) path))
+    | (str_list, _, nprems, 
+       App(oper, [|c1; c2|]), 2::a::path) 
+      when ((is_matching_local (andconstr()) oper) or
+	    (is_matching_local (prodconstr()) oper)) & (a = 1 or a = 2) ->
+	let h1 = next_global_ident hyp_radix avoid in
+	let h2 = next_global_ident hyp_radix (h1::avoid) in
+	Some(PbpThens
+                  ([elim_with_bindings h str_list],
+		    let cont_body = 
+		      if a = 1 then c1 else c2 in
+		    let cont_tac = 
+		      f (h2::h1::avoid) (h::clear_names) 
+                        false (Some (if 1 = a then h1 else h2))
+                        (kind_of_term cont_body) path in
+		      (chain_tactics 
+			 [make_named_intro h1; make_named_intro h2]
+			 cont_tac)::
+	       (auxiliary_goals clear_names clear_flag h nprems [])))
+    | (str_list, _, nprems, App(oper,[|c1; c2|]), 2::a::path)
+      when ((is_matching_local (sigTconstr()) oper)) & a = 2 ->
+		   (match (kind_of_term c2),path with
+		     Lambda(Name x, _,body), (2::path) ->
+		       Some(PbpThens
+		    		 ([elim_with_bindings h str_list],
+				   let x' = next_global_ident x avoid in
+				   let cont_body =
+				     Prod(Name x', c1,
+					    mkProd(Anonymous, body, 
+						   mkVar(dummy_id))) in
+				   let cont_tac 
+				       = f avoid (h::clear_names) false None
+				       cont_body (2::1::path) in
+				   cont_tac::(auxiliary_goals
+						       clear_names clear_flag
+						       h nprems [])))
+		     | _ -> None)
+    | (str_list, _, nprems, App(oper,[|c1; c2|]), 2::a::path)
+	when ((is_matching_local (orconstr ()) oper) or
+              (is_matching_local (sumboolconstr ()) oper) or
+	      (is_matching_local (sumconstr ()) oper)) &
+                (a = 1 or a = 2) ->
+	  Some(PbpThens
+		    ([elim_with_bindings h str_list],
+		      let cont_body =
+			if a = 1 then c1 else c2 in
+                      (* h' is the name for the new intro *)
+		      let h' = next_global_ident hyp_radix avoid in
+		      let cont_tac =
+                        chain_tactics 
+			  [make_named_intro h']
+			  (f 
+			     (* h' should not be used again *)
+			     (h'::avoid)
+			     (* the disjunct itself can be discarded *)
+			     (h::clear_names) false (Some h')
+                             (kind_of_term cont_body) path) in
+		      let snd_tac = 
+			chain_tactics
+			   [make_named_intro h']
+			   (make_clears (h::clear_names)) in
+		      let tacs1 = 
+			if a = 1 then
+			  [cont_tac; snd_tac]
+		      	else
+			  [snd_tac; cont_tac] in
+		      tacs1@(auxiliary_goals (h::clear_names)
+				   false dummy_id nprems [])))
+    | (str_list, int_list, nprems, c, []) 
+        when  (check_apply c (mk_db_indices int_list nprems)) &
+              (match c with Prod(_,_,_) -> false
+              |  _ -> true) &
+              (List.length int_list) + nprems > 0 ->
+          Some(add_clear_names_if_necessary (PbpThen [PbpApply h]) clear_names)
+    | _ -> None)
+  | _ -> None;;
+      
+
+let pbp_rules = ref [rem_cast;head_tactic_patt;forall_intro;imply_intro2;
+                      forall_elim; imply_intro3; imply_elim1; imply_elim2;
+		      and_intro; or_intro; not_intro; ex_intro; exT_intro];;
+
+
+let try_trace = ref true;;
+
+let traced_try (f1:tactic) g =
+    try (try_trace := true; tclPROGRESS f1 g)
+    with e when Logic.catchable_exception e ->
+      (try_trace := false; tclIDTAC g);;
+
+let traced_try_entry = function
+     [Tacexp t] ->
+           traced_try (Tacinterp.interp t)
+  |  _ -> failwith "traced_try_entry received wrong arguments";;
+
+
+(* When the recursive descent along the path is over, one includes the
+   command requested by the point-and-shoot strategy.  Default is
+   Try Assumption--Try Exact.  *)
+
+
+let default_ast optname constr path = PbpThen [PbpTryAssumption optname]
+
+(* This is the main proof by pointing function. *)
+(* avoid: les noms a ne pas utiliser *)
+(* final_cmd: la fonction appelee par defaut *)
+(* opt_name: eventuellement le nom de l'hypothese sur laquelle on agit *)
+
+let rec pbpt final_cmd avoid clear_names clear_flag opt_name constr path =
+  let rec try_all_rules rl =
+      match rl with 
+         f::tl ->
+           (match f (avoid, clear_names, clear_flag,
+                     opt_name, constr, path, pbpt final_cmd) with
+              Some(ast) -> ast
+            | None -> try_all_rules tl)
+      |	 [] -> make_final_cmd final_cmd opt_name clear_names constr path
+  in try_all_rules (!pbp_rules);;
+
+(* these are the optimisation functions. *)
+(* This function takes care of flattening successive then commands. *)
+
+
+(* Invariant: in [flatten_sequence t], occurrences of [PbpThenCont(l,t)] enjoy
+    that t is some [PbpAtom t] *)
+
+(* This optimization function takes care of compacting successive Intro commands
+   together. *)
+
+let rec group_intros names = function
+    [] -> (match names with
+        [] -> []
+      | l -> [PbpIntros l])
+  | (PbpIntros ids)::others -> group_intros (names@ids) others
+  | t1::others ->
+      (match names with
+	  [] -> t1::(group_intros [] others)
+	| l -> (PbpIntros l)::t1::(group_intros [] others))
+
+let rec optim2 = function
+  | PbpThens (tl1,tl2) -> PbpThens (group_intros [] tl1, List.map optim2 tl2)
+  | PbpThen tl -> PbpThen (group_intros [] tl)
+
+
+let rec cleanup_clears str_list = function
+    [] -> []
+  | x::tail ->
+      if List.mem x str_list then cleanup_clears str_list tail
+      else x::(cleanup_clears str_list tail);;
+
+(* This function takes care of compacting instanciations of universal
+   quantifications. *)
+
+let rec optim3_aux str_list = function
+    (PbpGeneralize (h,l1))::
+    (PbpIntros [IntroIdentifier s])::(PbpGeneralize (h',l2))::others
+      when s=h' ->
+      optim3_aux (s::str_list) (PbpGeneralize (h,l1@l2)::others)
+  | (PbpTryClear names)::other ->
+      (match cleanup_clears str_list names with
+	  [] -> other
+	| l -> (PbpTryClear l)::other)
+  | a::l -> a::(optim3_aux str_list l) 
+  | [] -> [];;
+
+let rec optim3 str_list = function
+    PbpThens (tl1, tl2) ->
+      PbpThens (optim3_aux str_list tl1, List.map (optim3 str_list) tl2)
+  | PbpThen tl -> PbpThen (optim3_aux str_list tl)
+
+let optim x = make_pbp_tactic (optim3 [] (optim2 x));;
+
+(* TODO
+add_tactic "Traced_Try" traced_try_entry;;
+*)
+
+let rec tactic_args_to_ints = function
+    [] -> []
+  | (Integer n)::l -> n::(tactic_args_to_ints l)
+  | _ -> failwith "expecting only numbers";;
+
+(*
+let pbp_tac display_function = function 
+            (Identifier a)::l -> 
+                 (function g ->
+                    let str = (string_of_id a) in
+		    let (ou,tstr) = (get_hyp_by_name g str) in
+		    let exp_ast =
+		      pbpt default_ast
+		        (match ou with
+			       "hyp" ->(pf_ids_of_hyps g)
+			       |_ -> (a::(pf_ids_of_hyps g)))
+                        []
+			false
+			(Some str)
+			(kind_of_term tstr)
+                        (tactic_args_to_ints l) in
+                    (display_function (optim exp_ast);
+                        tclIDTAC g))
+          | ((Integer n)::_) as l -> 
+                 (function g ->
+                    let exp_ast =
+                       (pbpt default_ast (pf_ids_of_hyps g) [] false
+                          None (kind_of_term (pf_concl g))
+			  (tactic_args_to_ints l)) in
+                     (display_function (optim exp_ast);
+                       tclIDTAC g))
+          | [] -> (function g ->
+                     (display_function (default_ast None (pf_concl g) []);
+                      tclIDTAC g))
+          |  _ -> failwith "expecting other arguments";;
+
+
+*)
+let pbp_tac display_function idopt nl =
+  match idopt with
+    | Some str ->
+        (function g ->
+	  let (ou,tstr) = (get_hyp_by_name g str) in
+	  let exp_ast =
+	    pbpt default_ast
+	      (match ou with
+		  "hyp" ->(pf_ids_of_hyps g)
+		|_ -> (str::(pf_ids_of_hyps g)))
+              []
+	      false
+	      (Some str)
+	      (kind_of_term tstr)
+              nl in
+              (display_function (optim exp_ast); tclIDTAC g))
+    | None ->
+	if nl <> [] then
+          (function g ->
+            let exp_ast =
+              (pbpt default_ast (pf_ids_of_hyps g) [] false
+		None (kind_of_term (pf_concl g)) nl) in
+            (display_function (optim exp_ast); tclIDTAC g))
+	else
+          (function g ->
+            (display_function
+	       (make_pbp_tactic (default_ast None (pf_concl g) []));
+            tclIDTAC g));;
+
+
diff --git a/contrib/interface/pbp.mli b/contrib/interface/pbp.mli
new file mode 100644
index 00000000..43ec1274
--- /dev/null
+++ b/contrib/interface/pbp.mli
@@ -0,0 +1,4 @@
+val pbp_tac : (Tacexpr.raw_tactic_expr -> 'a) ->
+    Names.identifier option -> int list ->
+    Proof_type.goal Tacmach.sigma ->
+    Proof_type.goal list Proof_type.sigma * Proof_type.validation;;
diff --git a/contrib/interface/showproof.ml b/contrib/interface/showproof.ml
new file mode 100644
index 00000000..5b265ec8
--- /dev/null
+++ b/contrib/interface/showproof.ml
@@ -0,0 +1,1899 @@
+(*
+#use "/cygdrive/D/Tools/coq-7avril/dev/base_include";;
+open Coqast;;
+*)
+open Environ
+open Evd
+open Names
+open Nameops
+open Libnames
+open Term
+open Termops
+open Util
+open Proof_type
+open Coqast
+open Pfedit
+open Translate
+open Term
+open Reductionops
+open Clenv
+open Typing
+open Inductive
+open Inductiveops
+open Vernacinterp
+open Declarations
+open Showproof_ct
+open Proof_trees
+open Sign
+open Pp
+open Printer
+open Rawterm
+open Tacexpr
+open Genarg
+(*****************************************************************************)
+(*
+   Arbre de preuve maison:
+   
+*)
+
+(* hypotheses *)
+
+type nhyp = {hyp_name : identifier;
+             hyp_type : Term.constr;
+             hyp_full_type: Term.constr}
+;;
+
+type ntactic = tactic_expr
+;;
+
+type nproof =
+    Notproved
+  | Proof of ntactic * (ntree list)
+
+and ngoal=
+     {newhyp : nhyp list;
+      t_concl : Term.constr;
+      t_full_concl: Term.constr;
+      t_full_env: Sign.named_context}
+and ntree=
+      {t_info:string;
+	t_goal:ngoal;
+       	t_proof : nproof}
+;;
+
+
+let hyps {t_info=info;
+	 t_goal={newhyp=lh;t_concl=g;t_full_concl=gf;t_full_env=ge};
+	 t_proof=p} = lh
+;;
+
+let concl {t_info=info;
+	 t_goal={newhyp=lh;t_concl=g;t_full_concl=gf;t_full_env=ge};
+	 t_proof=p} = g
+;;
+
+let proof {t_info=info;
+	 t_goal={newhyp=lh;t_concl=g;t_full_concl=gf;t_full_env=ge};
+	 t_proof=p} = p
+;;
+let g_env {t_info=info;
+	 t_goal={newhyp=lh;t_concl=g;t_full_concl=gf;t_full_env=ge};
+	 t_proof=p} = ge
+;;
+let sub_ntrees t =
+  match (proof t) with
+    Notproved -> []
+  | Proof (_,l) -> l
+;;
+
+let tactic t =
+  match (proof t) with
+    Notproved -> failwith "no tactic applied"
+  | Proof (t,_) -> t
+;;
+
+
+(* 
+un arbre est clos s'il ne contient pas de sous-but non prouves,
+ou bien s'il a un cousin gauche qui n'est pas clos 
+ce qui fait qu'on a au plus un sous-but non clos, le premier sous-but.
+*)
+let update_closed nt =
+  let found_not_closed=ref false in
+  let rec update {t_info=b; t_goal=g; t_proof =p} =
+    if !found_not_closed
+    then  {t_info="to_prove"; t_goal=g; t_proof =p}
+    else
+      match p with
+      	Notproved -> found_not_closed:=true;
+	  {t_info="not_proved"; t_goal=g; t_proof =p}
+      | Proof(tac,lt) ->
+	  let lt1=List.map update lt in
+	  let b=ref "proved" in
+	  (List.iter
+	     (fun x ->
+	       if x.t_info ="not_proved" then b:="not_proved") lt1;
+	   {t_info=(!b);
+	     t_goal=g;
+             t_proof=Proof(tac,lt1)})
+  in update nt
+    ;;
+    
+      
+(*
+    type complet avec les hypotheses.
+*)
+
+let long_type_hyp lh t=
+   let t=ref t in
+   List.iter (fun (n,th) ->
+         let ni = match n with Name ni -> ni | _ -> assert false in
+         t:= mkProd(n,th,subst_term (mkVar ni) !t))
+       (List.rev lh);
+   !t
+;;
+
+(* let long_type_hyp x y = y;; *)
+
+(* Expansion des tactikelles *)
+
+let seq_to_lnhyp sign sign' cl =
+      let lh= ref (List.map (fun (x,c,t) -> (Name x, t)) sign) in
+      let nh=List.map (fun (id,c,ty) -> 
+             {hyp_name=id;
+              hyp_type=ty;
+              hyp_full_type=
+                let res= long_type_hyp !lh ty in
+                lh:=(!lh)@[(Name id,ty)];
+                res})
+              sign'
+      in
+      {newhyp=nh;
+       t_concl=cl;
+       t_full_concl=long_type_hyp !lh cl;
+       t_full_env = sign@sign'}
+;;
+
+
+let rule_is_complex r =
+   match r with
+      Tactic (TacArg (Tacexp t),_) -> true  
+   |  Tactic (TacAtom (_,TacAuto _), _) -> true
+   |  Tactic (TacAtom (_,TacSymmetry _), _) -> true 
+   |_ -> false
+;;
+
+let ast_of_constr = Termast.ast_of_constr true (Global.env()) ;;
+
+(*
+let rule_to_ntactic r =
+   let rast =
+     (match r with
+       Tactic (s,l) ->
+	 Ast.ope (s,(List.map ast_of_cvt_arg l))
+     | Prim (Refine h) ->
+	 Ast.ope ("Exact",
+		  [Node ((0,0), "COMMAND", [ast_of_constr h])])
+     | _ -> Ast.ope ("Intros",[])) in
+   if rule_is_complex r
+   then (match rast with
+           Node(_,_,[Node(_,_,[Node(_,_,x)])]) ->x
+          | _ -> assert false)
+
+   else [rast ]
+;;
+*)
+let rule_to_ntactic r =
+   let rt =
+     (match r with
+       Tactic (t,_) -> t
+     | Prim (Refine h) -> TacAtom (dummy_loc,TacExact h)
+     | _ -> TacAtom (dummy_loc, TacIntroPattern [])) in
+   if rule_is_complex r
+   then (match rt with
+           TacArg (Tacexp _) as t -> t
+          | _ -> assert false)
+
+   else rt
+;;
+
+(*
+let term_of_command x =
+  match x with
+    Node(_,_,y::_) -> y
+  | _ -> x
+;;
+*)
+
+(* Attribue les preuves de la liste l aux sous-buts non-prouvés de nt  *)
+
+
+let fill_unproved nt l =
+  let lnt = ref l in
+  let rec fill nt =
+    let {t_goal=g;t_proof=p}=nt in
+       match p with
+        Notproved -> let p=List.hd (!lnt) in
+                     lnt:=List.tl (!lnt);
+                     {t_info="to_prove";t_goal=g;t_proof=p}
+       |Proof(tac,lt) ->
+          {t_info="to_prove";t_goal=g;
+           t_proof=Proof(tac,List.map fill lt)}
+  in fill nt
+;;
+(* Differences entre signatures *)
+
+let new_sign osign sign =
+    let res=ref [] in
+    List.iter (fun (id,c,ty) ->
+		   try (let  (_,_,ty1)= (lookup_named id osign) in
+			())
+		   with Not_found -> res:=(id,c,ty)::(!res))
+              sign;
+    !res
+;;
+
+let old_sign osign sign =
+    let res=ref [] in
+    List.iter (fun (id,c,ty) ->
+		   try (let (_,_,ty1) = (lookup_named id osign) in
+			if ty1 = ty then res:=(id,c,ty)::(!res))
+		   with Not_found -> ())
+              sign;
+    !res
+;;
+
+(* convertit l'arbre de preuve courant en ntree *)
+let  to_nproof sigma osign pf =
+  let rec to_nproof_rec sigma osign pf =
+    let {evar_hyps=sign;evar_concl=cl} = pf.goal in
+    let nsign = new_sign osign sign in 
+    let oldsign = old_sign osign sign in 
+    match pf.ref with
+      
+      None -> {t_info="to_prove";
+	      	t_goal=(seq_to_lnhyp oldsign nsign cl);
+              	t_proof=Notproved}
+    | Some(r,spfl) ->
+      	if rule_is_complex r
+      	then (
+	  let p1= to_nproof_rec sigma sign (subproof_of_proof pf) in
+          let ntree= fill_unproved p1 
+              (List.map (fun x -> (to_nproof_rec sigma sign x).t_proof)
+		 spfl) in
+	  (match r with
+	    Tactic (TacAtom (_, TacAuto _),_) ->
+	      if spfl=[]
+	      then
+	      	{t_info="to_prove";
+	    	  t_goal= {newhyp=[];
+			    t_concl=concl ntree;
+			    t_full_concl=ntree.t_goal.t_full_concl;
+			    t_full_env=ntree.t_goal.t_full_env};
+		  t_proof= Proof (TacAtom (dummy_loc,TacExtend (dummy_loc,"InfoAuto",[])), [ntree])}
+	      else ntree
+	  | _ -> ntree))
+      	else
+	  {t_info="to_prove";
+	    t_goal=(seq_to_lnhyp oldsign nsign cl);
+       	    t_proof=(Proof (rule_to_ntactic r,
+			      List.map (fun x -> to_nproof_rec sigma sign x) spfl))}
+  in update_closed (to_nproof_rec sigma osign pf)
+    ;;
+
+(* 
+  recupere l'arbre de preuve courant.
+*)
+
+let get_nproof () =
+  to_nproof (Global.env()) []
+            (Tacmach.proof_of_pftreestate (get_pftreestate()))
+;;
+
+    
+(*****************************************************************************)
+(*
+   Pprinter
+*)
+
+let pr_void () = sphs "";;
+
+let list_rem l = match l with [] -> [] |x::l1->l1;;
+
+(* liste de chaines *)
+let prls l = 
+   let res = ref (sps (List.hd l)) in
+   List.iter (fun s -> 
+     res:= sphv [ !res; spb; sps s]) (list_rem l);
+   !res
+;;
+
+let prphrases f l = 
+   spv (List.map (fun s -> sphv [f s; sps ","]) l)
+;;
+
+(* indentation *)
+let spi = spnb 3;;
+
+(* en colonne *)
+let prl f l = 
+   if l=[] then spe else spv (List.map f l);;
+(*en colonne,  avec indentation *)
+let prli f l =  
+   if l=[] then spe else sph [spi; spv (List.map f l)];;
+
+(* 
+  Langues.
+*)
+
+let rand l =
+  List.nth l (Random.int (List.length l))
+;;
+
+type natural_languages = French | English;;
+let natural_language = ref French;;
+
+(*****************************************************************************)
+(*
+   Les liens html pour proof-by-pointing
+*)
+
+(* le path du but en cours. *)
+
+let path=ref[1];;
+
+let ftag_apply =ref (fun (n:string) t -> spt t);;
+
+let ftag_case =ref (fun n -> sps n);;
+
+let ftag_elim =ref (fun n ->  sps n);;
+
+let ftag_hypt =ref (fun h t -> sphypt (translate_path !path) h t);;
+
+let ftag_hyp =ref (fun h t -> sphyp (translate_path !path) h t);;
+
+let ftag_uselemma =ref (fun h t ->
+  let intro = match !natural_language with
+    French -> "par"
+  | English -> "by"
+  in
+  spuselemma intro h t);;
+
+let ftag_toprove =ref (fun t -> sptoprove (translate_path !path) t);;
+
+let tag_apply = !ftag_apply;;
+
+let tag_case = !ftag_case;;
+
+let tag_elim = !ftag_elim;;
+
+let tag_uselemma = !ftag_uselemma;;
+
+let tag_hyp = !ftag_hyp;;
+
+let tag_hypt = !ftag_hypt;;
+
+let tag_toprove = !ftag_toprove;;
+
+(*****************************************************************************)
+
+(* pluriel *)
+let txtn n s =
+  if n=1 then s
+  else match s with
+    |"un" -> "des"
+    |"a" -> ""
+    |"an" -> ""
+    |"une" -> "des"
+    |"Soit" -> "Soient"
+    |"Let" -> "Let"
+    | s -> s^"s"
+;;
+
+let _et () =  match !natural_language with
+    French -> sps "et"
+| English -> sps "and"
+;;
+
+let name_count = ref 0;;
+let new_name () =
+  name_count:=(!name_count)+1;
+  string_of_int !name_count
+;;
+
+let enumerate f ln =
+  match ln with
+    [] -> []
+  | [x] -> [f x]
+  |ln -> 
+  let rec enum_rec f ln = 
+     (match ln with 
+       [x;y] -> [f x; spb; sph [_et ();spb;f y]]
+      |x::l -> [sph [(f x);sps ","];spb]@(enum_rec f l)
+      | _ -> assert false)
+  in enum_rec f ln
+;;
+
+
+let constr_of_ast = Constrintern.interp_constr Evd.empty (Global.env());;
+
+(*
+let sp_tac tac =
+   try spt (constr_of_ast (term_of_command tac))
+   with _ -> (* let Node(_,t,_) = tac in *)
+             spe (* sps ("error in sp_tac " ^ t) *)
+;;
+*)
+let sp_tac tac = failwith "TODO"
+
+let soit_A_une_proposition nh ln t=  match !natural_language with
+    French ->
+      sphv ([sps (txtn nh "Soit");spb]@(enumerate (fun x -> tag_hyp x t) ln)
+            @[spb; prls [txtn nh "une";txtn nh "proposition"]])
+| English ->
+      sphv ([sps "Let";spb]@(enumerate (fun x -> tag_hyp x t) ln)
+            @[spb; prls ["be"; txtn nh "a";txtn nh "proposition"]])
+;;
+
+let on_a ()=  match !natural_language with
+  French -> rand ["on a "]
+| English ->rand ["we have "]
+;;
+
+let bon_a ()=  match !natural_language with
+  French -> rand ["On a "]
+| English ->rand ["We have "]
+;;
+
+let soit_X_un_element_de_T nh ln t =  match !natural_language with
+  French ->
+    sphv ([sps (txtn nh "Soit");spb]@(enumerate (fun x -> tag_hyp x t) ln)
+          @[spb; prls [txtn nh "un";txtn nh "élément";"de"]]
+          @[spb; spt t])
+| English ->
+    sphv ([sps (txtn nh "Let");spb]@(enumerate (fun x -> tag_hyp x t) ln)
+          @[spb; prls ["be";txtn nh "an";txtn nh "element";"of"]]
+          @[spb; spt t])
+;;
+
+let soit_F_une_fonction_de_type_T nh ln t =  match !natural_language with
+  French ->
+    sphv ([sps (txtn nh "Soit");spb]@(enumerate (fun x -> tag_hyp x t) ln)
+          @[spb; prls [txtn nh "une";txtn nh "fonction";"de";"type"]]
+          @[spb; spt t])
+| English ->
+    sphv ([sps (txtn nh "Let");spb]@(enumerate (fun x -> tag_hyp x t) ln)
+          @[spb; prls ["be";txtn nh "a";txtn nh "function";"of";"type"]]
+          @[spb; spt t])
+;;
+
+
+let telle_que nh =  match !natural_language with
+    French -> [prls [" ";txtn nh "telle";"que";" "]]
+| English -> [prls [" "; "such";"that";" "]]
+;;
+
+let tel_que nh =  match !natural_language with
+    French -> [prls [" ";txtn nh "tel";"que";" "]]
+| English -> [prls [" ";"such";"that";" "]]
+;;
+
+let supposons () =  match !natural_language with
+    French -> "Supposons "
+|  English -> "Suppose "
+;;
+
+let cas () =  match !natural_language with
+    French -> "Cas"
+|  English -> "Case"
+;;
+
+let donnons_une_proposition () =  match !natural_language with
+    French -> sph[ (prls ["Donnons";"une";"proposition"])]
+|  English -> sph[ (prls ["Let us give";"a";"proposition"])]
+;;
+
+let montrons g =  match !natural_language with
+    French -> sph[ sps (rand ["Prouvons";"Montrons";"Démontrons"]);
+		   spb; spt g; sps ". "]
+|  English -> sph[ sps (rand ["Let us";"Now"]);spb;
+		   sps (rand ["prove";"show"]);
+		   spb; spt g; sps ". "]
+;;
+
+let calculons_un_element_de g =  match !natural_language with
+    French -> sph[ (prls ["Calculons";"un";"élément";"de"]);
+		   spb; spt g; sps ". "]
+|  English -> sph[ (prls ["Let us";"compute";"an";"element";"of"]);
+		   spb; spt g; sps ". "]
+;;
+
+let calculons_une_fonction_de_type g =  match !natural_language with
+    French -> sphv [ (prls ["Calculons";"une";"fonction";"de";"type"]);
+                spb; spt g; sps ". "]
+|  English -> sphv [ (prls ["Let";"us";"compute";"a";"function";"of";"type"]);
+                spb; spt g; sps ". "];;
+
+let en_simplifiant_on_obtient g =  match !natural_language with
+    French ->
+      sphv [ (prls [rand ["Après simplification,"; "En simplifiant,"];
+		     rand ["on doit";"il reste à"];
+		     rand ["prouver";"montrer";"démontrer"]]);
+		     spb; spt g; sps ". "]
+|  English ->
+      sphv [ (prls [rand ["After simplification,"; "Simplifying,"];
+		     rand ["we must";"it remains to"];
+		     rand ["prove";"show"]]);
+		     spb; spt g; sps ". "] ;;
+
+let on_obtient g =  match !natural_language with
+  French -> sph[ (prls [rand ["on doit";"il reste à"];
+			 rand ["prouver";"montrer";"démontrer"]]);
+                 spb; spt g; sps ". "]
+|  English ->sph[ (prls [rand ["we must";"it remains to"];
+		     rand ["prove";"show"]]);
+                  spb; spt g; sps ". "]
+;;
+
+let reste_a_montrer g =  match !natural_language with
+    French -> sph[ (prls ["Reste";"à";
+			   rand ["prouver";"montrer";"démontrer"]]);
+                spb; spt g; sps ". "]
+|  English -> sph[ (prls ["It remains";"to";
+			   rand ["prove";"show"]]);
+                spb; spt g; sps ". "] 
+;;
+
+let discutons_avec_A type_arg  =  match !natural_language with
+    French -> sphv [sps "Discutons"; spb; sps "avec"; spb;
+				   spt type_arg; sps ":"] 
+|  English -> sphv [sps "Let us discuss"; spb; sps "with"; spb;
+				   spt type_arg; sps ":"] 
+;;
+
+let utilisons_A arg1  =  match !natural_language with
+    French -> sphv [sps (rand ["Utilisons";"Avec";"A l'aide de"]);
+		     spb; spt arg1; sps ":"] 
+|  English -> sphv [sps (rand ["Let us use";"With";"With the help of"]);
+		     spb; spt arg1; sps ":"] 
+;;
+
+let selon_les_valeurs_de_A arg1  =  match !natural_language with
+    French -> sphv [  (prls ["Selon";"les";"valeurs";"de"]);
+                      spb; spt arg1; sps ":"] 
+|  English -> sphv [  (prls ["According";"values";"of"]);
+                      spb; spt arg1; sps ":"] 
+;;
+
+let de_A_on_a arg1  =  match !natural_language with
+    French -> sphv [  sps (rand ["De";"Avec";"Grâce à"]); spb; spt arg1; spb;
+		      sps (rand ["on a:";"on déduit:";"on obtient:"])]
+|  English -> sphv [  sps (rand ["From";"With";"Thanks to"]); spb;
+		     spt arg1; spb;
+		      sps (rand ["we have:";"we deduce:";"we obtain:"])]
+;;
+
+
+let procedons_par_recurrence_sur_A arg1  =  match !natural_language with
+    French ->  sphv [  (prls ["Procédons";"par";"récurrence";"sur"]);
+			  spb; spt arg1; sps ":"]
+|  English -> sphv [  (prls ["By";"induction";"on"]);
+			  spb; spt arg1; sps ":"]
+;;
+
+
+let calculons_la_fonction_F_de_type_T_par_recurrence_sur_son_argument_A 
+  nfun tfun narg =  match !natural_language with
+    French ->  sphv [  
+                    sphv [ prls ["Calculons";"la";"fonction"];
+                     spb; sps (string_of_id nfun);spb;
+                     prls ["de";"type"];
+                     spb; spt tfun;spb;
+                     prls ["par";"récurrence";"sur";"son";"argument"];
+                     spb; sps (string_of_int narg); sps ":"]
+                 ]
+|  English ->  sphv [  
+                    sphv [ prls ["Let us compute";"the";"function"];
+                     spb; sps (string_of_id nfun);spb;
+                     prls ["of";"type"];
+                     spb; spt tfun;spb;
+                     prls ["by";"induction";"on";"its";"argument"];
+                     spb; sps (string_of_int narg); sps ":"]
+                 ]
+
+;;
+let pour_montrer_G_la_valeur_recherchee_est_A g arg1  =
+  match !natural_language with
+    French ->  sph [sps "Pour";spb;sps "montrer"; spt g; spb;
+		     sps ","; spb; sps "choisissons";spb;
+		     spt arg1;sps ". " ]
+|  English ->  sph [sps "In order to";spb;sps "show"; spt g; spb;
+		     sps ","; spb; sps "let us choose";spb;
+		     spt arg1;sps ". " ]
+;;
+
+let on_se_sert_de_A   arg1  =  match !natural_language with
+    French ->  sph [sps "On se sert de";spb ;spt arg1;sps ":" ]
+|  English ->  sph [sps "We use";spb ;spt arg1;sps ":" ]
+;;
+
+
+let d_ou_A g  =  match !natural_language with
+    French ->  sph [spi; sps "d'où";spb ;spt g;sps ". " ]
+|  English -> sph [spi; sps "then";spb ;spt g;sps ". " ]
+;;
+
+
+let coq_le_demontre_seul ()  =  match !natural_language with
+    French ->   rand [prls ["Coq";"le";"démontre"; "seul."];
+		       sps "Fastoche.";
+		     sps "Trop cool"]
+|  English -> 	rand [prls ["Coq";"shows";"it"; "alone."];
+		       sps "Fingers in the nose."]	      
+;;
+
+let de_A_on_deduit_donc_B arg g  =  match !natural_language with
+    French -> sph
+             [  sps "De"; spb; spt arg; spb; sps "on";spb;
+                sps "déduit";spb; sps "donc";spb;  spt g ]
+|  English -> sph
+             [  sps "From"; spb; spt arg; spb; sps "we";spb;
+                sps "deduce";spb; sps "then";spb;  spt g ]
+;;
+
+let _A_est_immediat_par_B g arg  =  match !natural_language with
+    French -> sph [  spt g;  spb; (prls ["est";"immédiat";"par"]);
+                     spb;  spt arg ] 
+|  English -> sph [  spt g;  spb; (prls ["is";"immediate";"from"]);
+                     spb;  spt arg ] 
+;;
+
+let le_resultat_est arg  =  match !natural_language with
+    French -> sph [  (prls ["le";"résultat";"est"]);
+                    spb; spt arg ] 
+|  English -> sph [  (prls ["the";"result";"is"]);
+                    spb; spt arg ];;
+
+let on_applique_la_tactique tactic tac =  match !natural_language with
+  French -> sphv 
+      [ sps "on applique";spb;sps "la tactique"; spb;tactic;spb;tac]
+|  English -> sphv 
+      [ sps "we apply";spb;sps "the tactic"; spb;tactic;spb;tac]
+;;
+
+let de_A_il_vient_B arg g  =  match !natural_language with
+    French -> sph
+             [  sps "De"; spb; spt arg; spb; 
+               sps "il";spb; sps "vient";spb; spt g; sps ". " ] 
+|  English -> sph
+             [  sps "From"; spb; spt arg; spb; 
+               sps "it";spb; sps "comes";spb; spt g; sps ". " ] 
+;;
+
+let ce_qui_est_trivial ()  =  match !natural_language with
+    French -> sps "Trivial."
+|  English -> sps "Trivial."
+;;
+
+let en_utilisant_l_egalite_A arg  =  match !natural_language with
+    French -> sphv [  sps "En"; spb;sps "utilisant"; spb;
+                   sps "l'egalite"; spb; spt arg; sps ","
+                  ]
+|  English -> sphv [  sps "Using"; spb;
+                   sps "the equality"; spb; spt arg; sps ","
+                  ]
+;;
+
+let simplifions_H_T hyp thyp =  match !natural_language with
+    French -> sphv [sps"En simplifiant";spb;sps hyp;spb;sps "on obtient:";
+		     spb;spt thyp;sps "."]
+|  English ->  sphv [sps"Simplifying";spb;sps hyp;spb;sps "we get:";
+		     spb;spt thyp;sps "."]
+;;
+
+let grace_a_A_il_suffit_de_montrer_LA arg lg=
+  match !natural_language with
+    French -> sphv ([sps (rand ["Grâce à";"Avec";"A l'aide de"]);spb;
+		      spt arg;sps ",";spb;
+		     sps "il suffit";spb; sps "de"; spb;
+		      sps (rand["prouver";"montrer";"démontrer"]); spb]
+		     @[spv (enumerate (fun x->x) lg)])
+|  English -> sphv ([sps (rand ["Thanks to";"With"]);spb;
+		      spt arg;sps ",";spb;
+		     sps "it suffices";spb; sps "to"; spb;
+		      sps (rand["prove";"show"]); spb]
+		     @[spv (enumerate (fun x->x) lg)])
+;;
+let reste_a_montrer_LA lg=
+  match !natural_language with
+    French -> sphv ([ sps "Il reste";spb; sps "à"; spb;
+		      sps (rand["prouver";"montrer";"démontrer"]); spb]
+		     @[spv (enumerate (fun x->x) lg)])
+|  English -> sphv ([ sps "It remains";spb; sps "to"; spb;
+		      sps (rand["prove";"show"]); spb]
+		     @[spv (enumerate (fun x->x) lg)])
+;;
+(*****************************************************************************)
+(*
+  Traduction des hypothèses.
+*)
+
+type n_sort=
+      Nprop
+    | Nformula
+    | Ntype
+    | Nfunction
+;;
+
+   
+let sort_of_type t ts =
+   let t=(strip_outer_cast t) in
+   if is_Prop t
+   then Nprop
+   else 
+       match ts with
+         Prop(Null) -> Nformula
+        |_ -> (match (kind_of_term t) with
+                Prod(_,_,_) -> Nfunction
+               |_ -> Ntype)
+;;
+
+let adrel (x,t) e =
+    match x with 
+      Name(xid) -> Environ.push_rel (x,None,t) e
+    | Anonymous -> Environ.push_rel (x,None,t) e
+
+let rec nsortrec vl x = 
+     match (kind_of_term x) with
+     Prod(n,t,c)->
+        let vl = (adrel (n,t) vl) in nsortrec vl c
+   | Lambda(n,t,c) ->
+        let vl = (adrel (n,t) vl) in nsortrec vl c
+   | App(f,args) -> nsortrec vl f
+   | Sort(Prop(Null)) -> Prop(Null)
+   | Sort(c) -> c
+   | Ind(ind) ->
+          let (mib,mip) = lookup_mind_specif vl ind in
+          mip.mind_sort
+   | Construct(c) ->
+          nsortrec vl (mkInd (inductive_of_constructor c))
+   | Case(_,x,t,a) 
+        -> nsortrec vl x
+   | Cast(x,t)-> nsortrec vl t
+   | Const c  -> nsortrec vl (lookup_constant c vl).const_type
+   | _ -> nsortrec vl (type_of vl Evd.empty x)
+;;
+let nsort x =
+    nsortrec  (Global.env()) (strip_outer_cast x)
+;;
+
+let sort_of_hyp h = 
+  (sort_of_type h.hyp_type (nsort h.hyp_full_type))
+;;
+
+(* grouper les hypotheses successives de meme type, ou logiques.
+   donne une liste de liste *)
+let rec group_lhyp lh =
+    match lh with
+     [] -> []
+    |[h] -> [[h]]
+    |h::lh ->
+      match group_lhyp lh with
+       (h1::lh1)::lh2 -> 
+        if h.hyp_type=h1.hyp_type
+          || ((sort_of_hyp h)=(sort_of_hyp h1) && (sort_of_hyp h1)=Nformula)
+        then (h::(h1::lh1))::lh2
+        else [h]::((h1::lh1)::lh2)
+     |_-> assert false
+;;
+	
+(* ln noms des hypotheses, lt leurs types *)
+let natural_ghyp (sort,ln,lt) intro =
+  let t=List.hd lt in
+  let nh=List.length ln in
+  let ns=List.hd ln in
+  match sort with
+    Nprop -> soit_A_une_proposition nh ln t
+  | Ntype -> soit_X_un_element_de_T nh ln t
+  | Nfunction -> soit_F_une_fonction_de_type_T nh ln t
+  | Nformula -> 
+      sphv ((sps intro)::(enumerate (fun (n,t) -> tag_hypt n t)
+			    (List.combine ln lt)))
+;;
+
+(* Cas d'une hypothese *)
+let natural_hyp h = 
+   let ns= string_of_id h.hyp_name in
+   let t=h.hyp_type in
+   let ts= (nsort h.hyp_full_type) in
+   natural_ghyp ((sort_of_type t ts),[ns],[t]) (supposons ())
+;;
+
+let rec pr_ghyp lh intro=
+     match lh with
+       [] -> []
+     | [(sort,ln,t)]->
+         (match sort with
+           Nformula -> [natural_ghyp(sort,ln,t) intro; sps ". "]
+         | _ -> [natural_ghyp(sort,ln,t) ""; sps ". "])
+     | (sort,ln,t)::lh  ->
+       let hp= 
+        ([natural_ghyp(sort,ln,t) intro]
+         @(match lh with
+           [] -> [sps ". "]
+          |(sort1,ln1,t1)::lh1  ->
+             match sort1 with
+               Nformula -> 
+                 (let nh=List.length ln in
+                     match sort with
+                   Nprop -> telle_que nh 
+                  |Nfunction -> telle_que nh 
+                  |Ntype -> tel_que nh 
+                  |Nformula -> [sps ". "])
+             | _ -> [sps ". "])) in
+        (sphv hp)::(pr_ghyp lh "")
+;;
+
+(* traduction d'une liste d'hypotheses groupees. *)
+let prnatural_ghyp llh intro=
+  if llh=[]
+  then spe
+  else
+    sphv (pr_ghyp (List.map
+		     (fun lh ->
+		       let h=(List.hd lh) in
+		       let sh = sort_of_hyp h in
+		       let lhname = (List.map (fun h ->
+			 string_of_id h.hyp_name) lh) in
+		       let lhtype = (List.map (fun h -> h.hyp_type) lh) in
+		       (sh,lhname,lhtype))
+		     llh) intro)
+;;
+
+
+(*****************************************************************************)
+(*
+    Liste des hypotheses.
+*)
+type type_info_subgoals_hyp=
+    All_subgoals_hyp
+  | Reduce_hyp
+  | No_subgoals_hyp
+  | Case_subgoals_hyp of string (* word for introduction *)
+	* Term.constr (* variable *)
+        * string (* constructor *)
+        * int (* arity *)
+        * int (* number of constructors *)
+  | Case_prop_subgoals_hyp of string (* word for introduction *)
+	* Term.constr (* variable *)
+        * int (* index of constructor *)
+        * int (* arity *)
+        * int (* number of constructors *)
+  | Elim_subgoals_hyp of Term.constr (* variable *)
+        * string (* constructor *)
+        * int (* arity *)
+        * (string list) (* rec hyp *)
+        * int (* number of constructors *)
+  | Elim_prop_subgoals_hyp of Term.constr (* variable *)
+        * int (* index of constructor *)
+        * int (* arity *)
+        * (string list) (* rec hyp *)
+        * int (* number of constructors *)
+;;
+let rec nrem l n =
+  if n<=0 then l else nrem (list_rem l) (n-1)
+;;
+
+let rec nhd l n =
+  if n<=0 then [] else (List.hd l)::(nhd (list_rem l) (n-1))
+;;
+
+let par_hypothese_de_recurrence () =  match !natural_language with
+    French -> sphv [(prls ["par";"hypothèse";"de";"récurrence";","])]
+| English -> sphv [(prls ["by";"induction";"hypothesis";","])]
+;;
+
+let  natural_lhyp lh hi =
+  match hi with
+    All_subgoals_hyp -> 
+        ( match lh with
+          [] -> spe
+        |_-> prnatural_ghyp (group_lhyp lh) (supposons ()))
+  | Reduce_hyp ->
+      (match lh with
+	[h] -> simplifions_H_T (string_of_id h.hyp_name) h.hyp_type
+      |	_-> spe)
+  | No_subgoals_hyp -> spe
+  |Case_subgoals_hyp (sintro,var,c,a,ncase) -> (* sintro pas encore utilisee *)
+      let s=ref c in
+      for i=1 to a do
+        let nh=(List.nth lh (i-1)) in
+        s:=(!s)^" "^(string_of_id nh.hyp_name);
+      done;
+      if a>0 then s:="("^(!s)^")";
+      sphv [  (if ncase>1
+                     then sph[ sps ("-"^(cas ()));spb]
+                     else spe);
+                    (* spt var;sps "="; *) sps !s; sps ":";
+           (prphrases (natural_hyp) (nrem lh a))]
+  |Case_prop_subgoals_hyp (sintro,var,c,a,ncase) ->
+      prnatural_ghyp (group_lhyp lh) sintro
+  |Elim_subgoals_hyp (var,c,a,lhci,ncase) ->
+      let nlh = List.length lh in
+      let nlhci = List.length lhci in
+      let lh0 = ref [] in
+      for i=1 to (nlh-nlhci) do
+         lh0:=(!lh0)@[List.nth lh (i-1)];
+      done;
+      let lh=nrem lh (nlh-nlhci) in
+      let s=ref c in
+      let lh1=ref [] in
+      for i=1 to nlhci do
+        let targ=(List.nth lhci (i-1))in
+        let nh=(List.nth lh (i-1)) in
+        if targ="arg" || targ="argrec" 
+        then
+            (s:=(!s)^" "^(string_of_id nh.hyp_name);
+	     lh0:=(!lh0)@[nh])
+        else lh1:=(!lh1)@[nh];
+      done;
+      let introhyprec=
+          (if (!lh1)=[] then spe 
+           else   par_hypothese_de_recurrence () )
+      in          
+      if a>0 then s:="("^(!s)^")";
+      spv [sphv [(if ncase>1
+                     then sph[ sps ("-"^(cas ()));spb]
+                     else spe);
+                     sps !s; sps ":"]; 
+           prnatural_ghyp (group_lhyp !lh0) (supposons ());
+           introhyprec;
+           prl (natural_hyp) !lh1]
+  |Elim_prop_subgoals_hyp (var,c,a,lhci,ncase) ->
+      sphv [  (if ncase>1
+                     then sph[ sps ("-"^(cas ()));spb;sps (string_of_int c);
+                             sps ":";spb]
+                     else spe);
+           (prphrases (natural_hyp) lh )]
+
+;;
+
+(*****************************************************************************)
+(*
+    Analyse des tactiques.
+*)
+
+(*
+let name_tactic tac =
+      match tac with
+        (Node(_,"Interp",
+		(Node(_,_,
+		      (Node(_,t,_))::_))::_))::_  -> t
+       |(Node(_,t,_))::_ -> t
+       | _ -> assert false
+;;
+*)
+let name_tactic = function
+  | TacIntroPattern _ -> "Intro"
+  | TacAssumption -> "Assumption"
+  | _ -> failwith "TODO"
+;;
+
+(*
+let arg1_tactic tac =
+  match tac with
+    (Node(_,"Interp",
+		(Node(_,_,
+		      (Node(_,_,x::_))::_))::_))::_ ->x
+  | (Node(_,_,x::_))::_ -> x
+  | x::_ -> x
+  | _ -> assert false
+;;
+*)
+
+let arg1_tactic tac = failwith "TODO"
+
+let arg2_tactic tac =
+   match tac with
+     (Node(_,"Interp",
+		(Node(_,_,
+		      (Node(_,_,_::x::_))::_))::_))::_ -> x
+    | (Node(_,_,_::x::_))::_ -> x
+    | _ -> assert false
+;;
+
+(*
+type nat_tactic =
+    Split of (Coqast.t list)
+  | Generalize of (Coqast.t list)
+  | Reduce of string*(Coqast.t list)
+  | Other of string*(Coqast.t list)
+;;
+
+let analyse_tac tac =
+  match tac with
+    [Node (_, "Split", [Node (_, "BINDINGS", [])])]
+      -> Split []
+  | [Node (_, "Split",[Node(_, "BINDINGS",[Node(_, "BINDING",
+	[Node (_, "COMMAND", x)])])])] 
+     -> Split x
+  | [Node (_, "Generalize", [Node (_, "COMMAND", x)])] 
+     ->Generalize x
+  | [Node (_, "Reduce", [Node (_, "REDEXP", [Node (_, mode, _)]);
+             Node (_, "CLAUSE", lhyp)])] 
+     -> Reduce(mode,lhyp)
+  | [Node (_, x,la)] -> Other (x,la)
+  | _ -> assert false
+;;
+*)
+      
+
+
+
+
+let id_of_command x =
+  match x with
+      Node(_,_,Node(_,_,y::_)::_) ->  y
+     |_ -> assert false
+;;
+type type_info_subgoals =
+    {ihsg: type_info_subgoals_hyp;
+     isgintro : string}
+;;
+
+let rec show_goal lh ig g gs =
+  match ig with
+    "intros" ->
+      if lh = []
+      then spe
+      else show_goal lh "standard" g gs 
+  |"standard" ->
+      (match (sort_of_type g gs) with
+        Nprop -> donnons_une_proposition ()
+      | Nformula -> montrons g
+      | Ntype -> calculons_un_element_de g
+      | Nfunction ->calculons_une_fonction_de_type g)
+  | "apply" -> show_goal lh "" g gs
+  | "simpl" ->en_simplifiant_on_obtient g
+  | "rewrite" -> on_obtient g 
+  | "equality" -> reste_a_montrer g
+  | "trivial_equality" -> reste_a_montrer g
+  | "" -> spe
+  |_ -> sph[ sps "A faire ..."; spb; spt g; sps ". " ]
+;;
+
+let show_goal2 lh {ihsg=hi;isgintro=ig} g gs s =
+  if ig="" && lh = []
+  then spe
+  else sphv [  show_goal lh ig g gs; sps s]
+;;
+
+let imaginez_une_preuve_de () =  match !natural_language with
+    French -> "Imaginez une preuve de"
+| English -> "Imagine a proof of"
+;;
+
+let donnez_un_element_de () =  match !natural_language with
+    French -> "Donnez un element de"
+| English -> "Give an element of";;
+
+let intro_not_proved_goal gs =
+   match gs with
+     Prop(Null) -> imaginez_une_preuve_de ()
+    |_ -> donnez_un_element_de ()
+;;
+
+let first_name_hyp_of_ntree {t_goal={newhyp=lh}}=
+  match lh with
+   {hyp_name=n}::_ -> n
+  | _ -> assert false
+;;
+
+let rec find_type x t=
+    match (kind_of_term (strip_outer_cast t)) with 
+      Prod(y,ty,t) ->
+	(match y with
+	  Name y -> 
+            if x=(string_of_id y) then ty
+            else find_type x t
+	| _ -> find_type x t)
+     |_-> assert false 
+;;
+
+(***********************************************************************
+Traitement des égalités
+*)
+(*
+let is_equality e =
+   match  (kind_of_term e) with
+     AppL args ->
+       (match (kind_of_term args.(0)) with
+	 Const (c,_) ->
+	   (match (string_of_sp c) with
+	     "Equal" -> true
+           | "eq" -> true
+	   | "eqT" -> true
+	   | "identityT" -> true
+	   | _ -> false)
+       | _ -> false)
+   | _ -> false
+;;
+*)
+
+let is_equality e =
+  let e= (strip_outer_cast e) in
+   match  (kind_of_term e) with
+     App (f,args) -> (Array.length args) >= 3
+   | _ -> false
+;;
+
+let terms_of_equality e =
+  let e= (strip_outer_cast e) in
+  match  (kind_of_term e) with
+     App (f,args) -> (args.(1) , args.(2))
+    | _ -> assert false
+;;
+
+let eq_term = eq_constr;;
+
+let is_equality_tac = function
+  | TacAtom (_,
+      (TacExtend
+	(_,("ERewriteLR"|"ERewriteRL"|"ERewriteLRocc"|"ERewriteRLocc"
+	 |"ERewriteParallel"|"ERewriteNormal"
+	 |"RewriteLR"|"RewriteRL"|"Replace"),_)
+      | TacReduce _
+      | TacSymmetry _ | TacReflexivity
+      | TacExact _ | TacIntroPattern _ | TacIntroMove _ | TacAuto _)) -> true
+  | _ -> false
+
+let equalities_ntree ig ntree =
+  let rec equalities_ntree ig ntree =
+  if not (is_equality (concl ntree)) 
+  then []
+  else
+    match (proof ntree) with
+      Notproved ->  [(ig,ntree)]
+    | Proof (tac,ltree) ->
+	if is_equality_tac tac
+      	then (match ltree with
+          [] ->  [(ig,ntree)]
+	| t::_ -> let res=(equalities_ntree ig t) in
+	          if eq_term (concl ntree) (concl t)
+		  then res
+		  else (ig,ntree)::res)
+	else  [(ig,ntree)]
+  in 
+  equalities_ntree ig ntree 
+;;
+
+let remove_seq_of_terms l =
+  let rec remove_seq_of_terms l =    match l with
+    a::b::l -> if (eq_term (fst a) (fst b))
+    then remove_seq_of_terms (b::l)
+    else a::(remove_seq_of_terms (b::l))
+  | _ -> l
+  in remove_seq_of_terms l
+;;
+
+let  list_to_eq l o=
+  let switch = fun h h' -> (if o then h else h') in
+   match l with
+      [a] -> spt (fst a) 
+   |  (a,h)::(b,h')::l ->
+       let rec list_to_eq h l =
+	 match l with
+	   [] -> []
+	 |  (b,h')::l ->
+	     (sph [sps "="; spb; spt b; spb;tag_uselemma (switch h h') spe])
+             :: (list_to_eq (switch h' h) l)
+       in sph [spt a;  spb;
+		 spv ((sph [sps "="; spb; spt b; spb; 
+			     tag_uselemma (switch h h') spe])
+		      ::(list_to_eq (switch h' h) l))]
+  | _ -> assert false
+;;
+
+let stde = Global.env;;
+
+let dbize env = Constrintern.interp_constr Evd.empty env;;
+
+(**********************************************************************)
+let rec natural_ntree ig ntree =
+  let  {t_info=info;
+	 t_goal={newhyp=lh;t_concl=g;t_full_concl=gf;t_full_env=ge};
+	 t_proof=p} = ntree in
+    let leq = List.rev (equalities_ntree ig ntree)  in
+    if List.length leq > 1
+    then (* Several equalities to treate ... *)
+      (
+       print_string("Several equalities to treate ...\n");
+      let l1 = ref [] in
+      let l2 = ref [] in
+      List.iter
+	(fun (_,ntree) ->
+	 let lemma =  match (proof ntree) with
+	   Proof (tac,ltree) ->
+	     (try (sph [spt (dbize (gLOB ge) (arg1_tactic tac));(* TODO *)
+			  (match ltree with
+			    [] ->spe
+			  | [_] -> spe
+			  | _::l -> sphv[sps ": ";
+					  prli (natural_ntree 
+					    {ihsg=All_subgoals_hyp;
+					      isgintro="standard"})
+                            		    l])])
+	      with _ -> sps "simplification"  )
+	 | Notproved -> spe
+	 in
+ 	  let (t1,t2)= terms_of_equality (concl ntree) in
+	  l2:=(t2,lemma)::(!l2);
+	  l1:=(t1,lemma)::(!l1))
+	leq;
+      l1:=remove_seq_of_terms !l1;
+      l2:=remove_seq_of_terms !l2;
+      l2:=List.rev !l2;
+      let ltext=ref [] in
+      if List.length !l1 > 1
+      then (ltext:=(!ltext)@[list_to_eq !l1 true];
+	    if List.length !l2 > 1 then
+	      (ltext:=(!ltext)@[_et()];
+	       ltext:=(!ltext)@[list_to_eq !l2 false]))
+      else if List.length !l2 > 1 then ltext:=(!ltext)@[list_to_eq !l2 false];
+      if !ltext<>[] then ltext:=[sps (bon_a ()); spv !ltext];
+      let (ig,ntree)=(List.hd leq) in
+      spv [(natural_lhyp lh ig.ihsg);
+	    (show_goal2 lh ig g (nsort gf) "");
+	    sph !ltext;
+	    
+	    natural_ntree {ihsg=All_subgoals_hyp;
+                            isgintro=
+			    let  (t1,t2)= terms_of_equality (concl ntree) in
+			    if eq_term t1 t2
+			    then "trivial_equality"
+			    else "equality"}
+	      ntree]
+      	)
+    else
+    let ntext =
+      let gs=nsort gf in
+      match p with
+   	Notproved ->  spv [ (natural_lhyp lh ig.ihsg);
+                            sph [spi; sps (intro_not_proved_goal gs); spb; 
+                                  tag_toprove g  ]
+			  ]
+
+      | Proof (TacId _,ltree) -> natural_ntree ig (List.hd ltree)
+      | Proof (TacAtom (_,tac),ltree) -> 
+	 (let ntext = 
+	  match tac with
+(* Pas besoin de l'argument éventuel de la tactique *)
+	    TacIntroPattern _ -> natural_intros ig lh g gs ltree
+	  | TacIntroMove _ -> natural_intros ig lh g gs ltree
+	  | TacFix (_,n) -> natural_fix ig lh g gs n ltree
+	  | TacSplit (_,NoBindings) -> natural_split ig lh g gs ge [] ltree
+	  | TacSplit(_,ImplicitBindings l) -> natural_split ig lh g gs ge l ltree
+	  | TacGeneralize l -> natural_generalize ig lh g gs ge l ltree
+	  | TacRight _ -> natural_right ig lh g gs ltree
+	  | TacLeft _ -> natural_left ig lh g gs ltree
+	  | (* "Simpl" *)TacReduce (r,cl)  ->
+	      natural_reduce ig lh g gs ge r cl ltree
+	  | TacExtend (_,"InfoAuto",[]) -> natural_infoauto ig lh g gs ltree
+	  | TacAuto _ -> natural_auto ig lh g gs ltree
+	  | TacExtend (_,"EAuto",_) -> natural_auto ig lh g gs ltree
+	  | TacTrivial _ -> natural_trivial ig lh g gs ltree
+	  | TacAssumption -> natural_trivial ig lh g gs ltree
+	  | TacClear _ -> natural_clear ig lh g gs ltree
+(* Besoin de l'argument de la tactique *)
+	  | TacSimpleInduction (NamedHyp id,_) -> 
+              natural_induction ig lh g gs ge id ltree false
+	  | TacExtend (_,"InductionIntro",[a]) -> 
+              let id=(out_gen wit_ident a) in
+              natural_induction ig lh g gs ge id ltree true
+	  | TacApply (c,_) -> natural_apply ig lh g gs c ltree
+	  | TacExact c -> natural_exact ig lh g gs c ltree
+	  | TacCut c -> natural_cut ig lh g gs c ltree
+	  | TacExtend (_,"CutIntro",[a]) ->
+	      let c = out_gen wit_constr a in
+	      natural_cutintro ig lh g gs a ltree
+	  | TacCase (c,_) -> natural_case ig lh g gs ge c ltree false
+	  | TacExtend (_,"CaseIntro",[a]) ->
+	      let c = out_gen wit_constr a in
+	      natural_case ig lh g gs ge c ltree true
+	  | TacElim ((c,_),_) -> natural_elim ig lh g gs ge c ltree false
+	  | TacExtend (_,"ElimIntro",[a]) ->
+	      let c = out_gen wit_constr a in
+	      natural_elim ig lh g gs ge c ltree true
+	  | TacExtend (_,"Rewrite",[_;a]) ->
+	      let (c,_) = out_gen wit_constr_with_bindings a in
+	      natural_rewrite ig lh g gs c ltree
+	  | TacExtend (_,"ERewriteRL",[a]) ->
+	      let c = out_gen wit_constr a in (* TODO *)
+	      natural_rewrite ig lh g gs c ltree
+	  | TacExtend (_,"ERewriteLR",[a]) ->
+	      let c = out_gen wit_constr a in (* TODO *)
+	      natural_rewrite ig lh g gs c ltree
+	  |_ -> natural_generic ig lh g gs (sps (name_tactic tac)) (prl sp_tac [tac]) ltree
+         in
+          ntext (* spwithtac ntext tactic*)
+          )
+      | Proof _ -> failwith "Don't know what to do with that"
+    in   
+         if info<>"not_proved"
+         then spshrink info ntext
+         else ntext
+and  natural_generic  ig lh g gs tactic tac ltree =
+  spv
+    [ (natural_lhyp lh ig.ihsg);
+      (show_goal2 lh ig g gs "");
+      on_applique_la_tactique tactic tac ;
+      (prli(natural_ntree  
+	      {ihsg=All_subgoals_hyp;
+		isgintro="standard"})
+         ltree)
+    ]
+and natural_clear ig lh g gs ltree = natural_ntree ig (List.hd ltree)
+(*
+    spv
+    [ (natural_lhyp lh ig.ihsg);
+      (show_goal2 lh ig g gs "");
+      (prl (natural_ntree ig) ltree)
+    ]
+*)
+and natural_intros ig lh g gs ltree =
+  spv
+         [  (natural_lhyp lh ig.ihsg);
+            (show_goal2 lh ig g gs "");
+            (prl (natural_ntree  
+                {ihsg=All_subgoals_hyp;
+                 isgintro="intros"})
+                            ltree)
+        ]
+and natural_apply ig lh g gs arg ltree =
+  let lg = List.map concl ltree in
+  match lg with
+    [] ->
+      spv
+        [ (natural_lhyp lh ig.ihsg);
+	  de_A_il_vient_B arg g  
+        ]
+  | [sg]->
+      spv
+        [ (natural_lhyp lh ig.ihsg);
+          (show_goal2 lh
+	     {ihsg=ig.ihsg; isgintro= if ig.isgintro<>"apply"
+	                              then "standard"
+	                              else ""}
+	     g gs "");
+          grace_a_A_il_suffit_de_montrer_LA arg [spt sg];
+	  sph [spi ; natural_ntree 
+		  {ihsg=All_subgoals_hyp;
+		    isgintro="apply"} (List.hd ltree)]
+	]       
+  | _ ->
+      let ln = List.map (fun _ -> new_name()) lg in
+      spv
+        [ (natural_lhyp lh ig.ihsg);
+          (show_goal2 lh
+	     {ihsg=ig.ihsg; isgintro= if ig.isgintro<>"apply"
+	                              then "standard"
+			              else ""}
+	     g gs "");
+          grace_a_A_il_suffit_de_montrer_LA arg
+	    (List.map2 (fun g n -> sph [sps ("("^n^")"); spb; spt g])
+	       lg ln);
+	  sph [spi; spv (List.map2
+			   (fun x n -> sph [sps ("("^n^"):"); spb;
+					     natural_ntree 
+					       {ihsg=All_subgoals_hyp;
+						 isgintro="apply"} x])
+			   ltree ln)]
+        ]
+and natural_rem_goals ltree =
+  let lg = List.map concl ltree in
+  match lg with
+    [] -> spe
+  | [sg]->
+      spv
+        [ reste_a_montrer_LA [spt sg];
+	  sph [spi ; natural_ntree 
+		  {ihsg=All_subgoals_hyp;
+		    isgintro="apply"} (List.hd ltree)]
+	]       
+  | _ ->
+      let ln = List.map (fun _ -> new_name()) lg in
+      spv
+        [   reste_a_montrer_LA 
+	    (List.map2 (fun g n -> sph [sps ("("^n^")"); spb; spt g])
+	       lg ln);
+	  sph [spi; spv (List.map2
+			   (fun x n -> sph [sps ("("^n^"):"); spb;
+					     natural_ntree 
+					       {ihsg=All_subgoals_hyp;
+						 isgintro="apply"} x])
+			   ltree ln)]
+        ]
+and natural_exact ig lh g gs arg ltree =
+spv
+         [  
+             (natural_lhyp lh ig.ihsg);
+             (let {ihsg=pi;isgintro=ig}= ig in
+               (show_goal2 lh {ihsg=pi;isgintro=""}
+                   g gs ""));
+             (match gs with
+               Prop(Null) -> _A_est_immediat_par_B g arg
+              |_ -> le_resultat_est arg)
+
+        ]
+and natural_cut ig lh g gs arg ltree =
+  spv
+         [  (natural_lhyp lh ig.ihsg);
+             (show_goal2 lh ig g gs "");
+             (prli(natural_ntree  
+                    {ihsg=All_subgoals_hyp;isgintro="standard"})
+                            (List.rev ltree));
+             de_A_on_deduit_donc_B arg g
+        ]
+and natural_cutintro ig lh g gs arg ltree =
+  spv
+         [  (natural_lhyp lh ig.ihsg);
+             (show_goal2 lh ig g gs "");
+             sph [spi;
+                    (natural_ntree  
+                       {ihsg=All_subgoals_hyp;isgintro=""}
+                       (List.nth ltree 1))];
+             sph [spi;
+                    (natural_ntree  
+                       {ihsg=No_subgoals_hyp;isgintro=""}
+                       (List.nth ltree 0))]
+        ]
+and whd_betadeltaiota x = whd_betaiotaevar (Global.env()) Evd.empty x
+and type_of_ast s c = type_of (Global.env()) Evd.empty (constr_of_ast c)
+and prod_head t =
+  match (kind_of_term (strip_outer_cast t)) with 
+     Prod(_,_,c) -> prod_head c
+(*    |App(f,a) -> f *)
+    | _ -> t
+and string_of_sp sp = string_of_id (basename sp)
+and constr_of_mind mip i =
+  (string_of_id mip.mind_consnames.(i-1))
+and arity_of_constr_of_mind env indf i =
+     (get_constructors env indf).(i-1).cs_nargs
+and gLOB ge = Global.env_of_context ge  (* (Global.env()) *)
+
+and natural_case ig lh g gs ge arg1 ltree with_intros =
+ let env= (gLOB ge) in
+ let targ1 = prod_head (type_of env Evd.empty arg1) in
+ let IndType (indf,targ) = find_rectype env Evd.empty targ1 in
+ let ncti= Array.length(get_constructors env indf) in
+ let (ind,_) = dest_ind_family indf in
+ let (mib,mip) = lookup_mind_specif env ind in
+ let ti =(string_of_id mip.mind_typename) in
+ let type_arg= targ1 (* List.nth targ (mis_index dmi)*)  in
+ if  ncti<>1
+(* Zéro ou Plusieurs constructeurs *)
+ then (   
+   spv
+         [  (natural_lhyp lh ig.ihsg);
+             (show_goal2 lh ig g gs "");
+             (match (nsort targ1) with
+               Prop(Null) ->
+		 (match ti with
+		   "or" ->  discutons_avec_A type_arg
+                 | _ -> utilisons_A arg1)
+             |_ -> selon_les_valeurs_de_A arg1);
+            (let ci=ref 0 in
+             (prli
+                 (fun treearg -> ci:=!ci+1;
+                      let nci=(constr_of_mind mip !ci) in
+                      let aci=if with_intros
+			      then (arity_of_constr_of_mind env indf !ci)
+		              else 0 in
+                      let ici= (!ci) in
+                    sph[ (natural_ntree  
+                          {ihsg=
+                             (match (nsort targ1) with
+                                Prop(Null) ->
+                                   Case_prop_subgoals_hyp (supposons (),arg1,ici,aci,
+                                     (List.length ltree))
+                               |_-> Case_subgoals_hyp ("",arg1,nci,aci,
+                                                (List.length ltree)));
+                           isgintro= if with_intros then "" else "standard"}
+                          treearg)
+                    ])
+                  (nrem ltree ((List.length ltree)- ncti))));
+	    (sph [spi; (natural_rem_goals
+			  (nhd ltree ((List.length ltree)- ncti)))])
+         ] )
+(* Cas d'un seul constructeur *)
+     else (  
+
+     spv
+     [ (natural_lhyp lh ig.ihsg);
+       (show_goal2 lh ig g gs "");
+       de_A_on_a arg1;
+       (let treearg=List.hd ltree in
+       let nci=(constr_of_mind mip 1) in
+       let aci=
+	 if with_intros
+         then (arity_of_constr_of_mind env indf 1)
+	 else 0 in
+       let ici= 1 in
+       sph[ (natural_ntree  
+               {ihsg=
+                 (match (nsort targ1) with
+                   Prop(Null) ->
+                     Case_prop_subgoals_hyp ("",arg1,1,aci,
+					     (List.length ltree))
+                 |_-> Case_subgoals_hyp ("",arg1,nci,aci,
+                                         (List.length ltree)));
+                 isgintro=""}
+               treearg)
+          ]);
+       (sph [spi; (natural_rem_goals
+		     (nhd ltree ((List.length ltree)- 1)))])
+     ] 
+     )
+(*    with _ ->natural_generic ig lh g gs (sps "Case")  (spt arg1) ltree *)
+
+(*****************************************************************************)
+(*
+   Elim
+*)
+and prod_list_var t =
+   match (kind_of_term (strip_outer_cast t)) with 
+      Prod(_,t,c) -> t::(prod_list_var c)
+     |_ -> []
+and  hd_is_mind t ti =
+    try (let env = Global.env() in
+         let IndType (indf,targ) = find_rectype env Evd.empty t in
+	 let ncti= Array.length(get_constructors env indf) in
+	 let (ind,_) = dest_ind_family indf in
+         let (mib,mip) = lookup_mind_specif env ind in
+	 (string_of_id mip.mind_typename) = ti)
+    with _ -> false
+and mind_ind_info_hyp_constr indf c =
+  let env = Global.env() in
+  let (ind,_) = dest_ind_family indf in
+  let (mib,mip) = lookup_mind_specif env ind in
+  let p = mip.mind_nparams in
+  let a = arity_of_constr_of_mind env indf c in
+  let lp=ref (get_constructors env indf).(c).cs_args in
+  let lr=ref [] in
+  let ti = (string_of_id mip.mind_typename) in
+  for i=1 to a do
+     match !lp with
+     ((_,_,t)::lp1)->
+       if hd_is_mind t ti
+       then (lr:=(!lr)@["argrec";"hyprec"]; lp:=List.tl lp1)
+       else (lr:=(!lr)@["arg"];lp:=lp1)
+     |  _ -> raise (Failure "mind_ind_info_hyp_constr")
+  done;
+  !lr
+(*
+ mind_ind_info_hyp_constr "le" 2;;
+donne  ["arg"; "argrec"] 
+mind_ind_info_hyp_constr "le" 1;;
+donne []
+ mind_ind_info_hyp_constr "nat" 2;;
+donne ["argrec"]
+*)
+
+and natural_elim ig lh g gs ge arg1 ltree with_intros=
+ let env= (gLOB ge) in
+ let targ1 = prod_head (type_of env Evd.empty arg1) in
+ let IndType (indf,targ) = find_rectype env Evd.empty targ1 in
+ let ncti= Array.length(get_constructors env indf) in
+ let (ind,_) = dest_ind_family indf in
+ let (mib,mip) = lookup_mind_specif env ind in
+ let ti =(string_of_id mip.mind_typename) in
+ let type_arg=targ1 (* List.nth targ (mis_index dmi) *) in
+  spv
+         [  (natural_lhyp lh ig.ihsg);
+             (show_goal2 lh ig g gs "");
+             (match (nsort targ1) with
+               Prop(Null) -> utilisons_A arg1
+	     |_ ->procedons_par_recurrence_sur_A arg1);
+            (let ci=ref 0 in
+             (prli
+                 (fun treearg -> ci:=!ci+1;
+                      let nci=(constr_of_mind mip !ci) in
+                      let aci=(arity_of_constr_of_mind env indf !ci) in
+                      let hci=
+			if with_intros
+			then mind_ind_info_hyp_constr indf  !ci
+		      	else [] in
+                      let ici= (!ci) in
+                    sph[ (natural_ntree  
+                          {ihsg=
+                             (match (nsort targ1) with
+                                Prop(Null) ->
+                                   Elim_prop_subgoals_hyp (arg1,ici,aci,hci,
+                                     (List.length ltree))
+                               |_-> Elim_subgoals_hyp (arg1,nci,aci,hci,
+                                                (List.length ltree)));
+                           isgintro= ""}
+                          treearg)
+                    ])
+                  (nhd ltree ncti)));
+	    (sph [spi; (natural_rem_goals (nrem ltree ncti))])
+        ]
+(* )
+  with _ ->natural_generic ig lh g gs (sps "Elim")  (spt arg1) ltree *)
+
+(*****************************************************************************)
+(*
+   InductionIntro n
+*) 
+and natural_induction ig lh g gs ge arg2 ltree with_intros=
+ let env = (gLOB (g_env (List.hd ltree))) in
+ let arg1= mkVar arg2 in
+ let targ1 = prod_head (type_of env Evd.empty arg1) in
+ let IndType (indf,targ) = find_rectype env Evd.empty targ1 in
+ let ncti= Array.length(get_constructors env indf) in
+ let (ind,_) = dest_ind_family indf in
+ let (mib,mip) = lookup_mind_specif env ind in
+ let ti =(string_of_id mip.mind_typename) in
+ let type_arg= targ1(*List.nth targ (mis_index dmi)*) in
+
+ let lh1= hyps (List.hd ltree) in (* la liste des hyp jusqu'a n *)
+ (* on les enleve des hypotheses des sous-buts *)
+ let ltree = List.map
+     (fun {t_info=info;
+	    t_goal={newhyp=lh;t_concl=g;t_full_concl=gf;t_full_env=ge};
+	    t_proof=p} ->
+	  {t_info=info;
+	    t_goal={newhyp=(nrem lh (List.length lh1));
+		     t_concl=g;t_full_concl=gf;t_full_env=ge};
+	    t_proof=p}) ltree in
+ spv
+   [  (natural_lhyp lh ig.ihsg);
+             (show_goal2 lh ig g gs "");
+	   (natural_lhyp lh1 All_subgoals_hyp);
+             (match (print_string "targ1------------\n";(nsort targ1)) with
+               Prop(Null) -> utilisons_A arg1
+	     |_ -> procedons_par_recurrence_sur_A arg1);
+            (let ci=ref 0 in
+             (prli
+                 (fun treearg -> ci:=!ci+1;
+                      let nci=(constr_of_mind mip !ci) in
+                      let aci=(arity_of_constr_of_mind env indf !ci) in
+                      let hci= 
+			if with_intros
+			then mind_ind_info_hyp_constr indf  !ci
+		      	else [] in
+                      let ici= (!ci) in
+                    sph[ (natural_ntree  
+                          {ihsg=
+                             (match (nsort targ1) with
+                                Prop(Null) ->
+                                   Elim_prop_subgoals_hyp (arg1,ici,aci,hci,
+                                     (List.length ltree))
+                               |_-> Elim_subgoals_hyp (arg1,nci,aci,hci,
+                                                (List.length ltree)));
+                           isgintro= "standard"}
+                          treearg)
+                    ])
+                  ltree))
+        ]
+(************************************************************************)
+(* Points fixes *)
+
+and natural_fix ig lh g gs narg ltree =
+  let {t_info=info;
+	t_goal={newhyp=lh1;t_concl=g1;t_full_concl=gf1;
+                   t_full_env=ge1};t_proof=p1}=(List.hd ltree) in
+  match lh1 with
+     {hyp_name=nfun;hyp_type=tfun}::lh2 ->
+  let ltree=[{t_info=info;
+	       t_goal={newhyp=lh2;t_concl=g1;t_full_concl=gf1;
+                          t_full_env=ge1};
+	       t_proof=p1}] in
+  spv
+         [  (natural_lhyp lh ig.ihsg);
+             calculons_la_fonction_F_de_type_T_par_recurrence_sur_son_argument_A  nfun tfun narg;
+             (prli(natural_ntree  
+                   {ihsg=All_subgoals_hyp;isgintro=""})
+                            ltree)
+        ]
+   | _ -> assert false
+and natural_reduce ig lh g gs ge mode la ltree =
+  match la with
+    {onhyps=Some[];onconcl=true} -> 
+      spv
+        [  (natural_lhyp lh ig.ihsg);
+          (show_goal2 lh ig g gs ""); 
+          (prl (natural_ntree 
+		  {ihsg=All_subgoals_hyp;isgintro="simpl"})
+             ltree)
+        ]
+  | {onhyps=Some[hyp]; onconcl=false} ->
+      spv
+        [  (natural_lhyp lh ig.ihsg);
+          (show_goal2 lh ig g gs ""); 
+          (prl (natural_ntree 
+		  {ihsg=Reduce_hyp;isgintro=""})
+             ltree)
+        ]
+  | _ -> assert false
+and natural_split ig lh g gs ge la ltree =
+  match la with
+    [arg] -> 
+      let env= (gLOB ge) in
+      let arg1= (*dbize env*) arg in
+      spv
+      	[ (natural_lhyp lh ig.ihsg);
+          (show_goal2 lh ig g gs ""); 
+	  pour_montrer_G_la_valeur_recherchee_est_A  g arg1;
+          (prl (natural_ntree 
+		  {ihsg=All_subgoals_hyp;isgintro="standard"})
+             ltree)
+        ]
+  | [] ->
+      spv
+        [ (natural_lhyp lh ig.ihsg);
+          (prli(natural_ntree  
+                  {ihsg=All_subgoals_hyp;isgintro="standard"})
+             ltree)
+        ]
+  | _ -> assert false
+and natural_generalize ig lh g gs ge la ltree =
+  match la with
+    [arg] ->
+      let env= (gLOB ge) in
+      let arg1= (*dbize env*) arg in
+      let type_arg=type_of (Global.env()) Evd.empty arg in
+(*      let type_arg=type_of_ast ge arg in*)
+      spv
+      	[ (natural_lhyp lh ig.ihsg);
+          (show_goal2 lh ig g gs ""); 
+	  on_se_sert_de_A   arg1;
+          (prl (natural_ntree 
+		  {ihsg=All_subgoals_hyp;isgintro=""})
+             ltree)
+        ]
+    | _ -> assert false
+and natural_right ig lh g gs ltree =
+  spv
+         [ (natural_lhyp lh ig.ihsg);
+            (prli(natural_ntree  
+                {ihsg=All_subgoals_hyp;isgintro="standard"})
+                            ltree); 
+            d_ou_A g  
+        ]
+and natural_left ig lh g gs ltree =
+  spv
+         [ (natural_lhyp lh ig.ihsg);
+            (prli(natural_ntree  
+                {ihsg=All_subgoals_hyp;isgintro="standard"})
+                            ltree); 
+             d_ou_A g  
+        ]
+and natural_auto ig lh g gs ltree =
+  match ig.isgintro with
+   "trivial_equality" -> spe
+  | _ -> 
+      if ltree=[]
+      then sphv [(natural_lhyp lh ig.ihsg);
+		  (show_goal2 lh ig g gs "");
+		  coq_le_demontre_seul ()]
+      else spv [(natural_lhyp lh ig.ihsg);
+		 (show_goal2 lh ig g gs "");
+		 (prli (natural_ntree {ihsg=All_subgoals_hyp;isgintro=""}
+			  )
+                    ltree)]
+and natural_infoauto ig lh g gs ltree =
+ match ig.isgintro with
+   "trivial_equality" ->
+     spshrink "trivial_equality"
+       (natural_ntree {ihsg=All_subgoals_hyp;isgintro="standard"}
+		 (List.hd ltree))
+  | _ ->   sphv [(natural_lhyp lh ig.ihsg);
+	 (show_goal2 lh ig g gs "");
+	 coq_le_demontre_seul ();
+       spshrink "auto"
+		    (sph [spi;
+		       (natural_ntree
+			  {ihsg=All_subgoals_hyp;isgintro=""}
+			  (List.hd ltree))])]
+and natural_trivial ig lh g gs ltree =
+  if ltree=[]
+  then sphv [(natural_lhyp lh ig.ihsg);
+	      (show_goal2 lh ig g gs "");
+	      ce_qui_est_trivial () ]
+  else spv [(natural_lhyp lh ig.ihsg);
+	     (show_goal2 lh ig g gs ". ");
+            (prli(natural_ntree  
+                      {ihsg=All_subgoals_hyp;isgintro="standard"})
+                            ltree)]
+and natural_rewrite ig lh g gs arg ltree =
+  spv
+         [  (natural_lhyp lh ig.ihsg);
+             (show_goal2 lh ig g gs "");
+             en_utilisant_l_egalite_A arg;
+            (prli(natural_ntree  
+                 {ihsg=All_subgoals_hyp;isgintro="rewrite"})
+                            ltree)
+        ]
+;;
+
+let natural_ntree_path ig g =
+  Random.init(0);
+        natural_ntree ig g
+;;
+
+let show_proof lang gpath =
+  (match lang with
+     "fr" -> natural_language:=French
+    |"en" -> natural_language:=English
+    | _ -> natural_language:=English);
+  path:=List.rev gpath;
+  name_count:=0;
+  let ntree=(get_nproof ()) in
+  let {t_info=i;t_goal=g;t_proof=p} =ntree in
+  root_of_text_proof
+    (sph [(natural_ntree_path {ihsg=All_subgoals_hyp;
+				isgintro="standard"}
+	                      {t_info="not_proved";t_goal=g;t_proof=p});
+           spr])
+    ;;
+
+let show_nproof path =
+  pp (sp_print (sph [spi; show_proof "fr" path]));;
+
+vinterp_add "ShowNaturalProof"
+	    (fun _ ->
+		 (fun () ->show_nproof[];()));;
+
+(***********************************************************************
+debug sous cygwin:
+
+PATH=/usr/local/bin:/usr/bin:$PATH
+COQTOP=d:/Tools/coq-7avril
+CAMLLIB=/usr/local/lib/ocaml
+CAMLP4LIB=/usr/local/lib/camlp4
+export CAMLLIB
+export COQTOP
+export CAMLP4LIB 
+cd d:/Tools/pcoq/src/text
+d:/Tools/coq-7avril/bin/coqtop.byte.exe -I /cygdrive/D/Tools/pcoq/src/abs_syntax  -I /cygdrive/D/Tools/pcoq/src/text -I /cygdrive/D/Tools/pcoq/src/coq -I /cygdrive/D/Tools/pcoq/src/pbp -I /cygdrive/D/Tools/pcoq/src/dad -I /cygdrive/D/Tools/pcoq/src/history
+
+ 
+ 
+Lemma l1: (A, B : Prop) A \/ B -> B ->  A.
+Intros.
+Elim H.
+Auto.
+Qed.
+ 
+
+Drop.
+
+#use "/cygdrive/D/Tools/coq-7avril/dev/base_include";;
+#load "xlate.cmo";;
+#load "translate.cmo";;
+#load "showproof_ct.cmo";;
+#load "showproof.cmo";;
+#load "pbp.cmo";;
+#load "debug_tac.cmo";;
+#load "name_to_ast.cmo";;
+#load "paths.cmo";;
+#load "dad.cmo";;
+#load "vtp.cmo";;
+#load "history.cmo";;
+#load "centaur.cmo";;
+Xlate.set_xlate_mut_stuff Centaur.globcv;;
+Xlate.declare_in_coq();;
+
+#use "showproof.ml";;
+
+let pproof x = pP (sp_print x);;
+Pp_control.set_depth_boxes 100;;
+#install_printer  pproof;;
+
+ep();;
+let bidon = ref (constr_of_string "O");; 
+
+#trace to_nproof;;
+***********************************************************************)
+let ep()=show_proof "fr" [];;
diff --git a/contrib/interface/showproof.mli b/contrib/interface/showproof.mli
new file mode 100755
index 00000000..ee269458
--- /dev/null
+++ b/contrib/interface/showproof.mli
@@ -0,0 +1,23 @@
+open Environ
+open Evd
+open Names
+open Term
+open Util
+open Proof_type
+open Coqast
+open Pfedit
+open Translate
+open Term
+open Reduction
+open Clenv
+open Typing
+open Inductive
+open Vernacinterp
+open Declarations
+open Showproof_ct
+open Proof_trees
+open Sign
+open Pp
+open Printer
+
+val show_proof : string -> int list -> Ascent.ct_TEXT;;
diff --git a/contrib/interface/showproof_ct.ml b/contrib/interface/showproof_ct.ml
new file mode 100644
index 00000000..ee901c5e
--- /dev/null
+++ b/contrib/interface/showproof_ct.ml
@@ -0,0 +1,185 @@
+(*****************************************************************************)
+(*
+   Vers Ctcoq
+*)
+
+open Esyntax
+open Metasyntax
+open Printer
+open Pp
+open Translate
+open Ascent
+open Vtp
+open Xlate
+
+let ct_text x = CT_coerce_ID_to_TEXT (CT_ident x);;
+
+let sps s =
+  ct_text s
+    ;;
+
+
+let sphs s =
+  ct_text s
+    ;;
+
+let spe = sphs "";;
+let spb = sps " ";;
+let spr = sps "Retour chariot pour Show proof";;
+
+let spnb n = 
+   let s = ref "" in
+   for i=1 to n do s:=(!s)^" "; done; sps !s
+;;
+
+
+let rec spclean l =
+  match l with 
+    [] -> []
+   |x::l -> if x=spe then (spclean l) else x::(spclean l)
+;;
+
+
+let spnb n = 
+   let s = ref "" in
+   for i=1 to n do s:=(!s)^" "; done; sps !s
+;;
+
+let ct_FORMULA_constr = Hashtbl.create 50;;
+
+let stde()  = (Global.env())
+
+;;
+
+let spt t =
+   let f = (translate_constr true (stde()) t) in
+   Hashtbl.add ct_FORMULA_constr f t;
+   CT_text_formula f
+;;
+
+
+
+let root_of_text_proof t=
+  CT_text_op [ct_text "root_of_text_proof";
+              t]
+    ;;
+    
+let spshrink info t =
+  CT_text_op [ct_text "shrink";
+	      CT_text_op [ct_text info;
+                          t]]
+;;
+			 
+let spuselemma intro x y =
+  CT_text_op [ct_text "uselemma";
+              ct_text intro;
+	      x;y]
+;;
+
+let sptoprove p t =
+  CT_text_op [ct_text "to_prove";
+	      CT_text_path p;
+              ct_text "goal";
+	      (spt t)]
+;;
+let sphyp p h t =
+  CT_text_op [ct_text "hyp";
+	      CT_text_path p;
+	      ct_text h;
+              (spt t)]
+;;
+let sphypt p h t =
+  CT_text_op [ct_text "hyp_with_type";
+	      CT_text_path p;
+	      ct_text h;
+              (spt t)]
+;;
+
+let spwithtac x t =
+    CT_text_op [ct_text "with_tactic";
+                ct_text t;
+                x]
+;;
+
+
+let spv l =
+   let l= spclean l in
+   CT_text_v l
+;;
+     
+let sph l =
+   let l= spclean l in
+   CT_text_h l
+;;
+
+
+let sphv l =
+   let l= spclean l in
+   CT_text_hv l
+;;
+
+let rec prlist_with_sep f g l =
+    match l with 
+      [] -> hov 0 (mt ())
+     |x::l1 -> hov 0 ((g x) ++ (f ()) ++ (prlist_with_sep f g l1))
+;;
+   
+let rec sp_print x = 
+   match x with
+     | CT_coerce_ID_to_TEXT (CT_ident s)
+       -> (match s with
+	     | "\n" -> fnl ()
+	     | "Retour chariot pour Show proof" -> fnl ()
+	     |_ -> str s)
+     | CT_text_formula  f -> prterm (Hashtbl.find ct_FORMULA_constr f)
+     | CT_text_op [CT_coerce_ID_to_TEXT (CT_ident "to_prove");
+		   CT_text_path (CT_signed_int_list p);
+		   CT_coerce_ID_to_TEXT (CT_ident "goal");
+		   g] ->
+      let p=(List.map (fun y -> match y with
+	                 (CT_coerce_INT_to_SIGNED_INT
+			      (CT_int x)) -> x
+		       | _ -> raise (Failure "sp_print")) p) in
+      h 0 (str "<b>" ++ sp_print g ++ str "</b>")
+ |   CT_text_op [CT_coerce_ID_to_TEXT (CT_ident "uselemma");
+              CT_coerce_ID_to_TEXT (CT_ident intro);
+	      l;g] ->
+      h 0 (str ("<i>("^intro^" ") ++ sp_print l ++ str ")</i>" ++ sp_print g)
+ |   CT_text_op [CT_coerce_ID_to_TEXT (CT_ident "hyp");
+	      CT_text_path (CT_signed_int_list p);
+	      CT_coerce_ID_to_TEXT (CT_ident hyp);
+              g]  ->
+      let p=(List.map (fun y -> match y with
+	                  (CT_coerce_INT_to_SIGNED_INT
+			      (CT_int x)) -> x
+		       | _ -> raise (Failure "sp_print")) p) in
+            h 0 (str hyp)
+
+  |   CT_text_op [CT_coerce_ID_to_TEXT (CT_ident "hyp_with_type");
+	      CT_text_path (CT_signed_int_list p);
+	      CT_coerce_ID_to_TEXT (CT_ident hyp);
+              g]  ->
+      let p=(List.map (fun y -> match y with
+                         (CT_coerce_INT_to_SIGNED_INT
+			      (CT_int x)) -> x
+		       | _ -> raise (Failure "sp_print")) p) in
+      h 0 (sp_print g ++ spc () ++ str "<i>(" ++ str hyp ++ str ")</i>")   
+
+  | CT_text_h l ->
+      h 0 (prlist_with_sep (fun () -> mt ())
+	     (fun y -> sp_print y) l)
+  | CT_text_v l ->
+      v 0 (prlist_with_sep (fun () -> mt ())
+		(fun y -> sp_print y) l)
+  | CT_text_hv l ->
+      h 0 (prlist_with_sep (fun () -> mt ())
+	     (fun y -> sp_print y) l)
+  | CT_text_op [CT_coerce_ID_to_TEXT (CT_ident "shrink");
+	      CT_text_op [CT_coerce_ID_to_TEXT (CT_ident info); t]]  ->
+                   h 0 (str ("("^info^": ") ++ sp_print t ++ str ")")
+  | CT_text_op [CT_coerce_ID_to_TEXT (CT_ident "root_of_text_proof");
+              t]->
+                    sp_print t 
+  | _ -> str "..."
+;;
+  
diff --git a/contrib/interface/translate.ml b/contrib/interface/translate.ml
new file mode 100644
index 00000000..e63baecf
--- /dev/null
+++ b/contrib/interface/translate.ml
@@ -0,0 +1,165 @@
+open Names;;
+open Sign;;
+open Util;;
+open Ast;;
+open Term;;
+open Pp;;
+open Libobject;;
+open Library;;
+open Vernacinterp;;
+open Termast;;
+open Tacmach;;
+open Pfedit;;
+open Parsing;;
+open Evd;;
+open Evarutil;;
+
+open Xlate;;
+open Ctast;;
+open Vtp;;
+open Ascent;;
+open Environ;;
+open Proof_type;;
+
+(* dead code: let rel_reference gt k oper = 
+ if is_existential_oper oper then ope("XTRA", [str "ISEVAR"])
+ else begin
+  let id = id_of_global oper in
+  let oper', _ = global_operator (Nametab.sp_of_id k id) id in
+  if oper = oper' then nvar (string_of_id id)
+  else failwith "xlate"
+end;;
+*)
+
+(* dead code: 
+let relativize relfun =
+ let rec relrec =
+  function
+     | Nvar (_, id) -> nvar id
+     | Slam (l, na, ast) -> Slam (l, na, relrec ast)
+     | Node (loc, nna, l) as ast -> begin
+       try relfun ast
+       with
+       | Failure _ -> Node (loc, nna, List.map relrec l)
+     end
+     | a -> a in
+ relrec;;
+*)
+
+(* dead code:
+let dbize_sp =
+ function
+    | Path (loc, sl, s) -> begin
+      try section_path sl s
+      with
+      | Invalid_argument _ | Failure _ ->
+      anomaly_loc
+       (loc, "Translate.dbize_sp (taken from Astterm)",
+       [< str "malformed section-path" >])
+    end
+    | ast ->
+     anomaly_loc
+      (Ast.loc ast, "Translate.dbize_sp (taken from Astterm)",
+      [< str "not a section-path" >]);;
+*)
+
+(* dead code:
+let relativize_cci gt = relativize (function
+    | Node (_, "CONST", (p :: _)) as gt ->
+     rel_reference gt CCI (Const (dbize_sp p))
+    | Node (_, "MUTIND", (p :: ((Num (_, tyi)) :: _))) as gt ->
+     rel_reference gt CCI (MutInd (dbize_sp p, tyi))
+    | Node (_, "MUTCONSTRUCT", (p :: ((Num (_, tyi)) :: ((Num (_, i)) :: _)))) as gt ->
+     rel_reference gt CCI (MutConstruct (
+      (dbize_sp p, tyi), i))
+    | _ -> failwith "caught") gt;;
+*)
+
+let coercion_description_holder = ref (function _ -> None : t -> int option);;
+
+let coercion_description t = !coercion_description_holder t;;
+
+let set_coercion_description f =
+ coercion_description_holder:=f; ();;
+
+let rec nth_tl l n = if n = 0 then l
+ else (match l with
+ | a :: b -> nth_tl b (n - 1)
+ | [] -> failwith "list too short for nth_tl");;
+
+let rec discard_coercions =
+ function
+    | Slam (l, na, ast) -> Slam (l, na, discard_coercions ast)
+    | Node (l, ("APPLIST" as nna), (f :: args as all_sons)) ->
+     (match coercion_description f with
+     | Some n ->
+      let new_args =
+       try nth_tl args n
+       with
+       | Failure "list too short for nth_tl" -> [] in
+      (match new_args with
+       | a :: (b :: c) -> Node (l, nna, List.map discard_coercions new_args)
+       | a :: [] -> discard_coercions a
+       | [] -> Node (l, nna, List.map discard_coercions all_sons))
+     | None -> Node (l, nna, List.map discard_coercions all_sons))
+    | Node (l, nna, all_sons) ->
+     Node (l, nna, List.map discard_coercions all_sons)
+    | it -> it;;
+
+(*translates a formula into a centaur-tree --> FORMULA *)
+let translate_constr at_top env c =
+  xlate_formula (Constrextern.extern_constr at_top env c);;
+
+(*translates a named_context into a centaur-tree --> PREMISES_LIST *)
+(* this code is inspired from printer.ml (function pr_named_context_of) *)
+let translate_sign env =
+  let l = 
+    Environ.fold_named_context
+      (fun env (id,v,c) l -> 
+	 (match v with
+	      None ->
+	       	CT_premise(CT_ident(string_of_id id), translate_constr false env c)
+	    | Some v1 ->
+		CT_eval_result
+		  (CT_coerce_ID_to_FORMULA (CT_ident (string_of_id id)),
+		   translate_constr false env v1,
+		   translate_constr false env c))::l)
+      env ~init:[] 
+  in
+  CT_premises_list l;;
+       
+(* the function rev_and_compact performs two operations:
+   1- it reverses the list of integers given as argument
+   2- it replaces sequences of "1" by a negative number that is
+      the length of the sequence. *)
+let rec rev_and_compact l = function
+    [] -> l
+  | 1::tl -> 
+      (match l with
+              n::tl' -> 
+        if n < 0 then
+          rev_and_compact ((n - 1)::tl') tl
+        else
+          rev_and_compact ((-1)::l) tl
+      |       [] -> rev_and_compact [-1] tl)
+  | a::tl ->
+      if a < 0 then
+      (match l with
+        n::tl' ->
+          if n < 0 then
+            rev_and_compact ((n + a)::tl') tl
+          else
+            rev_and_compact (a::l) tl
+      | [] -> rev_and_compact (a::l) tl)
+      else
+      rev_and_compact (a::l) tl;;
+
+(*translates an int list into a centaur-tree --> SIGNED_INT_LIST *)
+let translate_path l =
+ CT_signed_int_list
+ (List.map (function n -> CT_coerce_INT_to_SIGNED_INT (CT_int n))
+    (rev_and_compact [] l));;
+
+(*translates a path and a goal into a centaur-tree --> RULE *)
+let translate_goal (g:goal) =
+ CT_rule(translate_sign (evar_env g), translate_constr true (evar_env g) g.evar_concl);;
diff --git a/contrib/interface/translate.mli b/contrib/interface/translate.mli
new file mode 100644
index 00000000..65d8331b
--- /dev/null
+++ b/contrib/interface/translate.mli
@@ -0,0 +1,11 @@
+open Ascent;;
+open Evd;;
+open Proof_type;;
+open Environ;;
+open Term;;
+
+val translate_goal : goal -> ct_RULE;;
+(* The boolean argument indicates whether names from the environment should *)
+(*  be avoided (same interpretation as for prterm_env and ast_of_constr)    *)
+val translate_constr : bool -> env -> constr -> ct_FORMULA;;
+val translate_path : int list -> ct_SIGNED_INT_LIST;;
diff --git a/contrib/interface/vernacrc b/contrib/interface/vernacrc
new file mode 100644
index 00000000..42b5e5ab
--- /dev/null
+++ b/contrib/interface/vernacrc
@@ -0,0 +1,12 @@
+# $Id: vernacrc,v 1.3 2004/01/14 14:52:59 bertot Exp $
+
+# This file is loaded initially by ./vernacparser.
+
+load_syntax_file 1 Notations
+load_syntax_file 2 Logic
+load_syntax_file 34 Omega
+load_syntax_file 27 Ring
+quiet_parse_string
+Goal a.
+&& END--OF--DATA
+print_version
diff --git a/contrib/interface/vtp.ml b/contrib/interface/vtp.ml
new file mode 100644
index 00000000..ff418523
--- /dev/null
+++ b/contrib/interface/vtp.ml
@@ -0,0 +1,1915 @@
+open Ascent;;
+
+let fNODE s n =
+    print_string "n\n";
+    print_string ("vernac$" ^ s);
+    print_string "\n";
+    print_int n;
+    print_string "\n";;
+
+let fATOM s1 =
+    print_string "a\n";
+    print_string ("vernac$" ^ s1);
+    print_string "\n";;
+
+let f_atom_string = print_string;;
+let f_atom_int = print_int;;
+let rec fAST = function
+| CT_coerce_ID_OR_INT_to_AST x -> fID_OR_INT x
+| CT_coerce_ID_OR_STRING_to_AST x -> fID_OR_STRING x
+| CT_coerce_SINGLE_OPTION_VALUE_to_AST x -> fSINGLE_OPTION_VALUE x
+| CT_astnode(x1, x2) ->
+   fID x1;
+   fAST_LIST x2;
+   fNODE "astnode" 2
+| CT_astpath(x1) ->
+   fID_LIST x1;
+   fNODE "astpath" 1
+| CT_astslam(x1, x2) ->
+   fID_OPT x1;
+   fAST x2;
+   fNODE "astslam" 2
+and fAST_LIST = function
+| CT_ast_list l ->
+   (List.iter fAST l);
+   fNODE "ast_list" (List.length l)
+and fBINARY = function
+| CT_binary x -> fATOM "binary";
+   (f_atom_int x);
+   print_string "\n"and fBINDER = function
+| CT_coerce_DEF_to_BINDER x -> fDEF x
+| CT_binder(x1, x2) ->
+   fID_OPT_NE_LIST x1;
+   fFORMULA x2;
+   fNODE "binder" 2
+| CT_binder_coercion(x1, x2) ->
+   fID_OPT_NE_LIST x1;
+   fFORMULA x2;
+   fNODE "binder_coercion" 2
+and fBINDER_LIST = function
+| CT_binder_list l ->
+   (List.iter fBINDER l);
+   fNODE "binder_list" (List.length l)
+and fBINDER_NE_LIST = function
+| CT_binder_ne_list(x,l) ->
+   fBINDER x;
+   (List.iter fBINDER l);
+   fNODE "binder_ne_list" (1 + (List.length l))
+and fBINDING = function
+| CT_binding(x1, x2) ->
+   fID_OR_INT x1;
+   fFORMULA x2;
+   fNODE "binding" 2
+and fBINDING_LIST = function
+| CT_binding_list l ->
+   (List.iter fBINDING l);
+   fNODE "binding_list" (List.length l)
+and fBOOL = function
+| CT_false -> fNODE "false" 0
+| CT_true -> fNODE "true" 0
+and fCASE = function
+| CT_case x -> fATOM "case";
+   (f_atom_string x);
+   print_string "\n"and fCLAUSE = function
+| CT_clause(x1, x2) ->
+   fHYP_LOCATION_LIST_OR_STAR x1;
+   fSTAR_OPT x2;
+   fNODE "clause" 2
+and fCOERCION_OPT = function
+| CT_coerce_NONE_to_COERCION_OPT x -> fNONE x
+| CT_coercion_atm -> fNODE "coercion_atm" 0
+and fCOFIXTAC = function
+| CT_cofixtac(x1, x2) ->
+   fID x1;
+   fFORMULA x2;
+   fNODE "cofixtac" 2
+and fCOFIX_REC = function
+| CT_cofix_rec(x1, x2, x3, x4) ->
+   fID x1;
+   fBINDER_LIST x2;
+   fFORMULA x3;
+   fFORMULA x4;
+   fNODE "cofix_rec" 4
+and fCOFIX_REC_LIST = function
+| CT_cofix_rec_list(x,l) ->
+   fCOFIX_REC x;
+   (List.iter fCOFIX_REC l);
+   fNODE "cofix_rec_list" (1 + (List.length l))
+and fCOFIX_TAC_LIST = function
+| CT_cofix_tac_list l ->
+   (List.iter fCOFIXTAC l);
+   fNODE "cofix_tac_list" (List.length l)
+and fCOMMAND = function
+| CT_coerce_COMMAND_LIST_to_COMMAND x -> fCOMMAND_LIST x
+| CT_coerce_EVAL_CMD_to_COMMAND x -> fEVAL_CMD x
+| CT_coerce_SECTION_BEGIN_to_COMMAND x -> fSECTION_BEGIN x
+| CT_coerce_THEOREM_GOAL_to_COMMAND x -> fTHEOREM_GOAL x
+| CT_abort(x1) ->
+   fID_OPT_OR_ALL x1;
+   fNODE "abort" 1
+| CT_abstraction(x1, x2, x3) ->
+   fID x1;
+   fFORMULA x2;
+   fINT_LIST x3;
+   fNODE "abstraction" 3
+| CT_add_field(x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11) ->
+   fFORMULA x1;
+   fFORMULA x2;
+   fFORMULA x3;
+   fFORMULA x4;
+   fFORMULA x5;
+   fFORMULA x6;
+   fFORMULA x7;
+   fFORMULA x8;
+   fFORMULA x9;
+   fFORMULA x10;
+   fBINDING_LIST x11;
+   fNODE "add_field" 11
+| CT_add_natural_feature(x1, x2) ->
+   fNATURAL_FEATURE x1;
+   fID x2;
+   fNODE "add_natural_feature" 2
+| CT_addpath(x1, x2) ->
+   fSTRING x1;
+   fID_OPT x2;
+   fNODE "addpath" 2
+| CT_arguments_scope(x1, x2) ->
+   fID x1;
+   fID_OPT_LIST x2;
+   fNODE "arguments_scope" 2
+| CT_bind_scope(x1, x2) ->
+   fID x1;
+   fID_NE_LIST x2;
+   fNODE "bind_scope" 2
+| CT_cd(x1) ->
+   fSTRING_OPT x1;
+   fNODE "cd" 1
+| CT_check(x1) ->
+   fFORMULA x1;
+   fNODE "check" 1
+| CT_class(x1) ->
+   fID x1;
+   fNODE "class" 1
+| CT_close_scope(x1) ->
+   fID x1;
+   fNODE "close_scope" 1
+| CT_coercion(x1, x2, x3, x4, x5) ->
+   fLOCAL_OPT x1;
+   fIDENTITY_OPT x2;
+   fID x3;
+   fID x4;
+   fID x5;
+   fNODE "coercion" 5
+| CT_cofix_decl(x1) ->
+   fCOFIX_REC_LIST x1;
+   fNODE "cofix_decl" 1
+| CT_compile_module(x1, x2, x3) ->
+   fVERBOSE_OPT x1;
+   fID x2;
+   fSTRING_OPT x3;
+   fNODE "compile_module" 3
+| CT_declare_module(x1, x2, x3, x4) ->
+   fID x1;
+   fMODULE_BINDER_LIST x2;
+   fMODULE_TYPE_CHECK x3;
+   fMODULE_EXPR x4;
+   fNODE "declare_module" 4
+| CT_define_notation(x1, x2, x3, x4) ->
+   fSTRING x1;
+   fFORMULA x2;
+   fMODIFIER_LIST x3;
+   fID_OPT x4;
+   fNODE "define_notation" 4
+| CT_definition(x1, x2, x3, x4, x5) ->
+   fDEFN x1;
+   fID x2;
+   fBINDER_LIST x3;
+   fDEF_BODY x4;
+   fFORMULA_OPT x5;
+   fNODE "definition" 5
+| CT_delim_scope(x1, x2) ->
+   fID x1;
+   fID x2;
+   fNODE "delim_scope" 2
+| CT_delpath(x1) ->
+   fSTRING x1;
+   fNODE "delpath" 1
+| CT_derive_depinversion(x1, x2, x3, x4) ->
+   fINV_TYPE x1;
+   fID x2;
+   fFORMULA x3;
+   fSORT_TYPE x4;
+   fNODE "derive_depinversion" 4
+| CT_derive_inversion(x1, x2, x3, x4) ->
+   fINV_TYPE x1;
+   fINT_OPT x2;
+   fID x3;
+   fID x4;
+   fNODE "derive_inversion" 4
+| CT_derive_inversion_with(x1, x2, x3, x4) ->
+   fINV_TYPE x1;
+   fID x2;
+   fFORMULA x3;
+   fSORT_TYPE x4;
+   fNODE "derive_inversion_with" 4
+| CT_explain_proof(x1) ->
+   fINT_LIST x1;
+   fNODE "explain_proof" 1
+| CT_explain_prooftree(x1) ->
+   fINT_LIST x1;
+   fNODE "explain_prooftree" 1
+| CT_export_id(x1) ->
+   fID_NE_LIST x1;
+   fNODE "export_id" 1
+| CT_extract_to_file(x1, x2) ->
+   fSTRING x1;
+   fID_NE_LIST x2;
+   fNODE "extract_to_file" 2
+| CT_extraction(x1) ->
+   fID_OPT x1;
+   fNODE "extraction" 1
+| CT_fix_decl(x1) ->
+   fFIX_REC_LIST x1;
+   fNODE "fix_decl" 1
+| CT_focus(x1) ->
+   fINT_OPT x1;
+   fNODE "focus" 1
+| CT_go(x1) ->
+   fINT_OR_LOCN x1;
+   fNODE "go" 1
+| CT_guarded -> fNODE "guarded" 0
+| CT_hint_destruct(x1, x2, x3, x4, x5, x6) ->
+   fID x1;
+   fINT x2;
+   fDESTRUCT_LOCATION x3;
+   fFORMULA x4;
+   fTACTIC_COM x5;
+   fID_LIST x6;
+   fNODE "hint_destruct" 6
+| CT_hint_extern(x1, x2, x3, x4) ->
+   fINT x1;
+   fFORMULA x2;
+   fTACTIC_COM x3;
+   fID_LIST x4;
+   fNODE "hint_extern" 4
+| CT_hintrewrite(x1, x2, x3, x4) ->
+   fORIENTATION x1;
+   fFORMULA_NE_LIST x2;
+   fID x3;
+   fTACTIC_COM x4;
+   fNODE "hintrewrite" 4
+| CT_hints(x1, x2, x3) ->
+   fID x1;
+   fID_NE_LIST x2;
+   fID_LIST x3;
+   fNODE "hints" 3
+| CT_hints_immediate(x1, x2) ->
+   fFORMULA_NE_LIST x1;
+   fID_LIST x2;
+   fNODE "hints_immediate" 2
+| CT_hints_resolve(x1, x2) ->
+   fFORMULA_NE_LIST x1;
+   fID_LIST x2;
+   fNODE "hints_resolve" 2
+| CT_hyp_search_pattern(x1, x2) ->
+   fFORMULA x1;
+   fIN_OR_OUT_MODULES x2;
+   fNODE "hyp_search_pattern" 2
+| CT_implicits(x1, x2) ->
+   fID x1;
+   fID_LIST_OPT x2;
+   fNODE "implicits" 2
+| CT_import_id(x1) ->
+   fID_NE_LIST x1;
+   fNODE "import_id" 1
+| CT_ind_scheme(x1) ->
+   fSCHEME_SPEC_LIST x1;
+   fNODE "ind_scheme" 1
+| CT_infix(x1, x2, x3, x4) ->
+   fSTRING x1;
+   fID x2;
+   fMODIFIER_LIST x3;
+   fID_OPT x4;
+   fNODE "infix" 4
+| CT_inline(x1) ->
+   fID_NE_LIST x1;
+   fNODE "inline" 1
+| CT_inspect(x1) ->
+   fINT x1;
+   fNODE "inspect" 1
+| CT_kill_node(x1) ->
+   fINT x1;
+   fNODE "kill_node" 1
+| CT_load(x1, x2) ->
+   fVERBOSE_OPT x1;
+   fID_OR_STRING x2;
+   fNODE "load" 2
+| CT_local_close_scope(x1) ->
+   fID x1;
+   fNODE "local_close_scope" 1
+| CT_local_define_notation(x1, x2, x3, x4) ->
+   fSTRING x1;
+   fFORMULA x2;
+   fMODIFIER_LIST x3;
+   fID_OPT x4;
+   fNODE "local_define_notation" 4
+| CT_local_hint_destruct(x1, x2, x3, x4, x5, x6) ->
+   fID x1;
+   fINT x2;
+   fDESTRUCT_LOCATION x3;
+   fFORMULA x4;
+   fTACTIC_COM x5;
+   fID_LIST x6;
+   fNODE "local_hint_destruct" 6
+| CT_local_hint_extern(x1, x2, x3, x4) ->
+   fINT x1;
+   fFORMULA x2;
+   fTACTIC_COM x3;
+   fID_LIST x4;
+   fNODE "local_hint_extern" 4
+| CT_local_hints(x1, x2, x3) ->
+   fID x1;
+   fID_NE_LIST x2;
+   fID_LIST x3;
+   fNODE "local_hints" 3
+| CT_local_hints_immediate(x1, x2) ->
+   fFORMULA_NE_LIST x1;
+   fID_LIST x2;
+   fNODE "local_hints_immediate" 2
+| CT_local_hints_resolve(x1, x2) ->
+   fFORMULA_NE_LIST x1;
+   fID_LIST x2;
+   fNODE "local_hints_resolve" 2
+| CT_local_infix(x1, x2, x3, x4) ->
+   fSTRING x1;
+   fID x2;
+   fMODIFIER_LIST x3;
+   fID_OPT x4;
+   fNODE "local_infix" 4
+| CT_local_open_scope(x1) ->
+   fID x1;
+   fNODE "local_open_scope" 1
+| CT_local_reserve_notation(x1, x2) ->
+   fSTRING x1;
+   fMODIFIER_LIST x2;
+   fNODE "local_reserve_notation" 2
+| CT_locate(x1) ->
+   fID x1;
+   fNODE "locate" 1
+| CT_locate_file(x1) ->
+   fSTRING x1;
+   fNODE "locate_file" 1
+| CT_locate_lib(x1) ->
+   fID x1;
+   fNODE "locate_lib" 1
+| CT_locate_notation(x1) ->
+   fSTRING x1;
+   fNODE "locate_notation" 1
+| CT_mind_decl(x1, x2) ->
+   fCO_IND x1;
+   fIND_SPEC_LIST x2;
+   fNODE "mind_decl" 2
+| CT_ml_add_path(x1) ->
+   fSTRING x1;
+   fNODE "ml_add_path" 1
+| CT_ml_declare_modules(x1) ->
+   fSTRING_NE_LIST x1;
+   fNODE "ml_declare_modules" 1
+| CT_ml_print_modules -> fNODE "ml_print_modules" 0
+| CT_ml_print_path -> fNODE "ml_print_path" 0
+| CT_module(x1, x2, x3, x4) ->
+   fID x1;
+   fMODULE_BINDER_LIST x2;
+   fMODULE_TYPE_CHECK x3;
+   fMODULE_EXPR x4;
+   fNODE "module" 4
+| CT_module_type_decl(x1, x2, x3) ->
+   fID x1;
+   fMODULE_BINDER_LIST x2;
+   fMODULE_TYPE_OPT x3;
+   fNODE "module_type_decl" 3
+| CT_no_inline(x1) ->
+   fID_NE_LIST x1;
+   fNODE "no_inline" 1
+| CT_omega_flag(x1, x2) ->
+   fOMEGA_MODE x1;
+   fOMEGA_FEATURE x2;
+   fNODE "omega_flag" 2
+| CT_opaque(x1) ->
+   fID_NE_LIST x1;
+   fNODE "opaque" 1
+| CT_open_scope(x1) ->
+   fID x1;
+   fNODE "open_scope" 1
+| CT_print -> fNODE "print" 0
+| CT_print_about(x1) ->
+   fID x1;
+   fNODE "print_about" 1
+| CT_print_all -> fNODE "print_all" 0
+| CT_print_classes -> fNODE "print_classes" 0
+| CT_print_coercions -> fNODE "print_coercions" 0
+| CT_print_grammar(x1) ->
+   fGRAMMAR x1;
+   fNODE "print_grammar" 1
+| CT_print_graph -> fNODE "print_graph" 0
+| CT_print_hint(x1) ->
+   fID_OPT x1;
+   fNODE "print_hint" 1
+| CT_print_hintdb(x1) ->
+   fID_OR_STAR x1;
+   fNODE "print_hintdb" 1
+| CT_print_id(x1) ->
+   fID x1;
+   fNODE "print_id" 1
+| CT_print_implicit(x1) ->
+   fID x1;
+   fNODE "print_implicit" 1
+| CT_print_loadpath -> fNODE "print_loadpath" 0
+| CT_print_module(x1) ->
+   fID x1;
+   fNODE "print_module" 1
+| CT_print_module_type(x1) ->
+   fID x1;
+   fNODE "print_module_type" 1
+| CT_print_modules -> fNODE "print_modules" 0
+| CT_print_natural(x1) ->
+   fID x1;
+   fNODE "print_natural" 1
+| CT_print_natural_feature(x1) ->
+   fNATURAL_FEATURE x1;
+   fNODE "print_natural_feature" 1
+| CT_print_opaqueid(x1) ->
+   fID x1;
+   fNODE "print_opaqueid" 1
+| CT_print_path(x1, x2) ->
+   fID x1;
+   fID x2;
+   fNODE "print_path" 2
+| CT_print_proof(x1) ->
+   fID x1;
+   fNODE "print_proof" 1
+| CT_print_scope(x1) ->
+   fID x1;
+   fNODE "print_scope" 1
+| CT_print_scopes -> fNODE "print_scopes" 0
+| CT_print_section(x1) ->
+   fID x1;
+   fNODE "print_section" 1
+| CT_print_states -> fNODE "print_states" 0
+| CT_print_tables -> fNODE "print_tables" 0
+| CT_print_universes(x1) ->
+   fSTRING_OPT x1;
+   fNODE "print_universes" 1
+| CT_print_visibility(x1) ->
+   fID_OPT x1;
+   fNODE "print_visibility" 1
+| CT_proof(x1) ->
+   fFORMULA x1;
+   fNODE "proof" 1
+| CT_proof_no_op -> fNODE "proof_no_op" 0
+| CT_proof_with(x1) ->
+   fTACTIC_COM x1;
+   fNODE "proof_with" 1
+| CT_pwd -> fNODE "pwd" 0
+| CT_quit -> fNODE "quit" 0
+| CT_read_module(x1) ->
+   fID x1;
+   fNODE "read_module" 1
+| CT_rec_ml_add_path(x1) ->
+   fSTRING x1;
+   fNODE "rec_ml_add_path" 1
+| CT_recaddpath(x1, x2) ->
+   fSTRING x1;
+   fID_OPT x2;
+   fNODE "recaddpath" 2
+| CT_record(x1, x2, x3, x4, x5, x6) ->
+   fCOERCION_OPT x1;
+   fID x2;
+   fBINDER_LIST x3;
+   fFORMULA x4;
+   fID_OPT x5;
+   fRECCONSTR_LIST x6;
+   fNODE "record" 6
+| CT_remove_natural_feature(x1, x2) ->
+   fNATURAL_FEATURE x1;
+   fID x2;
+   fNODE "remove_natural_feature" 2
+| CT_require(x1, x2, x3) ->
+   fIMPEXP x1;
+   fSPEC_OPT x2;
+   fID_NE_LIST_OR_STRING x3;
+   fNODE "require" 3
+| CT_reserve(x1, x2) ->
+   fID_NE_LIST x1;
+   fFORMULA x2;
+   fNODE "reserve" 2
+| CT_reserve_notation(x1, x2) ->
+   fSTRING x1;
+   fMODIFIER_LIST x2;
+   fNODE "reserve_notation" 2
+| CT_reset(x1) ->
+   fID x1;
+   fNODE "reset" 1
+| CT_reset_section(x1) ->
+   fID x1;
+   fNODE "reset_section" 1
+| CT_restart -> fNODE "restart" 0
+| CT_restore_state(x1) ->
+   fID x1;
+   fNODE "restore_state" 1
+| CT_resume(x1) ->
+   fID_OPT x1;
+   fNODE "resume" 1
+| CT_save(x1, x2) ->
+   fTHM_OPT x1;
+   fID_OPT x2;
+   fNODE "save" 2
+| CT_scomments(x1) ->
+   fSCOMMENT_CONTENT_LIST x1;
+   fNODE "scomments" 1
+| CT_search(x1, x2) ->
+   fID x1;
+   fIN_OR_OUT_MODULES x2;
+   fNODE "search" 2
+| CT_search_about(x1, x2) ->
+   fID_OR_STRING_NE_LIST x1;
+   fIN_OR_OUT_MODULES x2;
+   fNODE "search_about" 2
+| CT_search_pattern(x1, x2) ->
+   fFORMULA x1;
+   fIN_OR_OUT_MODULES x2;
+   fNODE "search_pattern" 2
+| CT_search_rewrite(x1, x2) ->
+   fFORMULA x1;
+   fIN_OR_OUT_MODULES x2;
+   fNODE "search_rewrite" 2
+| CT_section_end(x1) ->
+   fID x1;
+   fNODE "section_end" 1
+| CT_section_struct(x1, x2, x3) ->
+   fSECTION_BEGIN x1;
+   fSECTION_BODY x2;
+   fCOMMAND x3;
+   fNODE "section_struct" 3
+| CT_set_natural(x1) ->
+   fID x1;
+   fNODE "set_natural" 1
+| CT_set_natural_default -> fNODE "set_natural_default" 0
+| CT_set_option(x1) ->
+   fTABLE x1;
+   fNODE "set_option" 1
+| CT_set_option_value(x1, x2) ->
+   fTABLE x1;
+   fSINGLE_OPTION_VALUE x2;
+   fNODE "set_option_value" 2
+| CT_set_option_value2(x1, x2) ->
+   fTABLE x1;
+   fID_OR_STRING_NE_LIST x2;
+   fNODE "set_option_value2" 2
+| CT_sethyp(x1) ->
+   fINT x1;
+   fNODE "sethyp" 1
+| CT_setundo(x1) ->
+   fINT x1;
+   fNODE "setundo" 1
+| CT_show_existentials -> fNODE "show_existentials" 0
+| CT_show_goal(x1) ->
+   fINT_OPT x1;
+   fNODE "show_goal" 1
+| CT_show_implicit(x1) ->
+   fINT x1;
+   fNODE "show_implicit" 1
+| CT_show_intro -> fNODE "show_intro" 0
+| CT_show_intros -> fNODE "show_intros" 0
+| CT_show_node -> fNODE "show_node" 0
+| CT_show_proof -> fNODE "show_proof" 0
+| CT_show_proofs -> fNODE "show_proofs" 0
+| CT_show_script -> fNODE "show_script" 0
+| CT_show_tree -> fNODE "show_tree" 0
+| CT_solve(x1, x2, x3) ->
+   fINT x1;
+   fTACTIC_COM x2;
+   fDOTDOT_OPT x3;
+   fNODE "solve" 3
+| CT_suspend -> fNODE "suspend" 0
+| CT_syntax_macro(x1, x2, x3) ->
+   fID x1;
+   fFORMULA x2;
+   fINT_OPT x3;
+   fNODE "syntax_macro" 3
+| CT_tactic_definition(x1) ->
+   fTAC_DEF_NE_LIST x1;
+   fNODE "tactic_definition" 1
+| CT_test_natural_feature(x1, x2) ->
+   fNATURAL_FEATURE x1;
+   fID x2;
+   fNODE "test_natural_feature" 2
+| CT_theorem_struct(x1, x2) ->
+   fTHEOREM_GOAL x1;
+   fPROOF_SCRIPT x2;
+   fNODE "theorem_struct" 2
+| CT_time(x1) ->
+   fCOMMAND x1;
+   fNODE "time" 1
+| CT_transparent(x1) ->
+   fID_NE_LIST x1;
+   fNODE "transparent" 1
+| CT_undo(x1) ->
+   fINT_OPT x1;
+   fNODE "undo" 1
+| CT_unfocus -> fNODE "unfocus" 0
+| CT_unset_option(x1) ->
+   fTABLE x1;
+   fNODE "unset_option" 1
+| CT_unsethyp -> fNODE "unsethyp" 0
+| CT_unsetundo -> fNODE "unsetundo" 0
+| CT_user_vernac(x1, x2) ->
+   fID x1;
+   fVARG_LIST x2;
+   fNODE "user_vernac" 2
+| CT_variable(x1, x2) ->
+   fVAR x1;
+   fBINDER_NE_LIST x2;
+   fNODE "variable" 2
+| CT_write_module(x1, x2) ->
+   fID x1;
+   fSTRING_OPT x2;
+   fNODE "write_module" 2
+and fCOMMAND_LIST = function
+| CT_command_list(x,l) ->
+   fCOMMAND x;
+   (List.iter fCOMMAND l);
+   fNODE "command_list" (1 + (List.length l))
+and fCOMMENT = function
+| CT_comment x -> fATOM "comment";
+   (f_atom_string x);
+   print_string "\n"and fCOMMENT_S = function
+| CT_comment_s l ->
+   (List.iter fCOMMENT l);
+   fNODE "comment_s" (List.length l)
+and fCONSTR = function
+| CT_constr(x1, x2) ->
+   fID x1;
+   fFORMULA x2;
+   fNODE "constr" 2
+| CT_constr_coercion(x1, x2) ->
+   fID x1;
+   fFORMULA x2;
+   fNODE "constr_coercion" 2
+and fCONSTR_LIST = function
+| CT_constr_list l ->
+   (List.iter fCONSTR l);
+   fNODE "constr_list" (List.length l)
+and fCONTEXT_HYP_LIST = function
+| CT_context_hyp_list l ->
+   (List.iter fPREMISE_PATTERN l);
+   fNODE "context_hyp_list" (List.length l)
+and fCONTEXT_PATTERN = function
+| CT_coerce_FORMULA_to_CONTEXT_PATTERN x -> fFORMULA x
+| CT_context(x1, x2) ->
+   fID_OPT x1;
+   fFORMULA x2;
+   fNODE "context" 2
+and fCONTEXT_RULE = function
+| CT_context_rule(x1, x2, x3) ->
+   fCONTEXT_HYP_LIST x1;
+   fCONTEXT_PATTERN x2;
+   fTACTIC_COM x3;
+   fNODE "context_rule" 3
+| CT_def_context_rule(x1) ->
+   fTACTIC_COM x1;
+   fNODE "def_context_rule" 1
+and fCONVERSION_FLAG = function
+| CT_beta -> fNODE "beta" 0
+| CT_delta -> fNODE "delta" 0
+| CT_evar -> fNODE "evar" 0
+| CT_iota -> fNODE "iota" 0
+| CT_zeta -> fNODE "zeta" 0
+and fCONVERSION_FLAG_LIST = function
+| CT_conversion_flag_list l ->
+   (List.iter fCONVERSION_FLAG l);
+   fNODE "conversion_flag_list" (List.length l)
+and fCONV_SET = function
+| CT_unf l ->
+   (List.iter fID l);
+   fNODE "unf" (List.length l)
+| CT_unfbut l ->
+   (List.iter fID l);
+   fNODE "unfbut" (List.length l)
+and fCO_IND = function
+| CT_co_ind x -> fATOM "co_ind";
+   (f_atom_string x);
+   print_string "\n"and fDECL_NOTATION_OPT = function
+| CT_coerce_NONE_to_DECL_NOTATION_OPT x -> fNONE x
+| CT_decl_notation(x1, x2, x3) ->
+   fSTRING x1;
+   fFORMULA x2;
+   fID_OPT x3;
+   fNODE "decl_notation" 3
+and fDEF = function
+| CT_def(x1, x2) ->
+   fID_OPT x1;
+   fFORMULA x2;
+   fNODE "def" 2
+and fDEFN = function
+| CT_defn x -> fATOM "defn";
+   (f_atom_string x);
+   print_string "\n"and fDEFN_OR_THM = function
+| CT_coerce_DEFN_to_DEFN_OR_THM x -> fDEFN x
+| CT_coerce_THM_to_DEFN_OR_THM x -> fTHM x
+and fDEF_BODY = function
+| CT_coerce_CONTEXT_PATTERN_to_DEF_BODY x -> fCONTEXT_PATTERN x
+| CT_coerce_EVAL_CMD_to_DEF_BODY x -> fEVAL_CMD x
+| CT_type_of(x1) ->
+   fFORMULA x1;
+   fNODE "type_of" 1
+and fDEF_BODY_OPT = function
+| CT_coerce_DEF_BODY_to_DEF_BODY_OPT x -> fDEF_BODY x
+| CT_coerce_FORMULA_OPT_to_DEF_BODY_OPT x -> fFORMULA_OPT x
+and fDEP = function
+| CT_dep x -> fATOM "dep";
+   (f_atom_string x);
+   print_string "\n"and fDESTRUCTING = function
+| CT_coerce_NONE_to_DESTRUCTING x -> fNONE x
+| CT_destructing -> fNODE "destructing" 0
+and fDESTRUCT_LOCATION = function
+| CT_conclusion_location -> fNODE "conclusion_location" 0
+| CT_discardable_hypothesis -> fNODE "discardable_hypothesis" 0
+| CT_hypothesis_location -> fNODE "hypothesis_location" 0
+and fDOTDOT_OPT = function
+| CT_coerce_NONE_to_DOTDOT_OPT x -> fNONE x
+| CT_dotdot -> fNODE "dotdot" 0
+and fEQN = function
+| CT_eqn(x1, x2) ->
+   fMATCH_PATTERN_NE_LIST x1;
+   fFORMULA x2;
+   fNODE "eqn" 2
+and fEQN_LIST = function
+| CT_eqn_list l ->
+   (List.iter fEQN l);
+   fNODE "eqn_list" (List.length l)
+and fEVAL_CMD = function
+| CT_eval(x1, x2, x3) ->
+   fINT_OPT x1;
+   fRED_COM x2;
+   fFORMULA x3;
+   fNODE "eval" 3
+and fFIXTAC = function
+| CT_fixtac(x1, x2, x3) ->
+   fID x1;
+   fINT x2;
+   fFORMULA x3;
+   fNODE "fixtac" 3
+and fFIX_BINDER = function
+| CT_coerce_FIX_REC_to_FIX_BINDER x -> fFIX_REC x
+| CT_fix_binder(x1, x2, x3, x4) ->
+   fID x1;
+   fINT x2;
+   fFORMULA x3;
+   fFORMULA x4;
+   fNODE "fix_binder" 4
+and fFIX_BINDER_LIST = function
+| CT_fix_binder_list(x,l) ->
+   fFIX_BINDER x;
+   (List.iter fFIX_BINDER l);
+   fNODE "fix_binder_list" (1 + (List.length l))
+and fFIX_REC = function
+| CT_fix_rec(x1, x2, x3, x4, x5) ->
+   fID x1;
+   fBINDER_NE_LIST x2;
+   fID_OPT x3;
+   fFORMULA x4;
+   fFORMULA x5;
+   fNODE "fix_rec" 5
+and fFIX_REC_LIST = function
+| CT_fix_rec_list(x,l) ->
+   fFIX_REC x;
+   (List.iter fFIX_REC l);
+   fNODE "fix_rec_list" (1 + (List.length l))
+and fFIX_TAC_LIST = function
+| CT_fix_tac_list l ->
+   (List.iter fFIXTAC l);
+   fNODE "fix_tac_list" (List.length l)
+and fFORMULA = function
+| CT_coerce_BINARY_to_FORMULA x -> fBINARY x
+| CT_coerce_ID_to_FORMULA x -> fID x
+| CT_coerce_NUM_to_FORMULA x -> fNUM x
+| CT_coerce_SORT_TYPE_to_FORMULA x -> fSORT_TYPE x
+| CT_coerce_TYPED_FORMULA_to_FORMULA x -> fTYPED_FORMULA x
+| CT_appc(x1, x2) ->
+   fFORMULA x1;
+   fFORMULA_NE_LIST x2;
+   fNODE "appc" 2
+| CT_arrowc(x1, x2) ->
+   fFORMULA x1;
+   fFORMULA x2;
+   fNODE "arrowc" 2
+| CT_bang(x1) ->
+   fFORMULA x1;
+   fNODE "bang" 1
+| CT_cases(x1, x2, x3) ->
+   fMATCHED_FORMULA_NE_LIST x1;
+   fFORMULA_OPT x2;
+   fEQN_LIST x3;
+   fNODE "cases" 3
+| CT_cofixc(x1, x2) ->
+   fID x1;
+   fCOFIX_REC_LIST x2;
+   fNODE "cofixc" 2
+| CT_elimc(x1, x2, x3, x4) ->
+   fCASE x1;
+   fFORMULA_OPT x2;
+   fFORMULA x3;
+   fFORMULA_LIST x4;
+   fNODE "elimc" 4
+| CT_existvarc -> fNODE "existvarc" 0
+| CT_fixc(x1, x2) ->
+   fID x1;
+   fFIX_BINDER_LIST x2;
+   fNODE "fixc" 2
+| CT_if(x1, x2, x3, x4) ->
+   fFORMULA x1;
+   fRETURN_INFO x2;
+   fFORMULA x3;
+   fFORMULA x4;
+   fNODE "if" 4
+| CT_inductive_let(x1, x2, x3, x4) ->
+   fFORMULA_OPT x1;
+   fID_OPT_NE_LIST x2;
+   fFORMULA x3;
+   fFORMULA x4;
+   fNODE "inductive_let" 4
+| CT_labelled_arg(x1, x2) ->
+   fID x1;
+   fFORMULA x2;
+   fNODE "labelled_arg" 2
+| CT_lambdac(x1, x2) ->
+   fBINDER_NE_LIST x1;
+   fFORMULA x2;
+   fNODE "lambdac" 2
+| CT_let_tuple(x1, x2, x3, x4) ->
+   fID_OPT_NE_LIST x1;
+   fRETURN_INFO x2;
+   fFORMULA x3;
+   fFORMULA x4;
+   fNODE "let_tuple" 4
+| CT_letin(x1, x2) ->
+   fDEF x1;
+   fFORMULA x2;
+   fNODE "letin" 2
+| CT_notation(x1, x2) ->
+   fSTRING x1;
+   fFORMULA_LIST x2;
+   fNODE "notation" 2
+| CT_num_encapsulator(x1, x2) ->
+   fNUM_TYPE x1;
+   fFORMULA x2;
+   fNODE "num_encapsulator" 2
+| CT_prodc(x1, x2) ->
+   fBINDER_NE_LIST x1;
+   fFORMULA x2;
+   fNODE "prodc" 2
+| CT_proj(x1, x2) ->
+   fFORMULA x1;
+   fFORMULA_NE_LIST x2;
+   fNODE "proj" 2
+and fFORMULA_LIST = function
+| CT_formula_list l ->
+   (List.iter fFORMULA l);
+   fNODE "formula_list" (List.length l)
+and fFORMULA_NE_LIST = function
+| CT_formula_ne_list(x,l) ->
+   fFORMULA x;
+   (List.iter fFORMULA l);
+   fNODE "formula_ne_list" (1 + (List.length l))
+and fFORMULA_OPT = function
+| CT_coerce_FORMULA_to_FORMULA_OPT x -> fFORMULA x
+| CT_coerce_ID_OPT_to_FORMULA_OPT x -> fID_OPT x
+and fFORMULA_OR_INT = function
+| CT_coerce_FORMULA_to_FORMULA_OR_INT x -> fFORMULA x
+| CT_coerce_ID_OR_INT_to_FORMULA_OR_INT x -> fID_OR_INT x
+and fGRAMMAR = function
+| CT_grammar_none -> fNODE "grammar_none" 0
+and fHYP_LOCATION = function
+| CT_coerce_UNFOLD_to_HYP_LOCATION x -> fUNFOLD x
+| CT_intype(x1, x2) ->
+   fID x1;
+   fINT_LIST x2;
+   fNODE "intype" 2
+| CT_invalue(x1, x2) ->
+   fID x1;
+   fINT_LIST x2;
+   fNODE "invalue" 2
+and fHYP_LOCATION_LIST_OR_STAR = function
+| CT_coerce_STAR_to_HYP_LOCATION_LIST_OR_STAR x -> fSTAR x
+| CT_hyp_location_list l ->
+   (List.iter fHYP_LOCATION l);
+   fNODE "hyp_location_list" (List.length l)
+and fID = function
+| CT_ident x -> fATOM "ident";
+   (f_atom_string x);
+   print_string "\n"| CT_metac(x1) ->
+   fINT x1;
+   fNODE "metac" 1
+| CT_metaid x -> fATOM "metaid";
+   (f_atom_string x);
+   print_string "\n"and fIDENTITY_OPT = function
+| CT_coerce_NONE_to_IDENTITY_OPT x -> fNONE x
+| CT_identity -> fNODE "identity" 0
+and fID_LIST = function
+| CT_id_list l ->
+   (List.iter fID l);
+   fNODE "id_list" (List.length l)
+and fID_LIST_LIST = function
+| CT_id_list_list l ->
+   (List.iter fID_LIST l);
+   fNODE "id_list_list" (List.length l)
+and fID_LIST_OPT = function
+| CT_coerce_ID_LIST_to_ID_LIST_OPT x -> fID_LIST x
+| CT_coerce_NONE_to_ID_LIST_OPT x -> fNONE x
+and fID_NE_LIST = function
+| CT_id_ne_list(x,l) ->
+   fID x;
+   (List.iter fID l);
+   fNODE "id_ne_list" (1 + (List.length l))
+and fID_NE_LIST_OR_STAR = function
+| CT_coerce_ID_NE_LIST_to_ID_NE_LIST_OR_STAR x -> fID_NE_LIST x
+| CT_coerce_STAR_to_ID_NE_LIST_OR_STAR x -> fSTAR x
+and fID_NE_LIST_OR_STRING = function
+| CT_coerce_ID_NE_LIST_to_ID_NE_LIST_OR_STRING x -> fID_NE_LIST x
+| CT_coerce_STRING_to_ID_NE_LIST_OR_STRING x -> fSTRING x
+and fID_OPT = function
+| CT_coerce_ID_to_ID_OPT x -> fID x
+| CT_coerce_NONE_to_ID_OPT x -> fNONE x
+and fID_OPT_LIST = function
+| CT_id_opt_list l ->
+   (List.iter fID_OPT l);
+   fNODE "id_opt_list" (List.length l)
+and fID_OPT_NE_LIST = function
+| CT_id_opt_ne_list(x,l) ->
+   fID_OPT x;
+   (List.iter fID_OPT l);
+   fNODE "id_opt_ne_list" (1 + (List.length l))
+and fID_OPT_OR_ALL = function
+| CT_coerce_ID_OPT_to_ID_OPT_OR_ALL x -> fID_OPT x
+| CT_all -> fNODE "all" 0
+and fID_OR_INT = function
+| CT_coerce_ID_to_ID_OR_INT x -> fID x
+| CT_coerce_INT_to_ID_OR_INT x -> fINT x
+and fID_OR_INT_OPT = function
+| CT_coerce_ID_OPT_to_ID_OR_INT_OPT x -> fID_OPT x
+| CT_coerce_ID_OR_INT_to_ID_OR_INT_OPT x -> fID_OR_INT x
+| CT_coerce_INT_OPT_to_ID_OR_INT_OPT x -> fINT_OPT x
+and fID_OR_STAR = function
+| CT_coerce_ID_to_ID_OR_STAR x -> fID x
+| CT_coerce_STAR_to_ID_OR_STAR x -> fSTAR x
+and fID_OR_STRING = function
+| CT_coerce_ID_to_ID_OR_STRING x -> fID x
+| CT_coerce_STRING_to_ID_OR_STRING x -> fSTRING x
+and fID_OR_STRING_NE_LIST = function
+| CT_id_or_string_ne_list(x,l) ->
+   fID_OR_STRING x;
+   (List.iter fID_OR_STRING l);
+   fNODE "id_or_string_ne_list" (1 + (List.length l))
+and fIMPEXP = function
+| CT_coerce_NONE_to_IMPEXP x -> fNONE x
+| CT_export -> fNODE "export" 0
+| CT_import -> fNODE "import" 0
+and fIND_SPEC = function
+| CT_ind_spec(x1, x2, x3, x4, x5) ->
+   fID x1;
+   fBINDER_LIST x2;
+   fFORMULA x3;
+   fCONSTR_LIST x4;
+   fDECL_NOTATION_OPT x5;
+   fNODE "ind_spec" 5
+and fIND_SPEC_LIST = function
+| CT_ind_spec_list l ->
+   (List.iter fIND_SPEC l);
+   fNODE "ind_spec_list" (List.length l)
+and fINT = function
+| CT_int x -> fATOM "int";
+   (f_atom_int x);
+   print_string "\n"and fINTRO_PATT = function
+| CT_coerce_ID_to_INTRO_PATT x -> fID x
+| CT_disj_pattern(x,l) ->
+   fINTRO_PATT_LIST x;
+   (List.iter fINTRO_PATT_LIST l);
+   fNODE "disj_pattern" (1 + (List.length l))
+and fINTRO_PATT_LIST = function
+| CT_intro_patt_list l ->
+   (List.iter fINTRO_PATT l);
+   fNODE "intro_patt_list" (List.length l)
+and fINTRO_PATT_OPT = function
+| CT_coerce_ID_OPT_to_INTRO_PATT_OPT x -> fID_OPT x
+| CT_coerce_INTRO_PATT_to_INTRO_PATT_OPT x -> fINTRO_PATT x
+and fINT_LIST = function
+| CT_int_list l ->
+   (List.iter fINT l);
+   fNODE "int_list" (List.length l)
+and fINT_NE_LIST = function
+| CT_int_ne_list(x,l) ->
+   fINT x;
+   (List.iter fINT l);
+   fNODE "int_ne_list" (1 + (List.length l))
+and fINT_OPT = function
+| CT_coerce_INT_to_INT_OPT x -> fINT x
+| CT_coerce_NONE_to_INT_OPT x -> fNONE x
+and fINT_OR_LOCN = function
+| CT_coerce_INT_to_INT_OR_LOCN x -> fINT x
+| CT_coerce_LOCN_to_INT_OR_LOCN x -> fLOCN x
+and fINT_OR_NEXT = function
+| CT_coerce_INT_to_INT_OR_NEXT x -> fINT x
+| CT_next_level -> fNODE "next_level" 0
+and fINV_TYPE = function
+| CT_inv_clear -> fNODE "inv_clear" 0
+| CT_inv_regular -> fNODE "inv_regular" 0
+| CT_inv_simple -> fNODE "inv_simple" 0
+and fIN_OR_OUT_MODULES = function
+| CT_coerce_NONE_to_IN_OR_OUT_MODULES x -> fNONE x
+| CT_in_modules(x1) ->
+   fID_NE_LIST x1;
+   fNODE "in_modules" 1
+| CT_out_modules(x1) ->
+   fID_NE_LIST x1;
+   fNODE "out_modules" 1
+and fLET_CLAUSE = function
+| CT_let_clause(x1, x2, x3) ->
+   fID x1;
+   fTACTIC_OPT x2;
+   fLET_VALUE x3;
+   fNODE "let_clause" 3
+and fLET_CLAUSES = function
+| CT_let_clauses(x,l) ->
+   fLET_CLAUSE x;
+   (List.iter fLET_CLAUSE l);
+   fNODE "let_clauses" (1 + (List.length l))
+and fLET_VALUE = function
+| CT_coerce_DEF_BODY_to_LET_VALUE x -> fDEF_BODY x
+| CT_coerce_TACTIC_COM_to_LET_VALUE x -> fTACTIC_COM x
+and fLOCAL_OPT = function
+| CT_coerce_NONE_to_LOCAL_OPT x -> fNONE x
+| CT_local -> fNODE "local" 0
+and fLOCN = function
+| CT_locn x -> fATOM "locn";
+   (f_atom_string x);
+   print_string "\n"and fMATCHED_FORMULA = function
+| CT_coerce_FORMULA_to_MATCHED_FORMULA x -> fFORMULA x
+| CT_formula_as(x1, x2) ->
+   fFORMULA x1;
+   fID_OPT x2;
+   fNODE "formula_as" 2
+| CT_formula_as_in(x1, x2, x3) ->
+   fFORMULA x1;
+   fID_OPT x2;
+   fFORMULA x3;
+   fNODE "formula_as_in" 3
+| CT_formula_in(x1, x2) ->
+   fFORMULA x1;
+   fFORMULA x2;
+   fNODE "formula_in" 2
+and fMATCHED_FORMULA_NE_LIST = function
+| CT_matched_formula_ne_list(x,l) ->
+   fMATCHED_FORMULA x;
+   (List.iter fMATCHED_FORMULA l);
+   fNODE "matched_formula_ne_list" (1 + (List.length l))
+and fMATCH_PATTERN = function
+| CT_coerce_ID_OPT_to_MATCH_PATTERN x -> fID_OPT x
+| CT_coerce_NUM_to_MATCH_PATTERN x -> fNUM x
+| CT_pattern_app(x1, x2) ->
+   fMATCH_PATTERN x1;
+   fMATCH_PATTERN_NE_LIST x2;
+   fNODE "pattern_app" 2
+| CT_pattern_as(x1, x2) ->
+   fMATCH_PATTERN x1;
+   fID_OPT x2;
+   fNODE "pattern_as" 2
+| CT_pattern_delimitors(x1, x2) ->
+   fNUM_TYPE x1;
+   fMATCH_PATTERN x2;
+   fNODE "pattern_delimitors" 2
+| CT_pattern_notation(x1, x2) ->
+   fSTRING x1;
+   fMATCH_PATTERN_LIST x2;
+   fNODE "pattern_notation" 2
+and fMATCH_PATTERN_LIST = function
+| CT_match_pattern_list l ->
+   (List.iter fMATCH_PATTERN l);
+   fNODE "match_pattern_list" (List.length l)
+and fMATCH_PATTERN_NE_LIST = function
+| CT_match_pattern_ne_list(x,l) ->
+   fMATCH_PATTERN x;
+   (List.iter fMATCH_PATTERN l);
+   fNODE "match_pattern_ne_list" (1 + (List.length l))
+and fMATCH_TAC_RULE = function
+| CT_match_tac_rule(x1, x2) ->
+   fCONTEXT_PATTERN x1;
+   fLET_VALUE x2;
+   fNODE "match_tac_rule" 2
+and fMATCH_TAC_RULES = function
+| CT_match_tac_rules(x,l) ->
+   fMATCH_TAC_RULE x;
+   (List.iter fMATCH_TAC_RULE l);
+   fNODE "match_tac_rules" (1 + (List.length l))
+and fMODIFIER = function
+| CT_entry_type(x1, x2) ->
+   fID x1;
+   fID x2;
+   fNODE "entry_type" 2
+| CT_format(x1) ->
+   fSTRING x1;
+   fNODE "format" 1
+| CT_lefta -> fNODE "lefta" 0
+| CT_nona -> fNODE "nona" 0
+| CT_only_parsing -> fNODE "only_parsing" 0
+| CT_righta -> fNODE "righta" 0
+| CT_set_item_level(x1, x2) ->
+   fID_NE_LIST x1;
+   fINT_OR_NEXT x2;
+   fNODE "set_item_level" 2
+| CT_set_level(x1) ->
+   fINT x1;
+   fNODE "set_level" 1
+and fMODIFIER_LIST = function
+| CT_modifier_list l ->
+   (List.iter fMODIFIER l);
+   fNODE "modifier_list" (List.length l)
+and fMODULE_BINDER = function
+| CT_module_binder(x1, x2) ->
+   fID_NE_LIST x1;
+   fMODULE_TYPE x2;
+   fNODE "module_binder" 2
+and fMODULE_BINDER_LIST = function
+| CT_module_binder_list l ->
+   (List.iter fMODULE_BINDER l);
+   fNODE "module_binder_list" (List.length l)
+and fMODULE_EXPR = function
+| CT_coerce_ID_OPT_to_MODULE_EXPR x -> fID_OPT x
+| CT_module_app(x1, x2) ->
+   fMODULE_EXPR x1;
+   fMODULE_EXPR x2;
+   fNODE "module_app" 2
+and fMODULE_TYPE = function
+| CT_coerce_ID_to_MODULE_TYPE x -> fID x
+| CT_module_type_with_def(x1, x2, x3) ->
+   fMODULE_TYPE x1;
+   fID x2;
+   fFORMULA x3;
+   fNODE "module_type_with_def" 3
+| CT_module_type_with_mod(x1, x2, x3) ->
+   fMODULE_TYPE x1;
+   fID x2;
+   fID x3;
+   fNODE "module_type_with_mod" 3
+and fMODULE_TYPE_CHECK = function
+| CT_coerce_MODULE_TYPE_OPT_to_MODULE_TYPE_CHECK x -> fMODULE_TYPE_OPT x
+| CT_only_check(x1) ->
+   fMODULE_TYPE x1;
+   fNODE "only_check" 1
+and fMODULE_TYPE_OPT = function
+| CT_coerce_ID_OPT_to_MODULE_TYPE_OPT x -> fID_OPT x
+| CT_coerce_MODULE_TYPE_to_MODULE_TYPE_OPT x -> fMODULE_TYPE x
+and fNATURAL_FEATURE = function
+| CT_contractible -> fNODE "contractible" 0
+| CT_implicit -> fNODE "implicit" 0
+| CT_nat_transparent -> fNODE "nat_transparent" 0
+and fNONE = function
+| CT_none -> fNODE "none" 0
+and fNUM = function
+| CT_int_encapsulator x -> fATOM "int_encapsulator";
+   (f_atom_string x);
+   print_string "\n"and fNUM_TYPE = function
+| CT_num_type x -> fATOM "num_type";
+   (f_atom_string x);
+   print_string "\n"and fOMEGA_FEATURE = function
+| CT_coerce_STRING_to_OMEGA_FEATURE x -> fSTRING x
+| CT_flag_action -> fNODE "flag_action" 0
+| CT_flag_system -> fNODE "flag_system" 0
+| CT_flag_time -> fNODE "flag_time" 0
+and fOMEGA_MODE = function
+| CT_set -> fNODE "set" 0
+| CT_switch -> fNODE "switch" 0
+| CT_unset -> fNODE "unset" 0
+and fORIENTATION = function
+| CT_lr -> fNODE "lr" 0
+| CT_rl -> fNODE "rl" 0
+and fPATTERN = function
+| CT_pattern_occ(x1, x2) ->
+   fINT_LIST x1;
+   fFORMULA x2;
+   fNODE "pattern_occ" 2
+and fPATTERN_NE_LIST = function
+| CT_pattern_ne_list(x,l) ->
+   fPATTERN x;
+   (List.iter fPATTERN l);
+   fNODE "pattern_ne_list" (1 + (List.length l))
+and fPATTERN_OPT = function
+| CT_coerce_NONE_to_PATTERN_OPT x -> fNONE x
+| CT_coerce_PATTERN_to_PATTERN_OPT x -> fPATTERN x
+and fPREMISE = function
+| CT_coerce_TYPED_FORMULA_to_PREMISE x -> fTYPED_FORMULA x
+| CT_eval_result(x1, x2, x3) ->
+   fFORMULA x1;
+   fFORMULA x2;
+   fFORMULA x3;
+   fNODE "eval_result" 3
+| CT_premise(x1, x2) ->
+   fID x1;
+   fFORMULA x2;
+   fNODE "premise" 2
+and fPREMISES_LIST = function
+| CT_premises_list l ->
+   (List.iter fPREMISE l);
+   fNODE "premises_list" (List.length l)
+and fPREMISE_PATTERN = function
+| CT_premise_pattern(x1, x2) ->
+   fID_OPT x1;
+   fCONTEXT_PATTERN x2;
+   fNODE "premise_pattern" 2
+and fPROOF_SCRIPT = function
+| CT_proof_script l ->
+   (List.iter fCOMMAND l);
+   fNODE "proof_script" (List.length l)
+and fRECCONSTR = function
+| CT_defrecconstr(x1, x2, x3) ->
+   fID_OPT x1;
+   fFORMULA x2;
+   fFORMULA_OPT x3;
+   fNODE "defrecconstr" 3
+| CT_defrecconstr_coercion(x1, x2, x3) ->
+   fID_OPT x1;
+   fFORMULA x2;
+   fFORMULA_OPT x3;
+   fNODE "defrecconstr_coercion" 3
+| CT_recconstr(x1, x2) ->
+   fID_OPT x1;
+   fFORMULA x2;
+   fNODE "recconstr" 2
+| CT_recconstr_coercion(x1, x2) ->
+   fID_OPT x1;
+   fFORMULA x2;
+   fNODE "recconstr_coercion" 2
+and fRECCONSTR_LIST = function
+| CT_recconstr_list l ->
+   (List.iter fRECCONSTR l);
+   fNODE "recconstr_list" (List.length l)
+and fREC_TACTIC_FUN = function
+| CT_rec_tactic_fun(x1, x2, x3) ->
+   fID x1;
+   fID_OPT_NE_LIST x2;
+   fTACTIC_COM x3;
+   fNODE "rec_tactic_fun" 3
+and fREC_TACTIC_FUN_LIST = function
+| CT_rec_tactic_fun_list(x,l) ->
+   fREC_TACTIC_FUN x;
+   (List.iter fREC_TACTIC_FUN l);
+   fNODE "rec_tactic_fun_list" (1 + (List.length l))
+and fRED_COM = function
+| CT_cbv(x1, x2) ->
+   fCONVERSION_FLAG_LIST x1;
+   fCONV_SET x2;
+   fNODE "cbv" 2
+| CT_fold(x1) ->
+   fFORMULA_LIST x1;
+   fNODE "fold" 1
+| CT_hnf -> fNODE "hnf" 0
+| CT_lazy(x1, x2) ->
+   fCONVERSION_FLAG_LIST x1;
+   fCONV_SET x2;
+   fNODE "lazy" 2
+| CT_pattern(x1) ->
+   fPATTERN_NE_LIST x1;
+   fNODE "pattern" 1
+| CT_red -> fNODE "red" 0
+| CT_simpl(x1) ->
+   fPATTERN_OPT x1;
+   fNODE "simpl" 1
+| CT_unfold(x1) ->
+   fUNFOLD_NE_LIST x1;
+   fNODE "unfold" 1
+and fRETURN_INFO = function
+| CT_coerce_NONE_to_RETURN_INFO x -> fNONE x
+| CT_as_and_return(x1, x2) ->
+   fID_OPT x1;
+   fFORMULA x2;
+   fNODE "as_and_return" 2
+| CT_return(x1) ->
+   fFORMULA x1;
+   fNODE "return" 1
+and fRULE = function
+| CT_rule(x1, x2) ->
+   fPREMISES_LIST x1;
+   fFORMULA x2;
+   fNODE "rule" 2
+and fRULE_LIST = function
+| CT_rule_list l ->
+   (List.iter fRULE l);
+   fNODE "rule_list" (List.length l)
+and fSCHEME_SPEC = function
+| CT_scheme_spec(x1, x2, x3, x4) ->
+   fID x1;
+   fDEP x2;
+   fFORMULA x3;
+   fSORT_TYPE x4;
+   fNODE "scheme_spec" 4
+and fSCHEME_SPEC_LIST = function
+| CT_scheme_spec_list(x,l) ->
+   fSCHEME_SPEC x;
+   (List.iter fSCHEME_SPEC l);
+   fNODE "scheme_spec_list" (1 + (List.length l))
+and fSCOMMENT_CONTENT = function
+| CT_coerce_FORMULA_to_SCOMMENT_CONTENT x -> fFORMULA x
+| CT_coerce_ID_OR_STRING_to_SCOMMENT_CONTENT x -> fID_OR_STRING x
+and fSCOMMENT_CONTENT_LIST = function
+| CT_scomment_content_list l ->
+   (List.iter fSCOMMENT_CONTENT l);
+   fNODE "scomment_content_list" (List.length l)
+and fSECTION_BEGIN = function
+| CT_section(x1) ->
+   fID x1;
+   fNODE "section" 1
+and fSECTION_BODY = function
+| CT_section_body l ->
+   (List.iter fCOMMAND l);
+   fNODE "section_body" (List.length l)
+and fSIGNED_INT = function
+| CT_coerce_INT_to_SIGNED_INT x -> fINT x
+| CT_minus(x1) ->
+   fINT x1;
+   fNODE "minus" 1
+and fSIGNED_INT_LIST = function
+| CT_signed_int_list l ->
+   (List.iter fSIGNED_INT l);
+   fNODE "signed_int_list" (List.length l)
+and fSINGLE_OPTION_VALUE = function
+| CT_coerce_INT_to_SINGLE_OPTION_VALUE x -> fINT x
+| CT_coerce_STRING_to_SINGLE_OPTION_VALUE x -> fSTRING x
+and fSORT_TYPE = function
+| CT_sortc x -> fATOM "sortc";
+   (f_atom_string x);
+   print_string "\n"and fSPEC_LIST = function
+| CT_coerce_BINDING_LIST_to_SPEC_LIST x -> fBINDING_LIST x
+| CT_coerce_FORMULA_LIST_to_SPEC_LIST x -> fFORMULA_LIST x
+and fSPEC_OPT = function
+| CT_coerce_NONE_to_SPEC_OPT x -> fNONE x
+| CT_spec -> fNODE "spec" 0
+and fSTAR = function
+| CT_star -> fNODE "star" 0
+and fSTAR_OPT = function
+| CT_coerce_NONE_to_STAR_OPT x -> fNONE x
+| CT_coerce_STAR_to_STAR_OPT x -> fSTAR x
+and fSTRING = function
+| CT_string x -> fATOM "string";
+   (f_atom_string x);
+   print_string "\n"and fSTRING_NE_LIST = function
+| CT_string_ne_list(x,l) ->
+   fSTRING x;
+   (List.iter fSTRING l);
+   fNODE "string_ne_list" (1 + (List.length l))
+and fSTRING_OPT = function
+| CT_coerce_NONE_to_STRING_OPT x -> fNONE x
+| CT_coerce_STRING_to_STRING_OPT x -> fSTRING x
+and fTABLE = function
+| CT_coerce_ID_to_TABLE x -> fID x
+| CT_table(x1, x2) ->
+   fID x1;
+   fID x2;
+   fNODE "table" 2
+and fTACTIC_ARG = function
+| CT_coerce_EVAL_CMD_to_TACTIC_ARG x -> fEVAL_CMD x
+| CT_coerce_FORMULA_OR_INT_to_TACTIC_ARG x -> fFORMULA_OR_INT x
+| CT_coerce_TACTIC_COM_to_TACTIC_ARG x -> fTACTIC_COM x
+| CT_coerce_TERM_CHANGE_to_TACTIC_ARG x -> fTERM_CHANGE x
+| CT_void -> fNODE "void" 0
+and fTACTIC_ARG_LIST = function
+| CT_tactic_arg_list(x,l) ->
+   fTACTIC_ARG x;
+   (List.iter fTACTIC_ARG l);
+   fNODE "tactic_arg_list" (1 + (List.length l))
+and fTACTIC_COM = function
+| CT_abstract(x1, x2) ->
+   fID_OPT x1;
+   fTACTIC_COM x2;
+   fNODE "abstract" 2
+| CT_absurd(x1) ->
+   fFORMULA x1;
+   fNODE "absurd" 1
+| CT_any_constructor(x1) ->
+   fTACTIC_OPT x1;
+   fNODE "any_constructor" 1
+| CT_apply(x1, x2) ->
+   fFORMULA x1;
+   fSPEC_LIST x2;
+   fNODE "apply" 2
+| CT_assert(x1, x2) ->
+   fID_OPT x1;
+   fFORMULA x2;
+   fNODE "assert" 2
+| CT_assumption -> fNODE "assumption" 0
+| CT_auto(x1) ->
+   fINT_OPT x1;
+   fNODE "auto" 1
+| CT_auto_with(x1, x2) ->
+   fINT_OPT x1;
+   fID_NE_LIST_OR_STAR x2;
+   fNODE "auto_with" 2
+| CT_autorewrite(x1, x2) ->
+   fID_NE_LIST x1;
+   fTACTIC_OPT x2;
+   fNODE "autorewrite" 2
+| CT_autotdb(x1) ->
+   fINT_OPT x1;
+   fNODE "autotdb" 1
+| CT_case_type(x1) ->
+   fFORMULA x1;
+   fNODE "case_type" 1
+| CT_casetac(x1, x2) ->
+   fFORMULA x1;
+   fSPEC_LIST x2;
+   fNODE "casetac" 2
+| CT_cdhyp(x1) ->
+   fID x1;
+   fNODE "cdhyp" 1
+| CT_change(x1, x2) ->
+   fFORMULA x1;
+   fCLAUSE x2;
+   fNODE "change" 2
+| CT_change_local(x1, x2, x3) ->
+   fPATTERN x1;
+   fFORMULA x2;
+   fCLAUSE x3;
+   fNODE "change_local" 3
+| CT_clear(x1) ->
+   fID_NE_LIST x1;
+   fNODE "clear" 1
+| CT_clear_body(x1) ->
+   fID_NE_LIST x1;
+   fNODE "clear_body" 1
+| CT_cofixtactic(x1, x2) ->
+   fID_OPT x1;
+   fCOFIX_TAC_LIST x2;
+   fNODE "cofixtactic" 2
+| CT_condrewrite_lr(x1, x2, x3, x4) ->
+   fTACTIC_COM x1;
+   fFORMULA x2;
+   fSPEC_LIST x3;
+   fID_OPT x4;
+   fNODE "condrewrite_lr" 4
+| CT_condrewrite_rl(x1, x2, x3, x4) ->
+   fTACTIC_COM x1;
+   fFORMULA x2;
+   fSPEC_LIST x3;
+   fID_OPT x4;
+   fNODE "condrewrite_rl" 4
+| CT_constructor(x1, x2) ->
+   fINT x1;
+   fSPEC_LIST x2;
+   fNODE "constructor" 2
+| CT_contradiction -> fNODE "contradiction" 0
+| CT_contradiction_thm(x1, x2) ->
+   fFORMULA x1;
+   fSPEC_LIST x2;
+   fNODE "contradiction_thm" 2
+| CT_cut(x1) ->
+   fFORMULA x1;
+   fNODE "cut" 1
+| CT_cutrewrite_lr(x1, x2) ->
+   fFORMULA x1;
+   fID_OPT x2;
+   fNODE "cutrewrite_lr" 2
+| CT_cutrewrite_rl(x1, x2) ->
+   fFORMULA x1;
+   fID_OPT x2;
+   fNODE "cutrewrite_rl" 2
+| CT_dauto(x1, x2) ->
+   fINT_OPT x1;
+   fINT_OPT x2;
+   fNODE "dauto" 2
+| CT_dconcl -> fNODE "dconcl" 0
+| CT_decompose_list(x1, x2) ->
+   fID_NE_LIST x1;
+   fFORMULA x2;
+   fNODE "decompose_list" 2
+| CT_decompose_record(x1) ->
+   fFORMULA x1;
+   fNODE "decompose_record" 1
+| CT_decompose_sum(x1) ->
+   fFORMULA x1;
+   fNODE "decompose_sum" 1
+| CT_depinversion(x1, x2, x3, x4) ->
+   fINV_TYPE x1;
+   fID_OR_INT x2;
+   fINTRO_PATT_OPT x3;
+   fFORMULA_OPT x4;
+   fNODE "depinversion" 4
+| CT_deprewrite_lr(x1) ->
+   fID x1;
+   fNODE "deprewrite_lr" 1
+| CT_deprewrite_rl(x1) ->
+   fID x1;
+   fNODE "deprewrite_rl" 1
+| CT_destruct(x1) ->
+   fID_OR_INT x1;
+   fNODE "destruct" 1
+| CT_dhyp(x1) ->
+   fID x1;
+   fNODE "dhyp" 1
+| CT_discriminate_eq(x1) ->
+   fID_OR_INT_OPT x1;
+   fNODE "discriminate_eq" 1
+| CT_do(x1, x2) ->
+   fID_OR_INT x1;
+   fTACTIC_COM x2;
+   fNODE "do" 2
+| CT_eapply(x1, x2) ->
+   fFORMULA x1;
+   fSPEC_LIST x2;
+   fNODE "eapply" 2
+| CT_eauto(x1, x2) ->
+   fID_OR_INT_OPT x1;
+   fID_OR_INT_OPT x2;
+   fNODE "eauto" 2
+| CT_eauto_with(x1, x2, x3) ->
+   fID_OR_INT_OPT x1;
+   fID_OR_INT_OPT x2;
+   fID_NE_LIST_OR_STAR x3;
+   fNODE "eauto_with" 3
+| CT_elim(x1, x2, x3) ->
+   fFORMULA x1;
+   fSPEC_LIST x2;
+   fUSING x3;
+   fNODE "elim" 3
+| CT_elim_type(x1) ->
+   fFORMULA x1;
+   fNODE "elim_type" 1
+| CT_exact(x1) ->
+   fFORMULA x1;
+   fNODE "exact" 1
+| CT_exists(x1) ->
+   fSPEC_LIST x1;
+   fNODE "exists" 1
+| CT_fail(x1, x2) ->
+   fID_OR_INT x1;
+   fSTRING_OPT x2;
+   fNODE "fail" 2
+| CT_first(x,l) ->
+   fTACTIC_COM x;
+   (List.iter fTACTIC_COM l);
+   fNODE "first" (1 + (List.length l))
+| CT_firstorder(x1) ->
+   fTACTIC_OPT x1;
+   fNODE "firstorder" 1
+| CT_firstorder_using(x1, x2) ->
+   fTACTIC_OPT x1;
+   fID_NE_LIST x2;
+   fNODE "firstorder_using" 2
+| CT_firstorder_with(x1, x2) ->
+   fTACTIC_OPT x1;
+   fID_NE_LIST x2;
+   fNODE "firstorder_with" 2
+| CT_fixtactic(x1, x2, x3) ->
+   fID_OPT x1;
+   fINT x2;
+   fFIX_TAC_LIST x3;
+   fNODE "fixtactic" 3
+| CT_formula_marker(x1) ->
+   fFORMULA x1;
+   fNODE "formula_marker" 1
+| CT_fresh(x1) ->
+   fSTRING_OPT x1;
+   fNODE "fresh" 1
+| CT_generalize(x1) ->
+   fFORMULA_NE_LIST x1;
+   fNODE "generalize" 1
+| CT_generalize_dependent(x1) ->
+   fFORMULA x1;
+   fNODE "generalize_dependent" 1
+| CT_idtac(x1) ->
+   fSTRING_OPT x1;
+   fNODE "idtac" 1
+| CT_induction(x1) ->
+   fID_OR_INT x1;
+   fNODE "induction" 1
+| CT_info(x1) ->
+   fTACTIC_COM x1;
+   fNODE "info" 1
+| CT_injection_eq(x1) ->
+   fID_OR_INT_OPT x1;
+   fNODE "injection_eq" 1
+| CT_instantiate(x1, x2, x3) ->
+   fINT x1;
+   fFORMULA x2;
+   fCLAUSE x3;
+   fNODE "instantiate" 3
+| CT_intro(x1) ->
+   fID_OPT x1;
+   fNODE "intro" 1
+| CT_intro_after(x1, x2) ->
+   fID_OPT x1;
+   fID x2;
+   fNODE "intro_after" 2
+| CT_intros(x1) ->
+   fINTRO_PATT_LIST x1;
+   fNODE "intros" 1
+| CT_intros_until(x1) ->
+   fID_OR_INT x1;
+   fNODE "intros_until" 1
+| CT_inversion(x1, x2, x3, x4) ->
+   fINV_TYPE x1;
+   fID_OR_INT x2;
+   fINTRO_PATT_OPT x3;
+   fID_LIST x4;
+   fNODE "inversion" 4
+| CT_left(x1) ->
+   fSPEC_LIST x1;
+   fNODE "left" 1
+| CT_let_ltac(x1, x2) ->
+   fLET_CLAUSES x1;
+   fLET_VALUE x2;
+   fNODE "let_ltac" 2
+| CT_lettac(x1, x2, x3) ->
+   fID_OPT x1;
+   fFORMULA x2;
+   fCLAUSE x3;
+   fNODE "lettac" 3
+| CT_match_context(x,l) ->
+   fCONTEXT_RULE x;
+   (List.iter fCONTEXT_RULE l);
+   fNODE "match_context" (1 + (List.length l))
+| CT_match_context_reverse(x,l) ->
+   fCONTEXT_RULE x;
+   (List.iter fCONTEXT_RULE l);
+   fNODE "match_context_reverse" (1 + (List.length l))
+| CT_match_tac(x1, x2) ->
+   fTACTIC_COM x1;
+   fMATCH_TAC_RULES x2;
+   fNODE "match_tac" 2
+| CT_move_after(x1, x2) ->
+   fID x1;
+   fID x2;
+   fNODE "move_after" 2
+| CT_new_destruct(x1, x2, x3) ->
+   fFORMULA_OR_INT x1;
+   fUSING x2;
+   fINTRO_PATT_OPT x3;
+   fNODE "new_destruct" 3
+| CT_new_induction(x1, x2, x3) ->
+   fFORMULA_OR_INT x1;
+   fUSING x2;
+   fINTRO_PATT_OPT x3;
+   fNODE "new_induction" 3
+| CT_omega -> fNODE "omega" 0
+| CT_orelse(x1, x2) ->
+   fTACTIC_COM x1;
+   fTACTIC_COM x2;
+   fNODE "orelse" 2
+| CT_parallel(x,l) ->
+   fTACTIC_COM x;
+   (List.iter fTACTIC_COM l);
+   fNODE "parallel" (1 + (List.length l))
+| CT_pose(x1, x2) ->
+   fID_OPT x1;
+   fFORMULA x2;
+   fNODE "pose" 2
+| CT_progress(x1) ->
+   fTACTIC_COM x1;
+   fNODE "progress" 1
+| CT_prolog(x1, x2) ->
+   fFORMULA_LIST x1;
+   fINT x2;
+   fNODE "prolog" 2
+| CT_rec_tactic_in(x1, x2) ->
+   fREC_TACTIC_FUN_LIST x1;
+   fTACTIC_COM x2;
+   fNODE "rec_tactic_in" 2
+| CT_reduce(x1, x2) ->
+   fRED_COM x1;
+   fCLAUSE x2;
+   fNODE "reduce" 2
+| CT_refine(x1) ->
+   fFORMULA x1;
+   fNODE "refine" 1
+| CT_reflexivity -> fNODE "reflexivity" 0
+| CT_rename(x1, x2) ->
+   fID x1;
+   fID x2;
+   fNODE "rename" 2
+| CT_repeat(x1) ->
+   fTACTIC_COM x1;
+   fNODE "repeat" 1
+| CT_replace_with(x1, x2) ->
+   fFORMULA x1;
+   fFORMULA x2;
+   fNODE "replace_with" 2
+| CT_rewrite_lr(x1, x2, x3) ->
+   fFORMULA x1;
+   fSPEC_LIST x2;
+   fID_OPT x3;
+   fNODE "rewrite_lr" 3
+| CT_rewrite_rl(x1, x2, x3) ->
+   fFORMULA x1;
+   fSPEC_LIST x2;
+   fID_OPT x3;
+   fNODE "rewrite_rl" 3
+| CT_right(x1) ->
+   fSPEC_LIST x1;
+   fNODE "right" 1
+| CT_ring(x1) ->
+   fFORMULA_LIST x1;
+   fNODE "ring" 1
+| CT_simple_user_tac(x1, x2) ->
+   fID x1;
+   fTACTIC_ARG_LIST x2;
+   fNODE "simple_user_tac" 2
+| CT_simplify_eq(x1) ->
+   fID_OR_INT_OPT x1;
+   fNODE "simplify_eq" 1
+| CT_specialize(x1, x2, x3) ->
+   fINT_OPT x1;
+   fFORMULA x2;
+   fSPEC_LIST x3;
+   fNODE "specialize" 3
+| CT_split(x1) ->
+   fSPEC_LIST x1;
+   fNODE "split" 1
+| CT_subst(x1) ->
+   fID_LIST x1;
+   fNODE "subst" 1
+| CT_superauto(x1, x2, x3, x4) ->
+   fINT_OPT x1;
+   fID_LIST x2;
+   fDESTRUCTING x3;
+   fUSINGTDB x4;
+   fNODE "superauto" 4
+| CT_symmetry(x1) ->
+   fCLAUSE x1;
+   fNODE "symmetry" 1
+| CT_tac_double(x1, x2) ->
+   fID_OR_INT x1;
+   fID_OR_INT x2;
+   fNODE "tac_double" 2
+| CT_tacsolve(x,l) ->
+   fTACTIC_COM x;
+   (List.iter fTACTIC_COM l);
+   fNODE "tacsolve" (1 + (List.length l))
+| CT_tactic_fun(x1, x2) ->
+   fID_OPT_NE_LIST x1;
+   fTACTIC_COM x2;
+   fNODE "tactic_fun" 2
+| CT_then(x,l) ->
+   fTACTIC_COM x;
+   (List.iter fTACTIC_COM l);
+   fNODE "then" (1 + (List.length l))
+| CT_transitivity(x1) ->
+   fFORMULA x1;
+   fNODE "transitivity" 1
+| CT_trivial -> fNODE "trivial" 0
+| CT_trivial_with(x1) ->
+   fID_NE_LIST_OR_STAR x1;
+   fNODE "trivial_with" 1
+| CT_truecut(x1, x2) ->
+   fID_OPT x1;
+   fFORMULA x2;
+   fNODE "truecut" 2
+| CT_try(x1) ->
+   fTACTIC_COM x1;
+   fNODE "try" 1
+| CT_use(x1) ->
+   fFORMULA x1;
+   fNODE "use" 1
+| CT_use_inversion(x1, x2, x3) ->
+   fID_OR_INT x1;
+   fFORMULA x2;
+   fID_LIST x3;
+   fNODE "use_inversion" 3
+| CT_user_tac(x1, x2) ->
+   fID x1;
+   fTARG_LIST x2;
+   fNODE "user_tac" 2
+and fTACTIC_OPT = function
+| CT_coerce_NONE_to_TACTIC_OPT x -> fNONE x
+| CT_coerce_TACTIC_COM_to_TACTIC_OPT x -> fTACTIC_COM x
+and fTAC_DEF = function
+| CT_tac_def(x1, x2) ->
+   fID x1;
+   fTACTIC_COM x2;
+   fNODE "tac_def" 2
+and fTAC_DEF_NE_LIST = function
+| CT_tac_def_ne_list(x,l) ->
+   fTAC_DEF x;
+   (List.iter fTAC_DEF l);
+   fNODE "tac_def_ne_list" (1 + (List.length l))
+and fTARG = function
+| CT_coerce_BINDING_to_TARG x -> fBINDING x
+| CT_coerce_COFIXTAC_to_TARG x -> fCOFIXTAC x
+| CT_coerce_FIXTAC_to_TARG x -> fFIXTAC x
+| CT_coerce_FORMULA_OR_INT_to_TARG x -> fFORMULA_OR_INT x
+| CT_coerce_PATTERN_to_TARG x -> fPATTERN x
+| CT_coerce_SCOMMENT_CONTENT_to_TARG x -> fSCOMMENT_CONTENT x
+| CT_coerce_SIGNED_INT_LIST_to_TARG x -> fSIGNED_INT_LIST x
+| CT_coerce_SINGLE_OPTION_VALUE_to_TARG x -> fSINGLE_OPTION_VALUE x
+| CT_coerce_SPEC_LIST_to_TARG x -> fSPEC_LIST x
+| CT_coerce_TACTIC_COM_to_TARG x -> fTACTIC_COM x
+| CT_coerce_TARG_LIST_to_TARG x -> fTARG_LIST x
+| CT_coerce_UNFOLD_to_TARG x -> fUNFOLD x
+| CT_coerce_UNFOLD_NE_LIST_to_TARG x -> fUNFOLD_NE_LIST x
+and fTARG_LIST = function
+| CT_targ_list l ->
+   (List.iter fTARG l);
+   fNODE "targ_list" (List.length l)
+and fTERM_CHANGE = function
+| CT_check_term(x1) ->
+   fFORMULA x1;
+   fNODE "check_term" 1
+| CT_inst_term(x1, x2) ->
+   fID x1;
+   fFORMULA x2;
+   fNODE "inst_term" 2
+and fTEXT = function
+| CT_coerce_ID_to_TEXT x -> fID x
+| CT_text_formula(x1) ->
+   fFORMULA x1;
+   fNODE "text_formula" 1
+| CT_text_h l ->
+   (List.iter fTEXT l);
+   fNODE "text_h" (List.length l)
+| CT_text_hv l ->
+   (List.iter fTEXT l);
+   fNODE "text_hv" (List.length l)
+| CT_text_op l ->
+   (List.iter fTEXT l);
+   fNODE "text_op" (List.length l)
+| CT_text_path(x1) ->
+   fSIGNED_INT_LIST x1;
+   fNODE "text_path" 1
+| CT_text_v l ->
+   (List.iter fTEXT l);
+   fNODE "text_v" (List.length l)
+and fTHEOREM_GOAL = function
+| CT_goal(x1) ->
+   fFORMULA x1;
+   fNODE "goal" 1
+| CT_theorem_goal(x1, x2, x3, x4) ->
+   fDEFN_OR_THM x1;
+   fID x2;
+   fBINDER_LIST x3;
+   fFORMULA x4;
+   fNODE "theorem_goal" 4
+and fTHM = function
+| CT_thm x -> fATOM "thm";
+   (f_atom_string x);
+   print_string "\n"and fTHM_OPT = function
+| CT_coerce_NONE_to_THM_OPT x -> fNONE x
+| CT_coerce_THM_to_THM_OPT x -> fTHM x
+and fTYPED_FORMULA = function
+| CT_typed_formula(x1, x2) ->
+   fFORMULA x1;
+   fFORMULA x2;
+   fNODE "typed_formula" 2
+and fUNFOLD = function
+| CT_coerce_ID_to_UNFOLD x -> fID x
+| CT_unfold_occ(x1, x2) ->
+   fID x1;
+   fINT_NE_LIST x2;
+   fNODE "unfold_occ" 2
+and fUNFOLD_NE_LIST = function
+| CT_unfold_ne_list(x,l) ->
+   fUNFOLD x;
+   (List.iter fUNFOLD l);
+   fNODE "unfold_ne_list" (1 + (List.length l))
+and fUSING = function
+| CT_coerce_NONE_to_USING x -> fNONE x
+| CT_using(x1, x2) ->
+   fFORMULA x1;
+   fSPEC_LIST x2;
+   fNODE "using" 2
+and fUSINGTDB = function
+| CT_coerce_NONE_to_USINGTDB x -> fNONE x
+| CT_usingtdb -> fNODE "usingtdb" 0
+and fVAR = function
+| CT_var x -> fATOM "var";
+   (f_atom_string x);
+   print_string "\n"and fVARG = function
+| CT_coerce_AST_to_VARG x -> fAST x
+| CT_coerce_AST_LIST_to_VARG x -> fAST_LIST x
+| CT_coerce_BINDER_to_VARG x -> fBINDER x
+| CT_coerce_BINDER_LIST_to_VARG x -> fBINDER_LIST x
+| CT_coerce_BINDER_NE_LIST_to_VARG x -> fBINDER_NE_LIST x
+| CT_coerce_FORMULA_LIST_to_VARG x -> fFORMULA_LIST x
+| CT_coerce_FORMULA_OPT_to_VARG x -> fFORMULA_OPT x
+| CT_coerce_FORMULA_OR_INT_to_VARG x -> fFORMULA_OR_INT x
+| CT_coerce_ID_OPT_OR_ALL_to_VARG x -> fID_OPT_OR_ALL x
+| CT_coerce_ID_OR_INT_OPT_to_VARG x -> fID_OR_INT_OPT x
+| CT_coerce_INT_LIST_to_VARG x -> fINT_LIST x
+| CT_coerce_SCOMMENT_CONTENT_to_VARG x -> fSCOMMENT_CONTENT x
+| CT_coerce_STRING_OPT_to_VARG x -> fSTRING_OPT x
+| CT_coerce_TACTIC_OPT_to_VARG x -> fTACTIC_OPT x
+| CT_coerce_VARG_LIST_to_VARG x -> fVARG_LIST x
+and fVARG_LIST = function
+| CT_varg_list l ->
+   (List.iter fVARG l);
+   fNODE "varg_list" (List.length l)
+and fVERBOSE_OPT = function
+| CT_coerce_NONE_to_VERBOSE_OPT x -> fNONE x
+| CT_verbose -> fNODE "verbose" 0
+;;
diff --git a/contrib/interface/vtp.mli b/contrib/interface/vtp.mli
new file mode 100644
index 00000000..fe30b317
--- /dev/null
+++ b/contrib/interface/vtp.mli
@@ -0,0 +1,15 @@
+open Ascent;;
+
+val fCOMMAND_LIST : ct_COMMAND_LIST -> unit;;
+val fCOMMAND : ct_COMMAND -> unit;;
+val fTACTIC_COM : ct_TACTIC_COM -> unit;;
+val fFORMULA : ct_FORMULA -> unit;;
+val fID : ct_ID -> unit;;
+val fSTRING : ct_STRING -> unit;;
+val fINT : ct_INT -> unit;;
+val fRULE_LIST : ct_RULE_LIST -> unit;;
+val fRULE : ct_RULE -> unit;;
+val fSIGNED_INT_LIST : ct_SIGNED_INT_LIST -> unit;;
+val fPREMISES_LIST : ct_PREMISES_LIST -> unit;;
+val fID_LIST : ct_ID_LIST -> unit;;
+val fTEXT : ct_TEXT -> unit;;
\ No newline at end of file
diff --git a/contrib/interface/xlate.ml b/contrib/interface/xlate.ml
new file mode 100644
index 00000000..ed51b9cb
--- /dev/null
+++ b/contrib/interface/xlate.ml
@@ -0,0 +1,2118 @@
+(** Translation from coq abstract syntax trees to centaur vernac
+   *)
+open String;;
+open Char;;
+open Util;;
+open Ast;;
+open Names;;
+open Ascent;;
+open Genarg;;
+open Rawterm;;
+open Tacexpr;;
+open Vernacexpr;;
+open Decl_kinds;;
+open Topconstr;;
+open Libnames;;
+open Goptions;;
+
+
+let in_coq_ref = ref false;;
+
+let declare_in_coq () = in_coq_ref:=true;;
+
+let in_coq () = !in_coq_ref;;
+
+(* // Verify whether this is dead code, as of coq version 7 *)
+(* The following three sentences have been added to cope with a change 
+of strategy from the Coq team in the way rules construct ast's.  The
+problem is that now grammar rules will refer to identifiers by giving
+their absolute name, using the mutconstruct when needed.  Unfortunately,
+when you have a mutconstruct structure, you don't have a way to guess
+the corresponding identifier without an environment, and the parser
+does not have an environment.  We add one, only for the constructs
+that are always loaded. *)
+let type_table = ((Hashtbl.create 17) :
+      (string, ((string array) array)) Hashtbl.t);;
+
+Hashtbl.add type_table "Coq.Init.Logic.and"
+  [|[|"dummy";"conj"|]|];;
+
+Hashtbl.add type_table "Coq.Init.Datatypes.prod"
+  [|[|"dummy";"pair"|]|];;
+
+Hashtbl.add type_table "Coq.Init.Datatypes.nat"
+  [|[|"";"O"; "S"|]|];;
+
+Hashtbl.add type_table "Coq.ZArith.fast_integer.Z"
+[|[|"";"ZERO";"POS";"NEG"|]|];;
+
+
+Hashtbl.add type_table "Coq.ZArith.fast_integer.positive"
+[|[|"";"xI";"xO";"xH"|]|];;
+
+(*The following two codes are added to cope with the distinction
+  between ocaml and caml-light syntax while using ctcaml to
+  manipulate the program *)
+let code_plus = code (get "+" 0);;
+
+let code_minus = code (get "-" 0);;
+
+let coercion_description_holder = ref (function _ -> None : t -> int option);;
+
+let coercion_description t = !coercion_description_holder t;;
+
+let set_coercion_description f =
+ coercion_description_holder:=f; ();;
+
+let string_of_node_loc the_node =
+  match Util.unloc (loc the_node) with
+      (a,b) -> "(" ^ (string_of_int a) ^ ", " ^ (string_of_int b) ^ ")";;
+
+let xlate_error s = failwith ("Translation error: " ^ s);;
+
+let ctf_STRING_OPT_NONE = CT_coerce_NONE_to_STRING_OPT CT_none;;
+
+let ctf_STRING_OPT_SOME s = CT_coerce_STRING_to_STRING_OPT s;;
+
+let ctf_STRING_OPT = function
+  | None -> ctf_STRING_OPT_NONE
+  | Some s -> ctf_STRING_OPT_SOME (CT_string s)
+
+let ctv_ID_OPT_NONE = CT_coerce_NONE_to_ID_OPT CT_none;;
+
+let ctf_ID_OPT_SOME s = CT_coerce_ID_to_ID_OPT s;;
+
+let ctv_ID_OPT_OR_ALL_NONE =
+ CT_coerce_ID_OPT_to_ID_OPT_OR_ALL (CT_coerce_NONE_to_ID_OPT CT_none);;
+
+let ctv_FORMULA_OPT_NONE =
+  CT_coerce_ID_OPT_to_FORMULA_OPT(CT_coerce_NONE_to_ID_OPT CT_none);;
+
+let ctv_PATTERN_OPT_NONE = CT_coerce_NONE_to_PATTERN_OPT CT_none;;
+
+let ctv_DEF_BODY_OPT_NONE = CT_coerce_FORMULA_OPT_to_DEF_BODY_OPT 
+			      ctv_FORMULA_OPT_NONE;;
+
+let ctf_ID_OPT_OR_ALL_SOME s =
+ CT_coerce_ID_OPT_to_ID_OPT_OR_ALL (ctf_ID_OPT_SOME s);;
+
+let ctv_ID_OPT_OR_ALL_ALL = CT_all;;
+
+let ctv_SPEC_OPT_NONE = CT_coerce_NONE_to_SPEC_OPT CT_none;;
+
+let ct_coerce_FORMULA_to_DEF_BODY x =
+    CT_coerce_CONTEXT_PATTERN_to_DEF_BODY
+    (CT_coerce_FORMULA_to_CONTEXT_PATTERN x);;
+
+let castc x = CT_coerce_TYPED_FORMULA_to_FORMULA x;;
+
+let varc x = CT_coerce_ID_to_FORMULA x;;
+
+let xlate_ident id = CT_ident (string_of_id id)
+
+let ident_tac s = CT_user_tac (xlate_ident s, CT_targ_list []);;
+
+let ident_vernac s = CT_user_vernac (CT_ident s, CT_varg_list []);;
+
+let nums_to_int_list_aux l = List.map (fun x -> CT_int x) l;;
+
+let nums_to_int_list l =  CT_int_list(nums_to_int_list_aux l);;
+
+let nums_to_int_ne_list n l =
+  CT_int_ne_list(CT_int n, nums_to_int_list_aux l);;
+
+type iTARG =   Targ_command of ct_FORMULA
+             | Targ_intropatt of ct_INTRO_PATT_LIST
+             | Targ_id_list of ct_ID_LIST
+             | Targ_spec_list of ct_SPEC_LIST
+             | Targ_binding_com of ct_FORMULA
+             | Targ_ident of ct_ID
+             | Targ_int of ct_INT
+             | Targ_binding of ct_BINDING
+             | Targ_pattern of ct_PATTERN
+             | Targ_unfold of ct_UNFOLD
+	     | Targ_unfold_ne_list of ct_UNFOLD_NE_LIST
+             | Targ_string of ct_STRING
+             | Targ_fixtac of ct_FIXTAC
+             | Targ_cofixtac of ct_COFIXTAC
+             | Targ_tacexp of ct_TACTIC_COM
+             | Targ_redexp of ct_RED_COM;;
+
+type iVARG =   Varg_binder of ct_BINDER
+             | Varg_binderlist of ct_BINDER_LIST
+             | Varg_bindernelist of ct_BINDER_NE_LIST
+             | Varg_call of ct_ID * iVARG list
+             | Varg_constr of ct_FORMULA
+             | Varg_sorttype of ct_SORT_TYPE
+             | Varg_constrlist of ct_FORMULA list
+             | Varg_ident of ct_ID
+             | Varg_int of ct_INT
+             | Varg_intlist of ct_INT_LIST
+             | Varg_none
+             | Varg_string of ct_STRING
+             | Varg_tactic of ct_TACTIC_COM
+             | Varg_ast of ct_AST
+             | Varg_astlist of ct_AST_LIST
+             | Varg_tactic_arg of iTARG
+             | Varg_varglist of iVARG list;;
+
+
+let coerce_iVARG_to_FORMULA =
+ function
+    | Varg_constr x -> x
+    | Varg_sorttype x -> CT_coerce_SORT_TYPE_to_FORMULA x
+    | Varg_ident id -> CT_coerce_ID_to_FORMULA id
+    | _ -> xlate_error "coerce_iVARG_to_FORMULA: unexpected argument";;
+
+let coerce_iVARG_to_ID =
+ function Varg_ident id -> id
+    | _ -> xlate_error "coerce_iVARG_to_ID";;
+
+let coerce_VARG_to_ID =
+ function
+    | CT_coerce_ID_OPT_OR_ALL_to_VARG (CT_coerce_ID_OPT_to_ID_OPT_OR_ALL (CT_coerce_ID_to_ID_OPT x)) ->
+     x
+    | _ -> xlate_error "coerce_VARG_to_ID";;
+
+let xlate_ident_opt =
+  function
+    | None -> ctv_ID_OPT_NONE
+    | Some id -> ctf_ID_OPT_SOME (xlate_ident id)
+
+let xlate_id_to_id_or_int_opt s =
+   CT_coerce_ID_OPT_to_ID_OR_INT_OPT
+     (CT_coerce_ID_to_ID_OPT (CT_ident (string_of_id s)));;
+
+let xlate_int_to_id_or_int_opt n =
+   CT_coerce_ID_OR_INT_to_ID_OR_INT_OPT
+     (CT_coerce_INT_to_ID_OR_INT (CT_int n));;
+
+let none_in_id_or_int_opt =
+  CT_coerce_ID_OPT_to_ID_OR_INT_OPT
+    (CT_coerce_NONE_to_ID_OPT(CT_none));;
+
+let xlate_int_opt = function
+  | Some n -> CT_coerce_INT_to_INT_OPT (CT_int n)
+  | None ->  CT_coerce_NONE_to_INT_OPT CT_none
+
+let tac_qualid_to_ct_ID ref = 
+  CT_ident (Libnames.string_of_qualid (snd (qualid_of_reference ref)))
+
+let loc_qualid_to_ct_ID ref =
+  CT_ident (Libnames.string_of_qualid (snd (qualid_of_reference ref)))
+
+let int_of_meta n = int_of_string (string_of_id n)
+let is_int_meta n = try let _ = int_of_meta n in true with _ -> false
+
+let xlate_qualid_list l = CT_id_list (List.map loc_qualid_to_ct_ID l)
+
+let reference_to_ct_ID = function
+  | Ident (_,id) -> CT_ident (Names.string_of_id id)
+  | Qualid (_,qid) -> CT_ident (Libnames.string_of_qualid qid)
+
+let xlate_class = function
+  | FunClass -> CT_ident "FUNCLASS"
+  | SortClass -> CT_ident "SORTCLASS"
+  | RefClass qid -> loc_qualid_to_ct_ID qid
+
+let id_to_pattern_var ctid =
+ match ctid with
+ | CT_metaid _ -> xlate_error "metaid not expected in pattern_var"
+ | CT_ident "_" -> 
+     CT_coerce_ID_OPT_to_MATCH_PATTERN (CT_coerce_NONE_to_ID_OPT CT_none)
+ | CT_ident id_string ->
+     CT_coerce_ID_OPT_to_MATCH_PATTERN 
+       (CT_coerce_ID_to_ID_OPT (CT_ident id_string))
+ | CT_metac _ -> assert false;;
+
+exception Not_natural;;
+
+let xlate_sort =
+  function
+    | RProp Term.Pos -> CT_sortc "Set"
+    | RProp Term.Null -> CT_sortc "Prop"
+    | RType None -> CT_sortc "Type"
+    | RType (Some u) -> xlate_error "xlate_sort";;
+
+
+let xlate_qualid a =
+  let d,i = Libnames.repr_qualid a in
+  let l = Names.repr_dirpath d in
+  List.fold_left (fun s i1 -> (string_of_id i1) ^ "." ^ s) (string_of_id i) l;;
+   
+(* // The next two functions should be modified to make direct reference
+  to a notation operator *)
+let notation_to_formula s l = CT_notation(CT_string s, CT_formula_list l);;
+
+let xlate_reference = function
+    Ident(_,i) -> CT_ident (string_of_id i)
+  | Qualid(_, q) -> CT_ident (xlate_qualid q);;
+let rec xlate_match_pattern =
+ function
+   | CPatAtom(_, Some s) -> id_to_pattern_var (xlate_reference  s)
+   | CPatAtom(_, None) -> id_to_pattern_var (CT_ident "_")
+   | CPatCstr(_, f, []) -> id_to_pattern_var (xlate_reference f)
+   | CPatCstr (_, f1 , (arg1 :: args)) ->
+     CT_pattern_app
+      (id_to_pattern_var (xlate_reference  f1),
+      CT_match_pattern_ne_list
+       (xlate_match_pattern arg1, 
+	List.map xlate_match_pattern args))
+    | CPatAlias  (_,  pattern, id) ->
+     CT_pattern_as
+      (xlate_match_pattern pattern, CT_coerce_ID_to_ID_OPT (xlate_ident id))
+    | CPatDelimiters(_, key, p) -> 
+	CT_pattern_delimitors(CT_num_type key, xlate_match_pattern p)
+    | CPatNumeral(_,n) ->
+ 	CT_coerce_NUM_to_MATCH_PATTERN
+	  (CT_int_encapsulator(Bignat.bigint_to_string n))
+    | CPatNotation(_, s, l) -> 
+	CT_pattern_notation(CT_string s,
+			    CT_match_pattern_list(List.map xlate_match_pattern l))
+;;
+
+
+let xlate_id_opt_aux = function
+    Name id -> ctf_ID_OPT_SOME(CT_ident (string_of_id id))
+  | Anonymous -> ctv_ID_OPT_NONE;;
+
+let xlate_id_opt (_, v) = xlate_id_opt_aux v;;
+
+let xlate_id_opt_ne_list = function
+    [] -> assert false
+  | a::l -> CT_id_opt_ne_list(xlate_id_opt a, List.map xlate_id_opt l);;
+
+
+let rec last = function
+    [] -> assert false
+  | [a] -> a
+  | a::tl -> last tl;;
+
+let rec decompose_last = function
+    [] -> assert false
+  | [a] -> [], a
+  | a::tl -> let rl, b = decompose_last tl in (a::rl), b;;
+
+let make_fix_struct (n,bl) =
+  let names = names_of_local_assums bl in
+  let nn = List.length names in
+  if nn = 1 then ctv_ID_OPT_NONE
+  else if n < nn then xlate_id_opt(List.nth names n)
+  else xlate_error "unexpected result of parsing for Fixpoint";;
+
+
+let rec xlate_binder = function
+    (l,t) -> CT_binder(xlate_id_opt_ne_list l, xlate_formula t)
+and xlate_return_info = function
+| (Some Anonymous, None) | (None, None) ->
+   CT_coerce_NONE_to_RETURN_INFO CT_none
+| (None, Some t) -> CT_return(xlate_formula t)
+| (Some x, Some t) -> CT_as_and_return(xlate_id_opt_aux x, xlate_formula t)
+| (Some _, None) -> assert false
+and xlate_formula_opt =
+  function
+    | None -> ctv_FORMULA_OPT_NONE
+    | Some e -> CT_coerce_FORMULA_to_FORMULA_OPT (xlate_formula e)
+
+and  xlate_binder_l = function
+    LocalRawAssum(l,t) -> CT_binder(xlate_id_opt_ne_list l, xlate_formula t)
+  | LocalRawDef(n,v) -> CT_coerce_DEF_to_BINDER(CT_def(xlate_id_opt n,
+						       xlate_formula v))
+and 
+  xlate_match_pattern_ne_list = function
+    [] -> assert false
+  | a::l -> CT_match_pattern_ne_list(xlate_match_pattern a, 
+                                     List.map xlate_match_pattern l)
+and  translate_one_equation = function
+    (_,lp, a) -> CT_eqn ( xlate_match_pattern_ne_list lp,
+	     xlate_formula a)
+and 
+  xlate_binder_ne_list = function
+    [] -> assert false
+  | a::l -> CT_binder_ne_list(xlate_binder a, List.map xlate_binder l)
+and 
+  xlate_binder_list = function
+  l -> CT_binder_list( List.map xlate_binder_l l)
+and (xlate_formula:Topconstr.constr_expr -> Ascent.ct_FORMULA) = function
+
+     CRef r -> varc (xlate_reference r)
+   | CArrow(_,a,b)-> CT_arrowc (xlate_formula a, xlate_formula b)
+   | CProdN(_,ll,b) as whole_term -> 
+       let rec gather_binders = function
+	   CProdN(_, ll, b) ->
+	     ll@(gather_binders b)
+	 | _ -> [] in
+       let rec fetch_ultimate_body = function
+	   CProdN(_, _, b) -> fetch_ultimate_body b
+	 | a -> a in
+	 CT_prodc(xlate_binder_ne_list (gather_binders whole_term), 
+		  xlate_formula (fetch_ultimate_body b))
+   | CLambdaN(_,ll,b)-> CT_lambdac(xlate_binder_ne_list ll, xlate_formula b)
+   | CLetIn(_, v, a, b) -> 
+       CT_letin(CT_def(xlate_id_opt v, xlate_formula a), xlate_formula b)
+   | CAppExpl(_, (Some n, r), l) -> 
+       let l', last = decompose_last l in
+	 CT_proj(xlate_formula last,
+		 CT_formula_ne_list
+		   (CT_bang(varc (xlate_reference r)),
+		    List.map xlate_formula l'))
+   | CAppExpl(_, (None, r), []) -> CT_bang(varc(xlate_reference r))
+   | CAppExpl(_, (None, r), l) -> 
+       CT_appc(CT_bang(varc (xlate_reference r)),
+	       xlate_formula_ne_list l)
+   | CApp(_, (Some n,f), l) -> 
+       let l', last = decompose_last l in
+       CT_proj(xlate_formula_expl last, 
+	       CT_formula_ne_list
+		 (xlate_formula f, List.map xlate_formula_expl l'))
+   | CApp(_, (_,f), l) -> 
+       CT_appc(xlate_formula f, xlate_formula_expl_ne_list l)
+   | CCases (_, _, [], _) -> assert false
+   | CCases (_, (Some _, _), _, _) -> xlate_error "NOT parsed: Cases with Some"
+   | CCases (_,(None, ret_type), tm::tml, eqns)->
+       CT_cases(CT_matched_formula_ne_list(xlate_matched_formula tm,
+					   List.map xlate_matched_formula tml),
+		xlate_formula_opt ret_type,
+                CT_eqn_list (List.map (fun x -> translate_one_equation x) eqns))
+   | COrderedCase (_,Term.IfStyle,po,c,[b1;b2]) -> 
+       xlate_error "No more COrderedCase"
+   | CLetTuple (_,a::l, ret_info, c, b) -> 
+      CT_let_tuple(CT_id_opt_ne_list(xlate_id_opt_aux a,
+				     List.map xlate_id_opt_aux l),
+		   xlate_return_info ret_info,
+		   xlate_formula c,
+		   xlate_formula b)
+   | CLetTuple (_, [], _, _, _) -> xlate_error "NOT parsed: Let with ()"
+   | CIf (_,c, ret_info, b1, b2) -> 
+       CT_if
+	 (xlate_formula c, xlate_return_info ret_info,
+	  xlate_formula b1, xlate_formula b2)
+
+   | COrderedCase (_,Term.LetStyle, po, c, [CLambdaN(_,[l,_],b)]) ->
+       CT_inductive_let(xlate_formula_opt po,
+	       xlate_id_opt_ne_list l,
+	       xlate_formula c, xlate_formula b) 
+   | COrderedCase (_,c,v,e,l) -> 
+       let case_string = match c with
+	   Term.MatchStyle -> "Match"
+	 | _ -> "Case" in
+	 CT_elimc(CT_case "Case", xlate_formula_opt v, xlate_formula e,
+		  CT_formula_list(List.map xlate_formula l))
+   | CSort(_, s) -> CT_coerce_SORT_TYPE_to_FORMULA(xlate_sort s)
+   | CNotation(_, s, l) -> notation_to_formula s (List.map xlate_formula l)
+   | CNumeral(_, i) -> 
+       CT_coerce_NUM_to_FORMULA(CT_int_encapsulator(Bignat.bigint_to_string i))
+   | CHole _ -> CT_existvarc 
+(* I assume CDynamic has been inserted to make free form extension of
+   the language possible, but this would go agains the logic of pcoq anyway. *)
+   | CDynamic (_, _) -> assert false
+   | CDelimiters (_, key, num) -> 
+	 CT_num_encapsulator(CT_num_type key , xlate_formula  num)
+   | CCast (_, e, t) -> 
+       CT_coerce_TYPED_FORMULA_to_FORMULA
+	 (CT_typed_formula(xlate_formula e, xlate_formula t))
+   | CPatVar (_, (_,i)) when is_int_meta i ->
+       CT_coerce_ID_to_FORMULA(CT_metac (CT_int (int_of_meta i)))
+   | CPatVar (_, (false, s)) ->
+       CT_coerce_ID_to_FORMULA(CT_metaid (string_of_id s))
+   | CPatVar (_, (true, s)) ->
+       xlate_error "Second order variable not supported"
+   | CEvar (_, _) -> xlate_error "CEvar not supported"
+   | CCoFix (_, (_, id), lm::lmi) -> 
+     let strip_mutcorec (fid, bl,arf, ardef) =
+	CT_cofix_rec (xlate_ident fid, xlate_binder_list bl,
+                      xlate_formula arf, xlate_formula ardef) in
+        CT_cofixc(xlate_ident id,
+	  (CT_cofix_rec_list (strip_mutcorec lm, List.map strip_mutcorec lmi)))
+   | CFix (_, (_, id), lm::lmi) ->       
+     let strip_mutrec (fid, n, bl, arf, ardef) =
+        let (struct_arg,bl,arf,ardef) =
+         if bl = [] then
+           let (bl,arf,ardef) = Ppconstr.split_fix (n+1) arf ardef in
+           let bl = List.map (fun(nal,ty)->LocalRawAssum(nal,ty)) bl in
+           (xlate_id_opt(List.nth (names_of_local_assums bl) n),bl,arf,ardef)
+         else (make_fix_struct (n, bl),bl,arf,ardef) in
+        let arf = xlate_formula arf in
+        let ardef = xlate_formula ardef in
+	match xlate_binder_list bl with
+	  | CT_binder_list (b :: bl) ->
+	      CT_fix_rec (xlate_ident fid, CT_binder_ne_list (b, bl),
+			  struct_arg, arf, ardef)
+          | _ -> xlate_error "mutual recursive" in
+       CT_fixc (xlate_ident id, 
+         	CT_fix_binder_list
+		  (CT_coerce_FIX_REC_to_FIX_BINDER 
+		     (strip_mutrec lm), List.map 
+		       (fun x-> CT_coerce_FIX_REC_to_FIX_BINDER (strip_mutrec x))
+		       lmi)) 
+   | CCoFix _ -> assert false
+   | CFix _ -> assert false
+and xlate_matched_formula = function
+    (f, (Some x, Some y)) ->
+      CT_formula_as_in(xlate_formula f, xlate_id_opt_aux x, xlate_formula y)
+  | (f, (None, Some y)) ->
+      CT_formula_in(xlate_formula f, xlate_formula y)
+  | (f, (Some x, None)) ->
+      CT_formula_as(xlate_formula f, xlate_id_opt_aux x)
+  | (f, (None, None)) -> 
+      CT_coerce_FORMULA_to_MATCHED_FORMULA(xlate_formula f)
+and xlate_formula_expl = function
+    (a, None) -> xlate_formula a
+  | (a, Some (_,ExplByPos i)) -> 
+      xlate_error "explicitation of implicit by rank not supported"
+  | (a, Some (_,ExplByName i)) ->
+      CT_labelled_arg(CT_ident (string_of_id i), xlate_formula a)
+and xlate_formula_expl_ne_list = function
+    [] -> assert false
+  | a::l -> CT_formula_ne_list(xlate_formula_expl a, List.map xlate_formula_expl l)
+and xlate_formula_ne_list = function 
+    [] -> assert false
+  | a::l -> CT_formula_ne_list(xlate_formula a, List.map xlate_formula l);;
+
+let (xlate_ident_or_metaid:
+      Names.identifier Util.located Tacexpr.or_metaid -> ct_ID) = function
+    AI (_, x) -> xlate_ident x
+  | MetaId(_, x) -> CT_metaid x;;
+
+let xlate_hyp = function
+  | AI (_,id) -> xlate_ident id
+  | MetaId _ -> xlate_error "MetaId should occur only in quotations"
+
+let xlate_hyp_location =
+ function
+  | AI (_,id), nums, (InHypTypeOnly,_) ->
+      CT_intype(xlate_ident id, nums_to_int_list nums)
+  | AI (_,id), nums, (InHypValueOnly,_) ->
+      CT_invalue(xlate_ident id, nums_to_int_list nums)
+  | AI (_,id), [], (InHyp,_) ->
+      CT_coerce_UNFOLD_to_HYP_LOCATION 
+	(CT_coerce_ID_to_UNFOLD (xlate_ident id))
+  | AI (_,id), a::l, (InHyp,_) ->
+      CT_coerce_UNFOLD_to_HYP_LOCATION 
+	(CT_unfold_occ (xlate_ident id, 
+			CT_int_ne_list(CT_int a, nums_to_int_list_aux l)))
+  | MetaId _, _,_ -> 
+      xlate_error "MetaId not supported in xlate_hyp_location (should occur only in quotations)"
+
+let xlate_clause cls =
+  let hyps_info =
+    match cls.onhyps with
+    	None -> CT_coerce_STAR_to_HYP_LOCATION_LIST_OR_STAR CT_star
+      | Some l -> CT_hyp_location_list(List.map xlate_hyp_location l) in
+  CT_clause
+    (hyps_info, 
+     if cls.onconcl then 
+       CT_coerce_STAR_to_STAR_OPT CT_star
+     else
+       CT_coerce_NONE_to_STAR_OPT CT_none)
+
+(** Tactics
+   *)
+let strip_targ_spec_list =
+ function
+    | Targ_spec_list x -> x
+    | _ -> xlate_error "strip tactic: non binding-list argument";;
+
+let strip_targ_binding =
+ function
+    | Targ_binding x -> x
+    | _ -> xlate_error "strip tactic: non-binding argument";;
+
+let strip_targ_command =
+ function
+    | Targ_command x -> x
+    | Targ_binding_com x -> x
+    | _ -> xlate_error "strip tactic: non-command argument";;
+
+let strip_targ_ident =
+ function
+    | Targ_ident x -> x
+    | _ -> xlate_error "strip tactic: non-ident argument";;
+
+let strip_targ_int =
+ function
+    | Targ_int x -> x
+    | _ -> xlate_error "strip tactic: non-int argument";;
+
+let strip_targ_pattern =
+ function
+    | Targ_pattern x -> x
+    | _ -> xlate_error "strip tactic: non-pattern argument";;
+
+let strip_targ_unfold =
+ function
+    | Targ_unfold x -> x
+    | _ -> xlate_error "strip tactic: non-unfold argument";;
+
+let strip_targ_fixtac =
+ function
+    | Targ_fixtac x -> x
+    | _ -> xlate_error "strip tactic: non-fixtac argument";;
+
+let strip_targ_cofixtac =
+ function
+    | Targ_cofixtac x -> x
+    | _ -> xlate_error "strip tactic: non-cofixtac argument";;
+
+(*Need to transform formula to id for "Prolog" tactic problem *)
+let make_ID_from_FORMULA =
+ function
+    | CT_coerce_ID_to_FORMULA id -> id
+    | _ -> xlate_error "make_ID_from_FORMULA: non-formula argument";;
+
+let make_ID_from_iTARG_FORMULA x = make_ID_from_FORMULA (strip_targ_command x);;
+
+let xlate_quantified_hypothesis = function
+  | AnonHyp n -> CT_coerce_INT_to_ID_OR_INT (CT_int n)
+  | NamedHyp id -> CT_coerce_ID_to_ID_OR_INT (xlate_ident id)
+
+let xlate_quantified_hypothesis_opt = function
+  | None -> 
+      CT_coerce_ID_OPT_to_ID_OR_INT_OPT ctv_ID_OPT_NONE
+  | Some (AnonHyp n) -> xlate_int_to_id_or_int_opt n
+  | Some (NamedHyp id) -> xlate_id_to_id_or_int_opt id;;
+
+let xlate_id_or_int = function
+    ArgArg n -> CT_coerce_INT_to_ID_OR_INT(CT_int n)
+  | ArgVar(_, s) -> CT_coerce_ID_to_ID_OR_INT(xlate_ident s);;
+
+let xlate_explicit_binding (loc,h,c) = 
+  CT_binding (xlate_quantified_hypothesis h, xlate_formula c)
+
+let xlate_bindings = function
+  | ImplicitBindings l ->
+      CT_coerce_FORMULA_LIST_to_SPEC_LIST
+        (CT_formula_list (List.map xlate_formula l))
+  | ExplicitBindings l ->
+      CT_coerce_BINDING_LIST_to_SPEC_LIST
+        (CT_binding_list (List.map xlate_explicit_binding l))
+  | NoBindings ->
+      CT_coerce_FORMULA_LIST_to_SPEC_LIST (CT_formula_list [])
+
+let strip_targ_spec_list =
+ function
+    | Targ_spec_list x -> x
+    | _ -> xlate_error "strip_tar_spec_list";;
+
+let strip_targ_intropatt =
+ function
+    | Targ_intropatt x -> x
+    | _ -> xlate_error "strip_targ_intropatt";;
+
+let get_flag r =
+  let conv_flags, red_ids = 
+    if r.rDelta then
+      [CT_delta], CT_unfbut (List.map tac_qualid_to_ct_ID r.rConst)
+    else
+      (if r.rConst = []
+      then (* probably useless: just for compatibility *) []
+      else [CT_delta]),
+      CT_unf (List.map tac_qualid_to_ct_ID r.rConst) in
+  let conv_flags = if r.rBeta then CT_beta::conv_flags else conv_flags in
+  let conv_flags = if r.rIota then CT_iota::conv_flags else conv_flags in
+  let conv_flags = if r.rZeta then CT_zeta::conv_flags else conv_flags in
+  (* Rem: EVAR flag obsolète *)
+  conv_flags, red_ids
+
+let rec xlate_intro_pattern =
+ function
+  | IntroOrAndPattern [] -> assert false
+  | IntroOrAndPattern (fp::ll) ->
+      CT_disj_pattern
+      	(CT_intro_patt_list(List.map xlate_intro_pattern fp),
+	 List.map 
+	   (fun l ->
+	      CT_intro_patt_list(List.map xlate_intro_pattern l))
+	   ll)
+  | IntroWildcard -> CT_coerce_ID_to_INTRO_PATT(CT_ident "_" )
+  | IntroIdentifier c -> CT_coerce_ID_to_INTRO_PATT(xlate_ident c)
+
+let compute_INV_TYPE = function
+   FullInversionClear -> CT_inv_clear
+ | SimpleInversion -> CT_inv_simple
+ | FullInversion -> CT_inv_regular
+
+let is_tactic_special_case = function
+    "AutoRewrite" -> true
+  | _ -> false;;
+
+let xlate_context_pattern = function
+  | Term v -> 
+      CT_coerce_FORMULA_to_CONTEXT_PATTERN (xlate_formula v)
+  | Subterm (idopt, v) ->
+      CT_context(xlate_ident_opt idopt, xlate_formula v)
+
+
+let xlate_match_context_hyps = function
+  | Hyp (na,b) -> CT_premise_pattern(xlate_id_opt na, xlate_context_pattern b);;
+
+let xlate_arg_to_id_opt = function
+    Some id -> CT_coerce_ID_to_ID_OPT(CT_ident (string_of_id id))
+  | None -> ctv_ID_OPT_NONE;;
+
+let xlate_largs_to_id_opt largs =
+  match List.map xlate_arg_to_id_opt largs with
+      fst::rest -> fst, rest
+    | _ -> assert false;;
+
+let xlate_int_or_constr = function
+    ElimOnConstr a -> CT_coerce_FORMULA_to_FORMULA_OR_INT(xlate_formula a)
+  | ElimOnIdent(_,i) ->
+      CT_coerce_ID_OR_INT_to_FORMULA_OR_INT
+      	(CT_coerce_ID_to_ID_OR_INT(xlate_ident i))
+  | ElimOnAnonHyp i -> 
+      CT_coerce_ID_OR_INT_to_FORMULA_OR_INT
+	(CT_coerce_INT_to_ID_OR_INT(CT_int i));;
+
+let xlate_using = function
+    None -> CT_coerce_NONE_to_USING(CT_none)
+  | Some (c2,sl2) -> CT_using (xlate_formula c2, xlate_bindings sl2);;
+
+let xlate_one_unfold_block = function
+    ([],qid) -> CT_coerce_ID_to_UNFOLD(tac_qualid_to_ct_ID qid)
+  | (n::nums, qid) ->
+      CT_unfold_occ(tac_qualid_to_ct_ID qid, nums_to_int_ne_list n nums);;
+
+let xlate_intro_patt_opt = function
+    None -> CT_coerce_ID_OPT_to_INTRO_PATT_OPT ctv_ID_OPT_NONE
+  | Some fp -> CT_coerce_INTRO_PATT_to_INTRO_PATT_OPT (xlate_intro_pattern fp)
+
+let rec (xlate_tacarg:raw_tactic_arg -> ct_TACTIC_ARG) =
+  function
+    | TacVoid ->
+	CT_void
+    | Tacexp t -> 
+	CT_coerce_TACTIC_COM_to_TACTIC_ARG(xlate_tactic t)
+    | Integer n ->
+	CT_coerce_FORMULA_OR_INT_to_TACTIC_ARG
+	  (CT_coerce_ID_OR_INT_to_FORMULA_OR_INT
+	     (CT_coerce_INT_to_ID_OR_INT (CT_int n)))
+    | Reference r ->
+	CT_coerce_FORMULA_OR_INT_to_TACTIC_ARG
+	  (CT_coerce_ID_OR_INT_to_FORMULA_OR_INT
+	     (CT_coerce_ID_to_ID_OR_INT (reference_to_ct_ID r)))
+    | TacDynamic _ ->
+	failwith "Dynamics not treated in xlate_ast"
+    | ConstrMayEval (ConstrTerm c) ->
+	CT_coerce_FORMULA_OR_INT_to_TACTIC_ARG
+	  (CT_coerce_FORMULA_to_FORMULA_OR_INT (xlate_formula c))
+    | ConstrMayEval(ConstrEval(r,c)) ->
+	CT_coerce_EVAL_CMD_to_TACTIC_ARG
+	  (CT_eval(CT_coerce_NONE_to_INT_OPT CT_none, xlate_red_tactic r,
+		   xlate_formula c))
+    | ConstrMayEval(ConstrTypeOf(c)) -> 
+	CT_coerce_TERM_CHANGE_to_TACTIC_ARG(CT_check_term(xlate_formula c))
+    | MetaIdArg _ ->
+	xlate_error "MetaIdArg should only be used in quotations"
+    | t ->
+	CT_coerce_TACTIC_COM_to_TACTIC_ARG(xlate_call_or_tacarg t)
+
+and (xlate_call_or_tacarg:raw_tactic_arg -> ct_TACTIC_COM) =
+ function
+   (* Moved from xlate_tactic *)
+    | TacCall (_, r, a::l) ->
+	CT_simple_user_tac
+	  (reference_to_ct_ID r,
+	    CT_tactic_arg_list(xlate_tacarg a,List.map xlate_tacarg l))
+    | Reference (Ident (_,s)) -> ident_tac s
+    | ConstrMayEval(ConstrTerm a) ->
+	CT_formula_marker(xlate_formula a)
+    | TacFreshId s -> CT_fresh(ctf_STRING_OPT s)
+    | t -> xlate_error "TODO LATER: result other than tactic or constr"
+
+and xlate_red_tactic =
+ function
+  | Red true -> xlate_error ""
+  | Red false -> CT_red
+  | Hnf -> CT_hnf
+  | Simpl None -> CT_simpl ctv_PATTERN_OPT_NONE
+  | Simpl (Some (l,c)) -> 
+      CT_simpl 
+	(CT_coerce_PATTERN_to_PATTERN_OPT
+	   (CT_pattern_occ
+	      (CT_int_list(List.map (fun n -> CT_int n) l), xlate_formula c)))
+  | Cbv flag_list ->
+     let conv_flags, red_ids = get_flag flag_list in
+     CT_cbv (CT_conversion_flag_list conv_flags, red_ids)
+  | Lazy flag_list ->
+     let conv_flags, red_ids = get_flag flag_list in
+     CT_lazy (CT_conversion_flag_list conv_flags, red_ids)
+  | Unfold unf_list ->
+     let ct_unf_list = List.map xlate_one_unfold_block unf_list in
+     (match ct_unf_list with
+      | first :: others -> CT_unfold (CT_unfold_ne_list (first, others))
+      | [] -> error "there should be at least one thing to unfold")
+  | Fold formula_list -> 
+      CT_fold(CT_formula_list(List.map xlate_formula formula_list))
+  | Pattern l ->
+     let pat_list = List.map (fun (nums,c) ->
+          CT_pattern_occ
+           (CT_int_list (List.map (fun x -> CT_int x) nums),
+            xlate_formula c)) l in
+     (match pat_list with
+      | first :: others -> CT_pattern (CT_pattern_ne_list (first, others))
+      | [] -> error "Expecting at least one pattern in a Pattern command")
+  | ExtraRedExpr _ -> xlate_error "TODO LATER: ExtraRedExpr (probably dead code)"
+
+and xlate_local_rec_tac = function 
+ (* TODO LATER: local recursive tactics and global ones should be handled in
+    the same manner *)
+  | ((_,x),(argl,tac)) ->
+      let fst, rest = xlate_largs_to_id_opt argl in
+	CT_rec_tactic_fun(xlate_ident x,
+			  CT_id_opt_ne_list(fst, rest),
+			  xlate_tactic tac)
+
+and xlate_tactic =
+ function
+   | TacFun (largs, t) ->
+       let fst, rest =  xlate_largs_to_id_opt largs in
+       CT_tactic_fun (CT_id_opt_ne_list(fst, rest), xlate_tactic t)
+   | TacThen (t1,t2) -> 
+       (match xlate_tactic t1 with
+            CT_then(a,l) -> CT_then(a,l@[xlate_tactic t2])
+	  | t -> CT_then (t,[xlate_tactic t2]))
+   | TacThens(t1,[]) -> assert false
+   | TacThens(t1,t::l) ->
+       let ct = xlate_tactic t in
+       let cl = List.map xlate_tactic l in
+       (match xlate_tactic t1 with
+	    CT_then(ct1,cl1) -> CT_then(ct1, cl1@[CT_parallel(ct, cl)])
+	  | ct1 -> CT_then(ct1,[CT_parallel(ct, cl)]))
+   | TacFirst([]) -> assert false
+   | TacFirst(t1::l)-> CT_first(xlate_tactic t1, List.map xlate_tactic l)
+   | TacSolve([]) -> assert false
+   | TacSolve(t1::l)-> CT_tacsolve(xlate_tactic t1, List.map xlate_tactic l)
+   | TacDo(count, t) -> CT_do(xlate_id_or_int count, xlate_tactic t)
+   | TacTry t -> CT_try (xlate_tactic t)
+   | TacRepeat t -> CT_repeat(xlate_tactic t)
+   | TacAbstract(t,id_opt) -> 
+       CT_abstract((match id_opt with
+		       	None -> ctv_ID_OPT_NONE
+		      | Some id -> ctf_ID_OPT_SOME (CT_ident (string_of_id id))),
+		   xlate_tactic t)
+   | TacProgress t -> CT_progress(xlate_tactic t)
+   | TacOrelse(t1,t2) -> CT_orelse(xlate_tactic t1, xlate_tactic t2)
+   | TacMatch (exp, rules) ->
+        CT_match_tac(xlate_tactic exp,
+                     match List.map 
+                       (function 
+                          | Pat ([],p,tac) ->
+                              CT_match_tac_rule(xlate_context_pattern p,
+                                                mk_let_value tac)
+                          | Pat (_,p,tac) -> xlate_error"No hyps in pure Match"
+                          | All tac ->
+                              CT_match_tac_rule
+                                (CT_coerce_FORMULA_to_CONTEXT_PATTERN
+                                   CT_existvarc, 
+                                   mk_let_value tac)) rules with
+                         | [] -> assert false
+                         | fst::others ->
+                             CT_match_tac_rules(fst, others))
+   | TacMatchContext (_,[]) -> failwith ""
+   | TacMatchContext (false,rule1::rules) ->
+         CT_match_context(xlate_context_rule rule1,
+                          List.map xlate_context_rule rules)
+   | TacMatchContext (true,rule1::rules) ->
+         CT_match_context_reverse(xlate_context_rule rule1,
+                          List.map xlate_context_rule rules)
+   | TacLetIn (l, t) ->
+       let cvt_clause =
+         function
+             ((_,s),None,ConstrMayEval v) ->
+                 CT_let_clause(xlate_ident s,
+			       CT_coerce_NONE_to_TACTIC_OPT CT_none,
+                               CT_coerce_DEF_BODY_to_LET_VALUE
+                               (formula_to_def_body v))
+           | ((_,s),None,Tacexp t) -> 
+                 CT_let_clause(xlate_ident s,
+			       CT_coerce_NONE_to_TACTIC_OPT CT_none,
+                               CT_coerce_TACTIC_COM_to_LET_VALUE
+                               (xlate_tactic t))
+           | ((_,s),None,t) -> 
+                 CT_let_clause(xlate_ident s,
+			       CT_coerce_NONE_to_TACTIC_OPT CT_none,
+                               CT_coerce_TACTIC_COM_to_LET_VALUE
+                               (xlate_call_or_tacarg t))
+           | ((_,s),Some c,t) -> 
+	       CT_let_clause(xlate_ident s,
+			     CT_coerce_TACTIC_COM_to_TACTIC_OPT(xlate_tactic c),
+                               CT_coerce_TACTIC_COM_to_LET_VALUE
+				 (xlate_call_or_tacarg t)) in
+         let cl_l = List.map cvt_clause l in
+         (match cl_l with
+            | [] -> assert false 
+            | fst::others ->
+                CT_let_ltac (CT_let_clauses(fst, others), mk_let_value t))
+   | TacLetRecIn([], _) -> xlate_error "recursive definition with no definition"
+   | TacLetRecIn(f1::l, t) -> 
+       let tl =  CT_rec_tactic_fun_list
+		   (xlate_local_rec_tac f1, List.map xlate_local_rec_tac l) in
+       CT_rec_tactic_in(tl, xlate_tactic t)
+   | TacAtom (_, t) -> xlate_tac t 
+   | TacFail (count, "") -> CT_fail(xlate_id_or_int count, ctf_STRING_OPT_NONE)
+   | TacFail (count, s) -> CT_fail(xlate_id_or_int count,
+				   ctf_STRING_OPT_SOME (CT_string s))
+   | TacId "" -> CT_idtac ctf_STRING_OPT_NONE
+   | TacId s -> CT_idtac(ctf_STRING_OPT_SOME (CT_string s))
+   | TacInfo t -> CT_info(xlate_tactic t)
+   | TacArg a -> xlate_call_or_tacarg a
+
+and xlate_tac =
+  function
+    | TacExtend (_, "firstorder", tac_opt::l) ->
+       let t1 = match out_gen (wit_opt rawwit_tactic) tac_opt with
+	 | None -> CT_coerce_NONE_to_TACTIC_OPT CT_none
+	 | Some t2 -> CT_coerce_TACTIC_COM_to_TACTIC_OPT (xlate_tactic t2) in
+	 (match l with
+	      [] -> CT_firstorder t1
+	    | [l1] -> 
+		(match genarg_tag l1 with
+		     List1ArgType PreIdentArgType -> 
+		       let l2 = List.map 
+				  (fun x -> CT_ident x)
+				  (out_gen (wit_list1 rawwit_pre_ident) l1) in
+		       let fst,l3 = 
+			 match l2 with fst::l3 -> fst,l3 | [] -> assert false in
+		      	 CT_firstorder_using(t1, CT_id_ne_list(fst, l3))
+		   | List1ArgType RefArgType ->
+		       let l2 = List.map reference_to_ct_ID 
+				  (out_gen (wit_list1 rawwit_ref) l1) in
+		       let fst,l3 =
+			 match  l2 with fst::l3 -> fst, l3 | [] -> assert false in
+			 CT_firstorder_with(t1, CT_id_ne_list(fst, l3))
+		   | _ -> assert false)
+	    | _ -> assert false)
+    | TacExtend (_, "refine", [c]) ->
+       CT_refine (xlate_formula (out_gen rawwit_casted_open_constr c))
+    | TacExtend (_,"absurd",[c]) ->
+       CT_absurd (xlate_formula (out_gen rawwit_constr c))
+    | TacExtend (_,"contradiction",[opt_c]) ->
+	(match out_gen (wit_opt rawwit_constr_with_bindings) opt_c with
+	     None -> CT_contradiction
+	   | Some(c, b) ->
+	       let c1 = xlate_formula c in
+	       let bindings = xlate_bindings b in
+		 CT_contradiction_thm(c1, bindings))
+    | TacChange (None, f, b) -> CT_change (xlate_formula f, xlate_clause b)
+    | TacChange (Some(l,c), f, b) -> 
+	(* TODO LATER: combine with other constructions of pattern_occ *)
+	CT_change_local(
+	  CT_pattern_occ(CT_int_list(List.map (fun n -> CT_int n) l), 
+			 xlate_formula c),
+	  xlate_formula f,
+	  xlate_clause b)
+    | TacExtend (_,"contradiction",[]) -> CT_contradiction
+    | TacDoubleInduction (n1, n2) ->
+	CT_tac_double (xlate_quantified_hypothesis n1, xlate_quantified_hypothesis n2)
+    | TacExtend (_,"discriminate", [idopt]) ->
+     CT_discriminate_eq
+         (xlate_quantified_hypothesis_opt
+	    (out_gen (wit_opt rawwit_quant_hyp) idopt))
+    | TacExtend (_,"deq", [idopt]) ->
+	let idopt1 = out_gen (wit_opt rawwit_quant_hyp) idopt in
+	let idopt2 = match idopt1 with
+	    None -> CT_coerce_ID_OPT_to_ID_OR_INT_OPT
+		(CT_coerce_NONE_to_ID_OPT CT_none)
+	  | Some v ->
+	      CT_coerce_ID_OR_INT_to_ID_OR_INT_OPT
+	      	(xlate_quantified_hypothesis v) in
+	  CT_simplify_eq idopt2
+    | TacExtend (_,"injection", [idopt]) ->
+     CT_injection_eq
+         (xlate_quantified_hypothesis_opt
+	    (out_gen (wit_opt rawwit_quant_hyp) idopt))
+    | TacFix (idopt, n) ->
+     CT_fixtactic (xlate_ident_opt idopt, CT_int n, CT_fix_tac_list [])
+    | TacMutualFix (id, n, fixtac_list) ->
+     let f (id,n,c) = CT_fixtac (xlate_ident id, CT_int n, xlate_formula c) in
+     CT_fixtactic
+      (ctf_ID_OPT_SOME (xlate_ident id), CT_int n,
+      CT_fix_tac_list (List.map f fixtac_list))
+    | TacCofix idopt ->
+       CT_cofixtactic (xlate_ident_opt idopt, CT_cofix_tac_list [])
+    | TacMutualCofix (id, cofixtac_list) ->
+     let f (id,c) = CT_cofixtac (xlate_ident id, xlate_formula c) in
+     CT_cofixtactic
+      (CT_coerce_ID_to_ID_OPT (xlate_ident id),
+      CT_cofix_tac_list (List.map f cofixtac_list))
+    | TacIntrosUntil (NamedHyp id) -> 
+	CT_intros_until (CT_coerce_ID_to_ID_OR_INT (xlate_ident id))
+    | TacIntrosUntil (AnonHyp n) -> 
+	CT_intros_until (CT_coerce_INT_to_ID_OR_INT (CT_int n))
+    | TacIntroMove (Some id1, Some (_,id2)) ->
+     CT_intro_after(CT_coerce_ID_to_ID_OPT (xlate_ident id1),xlate_ident id2)
+    | TacIntroMove (None, Some (_,id2)) ->
+	CT_intro_after(CT_coerce_NONE_to_ID_OPT CT_none, xlate_ident id2)
+    | TacMove (true, id1, id2) ->
+	CT_move_after(xlate_hyp id1, xlate_hyp id2)
+    | TacMove (false, id1, id2) -> xlate_error "Non dep Move is only internal"
+    | TacIntroPattern patt_list ->
+	CT_intros
+	  (CT_intro_patt_list (List.map xlate_intro_pattern patt_list))
+    | TacIntroMove (Some id, None) ->
+     CT_intros (CT_intro_patt_list[CT_coerce_ID_to_INTRO_PATT(xlate_ident id)])
+    | TacIntroMove (None, None) ->  CT_intro (CT_coerce_NONE_to_ID_OPT CT_none)
+    | TacLeft bindl -> CT_left (xlate_bindings bindl)
+    | TacRight bindl -> CT_right (xlate_bindings bindl)
+    | TacSplit (false,bindl) -> CT_split (xlate_bindings bindl)
+    | TacSplit (true,bindl) -> CT_exists (xlate_bindings bindl)
+    | TacExtend (_,"replace", [c1; c2]) ->
+     let c1 = xlate_formula (out_gen rawwit_constr c1) in
+     let c2 = xlate_formula (out_gen rawwit_constr c2) in
+     CT_replace_with (c1, c2)
+    | TacExtend (_,"rewrite", [b; cbindl]) ->
+     let b = out_gen Extraargs.rawwit_orient b in
+     let (c,bindl) = out_gen rawwit_constr_with_bindings cbindl in
+     let c = xlate_formula c and bindl = xlate_bindings bindl in
+     if b then CT_rewrite_lr (c, bindl, ctv_ID_OPT_NONE)
+     else CT_rewrite_rl (c, bindl, ctv_ID_OPT_NONE)
+    | TacExtend (_,"rewritein", [b; cbindl; id]) ->
+     let b = out_gen Extraargs.rawwit_orient b in
+     let (c,bindl) = out_gen rawwit_constr_with_bindings cbindl in
+     let c = xlate_formula c and bindl = xlate_bindings bindl in
+     let id = ctf_ID_OPT_SOME (xlate_ident (out_gen rawwit_ident id)) in
+     if b then CT_rewrite_lr (c, bindl, id)
+     else CT_rewrite_rl (c, bindl, id)
+    | TacExtend (_,"conditionalrewrite", [t; b; cbindl]) ->
+     let t = out_gen rawwit_tactic t in
+     let b = out_gen Extraargs.rawwit_orient b in
+     let (c,bindl) = out_gen rawwit_constr_with_bindings cbindl in
+     let c = xlate_formula c and bindl = xlate_bindings bindl in
+     if b then CT_condrewrite_lr (xlate_tactic t, c, bindl, ctv_ID_OPT_NONE)
+     else CT_condrewrite_rl (xlate_tactic t, c, bindl, ctv_ID_OPT_NONE)
+    | TacExtend (_,"conditionalrewritein", [t; b; cbindl; id]) ->
+     let t = out_gen rawwit_tactic t in
+     let b = out_gen Extraargs.rawwit_orient b in
+     let (c,bindl) = out_gen rawwit_constr_with_bindings cbindl in
+     let c = xlate_formula c and bindl = xlate_bindings bindl in
+     let id = ctf_ID_OPT_SOME (xlate_ident (out_gen rawwit_ident id)) in
+     if b then CT_condrewrite_lr (xlate_tactic t, c, bindl, id)
+     else CT_condrewrite_rl (xlate_tactic t, c, bindl, id)
+    | TacExtend (_,"dependentrewrite", [b; id_or_constr]) ->
+      let b = out_gen Extraargs.rawwit_orient b in
+      (match genarg_tag id_or_constr with
+	| IdentArgType -> (*Dependent Rewrite/SubstHypInConcl*)
+	    let id = xlate_ident (out_gen rawwit_ident id_or_constr) in
+	    if b then CT_deprewrite_lr id else CT_deprewrite_rl id
+	| ConstrArgType -> (*CutRewrite/SubstConcl*)
+	    let c = xlate_formula (out_gen rawwit_constr id_or_constr) in
+	    if b then CT_cutrewrite_lr (c, ctv_ID_OPT_NONE)
+	    else CT_cutrewrite_rl (c, ctv_ID_OPT_NONE)
+	| _ -> xlate_error "")
+    | TacExtend (_,"dependentrewrite", [b; c; id]) -> (*CutRewrite in/SubstHyp*)
+      let b = out_gen Extraargs.rawwit_orient b in
+      let c = xlate_formula (out_gen rawwit_constr c) in
+      let id = xlate_ident (out_gen rawwit_ident id) in
+      if b then CT_cutrewrite_lr (c, ctf_ID_OPT_SOME id)
+      else CT_cutrewrite_lr (c, ctf_ID_OPT_SOME id)
+    | TacExtend(_, "subst", [l]) ->
+	CT_subst
+	  (CT_id_list
+	     (List.map (fun x -> CT_ident (string_of_id x))
+		(out_gen (wit_list1 rawwit_ident) l)))
+    | TacReflexivity -> CT_reflexivity
+    | TacSymmetry cls -> CT_symmetry(xlate_clause cls)
+    | TacTransitivity c -> CT_transitivity (xlate_formula c)
+    | TacAssumption -> CT_assumption
+    | TacExact c -> CT_exact (xlate_formula c)
+    | TacDestructHyp (true, (_,id)) -> CT_cdhyp (xlate_ident id)
+    | TacDestructHyp (false, (_,id)) -> CT_dhyp (xlate_ident id)
+    | TacDestructConcl -> CT_dconcl
+    | TacSuperAuto (nopt,l,a3,a4) ->
+      CT_superauto(
+        xlate_int_opt nopt,
+        xlate_qualid_list l,
+        (if a3 then CT_destructing else CT_coerce_NONE_to_DESTRUCTING CT_none),
+        (if a4 then CT_usingtdb else CT_coerce_NONE_to_USINGTDB CT_none))
+    | TacAutoTDB nopt -> CT_autotdb (xlate_int_opt nopt)
+    | TacAuto (nopt, Some []) -> CT_auto (xlate_int_opt nopt)
+    | TacAuto (nopt, None) ->
+ 	CT_auto_with (xlate_int_opt nopt,
+		      CT_coerce_STAR_to_ID_NE_LIST_OR_STAR CT_star)
+    | TacAuto (nopt, Some (id1::idl)) ->
+	CT_auto_with(xlate_int_opt nopt,
+             CT_coerce_ID_NE_LIST_to_ID_NE_LIST_OR_STAR(
+             CT_id_ne_list(CT_ident id1, List.map (fun x -> CT_ident x) idl)))
+    |TacExtend(_, ("autorewritev7"|"autorewritev8"), l::t) ->
+       let (id_list:ct_ID list) =
+	 List.map (fun x -> CT_ident x) (out_gen (wit_list1 rawwit_pre_ident) l) in
+       let fst, (id_list1: ct_ID list) =
+	 match id_list with [] -> assert false | a::tl -> a,tl in
+       let t1 =
+	 match t with
+	     [t0] -> 
+	       CT_coerce_TACTIC_COM_to_TACTIC_OPT
+		 (xlate_tactic(out_gen rawwit_tactic t0))
+	   | [] -> CT_coerce_NONE_to_TACTIC_OPT CT_none
+	   | _ -> assert false in
+	 CT_autorewrite (CT_id_ne_list(fst, id_list1), t1)
+    | TacExtend (_,"eauto", [nopt; popt; idl]) ->
+	let first_n =
+	  match out_gen (wit_opt rawwit_int_or_var) nopt with
+	    | Some (ArgVar(_, s)) -> xlate_id_to_id_or_int_opt s
+	    | Some ArgArg n -> xlate_int_to_id_or_int_opt n
+	    | None -> none_in_id_or_int_opt in
+	let second_n =
+	  match out_gen (wit_opt rawwit_int_or_var) popt with
+	    | Some (ArgVar(_, s)) -> xlate_id_to_id_or_int_opt s
+	    | Some ArgArg n -> xlate_int_to_id_or_int_opt n
+	    | None -> none_in_id_or_int_opt in
+	let idl = out_gen Eauto.rawwit_hintbases idl in
+          (match idl with
+	    None -> CT_eauto_with(first_n,
+				  second_n,
+				  CT_coerce_STAR_to_ID_NE_LIST_OR_STAR CT_star)
+	  | Some [] -> CT_eauto(first_n, second_n)
+	  | Some (a::l) -> 
+	      CT_eauto_with(first_n, second_n,
+			    CT_coerce_ID_NE_LIST_to_ID_NE_LIST_OR_STAR
+			      (CT_id_ne_list
+				 (CT_ident a,
+				  List.map (fun x -> CT_ident x) l))))
+    | TacExtend (_,"prolog", [cl; n]) ->
+      let cl = List.map xlate_formula (out_gen (wit_list0 rawwit_constr) cl) in
+      (match out_gen wit_int_or_var n with
+	| ArgVar _ -> xlate_error ""
+	| ArgArg n -> CT_prolog (CT_formula_list cl, CT_int  n))
+    | TacExtend (_,"eapply", [cbindl]) ->
+     let (c,bindl) = out_gen rawwit_constr_with_bindings cbindl in
+     let c = xlate_formula c and bindl = xlate_bindings bindl in
+     CT_eapply (c, bindl)
+    | TacTrivial (Some []) -> CT_trivial
+    | TacTrivial None -> 
+	CT_trivial_with(CT_coerce_STAR_to_ID_NE_LIST_OR_STAR CT_star)
+    | TacTrivial (Some (id1::idl)) ->
+	 CT_trivial_with(CT_coerce_ID_NE_LIST_to_ID_NE_LIST_OR_STAR(
+            (CT_id_ne_list(CT_ident id1,List.map (fun x -> CT_ident x) idl))))
+    | TacReduce (red, l) ->
+     CT_reduce (xlate_red_tactic red, xlate_clause l)
+    | TacApply (c,bindl) ->
+     CT_apply (xlate_formula c, xlate_bindings bindl)
+    | TacConstructor (n_or_meta, bindl) ->
+	let n = match n_or_meta with AI n -> n | MetaId _ -> xlate_error ""
+	in CT_constructor (CT_int n, xlate_bindings bindl)
+    | TacSpecialize (nopt, (c,sl)) ->
+     CT_specialize (xlate_int_opt nopt, xlate_formula c, xlate_bindings sl)
+    | TacGeneralize [] -> xlate_error ""
+    | TacGeneralize (first :: cl) ->
+     CT_generalize
+      (CT_formula_ne_list (xlate_formula first, List.map xlate_formula cl))
+    | TacGeneralizeDep c ->
+	CT_generalize_dependent (xlate_formula c)
+    | TacElimType c -> CT_elim_type (xlate_formula c)
+    | TacCaseType c -> CT_case_type (xlate_formula c)
+    | TacElim ((c1,sl), u) ->
+     CT_elim (xlate_formula c1, xlate_bindings sl, xlate_using u)
+    | TacCase (c1,sl) ->
+     CT_casetac (xlate_formula c1, xlate_bindings sl)
+    | TacSimpleInduction (h,_) -> CT_induction (xlate_quantified_hypothesis h)
+    | TacSimpleDestruct h -> CT_destruct (xlate_quantified_hypothesis h)
+    | TacCut c -> CT_cut (xlate_formula c)
+    | TacLApply c -> CT_use (xlate_formula c)
+    | TacDecompose ([],c) ->
+	xlate_error "Decompose : empty list of identifiers?"
+    | TacDecompose (id::l,c) ->
+	let id' = tac_qualid_to_ct_ID id in
+	let l' = List.map tac_qualid_to_ct_ID l in
+        CT_decompose_list(CT_id_ne_list(id',l'),xlate_formula c)
+    | TacDecomposeAnd c -> CT_decompose_record (xlate_formula c)
+    | TacDecomposeOr c -> CT_decompose_sum(xlate_formula c)
+    | TacClear [] ->
+	xlate_error "Clear expects a non empty list of identifiers"
+    | TacClear (id::idl) ->
+       let idl' = List.map xlate_hyp idl in
+       CT_clear (CT_id_ne_list (xlate_hyp id, idl'))
+    | (*For translating tactics/Inv.v *)
+      TacInversion (NonDepInversion (k,idl,l),quant_hyp) ->
+	CT_inversion(compute_INV_TYPE k, xlate_quantified_hypothesis quant_hyp,
+		     xlate_intro_patt_opt l,
+	             CT_id_list (List.map xlate_hyp idl))
+    | TacInversion (DepInversion (k,copt,l),quant_hyp) ->
+	let id = xlate_quantified_hypothesis quant_hyp in
+	CT_depinversion (compute_INV_TYPE k, id, 
+			 xlate_intro_patt_opt l, xlate_formula_opt copt)
+    | TacInversion (InversionUsing (c,idlist), id) ->
+	let id = xlate_quantified_hypothesis id in
+	  CT_use_inversion (id, xlate_formula c,
+	    CT_id_list (List.map xlate_hyp idlist))
+    | TacExtend (_,"omega", []) -> CT_omega
+    | TacRename (id1, id2) -> CT_rename(xlate_hyp id1, xlate_hyp id2)
+    | TacClearBody([]) -> assert false
+    | TacClearBody(a::l) -> 
+	CT_clear_body (CT_id_ne_list (xlate_hyp a, List.map xlate_hyp l))
+    | TacDAuto (a, b) -> CT_dauto(xlate_int_opt a, xlate_int_opt b)
+    | TacNewDestruct(a,b,(c,_)) ->
+	CT_new_destruct
+	  (xlate_int_or_constr a, xlate_using b, 
+	   xlate_intro_patt_opt c)
+    | TacNewInduction(a,b,(c,_)) ->
+	CT_new_induction
+	  (xlate_int_or_constr a, xlate_using b,
+	   xlate_intro_patt_opt c)
+    | TacInstantiate (a, b, cl) -> 
+        CT_instantiate(CT_int a, xlate_formula b,
+		       xlate_clause cl)
+    | TacLetTac (na, c, cl) ->
+        CT_lettac(xlate_id_opt ((0,0),na), xlate_formula c, 
+		  (* TODO LATER: This should be shared with Unfold,
+		     but the structures are different *)
+		  xlate_clause cl)
+    | TacForward (true, name, c) -> 
+               CT_pose(xlate_id_opt_aux name, xlate_formula c)
+    | TacForward (false, name, c) -> 
+               CT_assert(xlate_id_opt ((0,0),name), xlate_formula c)
+    | TacTrueCut (na, c) -> 
+        CT_truecut(xlate_id_opt ((0,0),na), xlate_formula c)
+    | TacAnyConstructor(Some tac) -> 
+	CT_any_constructor
+	(CT_coerce_TACTIC_COM_to_TACTIC_OPT(xlate_tactic tac))
+    | TacAnyConstructor(None) -> 
+	CT_any_constructor(CT_coerce_NONE_to_TACTIC_OPT CT_none)
+    | TacExtend(_, "ring", [args]) -> 
+	CT_ring
+	  (CT_formula_list
+	     (List.map xlate_formula
+		(out_gen (wit_list0 rawwit_constr) args)))
+    | TacExtend (_,id, l) ->
+     CT_user_tac (CT_ident id, CT_targ_list (List.map coerce_genarg_to_TARG l))
+    | TacAlias _ -> xlate_error "Alias not supported"
+
+and coerce_genarg_to_TARG x =
+ match Genarg.genarg_tag x with
+  (* Basic types *)
+  | BoolArgType -> xlate_error "TODO: generic boolean argument"
+  | IntArgType ->
+      let n = out_gen rawwit_int x in
+	CT_coerce_FORMULA_OR_INT_to_TARG
+	  (CT_coerce_ID_OR_INT_to_FORMULA_OR_INT
+	     (CT_coerce_INT_to_ID_OR_INT (CT_int n)))
+  | IntOrVarArgType ->
+      let x = match out_gen rawwit_int_or_var x with
+	| ArgArg n -> CT_coerce_INT_to_ID_OR_INT (CT_int n)
+	| ArgVar (_,id) -> CT_coerce_ID_to_ID_OR_INT (xlate_ident id) in
+	CT_coerce_FORMULA_OR_INT_to_TARG
+	  (CT_coerce_ID_OR_INT_to_FORMULA_OR_INT x)
+  | StringArgType ->
+     let s = CT_string (out_gen rawwit_string x) in
+       CT_coerce_SCOMMENT_CONTENT_to_TARG
+	 (CT_coerce_ID_OR_STRING_to_SCOMMENT_CONTENT
+	    (CT_coerce_STRING_to_ID_OR_STRING s))
+  | PreIdentArgType ->
+      let id = CT_ident (out_gen rawwit_pre_ident x) in
+	CT_coerce_FORMULA_OR_INT_to_TARG
+	  (CT_coerce_ID_OR_INT_to_FORMULA_OR_INT
+	     (CT_coerce_ID_to_ID_OR_INT id))
+  | IntroPatternArgType ->
+      xlate_error "TODO"
+  | IdentArgType ->
+      let id = xlate_ident (out_gen rawwit_ident x) in
+	CT_coerce_FORMULA_OR_INT_to_TARG
+	  (CT_coerce_ID_OR_INT_to_FORMULA_OR_INT
+	     (CT_coerce_ID_to_ID_OR_INT id))
+  | HypArgType ->
+      xlate_error "TODO (similar to IdentArgType)"
+  | RefArgType ->
+      let id = tac_qualid_to_ct_ID (out_gen rawwit_ref x) in
+	CT_coerce_FORMULA_OR_INT_to_TARG
+	  (CT_coerce_ID_OR_INT_to_FORMULA_OR_INT
+	     (CT_coerce_ID_to_ID_OR_INT id))
+  (* Specific types *)
+  | SortArgType ->
+      CT_coerce_SCOMMENT_CONTENT_to_TARG
+      (CT_coerce_FORMULA_to_SCOMMENT_CONTENT
+        (CT_coerce_SORT_TYPE_to_FORMULA (xlate_sort (out_gen rawwit_sort x))))
+  | ConstrArgType ->
+      CT_coerce_SCOMMENT_CONTENT_to_TARG
+      (CT_coerce_FORMULA_to_SCOMMENT_CONTENT (xlate_formula (out_gen rawwit_constr x)))
+  | ConstrMayEvalArgType -> xlate_error"TODO: generic constr-may-eval argument"
+  | QuantHypArgType ->xlate_error"TODO: generic quantified hypothesis argument"
+  | TacticArgType ->
+      let t = xlate_tactic (out_gen rawwit_tactic x) in
+      CT_coerce_TACTIC_COM_to_TARG t
+  | CastedOpenConstrArgType -> 
+      CT_coerce_SCOMMENT_CONTENT_to_TARG
+      	(CT_coerce_FORMULA_to_SCOMMENT_CONTENT(xlate_formula
+						 (out_gen
+						    rawwit_casted_open_constr x)))
+  | ConstrWithBindingsArgType -> xlate_error "TODO: generic constr with bindings"
+  | BindingsArgType -> xlate_error "TODO: generic with bindings"
+  | RedExprArgType -> xlate_error "TODO: generic red expr"
+  | List0ArgType l -> xlate_error "TODO: lists of generic arguments"
+  | List1ArgType l -> xlate_error "TODO: non empty lists of generic arguments"
+  | OptArgType x -> xlate_error "TODO: optional generic arguments"
+  | PairArgType (u,v) -> xlate_error "TODO: pairs of generic arguments"
+  | ExtraArgType s -> xlate_error "Cannot treat extra generic arguments"
+and xlate_context_rule =
+  function
+    | Pat (hyps, concl_pat, tactic) ->
+	CT_context_rule
+	  (CT_context_hyp_list (List.map xlate_match_context_hyps hyps),
+	   xlate_context_pattern concl_pat, xlate_tactic tactic)
+    | All tactic ->
+        CT_def_context_rule (xlate_tactic tactic)
+and formula_to_def_body =
+  function
+    | ConstrEval (red, f) ->
+        CT_coerce_EVAL_CMD_to_DEF_BODY(
+	CT_eval(CT_coerce_NONE_to_INT_OPT CT_none,
+                xlate_red_tactic red, xlate_formula f))
+    | ConstrContext((_, id), f) ->
+       	CT_coerce_CONTEXT_PATTERN_to_DEF_BODY
+	  (CT_context
+	     (CT_coerce_ID_to_ID_OPT (CT_ident (string_of_id id)),
+	      xlate_formula f))
+    | ConstrTypeOf f -> CT_type_of (xlate_formula f)
+    | ConstrTerm c -> ct_coerce_FORMULA_to_DEF_BODY(xlate_formula c)
+
+and mk_let_value = function 
+    TacArg (ConstrMayEval v) ->
+      CT_coerce_DEF_BODY_to_LET_VALUE(formula_to_def_body v)
+  | v -> CT_coerce_TACTIC_COM_to_LET_VALUE(xlate_tactic v);;
+
+let coerce_genarg_to_VARG x =
+ match Genarg.genarg_tag x with
+  (* Basic types *)
+  | BoolArgType -> xlate_error "TODO: generic boolean argument"
+  | IntArgType ->
+      let n = out_gen rawwit_int x in
+      CT_coerce_ID_OR_INT_OPT_to_VARG
+	(CT_coerce_INT_OPT_to_ID_OR_INT_OPT
+	   (CT_coerce_INT_to_INT_OPT (CT_int n)))
+  | IntOrVarArgType ->
+      (match out_gen rawwit_int_or_var x with
+	| ArgArg n -> 
+      CT_coerce_ID_OR_INT_OPT_to_VARG
+	(CT_coerce_INT_OPT_to_ID_OR_INT_OPT
+	   (CT_coerce_INT_to_INT_OPT (CT_int n)))
+	| ArgVar (_,id) ->
+	    CT_coerce_ID_OPT_OR_ALL_to_VARG
+	      (CT_coerce_ID_OPT_to_ID_OPT_OR_ALL
+	        (CT_coerce_ID_to_ID_OPT (xlate_ident id))))
+  | StringArgType ->
+     let s = CT_string (out_gen rawwit_string x) in
+     CT_coerce_STRING_OPT_to_VARG (CT_coerce_STRING_to_STRING_OPT s)
+  | PreIdentArgType ->
+      let id = CT_ident (out_gen rawwit_pre_ident x) in
+      CT_coerce_ID_OPT_OR_ALL_to_VARG
+	      (CT_coerce_ID_OPT_to_ID_OPT_OR_ALL
+	        (CT_coerce_ID_to_ID_OPT id))
+  | IntroPatternArgType ->
+      xlate_error "TODO"
+  | IdentArgType ->
+      let id = xlate_ident (out_gen rawwit_ident x) in
+      CT_coerce_ID_OPT_OR_ALL_to_VARG
+	      (CT_coerce_ID_OPT_to_ID_OPT_OR_ALL
+	        (CT_coerce_ID_to_ID_OPT id))
+  | HypArgType ->
+      xlate_error "TODO (similar to IdentArgType)"
+  | RefArgType ->
+      let id = tac_qualid_to_ct_ID (out_gen rawwit_ref x) in
+      CT_coerce_ID_OPT_OR_ALL_to_VARG
+	      (CT_coerce_ID_OPT_to_ID_OPT_OR_ALL
+	        (CT_coerce_ID_to_ID_OPT id))
+  (* Specific types *)
+  | SortArgType ->
+     CT_coerce_FORMULA_OPT_to_VARG 
+      (CT_coerce_FORMULA_to_FORMULA_OPT
+	(CT_coerce_SORT_TYPE_to_FORMULA (xlate_sort (out_gen rawwit_sort x))))
+  | ConstrArgType ->
+     CT_coerce_FORMULA_OPT_to_VARG 
+      (CT_coerce_FORMULA_to_FORMULA_OPT (xlate_formula (out_gen rawwit_constr x)))
+  | ConstrMayEvalArgType -> xlate_error"TODO: generic constr-may-eval argument"
+  | QuantHypArgType ->xlate_error"TODO: generic quantified hypothesis argument"
+  | TacticArgType ->
+      let t = xlate_tactic (out_gen rawwit_tactic x) in
+      CT_coerce_TACTIC_OPT_to_VARG (CT_coerce_TACTIC_COM_to_TACTIC_OPT t)
+  | CastedOpenConstrArgType -> xlate_error "TODO: generic open constr"
+  | ConstrWithBindingsArgType -> xlate_error "TODO: generic constr with bindings"
+  | BindingsArgType -> xlate_error "TODO: generic with bindings"
+  | RedExprArgType -> xlate_error "TODO: red expr as generic argument"
+  | List0ArgType l -> xlate_error "TODO: lists of generic arguments"
+  | List1ArgType l -> xlate_error "TODO: non empty lists of generic arguments"
+  | OptArgType x -> xlate_error "TODO: optional generic arguments"
+  | PairArgType (u,v) -> xlate_error "TODO: pairs of generic arguments"
+  | ExtraArgType s -> xlate_error "Cannot treat extra generic arguments"
+
+
+let xlate_thm x = CT_thm (match x with
+  | Theorem -> "Theorem"
+  | Remark -> "Remark"
+  | Lemma -> "Lemma"
+  | Fact -> "Fact")
+
+
+let xlate_defn x = CT_defn (match x with
+ | (Local, Definition) -> "Local"
+ | (Global, Definition) -> "Definition"
+ | (Global, SubClass) -> "SubClass"
+ | (Global, Coercion) -> "Coercion"
+ | (Local, SubClass) -> "Local SubClass"
+ | (Local, Coercion) -> "Local Coercion"
+ | (Global,CanonicalStructure) -> "Canonical Structure"
+ | (Local, CanonicalStructure) -> 
+     xlate_error "Local CanonicalStructure not parsed")
+
+let xlate_var x = CT_var (match x with
+ | (Global,Definitional) -> "Parameter"
+ | (Global,Logical) -> "Axiom"
+ | (Local,Definitional) -> "Variable"
+ | (Local,Logical) -> "Hypothesis"
+ | (Global,Conjectural) -> "Conjecture"
+ | (Local,Conjectural) -> xlate_error "No local conjecture");;
+
+
+let xlate_dep =
+ function
+    | true -> CT_dep "Induction for"
+    | false -> CT_dep "Minimality for";;
+
+let xlate_locn =
+ function
+    | GoTo n -> CT_coerce_INT_to_INT_OR_LOCN (CT_int n)
+    | GoTop -> CT_coerce_LOCN_to_INT_OR_LOCN (CT_locn "top")
+    | GoPrev -> CT_coerce_LOCN_to_INT_OR_LOCN (CT_locn "prev")
+    | GoNext -> CT_coerce_LOCN_to_INT_OR_LOCN (CT_locn "next")
+
+let xlate_search_restr =
+  function
+    | SearchOutside [] -> CT_coerce_NONE_to_IN_OR_OUT_MODULES CT_none
+    | SearchInside (m1::l1) ->
+	CT_in_modules (CT_id_ne_list(loc_qualid_to_ct_ID m1,
+	List.map loc_qualid_to_ct_ID l1))
+    | SearchOutside (m1::l1) ->
+	CT_out_modules (CT_id_ne_list(loc_qualid_to_ct_ID m1,
+	List.map loc_qualid_to_ct_ID l1))
+    | SearchInside [] -> xlate_error "bad extra argument for Search"
+
+let xlate_check =
+ function
+    | "CHECK" -> "Check"
+    | "PRINTTYPE" -> "Type"
+    | _ -> xlate_error "xlate_check";;
+
+let build_constructors l =
+ let f (coe,((_,id),c)) =
+   if coe then CT_constr_coercion (xlate_ident id, xlate_formula c)
+   else CT_constr (xlate_ident id, xlate_formula c) in
+ CT_constr_list (List.map f l)
+
+let build_record_field_list l =
+ let build_record_field (coe,d) = match d with
+  | AssumExpr (id,c) ->
+      if coe then CT_recconstr_coercion (xlate_id_opt id, xlate_formula c)
+      else
+	CT_recconstr(xlate_id_opt id, xlate_formula c)
+  | DefExpr (id,c,topt) ->
+      if coe then
+ 	CT_defrecconstr_coercion(xlate_id_opt id, xlate_formula c,
+			      xlate_formula_opt topt)
+      else
+ 	CT_defrecconstr(xlate_id_opt id, xlate_formula c, xlate_formula_opt topt) in
+ CT_recconstr_list (List.map build_record_field l);;
+
+let get_require_flags impexp spec =
+ let ct_impexp =
+  match impexp with
+  | None -> CT_coerce_NONE_to_IMPEXP CT_none
+  | Some false -> CT_import
+  | Some true -> CT_export in
+ let ct_spec =
+  match spec with
+  | None -> ctv_SPEC_OPT_NONE
+  | Some true -> CT_spec
+  | Some false -> ctv_SPEC_OPT_NONE in
+ ct_impexp, ct_spec;;
+
+let cvt_optional_eval_for_definition c1 optional_eval =
+  match optional_eval with
+    None -> ct_coerce_FORMULA_to_DEF_BODY (xlate_formula c1)
+  | Some red ->
+      CT_coerce_EVAL_CMD_to_DEF_BODY(
+      CT_eval(CT_coerce_NONE_to_INT_OPT CT_none,
+	      xlate_red_tactic red,
+	      xlate_formula c1))
+
+let cvt_vernac_binder = function
+  | b,(id::idl,c) ->
+      let l,t = 
+	CT_id_opt_ne_list 
+          (xlate_ident_opt (Some (snd id)),
+           List.map (fun id -> xlate_ident_opt (Some (snd id))) idl),
+          xlate_formula c in
+	if b then
+	  CT_binder_coercion(l,t)
+	else
+	  CT_binder(l,t)
+  | _, _ -> xlate_error "binder with no left part, rejected";;
+
+let cvt_vernac_binders = function
+    a::args -> CT_binder_ne_list(cvt_vernac_binder a, List.map cvt_vernac_binder args)
+  | [] -> assert false;;
+
+
+let xlate_comment = function
+    CommentConstr c -> CT_coerce_FORMULA_to_SCOMMENT_CONTENT(xlate_formula c)
+  | CommentString s -> CT_coerce_ID_OR_STRING_to_SCOMMENT_CONTENT
+      (CT_coerce_STRING_to_ID_OR_STRING(CT_string s))
+  | CommentInt n ->
+      CT_coerce_FORMULA_to_SCOMMENT_CONTENT
+	(CT_coerce_NUM_to_FORMULA(CT_int_encapsulator (string_of_int n)));;
+
+let translate_opt_notation_decl = function
+    None -> CT_coerce_NONE_to_DECL_NOTATION_OPT(CT_none)
+  |  Some(s, f, sc) ->
+       let tr_sc = 
+	 match sc with 
+	     None -> ctv_ID_OPT_NONE
+	   | Some id -> CT_coerce_ID_to_ID_OPT (CT_ident id) in
+       CT_decl_notation(CT_string s, xlate_formula f, tr_sc);;
+
+let xlate_level = function
+    Extend.NumLevel n -> CT_coerce_INT_to_INT_OR_NEXT(CT_int n)
+  | Extend.NextLevel -> CT_next_level;;
+
+let xlate_syntax_modifier = function
+    Extend.SetItemLevel((s::sl), level) ->
+      CT_set_item_level
+	(CT_id_ne_list(CT_ident s, List.map (fun s -> CT_ident s) sl),
+	 xlate_level level)
+  | Extend.SetItemLevel([], _) -> assert false
+  | Extend.SetLevel level -> CT_set_level (CT_int level)
+  | Extend.SetAssoc Gramext.LeftA -> CT_lefta
+  | Extend.SetAssoc Gramext.RightA -> CT_righta
+  | Extend.SetAssoc Gramext.NonA -> CT_nona
+  | Extend.SetEntryType(x,typ) ->
+      CT_entry_type(CT_ident x,
+		 match typ with
+		     Extend.ETIdent -> CT_ident "ident"
+		   | Extend.ETReference -> CT_ident "global"
+		   | Extend.ETBigint -> CT_ident "bigint"
+		   | _ -> xlate_error "syntax_type not parsed")
+  | Extend.SetOnlyParsing -> CT_only_parsing
+  | Extend.SetFormat(_,s) -> CT_format(CT_string s);;
+
+
+let rec xlate_module_type = function
+  | CMTEident(_, qid) -> 
+      CT_coerce_ID_to_MODULE_TYPE(CT_ident (xlate_qualid qid))
+  | CMTEwith(mty, decl) ->
+      let mty1 = xlate_module_type mty in
+	(match decl with
+	     CWith_Definition((_, id), c) ->
+	       CT_module_type_with_def(xlate_module_type mty, 
+				       xlate_ident id, xlate_formula c)
+	   | CWith_Module((_, id), (_, qid)) ->
+	       CT_module_type_with_mod(xlate_module_type mty,
+				       xlate_ident id, 
+				       CT_ident (xlate_qualid qid)));;
+
+let xlate_module_binder_list (l:module_binder list) =
+  CT_module_binder_list
+    (List.map (fun (idl, mty) ->
+		 let idl1 = 
+		   List.map (fun (_, x) -> CT_ident (string_of_id x)) idl in
+		 let fst,idl2 = match idl1 with
+		     [] -> assert false
+		   | fst::idl2 -> fst,idl2 in
+		 CT_module_binder
+		   (CT_id_ne_list(fst, idl2), xlate_module_type mty)) l);;
+
+let xlate_module_type_check_opt = function
+    None -> CT_coerce_MODULE_TYPE_OPT_to_MODULE_TYPE_CHECK
+ 	(CT_coerce_ID_OPT_to_MODULE_TYPE_OPT ctv_ID_OPT_NONE)
+  | Some(mty, true) -> CT_only_check(xlate_module_type mty)
+  | Some(mty, false) -> 
+      CT_coerce_MODULE_TYPE_OPT_to_MODULE_TYPE_CHECK
+	(CT_coerce_MODULE_TYPE_to_MODULE_TYPE_OPT
+	   (xlate_module_type mty));;
+
+let rec xlate_module_expr = function
+    CMEident (_, qid) -> CT_coerce_ID_OPT_to_MODULE_EXPR
+	(CT_coerce_ID_to_ID_OPT (CT_ident (xlate_qualid qid)))
+  | CMEapply (me1, me2) -> CT_module_app(xlate_module_expr me1,
+					 xlate_module_expr me2)
+
+let rec xlate_vernac =
+ function
+   | VernacDeclareTacticDefinition (true, tacs) ->
+       (match List.map 
+	 (function
+	      ((_, id), body) ->
+		CT_tac_def(CT_ident (string_of_id id), xlate_tactic body))
+	 tacs with
+	     [] -> assert false
+	   | fst::tacs1 ->
+	       CT_tactic_definition
+		 (CT_tac_def_ne_list(fst, tacs1)))
+   | VernacDeclareTacticDefinition(false, _) -> 
+       xlate_error "obsolete tactic definition not handled"
+    | VernacLoad (verbose,s) ->
+      CT_load (
+       (match verbose with
+        | false -> CT_coerce_NONE_to_VERBOSE_OPT CT_none
+        | true -> CT_verbose),
+       CT_coerce_STRING_to_ID_OR_STRING (CT_string s))
+    | VernacCheckMayEval (Some red, numopt, f) ->
+      let red = xlate_red_tactic red in
+      CT_coerce_EVAL_CMD_to_COMMAND
+       (CT_eval (xlate_int_opt numopt, red, xlate_formula f))
+    |VernacChdir opt_s -> CT_cd (ctf_STRING_OPT opt_s)
+    | VernacAddLoadPath (false,str,None) ->
+ 	CT_addpath (CT_string str, ctv_ID_OPT_NONE)
+    | VernacAddLoadPath (false,str,Some x) ->
+ 	CT_addpath (CT_string str,
+		    CT_coerce_ID_to_ID_OPT (CT_ident (string_of_dirpath x)))
+    | VernacAddLoadPath (true,str,None) ->
+ 	CT_recaddpath (CT_string str, ctv_ID_OPT_NONE)
+    | VernacAddLoadPath (_,str, Some x) ->
+	CT_recaddpath (CT_string str,
+		       CT_coerce_ID_to_ID_OPT (CT_ident (string_of_dirpath x)))
+    | VernacRemoveLoadPath str -> CT_delpath (CT_string str)
+    | VernacToplevelControl Quit -> CT_quit
+    | VernacToplevelControl _ -> xlate_error "Drop/ProtectedToplevel not supported"
+      (*ML commands *)
+    | VernacAddMLPath (false,str) -> CT_ml_add_path (CT_string str)
+    | VernacAddMLPath (true,str) -> CT_rec_ml_add_path (CT_string str)
+    | VernacDeclareMLModule [] -> failwith ""
+    | VernacDeclareMLModule (str :: l) ->
+      CT_ml_declare_modules
+       (CT_string_ne_list (CT_string str, List.map (fun x -> CT_string x) l))
+    | VernacGoal c ->
+	CT_coerce_THEOREM_GOAL_to_COMMAND (CT_goal (xlate_formula c))
+    | VernacAbort (Some (_,id)) ->
+	CT_abort(ctf_ID_OPT_OR_ALL_SOME(xlate_ident id))
+    | VernacAbort None -> CT_abort ctv_ID_OPT_OR_ALL_NONE
+    | VernacAbortAll -> CT_abort ctv_ID_OPT_OR_ALL_ALL
+    | VernacRestart -> CT_restart
+    | VernacSolve (n, tac, b) -> 
+	CT_solve (CT_int n, xlate_tactic tac,
+		  if b then CT_dotdot
+                  else CT_coerce_NONE_to_DOTDOT_OPT CT_none)
+    | VernacFocus nopt -> CT_focus (xlate_int_opt nopt)
+    | VernacUnfocus -> CT_unfocus
+    |VernacExtend("Extraction", [f;l]) ->
+       let file = out_gen rawwit_string f in
+       let l1 = out_gen (wit_list1 rawwit_ref) l in
+       let fst,l2 = match l1 with [] -> assert false | fst::l2 -> fst, l2 in
+	 CT_extract_to_file(CT_string file, 
+		       CT_id_ne_list(loc_qualid_to_ct_ID fst,
+				     List.map loc_qualid_to_ct_ID l2))
+    | VernacExtend("ExtractionInline", [l]) ->
+	let l1 = out_gen (wit_list1 rawwit_ref) l in
+	let fst, l2 = match l1 with [] -> assert false | fst ::l2 -> fst, l2 in
+	CT_inline(CT_id_ne_list(loc_qualid_to_ct_ID fst,
+				List.map loc_qualid_to_ct_ID l2))
+    | VernacExtend("ExtractionNoInline", [l]) ->
+	let l1 = out_gen (wit_list1 rawwit_ref) l in
+	let fst, l2 = match l1 with [] -> assert false | fst ::l2 -> fst, l2 in
+	CT_no_inline(CT_id_ne_list(loc_qualid_to_ct_ID fst,
+				List.map loc_qualid_to_ct_ID l2))
+    | VernacExtend("Field", 
+		   [a;aplus;amult;aone;azero;aopp;aeq;ainv;fth;ainvl;minusdiv]) ->
+	(match List.map (fun v -> xlate_formula(out_gen rawwit_constr v))
+                   [a;aplus;amult;aone;azero;aopp;aeq;ainv;fth;ainvl]
+ 	 with
+             [a1;aplus1;amult1;aone1;azero1;aopp1;aeq1;ainv1;fth1;ainvl1] ->
+	       let bind =
+		 match out_gen Field.rawwit_minus_div_arg minusdiv with
+		     None, None ->
+		       CT_binding_list[]
+		   | Some m, None ->
+		       CT_binding_list[
+			 CT_binding(CT_coerce_ID_to_ID_OR_INT (CT_ident "minus"), xlate_formula m)]
+		   | None, Some d ->
+		       CT_binding_list[
+			 CT_binding(CT_coerce_ID_to_ID_OR_INT (CT_ident "div"), xlate_formula d)]
+		   | Some m, Some d ->
+		       CT_binding_list[
+			 CT_binding(CT_coerce_ID_to_ID_OR_INT (CT_ident "minus"), xlate_formula m);
+			 CT_binding(CT_coerce_ID_to_ID_OR_INT (CT_ident "div"), xlate_formula d)] in
+		 CT_add_field(a1, aplus1, amult1, aone1, azero1, aopp1, aeq1,
+			      ainv1, fth1, ainvl1, bind)
+	   |_ -> assert false)
+  | VernacExtend (("HintRewriteV7"|"HintRewriteV8") as key, largs) ->
+      let in_v8 = (key = "HintRewriteV8") in
+      let orient = out_gen Extraargs.rawwit_orient (List.nth largs 0) in
+      let formula_list = out_gen (wit_list1 rawwit_constr) (List.nth largs 1) in
+      let t =
+	if List.length largs = 4 then
+	   out_gen rawwit_tactic (List.nth largs (if in_v8 then 2 else 3))
+	 else
+	   TacId "" in
+      let base = 
+	out_gen rawwit_pre_ident
+	  (if in_v8 then last largs else List.nth largs 2) in
+      let ct_orient = match orient with
+	| true  -> CT_lr
+	| false -> CT_rl in
+      let f_ne_list = match List.map xlate_formula formula_list with
+	  (fst::rest) -> CT_formula_ne_list(fst,rest)
+	| _ -> assert false in
+      CT_hintrewrite(ct_orient, f_ne_list, CT_ident base, xlate_tactic t)
+  | VernacHints (local,dbnames,h) ->
+      let dblist = CT_id_list(List.map (fun x -> CT_ident x) dbnames) in
+      (match h with
+	| HintsConstructors (None, l) ->
+	 let n1, names = match List.map tac_qualid_to_ct_ID l with
+	     n1 :: names -> n1, names
+	   | _  -> failwith "" in
+	   if local then
+	     CT_local_hints(CT_ident "Constructors",
+			    CT_id_ne_list(n1, names), dblist)
+	   else
+	     CT_hints(CT_ident "Constructors",
+		      CT_id_ne_list(n1, names), dblist)
+	| HintsExtern (None, n, c, t) ->
+	    CT_hint_extern(CT_int n, xlate_formula c, xlate_tactic t, dblist)
+        | HintsResolve l | HintsImmediate l -> 
+	    let l = 
+	      List.map 
+	     	(function (None, f) -> xlate_formula f
+		   | _ -> 
+		       xlate_error "obsolete Hint Resolve not supported") l in
+	 let f1, formulas = match l  with
+	     a :: tl -> a, tl
+	   | _  -> failwith "" in
+	 let l' = CT_formula_ne_list(f1, formulas) in
+	   if local then
+             (match h with 
+		  HintsResolve _ ->
+		    CT_local_hints_resolve(l', dblist)
+	       	| HintsImmediate _ ->
+		    CT_local_hints_immediate(l', dblist)
+	       	| _ -> assert false)
+	   else
+	     (match h with
+		  HintsResolve _ -> CT_hints_resolve(l', dblist)
+		| HintsImmediate _ -> CT_hints_immediate(l', dblist)
+		| _ -> assert false)
+        | HintsUnfold l -> 
+	 let l = List.map
+	   (function (None,ref) -> loc_qualid_to_ct_ID ref |
+	      _ -> xlate_error "obsolete Hint Unfold not supported") l in
+	 let n1, names = match l with
+	     n1 :: names -> n1, names
+	   | _  -> failwith "" in
+	   if local then
+             CT_local_hints(CT_ident "Unfold",
+			    CT_id_ne_list(n1, names), dblist)
+	   else	     
+             CT_hints(CT_ident "Unfold", CT_id_ne_list(n1, names), dblist)
+       	| HintsDestruct(id, n, loc, f, t) ->
+	    let dl = match loc with
+		ConclLocation() -> CT_conclusion_location
+	      | HypLocation true -> CT_discardable_hypothesis
+	      | HypLocation false -> CT_hypothesis_location in
+	     if local then
+               CT_local_hint_destruct
+		 (xlate_ident id, CT_int n,
+		  dl, xlate_formula f, xlate_tactic t, dblist)
+	     else
+	       CT_hint_destruct
+		 (xlate_ident id, CT_int n, dl, xlate_formula f,
+		  xlate_tactic t, dblist)
+	| HintsExtern(Some _, _, _, _)
+	| HintsConstructors(Some _, _) -> 
+            xlate_error "obsolete Hint Constructors not supported"
+)
+  | VernacEndProof (Proved (true,None)) ->
+      CT_save (CT_coerce_THM_to_THM_OPT (CT_thm "Theorem"), ctv_ID_OPT_NONE)
+  | VernacEndProof (Proved (false,None)) ->
+      CT_save (CT_coerce_THM_to_THM_OPT (CT_thm "Definition"), ctv_ID_OPT_NONE)
+  | VernacEndProof (Proved (b,Some ((_,s), Some kind))) ->
+      CT_save (CT_coerce_THM_to_THM_OPT (xlate_thm kind),
+       ctf_ID_OPT_SOME (xlate_ident s))
+  | VernacEndProof (Proved (b,Some ((_,s),None))) ->
+      CT_save (CT_coerce_THM_to_THM_OPT (CT_thm "Theorem"),
+       ctf_ID_OPT_SOME (xlate_ident s))
+  | VernacEndProof Admitted ->
+      CT_save (CT_coerce_THM_to_THM_OPT (CT_thm "Admitted"), ctv_ID_OPT_NONE)
+  | VernacSetOpacity (false, id :: idl) ->
+            CT_transparent(CT_id_ne_list(loc_qualid_to_ct_ID id,
+                   List.map loc_qualid_to_ct_ID idl))
+  | VernacSetOpacity (true, id :: idl)
+            -> CT_opaque (CT_id_ne_list(loc_qualid_to_ct_ID id,
+                   List.map loc_qualid_to_ct_ID idl))
+  | VernacSetOpacity (_, []) -> xlate_error "Shouldn't occur"
+  | VernacUndo n -> CT_undo (CT_coerce_INT_to_INT_OPT (CT_int n))
+  | VernacShow (ShowGoal nopt) -> CT_show_goal (xlate_int_opt nopt)
+  | VernacShow ShowNode -> CT_show_node
+  | VernacShow ShowProof -> CT_show_proof
+  | VernacShow ShowTree -> CT_show_tree
+  | VernacShow ShowProofNames -> CT_show_proofs
+  | VernacShow (ShowIntros true) -> CT_show_intros
+  | VernacShow (ShowIntros false) -> CT_show_intro
+  | VernacShow (ShowGoalImplicitly None) -> CT_show_implicit (CT_int 1)
+  | VernacShow (ShowGoalImplicitly (Some n)) -> CT_show_implicit (CT_int n)
+  | VernacShow ShowExistentials -> CT_show_existentials
+  | VernacShow ShowScript -> CT_show_script
+  | VernacGo arg -> CT_go (xlate_locn arg)
+  | VernacShow ExplainProof l -> CT_explain_proof (nums_to_int_list l)
+  | VernacShow ExplainTree l ->
+      CT_explain_prooftree (nums_to_int_list l)
+  | VernacCheckGuard -> CT_guarded
+  | VernacPrint p ->
+      (match p with
+	  PrintFullContext -> CT_print_all
+	| PrintName id -> CT_print_id (loc_qualid_to_ct_ID id)
+	| PrintOpaqueName id -> CT_print_opaqueid (loc_qualid_to_ct_ID id)
+	| PrintSectionContext id -> CT_print_section (loc_qualid_to_ct_ID id)
+	| PrintModules -> CT_print_modules
+	| PrintGrammar (phylum, name) -> CT_print_grammar CT_grammar_none
+	| PrintHintDb -> CT_print_hintdb (CT_coerce_STAR_to_ID_OR_STAR CT_star)
+	| PrintHintDbName id -> 
+	    CT_print_hintdb (CT_coerce_ID_to_ID_OR_STAR (CT_ident id))
+	| PrintHint id ->
+	    CT_print_hint (CT_coerce_ID_to_ID_OPT (loc_qualid_to_ct_ID id))
+	| PrintHintGoal -> CT_print_hint ctv_ID_OPT_NONE
+	| PrintLoadPath -> CT_print_loadpath
+	| PrintMLLoadPath -> CT_ml_print_path
+	| PrintMLModules -> CT_ml_print_modules
+	| PrintGraph -> CT_print_graph
+	| PrintClasses -> CT_print_classes
+	| PrintCoercions -> CT_print_coercions
+	| PrintCoercionPaths (id1, id2) -> 
+	    CT_print_path (xlate_class id1, xlate_class id2)
+	| PrintInspect n -> CT_inspect (CT_int n)
+	| PrintUniverses opt_s -> CT_print_universes(ctf_STRING_OPT opt_s)
+	| PrintLocalContext -> CT_print
+	| PrintTables -> CT_print_tables
+        | PrintModuleType a -> CT_print_module_type (loc_qualid_to_ct_ID a)
+        | PrintModule a -> CT_print_module (loc_qualid_to_ct_ID a)
+        | PrintScopes -> CT_print_scopes
+        | PrintScope id -> CT_print_scope (CT_ident id)
+	| PrintVisibility id_opt ->
+	    CT_print_visibility 
+	      (match id_opt with
+		   Some id -> CT_coerce_ID_to_ID_OPT(CT_ident id)
+		 | None -> ctv_ID_OPT_NONE)
+        | PrintAbout qid -> CT_print_about(loc_qualid_to_ct_ID qid)
+	| PrintImplicit qid -> CT_print_implicit(loc_qualid_to_ct_ID qid))
+  | VernacBeginSection (_,id) ->
+      CT_coerce_SECTION_BEGIN_to_COMMAND (CT_section (xlate_ident id))
+  | VernacEndSegment (_,id) -> CT_section_end (xlate_ident id)
+  | VernacStartTheoremProof (k, (_,s), (bl,c), _, _) ->
+      CT_coerce_THEOREM_GOAL_to_COMMAND(
+	CT_theorem_goal (CT_coerce_THM_to_DEFN_OR_THM (xlate_thm k), xlate_ident s,
+           xlate_binder_list bl, xlate_formula c))
+  | VernacSuspend -> CT_suspend
+  | VernacResume idopt -> CT_resume (xlate_ident_opt (option_app snd idopt))
+  | VernacDefinition (k,(_,s),ProveBody (bl,typ),_) ->
+      CT_coerce_THEOREM_GOAL_to_COMMAND
+	(CT_theorem_goal
+	   (CT_coerce_DEFN_to_DEFN_OR_THM (xlate_defn k),
+	    xlate_ident s, xlate_binder_list bl, xlate_formula typ))
+  | VernacDefinition (kind,(_,s),DefineBody(bl,red_option,c,typ_opt),_) ->
+      CT_definition
+	(xlate_defn kind, xlate_ident s, xlate_binder_list bl,
+	   cvt_optional_eval_for_definition c red_option,
+           xlate_formula_opt typ_opt)
+  | VernacAssumption (kind, b) ->
+      CT_variable (xlate_var kind, cvt_vernac_binders b)
+  | VernacCheckMayEval (None, numopt, c) ->
+      CT_check (xlate_formula c)
+  | VernacSearch (s,x) ->
+      let translated_restriction = xlate_search_restr x in
+      (match s with
+	| SearchPattern c ->
+	    CT_search_pattern(xlate_formula c, translated_restriction)
+	| SearchHead id ->
+	    CT_search(loc_qualid_to_ct_ID id, translated_restriction)
+	| SearchRewrite c ->
+	    CT_search_rewrite(xlate_formula c, translated_restriction)
+	| SearchAbout (a::l) ->
+	    let xlate_search_about_item it =
+	      match it with
+		  SearchRef x -> 
+		    CT_coerce_ID_to_ID_OR_STRING(loc_qualid_to_ct_ID x)
+		| SearchString s -> 
+		    CT_coerce_STRING_to_ID_OR_STRING(CT_string s) in
+	    CT_search_about
+	      (CT_id_or_string_ne_list(xlate_search_about_item a,
+				       List.map xlate_search_about_item l),
+	       translated_restriction)
+  	| SearchAbout [] -> assert false)
+
+  | (*Record from tactics/Record.v *)
+    VernacRecord 
+      (_, (add_coercion, (_,s)), binders, c1,
+       rec_constructor_or_none, field_list) ->
+      let record_constructor =
+        xlate_ident_opt (option_app snd rec_constructor_or_none) in
+      CT_record
+       ((if add_coercion then CT_coercion_atm else
+          CT_coerce_NONE_to_COERCION_OPT(CT_none)),
+        xlate_ident s, xlate_binder_list binders, 
+	xlate_formula c1, record_constructor,
+         build_record_field_list field_list)
+   | VernacInductive (isind, lmi) ->
+      let co_or_ind = if isind then "Inductive" else "CoInductive" in
+      let strip_mutind ((_,s), notopt, parameters, c, constructors) =
+          CT_ind_spec
+            (xlate_ident s, xlate_binder_list parameters, xlate_formula c,
+             build_constructors constructors,
+	     translate_opt_notation_decl notopt) in
+        CT_mind_decl
+	  (CT_co_ind co_or_ind, CT_ind_spec_list (List.map strip_mutind lmi))
+   | VernacFixpoint [] -> xlate_error "mutual recursive"
+   | VernacFixpoint (lm :: lmi) ->
+      let strip_mutrec ((fid, n, bl, arf, ardef), ntn) =
+        let (struct_arg,bl,arf,ardef) =
+         if bl = [] then
+           let (bl,arf,ardef) = Ppconstr.split_fix (n+1) arf ardef in
+           let bl = List.map (fun(nal,ty)->LocalRawAssum(nal,ty)) bl in
+           (xlate_id_opt(List.nth (names_of_local_assums bl) n),bl,arf,ardef)
+         else (make_fix_struct (n, bl),bl,arf,ardef) in
+        let arf = xlate_formula arf in
+        let ardef = xlate_formula ardef in
+	match xlate_binder_list bl with
+	  | CT_binder_list (b :: bl) ->
+	      CT_fix_rec (xlate_ident fid, CT_binder_ne_list (b, bl), 
+			  struct_arg, arf, ardef)
+          | _ -> xlate_error "mutual recursive" in
+        CT_fix_decl
+	  (CT_fix_rec_list (strip_mutrec lm, List.map strip_mutrec lmi))
+   | VernacCoFixpoint [] -> xlate_error "mutual corecursive"
+   | VernacCoFixpoint (lm :: lmi) ->
+      let strip_mutcorec (fid, bl, arf, ardef) =
+	CT_cofix_rec (xlate_ident fid, xlate_binder_list bl,
+                      xlate_formula arf, xlate_formula ardef) in
+        CT_cofix_decl
+	  (CT_cofix_rec_list (strip_mutcorec lm, List.map strip_mutcorec lmi))
+   | VernacScheme [] -> xlate_error "induction scheme"
+   | VernacScheme (lm :: lmi) ->
+      let strip_ind ((_,id), depstr, inde, sort) =
+           CT_scheme_spec
+            (xlate_ident id, xlate_dep depstr, 
+	    CT_coerce_ID_to_FORMULA (loc_qualid_to_ct_ID inde),
+	     xlate_sort sort) in
+        CT_ind_scheme
+	  (CT_scheme_spec_list (strip_ind lm, List.map strip_ind lmi))
+   | VernacSyntacticDefinition (id, c, false, _) ->
+       CT_syntax_macro (xlate_ident id, xlate_formula c, xlate_int_opt None)
+   | VernacSyntacticDefinition (id, c, true, _) ->
+       xlate_error "TODO: Local abbreviations"
+  (* Modules and Module Types *)
+  | VernacDeclareModuleType((_, id), bl, mty_o)  -> 
+      CT_module_type_decl(xlate_ident id,
+			  xlate_module_binder_list bl,
+			  match mty_o with
+			      None ->
+				CT_coerce_ID_OPT_to_MODULE_TYPE_OPT
+				  ctv_ID_OPT_NONE
+			    | Some mty1 ->
+				CT_coerce_MODULE_TYPE_to_MODULE_TYPE_OPT
+				  (xlate_module_type mty1))
+   | VernacDefineModule((_, id), bl, mty_o, mexpr_o) ->
+       CT_module(xlate_ident id, 
+		 xlate_module_binder_list bl,
+		 xlate_module_type_check_opt mty_o,
+		 match mexpr_o with
+		     None -> CT_coerce_ID_OPT_to_MODULE_EXPR ctv_ID_OPT_NONE
+		   | Some m -> xlate_module_expr m)
+  | VernacDeclareModule((_, id), bl, mty_o, mexpr_o) -> 
+       CT_declare_module(xlate_ident id, 
+		 xlate_module_binder_list bl,
+		 xlate_module_type_check_opt mty_o,
+		 match mexpr_o with
+		     None -> CT_coerce_ID_OPT_to_MODULE_EXPR ctv_ID_OPT_NONE
+		   | Some m -> xlate_module_expr m)
+   | VernacRequire (impexp, spec, id::idl) ->
+      let ct_impexp, ct_spec = get_require_flags impexp spec in
+      CT_require (ct_impexp, ct_spec, 
+		  CT_coerce_ID_NE_LIST_to_ID_NE_LIST_OR_STRING(
+		  CT_id_ne_list(loc_qualid_to_ct_ID id,
+				List.map loc_qualid_to_ct_ID idl)))
+   | VernacRequire (_,_,[]) ->
+       xlate_error "Require should have at least one id argument"
+   | VernacRequireFrom (impexp, spec, filename) ->
+      let ct_impexp, ct_spec = get_require_flags impexp spec in
+      CT_require(ct_impexp, ct_spec, 
+		 CT_coerce_STRING_to_ID_NE_LIST_OR_STRING(CT_string filename))
+
+   | VernacSyntax (phylum, l) -> xlate_error "SYNTAX not implemented"
+
+   | VernacOpenCloseScope(true, true, s) -> CT_local_open_scope(CT_ident s)
+   | VernacOpenCloseScope(false, true, s) -> CT_open_scope(CT_ident s)
+   | VernacOpenCloseScope(true, false, s) -> CT_local_close_scope(CT_ident s)
+   | VernacOpenCloseScope(false, false, s) -> CT_close_scope(CT_ident s)
+   | VernacArgumentsScope(qid, l) -> 
+       CT_arguments_scope(loc_qualid_to_ct_ID qid,
+		       CT_id_opt_list
+		       (List.map
+			  (fun x ->
+				  match x with
+				      None -> ctv_ID_OPT_NONE
+				    | Some x -> ctf_ID_OPT_SOME(CT_ident x)) l))
+   | VernacDelimiters(s1,s2) -> CT_delim_scope(CT_ident s1, CT_ident s2)
+   | VernacBindScope(id, a::l) -> 
+       let xlate_class_rawexpr = function
+	   FunClass -> CT_ident "Funclass" | SortClass -> CT_ident "Sortclass"
+	 | RefClass qid -> loc_qualid_to_ct_ID qid in
+       CT_bind_scope(CT_ident id,
+		     CT_id_ne_list(xlate_class_rawexpr a,
+				   List.map xlate_class_rawexpr l))
+   | VernacBindScope(id, []) -> assert false
+   | VernacNotation(b, c, None, _, _) -> assert false
+   | VernacNotation(b, c, Some(s,modif_list), _, opt_scope) -> 
+       let translated_s = CT_string s in
+       let formula = xlate_formula c in
+       let translated_modif_list = 
+	 CT_modifier_list(List.map xlate_syntax_modifier modif_list) in
+       let translated_scope = match opt_scope with
+	   None -> ctv_ID_OPT_NONE
+	 | Some x -> ctf_ID_OPT_SOME(CT_ident x) in
+       if b then
+       CT_local_define_notation
+	 (translated_s, formula, translated_modif_list, translated_scope)
+       else
+	 CT_define_notation(translated_s, formula, 
+			    translated_modif_list, translated_scope)
+   | VernacSyntaxExtension(b,Some(s,modif_list), None) -> 
+       let translated_s = CT_string s in
+       let translated_modif_list = 
+	 CT_modifier_list(List.map xlate_syntax_modifier modif_list) in
+       if b then
+	 CT_local_reserve_notation(translated_s, translated_modif_list)
+       else
+	 CT_reserve_notation(translated_s, translated_modif_list)
+   | VernacSyntaxExtension(_, _, _) -> assert false
+   | VernacInfix (b,(str,modl),id,_, opt_scope) ->
+       let id1 = loc_qualid_to_ct_ID id in
+       let modl1 = CT_modifier_list(List.map xlate_syntax_modifier modl) in
+       let s = CT_string str in
+       let translated_scope = match opt_scope with
+	   None -> ctv_ID_OPT_NONE
+	 | Some x -> ctf_ID_OPT_SOME(CT_ident x) in
+	 if b then
+	   CT_local_infix(s, id1,modl1, translated_scope)
+	 else
+	   CT_infix(s, id1,modl1, translated_scope)
+   | VernacGrammar _ -> xlate_error "GRAMMAR not implemented"
+   | VernacCoercion (s, id1, id2, id3) ->
+      let id_opt = CT_coerce_NONE_to_IDENTITY_OPT CT_none in
+      let local_opt =
+       match s with
+       (* Cannot decide whether it is a global or a Local but at toplevel *)
+       | Global -> CT_coerce_NONE_to_LOCAL_OPT CT_none
+       | Local -> CT_local in
+      CT_coercion (local_opt, id_opt, loc_qualid_to_ct_ID id1,
+        xlate_class id2, xlate_class id3)
+
+   | VernacIdentityCoercion (s, (_,id1), id2, id3) ->
+      let id_opt = CT_identity in
+      let local_opt =
+       match s with
+       (* Cannot decide whether it is a global or a Local but at toplevel *)
+       | Global -> CT_coerce_NONE_to_LOCAL_OPT CT_none
+       | Local -> CT_local in
+      CT_coercion (local_opt, id_opt, xlate_ident id1,
+        xlate_class id2, xlate_class id3)
+  | VernacResetName id -> CT_reset (xlate_ident (snd id))
+  | VernacResetInitial -> CT_restore_state (CT_ident "Initial")
+  | VernacExtend (s, l) ->
+      CT_user_vernac
+       (CT_ident s, CT_varg_list (List.map coerce_genarg_to_VARG l))
+  | VernacDebug b -> xlate_error "Debug On/Off not supported"
+  | VernacList((_, a)::l) -> 
+      CT_coerce_COMMAND_LIST_to_COMMAND
+	(CT_command_list(xlate_vernac a, 
+			 List.map (fun (_, x) -> xlate_vernac x) l))
+  | VernacList([]) -> assert false
+  | (VernacV7only _ | VernacV8only _) ->
+      xlate_error "Not treated here"
+  | VernacNop -> CT_proof_no_op
+  | VernacComments l -> 
+      CT_scomments(CT_scomment_content_list (List.map xlate_comment l))
+  | VernacDeclareImplicits(id, opt_positions) ->
+      CT_implicits
+	(reference_to_ct_ID id,
+	 match opt_positions with
+	     None -> CT_coerce_NONE_to_ID_LIST_OPT CT_none
+	   | Some l -> 
+	       CT_coerce_ID_LIST_to_ID_LIST_OPT
+	       (CT_id_list
+	       (List.map
+		  (function ExplByPos x
+		       -> xlate_error
+			   "explication argument by rank is obsolete"
+		     | ExplByName id -> CT_ident (string_of_id id)) l)))
+  | VernacReserve((_,a)::l, f) ->
+      CT_reserve(CT_id_ne_list(xlate_ident a, 
+			       List.map (fun (_,x) -> xlate_ident x) l),
+		 xlate_formula f)
+  | VernacReserve([], _) -> assert false
+  | VernacLocate(LocateTerm id) -> CT_locate(reference_to_ct_ID id)
+  | VernacLocate(LocateLibrary id) -> CT_locate_lib(reference_to_ct_ID id)
+  | VernacLocate(LocateFile s) -> CT_locate_file(CT_string s)
+  | VernacLocate(LocateNotation s) -> CT_locate_notation(CT_string s)
+  | VernacTime(v) -> CT_time(xlate_vernac v)
+  | VernacSetOption (Goptions.SecondaryTable ("Implicit", "Arguments"), BoolValue true)->CT_user_vernac (CT_ident "IMPLICIT_ARGS_ON", CT_varg_list[])
+  |VernacExactProof f -> CT_proof(xlate_formula f)
+  | VernacSetOption (table, BoolValue true) -> 
+      let table1 = 
+	match table with
+	    PrimaryTable(s) -> CT_coerce_ID_to_TABLE(CT_ident s)
+	  | SecondaryTable(s1,s2) -> CT_table(CT_ident s1, CT_ident s2) in
+	CT_set_option(table1)
+  | VernacSetOption (table, v) -> 
+      let table1 = 
+	match table with
+	    PrimaryTable(s) -> CT_coerce_ID_to_TABLE(CT_ident s)
+	  | SecondaryTable(s1,s2) -> CT_table(CT_ident s1, CT_ident s2) in
+      let value =
+	match v with
+	  | BoolValue _ -> assert false
+	  | StringValue s ->
+	      CT_coerce_STRING_to_SINGLE_OPTION_VALUE(CT_string s)
+	  | IntValue n ->
+	      CT_coerce_INT_to_SINGLE_OPTION_VALUE(CT_int n) in
+	CT_set_option_value(table1, value)
+  | VernacUnsetOption(table) ->
+      let table1 = 
+	match table with
+	    PrimaryTable(s) -> CT_coerce_ID_to_TABLE(CT_ident s)
+	  | SecondaryTable(s1,s2) -> CT_table(CT_ident s1, CT_ident s2) in
+	CT_unset_option(table1)
+  | VernacAddOption (table, l) ->
+      let values =
+	List.map
+	  (function
+	     | QualidRefValue x -> 
+		 CT_coerce_ID_to_ID_OR_STRING(loc_qualid_to_ct_ID x)
+	     | StringRefValue x -> 
+		 CT_coerce_STRING_to_ID_OR_STRING(CT_string x)) l in
+      let fst, values1 = 
+	match values with [] -> assert false | a::b -> (a,b) in
+      let table1 = 
+	match table with
+	    PrimaryTable(s) -> CT_coerce_ID_to_TABLE(CT_ident s)
+	  | SecondaryTable(s1,s2) -> CT_table(CT_ident s1, CT_ident s2) in
+	CT_set_option_value2(table1, CT_id_or_string_ne_list(fst, values1))
+  | VernacImport(true, a::l) ->
+      CT_export_id(CT_id_ne_list(reference_to_ct_ID a,
+				 List.map reference_to_ct_ID l))
+  | VernacImport(false, a::l) ->
+      CT_import_id(CT_id_ne_list(reference_to_ct_ID a,
+				 List.map reference_to_ct_ID l))
+  | VernacImport(_, []) -> assert false
+  | VernacProof t -> CT_proof_with(xlate_tactic t)
+  | VernacVar _ -> xlate_error "Grammar vernac obsolete"
+  | (VernacGlobalCheck _|VernacPrintOption _|
+     VernacMemOption (_, _)|VernacRemoveOption (_, _)
+  | VernacBack _|VernacRestoreState _| VernacWriteState _|
+    VernacSolveExistential (_, _)|VernacCanonical _ | VernacDistfix _|
+     VernacTacticGrammar _)
+    -> xlate_error "TODO: vernac";;
+
+let rec xlate_vernac_list =
+ function
+   | VernacList (v::l) ->
+       CT_command_list
+         (xlate_vernac (snd v), List.map (fun (_,x) -> xlate_vernac x) l)
+   | VernacV7only v -> 
+       if !Options.v7 then xlate_vernac_list v
+       else xlate_error "Unknown command"
+   | VernacList [] -> xlate_error "xlate_command_list"
+   | _ -> xlate_error "Not a list of commands";;
diff --git a/contrib/interface/xlate.mli b/contrib/interface/xlate.mli
new file mode 100644
index 00000000..bedb4ac8
--- /dev/null
+++ b/contrib/interface/xlate.mli
@@ -0,0 +1,9 @@
+open Ascent;;
+
+val xlate_vernac : Vernacexpr.vernac_expr -> ct_COMMAND;;
+val xlate_tactic : Tacexpr.raw_tactic_expr -> ct_TACTIC_COM;;
+val xlate_formula : Topconstr.constr_expr -> ct_FORMULA;;
+val xlate_ident : Names.identifier -> ct_ID;;
+val xlate_vernac_list : Vernacexpr.vernac_expr -> ct_COMMAND_LIST;;
+
+val declare_in_coq : (unit -> unit);;