Prepare merge into Coq

32 files changed, 0 insertions, 9439 deletions

diff --git a/src/dune b/src/dune
deleted file mode 100644
index 332f3644b0..0000000000
--- a/src/dune
+++ /dev/null
@@ -1,11 +0,0 @@
-(library
- (name ltac2_plugin)
- (public_name ltac2.plugin)
- (modules_without_implementation tac2expr tac2qexpr tac2types)
- (flags :standard -warn-error -9-27-50)
- (libraries coq.plugins.firstorder))
-
-(rule
- (targets g_ltac2.ml)
- (deps (:mlg-file g_ltac2.mlg))
- (action (run coqpp %{mlg-file})))
diff --git a/src/g_ltac2.mlg b/src/g_ltac2.mlg
deleted file mode 100644
index 0071dbb088..0000000000
--- a/src/g_ltac2.mlg
+++ /dev/null
@@ -1,933 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-{
-
-open Pp
-open Util
-open Names
-open Tok
-open Pcoq
-open Attributes
-open Constrexpr
-open Tac2expr
-open Tac2qexpr
-open Ltac_plugin
-
-let err () = raise Stream.Failure
-
-type lookahead = int -> Tok.t Stream.t -> int option
-
-let entry_of_lookahead s (lk : lookahead) =
-  let run strm = match lk 0 strm with None -> err () | Some _ -> () in
-  Pcoq.Entry.of_parser s run
-
-let (>>) (lk1 : lookahead) lk2 n strm = match lk1 n strm with
-| None -> None
-| Some n -> lk2 n strm
-
-let (<+>) (lk1 : lookahead) lk2 n strm = match lk1 n strm with
-| None -> lk2 n strm
-| Some n -> Some n
-
-let lk_kw kw n strm = match stream_nth n strm with
-| KEYWORD kw' | IDENT kw' -> if String.equal kw kw' then Some (n + 1) else None
-| _ -> None
-
-let lk_ident n strm = match stream_nth n strm with
-| IDENT _ -> Some (n + 1)
-| _ -> None
-
-let lk_int n strm = match stream_nth n strm with
-| NUMERAL { NumTok.int = _; frac = ""; exp = "" } -> Some (n + 1)
-| _ -> None
-
-let lk_ident_or_anti = lk_ident <+> (lk_kw "$" >> lk_ident)
-
-(* lookahead for (x:=t), (?x:=t) and (1:=t) *)
-let test_lpar_idnum_coloneq =
-  entry_of_lookahead "test_lpar_idnum_coloneq" begin
-    lk_kw "(" >> (lk_ident_or_anti <+> lk_int) >> lk_kw ":="
-  end
-
-(* lookahead for (x:t), (?x:t) *)
-let test_lpar_id_colon =
-  entry_of_lookahead "test_lpar_id_colon" begin
-    lk_kw "(" >> lk_ident_or_anti >> lk_kw ":"
-  end
-
-(* Hack to recognize "(x := t)" and "($x := t)" *)
-let test_lpar_id_coloneq =
-  entry_of_lookahead "test_lpar_id_coloneq" begin
-    lk_kw "(" >> lk_ident_or_anti >> lk_kw ":="
-  end
-
-(* Hack to recognize "(x)" *)
-let test_lpar_id_rpar =
-  entry_of_lookahead "test_lpar_id_rpar" begin
-    lk_kw "(" >> lk_ident >> lk_kw ")"
-  end
-
-let test_ampersand_ident =
-  entry_of_lookahead "test_ampersand_ident" begin
-    lk_kw "&" >> lk_ident
-  end
-
-let test_dollar_ident =
-  entry_of_lookahead "test_dollar_ident" begin
-    lk_kw "$" >> lk_ident
-  end
-
-let tac2expr = Tac2entries.Pltac.tac2expr
-let tac2type = Entry.create "tactic:tac2type"
-let tac2def_val = Entry.create "tactic:tac2def_val"
-let tac2def_typ = Entry.create "tactic:tac2def_typ"
-let tac2def_ext = Entry.create "tactic:tac2def_ext"
-let tac2def_syn = Entry.create "tactic:tac2def_syn"
-let tac2def_mut = Entry.create "tactic:tac2def_mut"
-let tac2def_run = Entry.create "tactic:tac2def_run"
-let tac2mode = Entry.create "vernac:ltac2_command"
-
-let ltac1_expr = Pltac.tactic_expr
-
-let inj_wit wit loc x = CAst.make ~loc @@ CTacExt (wit, x)
-let inj_open_constr loc c = inj_wit Tac2quote.wit_open_constr loc c
-let inj_pattern loc c = inj_wit Tac2quote.wit_pattern loc c
-let inj_reference loc c = inj_wit Tac2quote.wit_reference loc c
-let inj_ltac1 loc e = inj_wit Tac2quote.wit_ltac1 loc e
-let inj_ltac1val loc e = inj_wit Tac2quote.wit_ltac1val loc e
-
-let pattern_of_qualid qid =
-  if Tac2env.is_constructor qid then CAst.make ?loc:qid.CAst.loc @@ CPatRef (RelId qid, [])
-  else
-    let open Libnames in
-    if qualid_is_ident qid then CAst.make ?loc:qid.CAst.loc @@ CPatVar (Name (qualid_basename qid))
-    else
-      CErrors.user_err ?loc:qid.CAst.loc (Pp.str "Syntax error")
-
-}
-
-GRAMMAR EXTEND Gram
-  GLOBAL: tac2expr tac2type tac2def_val tac2def_typ tac2def_ext tac2def_syn
-          tac2def_mut tac2def_run;
-  tac2pat:
-    [ "1" LEFTA
-      [ qid = Prim.qualid; pl = LIST1 tac2pat LEVEL "0" -> {
-        if Tac2env.is_constructor qid then
-          CAst.make ~loc @@ CPatRef (RelId qid, pl)
-        else
-          CErrors.user_err ~loc (Pp.str "Syntax error") }
-      | qid = Prim.qualid -> { pattern_of_qualid qid }
-      | "["; "]" -> { CAst.make ~loc @@ CPatRef (AbsKn (Other Tac2core.Core.c_nil), []) }
-      | p1 = tac2pat; "::"; p2 = tac2pat ->
-        { CAst.make ~loc @@ CPatRef (AbsKn (Other Tac2core.Core.c_cons), [p1; p2])}
-      ]
-    | "0"
-      [ "_" -> { CAst.make ~loc @@ CPatVar Anonymous }
-      | "()" -> { CAst.make ~loc @@ CPatRef (AbsKn (Tuple 0), []) }
-      | qid = Prim.qualid -> { pattern_of_qualid qid }
-      | "("; p = atomic_tac2pat; ")" -> { p }
-    ] ]
-  ;
-  atomic_tac2pat:
-    [ [ ->
-        { CAst.make ~loc @@ CPatRef (AbsKn (Tuple 0), []) }
-      | p = tac2pat; ":"; t = tac2type ->
-        { CAst.make ~loc @@ CPatCnv (p, t) }
-      | p = tac2pat; ","; pl = LIST0 tac2pat SEP "," ->
-        { let pl = p :: pl in
-          CAst.make ~loc @@ CPatRef (AbsKn (Tuple (List.length pl)), pl) }
-      | p = tac2pat -> { p }
-    ] ]
-  ;
-  tac2expr:
-    [ "6" RIGHTA
-        [ e1 = SELF; ";"; e2 = SELF -> { CAst.make ~loc @@ CTacSeq (e1, e2) } ]
-    | "5"
-      [ "fun"; it = LIST1 input_fun ; "=>"; body = tac2expr LEVEL "6" ->
-        { CAst.make ~loc @@ CTacFun (it, body) }
-      | "let"; isrec = rec_flag;
-          lc = LIST1 let_clause SEP "with"; "in";
-          e = tac2expr LEVEL "6" ->
-        { CAst.make ~loc @@ CTacLet (isrec, lc, e) }
-      | "match"; e = tac2expr LEVEL "5"; "with"; bl = branches; "end" ->
-        { CAst.make ~loc @@ CTacCse (e, bl) }
-      ]
-    | "4" LEFTA [ ]
-    | "::" RIGHTA
-      [ e1 = tac2expr; "::"; e2 = tac2expr ->
-        { CAst.make ~loc @@ CTacApp (CAst.make ~loc @@ CTacCst (AbsKn (Other Tac2core.Core.c_cons)), [e1; e2]) }
-      ]
-    | [ e0 = SELF; ","; el = LIST1 NEXT SEP "," ->
-        { let el = e0 :: el in
-          CAst.make ~loc @@ CTacApp (CAst.make ~loc @@ CTacCst (AbsKn (Tuple (List.length el))), el) } ]
-    | "1" LEFTA
-      [ e = tac2expr; el = LIST1 tac2expr LEVEL "0" ->
-        { CAst.make ~loc @@ CTacApp (e, el) }
-      | e = SELF; ".("; qid = Prim.qualid; ")" ->
-        { CAst.make ~loc @@ CTacPrj (e, RelId qid) }
-      | e = SELF; ".("; qid = Prim.qualid; ")"; ":="; r = tac2expr LEVEL "5" ->
-        { CAst.make ~loc @@ CTacSet (e, RelId qid, r) } ]
-    | "0"
-      [ "("; a = SELF; ")" -> { a }
-      | "("; a = SELF; ":"; t = tac2type; ")" ->
-        { CAst.make ~loc @@ CTacCnv (a, t) }
-      | "()" ->
-        { CAst.make ~loc @@ CTacCst (AbsKn (Tuple 0)) }
-      | "("; ")" ->
-        { CAst.make ~loc @@ CTacCst (AbsKn (Tuple 0)) }
-      | "["; a = LIST0 tac2expr LEVEL "5" SEP ";"; "]" ->
-        { Tac2quote.of_list ~loc (fun x -> x) a }
-      | "{"; a = tac2rec_fieldexprs; "}" ->
-        { CAst.make ~loc @@ CTacRec a }
-      | a = tactic_atom -> { a } ]
-    ]
-  ;
-  branches:
-  [ [ -> { [] }
-    | "|"; bl = LIST1 branch SEP "|" -> { bl }
-    | bl = LIST1 branch SEP "|" -> { bl } ]
-  ]
-  ;
-  branch:
-  [ [ pat = tac2pat LEVEL "1"; "=>"; e = tac2expr LEVEL "6" -> { (pat, e) } ] ]
-  ;
-  rec_flag:
-    [ [ IDENT "rec" -> { true }
-      | -> { false } ] ]
-  ;
-  mut_flag:
-    [ [ IDENT "mutable" -> { true }
-      | -> { false } ] ]
-  ;
-  typ_param:
-    [ [ "'"; id = Prim.ident -> { id } ] ]
-  ;
-  tactic_atom:
-    [ [ n = Prim.integer -> { CAst.make ~loc @@ CTacAtm (AtmInt n) }
-      | s = Prim.string -> { CAst.make ~loc @@ CTacAtm (AtmStr s) }
-      | qid = Prim.qualid ->
-      { if Tac2env.is_constructor qid then
-          CAst.make ~loc @@ CTacCst (RelId qid)
-        else
-          CAst.make ~loc @@ CTacRef (RelId qid) }
-      | "@"; id = Prim.ident -> { Tac2quote.of_ident (CAst.make ~loc id) }
-      | "&"; id = lident -> { Tac2quote.of_hyp ~loc id }
-      | "'"; c = Constr.constr -> { inj_open_constr loc c }
-      | IDENT "constr"; ":"; "("; c = Constr.lconstr; ")" -> { Tac2quote.of_constr c }
-      | IDENT "open_constr"; ":"; "("; c = Constr.lconstr; ")" -> { Tac2quote.of_open_constr c }
-      | IDENT "ident"; ":"; "("; c = lident; ")" -> { Tac2quote.of_ident c }
-      | IDENT "pattern"; ":"; "("; c = Constr.lconstr_pattern; ")" -> { inj_pattern loc c }
-      | IDENT "reference"; ":"; "("; c = globref; ")" -> { inj_reference loc c }
-      | IDENT "ltac1"; ":"; "("; qid = ltac1_expr; ")" -> { inj_ltac1 loc qid }
-      | IDENT "ltac1val"; ":"; "("; qid = ltac1_expr; ")" -> { inj_ltac1val loc qid }
-    ] ]
-  ;
-  let_clause:
-    [ [ binder = let_binder; ":="; te = tac2expr ->
-      { let (pat, fn) = binder in
-        let te = match fn with
-        | None -> te
-        | Some args -> CAst.make ~loc @@ CTacFun (args, te)
-        in
-        (pat, te) }
-    ] ]
-  ;
-  let_binder:
-    [ [ pats = LIST1 input_fun ->
-      { match pats with
-        | [{CAst.v=CPatVar _} as pat] -> (pat, None)
-        | ({CAst.v=CPatVar (Name id)} as pat) :: args -> (pat, Some args)
-        | [pat] -> (pat, None)
-        | _ -> CErrors.user_err ~loc (str "Invalid pattern") }
-    ] ]
-  ;
-  tac2type:
-    [ "5" RIGHTA
-      [ t1 = tac2type; "->"; t2 = tac2type -> { CAst.make ~loc @@ CTypArrow (t1, t2) } ]
-    | "2"
-      [ t = tac2type; "*"; tl = LIST1 tac2type LEVEL "1" SEP "*" ->
-      { let tl = t :: tl in
-        CAst.make ~loc @@ CTypRef (AbsKn (Tuple (List.length tl)), tl) } ]
-    | "1" LEFTA
-      [ t = SELF; qid = Prim.qualid -> { CAst.make ~loc @@ CTypRef (RelId qid, [t]) } ]
-    | "0"
-      [ "("; t = tac2type LEVEL "5"; ")"  -> { t }
-      | id = typ_param -> { CAst.make ~loc @@ CTypVar (Name id) }
-      | "_" -> { CAst.make ~loc @@ CTypVar Anonymous }
-      | qid = Prim.qualid -> { CAst.make ~loc @@ CTypRef (RelId qid, []) }
-      | "("; p = LIST1 tac2type LEVEL "5" SEP ","; ")"; qid = Prim.qualid ->
-        { CAst.make ~loc @@ CTypRef (RelId qid, p) } ]
-    ];
-  locident:
-    [ [ id = Prim.ident -> { CAst.make ~loc id } ] ]
-  ;
-  binder:
-    [ [ "_" -> { CAst.make ~loc Anonymous }
-      | l = Prim.ident -> { CAst.make ~loc (Name l) } ] ]
-  ;
-  input_fun:
-    [ [ b = tac2pat LEVEL "0" -> { b } ] ]
-  ;
-  tac2def_body:
-    [ [ name = binder; it = LIST0 input_fun; ":="; e = tac2expr ->
-      { let e = if List.is_empty it then e else CAst.make ~loc @@ CTacFun (it, e) in
-        (name, e) }
-    ] ]
-  ;
-  tac2def_val:
-    [ [ mut = mut_flag; isrec = rec_flag; l = LIST1 tac2def_body SEP "with" ->
-        { StrVal (mut, isrec, l) }
-    ] ]
-  ;
-  tac2def_mut:
-    [ [ "Set"; qid = Prim.qualid; ":="; e = tac2expr -> { StrMut (qid, e) } ] ]
-  ;
-  tac2def_run:
-    [ [ "Eval"; e = tac2expr -> { StrRun e } ] ]
-  ;
-  tac2typ_knd:
-    [ [ t = tac2type -> { CTydDef (Some t) }
-      | "["; ".."; "]" -> { CTydOpn }
-      | "["; t = tac2alg_constructors; "]" -> { CTydAlg t }
-      | "{"; t = tac2rec_fields; "}"-> { CTydRec t } ] ]
-  ;
-  tac2alg_constructors:
-    [ [ "|"; cs = LIST1 tac2alg_constructor SEP "|" -> { cs }
-      | cs = LIST0 tac2alg_constructor SEP "|" -> { cs } ] ]
-  ;
-  tac2alg_constructor:
-    [ [ c = Prim.ident -> { (c, []) }
-      | c = Prim.ident; "("; args = LIST0 tac2type SEP ","; ")"-> { (c, args) } ] ]
-  ;
-  tac2rec_fields:
-    [ [ f = tac2rec_field; ";"; l = tac2rec_fields -> { f :: l }
-      | f = tac2rec_field; ";" -> { [f] }
-      | f = tac2rec_field -> { [f] }
-      | -> { [] } ] ]
-  ;
-  tac2rec_field:
-    [ [ mut = mut_flag; id = Prim.ident; ":"; t = tac2type -> { (id, mut, t) } ] ]
-  ;
-  tac2rec_fieldexprs:
-    [ [ f = tac2rec_fieldexpr; ";"; l = tac2rec_fieldexprs -> { f :: l }
-      | f = tac2rec_fieldexpr; ";" -> { [f] }
-      | f = tac2rec_fieldexpr-> { [f] }
-      | -> { [] } ] ]
-  ;
-  tac2rec_fieldexpr:
-    [ [ qid = Prim.qualid; ":="; e = tac2expr LEVEL "1" -> { RelId qid, e } ] ]
-  ;
-  tac2typ_prm:
-    [ [ -> { [] }
-      | id = typ_param -> { [CAst.make ~loc id] }
-      | "("; ids = LIST1 [ id = typ_param -> { CAst.make ~loc id } ] SEP "," ;")" -> { ids }
-    ] ]
-  ;
-  tac2typ_def:
-    [ [ prm = tac2typ_prm; id = Prim.qualid; b = tac2type_body -> { let (r, e) = b in (id, r, (prm, e)) } ] ]
-  ;
-  tac2type_body:
-    [ [ -> { false, CTydDef None }
-      | ":="; e = tac2typ_knd -> { false, e }
-      | "::="; e = tac2typ_knd -> { true, e }
-    ] ]
-  ;
-  tac2def_typ:
-    [ [ "Type"; isrec = rec_flag; l = LIST1 tac2typ_def SEP "with" ->
-        { StrTyp (isrec, l) }
-    ] ]
-  ;
-  tac2def_ext:
-    [ [ "@"; IDENT "external"; id = locident; ":"; t = tac2type LEVEL "5"; ":=";
-        plugin = Prim.string; name = Prim.string ->
-      { let ml = { mltac_plugin = plugin; mltac_tactic = name } in
-        StrPrm (id, t, ml) }
-    ] ]
-  ;
-  syn_node:
-    [ [ "_" -> { CAst.make ~loc None }
-      | id = Prim.ident -> { CAst.make ~loc (Some id) }
-    ] ]
-  ;
-  sexpr:
-    [ [ s = Prim.string -> { SexprStr (CAst.make ~loc s) }
-      | n = Prim.integer -> { SexprInt (CAst.make ~loc n) }
-      | id = syn_node -> { SexprRec (loc, id, []) }
-      | id = syn_node; "("; tok = LIST1 sexpr SEP "," ; ")" ->
-        { SexprRec (loc, id, tok) }
-    ] ]
-  ;
-  syn_level:
-    [ [ -> { None }
-      | ":"; n = Prim.integer -> { Some n }
-    ] ]
-  ;
-  tac2def_syn:
-    [ [ "Notation"; toks = LIST1 sexpr; n = syn_level; ":=";
-        e = tac2expr ->
-        { StrSyn (toks, n, e) }
-    ] ]
-  ;
-  lident:
-    [ [ id = Prim.ident -> { CAst.make ~loc id } ] ]
-  ;
-  globref:
-    [ [ "&"; id = Prim.ident -> { CAst.make ~loc (QHypothesis id) }
-      | qid = Prim.qualid -> { CAst.make ~loc @@ QReference qid }
-    ] ]
-  ;
-END
-
-(* Quotation scopes used by notations *)
-
-{
-
-open Tac2entries.Pltac
-
-let loc_of_ne_list l = Loc.merge_opt (fst (List.hd l)) (fst (List.last l))
-
-}
-
-GRAMMAR EXTEND Gram
-  GLOBAL: q_ident q_bindings q_intropattern q_intropatterns q_induction_clause
-          q_conversion q_rewriting q_clause q_dispatch q_occurrences q_strategy_flag
-          q_destruction_arg q_reference q_with_bindings q_constr_matching
-          q_goal_matching q_hintdb q_move_location q_pose q_assert;
-  anti:
-    [ [ "$"; id = Prim.ident -> { QAnti (CAst.make ~loc id) } ] ]
-  ;
-  ident_or_anti:
-    [ [ id = lident -> { QExpr id }
-      | "$"; id = Prim.ident -> { QAnti (CAst.make ~loc id) }
-    ] ]
-  ;
-  lident:
-    [ [ id = Prim.ident -> { CAst.make ~loc id } ] ]
-  ;
-  lnatural:
-    [ [ n = Prim.natural -> { CAst.make ~loc n } ] ]
-  ;
-  q_ident:
-    [ [ id = ident_or_anti -> { id } ] ]
-  ;
-  qhyp:
-    [ [ x = anti -> { x }
-      | n = lnatural -> { QExpr (CAst.make ~loc @@ QAnonHyp n) }
-      | id = lident -> { QExpr (CAst.make ~loc @@ QNamedHyp id) }
-    ] ]
-  ;
-  simple_binding:
-    [ [ "("; h = qhyp; ":="; c = Constr.lconstr; ")" ->
-        { CAst.make ~loc (h, c) }
-    ] ]
-  ;
-  bindings:
-    [ [ test_lpar_idnum_coloneq; bl = LIST1 simple_binding ->
-        { CAst.make ~loc @@ QExplicitBindings bl }
-      | bl = LIST1 Constr.constr ->
-        { CAst.make ~loc @@ QImplicitBindings bl }
-    ] ]
-  ;
-  q_bindings:
-    [ [ bl = bindings -> { bl } ] ]
-  ;
-  q_with_bindings:
-    [ [ bl = with_bindings -> { bl } ] ]
-  ;
-  intropatterns:
-    [ [ l = LIST0 nonsimple_intropattern -> { CAst.make ~loc l } ] ]
-  ;
-(*   ne_intropatterns: *)
-(*     [ [ l = LIST1 nonsimple_intropattern -> l ]] *)
-(*   ; *)
-  or_and_intropattern:
-    [ [ "["; tc = LIST1 intropatterns SEP "|"; "]" -> { CAst.make ~loc @@ QIntroOrPattern tc }
-      | "()" -> { CAst.make ~loc @@ QIntroAndPattern (CAst.make ~loc []) }
-      | "("; si = simple_intropattern; ")" -> { CAst.make ~loc @@ QIntroAndPattern (CAst.make ~loc [si]) }
-      | "("; si = simple_intropattern; ",";
-             tc = LIST1 simple_intropattern SEP "," ; ")" ->
-             { CAst.make ~loc @@ QIntroAndPattern (CAst.make ~loc (si::tc)) }
-      | "("; si = simple_intropattern; "&";
-	     tc = LIST1 simple_intropattern SEP "&" ; ")" ->
-	  (* (A & B & C) is translated into (A,(B,C)) *)
-	{ let rec pairify = function
-	    | ([]|[_]|[_;_]) as l -> CAst.make ~loc l
-	    | t::q ->
-              let q =
-                CAst.make ~loc @@
-                  QIntroAction (CAst.make ~loc @@
-                    QIntroOrAndPattern (CAst.make ~loc @@
-                      QIntroAndPattern (pairify q)))
-              in
-              CAst.make ~loc [t; q]
-	  in CAst.make ~loc @@ QIntroAndPattern (pairify (si::tc)) } ] ]
-  ;
-  equality_intropattern:
-    [ [ "->" -> { CAst.make ~loc @@ QIntroRewrite true }
-      | "<-" -> { CAst.make ~loc @@ QIntroRewrite false }
-      | "[="; tc = intropatterns; "]" -> { CAst.make ~loc @@ QIntroInjection tc } ] ]
-  ;
-  naming_intropattern:
-    [ [ LEFTQMARK; id = lident ->
-        { CAst.make ~loc @@ QIntroFresh (QExpr id) }
-      | "?$"; id = lident ->
-        { CAst.make ~loc @@ QIntroFresh (QAnti id) }
-      | "?" ->
-        { CAst.make ~loc @@ QIntroAnonymous }
-      | id = ident_or_anti ->
-        { CAst.make ~loc @@ QIntroIdentifier id }
-    ] ]
-  ;
-  nonsimple_intropattern:
-    [ [ l = simple_intropattern -> { l }
-      | "*"  -> { CAst.make ~loc @@ QIntroForthcoming true }
-      | "**" -> { CAst.make ~loc @@ QIntroForthcoming false } ] ]
-  ;
-  simple_intropattern:
-    [ [ pat = simple_intropattern_closed ->
-(*         l = LIST0 ["%"; c = operconstr LEVEL "0" -> c] -> *)
-        (** TODO: handle %pat *)
-        { pat }
-    ] ]
-  ;
-  simple_intropattern_closed:
-    [ [ pat = or_and_intropattern ->
-        { CAst.make ~loc @@ QIntroAction (CAst.make ~loc @@ QIntroOrAndPattern pat) }
-      | pat = equality_intropattern ->
-        { CAst.make ~loc @@ QIntroAction pat }
-      | "_" ->
-        { CAst.make ~loc @@ QIntroAction (CAst.make ~loc @@ QIntroWildcard) }
-      | pat = naming_intropattern ->
-        { CAst.make ~loc @@ QIntroNaming pat }
-    ] ]
-  ;
-  q_intropatterns:
-    [ [ ipat = intropatterns -> { ipat } ] ]
-  ;
-  q_intropattern:
-    [ [ ipat = simple_intropattern -> { ipat } ] ]
-  ;
-  nat_or_anti:
-    [ [ n = lnatural -> { QExpr n }
-      | "$"; id = Prim.ident -> { QAnti (CAst.make ~loc id) }
-    ] ]
-  ;
-  eqn_ipat:
-    [ [ IDENT "eqn"; ":"; pat = naming_intropattern -> { Some pat }
-      | -> { None }
-    ] ]
-  ;
-  with_bindings:
-    [ [ "with"; bl = bindings -> { bl } | -> { CAst.make ~loc @@ QNoBindings } ] ]
-  ;
-  constr_with_bindings:
-    [ [ c = Constr.constr; l = with_bindings -> { CAst.make ~loc @@ (c, l) } ] ]
-  ;
-  destruction_arg:
-    [ [ n = lnatural -> { CAst.make ~loc @@ QElimOnAnonHyp n }
-      | id = lident -> { CAst.make ~loc @@ QElimOnIdent id }
-      | c = constr_with_bindings -> { CAst.make ~loc @@ QElimOnConstr c }
-    ] ]
-  ;
-  q_destruction_arg:
-    [ [ arg = destruction_arg -> { arg } ] ]
-  ;
-  as_or_and_ipat:
-    [ [ "as"; ipat = or_and_intropattern -> { Some ipat }
-      | -> { None }
-    ] ]
-  ;
-  occs_nums:
-    [ [ nl = LIST1 nat_or_anti -> { CAst.make ~loc @@ QOnlyOccurrences nl }
-      | "-"; n = nat_or_anti; nl = LIST0 nat_or_anti ->
-        { CAst.make ~loc @@ QAllOccurrencesBut (n::nl) }
-    ] ]
-  ;
-  occs:
-    [ [ "at"; occs = occs_nums -> { occs } | -> { CAst.make ~loc QAllOccurrences } ] ]
-  ;
-  hypident:
-    [ [ id = ident_or_anti ->
-        { id,Locus.InHyp }
-      | "("; IDENT "type"; IDENT "of"; id = ident_or_anti; ")" ->
-        { id,Locus.InHypTypeOnly }
-      | "("; IDENT "value"; IDENT "of"; id = ident_or_anti; ")" ->
-        { id,Locus.InHypValueOnly }
-    ] ]
-  ;
-  hypident_occ:
-    [ [ h=hypident; occs=occs -> { let (id,l) = h in ((occs,id),l) } ] ]
-  ;
-  in_clause:
-    [ [ "*"; occs=occs ->
-        { { q_onhyps = None; q_concl_occs = occs } }
-      | "*"; "|-"; occs = concl_occ ->
-        { { q_onhyps = None; q_concl_occs = occs } }
-      | hl = LIST0 hypident_occ SEP ","; "|-"; occs = concl_occ ->
-        { { q_onhyps = Some hl; q_concl_occs = occs } }
-      | hl = LIST0 hypident_occ SEP "," ->
-        { { q_onhyps = Some hl; q_concl_occs = CAst.make ~loc QNoOccurrences } }
-    ] ]
-  ;
-  clause:
-    [ [ "in"; cl = in_clause -> { CAst.make ~loc @@ cl }
-      | "at"; occs = occs_nums ->
-        { CAst.make ~loc @@ { q_onhyps = Some []; q_concl_occs = occs } }
-    ] ]
-  ;
-  q_clause:
-    [ [ cl = clause -> { cl } ] ]
-  ;
-  concl_occ:
-    [ [ "*"; occs = occs -> { occs }
-      | -> { CAst.make ~loc QNoOccurrences }
-    ] ]
-  ;
-  induction_clause:
-    [ [ c = destruction_arg; pat = as_or_and_ipat; eq = eqn_ipat;
-        cl = OPT clause ->
-      { CAst.make ~loc @@ {
-          indcl_arg = c;
-          indcl_eqn = eq;
-          indcl_as = pat;
-          indcl_in = cl;
-        } }
-    ] ]
-  ;
-  q_induction_clause:
-    [ [ cl = induction_clause -> { cl } ] ]
-  ;
-  conversion:
-    [ [ c = Constr.constr ->
-        { CAst.make ~loc @@ QConvert c }
-      | c1 = Constr.constr; "with"; c2 = Constr.constr ->
-        { CAst.make ~loc @@ QConvertWith (c1, c2) }
-    ] ]
-  ;
-  q_conversion:
-    [ [ c = conversion -> { c } ] ]
-  ;
-  orient:
-    [ [ "->" -> { CAst.make ~loc (Some true) }
-      | "<-" -> { CAst.make ~loc (Some false) }
-      | -> { CAst.make ~loc None }
-    ]]
-  ;
-  rewriter:
-    [ [ "!"; c = constr_with_bindings ->
-        { (CAst.make ~loc @@ QRepeatPlus,c) }
-      | [ "?" -> { () } | LEFTQMARK -> { () } ]; c = constr_with_bindings ->
-        { (CAst.make ~loc @@ QRepeatStar,c) }
-      | n = lnatural; "!"; c = constr_with_bindings ->
-        { (CAst.make ~loc @@ QPrecisely n,c) }
-      |	n = lnatural; ["?" -> { () } | LEFTQMARK -> { () } ]; c = constr_with_bindings ->
-        { (CAst.make ~loc @@ QUpTo n,c) }
-      | n = lnatural; c = constr_with_bindings ->
-        { (CAst.make ~loc @@ QPrecisely n,c) }
-      | c = constr_with_bindings ->
-        { (CAst.make ~loc @@ QPrecisely (CAst.make 1), c) }
-      ] ]
-  ;
-  oriented_rewriter:
-    [ [ b = orient; r = rewriter ->
-      { let (m, c) = r in
-        CAst.make ~loc @@ {
-        rew_orient = b;
-        rew_repeat = m;
-        rew_equatn = c;
-      } }
-    ] ]
-  ;
-  q_rewriting:
-    [ [ r = oriented_rewriter -> { r } ] ]
-  ;
-  tactic_then_last:
-    [ [ "|"; lta = LIST0 (OPT tac2expr LEVEL "6") SEP "|" -> { lta }
-      | -> { [] }
-    ] ]
-  ;
-  tactic_then_gen:
-    [ [ ta = tac2expr; "|"; tg = tactic_then_gen -> { let (first,last) = tg in (Some ta :: first, last) }
-      | ta = tac2expr; ".."; l = tactic_then_last -> { ([], Some (Some ta, l)) }
-      | ".."; l = tactic_then_last -> { ([], Some (None, l)) }
-      | ta = tac2expr -> { ([Some ta], None) }
-      | "|"; tg = tactic_then_gen -> { let (first,last) = tg in (None :: first, last) }
-      | -> { ([None], None) }
-    ] ]
-  ;
-  q_dispatch:
-    [ [ d = tactic_then_gen -> { CAst.make ~loc d } ] ]
-  ;
-  q_occurrences:
-    [ [ occs = occs -> { occs } ] ]
-  ;
-  red_flag:
-    [ [ IDENT "beta" -> { CAst.make ~loc @@ QBeta }
-      | IDENT "iota" -> { CAst.make ~loc @@ QIota }
-      | IDENT "match" -> { CAst.make ~loc @@ QMatch }
-      | IDENT "fix" -> { CAst.make ~loc @@ QFix }
-      | IDENT "cofix" -> { CAst.make ~loc @@ QCofix }
-      | IDENT "zeta" -> { CAst.make ~loc @@ QZeta }
-      | IDENT "delta"; d = delta_flag -> { d }
-    ] ]
-  ;
-  refglobal:
-    [ [ "&"; id = Prim.ident -> { QExpr (CAst.make ~loc @@ QHypothesis id) }
-      | qid = Prim.qualid -> { QExpr (CAst.make ~loc @@ QReference qid) }
-      | "$"; id = Prim.ident -> { QAnti (CAst.make ~loc id) }
-    ] ]
-  ;
-  q_reference:
-    [ [ r = refglobal -> { r } ] ]
-  ;
-  refglobals:
-    [ [ gl = LIST1 refglobal -> { CAst.make ~loc gl } ] ]
-  ;
-  delta_flag:
-    [ [ "-"; "["; idl = refglobals; "]" -> { CAst.make ~loc @@ QDeltaBut idl }
-      | "["; idl = refglobals; "]" -> { CAst.make ~loc @@ QConst idl }
-      | -> { CAst.make ~loc @@ QDeltaBut (CAst.make ~loc []) }
-    ] ]
-  ;
-  strategy_flag:
-    [ [ s = LIST1 red_flag -> { CAst.make ~loc s }
-      | d = delta_flag ->
-      { CAst.make ~loc
-          [CAst.make ~loc QBeta; CAst.make ~loc QIota; CAst.make ~loc QZeta; d] }
-    ] ]
-  ;
-  q_strategy_flag:
-    [ [ flag = strategy_flag -> { flag } ] ]
-  ;
-  hintdb:
-    [ [ "*" -> { CAst.make ~loc @@ QHintAll }
-      | l = LIST1 ident_or_anti -> { CAst.make ~loc @@ QHintDbs l }
-    ] ]
-  ;
-  q_hintdb:
-    [ [ db = hintdb -> { db } ] ]
-  ;
-  match_pattern:
-    [ [ IDENT "context";  id = OPT Prim.ident;
-          "["; pat = Constr.lconstr_pattern; "]" -> { CAst.make ~loc @@ QConstrMatchContext (id, pat) }
-      | pat = Constr.lconstr_pattern -> { CAst.make ~loc @@ QConstrMatchPattern pat } ] ]
-  ;
-  match_rule:
-    [ [ mp = match_pattern; "=>"; tac = tac2expr ->
-        { CAst.make ~loc @@ (mp, tac) }
-    ] ]
-  ;
-  match_list:
-    [ [ mrl = LIST1 match_rule SEP "|" -> { CAst.make ~loc @@ mrl }
-      | "|"; mrl = LIST1 match_rule SEP "|" -> { CAst.make ~loc @@ mrl } ] ]
-  ;
-  q_constr_matching:
-    [ [ m = match_list -> { m } ] ]
-  ;
-  gmatch_hyp_pattern:
-    [ [ na = Prim.name; ":"; pat = match_pattern -> { (na, pat) } ] ]
-  ;
-  gmatch_pattern:
-    [ [ "["; hl = LIST0 gmatch_hyp_pattern SEP ","; "|-"; p = match_pattern; "]" ->
-        { CAst.make ~loc @@ {
-          q_goal_match_concl = p;
-          q_goal_match_hyps = hl;
-        } }
-    ] ]
-  ;
-  gmatch_rule:
-    [ [ mp = gmatch_pattern; "=>"; tac = tac2expr ->
-        { CAst.make ~loc @@ (mp, tac) }
-    ] ]
-  ;
-  gmatch_list:
-    [ [ mrl = LIST1 gmatch_rule SEP "|" -> { CAst.make ~loc @@ mrl }
-      | "|"; mrl = LIST1 gmatch_rule SEP "|" -> { CAst.make ~loc @@ mrl } ] ]
-  ;
-  q_goal_matching:
-    [ [ m = gmatch_list -> { m } ] ]
-  ;
-  move_location:
-    [ [ "at"; IDENT "top" -> { CAst.make ~loc @@ QMoveFirst }
-      | "at"; IDENT "bottom" -> { CAst.make ~loc @@ QMoveLast }
-      | IDENT "after"; id = ident_or_anti -> { CAst.make ~loc @@ QMoveAfter id }
-      | IDENT "before"; id = ident_or_anti -> { CAst.make ~loc @@ QMoveBefore id }
-    ] ]
-  ;
-  q_move_location:
-    [ [ mv = move_location -> { mv } ] ]
-  ;
-  as_name:
-    [ [ -> { None }
-      | "as"; id = ident_or_anti -> { Some id }
-    ] ]
-  ;
-  pose:
-    [ [ test_lpar_id_coloneq; "("; id = ident_or_anti; ":="; c = Constr.lconstr; ")" ->
-        { CAst.make ~loc (Some id, c) }
-      | c = Constr.constr; na = as_name -> { CAst.make ~loc (na, c) }
-    ] ]
-  ;
-  q_pose:
-    [ [ p = pose -> { p } ] ]
-  ;
-  as_ipat:
-    [ [ "as"; ipat = simple_intropattern -> { Some ipat }
-      | -> { None }
-    ] ]
-  ;
-  by_tactic:
-    [ [ "by"; tac = tac2expr -> { Some tac }
-      | -> { None }
-    ] ]
-  ;
-  assertion:
-    [ [ test_lpar_id_coloneq; "("; id = ident_or_anti; ":="; c = Constr.lconstr; ")" ->
-        { CAst.make ~loc (QAssertValue (id, c)) }
-      | test_lpar_id_colon; "("; id = ident_or_anti; ":"; c = Constr.lconstr; ")"; tac = by_tactic ->
-      { let ipat = CAst.make ~loc @@ QIntroNaming (CAst.make ~loc @@ QIntroIdentifier id) in
-        CAst.make ~loc (QAssertType (Some ipat, c, tac)) }
-      | c = Constr.constr; ipat = as_ipat; tac = by_tactic ->
-        { CAst.make ~loc (QAssertType (ipat, c, tac)) }
-    ] ]
-  ;
-  q_assert:
-    [ [ a = assertion -> { a } ] ]
-  ;
-END
-
-(** Extension of constr syntax *)
-
-(*
-GRAMMAR EXTEND Gram
-  Pcoq.Constr.operconstr: LEVEL "0"
-    [ [ IDENT "ltac2"; ":"; "("; tac = tac2expr; ")" ->
-      { let arg = Genarg.in_gen (Genarg.rawwit Tac2env.wit_ltac2) tac in
-        CAst.make ~loc (CHole (None, Namegen.IntroAnonymous, Some arg)) }
-      | test_ampersand_ident; "&"; id = Prim.ident ->
-      { let tac = Tac2quote.of_exact_hyp ~loc (CAst.make ~loc id) in
-        let arg = Genarg.in_gen (Genarg.rawwit Tac2env.wit_ltac2) tac in
-        CAst.make ~loc (CHole (None, Namegen.IntroAnonymous, Some arg)) }
-      | test_dollar_ident; "$"; id = Prim.ident ->
-      { let id = Loc.tag ~loc id in
-        let arg = Genarg.in_gen (Genarg.rawwit Tac2env.wit_ltac2_quotation) id in
-        CAst.make ~loc (CHole (None, Namegen.IntroAnonymous, Some arg)) }
-    ] ]
-  ;
-END
-*)
-{
-
-let () =
-
-let open Extend in
-let open Tok in
-let (++) r s = Next (r, s) in
-let rules = [
-  Rule (
-    Stop ++ Aentry test_dollar_ident ++ Atoken (PKEYWORD "$") ++ Aentry Prim.ident,
-    begin fun id _ _ loc ->
-      let id = Loc.tag ~loc id in
-      let arg = Genarg.in_gen (Genarg.rawwit Tac2env.wit_ltac2_quotation) id in
-      CAst.make ~loc (CHole (None, Namegen.IntroAnonymous, Some arg))
-    end
-  );
-
-  Rule (
-    Stop ++ Aentry test_ampersand_ident ++ Atoken (PKEYWORD "&") ++ Aentry Prim.ident,
-    begin fun id _ _ loc ->
-      let tac = Tac2quote.of_exact_hyp ~loc (CAst.make ~loc id) in
-      let arg = Genarg.in_gen (Genarg.rawwit Tac2env.wit_ltac2) tac in
-      CAst.make ~loc (CHole (None, Namegen.IntroAnonymous, Some arg))
-    end
-  );
-
-  Rule (
-    Stop ++ Atoken (PIDENT (Some "ltac2")) ++ Atoken (PKEYWORD ":") ++
-      Atoken (PKEYWORD "(") ++ Aentry tac2expr ++ Atoken (PKEYWORD ")"),
-    begin fun _ tac _ _ _ loc ->
-      let arg = Genarg.in_gen (Genarg.rawwit Tac2env.wit_ltac2) tac in
-      CAst.make ~loc (CHole (None, Namegen.IntroAnonymous, Some arg))
-    end
-  )
-] in
-
-Hook.set Tac2entries.register_constr_quotations begin fun () ->
-  Pcoq.grammar_extend Pcoq.Constr.operconstr None (Some (Gramlib.Gramext.Level "0"), [(None, None, rules)])
-end
-
-}
-
-{
-
-let pr_ltac2entry _ = mt () (* FIXME *)
-let pr_ltac2expr _ = mt () (* FIXME *)
-
-}
-
-VERNAC ARGUMENT EXTEND ltac2_entry
-PRINTED BY { pr_ltac2entry }
-| [ tac2def_val(v) ] -> { v }
-| [ tac2def_typ(t) ] -> { t }
-| [ tac2def_ext(e) ] -> { e }
-| [ tac2def_syn(e) ] -> { e }
-| [ tac2def_mut(e) ] -> { e }
-| [ tac2def_run(e) ] -> { e }
-END
-
-{
-
-let classify_ltac2 = function
-| StrSyn _ -> Vernacextend.(VtSideff [], VtNow)
-| StrMut _ | StrVal _ | StrPrm _  | StrTyp _ | StrRun _ -> Vernacextend.classify_as_sideeff
-
-}
-
-VERNAC COMMAND EXTEND VernacDeclareTactic2Definition
-| #[ local = locality ] ![proof] [ "Ltac2" ltac2_entry(e) ] => { classify_ltac2 e } -> {
-  fun ~pstate -> Tac2entries.register_struct ?local ~pstate e; pstate
-  }
-END
-
-{
-
-let _ = Pvernac.register_proof_mode "Ltac2" tac2mode
-
-}
-
-VERNAC ARGUMENT EXTEND ltac2_expr
-PRINTED BY { pr_ltac2expr }
-| [ tac2expr(e) ] -> { e }
-END
-
-{
-
-open G_ltac
-open Vernacextend
-
-}
-
-VERNAC { tac2mode } EXTEND VernacLtac2
-| ![proof] [ ltac2_expr(t) ltac_use_default(default) ] =>
-    { classify_as_proofstep } -> {
-(*     let g = Option.default (Proof_global.get_default_goal_selector ()) g in *)
-  fun ~pstate ->
-    Option.map (fun pstate -> Tac2entries.call ~pstate ~default t) pstate
-  }
-END
-
-{
-
-open Stdarg
-
-}
-
-VERNAC COMMAND EXTEND Ltac2Print CLASSIFIED AS SIDEFF
-| [ "Print" "Ltac2" reference(tac) ] -> { Tac2entries.print_ltac tac }
-END
diff --git a/src/ltac2_plugin.mlpack b/src/ltac2_plugin.mlpack
deleted file mode 100644
index 2a25e825cb..0000000000
--- a/src/ltac2_plugin.mlpack
+++ /dev/null
@@ -1,14 +0,0 @@
-Tac2dyn
-Tac2ffi
-Tac2env
-Tac2print
-Tac2intern
-Tac2interp
-Tac2entries
-Tac2quote
-Tac2match
-Tac2core
-Tac2extffi
-Tac2tactics
-Tac2stdlib
-G_ltac2
diff --git a/src/tac2core.ml b/src/tac2core.ml
deleted file mode 100644
index d7e7b91ee6..0000000000
--- a/src/tac2core.ml
+++ /dev/null
@@ -1,1446 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Util
-open Pp
-open Names
-open Genarg
-open Tac2env
-open Tac2expr
-open Tac2entries.Pltac
-open Proofview.Notations
-
-(** Standard values *)
-
-module Value = Tac2ffi
-open Value
-
-let core_prefix path n = KerName.make path (Label.of_id (Id.of_string_soft n))
-
-let std_core n = core_prefix Tac2env.std_prefix n
-let coq_core n = core_prefix Tac2env.coq_prefix n
-let ltac1_core n = core_prefix Tac2env.ltac1_prefix n
-
-module Core =
-struct
-
-let t_int = coq_core "int"
-let t_string = coq_core "string"
-let t_array = coq_core "array"
-let t_unit = coq_core "unit"
-let t_list = coq_core "list"
-let t_constr = coq_core "constr"
-let t_pattern = coq_core "pattern"
-let t_ident = coq_core "ident"
-let t_option = coq_core "option"
-let t_exn = coq_core "exn"
-let t_reference = std_core "reference"
-let t_ltac1 = ltac1_core "t"
-
-let c_nil = coq_core "[]"
-let c_cons = coq_core "::"
-
-let c_none = coq_core "None"
-let c_some = coq_core "Some"
-
-let c_true = coq_core "true"
-let c_false = coq_core "false"
-
-end
-
-open Core
-
-let v_unit = Value.of_unit ()
-let v_blk = Valexpr.make_block
-
-let of_name c = match c with
-| Anonymous -> Value.of_option Value.of_ident None
-| Name id -> Value.of_option Value.of_ident (Some id)
-
-let to_name c = match Value.to_option Value.to_ident c with
-| None -> Anonymous
-| Some id -> Name id
-
-let of_relevance = function
-  | Sorts.Relevant -> ValInt 0
-  | Sorts.Irrelevant -> ValInt 1
-
-let to_relevance = function
-  | ValInt 0 -> Sorts.Relevant
-  | ValInt 1 -> Sorts.Irrelevant
-  | _ -> assert false
-
-let of_annot f Context.{binder_name;binder_relevance} =
-  of_tuple [|(f binder_name); of_relevance binder_relevance|]
-
-let to_annot f x =
-  match to_tuple x with
-  | [|x;y|] ->
-    let x = f x in
-    let y = to_relevance y in
-    Context.make_annot x y
-  | _ -> assert false
-
-let of_instance u =
-  let u = Univ.Instance.to_array (EConstr.Unsafe.to_instance u) in
-  Value.of_array (fun v -> Value.of_ext Value.val_univ v) u
-
-let to_instance u =
-  let u = Value.to_array (fun v -> Value.to_ext Value.val_univ v) u in
-  EConstr.EInstance.make (Univ.Instance.of_array u)
-
-let of_rec_declaration (nas, ts, cs) =
-  (Value.of_array (of_annot of_name) nas,
-  Value.of_array Value.of_constr ts,
-  Value.of_array Value.of_constr cs)
-
-let to_rec_declaration (nas, ts, cs) =
-  (Value.to_array (to_annot to_name) nas,
-  Value.to_array Value.to_constr ts,
-  Value.to_array Value.to_constr cs)
-
-let of_result f = function
-| Inl c -> v_blk 0 [|f c|]
-| Inr e -> v_blk 1 [|Value.of_exn e|]
-
-(** Stdlib exceptions *)
-
-let err_notfocussed =
-  Tac2interp.LtacError (coq_core "Not_focussed", [||])
-
-let err_outofbounds =
-  Tac2interp.LtacError (coq_core "Out_of_bounds", [||])
-
-let err_notfound =
-  Tac2interp.LtacError (coq_core "Not_found", [||])
-
-let err_matchfailure =
-  Tac2interp.LtacError (coq_core "Match_failure", [||])
-
-(** Helper functions *)
-
-let thaw f = Tac2ffi.apply f [v_unit]
-
-let fatal_flag : unit Exninfo.t = Exninfo.make ()
-
-let set_bt info =
-  if !Tac2interp.print_ltac2_backtrace then
-    Tac2interp.get_backtrace >>= fun bt ->
-    Proofview.tclUNIT (Exninfo.add info Tac2entries.backtrace bt)
-  else Proofview.tclUNIT info
-
-let throw ?(info = Exninfo.null) e =
-  set_bt info >>= fun info ->
-  let info = Exninfo.add info fatal_flag () in
-  Proofview.tclLIFT (Proofview.NonLogical.raise ~info e)
-
-let fail ?(info = Exninfo.null) e =
-  set_bt info >>= fun info ->
-  Proofview.tclZERO ~info e
-
-let return x = Proofview.tclUNIT x
-let pname s = { mltac_plugin = "ltac2"; mltac_tactic = s }
-
-let wrap f =
-  return () >>= fun () -> return (f ())
-
-let wrap_unit f =
-  return () >>= fun () -> f (); return v_unit
-
-let assert_focussed =
-  Proofview.Goal.goals >>= fun gls ->
-  match gls with
-  | [_] -> Proofview.tclUNIT ()
-  | [] | _ :: _ :: _ -> throw err_notfocussed
-
-let pf_apply f =
-  Proofview.Goal.goals >>= function
-  | [] ->
-    Proofview.tclENV >>= fun env ->
-    Proofview.tclEVARMAP >>= fun sigma ->
-    f env sigma
-  | [gl] ->
-    gl >>= fun gl ->
-    f (Proofview.Goal.env gl) (Tacmach.New.project gl)
-  | _ :: _ :: _ ->
-    throw err_notfocussed
-
-(** Primitives *)
-
-let define_primitive name arity f =
-  Tac2env.define_primitive (pname name) (mk_closure arity f)
-
-let define0 name f = define_primitive name arity_one (fun _ -> f)
-
-let define1 name r0 f = define_primitive name arity_one begin fun x ->
-  f (Value.repr_to r0 x)
-end
-
-let define2 name r0 r1 f = define_primitive name (arity_suc arity_one) begin fun x y ->
-  f (Value.repr_to r0 x) (Value.repr_to r1 y)
-end
-
-let define3 name r0 r1 r2 f = define_primitive name (arity_suc (arity_suc arity_one)) begin fun x y z ->
-  f (Value.repr_to r0 x) (Value.repr_to r1 y) (Value.repr_to r2 z)
-end
-
-(** Printing *)
-
-let () = define1 "print" pp begin fun pp ->
-  wrap_unit (fun () -> Feedback.msg_notice pp)
-end
-
-let () = define1 "message_of_int" int begin fun n ->
-  return (Value.of_pp (Pp.int n))
-end
-
-let () = define1 "message_of_string" string begin fun s ->
-  return (Value.of_pp (str (Bytes.to_string s)))
-end
-
-let () = define1 "message_of_constr" constr begin fun c ->
-  pf_apply begin fun env sigma ->
-    let pp = Printer.pr_econstr_env env sigma c in
-    return (Value.of_pp pp)
-  end
-end
-
-let () = define1 "message_of_ident" ident begin fun c ->
-  let pp = Id.print c in
-  return (Value.of_pp pp)
-end
-
-let () = define1 "message_of_exn" valexpr begin fun v ->
-  Proofview.tclENV >>= fun env ->
-  Proofview.tclEVARMAP >>= fun sigma ->
-  let pp = Tac2print.pr_valexpr env sigma v (GTypRef (Other Core.t_exn, [])) in
-  return (Value.of_pp pp)
-end
-
-
-let () = define2 "message_concat" pp pp begin fun m1 m2 ->
-  return (Value.of_pp (Pp.app m1 m2))
-end
-
-(** Array *)
-
-let () = define2 "array_make" int valexpr begin fun n x ->
-  if n < 0 || n > Sys.max_array_length then throw err_outofbounds
-  else wrap (fun () -> v_blk 0 (Array.make n x))
-end
-
-let () = define1 "array_length" block begin fun (_, v) ->
-  return (Value.of_int (Array.length v))
-end
-
-let () = define3 "array_set" block int valexpr begin fun (_, v) n x ->
-  if n < 0 || n >= Array.length v then throw err_outofbounds
-  else wrap_unit (fun () -> v.(n) <- x)
-end
-
-let () = define2 "array_get" block int begin fun (_, v) n ->
-  if n < 0 || n >= Array.length v then throw err_outofbounds
-  else wrap (fun () -> v.(n))
-end
-
-(** Ident *)
-
-let () = define2 "ident_equal" ident ident begin fun id1 id2 ->
-  return (Value.of_bool (Id.equal id1 id2))
-end
-
-let () = define1 "ident_to_string" ident begin fun id ->
-  return (Value.of_string (Bytes.of_string (Id.to_string id)))
-end
-
-let () = define1 "ident_of_string" string begin fun s ->
-  let id = try Some (Id.of_string (Bytes.to_string s)) with _ -> None in
-  return (Value.of_option Value.of_ident id)
-end
-
-(** Int *)
-
-let () = define2 "int_equal" int int begin fun m n ->
-  return (Value.of_bool (m == n))
-end
-
-let binop n f = define2 n int int begin fun m n ->
-  return (Value.of_int (f m n))
-end
-
-let () = binop "int_compare" Int.compare
-let () = binop "int_add" (+)
-let () = binop "int_sub" (-)
-let () = binop "int_mul" ( * )
-
-let () = define1 "int_neg" int begin fun m ->
-  return (Value.of_int (~- m))
-end
-
-(** Char *)
-
-let () = define1 "char_of_int" int begin fun n ->
-  wrap (fun () -> Value.of_char (Char.chr n))
-end
-
-let () = define1 "char_to_int" char begin fun n ->
-  wrap (fun () -> Value.of_int (Char.code n))
-end
-
-(** String *)
-
-let () = define2 "string_make" int char begin fun n c ->
-  if n < 0 || n > Sys.max_string_length then throw err_outofbounds
-  else wrap (fun () -> Value.of_string (Bytes.make n c))
-end
-
-let () = define1 "string_length" string begin fun s ->
-  return (Value.of_int (Bytes.length s))
-end
-
-let () = define3 "string_set" string int char begin fun s n c ->
-  if n < 0 || n >= Bytes.length s then throw err_outofbounds
-  else wrap_unit (fun () -> Bytes.set s n c)
-end
-
-let () = define2 "string_get" string int begin fun s n ->
-  if n < 0 || n >= Bytes.length s then throw err_outofbounds
-  else wrap (fun () -> Value.of_char (Bytes.get s n))
-end
-
-(** Terms *)
-
-(** constr -> constr *)
-let () = define1 "constr_type" constr begin fun c ->
-  let get_type env sigma =
-  Proofview.V82.wrap_exceptions begin fun () ->
-    let (sigma, t) = Typing.type_of env sigma c in
-    let t = Value.of_constr t in
-    Proofview.Unsafe.tclEVARS sigma <*> Proofview.tclUNIT t
-  end in
-  pf_apply get_type
-end
-
-(** constr -> constr *)
-let () = define2 "constr_equal" constr constr begin fun c1 c2 ->
-  Proofview.tclEVARMAP >>= fun sigma ->
-  let b = EConstr.eq_constr sigma c1 c2 in
-  Proofview.tclUNIT (Value.of_bool b)
-end
-
-let () = define1 "constr_kind" constr begin fun c ->
-  let open Constr in
-  Proofview.tclEVARMAP >>= fun sigma ->
-  return begin match EConstr.kind sigma c with
-  | Rel n ->
-    v_blk 0 [|Value.of_int n|]
-  | Var id ->
-    v_blk 1 [|Value.of_ident id|]
-  | Meta n ->
-    v_blk 2 [|Value.of_int n|]
-  | Evar (evk, args) ->
-    v_blk 3 [|
-      Value.of_int (Evar.repr evk);
-      Value.of_array Value.of_constr args;
-    |]
-  | Sort s ->
-    v_blk 4 [|Value.of_ext Value.val_sort s|]
-  | Cast (c, k, t) ->
-    v_blk 5 [|
-      Value.of_constr c;
-      Value.of_ext Value.val_cast k;
-      Value.of_constr t;
-    |]
-  | Prod (na, t, u) ->
-    v_blk 6 [|
-      of_annot of_name na;
-      Value.of_constr t;
-      Value.of_constr u;
-    |]
-  | Lambda (na, t, c) ->
-    v_blk 7 [|
-      of_annot of_name na;
-      Value.of_constr t;
-      Value.of_constr c;
-    |]
-  | LetIn (na, b, t, c) ->
-    v_blk 8 [|
-      of_annot of_name na;
-      Value.of_constr b;
-      Value.of_constr t;
-      Value.of_constr c;
-    |]
-  | App (c, cl) ->
-    v_blk 9 [|
-      Value.of_constr c;
-      Value.of_array Value.of_constr cl;
-    |]
-  | Const (cst, u) ->
-    v_blk 10 [|
-      Value.of_constant cst;
-      of_instance u;
-    |]
-  | Ind (ind, u) ->
-    v_blk 11 [|
-      Value.of_ext Value.val_inductive ind;
-      of_instance u;
-    |]
-  | Construct (cstr, u) ->
-    v_blk 12 [|
-      Value.of_ext Value.val_constructor cstr;
-      of_instance u;
-    |]
-  | Case (ci, c, t, bl) ->
-    v_blk 13 [|
-      Value.of_ext Value.val_case ci;
-      Value.of_constr c;
-      Value.of_constr t;
-      Value.of_array Value.of_constr bl;
-    |]
-  | Fix ((recs, i), def) ->
-    let (nas, ts, cs) = of_rec_declaration def in
-    v_blk 14 [|
-      Value.of_array Value.of_int recs;
-      Value.of_int i;
-      nas;
-      ts;
-      cs;
-    |]
-  | CoFix (i, def) ->
-    let (nas, ts, cs) = of_rec_declaration def in
-    v_blk 15 [|
-      Value.of_int i;
-      nas;
-      ts;
-      cs;
-    |]
-  | Proj (p, c) ->
-    v_blk 16 [|
-      Value.of_ext Value.val_projection p;
-      Value.of_constr c;
-    |]
-  | Int _ ->
-    assert false
-  end
-end
-
-let () = define1 "constr_make" valexpr begin fun knd ->
-  let c = match Tac2ffi.to_block knd with
-  | (0, [|n|]) ->
-    let n = Value.to_int n in
-    EConstr.mkRel n
-  | (1, [|id|]) ->
-    let id = Value.to_ident id in
-    EConstr.mkVar id
-  | (2, [|n|]) ->
-    let n = Value.to_int n in
-    EConstr.mkMeta n
-  | (3, [|evk; args|]) ->
-    let evk = Evar.unsafe_of_int (Value.to_int evk) in
-    let args = Value.to_array Value.to_constr args in
-    EConstr.mkEvar (evk, args)
-  | (4, [|s|]) ->
-    let s = Value.to_ext Value.val_sort s in
-    EConstr.mkSort (EConstr.Unsafe.to_sorts s)
-  | (5, [|c; k; t|]) ->
-    let c = Value.to_constr c in
-    let k = Value.to_ext Value.val_cast k in
-    let t = Value.to_constr t in
-    EConstr.mkCast (c, k, t)
-  | (6, [|na; t; u|]) ->
-    let na = to_annot to_name na in
-    let t = Value.to_constr t in
-    let u = Value.to_constr u in
-    EConstr.mkProd (na, t, u)
-  | (7, [|na; t; c|]) ->
-    let na = to_annot to_name na in
-    let t = Value.to_constr t in
-    let u = Value.to_constr c in
-    EConstr.mkLambda (na, t, u)
-  | (8, [|na; b; t; c|]) ->
-    let na = to_annot to_name na in
-    let b = Value.to_constr b in
-    let t = Value.to_constr t in
-    let c = Value.to_constr c in
-    EConstr.mkLetIn (na, b, t, c)
-  | (9, [|c; cl|]) ->
-    let c = Value.to_constr c in
-    let cl = Value.to_array Value.to_constr cl in
-    EConstr.mkApp (c, cl)
-  | (10, [|cst; u|]) ->
-    let cst = Value.to_constant cst in
-    let u = to_instance u in
-    EConstr.mkConstU (cst, u)
-  | (11, [|ind; u|]) ->
-    let ind = Value.to_ext Value.val_inductive ind in
-    let u = to_instance u in
-    EConstr.mkIndU (ind, u)
-  | (12, [|cstr; u|]) ->
-    let cstr = Value.to_ext Value.val_constructor cstr in
-    let u = to_instance u in
-    EConstr.mkConstructU (cstr, u)
-  | (13, [|ci; c; t; bl|]) ->
-    let ci = Value.to_ext Value.val_case ci in
-    let c = Value.to_constr c in
-    let t = Value.to_constr t in
-    let bl = Value.to_array Value.to_constr bl in
-    EConstr.mkCase (ci, c, t, bl)
-  | (14, [|recs; i; nas; ts; cs|]) ->
-    let recs = Value.to_array Value.to_int recs in
-    let i = Value.to_int i in
-    let def = to_rec_declaration (nas, ts, cs) in
-    EConstr.mkFix ((recs, i), def)
-  | (15, [|i; nas; ts; cs|]) ->
-    let i = Value.to_int i in
-    let def = to_rec_declaration (nas, ts, cs) in
-    EConstr.mkCoFix (i, def)
-  | (16, [|p; c|]) ->
-    let p = Value.to_ext Value.val_projection p in
-    let c = Value.to_constr c in
-    EConstr.mkProj (p, c)
-  | _ -> assert false
-  in
-  return (Value.of_constr c)
-end
-
-let () = define1 "constr_check" constr begin fun c ->
-  pf_apply begin fun env sigma ->
-    try
-      let (sigma, _) = Typing.type_of env sigma c in
-      Proofview.Unsafe.tclEVARS sigma >>= fun () ->
-      return (of_result Value.of_constr (Inl c))
-    with e when CErrors.noncritical e ->
-      let e = CErrors.push e in
-      return (of_result Value.of_constr (Inr e))
-  end
-end
-
-let () = define3 "constr_substnl" (list constr) int constr begin fun subst k c ->
-  let ans = EConstr.Vars.substnl subst k c in
-  return (Value.of_constr ans)
-end
-
-let () = define3 "constr_closenl" (list ident) int constr begin fun ids k c ->
-  let ans = EConstr.Vars.substn_vars k ids c in
-  return (Value.of_constr ans)
-end
-
-let () = define1 "constr_case" (repr_ext val_inductive) begin fun ind ->
-  Proofview.tclENV >>= fun env ->
-  try
-    let ans = Inductiveops.make_case_info env ind Sorts.Relevant Constr.RegularStyle in
-    return (Value.of_ext Value.val_case ans)
-  with e when CErrors.noncritical e ->
-    throw err_notfound
-end
-
-let () = define2 "constr_constructor" (repr_ext val_inductive) int begin fun (ind, i) k ->
-  Proofview.tclENV >>= fun env ->
-  try
-    let open Declarations in
-    let ans = Environ.lookup_mind ind env in
-    let _ = ans.mind_packets.(i).mind_consnames.(k) in
-    return (Value.of_ext val_constructor ((ind, i), (k + 1)))
-  with e when CErrors.noncritical e ->
-    throw err_notfound
-end
-
-let () = define3 "constr_in_context" ident constr closure begin fun id t c ->
-  Proofview.Goal.goals >>= function
-  | [gl] ->
-    gl >>= fun gl ->
-    let env = Proofview.Goal.env gl in
-    let sigma = Proofview.Goal.sigma gl in
-    let has_var =
-      try
-        let _ = Environ.lookup_named_val id env in
-        true
-      with Not_found -> false
-    in
-    if has_var then
-      Tacticals.New.tclZEROMSG (str "Variable already exists")
-    else
-      let open Context.Named.Declaration in
-      let nenv = EConstr.push_named (LocalAssum (Context.make_annot id Sorts.Relevant, t)) env in
-      let (sigma, (evt, _)) = Evarutil.new_type_evar nenv sigma Evd.univ_flexible in
-      let (sigma, evk) = Evarutil.new_pure_evar (Environ.named_context_val nenv) sigma evt in
-      Proofview.Unsafe.tclEVARS sigma >>= fun () ->
-      Proofview.Unsafe.tclSETGOALS [Proofview.with_empty_state evk] >>= fun () ->
-      thaw c >>= fun _ ->
-      Proofview.Unsafe.tclSETGOALS [Proofview.with_empty_state (Proofview.Goal.goal gl)] >>= fun () ->
-      let args = List.map (fun d -> EConstr.mkVar (get_id d)) (EConstr.named_context env) in
-      let args = Array.of_list (EConstr.mkRel 1 :: args) in
-      let ans = EConstr.mkEvar (evk, args) in
-      let ans = EConstr.mkLambda (Context.make_annot (Name id) Sorts.Relevant, t, ans) in
-      return (Value.of_constr ans)
-  | _ ->
-    throw err_notfocussed
-end
-
-(** Patterns *)
-
-let empty_context = EConstr.mkMeta Constr_matching.special_meta
-
-let () = define0 "pattern_empty_context" begin
-  return (Value.of_constr empty_context)
-end
-
-let () = define2 "pattern_matches" pattern constr begin fun pat c ->
-  pf_apply begin fun env sigma ->
-    let ans =
-      try Some (Constr_matching.matches env sigma pat c)
-      with Constr_matching.PatternMatchingFailure -> None
-    in
-    begin match ans with
-    | None -> fail err_matchfailure
-    | Some ans ->
-      let ans = Id.Map.bindings ans in
-      let of_pair (id, c) = Value.of_tuple [| Value.of_ident id; Value.of_constr c |] in
-      return (Value.of_list of_pair ans)
-    end
-  end
-end
-
-let () = define2 "pattern_matches_subterm" pattern constr begin fun pat c ->
-  let open Constr_matching in
-  let rec of_ans s = match IStream.peek s with
-  | IStream.Nil -> fail err_matchfailure
-  | IStream.Cons ({ m_sub = (_, sub); m_ctx }, s) ->
-    let ans = Id.Map.bindings sub in
-    let of_pair (id, c) = Value.of_tuple [| Value.of_ident id; Value.of_constr c |] in
-    let ans = Value.of_tuple [| Value.of_constr (Lazy.force m_ctx); Value.of_list of_pair ans |] in
-    Proofview.tclOR (return ans) (fun _ -> of_ans s)
-  in
-  pf_apply begin fun env sigma ->
-    let ans = Constr_matching.match_subterm env sigma (Id.Set.empty,pat) c in
-    of_ans ans
-  end
-end
-
-let () = define2 "pattern_matches_vect" pattern constr begin fun pat c ->
-  pf_apply begin fun env sigma ->
-    let ans =
-      try Some (Constr_matching.matches env sigma pat c)
-      with Constr_matching.PatternMatchingFailure -> None
-    in
-    begin match ans with
-    | None -> fail err_matchfailure
-    | Some ans ->
-      let ans = Id.Map.bindings ans in
-      let ans = Array.map_of_list snd ans in
-      return (Value.of_array Value.of_constr ans)
-    end
-  end
-end
-
-let () = define2 "pattern_matches_subterm_vect" pattern constr begin fun pat c ->
-  let open Constr_matching in
-  let rec of_ans s = match IStream.peek s with
-  | IStream.Nil -> fail err_matchfailure
-  | IStream.Cons ({ m_sub = (_, sub); m_ctx }, s) ->
-    let ans = Id.Map.bindings sub in
-    let ans = Array.map_of_list snd ans in
-    let ans = Value.of_tuple [| Value.of_constr (Lazy.force m_ctx); Value.of_array Value.of_constr ans |] in
-    Proofview.tclOR (return ans) (fun _ -> of_ans s)
-  in
-  pf_apply begin fun env sigma ->
-    let ans = Constr_matching.match_subterm env sigma (Id.Set.empty,pat) c in
-    of_ans ans
-  end
-end
-
-let () = define3 "pattern_matches_goal" bool (list (pair bool pattern)) (pair bool pattern) begin fun rev hp cp ->
-  assert_focussed >>= fun () ->
-  Proofview.Goal.enter_one begin fun gl ->
-  let env = Proofview.Goal.env gl in
-  let sigma = Proofview.Goal.sigma gl in
-  let concl = Proofview.Goal.concl gl in
-  let mk_pattern (b, pat) = if b then Tac2match.MatchPattern pat else Tac2match.MatchContext pat in
-  let r = (List.map mk_pattern hp, mk_pattern cp) in
-  Tac2match.match_goal env sigma concl ~rev r >>= fun (hyps, ctx, subst) ->
-    let of_ctxopt ctx = Value.of_constr (Option.default empty_context ctx) in
-    let hids = Value.of_array Value.of_ident (Array.map_of_list fst hyps) in
-    let hctx = Value.of_array of_ctxopt (Array.map_of_list snd hyps) in
-    let subs = Value.of_array Value.of_constr (Array.map_of_list snd (Id.Map.bindings subst)) in
-    let cctx = of_ctxopt ctx in
-    let ans = Value.of_tuple [| hids; hctx; subs; cctx |] in
-    Proofview.tclUNIT ans
-  end
-end
-
-let () = define2 "pattern_instantiate" constr constr begin fun ctx c ->
-  let ctx = EConstr.Unsafe.to_constr ctx in
-  let c = EConstr.Unsafe.to_constr c in
-  let ans = Termops.subst_meta [Constr_matching.special_meta, c] ctx in
-  return (Value.of_constr (EConstr.of_constr ans))
-end
-
-(** Error *)
-
-let () = define1 "throw" exn begin fun (e, info) ->
-  throw ~info e
-end
-
-(** Control *)
-
-(** exn -> 'a *)
-let () = define1 "zero" exn begin fun (e, info) ->
-  fail ~info e
-end
-
-(** (unit -> 'a) -> (exn -> 'a) -> 'a *)
-let () = define2 "plus" closure closure begin fun x k ->
-  Proofview.tclOR (thaw x) (fun e -> Tac2ffi.apply k [Value.of_exn e])
-end
-
-(** (unit -> 'a) -> 'a *)
-let () = define1 "once" closure begin fun f ->
-  Proofview.tclONCE (thaw f)
-end
-
-(** (unit -> unit) list -> unit *)
-let () = define1 "dispatch" (list closure) begin fun l ->
-  let l = List.map (fun f -> Proofview.tclIGNORE (thaw f)) l in
-  Proofview.tclDISPATCH l >>= fun () -> return v_unit
-end
-
-(** (unit -> unit) list -> (unit -> unit) -> (unit -> unit) list -> unit *)
-let () = define3 "extend" (list closure) closure (list closure) begin fun lft tac rgt ->
-  let lft = List.map (fun f -> Proofview.tclIGNORE (thaw f)) lft in
-  let tac = Proofview.tclIGNORE (thaw tac) in
-  let rgt = List.map (fun f -> Proofview.tclIGNORE (thaw f)) rgt in
-  Proofview.tclEXTEND lft tac rgt >>= fun () -> return v_unit
-end
-
-(** (unit -> unit) -> unit *)
-let () = define1 "enter" closure begin fun f ->
-  let f = Proofview.tclIGNORE (thaw f) in
-  Proofview.tclINDEPENDENT f >>= fun () -> return v_unit
-end
-
-(** (unit -> 'a) -> ('a * ('exn -> 'a)) result *)
-let () = define1 "case" closure begin fun f ->
-  Proofview.tclCASE (thaw f) >>= begin function
-  | Proofview.Next (x, k) ->
-    let k = Tac2ffi.mk_closure arity_one begin fun e ->
-      let (e, info) = Value.to_exn e in
-      set_bt info >>= fun info ->
-      k (e, info)
-    end in
-    return (v_blk 0 [| Value.of_tuple [| x; Value.of_closure k |] |])
-  | Proofview.Fail e -> return (v_blk 1 [| Value.of_exn e |])
-  end
-end
-
-(** int -> int -> (unit -> 'a) -> 'a *)
-let () = define3 "focus" int int closure begin fun i j tac ->
-  Proofview.tclFOCUS i j (thaw tac)
-end
-
-(** unit -> unit *)
-let () = define0 "shelve" begin
-  Proofview.shelve >>= fun () -> return v_unit
-end
-
-(** unit -> unit *)
-let () = define0 "shelve_unifiable" begin
-  Proofview.shelve_unifiable >>= fun () -> return v_unit
-end
-
-let () = define1 "new_goal" int begin fun ev ->
-  let ev = Evar.unsafe_of_int ev in
-  Proofview.tclEVARMAP >>= fun sigma ->
-  if Evd.mem sigma ev then
-    Proofview.Unsafe.tclNEWGOALS [Proofview.with_empty_state ev] <*> Proofview.tclUNIT v_unit
-  else throw err_notfound
-end
-
-(** unit -> constr *)
-let () = define0 "goal" begin
-  assert_focussed >>= fun () ->
-  Proofview.Goal.enter_one begin fun gl ->
-    let concl = Tacmach.New.pf_nf_concl gl in
-    return (Value.of_constr concl)
-  end
-end
-
-(** ident -> constr *)
-let () = define1 "hyp" ident begin fun id ->
-  pf_apply begin fun env _ ->
-    let mem = try ignore (Environ.lookup_named id env); true with Not_found -> false in
-    if mem then return (Value.of_constr (EConstr.mkVar id))
-    else Tacticals.New.tclZEROMSG
-      (str "Hypothesis " ++ quote (Id.print id) ++ str " not found") (* FIXME: Do something more sensible *)
-  end
-end
-
-let () = define0 "hyps" begin
-  pf_apply begin fun env _ ->
-    let open Context in
-    let open Named.Declaration in
-    let hyps = List.rev (Environ.named_context env) in
-    let map = function
-    | LocalAssum (id, t) ->
-      let t = EConstr.of_constr t in
-      Value.of_tuple [|Value.of_ident id.binder_name; Value.of_option Value.of_constr None; Value.of_constr t|]
-    | LocalDef (id, c, t) ->
-      let c = EConstr.of_constr c in
-      let t = EConstr.of_constr t in
-      Value.of_tuple [|Value.of_ident id.binder_name; Value.of_option Value.of_constr (Some c); Value.of_constr t|]
-    in
-    return (Value.of_list map hyps)
-  end
-end
-
-(** (unit -> constr) -> unit *)
-let () = define1 "refine" closure begin fun c ->
-  let c = thaw c >>= fun c -> Proofview.tclUNIT ((), Value.to_constr c) in
-  Proofview.Goal.enter begin fun gl ->
-    Refine.generic_refine ~typecheck:true c gl
-  end >>= fun () -> return v_unit
-end
-
-let () = define2 "with_holes" closure closure begin fun x f ->
-  Proofview.tclEVARMAP >>= fun sigma0 ->
-  thaw x >>= fun ans ->
-  Proofview.tclEVARMAP >>= fun sigma ->
-  Proofview.Unsafe.tclEVARS sigma0 >>= fun () ->
-  Tacticals.New.tclWITHHOLES false (Tac2ffi.apply f [ans]) sigma
-end
-
-let () = define1 "progress" closure begin fun f ->
-  Proofview.tclPROGRESS (thaw f)
-end
-
-let () = define2 "abstract" (option ident) closure begin fun id f ->
-  Abstract.tclABSTRACT id (Proofview.tclIGNORE (thaw f)) >>= fun () ->
-  return v_unit
-end
-
-let () = define2 "time" (option string) closure begin fun s f ->
-  let s = Option.map Bytes.to_string s in
-  Proofview.tclTIME s (thaw f)
-end
-
-let () = define0 "check_interrupt" begin
-  Proofview.tclCHECKINTERRUPT >>= fun () -> return v_unit
-end
-
-(** Fresh *)
-
-let () = define2 "fresh_free_union" (repr_ext val_free) (repr_ext val_free) begin fun set1 set2 ->
-  let ans = Id.Set.union set1 set2 in
-  return (Value.of_ext Value.val_free ans)
-end
-
-let () = define1 "fresh_free_of_ids" (list ident) begin fun ids ->
-  let free = List.fold_right Id.Set.add ids Id.Set.empty in
-  return (Value.of_ext Value.val_free free)
-end
-
-let () = define1 "fresh_free_of_constr" constr begin fun c ->
-  Proofview.tclEVARMAP >>= fun sigma ->
-  let rec fold accu c = match EConstr.kind sigma c with
-  | Constr.Var id -> Id.Set.add id accu
-  | _ -> EConstr.fold sigma fold accu c
-  in
-  let ans = fold Id.Set.empty c in
-  return (Value.of_ext Value.val_free ans)
-end
-
-let () = define2 "fresh_fresh" (repr_ext val_free) ident begin fun avoid id ->
-  let nid = Namegen.next_ident_away_from id (fun id -> Id.Set.mem id avoid) in
-  return (Value.of_ident nid)
-end
-
-(** Env *)
-
-let () = define1 "env_get" (list ident) begin fun ids ->
-  let r = match ids with
-  | [] -> None
-  | _ :: _ as ids ->
-    let (id, path) = List.sep_last ids in
-    let path = DirPath.make (List.rev path) in
-    let fp = Libnames.make_path path id in
-    try Some (Nametab.global_of_path fp) with Not_found -> None
-  in
-  return (Value.of_option Value.of_reference r)
-end
-
-let () = define1 "env_expand" (list ident) begin fun ids ->
-  let r = match ids with
-  | [] -> []
-  | _ :: _ as ids ->
-    let (id, path) = List.sep_last ids in
-    let path = DirPath.make (List.rev path) in
-    let qid = Libnames.make_qualid path id in
-    Nametab.locate_all qid
-  in
-  return (Value.of_list Value.of_reference r)
-end
-
-let () = define1 "env_path" reference begin fun r ->
-  match Nametab.path_of_global r with
-  | fp ->
-    let (path, id) = Libnames.repr_path fp in
-    let path = DirPath.repr path in
-    return (Value.of_list Value.of_ident (List.rev_append path [id]))
-  | exception Not_found ->
-    throw err_notfound
-end
-
-let () = define1 "env_instantiate" reference begin fun r ->
-  Proofview.tclENV >>= fun env ->
-  Proofview.tclEVARMAP >>= fun sigma ->
-  let (sigma, c) = Evd.fresh_global env sigma r in
-  Proofview.Unsafe.tclEVARS sigma >>= fun () ->
-  return (Value.of_constr c)
-end
-
-(** Ltac1 in Ltac2 *)
-
-let ltac1 = Tac2ffi.repr_ext Value.val_ltac1
-let of_ltac1 v = Value.of_ext Value.val_ltac1 v
-
-let () = define1 "ltac1_ref" (list ident) begin fun ids ->
-  let open Ltac_plugin in
-  let r = match ids with
-  | [] -> raise Not_found
-  | _ :: _ as ids ->
-    let (id, path) = List.sep_last ids in
-    let path = DirPath.make (List.rev path) in
-    let fp = Libnames.make_path path id in
-    if Tacenv.exists_tactic fp then
-      List.hd (Tacenv.locate_extended_all_tactic (Libnames.qualid_of_path fp))
-    else raise Not_found
-  in
-  let tac = Tacinterp.Value.of_closure (Tacinterp.default_ist ()) (Tacenv.interp_ltac r) in
-  return (Value.of_ext val_ltac1 tac)
-end
-
-let () = define1 "ltac1_run" ltac1 begin fun v ->
-  let open Ltac_plugin in
-  Tacinterp.tactic_of_value (Tacinterp.default_ist ()) v >>= fun () ->
-  return v_unit
-end
-
-let () = define3 "ltac1_apply" ltac1 (list ltac1) closure begin fun f args k ->
-  let open Ltac_plugin in
-  let open Tacexpr in
-  let open Locus in
-  let k ret =
-    Proofview.tclIGNORE (Tac2ffi.apply k [Value.of_ext val_ltac1 ret])
-  in
-  let fold arg (i, vars, lfun) =
-    let id = Id.of_string ("x" ^ string_of_int i) in
-    let x = Reference (ArgVar CAst.(make id)) in
-    (succ i, x :: vars, Id.Map.add id arg lfun)
-  in
-  let (_, args, lfun) = List.fold_right fold args (0, [], Id.Map.empty) in
-  let lfun = Id.Map.add (Id.of_string "F") f lfun in
-  let ist = { (Tacinterp.default_ist ()) with Tacinterp.lfun = lfun; } in
-  let tac = TacArg(CAst.make @@ TacCall (CAst.make (ArgVar CAst.(make @@ Id.of_string "F"),args))) in
-  Tacinterp.val_interp ist tac k >>= fun () ->
-  return v_unit
-end
-
-let () = define1 "ltac1_of_constr" constr begin fun c ->
-  let open Ltac_plugin in
-  return (Value.of_ext val_ltac1 (Tacinterp.Value.of_constr c))
-end
-
-let () = define1 "ltac1_to_constr" ltac1 begin fun v ->
-  let open Ltac_plugin in
-  return (Value.of_option Value.of_constr (Tacinterp.Value.to_constr v))
-end
-
-let () = define1 "ltac1_of_list" (list ltac1) begin fun l ->
-  let open Geninterp.Val in
-  return (Value.of_ext val_ltac1 (inject (Base typ_list) l))
-end
-
-let () = define1 "ltac1_to_list" ltac1 begin fun v ->
-  let open Ltac_plugin in
-  return (Value.of_option (Value.of_list of_ltac1) (Tacinterp.Value.to_list v))
-end
-
-(** ML types *)
-
-let constr_flags () =
-  let open Pretyping in
-  {
-    use_typeclasses = true;
-    solve_unification_constraints = true;
-    fail_evar = true;
-    expand_evars = true;
-    program_mode = false;
-    polymorphic = false;
-  }
-
-let open_constr_no_classes_flags () =
-  let open Pretyping in
-  {
-  use_typeclasses = false;
-  solve_unification_constraints = true;
-  fail_evar = false;
-  expand_evars = true;
-  program_mode = false;
-  polymorphic = false;
-  }
-
-(** Embed all Ltac2 data into Values *)
-let to_lvar ist =
-  let open Glob_ops in
-  let lfun = Tac2interp.set_env ist Id.Map.empty in
-  { empty_lvar with Ltac_pretype.ltac_genargs = lfun }
-
-let gtypref kn = GTypRef (Other kn, [])
-
-let intern_constr self ist c =
-  let (_, (c, _)) = Genintern.intern Stdarg.wit_constr ist c in
-  (GlbVal c, gtypref t_constr)
-
-let catchable_exception = function
-  | Logic_monad.Exception _ -> false
-  | e -> CErrors.noncritical e
-
-let interp_constr flags ist c =
-  let open Pretyping in
-  let ist = to_lvar ist in
-  pf_apply begin fun env sigma ->
-  try
-    let (sigma, c) = understand_ltac flags env sigma ist WithoutTypeConstraint c in
-    let c = Value.of_constr c in
-    Proofview.Unsafe.tclEVARS sigma >>= fun () ->
-    Proofview.tclUNIT c
-  with e when catchable_exception e ->
-    let (e, info) = CErrors.push e in
-    set_bt info >>= fun info ->
-    match Exninfo.get info fatal_flag with
-    | None -> Proofview.tclZERO ~info e
-    | Some () -> throw ~info e
-  end
-
-let () =
-  let intern = intern_constr in
-  let interp ist c = interp_constr (constr_flags ()) ist c in
-  let print env c = str "constr:(" ++ Printer.pr_lglob_constr_env env c ++ str ")" in
-  let subst subst c = Detyping.subst_glob_constr (Global.env()) subst c in
-  let obj = {
-    ml_intern = intern;
-    ml_subst = subst;
-    ml_interp = interp;
-    ml_print = print;
-  } in
-  define_ml_object Tac2quote.wit_constr obj
-
-let () =
-  let intern = intern_constr in
-  let interp ist c = interp_constr (open_constr_no_classes_flags ()) ist c in
-  let print env c = str "open_constr:(" ++ Printer.pr_lglob_constr_env env c ++ str ")" in
-  let subst subst c = Detyping.subst_glob_constr (Global.env()) subst c in
-  let obj = {
-    ml_intern = intern;
-    ml_subst = subst;
-    ml_interp = interp;
-    ml_print = print;
-  } in
-  define_ml_object Tac2quote.wit_open_constr obj
-
-let () =
-  let interp _ id = return (Value.of_ident id) in
-  let print _ id = str "ident:(" ++ Id.print id ++ str ")" in
-  let obj = {
-    ml_intern = (fun _ _ id -> GlbVal id, gtypref t_ident);
-    ml_interp = interp;
-    ml_subst = (fun _ id -> id);
-    ml_print = print;
-  } in
-  define_ml_object Tac2quote.wit_ident obj
-
-let () =
-  let intern self ist c =
-    let env = ist.Genintern.genv in
-    let sigma = Evd.from_env env in
-    let warn = if !Ltac_plugin.Tacintern.strict_check then fun x -> x else Constrintern.for_grammar in
-    let _, pat = warn (fun () ->Constrintern.intern_constr_pattern env sigma ~as_type:false c) () in
-    GlbVal pat, gtypref t_pattern
-  in
-  let subst subst c =
-    let env = Global.env () in
-    let sigma = Evd.from_env env in
-    Patternops.subst_pattern env sigma subst c
-  in
-  let print env pat = str "pattern:(" ++ Printer.pr_lconstr_pattern_env env Evd.empty pat ++ str ")" in
-  let interp _ c = return (Value.of_pattern c) in
-  let obj = {
-    ml_intern = intern;
-    ml_interp = interp;
-    ml_subst = subst;
-    ml_print = print;
-  } in
-  define_ml_object Tac2quote.wit_pattern obj
-
-let () =
-  let intern self ist ref = match ref.CAst.v with
-  | Tac2qexpr.QHypothesis id ->
-    GlbVal (Globnames.VarRef id), gtypref t_reference
-  | Tac2qexpr.QReference qid ->
-    let gr =
-      try Nametab.locate qid
-      with Not_found ->
-        Nametab.error_global_not_found qid
-    in
-    GlbVal gr, gtypref t_reference
-  in
-  let subst s c = Globnames.subst_global_reference s c in
-  let interp _ gr = return (Value.of_reference gr) in
-  let print _ = function
-  | Globnames.VarRef id -> str "reference:(" ++ str "&" ++ Id.print id ++ str ")"
-  | r -> str "reference:(" ++ Printer.pr_global r ++ str ")"
-  in
-  let obj = {
-    ml_intern = intern;
-    ml_subst = subst;
-    ml_interp = interp;
-    ml_print = print;
-  } in
-  define_ml_object Tac2quote.wit_reference obj
-
-let () =
-  let intern self ist tac =
-    (* Prevent inner calls to Ltac2 values *)
-    let extra = Tac2intern.drop_ltac2_env ist.Genintern.extra in
-    let ist = { ist with Genintern.extra } in
-    let _, tac = Genintern.intern Ltac_plugin.Tacarg.wit_tactic ist tac in
-    GlbVal tac, gtypref t_unit
-  in
-  let interp ist tac =
-    let ist = { env_ist = Id.Map.empty } in
-    let lfun = Tac2interp.set_env ist Id.Map.empty in
-    let ist = Ltac_plugin.Tacinterp.default_ist () in
-    let ist = { ist with Geninterp.lfun = lfun } in
-    let tac = (Ltac_plugin.Tacinterp.eval_tactic_ist ist tac : unit Proofview.tactic) in
-    let wrap (e, info) = set_bt info >>= fun info -> Proofview.tclZERO ~info e in
-    Proofview.tclOR tac wrap >>= fun () ->
-    return v_unit
-  in
-  let subst s tac = Genintern.substitute Ltac_plugin.Tacarg.wit_tactic s tac in
-  let print env tac =
-    str "ltac1:(" ++ Ltac_plugin.Pptactic.pr_glob_tactic env tac ++ str ")"
-  in
-  let obj = {
-    ml_intern = intern;
-    ml_subst = subst;
-    ml_interp = interp;
-    ml_print = print;
-  } in
-  define_ml_object Tac2quote.wit_ltac1 obj
-
-let () =
-  let open Ltac_plugin in
-  let intern self ist tac =
-    (* Prevent inner calls to Ltac2 values *)
-    let extra = Tac2intern.drop_ltac2_env ist.Genintern.extra in
-    let ist = { ist with Genintern.extra } in
-    let _, tac = Genintern.intern Ltac_plugin.Tacarg.wit_tactic ist tac in
-    GlbVal tac, gtypref t_ltac1
-  in
-  let interp ist tac =
-    let ist = { env_ist = Id.Map.empty } in
-    let lfun = Tac2interp.set_env ist Id.Map.empty in
-    let ist = Ltac_plugin.Tacinterp.default_ist () in
-    let ist = { ist with Geninterp.lfun = lfun } in
-    return (Value.of_ext val_ltac1 (Tacinterp.Value.of_closure ist tac))
-  in
-  let subst s tac = Genintern.substitute Tacarg.wit_tactic s tac in
-  let print env tac =
-    str "ltac1val:(" ++ Ltac_plugin.Pptactic.pr_glob_tactic env tac ++ str ")"
-  in
-  let obj = {
-    ml_intern = intern;
-    ml_subst = subst;
-    ml_interp = interp;
-    ml_print = print;
-  } in
-  define_ml_object Tac2quote.wit_ltac1val obj
-
-(** Ltac2 in terms *)
-
-let () =
-  let interp ist poly env sigma concl tac =
-    let ist = Tac2interp.get_env ist in
-    let tac = Proofview.tclIGNORE (Tac2interp.interp ist tac) in
-    let name, poly = Id.of_string "ltac2", poly in
-    let c, sigma = Pfedit.refine_by_tactic ~name ~poly env sigma concl tac in
-    (EConstr.of_constr c, sigma)
-  in
-  GlobEnv.register_constr_interp0 wit_ltac2 interp
-
-let () =
-  let interp ist poly env sigma concl id =
-    let ist = Tac2interp.get_env ist in
-    let c = Id.Map.find id ist.env_ist in
-    let c = Value.to_constr c in
-    let sigma = Typing.check env sigma c concl in
-    (c, sigma)
-  in
-  GlobEnv.register_constr_interp0 wit_ltac2_quotation interp
-
-let () =
-  let pr_raw id = Genprint.PrinterBasic (fun _env _sigma -> mt ()) in
-  let pr_glb id = Genprint.PrinterBasic (fun _env _sigma -> str "$" ++ Id.print id) in
-  let pr_top _ = Genprint.TopPrinterBasic mt in
-  Genprint.register_print0 wit_ltac2_quotation pr_raw pr_glb pr_top
-
-(** Ltac2 in Ltac1 *)
-
-let () =
-  let e = Tac2entries.Pltac.tac2expr in
-  let inject (loc, v) = Ltac_plugin.Tacexpr.TacGeneric (in_gen (rawwit wit_ltac2) v) in
-  Ltac_plugin.Tacentries.create_ltac_quotation "ltac2" inject (e, None)
-
-let () =
-  let open Ltac_plugin in
-  let open Tacinterp in
-  let idtac = Value.of_closure (default_ist ()) (Tacexpr.TacId []) in
-  let interp ist tac =
-(*     let ist = Tac2interp.get_env ist.Geninterp.lfun in *)
-    let ist = { env_ist = Id.Map.empty } in
-    Tac2interp.interp ist tac >>= fun _ ->
-    Ftactic.return idtac
-  in
-  Geninterp.register_interp0 wit_ltac2 interp
-
-let () =
-  let pr_raw _ = Genprint.PrinterBasic (fun _env _sigma -> mt ()) in
-  let pr_glb e = Genprint.PrinterBasic (fun _env _sigma -> Tac2print.pr_glbexpr e) in
-  let pr_top _ = Genprint.TopPrinterBasic mt in
-  Genprint.register_print0 wit_ltac2 pr_raw pr_glb pr_top
-
-(** Built-in notation scopes *)
-
-let add_scope s f =
-  Tac2entries.register_scope (Id.of_string s) f
-
-let rec pr_scope = let open CAst in function
-| SexprStr {v=s} -> qstring s
-| SexprInt {v=n} -> Pp.int n
-| SexprRec (_, {v=na}, args) ->
-  let na = match na with
-  | None -> str "_"
-  | Some id -> Id.print id
-  in
-  na ++ str "(" ++ prlist_with_sep (fun () -> str ", ") pr_scope args ++ str ")"
-
-let scope_fail s args =
-  let args = str "(" ++ prlist_with_sep (fun () -> str ", ") pr_scope args ++ str ")" in
-  CErrors.user_err (str "Invalid arguments " ++ args ++ str " in scope " ++ str s)
-
-let q_unit = CAst.make @@ CTacCst (AbsKn (Tuple 0))
-
-let add_generic_scope s entry arg =
-  let parse = function
-  | [] ->
-    let scope = Extend.Aentry entry in
-    let act x = CAst.make @@ CTacExt (arg, x) in
-    Tac2entries.ScopeRule (scope, act)
-  | arg -> scope_fail s arg
-  in
-  add_scope s parse
-
-open CAst
-
-let () = add_scope "keyword" begin function
-| [SexprStr {loc;v=s}] ->
-  let scope = Extend.Atoken (Tok.PKEYWORD s) in
-  Tac2entries.ScopeRule (scope, (fun _ -> q_unit))
-| arg -> scope_fail "keyword" arg
-end
-
-let () = add_scope "terminal" begin function
-| [SexprStr {loc;v=s}] ->
-  let scope = Extend.Atoken (CLexer.terminal s) in
-  Tac2entries.ScopeRule (scope, (fun _ -> q_unit))
-| arg -> scope_fail "terminal" arg
-end
-
-let () = add_scope "list0" begin function
-| [tok] ->
-  let Tac2entries.ScopeRule (scope, act) = Tac2entries.parse_scope tok in
-  let scope = Extend.Alist0 scope in
-  let act l = Tac2quote.of_list act l in
-  Tac2entries.ScopeRule (scope, act)
-| [tok; SexprStr {v=str}] ->
-  let Tac2entries.ScopeRule (scope, act) = Tac2entries.parse_scope tok in
-  let sep = Extend.Atoken (CLexer.terminal str) in
-  let scope = Extend.Alist0sep (scope, sep) in
-  let act l = Tac2quote.of_list act l in
-  Tac2entries.ScopeRule (scope, act)
-| arg -> scope_fail "list0" arg
-end
-
-let () = add_scope "list1" begin function
-| [tok] ->
-  let Tac2entries.ScopeRule (scope, act) = Tac2entries.parse_scope tok in
-  let scope = Extend.Alist1 scope in
-  let act l = Tac2quote.of_list act l in
-  Tac2entries.ScopeRule (scope, act)
-| [tok; SexprStr {v=str}] ->
-  let Tac2entries.ScopeRule (scope, act) = Tac2entries.parse_scope tok in
-  let sep = Extend.Atoken (CLexer.terminal str) in
-  let scope = Extend.Alist1sep (scope, sep) in
-  let act l = Tac2quote.of_list act l in
-  Tac2entries.ScopeRule (scope, act)
-| arg -> scope_fail "list1" arg
-end
-
-let () = add_scope "opt" begin function
-| [tok] ->
-  let Tac2entries.ScopeRule (scope, act) = Tac2entries.parse_scope tok in
-  let scope = Extend.Aopt scope in
-  let act opt = match opt with
-  | None ->
-    CAst.make @@ CTacCst (AbsKn (Other Core.c_none))
-  | Some x ->
-    CAst.make @@ CTacApp (CAst.make @@ CTacCst (AbsKn (Other Core.c_some)), [act x])
-  in
-  Tac2entries.ScopeRule (scope, act)
-| arg -> scope_fail "opt" arg
-end
-
-let () = add_scope "self" begin function
-| [] ->
-  let scope = Extend.Aself in
-  let act tac = tac in
-  Tac2entries.ScopeRule (scope, act)
-| arg -> scope_fail "self" arg
-end
-
-let () = add_scope "next" begin function
-| [] ->
-  let scope = Extend.Anext in
-  let act tac = tac in
-  Tac2entries.ScopeRule (scope, act)
-| arg -> scope_fail "next" arg
-end
-
-let () = add_scope "tactic" begin function
-| [] ->
-  (* Default to level 5 parsing *)
-  let scope = Extend.Aentryl (tac2expr, "5") in
-  let act tac = tac in
-  Tac2entries.ScopeRule (scope, act)
-| [SexprInt {loc;v=n}] as arg ->
-  let () = if n < 0 || n > 6 then scope_fail "tactic" arg in
-  let scope = Extend.Aentryl (tac2expr, string_of_int n) in
-  let act tac = tac in
-  Tac2entries.ScopeRule (scope, act)
-| arg -> scope_fail "tactic" arg
-end
-
-let () = add_scope "thunk" begin function
-| [tok] ->
-  let Tac2entries.ScopeRule (scope, act) = Tac2entries.parse_scope tok in
-  let act e = Tac2quote.thunk (act e) in
-  Tac2entries.ScopeRule (scope, act)
-| arg -> scope_fail "thunk" arg
-end
-
-let add_expr_scope name entry f =
-  add_scope name begin function
-  | [] -> Tac2entries.ScopeRule (Extend.Aentry entry, f)
-  | arg -> scope_fail name arg
-  end
-
-let () = add_expr_scope "ident" q_ident (fun id -> Tac2quote.of_anti Tac2quote.of_ident id)
-let () = add_expr_scope "bindings" q_bindings Tac2quote.of_bindings
-let () = add_expr_scope "with_bindings" q_with_bindings Tac2quote.of_bindings
-let () = add_expr_scope "intropattern" q_intropattern Tac2quote.of_intro_pattern
-let () = add_expr_scope "intropatterns" q_intropatterns Tac2quote.of_intro_patterns
-let () = add_expr_scope "destruction_arg" q_destruction_arg Tac2quote.of_destruction_arg
-let () = add_expr_scope "induction_clause" q_induction_clause Tac2quote.of_induction_clause
-let () = add_expr_scope "conversion" q_conversion Tac2quote.of_conversion
-let () = add_expr_scope "rewriting" q_rewriting Tac2quote.of_rewriting
-let () = add_expr_scope "clause" q_clause Tac2quote.of_clause
-let () = add_expr_scope "hintdb" q_hintdb Tac2quote.of_hintdb
-let () = add_expr_scope "occurrences" q_occurrences Tac2quote.of_occurrences
-let () = add_expr_scope "dispatch" q_dispatch Tac2quote.of_dispatch
-let () = add_expr_scope "strategy" q_strategy_flag Tac2quote.of_strategy_flag
-let () = add_expr_scope "reference" q_reference Tac2quote.of_reference
-let () = add_expr_scope "move_location" q_move_location Tac2quote.of_move_location
-let () = add_expr_scope "pose" q_pose Tac2quote.of_pose
-let () = add_expr_scope "assert" q_assert Tac2quote.of_assertion
-let () = add_expr_scope "constr_matching" q_constr_matching Tac2quote.of_constr_matching
-let () = add_expr_scope "goal_matching" q_goal_matching Tac2quote.of_goal_matching
-
-let () = add_generic_scope "constr" Pcoq.Constr.constr Tac2quote.wit_constr
-let () = add_generic_scope "open_constr" Pcoq.Constr.constr Tac2quote.wit_open_constr
-let () = add_generic_scope "pattern" Pcoq.Constr.constr Tac2quote.wit_pattern
-
-(** seq scope, a bit hairy *)
-
-open Extend
-exception SelfSymbol
-
-let rec generalize_symbol :
-  type a tr s. (s, tr, a) Extend.symbol -> (s, Extend.norec, a) Extend.symbol = function
-| Atoken tok -> Atoken tok
-| Alist1 e -> Alist1 (generalize_symbol e)
-| Alist1sep (e, sep) ->
-  let e = generalize_symbol e in
-  let sep = generalize_symbol sep in
-  Alist1sep (e, sep)
-| Alist0 e -> Alist0 (generalize_symbol e)
-| Alist0sep (e, sep) ->
-  let e = generalize_symbol e in
-  let sep = generalize_symbol sep in
-  Alist0sep (e, sep)
-| Aopt e -> Aopt (generalize_symbol e)
-| Aself -> raise SelfSymbol
-| Anext -> raise SelfSymbol
-| Aentry e -> Aentry e
-| Aentryl (e, l) -> Aentryl (e, l)
-| Arules r -> Arules r
-
-type _ converter =
-| CvNil : (Loc.t -> raw_tacexpr) converter
-| CvCns : 'act converter * ('a -> raw_tacexpr) option -> ('a -> 'act) converter
-
-let rec apply : type a. a converter -> raw_tacexpr list -> a = function
-| CvNil -> fun accu loc -> Tac2quote.of_tuple ~loc accu
-| CvCns (c, None) -> fun accu x -> apply c accu
-| CvCns (c, Some f) -> fun accu x -> apply c (f x :: accu)
-
-type seqrule =
-| Seqrule : (Tac2expr.raw_tacexpr, Extend.norec, 'act, Loc.t -> raw_tacexpr) rule * 'act converter -> seqrule
-
-let rec make_seq_rule = function
-| [] ->
-  Seqrule (Stop, CvNil)
-| tok :: rem ->
-  let Tac2entries.ScopeRule (scope, f) = Tac2entries.parse_scope tok in
-  let scope = generalize_symbol scope in
-  let Seqrule (r, c) = make_seq_rule rem in
-  let r = NextNoRec (r, scope) in
-  let f = match tok with
-  | SexprStr _ -> None (* Leave out mere strings *)
-  | _ -> Some f
-  in
-  Seqrule (r, CvCns (c, f))
-
-let () = add_scope "seq" begin fun toks ->
-  let scope =
-    try
-      let Seqrule (r, c) = make_seq_rule (List.rev toks) in
-      Arules [Rules (r, apply c [])]
-    with SelfSymbol ->
-      CErrors.user_err (str "Recursive symbols (self / next) are not allowed in local rules")
-  in
-  Tac2entries.ScopeRule (scope, (fun e -> e))
-end
diff --git a/src/tac2core.mli b/src/tac2core.mli
deleted file mode 100644
index 9fae65bb3e..0000000000
--- a/src/tac2core.mli
+++ /dev/null
@@ -1,30 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Tac2expr
-
-(** {5 Hardwired data} *)
-
-module Core :
-sig
-
-val t_list : type_constant
-val c_nil : ltac_constructor
-val c_cons : ltac_constructor
-
-val t_int : type_constant
-val t_option : type_constant
-val t_string : type_constant
-val t_array : type_constant
-
-val c_true : ltac_constructor
-val c_false : ltac_constructor
-
-end
-
-val pf_apply : (Environ.env -> Evd.evar_map -> 'a Proofview.tactic) -> 'a Proofview.tactic
diff --git a/src/tac2dyn.ml b/src/tac2dyn.ml
deleted file mode 100644
index 896676f08b..0000000000
--- a/src/tac2dyn.ml
+++ /dev/null
@@ -1,27 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-module Arg =
-struct
-  module DYN = Dyn.Make(struct end)
-  module Map = DYN.Map
-  type ('a, 'b) tag = ('a * 'b) DYN.tag
-  let eq = DYN.eq
-  let repr = DYN.repr
-  let create = DYN.create
-end
-
-module type Param = sig type ('raw, 'glb) t end
-
-module ArgMap (M : Param) =
-struct
-  type _ pack = Pack : ('raw, 'glb) M.t -> ('raw * 'glb) pack
-  include Arg.Map(struct type 'a t = 'a pack end)
-end
-
-module Val = Dyn.Make(struct end)
diff --git a/src/tac2dyn.mli b/src/tac2dyn.mli
deleted file mode 100644
index e995296840..0000000000
--- a/src/tac2dyn.mli
+++ /dev/null
@@ -1,34 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Dynamic arguments for Ltac2. *)
-
-module Arg :
-sig
-  type ('a, 'b) tag
-  val create : string -> ('a, 'b) tag
-  val eq : ('a1, 'b1) tag -> ('a2, 'b2) tag -> ('a1 * 'b1, 'a2 * 'b2) CSig.eq option
-  val repr : ('a, 'b) tag -> string
-end
-(** Arguments that are part of an AST. *)
-
-module type Param = sig type ('raw, 'glb) t end
-
-module ArgMap (M : Param) :
-sig
-  type _ pack = Pack : ('raw, 'glb) M.t -> ('raw * 'glb) pack
-  type t
-  val empty : t
-  val add : ('a, 'b) Arg.tag -> ('a * 'b) pack -> t -> t
-  val remove : ('a, 'b) Arg.tag -> t -> t
-  val find : ('a, 'b) Arg.tag -> t -> ('a * 'b) pack
-  val mem : ('a, 'b) Arg.tag -> t -> bool
-end
-
-module Val : Dyn.S
-(** Toplevel values *)
diff --git a/src/tac2entries.ml b/src/tac2entries.ml
deleted file mode 100644
index 9fd01426de..0000000000
--- a/src/tac2entries.ml
+++ /dev/null
@@ -1,938 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Pp
-open Util
-open CAst
-open CErrors
-open Names
-open Libnames
-open Libobject
-open Nametab
-open Tac2expr
-open Tac2print
-open Tac2intern
-
-(** Grammar entries *)
-
-module Pltac =
-struct
-let tac2expr = Pcoq.Entry.create "tactic:tac2expr"
-
-let q_ident = Pcoq.Entry.create "tactic:q_ident"
-let q_bindings = Pcoq.Entry.create "tactic:q_bindings"
-let q_with_bindings = Pcoq.Entry.create "tactic:q_with_bindings"
-let q_intropattern = Pcoq.Entry.create "tactic:q_intropattern"
-let q_intropatterns = Pcoq.Entry.create "tactic:q_intropatterns"
-let q_destruction_arg = Pcoq.Entry.create "tactic:q_destruction_arg"
-let q_induction_clause = Pcoq.Entry.create "tactic:q_induction_clause"
-let q_conversion = Pcoq.Entry.create "tactic:q_conversion"
-let q_rewriting = Pcoq.Entry.create "tactic:q_rewriting"
-let q_clause = Pcoq.Entry.create "tactic:q_clause"
-let q_dispatch = Pcoq.Entry.create "tactic:q_dispatch"
-let q_occurrences = Pcoq.Entry.create "tactic:q_occurrences"
-let q_reference = Pcoq.Entry.create "tactic:q_reference"
-let q_strategy_flag = Pcoq.Entry.create "tactic:q_strategy_flag"
-let q_constr_matching = Pcoq.Entry.create "tactic:q_constr_matching"
-let q_goal_matching = Pcoq.Entry.create "tactic:q_goal_matching"
-let q_hintdb = Pcoq.Entry.create "tactic:q_hintdb"
-let q_move_location = Pcoq.Entry.create "tactic:q_move_location"
-let q_pose = Pcoq.Entry.create "tactic:q_pose"
-let q_assert = Pcoq.Entry.create "tactic:q_assert"
-end
-
-(** Tactic definition *)
-
-type tacdef = {
-  tacdef_local : bool;
-  tacdef_mutable : bool;
-  tacdef_expr : glb_tacexpr;
-  tacdef_type : type_scheme;
-}
-
-let perform_tacdef visibility ((sp, kn), def) =
-  let () = if not def.tacdef_local then Tac2env.push_ltac visibility sp (TacConstant kn) in
-  let data = {
-    Tac2env.gdata_expr = def.tacdef_expr;
-    gdata_type = def.tacdef_type;
-    gdata_mutable = def.tacdef_mutable;
-  } in
-  Tac2env.define_global kn data
-
-let load_tacdef i obj = perform_tacdef (Until i) obj
-let open_tacdef i obj = perform_tacdef (Exactly i) obj
-
-let cache_tacdef ((sp, kn), def) =
-  let () = Tac2env.push_ltac (Until 1) sp (TacConstant kn) in
-  let data = {
-    Tac2env.gdata_expr = def.tacdef_expr;
-    gdata_type = def.tacdef_type;
-    gdata_mutable = def.tacdef_mutable;
-  } in
-  Tac2env.define_global kn data
-
-let subst_tacdef (subst, def) =
-  let expr' = subst_expr subst def.tacdef_expr in
-  let type' = subst_type_scheme subst def.tacdef_type in
-  if expr' == def.tacdef_expr && type' == def.tacdef_type then def
-  else { def with tacdef_expr = expr'; tacdef_type = type' }
-
-let classify_tacdef o = Substitute o
-
-let inTacDef : tacdef -> obj =
-  declare_object {(default_object "TAC2-DEFINITION") with
-     cache_function  = cache_tacdef;
-     load_function   = load_tacdef;
-     open_function   = open_tacdef;
-     subst_function = subst_tacdef;
-     classify_function = classify_tacdef}
-
-(** Type definition *)
-
-type typdef = {
-  typdef_local : bool;
-  typdef_expr : glb_quant_typedef;
-}
-
-let change_kn_label kn id =
-  let mp = KerName.modpath kn in
-  KerName.make mp (Label.of_id id)
-
-let change_sp_label sp id =
-  let (dp, _) = Libnames.repr_path sp in
-  Libnames.make_path dp id
-
-let push_typedef visibility sp kn (_, def) = match def with
-| GTydDef _ ->
-  Tac2env.push_type visibility sp kn
-| GTydAlg { galg_constructors = cstrs } ->
-  (* Register constructors *)
-  let iter (c, _) =
-    let spc = change_sp_label sp c in
-    let knc = change_kn_label kn c in
-    Tac2env.push_constructor visibility spc knc
-  in
-  Tac2env.push_type visibility sp kn;
-  List.iter iter cstrs
-| GTydRec fields ->
-  (* Register fields *)
-  let iter (c, _, _) =
-    let spc = change_sp_label sp c in
-    let knc = change_kn_label kn c in
-    Tac2env.push_projection visibility spc knc
-  in
-  Tac2env.push_type visibility sp kn;
-  List.iter iter fields
-| GTydOpn ->
-  Tac2env.push_type visibility sp kn
-
-let next i =
-  let ans = !i in
-  let () = incr i in
-  ans
-
-let define_typedef kn (params, def as qdef) = match def with
-| GTydDef _ ->
-  Tac2env.define_type kn qdef
-| GTydAlg { galg_constructors = cstrs } ->
-  (* Define constructors *)
-  let constant = ref 0 in
-  let nonconstant = ref 0 in
-  let iter (c, args) =
-    let knc = change_kn_label kn c in
-    let tag = if List.is_empty args then next constant else next nonconstant in
-    let data = {
-      Tac2env.cdata_prms = params;
-      cdata_type = kn;
-      cdata_args = args;
-      cdata_indx = Some tag;
-    } in
-    Tac2env.define_constructor knc data
-  in
-  Tac2env.define_type kn qdef;
-  List.iter iter cstrs
-| GTydRec fs ->
-  (* Define projections *)
-  let iter i (id, mut, t) =
-    let knp = change_kn_label kn id in
-    let proj = {
-      Tac2env.pdata_prms = params;
-      pdata_type = kn;
-      pdata_ptyp = t;
-      pdata_mutb = mut;
-      pdata_indx = i;
-    } in
-    Tac2env.define_projection knp proj
-  in
-  Tac2env.define_type kn qdef;
-  List.iteri iter fs
-| GTydOpn ->
-  Tac2env.define_type kn qdef
-
-let perform_typdef vs ((sp, kn), def) =
-  let () = if not def.typdef_local then push_typedef vs sp kn def.typdef_expr in
-  define_typedef kn def.typdef_expr
-
-let load_typdef i obj = perform_typdef (Until i) obj
-let open_typdef i obj = perform_typdef (Exactly i) obj
-
-let cache_typdef ((sp, kn), def) =
-  let () = push_typedef (Until 1) sp kn def.typdef_expr in
-  define_typedef kn def.typdef_expr
-
-let subst_typdef (subst, def) =
-  let expr' = subst_quant_typedef subst def.typdef_expr in
-  if expr' == def.typdef_expr then def else { def with typdef_expr = expr' }
-
-let classify_typdef o = Substitute o
-
-let inTypDef : typdef -> obj =
-  declare_object {(default_object "TAC2-TYPE-DEFINITION") with
-     cache_function  = cache_typdef;
-     load_function   = load_typdef;
-     open_function   = open_typdef;
-     subst_function = subst_typdef;
-     classify_function = classify_typdef}
-
-(** Type extension *)
-
-type extension_data = {
-  edata_name : Id.t;
-  edata_args : int glb_typexpr list;
-}
-
-type typext = {
-  typext_local : bool;
-  typext_prms : int;
-  typext_type : type_constant;
-  typext_expr : extension_data list;
-}
-
-let push_typext vis sp kn def =
-  let iter data =
-    let spc = change_sp_label sp data.edata_name in
-    let knc = change_kn_label kn data.edata_name in
-    Tac2env.push_constructor vis spc knc
-  in
-  List.iter iter def.typext_expr
-
-let define_typext kn def =
-  let iter data =
-    let knc = change_kn_label kn data.edata_name in
-    let cdata = {
-      Tac2env.cdata_prms = def.typext_prms;
-      cdata_type = def.typext_type;
-      cdata_args = data.edata_args;
-      cdata_indx = None;
-    } in
-    Tac2env.define_constructor knc cdata
-  in
-  List.iter iter def.typext_expr
-
-let cache_typext ((sp, kn), def) =
-  let () = define_typext kn def in
-  push_typext (Until 1) sp kn def
-
-let perform_typext vs ((sp, kn), def) =
-  let () = if not def.typext_local then push_typext vs sp kn def in
-  define_typext kn def
-
-let load_typext i obj = perform_typext (Until i) obj
-let open_typext i obj = perform_typext (Exactly i) obj
-
-let subst_typext (subst, e) =
-  let open Mod_subst in
-  let subst_data data =
-    let edata_args = List.Smart.map (fun e -> subst_type subst e) data.edata_args in
-    if edata_args == data.edata_args then data
-    else { data with edata_args }
-  in
-  let typext_type = subst_kn subst e.typext_type in
-  let typext_expr = List.Smart.map subst_data e.typext_expr in
-  if typext_type == e.typext_type && typext_expr == e.typext_expr then
-    e
-  else
-    { e with typext_type; typext_expr }
-
-let classify_typext o = Substitute o
-
-let inTypExt : typext -> obj =
-  declare_object {(default_object "TAC2-TYPE-EXTENSION") with
-     cache_function  = cache_typext;
-     load_function   = load_typext;
-     open_function   = open_typext;
-     subst_function = subst_typext;
-     classify_function = classify_typext}
-
-(** Toplevel entries *)
-
-let fresh_var avoid x =
-  let bad id =
-    Id.Set.mem id avoid ||
-    (try ignore (Tac2env.locate_ltac (qualid_of_ident id)); true with Not_found -> false)
-  in
-  Namegen.next_ident_away_from (Id.of_string x) bad
-
-let extract_pattern_type ({loc;v=p} as pat) = match p with
-| CPatCnv (pat, ty) -> pat, Some ty
-| CPatVar _ | CPatRef _ -> pat, None
-
-(** Mangle recursive tactics *)
-let inline_rec_tactic tactics =
-  let avoid = List.fold_left (fun accu ({v=id}, _) -> Id.Set.add id accu) Id.Set.empty tactics in
-  let map (id, e) = match e.v with
-  | CTacFun (pat, _) -> (id, List.map extract_pattern_type pat, e)
-  | _ ->
-    user_err ?loc:id.loc (str "Recursive tactic definitions must be functions")
-  in
-  let tactics = List.map map tactics in
-  let map (id, pat, e) =
-    let fold_var (avoid, ans) (pat, _) =
-      let id = fresh_var avoid "x" in
-      let loc = pat.loc in
-      (Id.Set.add id avoid, CAst.make ?loc id :: ans)
-    in
-    (* Fresh variables to abstract over the function patterns *)
-    let _, vars = List.fold_left fold_var (avoid, []) pat in
-    let map_body ({loc;v=id}, _, e) = CAst.(make ?loc @@ CPatVar (Name id)), e in
-    let bnd = List.map map_body tactics in
-    let pat_of_id {loc;v=id} = CAst.make ?loc @@ CPatVar (Name id) in
-    let var_of_id {loc;v=id} =
-      let qid = qualid_of_ident ?loc id in
-      CAst.make ?loc @@ CTacRef (RelId qid)
-    in
-    let loc0 = e.loc in
-    let vpat = List.map pat_of_id vars in
-    let varg = List.map var_of_id vars in
-    let e = CAst.make ?loc:loc0 @@ CTacLet (true, bnd, CAst.make ?loc:loc0 @@ CTacApp (var_of_id id, varg)) in
-    (id, CAst.make ?loc:loc0 @@ CTacFun (vpat, e))
-  in
-  List.map map tactics
-
-let check_lowercase {loc;v=id} =
-  if Tac2env.is_constructor (Libnames.qualid_of_ident id) then
-    user_err ?loc (str "The identifier " ++ Id.print id ++ str " must be lowercase")
-
-let register_ltac ?(local = false) ?(mut = false) isrec tactics =
-  let map ({loc;v=na}, e) =
-    let id = match na with
-    | Anonymous ->
-      user_err ?loc (str "Tactic definition must have a name")
-    | Name id -> id
-    in
-    let () = check_lowercase CAst.(make ?loc id) in
-    (CAst.(make ?loc id), e)
-  in
-  let tactics = List.map map tactics in
-  let tactics =
-    if isrec then inline_rec_tactic tactics else tactics
-  in
-  let map ({loc;v=id}, e) =
-    let (e, t) = intern ~strict:true e in
-    let () =
-      if not (is_value e) then
-        user_err ?loc (str "Tactic definition must be a syntactical value")
-    in
-    let kn = Lib.make_kn id in
-    let exists =
-      try let _ = Tac2env.interp_global kn in true with Not_found -> false
-    in
-    let () =
-      if exists then
-        user_err ?loc (str "Tactic " ++ Names.Id.print id ++ str " already exists")
-    in
-    (id, e, t)
-  in
-  let defs = List.map map tactics in
-  let iter (id, e, t) =
-    let def = {
-      tacdef_local = local;
-      tacdef_mutable = mut;
-      tacdef_expr = e;
-      tacdef_type = t;
-    } in
-    ignore (Lib.add_leaf id (inTacDef def))
-  in
-  List.iter iter defs
-
-let qualid_to_ident qid =
-  if qualid_is_ident qid then CAst.make ?loc:qid.CAst.loc @@ qualid_basename qid
-  else user_err ?loc:qid.CAst.loc (str "Identifier expected")
-
-let register_typedef ?(local = false) isrec types =
-  let same_name ({v=id1}, _) ({v=id2}, _) = Id.equal id1 id2 in
-  let () = match List.duplicates same_name types with
-  | [] -> ()
-  | ({loc;v=id}, _) :: _ ->
-    user_err ?loc (str "Multiple definition of the type name " ++ Id.print id)
-  in
-  let check ({loc;v=id}, (params, def)) =
-    let same_name {v=id1} {v=id2} = Id.equal id1 id2 in
-    let () = match List.duplicates same_name params with
-    | [] -> ()
-    | {loc;v=id} :: _ ->
-      user_err ?loc (str "The type parameter " ++ Id.print id ++
-        str " occurs several times")
-    in
-    match def with
-    | CTydDef _ ->
-      if isrec then
-        user_err ?loc (str "The type abbreviation " ++ Id.print id ++
-          str " cannot be recursive")
-    | CTydAlg cs ->
-      let same_name (id1, _) (id2, _) = Id.equal id1 id2 in
-      let () = match List.duplicates same_name cs with
-      | [] -> ()
-      | (id, _) :: _ ->
-        user_err (str "Multiple definitions of the constructor " ++ Id.print id)
-      in
-      ()
-    | CTydRec ps ->
-      let same_name (id1, _, _) (id2, _, _) = Id.equal id1 id2 in
-      let () = match List.duplicates same_name ps with
-      | [] -> ()
-      | (id, _, _) :: _ ->
-        user_err (str "Multiple definitions of the projection " ++ Id.print id)
-      in
-      ()
-    | CTydOpn ->
-      if isrec then
-        user_err ?loc (str "The open type declaration " ++ Id.print id ++
-          str " cannot be recursive")
-  in
-  let () = List.iter check types in
-  let self =
-    if isrec then
-      let fold accu ({v=id}, (params, _)) =
-        Id.Map.add id (Lib.make_kn id, List.length params) accu
-      in
-      List.fold_left fold Id.Map.empty types
-    else Id.Map.empty
-  in
-  let map ({v=id}, def) =
-    let typdef = {
-      typdef_local = local;
-      typdef_expr = intern_typedef self def;
-    } in
-    (id, typdef)
-  in
-  let types = List.map map types in
-  let iter (id, def) = ignore (Lib.add_leaf id (inTypDef def)) in
-  List.iter iter types
-
-let register_primitive ?(local = false) {loc;v=id} t ml =
-  let t = intern_open_type t in
-  let rec count_arrow = function
-  | GTypArrow (_, t) -> 1 + count_arrow t
-  | _ -> 0
-  in
-  let arrows = count_arrow (snd t) in
-  let () = if Int.equal arrows 0 then
-    user_err ?loc (str "External tactic must have at least one argument") in
-  let () =
-    try let _ = Tac2env.interp_primitive ml in () with Not_found ->
-      user_err ?loc (str "Unregistered primitive " ++
-        quote (str ml.mltac_plugin) ++ spc () ++ quote (str ml.mltac_tactic))
-  in
-  let init i = Id.of_string (Printf.sprintf "x%i" i) in
-  let names = List.init arrows init in
-  let bnd = List.map (fun id -> Name id) names in
-  let arg = List.map (fun id -> GTacVar id) names in
-  let e = GTacFun (bnd, GTacPrm (ml, arg)) in
-  let def = {
-    tacdef_local = local;
-    tacdef_mutable = false;
-    tacdef_expr = e;
-    tacdef_type = t;
-  } in
-  ignore (Lib.add_leaf id (inTacDef def))
-
-let register_open ?(local = false) qid (params, def) =
-  let kn =
-    try Tac2env.locate_type qid
-    with Not_found ->
-      user_err ?loc:qid.CAst.loc (str "Unbound type " ++ pr_qualid qid)
-  in
-  let (tparams, t) = Tac2env.interp_type kn in
-  let () = match t with
-  | GTydOpn -> ()
-  | GTydAlg _ | GTydRec _ | GTydDef _ ->
-    user_err ?loc:qid.CAst.loc (str "Type " ++ pr_qualid qid ++ str " is not an open type")
-  in
-  let () =
-    if not (Int.equal (List.length params) tparams) then
-      Tac2intern.error_nparams_mismatch ?loc:qid.CAst.loc (List.length params) tparams
-  in
-  match def with
-  | CTydOpn -> ()
-  | CTydAlg def ->
-    let intern_type t =
-      let tpe = CTydDef (Some t) in
-      let (_, ans) = intern_typedef Id.Map.empty (params, tpe) in
-      match ans with
-      | GTydDef (Some t) -> t
-      | _ -> assert false
-    in
-    let map (id, tpe) =
-      let tpe = List.map intern_type tpe in
-      { edata_name = id; edata_args = tpe }
-    in
-    let def = List.map map def in
-    let def = {
-      typext_local = local;
-      typext_type = kn;
-      typext_prms = tparams;
-      typext_expr = def;
-    } in
-    Lib.add_anonymous_leaf (inTypExt def)
-  | CTydRec _ | CTydDef _ ->
-    user_err ?loc:qid.CAst.loc (str "Extensions only accept inductive constructors")
-
-let register_type ?local isrec types = match types with
-| [qid, true, def] ->
-  let () = if isrec then user_err ?loc:qid.CAst.loc (str "Extensions cannot be recursive") in
-  register_open ?local qid def
-| _ ->
-  let map (qid, redef, def) =
-    let () = if redef then
-      user_err ?loc:qid.loc (str "Types can only be extended one by one")
-    in
-    (qualid_to_ident qid, def)
-  in
-  let types = List.map map types in
-  register_typedef ?local isrec types
-
-(** Parsing *)
-
-type 'a token =
-| TacTerm of string
-| TacNonTerm of Name.t * 'a
-
-type scope_rule =
-| ScopeRule : (raw_tacexpr, _, 'a) Extend.symbol * ('a -> raw_tacexpr) -> scope_rule
-
-type scope_interpretation = sexpr list -> scope_rule
-
-let scope_table : scope_interpretation Id.Map.t ref = ref Id.Map.empty
-
-let register_scope id s =
-  scope_table := Id.Map.add id s !scope_table
-
-module ParseToken =
-struct
-
-let loc_of_token = function
-| SexprStr {loc} -> loc
-| SexprInt {loc} -> loc
-| SexprRec (loc, _, _) -> Some loc
-
-let parse_scope = function
-| SexprRec (_, {loc;v=Some id}, toks) ->
-  if Id.Map.mem id !scope_table then
-    Id.Map.find id !scope_table toks
-  else
-    CErrors.user_err ?loc (str "Unknown scope" ++ spc () ++ Names.Id.print id)
-| SexprStr {v=str} ->
-  let v_unit = CAst.make @@ CTacCst (AbsKn (Tuple 0)) in
-  ScopeRule (Extend.Atoken (Tok.PIDENT (Some str)), (fun _ -> v_unit))
-| tok ->
-  let loc = loc_of_token tok in
-  CErrors.user_err ?loc (str "Invalid parsing token")
-
-let parse_token = function
-| SexprStr {v=s} -> TacTerm s
-| SexprRec (_, {v=na}, [tok]) ->
-  let na = match na with None -> Anonymous | Some id -> Name id in
-  let scope = parse_scope tok in
-  TacNonTerm (na, scope)
-| tok ->
-  let loc = loc_of_token tok in
-  CErrors.user_err ?loc (str "Invalid parsing token")
-
-end
-
-let parse_scope = ParseToken.parse_scope
-
-type synext = {
-  synext_tok : sexpr list;
-  synext_exp : raw_tacexpr;
-  synext_lev : int option;
-  synext_loc : bool;
-}
-
-type krule =
-| KRule :
-  (raw_tacexpr, _, 'act, Loc.t -> raw_tacexpr) Extend.rule *
-  ((Loc.t -> (Name.t * raw_tacexpr) list -> raw_tacexpr) -> 'act) -> krule
-
-let rec get_rule (tok : scope_rule token list) : krule = match tok with
-| [] -> KRule (Extend.Stop, fun k loc -> k loc [])
-| TacNonTerm (na, ScopeRule (scope, inj)) :: tok ->
-  let KRule (rule, act) = get_rule tok in
-  let rule = Extend.Next (rule, scope) in
-  let act k e = act (fun loc acc -> k loc ((na, inj e) :: acc)) in
-  KRule (rule, act)
-| TacTerm t :: tok ->
-  let KRule (rule, act) = get_rule tok in
-  let rule = Extend.Next (rule, Extend.Atoken (CLexer.terminal t)) in
-  let act k _ = act k in
-  KRule (rule, act)
-
-let perform_notation syn st =
-  let tok = List.rev_map ParseToken.parse_token syn.synext_tok in
-  let KRule (rule, act) = get_rule tok in
-  let mk loc args =
-    let map (na, e) =
-      ((CAst.make ?loc:e.loc @@ CPatVar na), e)
-    in
-    let bnd = List.map map args in
-    CAst.make ~loc @@ CTacLet (false, bnd, syn.synext_exp)
-  in
-  let rule = Extend.Rule (rule, act mk) in
-  let lev = match syn.synext_lev with
-  | None -> None
-  | Some lev -> Some (string_of_int lev)
-  in
-  let rule = (lev, None, [rule]) in
-  ([Pcoq.ExtendRule (Pltac.tac2expr, None, (None, [rule]))], st)
-
-let ltac2_notation =
-  Pcoq.create_grammar_command "ltac2-notation" perform_notation
-
-let cache_synext (_, syn) =
-  Pcoq.extend_grammar_command ltac2_notation syn
-
-let open_synext i (_, syn) =
-  if Int.equal i 1 then Pcoq.extend_grammar_command ltac2_notation syn
-
-let subst_synext (subst, syn) =
-  let e = Tac2intern.subst_rawexpr subst syn.synext_exp in
-  if e == syn.synext_exp then syn else { syn with synext_exp = e }
-
-let classify_synext o =
-  if o.synext_loc then Dispose else Substitute o
-
-let inTac2Notation : synext -> obj =
-  declare_object {(default_object "TAC2-NOTATION") with
-     cache_function  = cache_synext;
-     open_function   = open_synext;
-     subst_function = subst_synext;
-     classify_function = classify_synext}
-
-type abbreviation = {
-  abbr_body : raw_tacexpr;
-}
-
-let perform_abbreviation visibility ((sp, kn), abbr) =
-  let () = Tac2env.push_ltac visibility sp (TacAlias kn) in
-  Tac2env.define_alias kn abbr.abbr_body
-
-let load_abbreviation i obj = perform_abbreviation (Until i) obj
-let open_abbreviation i obj = perform_abbreviation (Exactly i) obj
-
-let cache_abbreviation ((sp, kn), abbr) =
-  let () = Tac2env.push_ltac (Until 1) sp (TacAlias kn) in
-  Tac2env.define_alias kn abbr.abbr_body
-
-let subst_abbreviation (subst, abbr) =
-  let body' = subst_rawexpr subst abbr.abbr_body in
-  if body' == abbr.abbr_body then abbr
-  else { abbr_body = body' }
-
-let classify_abbreviation o = Substitute o
-
-let inTac2Abbreviation : abbreviation -> obj =
-  declare_object {(default_object "TAC2-ABBREVIATION") with
-     cache_function  = cache_abbreviation;
-     load_function   = load_abbreviation;
-     open_function   = open_abbreviation;
-     subst_function = subst_abbreviation;
-     classify_function = classify_abbreviation}
-
-let register_notation ?(local = false) tkn lev body = match tkn, lev with
-| [SexprRec (_, {loc;v=Some id}, [])], None ->
-  (* Tactic abbreviation *)
-  let () = check_lowercase CAst.(make ?loc id) in
-  let body = Tac2intern.globalize Id.Set.empty body in
-  let abbr = { abbr_body = body } in
-  ignore (Lib.add_leaf id (inTac2Abbreviation abbr))
-| _ ->
-  (* Check that the tokens make sense *)
-  let entries = List.map ParseToken.parse_token tkn in
-  let fold accu tok = match tok with
-  | TacTerm _ -> accu
-  | TacNonTerm (Name id, _) -> Id.Set.add id accu
-  | TacNonTerm (Anonymous, _) -> accu
-  in
-  let ids = List.fold_left fold Id.Set.empty entries in
-  (* Globalize so that names are absolute *)
-  let body = Tac2intern.globalize ids body in
-  let lev = match lev with Some _ -> lev | None -> Some 5 in
-  let ext = {
-    synext_tok = tkn;
-    synext_exp = body;
-    synext_lev = lev;
-    synext_loc = local;
-  } in
-  Lib.add_anonymous_leaf (inTac2Notation ext)
-
-type redefinition = {
-  redef_kn : ltac_constant;
-  redef_body : glb_tacexpr;
-}
-
-let perform_redefinition (_, redef) =
-  let kn = redef.redef_kn in
-  let data = Tac2env.interp_global kn in
-  let data = { data with Tac2env.gdata_expr = redef.redef_body } in
-  Tac2env.define_global kn data
-
-let subst_redefinition (subst, redef) =
-  let kn = Mod_subst.subst_kn subst redef.redef_kn in
-  let body = Tac2intern.subst_expr subst redef.redef_body in
-  if kn == redef.redef_kn && body == redef.redef_body then redef
-  else { redef_kn = kn; redef_body = body }
-
-let classify_redefinition o = Substitute o
-
-let inTac2Redefinition : redefinition -> obj =
-  declare_object {(default_object "TAC2-REDEFINITION") with
-     cache_function  = perform_redefinition;
-     open_function   = (fun _ -> perform_redefinition);
-     subst_function = subst_redefinition;
-     classify_function = classify_redefinition }
-
-let register_redefinition ?(local = false) qid e =
-  let kn =
-    try Tac2env.locate_ltac qid
-    with Not_found -> user_err ?loc:qid.CAst.loc (str "Unknown tactic " ++ pr_qualid qid)
-  in
-  let kn = match kn with
-  | TacConstant kn -> kn
-  | TacAlias _ ->
-    user_err ?loc:qid.CAst.loc (str "Cannot redefine syntactic abbreviations")
-  in
-  let data = Tac2env.interp_global kn in
-  let () =
-    if not (data.Tac2env.gdata_mutable) then
-      user_err ?loc:qid.CAst.loc (str "The tactic " ++ pr_qualid qid ++ str " is not declared as mutable")
-  in
-  let (e, t) = intern ~strict:true e in
-  let () =
-    if not (is_value e) then
-      user_err ?loc:qid.CAst.loc (str "Tactic definition must be a syntactical value")
-  in
-  let () =
-    if not (Tac2intern.check_subtype t data.Tac2env.gdata_type) then
-      let name = int_name () in
-      user_err ?loc:qid.CAst.loc (str "Type " ++ pr_glbtype name (snd t) ++
-        str " is not a subtype of " ++ pr_glbtype name (snd data.Tac2env.gdata_type))
-  in
-  let def = {
-    redef_kn = kn;
-    redef_body = e;
-  } in
-  Lib.add_anonymous_leaf (inTac2Redefinition def)
-
-let perform_eval ~pstate e =
-  let open Proofview.Notations in
-  let env = Global.env () in
-  let (e, ty) = Tac2intern.intern ~strict:false e in
-  let v = Tac2interp.interp Tac2interp.empty_environment e in
-  let selector, proof =
-    match pstate with
-    | None ->
-      let sigma = Evd.from_env env in
-      let name, poly = Id.of_string "ltac2", false in
-      Goal_select.SelectAll, Proof.start ~name ~poly sigma []
-    | Some pstate ->
-      Goal_select.get_default_goal_selector (),
-      Proof_global.give_me_the_proof pstate
-  in
-  let v = match selector with
-  | Goal_select.SelectNth i -> Proofview.tclFOCUS i i v
-  | Goal_select.SelectList l -> Proofview.tclFOCUSLIST l v
-  | Goal_select.SelectId id -> Proofview.tclFOCUSID id v
-  | Goal_select.SelectAll -> v
-  | Goal_select.SelectAlreadyFocused -> assert false (* TODO **)
-  in
-  (* HACK: the API doesn't allow to return a value *)
-  let ans = ref None in
-  let tac = (v >>= fun r -> ans := Some r; Proofview.tclUNIT ()) in
-  let (proof, _) = Proof.run_tactic (Global.env ()) tac proof in
-  let sigma = Proof.in_proof proof (fun sigma -> sigma) in
-  let ans = match !ans with None -> assert false | Some r -> r in
-  let name = int_name () in
-  Feedback.msg_notice (str "- : " ++ pr_glbtype name (snd ty)
-    ++ spc () ++  str "=" ++ spc () ++
-    Tac2print.pr_valexpr env sigma ans (snd ty))
-
-(** Toplevel entries *)
-
-let register_struct ?local ~pstate str = match str with
-| StrVal (mut, isrec, e) -> register_ltac ?local ~mut isrec e
-| StrTyp (isrec, t) -> register_type ?local isrec t
-| StrPrm (id, t, ml) -> register_primitive ?local id t ml
-| StrSyn (tok, lev, e) -> register_notation ?local tok lev e
-| StrMut (qid, e) -> register_redefinition ?local qid e
-| StrRun e -> perform_eval ~pstate e
-
-(** Toplevel exception *)
-
-let _ = Goptions.declare_bool_option {
-  Goptions.optdepr = false;
-  Goptions.optname = "print Ltac2 backtrace";
-  Goptions.optkey = ["Ltac2"; "Backtrace"];
-  Goptions.optread = (fun () -> !Tac2interp.print_ltac2_backtrace);
-  Goptions.optwrite = (fun b -> Tac2interp.print_ltac2_backtrace := b);
-}
-
-let backtrace : backtrace Exninfo.t = Exninfo.make ()
-
-let pr_frame = function
-| FrAnon e -> str "Call {" ++ pr_glbexpr e ++ str "}"
-| FrLtac kn ->
-  str "Call " ++ Libnames.pr_qualid (Tac2env.shortest_qualid_of_ltac (TacConstant kn))
-| FrPrim ml ->
-  str "Prim <" ++ str ml.mltac_plugin ++ str ":" ++ str ml.mltac_tactic ++ str ">"
-| FrExtn (tag, arg) ->
-  let obj = Tac2env.interp_ml_object tag in
-  str "Extn " ++ str (Tac2dyn.Arg.repr tag) ++ str ":" ++ spc () ++
-    obj.Tac2env.ml_print (Global.env ()) arg
-
-let () = register_handler begin function
-| Tac2interp.LtacError (kn, args) ->
-  let t_exn = KerName.make Tac2env.coq_prefix (Label.make "exn") in
-  let v = Tac2ffi.of_open (kn, args) in
-  let t = GTypRef (Other t_exn, []) in
-  let c = Tac2print.pr_valexpr (Global.env ()) Evd.empty v t in
-  hov 0 (str "Uncaught Ltac2 exception:" ++ spc () ++ hov 0 c)
-| _ -> raise Unhandled
-end
-
-let () = ExplainErr.register_additional_error_info begin fun (e, info) ->
-  if !Tac2interp.print_ltac2_backtrace then
-    let bt = Exninfo.get info backtrace in
-    let bt = match bt with
-    | Some bt -> bt
-    | None -> raise Exit
-    in
-    let bt =
-      str "Backtrace:" ++ fnl () ++ prlist_with_sep fnl pr_frame bt ++ fnl ()
-    in
-    Some (Loc.tag @@ Some bt)
-  else raise Exit
-end
-
-(** Printing *)
-
-let print_ltac qid =
-  if Tac2env.is_constructor qid then
-    let kn =
-      try Tac2env.locate_constructor qid
-      with Not_found -> user_err ?loc:qid.CAst.loc (str "Unknown constructor " ++ pr_qualid qid)
-    in
-    let _ = Tac2env.interp_constructor kn in
-    Feedback.msg_notice (hov 2 (str "Constructor" ++ spc () ++ str ":" ++ spc () ++ pr_qualid qid))
-  else
-    let kn =
-      try Tac2env.locate_ltac qid
-      with Not_found -> user_err ?loc:qid.CAst.loc (str "Unknown tactic " ++ pr_qualid qid)
-    in
-    match kn with
-    | TacConstant kn ->
-      let data = Tac2env.interp_global kn in
-      let e = data.Tac2env.gdata_expr in
-      let (_, t) = data.Tac2env.gdata_type in
-      let name = int_name () in
-      Feedback.msg_notice (
-        hov 0 (
-          hov 2 (pr_qualid qid ++ spc () ++ str ":" ++ spc () ++ pr_glbtype name t) ++ fnl () ++
-          hov 2 (pr_qualid qid ++ spc () ++ str ":=" ++ spc () ++ pr_glbexpr e)
-        )
-      )
-    | TacAlias kn ->
-      Feedback.msg_notice (str "Alias to ...")
-
-(** Calling tactics *)
-
-let solve ~pstate default tac =
-  let pstate, status = Proof_global.with_current_proof begin fun etac p ->
-    let with_end_tac = if default then Some etac else None in
-    let g = Goal_select.get_default_goal_selector () in
-    let (p, status) = Pfedit.solve g None tac ?with_end_tac p in
-    (* in case a strict subtree was completed,
-       go back to the top of the prooftree *)
-    let p = Proof.maximal_unfocus Vernacentries.command_focus p in
-    p, status
-  end pstate in
-  if not status then Feedback.feedback Feedback.AddedAxiom;
-  pstate
-
-let call ~pstate ~default e =
-  let loc = e.loc in
-  let (e, t) = intern ~strict:false e in
-  let () = check_unit ?loc t in
-  let tac = Tac2interp.interp Tac2interp.empty_environment e in
-  solve ~pstate default (Proofview.tclIGNORE tac)
-
-(** Primitive algebraic types than can't be defined Coq-side *)
-
-let register_prim_alg name params def =
-  let id = Id.of_string name in
-  let def = List.map (fun (cstr, tpe) -> (Id.of_string_soft cstr, tpe)) def in
-  let getn (const, nonconst) (c, args) = match args with
-  | [] -> (succ const, nonconst)
-  | _ :: _ -> (const, succ nonconst)
-  in
-  let nconst, nnonconst = List.fold_left getn (0, 0) def in
-  let alg = {
-    galg_constructors = def;
-    galg_nconst = nconst;
-    galg_nnonconst = nnonconst;
-  } in
-  let def = (params, GTydAlg alg) in
-  let def = { typdef_local = false; typdef_expr = def } in
-  ignore (Lib.add_leaf id (inTypDef def))
-
-let coq_def n = KerName.make Tac2env.coq_prefix (Label.make n)
-
-let def_unit = {
-  typdef_local = false;
-  typdef_expr = 0, GTydDef (Some (GTypRef (Tuple 0, [])));
-}
-
-let t_list = coq_def "list"
-
-let (f_register_constr_quotations, register_constr_quotations) = Hook.make ()
-
-let cache_ltac2_init (_, ()) =
-  Hook.get f_register_constr_quotations ()
-
-let load_ltac2_init _ (_, ()) =
-  Hook.get f_register_constr_quotations ()
-
-let open_ltac2_init _ (_, ()) =
-  Goptions.set_string_option_value_gen ["Default"; "Proof"; "Mode"] "Ltac2"
-
-(** Dummy object that register global rules when Require is called *)
-let inTac2Init : unit -> obj =
-  declare_object {(default_object "TAC2-INIT") with
-    cache_function = cache_ltac2_init;
-    load_function = load_ltac2_init;
-    open_function = open_ltac2_init;
-  }
-
-let _ = Mltop.declare_cache_obj begin fun () ->
-  ignore (Lib.add_leaf (Id.of_string "unit") (inTypDef def_unit));
-  register_prim_alg "list" 1 [
-    ("[]", []);
-    ("::", [GTypVar 0; GTypRef (Other t_list, [GTypVar 0])]);
-  ];
-  Lib.add_anonymous_leaf (inTac2Init ());
-end "ltac2_plugin"
diff --git a/src/tac2entries.mli b/src/tac2entries.mli
deleted file mode 100644
index d493192bb3..0000000000
--- a/src/tac2entries.mli
+++ /dev/null
@@ -1,93 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Libnames
-open Tac2expr
-
-(** {5 Toplevel definitions} *)
-
-val register_ltac : ?local:bool -> ?mut:bool -> rec_flag ->
-  (Names.lname * raw_tacexpr) list -> unit
-
-val register_type : ?local:bool -> rec_flag ->
-  (qualid * redef_flag * raw_quant_typedef) list -> unit
-
-val register_primitive : ?local:bool ->
-  Names.lident -> raw_typexpr -> ml_tactic_name -> unit
-
-val register_struct
-  :  ?local:bool
-  -> pstate:Proof_global.t option
-  -> strexpr
-  -> unit
-
-val register_notation : ?local:bool -> sexpr list -> int option ->
-  raw_tacexpr -> unit
-
-(** {5 Notations} *)
-
-type scope_rule =
-| ScopeRule : (raw_tacexpr, _, 'a) Extend.symbol * ('a -> raw_tacexpr) -> scope_rule
-
-type scope_interpretation = sexpr list -> scope_rule
-
-val register_scope : Id.t -> scope_interpretation -> unit
-(** Create a new scope with the provided name *)
-
-val parse_scope : sexpr -> scope_rule
-(** Use this to interpret the subscopes for interpretation functions *)
-
-(** {5 Inspecting} *)
-
-val print_ltac : Libnames.qualid -> unit
-
-(** {5 Eval loop} *)
-
-(** Evaluate a tactic expression in the current environment *)
-val call : pstate:Proof_global.t -> default:bool -> raw_tacexpr -> Proof_global.t
-
-(** {5 Toplevel exceptions} *)
-
-val backtrace : backtrace Exninfo.t
-
-(** {5 Parsing entries} *)
-
-module Pltac :
-sig
-val tac2expr : raw_tacexpr Pcoq.Entry.t
-
-(** Quoted entries. To be used for complex notations. *)
-
-open Tac2qexpr
-
-val q_ident : Id.t CAst.t or_anti Pcoq.Entry.t
-val q_bindings : bindings Pcoq.Entry.t
-val q_with_bindings : bindings Pcoq.Entry.t
-val q_intropattern : intro_pattern Pcoq.Entry.t
-val q_intropatterns : intro_pattern list CAst.t Pcoq.Entry.t
-val q_destruction_arg : destruction_arg Pcoq.Entry.t
-val q_induction_clause : induction_clause Pcoq.Entry.t
-val q_conversion : conversion Pcoq.Entry.t
-val q_rewriting : rewriting Pcoq.Entry.t
-val q_clause : clause Pcoq.Entry.t
-val q_dispatch : dispatch Pcoq.Entry.t
-val q_occurrences : occurrences Pcoq.Entry.t
-val q_reference : reference or_anti Pcoq.Entry.t
-val q_strategy_flag : strategy_flag Pcoq.Entry.t
-val q_constr_matching : constr_matching Pcoq.Entry.t
-val q_goal_matching : goal_matching Pcoq.Entry.t
-val q_hintdb : hintdb Pcoq.Entry.t
-val q_move_location : move_location Pcoq.Entry.t
-val q_pose : pose Pcoq.Entry.t
-val q_assert : assertion Pcoq.Entry.t
-end
-
-(** {5 Hooks} *)
-
-val register_constr_quotations : (unit -> unit) Hook.t
diff --git a/src/tac2env.ml b/src/tac2env.ml
deleted file mode 100644
index 93ad57e97e..0000000000
--- a/src/tac2env.ml
+++ /dev/null
@@ -1,298 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Util
-open Names
-open Libnames
-open Tac2expr
-open Tac2ffi
-
-type global_data = {
-  gdata_expr : glb_tacexpr;
-  gdata_type : type_scheme;
-  gdata_mutable : bool;
-}
-
-type constructor_data = {
-  cdata_prms : int;
-  cdata_type : type_constant;
-  cdata_args : int glb_typexpr list;
-  cdata_indx : int option;
-}
-
-type projection_data = {
-  pdata_prms : int;
-  pdata_type : type_constant;
-  pdata_ptyp : int glb_typexpr;
-  pdata_mutb : bool;
-  pdata_indx : int;
-}
-
-type ltac_state = {
-  ltac_tactics : global_data KNmap.t;
-  ltac_constructors : constructor_data KNmap.t;
-  ltac_projections : projection_data KNmap.t;
-  ltac_types : glb_quant_typedef KNmap.t;
-  ltac_aliases : raw_tacexpr KNmap.t;
-}
-
-let empty_state = {
-  ltac_tactics = KNmap.empty;
-  ltac_constructors = KNmap.empty;
-  ltac_projections = KNmap.empty;
-  ltac_types = KNmap.empty;
-  ltac_aliases = KNmap.empty;
-}
-
-let ltac_state = Summary.ref empty_state ~name:"ltac2-state"
-
-let define_global kn e =
-  let state = !ltac_state in
-  ltac_state := { state with ltac_tactics = KNmap.add kn e state.ltac_tactics }
-
-let interp_global kn =
-  let data = KNmap.find kn ltac_state.contents.ltac_tactics in
-  data
-
-let define_constructor kn t =
-  let state = !ltac_state in
-  ltac_state := { state with ltac_constructors = KNmap.add kn t state.ltac_constructors }
-
-let interp_constructor kn = KNmap.find kn ltac_state.contents.ltac_constructors
-
-let define_projection kn t =
-  let state = !ltac_state in
-  ltac_state := { state with ltac_projections = KNmap.add kn t state.ltac_projections }
-
-let interp_projection kn = KNmap.find kn ltac_state.contents.ltac_projections
-
-let define_type kn e =
-  let state = !ltac_state in
-  ltac_state := { state with ltac_types = KNmap.add kn e state.ltac_types }
-
-let interp_type kn = KNmap.find kn ltac_state.contents.ltac_types
-
-let define_alias kn tac =
-  let state = !ltac_state in
-  ltac_state := { state with ltac_aliases = KNmap.add kn tac state.ltac_aliases }
-
-let interp_alias kn = KNmap.find kn ltac_state.contents.ltac_aliases
-
-module ML =
-struct
-  type t = ml_tactic_name
-  let compare n1 n2 =
-    let c = String.compare n1.mltac_plugin n2.mltac_plugin in
-    if Int.equal c 0 then String.compare n1.mltac_tactic n2.mltac_tactic
-    else c
-end
-
-module MLMap = Map.Make(ML)
-
-let primitive_map = ref MLMap.empty
-
-let define_primitive name f = primitive_map := MLMap.add name f !primitive_map
-let interp_primitive name = MLMap.find name !primitive_map
-
-(** Name management *)
-
-module FullPath =
-struct
-  type t = full_path
-  let equal = eq_full_path
-  let to_string = string_of_path
-  let repr sp =
-    let dir,id = repr_path sp in
-    id, (DirPath.repr dir)
-end
-
-type tacref = Tac2expr.tacref =
-| TacConstant of ltac_constant
-| TacAlias of ltac_alias
-
-module TacRef =
-struct
-type t = tacref
-let compare r1 r2 = match r1, r2 with
-| TacConstant c1, TacConstant c2 -> KerName.compare c1 c2
-| TacAlias c1, TacAlias c2 -> KerName.compare c1 c2
-| TacConstant _, TacAlias _ -> -1
-| TacAlias _, TacConstant _ -> 1
-
-let equal r1 r2 = compare r1 r2 == 0
-
-end
-
-module KnTab = Nametab.Make(FullPath)(KerName)
-module RfTab = Nametab.Make(FullPath)(TacRef)
-module RfMap = Map.Make(TacRef)
-
-type nametab = {
-  tab_ltac : RfTab.t;
-  tab_ltac_rev : full_path RfMap.t;
-  tab_cstr : KnTab.t;
-  tab_cstr_rev : full_path KNmap.t;
-  tab_type : KnTab.t;
-  tab_type_rev : full_path KNmap.t;
-  tab_proj : KnTab.t;
-  tab_proj_rev : full_path KNmap.t;
-}
-
-let empty_nametab = {
-  tab_ltac = RfTab.empty;
-  tab_ltac_rev = RfMap.empty;
-  tab_cstr = KnTab.empty;
-  tab_cstr_rev = KNmap.empty;
-  tab_type = KnTab.empty;
-  tab_type_rev = KNmap.empty;
-  tab_proj = KnTab.empty;
-  tab_proj_rev = KNmap.empty;
-}
-
-let nametab = Summary.ref empty_nametab ~name:"ltac2-nametab"
-
-let push_ltac vis sp kn =
-  let tab = !nametab in
-  let tab_ltac = RfTab.push vis sp kn tab.tab_ltac in
-  let tab_ltac_rev = RfMap.add kn sp tab.tab_ltac_rev in
-  nametab := { tab with tab_ltac; tab_ltac_rev }
-
-let locate_ltac qid =
-  let tab = !nametab in
-  RfTab.locate qid tab.tab_ltac
-
-let locate_extended_all_ltac qid =
-  let tab = !nametab in
-  RfTab.find_prefixes qid tab.tab_ltac
-
-let shortest_qualid_of_ltac kn =
-  let tab = !nametab in
-  let sp = RfMap.find kn tab.tab_ltac_rev in
-  RfTab.shortest_qualid Id.Set.empty sp tab.tab_ltac
-
-let push_constructor vis sp kn =
-  let tab = !nametab in
-  let tab_cstr = KnTab.push vis sp kn tab.tab_cstr in
-  let tab_cstr_rev = KNmap.add kn sp tab.tab_cstr_rev in
-  nametab := { tab with tab_cstr; tab_cstr_rev }
-
-let locate_constructor qid =
-  let tab = !nametab in
-  KnTab.locate qid tab.tab_cstr
-
-let locate_extended_all_constructor qid =
-  let tab = !nametab in
-  KnTab.find_prefixes qid tab.tab_cstr
-
-let shortest_qualid_of_constructor kn =
-  let tab = !nametab in
-  let sp = KNmap.find kn tab.tab_cstr_rev in
-  KnTab.shortest_qualid Id.Set.empty sp tab.tab_cstr
-
-let push_type vis sp kn =
-  let tab = !nametab in
-  let tab_type = KnTab.push vis sp kn tab.tab_type in
-  let tab_type_rev = KNmap.add kn sp tab.tab_type_rev in
-  nametab := { tab with tab_type; tab_type_rev }
-
-let locate_type qid =
-  let tab = !nametab in
-  KnTab.locate qid tab.tab_type
-
-let locate_extended_all_type qid =
-  let tab = !nametab in
-  KnTab.find_prefixes qid tab.tab_type
-
-let shortest_qualid_of_type ?loc kn =
-  let tab = !nametab in
-  let sp = KNmap.find kn tab.tab_type_rev in
-  KnTab.shortest_qualid ?loc Id.Set.empty sp tab.tab_type
-
-let push_projection vis sp kn =
-  let tab = !nametab in
-  let tab_proj = KnTab.push vis sp kn tab.tab_proj in
-  let tab_proj_rev = KNmap.add kn sp tab.tab_proj_rev in
-  nametab := { tab with tab_proj; tab_proj_rev }
-
-let locate_projection qid =
-  let tab = !nametab in
-  KnTab.locate qid tab.tab_proj
-
-let locate_extended_all_projection qid =
-  let tab = !nametab in
-  KnTab.find_prefixes qid tab.tab_proj
-
-let shortest_qualid_of_projection kn =
-  let tab = !nametab in
-  let sp = KNmap.find kn tab.tab_proj_rev in
-  KnTab.shortest_qualid Id.Set.empty sp tab.tab_proj
-
-type 'a or_glb_tacexpr =
-| GlbVal of 'a
-| GlbTacexpr of glb_tacexpr
-
-type environment = {
-  env_ist : valexpr Id.Map.t;
-}
-
-type ('a, 'b, 'r) intern_fun = Genintern.glob_sign -> 'a -> 'b * 'r glb_typexpr
-
-type ('a, 'b) ml_object = {
-  ml_intern : 'r. (raw_tacexpr, glb_tacexpr, 'r) intern_fun -> ('a, 'b or_glb_tacexpr, 'r) intern_fun;
-  ml_subst : Mod_subst.substitution -> 'b -> 'b;
-  ml_interp : environment -> 'b -> valexpr Proofview.tactic;
-  ml_print : Environ.env -> 'b -> Pp.t;
-}
-
-module MLTypeObj =
-struct
-  type ('a, 'b) t = ('a, 'b) ml_object
-end
-
-module MLType = Tac2dyn.ArgMap(MLTypeObj)
-
-let ml_object_table = ref MLType.empty
-
-let define_ml_object t tpe =
-  ml_object_table := MLType.add t (MLType.Pack tpe) !ml_object_table
-
-let interp_ml_object t =
-  try
-    let MLType.Pack ans = MLType.find t !ml_object_table in
-    ans
-  with Not_found ->
-    CErrors.anomaly Pp.(str "Unknown object type " ++ str (Tac2dyn.Arg.repr t))
-
-(** Absolute paths *)
-
-let coq_prefix =
-  MPfile (DirPath.make (List.map Id.of_string ["Init"; "Ltac2"]))
-
-let std_prefix =
-  MPfile (DirPath.make (List.map Id.of_string ["Std"; "Ltac2"]))
-
-let ltac1_prefix =
-  MPfile (DirPath.make (List.map Id.of_string ["Ltac1"; "Ltac2"]))
-
-(** Generic arguments *)
-
-let wit_ltac2 = Genarg.make0 "ltac2:value"
-let wit_ltac2_quotation = Genarg.make0 "ltac2:quotation"
-let () = Geninterp.register_val0 wit_ltac2 None
-let () = Geninterp.register_val0 wit_ltac2_quotation None
-
-let is_constructor qid =
-  let (_, id) = repr_qualid qid in
-  let id = Id.to_string id in
-  assert (String.length id > 0);
-  match id with
-  | "true" | "false" -> true (* built-in constructors *)
-  | _ ->
-    match id.[0] with
-    | 'A'..'Z' -> true
-    | _ -> false
diff --git a/src/tac2env.mli b/src/tac2env.mli
deleted file mode 100644
index c7e87c5432..0000000000
--- a/src/tac2env.mli
+++ /dev/null
@@ -1,146 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Genarg
-open Names
-open Libnames
-open Nametab
-open Tac2expr
-open Tac2ffi
-
-(** Ltac2 global environment *)
-
-(** {5 Toplevel definition of values} *)
-
-type global_data = {
-  gdata_expr : glb_tacexpr;
-  gdata_type : type_scheme;
-  gdata_mutable : bool;
-}
-
-val define_global : ltac_constant -> global_data -> unit
-val interp_global : ltac_constant -> global_data
-
-(** {5 Toplevel definition of types} *)
-
-val define_type : type_constant -> glb_quant_typedef -> unit
-val interp_type : type_constant -> glb_quant_typedef
-
-(** {5 Toplevel definition of algebraic constructors} *)
-
-type constructor_data = {
-  cdata_prms : int;
-  (** Type parameters *)
-  cdata_type : type_constant;
-  (** Inductive definition to which the constructor pertains *)
-  cdata_args : int glb_typexpr list;
-  (** Types of the constructor arguments *)
-  cdata_indx : int option;
-  (** Index of the constructor in the ADT. Numbering is duplicated between
-      argumentless and argument-using constructors, e.g. in type ['a option]
-      [None] and [Some] have both index 0. This field is empty whenever the
-      constructor is a member of an open type. *)
-}
-
-val define_constructor : ltac_constructor -> constructor_data -> unit
-val interp_constructor : ltac_constructor -> constructor_data
-
-(** {5 Toplevel definition of projections} *)
-
-type projection_data = {
-  pdata_prms : int;
-  (** Type parameters *)
-  pdata_type : type_constant;
-  (** Record definition to which the projection pertains *)
-  pdata_ptyp : int glb_typexpr;
-  (** Type of the projection *)
-  pdata_mutb : bool;
-  (** Whether the field is mutable *)
-  pdata_indx : int;
-  (** Index of the projection *)
-}
-
-val define_projection : ltac_projection -> projection_data -> unit
-val interp_projection : ltac_projection -> projection_data
-
-(** {5 Toplevel definition of aliases} *)
-
-val define_alias : ltac_constant -> raw_tacexpr -> unit
-val interp_alias : ltac_constant -> raw_tacexpr
-
-(** {5 Name management} *)
-
-val push_ltac : visibility -> full_path -> tacref -> unit
-val locate_ltac : qualid -> tacref
-val locate_extended_all_ltac : qualid -> tacref list
-val shortest_qualid_of_ltac : tacref -> qualid
-
-val push_constructor : visibility -> full_path -> ltac_constructor -> unit
-val locate_constructor : qualid -> ltac_constructor
-val locate_extended_all_constructor : qualid -> ltac_constructor list
-val shortest_qualid_of_constructor : ltac_constructor -> qualid
-
-val push_type : visibility -> full_path -> type_constant -> unit
-val locate_type : qualid -> type_constant
-val locate_extended_all_type : qualid -> type_constant list
-val shortest_qualid_of_type : ?loc:Loc.t -> type_constant -> qualid
-
-val push_projection : visibility -> full_path -> ltac_projection -> unit
-val locate_projection : qualid -> ltac_projection
-val locate_extended_all_projection : qualid -> ltac_projection list
-val shortest_qualid_of_projection : ltac_projection -> qualid
-
-(** {5 Toplevel definitions of ML tactics} *)
-
-(** This state is not part of the summary, contrarily to the ones above. It is
-    intended to be used from ML plugins to register ML-side functions. *)
-
-val define_primitive : ml_tactic_name -> closure -> unit
-val interp_primitive : ml_tactic_name -> closure
-
-(** {5 ML primitive types} *)
-
-type 'a or_glb_tacexpr =
-| GlbVal of 'a
-| GlbTacexpr of glb_tacexpr
-
-type ('a, 'b, 'r) intern_fun = Genintern.glob_sign -> 'a -> 'b * 'r glb_typexpr
-
-type environment = {
-  env_ist : valexpr Id.Map.t;
-}
-
-type ('a, 'b) ml_object = {
-  ml_intern : 'r. (raw_tacexpr, glb_tacexpr, 'r) intern_fun -> ('a, 'b or_glb_tacexpr, 'r) intern_fun;
-  ml_subst : Mod_subst.substitution -> 'b -> 'b;
-  ml_interp : environment -> 'b -> valexpr Proofview.tactic;
-  ml_print : Environ.env -> 'b -> Pp.t;
-}
-
-val define_ml_object : ('a, 'b) Tac2dyn.Arg.tag -> ('a, 'b) ml_object -> unit
-val interp_ml_object : ('a, 'b) Tac2dyn.Arg.tag -> ('a, 'b) ml_object
-
-(** {5 Absolute paths} *)
-
-val coq_prefix : ModPath.t
-(** Path where primitive datatypes are defined in Ltac2 plugin. *)
-
-val std_prefix : ModPath.t
-(** Path where Ltac-specific datatypes are defined in Ltac2 plugin. *)
-
-val ltac1_prefix : ModPath.t
-(** Path where the Ltac1 legacy FFI is defined. *)
-
-(** {5 Generic arguments} *)
-
-val wit_ltac2 : (raw_tacexpr, glb_tacexpr, Util.Empty.t) genarg_type
-val wit_ltac2_quotation : (Id.t Loc.located, Id.t, Util.Empty.t) genarg_type
-
-(** {5 Helper functions} *)
-
-val is_constructor : qualid -> bool
diff --git a/src/tac2expr.mli b/src/tac2expr.mli
deleted file mode 100644
index 1069d0bfa3..0000000000
--- a/src/tac2expr.mli
+++ /dev/null
@@ -1,190 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Libnames
-
-type mutable_flag = bool
-type rec_flag = bool
-type redef_flag = bool
-type lid = Id.t
-type uid = Id.t
-
-type ltac_constant = KerName.t
-type ltac_alias = KerName.t
-type ltac_constructor = KerName.t
-type ltac_projection = KerName.t
-type type_constant = KerName.t
-
-type tacref =
-| TacConstant of ltac_constant
-| TacAlias of ltac_alias
-
-type 'a or_relid =
-| RelId of qualid
-| AbsKn of 'a
-
-(** {5 Misc} *)
-
-type ml_tactic_name = {
-  mltac_plugin : string;
-  mltac_tactic : string;
-}
-
-type 'a or_tuple =
-| Tuple of int
-| Other of 'a
-
-(** {5 Type syntax} *)
-
-type raw_typexpr_r =
-| CTypVar of Name.t
-| CTypArrow of raw_typexpr * raw_typexpr
-| CTypRef of type_constant or_tuple or_relid * raw_typexpr list
-
-and raw_typexpr = raw_typexpr_r CAst.t
-
-type raw_typedef =
-| CTydDef of raw_typexpr option
-| CTydAlg of (uid * raw_typexpr list) list
-| CTydRec of (lid * mutable_flag * raw_typexpr) list
-| CTydOpn
-
-type 'a glb_typexpr =
-| GTypVar of 'a
-| GTypArrow of 'a glb_typexpr * 'a glb_typexpr
-| GTypRef of type_constant or_tuple * 'a glb_typexpr list
-
-type glb_alg_type = {
-  galg_constructors : (uid * int glb_typexpr list) list;
-  (** Constructors of the algebraic type *)
-  galg_nconst : int;
-  (** Number of constant constructors *)
-  galg_nnonconst : int;
-  (** Number of non-constant constructors *)
-}
-
-type glb_typedef =
-| GTydDef of int glb_typexpr option
-| GTydAlg of glb_alg_type
-| GTydRec of (lid * mutable_flag * int glb_typexpr) list
-| GTydOpn
-
-type type_scheme = int * int glb_typexpr
-
-type raw_quant_typedef = Names.lident list * raw_typedef
-type glb_quant_typedef = int * glb_typedef
-
-(** {5 Term syntax} *)
-
-type atom =
-| AtmInt of int
-| AtmStr of string
-
-(** Tactic expressions *)
-type raw_patexpr_r =
-| CPatVar of Name.t
-| CPatRef of ltac_constructor or_tuple or_relid * raw_patexpr list
-| CPatCnv of raw_patexpr * raw_typexpr
-
-and raw_patexpr = raw_patexpr_r CAst.t
-
-type raw_tacexpr_r =
-| CTacAtm of atom
-| CTacRef of tacref or_relid
-| CTacCst of ltac_constructor or_tuple or_relid
-| CTacFun of raw_patexpr list * raw_tacexpr
-| CTacApp of raw_tacexpr * raw_tacexpr list
-| CTacLet of rec_flag * (raw_patexpr * raw_tacexpr) list * raw_tacexpr
-| CTacCnv of raw_tacexpr * raw_typexpr
-| CTacSeq of raw_tacexpr * raw_tacexpr
-| CTacCse of raw_tacexpr * raw_taccase list
-| CTacRec of raw_recexpr
-| CTacPrj of raw_tacexpr * ltac_projection or_relid
-| CTacSet of raw_tacexpr * ltac_projection or_relid * raw_tacexpr
-| CTacExt : ('a, _) Tac2dyn.Arg.tag * 'a -> raw_tacexpr_r
-
-and raw_tacexpr = raw_tacexpr_r CAst.t
-
-and raw_taccase = raw_patexpr * raw_tacexpr
-
-and raw_recexpr = (ltac_projection or_relid * raw_tacexpr) list
-
-type case_info = type_constant or_tuple
-
-type 'a open_match = {
-  opn_match : 'a;
-  opn_branch : (Name.t * Name.t array * 'a) KNmap.t;
-  (** Invariant: should not be empty *)
-  opn_default : Name.t * 'a;
-}
-
-type glb_tacexpr =
-| GTacAtm of atom
-| GTacVar of Id.t
-| GTacRef of ltac_constant
-| GTacFun of Name.t list * glb_tacexpr
-| GTacApp of glb_tacexpr * glb_tacexpr list
-| GTacLet of rec_flag * (Name.t * glb_tacexpr) list * glb_tacexpr
-| GTacCst of case_info * int * glb_tacexpr list
-| GTacCse of glb_tacexpr * case_info * glb_tacexpr array * (Name.t array * glb_tacexpr) array
-| GTacPrj of type_constant * glb_tacexpr * int
-| GTacSet of type_constant * glb_tacexpr * int * glb_tacexpr
-| GTacOpn of ltac_constructor * glb_tacexpr list
-| GTacWth of glb_tacexpr open_match
-| GTacExt : (_, 'a) Tac2dyn.Arg.tag * 'a -> glb_tacexpr
-| GTacPrm of ml_tactic_name * glb_tacexpr list
-
-(** {5 Parsing & Printing} *)
-
-type exp_level =
-| E5
-| E4
-| E3
-| E2
-| E1
-| E0
-
-type sexpr =
-| SexprStr of string CAst.t
-| SexprInt of int CAst.t
-| SexprRec of Loc.t * Id.t option CAst.t * sexpr list
-
-(** {5 Toplevel statements} *)
-
-type strexpr =
-| StrVal of mutable_flag * rec_flag * (Names.lname * raw_tacexpr) list
-  (** Term definition *)
-| StrTyp of rec_flag * (qualid * redef_flag * raw_quant_typedef) list
-  (** Type definition *)
-| StrPrm of Names.lident * raw_typexpr * ml_tactic_name
-  (** External definition *)
-| StrSyn of sexpr list * int option * raw_tacexpr
-  (** Syntactic extensions *)
-| StrMut of qualid * raw_tacexpr
-  (** Redefinition of mutable globals *)
-| StrRun of raw_tacexpr
-  (** Toplevel evaluation of an expression *)
-
-(** {5 Dynamic semantics} *)
-
-(** Values are represented in a way similar to OCaml, i.e. they constrast
-    immediate integers (integers, constructors without arguments) and structured
-    blocks (tuples, arrays, constructors with arguments), as well as a few other
-    base cases, namely closures, strings, named constructors, and dynamic type
-    coming from the Coq implementation. *)
-
-type tag = int
-
-type frame =
-| FrLtac of ltac_constant
-| FrAnon of glb_tacexpr
-| FrPrim of ml_tactic_name
-| FrExtn : ('a, 'b) Tac2dyn.Arg.tag * 'b -> frame
-
-type backtrace = frame list
diff --git a/src/tac2extffi.ml b/src/tac2extffi.ml
deleted file mode 100644
index 315c970f9e..0000000000
--- a/src/tac2extffi.ml
+++ /dev/null
@@ -1,40 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Tac2ffi
-open Tac2types
-
-module Value = Tac2ffi
-
-(** Make a representation with a dummy from function *)
-let make_to_repr f = Tac2ffi.make_repr (fun _ -> assert false) f
-
-(** More ML representations *)
-
-let to_qhyp v = match Value.to_block v with
-| (0, [| i |]) -> AnonHyp (Value.to_int i)
-| (1, [| id |]) -> NamedHyp (Value.to_ident id)
-| _ -> assert false
-
-let qhyp = make_to_repr to_qhyp
-
-let to_bindings = function
-| ValInt 0 -> NoBindings
-| ValBlk (0, [| vl |]) ->
-  ImplicitBindings (Value.to_list Value.to_constr vl)
-| ValBlk (1, [| vl |]) ->
-  ExplicitBindings ((Value.to_list (fun p -> to_pair to_qhyp Value.to_constr p) vl))
-| _ -> assert false
-
-let bindings = make_to_repr to_bindings
-
-let to_constr_with_bindings v = match Value.to_tuple v with
-| [| c; bnd |] -> (Value.to_constr c, to_bindings bnd)
-| _ -> assert false
-
-let constr_with_bindings = make_to_repr to_constr_with_bindings
diff --git a/src/tac2extffi.mli b/src/tac2extffi.mli
deleted file mode 100644
index f5251c3d0d..0000000000
--- a/src/tac2extffi.mli
+++ /dev/null
@@ -1,16 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Tac2ffi
-open Tac2types
-
-val qhyp : quantified_hypothesis repr
-
-val bindings : bindings repr
-
-val constr_with_bindings : constr_with_bindings repr
diff --git a/src/tac2ffi.ml b/src/tac2ffi.ml
deleted file mode 100644
index e3127ab9df..0000000000
--- a/src/tac2ffi.ml
+++ /dev/null
@@ -1,382 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Util
-open Names
-open Globnames
-open Tac2dyn
-open Tac2expr
-open Proofview.Notations
-
-type ('a, _) arity0 =
-| OneAty : ('a, 'a -> 'a Proofview.tactic) arity0
-| AddAty : ('a, 'b) arity0 -> ('a, 'a -> 'b) arity0
-
-type valexpr =
-| ValInt of int
-  (** Immediate integers *)
-| ValBlk of tag * valexpr array
-  (** Structured blocks *)
-| ValStr of Bytes.t
-  (** Strings *)
-| ValCls of closure
-  (** Closures *)
-| ValOpn of KerName.t * valexpr array
-  (** Open constructors *)
-| ValExt : 'a Tac2dyn.Val.tag * 'a -> valexpr
-  (** Arbitrary data *)
-
-and closure = MLTactic : (valexpr, 'v) arity0 * 'v -> closure
-
-let arity_one = OneAty
-let arity_suc a = AddAty a
-
-type 'a arity = (valexpr, 'a) arity0
-
-let mk_closure arity f = MLTactic (arity, f)
-
-module Valexpr =
-struct
-
-type t = valexpr
-
-let is_int = function
-| ValInt _ -> true
-| ValBlk _ | ValStr _ | ValCls _ | ValOpn _ | ValExt _ -> false
-
-let tag v = match v with
-| ValBlk (n, _) -> n
-| ValInt _ | ValStr _ | ValCls _ | ValOpn _ | ValExt _ ->
-  CErrors.anomaly (Pp.str "Unexpected value shape")
-
-let field v n = match v with
-| ValBlk (_, v) -> v.(n)
-| ValInt _ | ValStr _ | ValCls _ | ValOpn _ | ValExt _ ->
-  CErrors.anomaly (Pp.str "Unexpected value shape")
-
-let set_field v n w = match v with
-| ValBlk (_, v) -> v.(n) <- w
-| ValInt _ | ValStr _ | ValCls _ | ValOpn _ | ValExt _ ->
-  CErrors.anomaly (Pp.str "Unexpected value shape")
-
-let make_block tag v = ValBlk (tag, v)
-let make_int n = ValInt n
-
-end
-
-type 'a repr = {
-  r_of : 'a -> valexpr;
-  r_to : valexpr -> 'a;
-  r_id : bool;
-}
-
-let repr_of r x = r.r_of x
-let repr_to r x = r.r_to x
-
-let make_repr r_of r_to = { r_of; r_to; r_id = false; }
-
-(** Dynamic tags *)
-
-let val_exn = Val.create "exn"
-let val_constr = Val.create "constr"
-let val_ident = Val.create "ident"
-let val_pattern = Val.create "pattern"
-let val_pp = Val.create "pp"
-let val_sort = Val.create "sort"
-let val_cast = Val.create "cast"
-let val_inductive = Val.create "inductive"
-let val_constant = Val.create "constant"
-let val_constructor = Val.create "constructor"
-let val_projection = Val.create "projection"
-let val_case = Val.create "case"
-let val_univ = Val.create "universe"
-let val_free : Names.Id.Set.t Val.tag = Val.create "free"
-let val_ltac1 : Geninterp.Val.t Val.tag = Val.create "ltac1"
-
-let extract_val (type a) (type b) (tag : a Val.tag) (tag' : b Val.tag) (v : b) : a =
-match Val.eq tag tag' with
-| None -> assert false
-| Some Refl -> v
-
-(** Exception *)
-
-exception LtacError of KerName.t * valexpr array
-
-(** Conversion functions *)
-
-let valexpr = {
-  r_of = (fun obj -> obj);
-  r_to = (fun obj -> obj);
-  r_id = true;
-}
-
-let of_unit () = ValInt 0
-
-let to_unit = function
-| ValInt 0 -> ()
-| _ -> assert false
-
-let unit = {
-  r_of = of_unit;
-  r_to = to_unit;
-  r_id = false;
-}
-
-let of_int n = ValInt n
-let to_int = function
-| ValInt n -> n
-| _ -> assert false
-
-let int = {
-  r_of = of_int;
-  r_to = to_int;
-  r_id = false;
-}
-
-let of_bool b = if b then ValInt 0 else ValInt 1
-
-let to_bool = function
-| ValInt 0 -> true
-| ValInt 1 -> false
-| _ -> assert false
-
-let bool = {
-  r_of = of_bool;
-  r_to = to_bool;
-  r_id = false;
-}
-
-let of_char n = ValInt (Char.code n)
-let to_char = function
-| ValInt n -> Char.chr n
-| _ -> assert false
-
-let char = {
-  r_of = of_char;
-  r_to = to_char;
-  r_id = false;
-}
-
-let of_string s = ValStr s
-let to_string = function
-| ValStr s -> s
-| _ -> assert false
-
-let string = {
-  r_of = of_string;
-  r_to = to_string;
-  r_id = false;
-}
-
-let rec of_list f = function
-| [] -> ValInt 0
-| x :: l -> ValBlk (0, [| f x; of_list f l |])
-
-let rec to_list f = function
-| ValInt 0 -> []
-| ValBlk (0, [|v; vl|]) -> f v :: to_list f vl
-| _ -> assert false
-
-let list r = {
-  r_of = (fun l -> of_list r.r_of l);
-  r_to = (fun l -> to_list r.r_to l);
-  r_id = false;
-}
-
-let of_closure cls = ValCls cls
-
-let to_closure = function
-| ValCls cls -> cls
-| ValExt _ | ValInt _ | ValBlk _ | ValStr _ | ValOpn _ -> assert false
-
-let closure = {
-  r_of = of_closure;
-  r_to = to_closure;
-  r_id = false;
-}
-
-let of_ext tag c =
-  ValExt (tag, c)
-
-let to_ext tag = function
-| ValExt (tag', e) -> extract_val tag tag' e
-| _ -> assert false
-
-let repr_ext tag = {
-  r_of = (fun e -> of_ext tag e);
-  r_to = (fun e -> to_ext tag e);
-  r_id = false;
-}
-
-let of_constr c = of_ext val_constr c
-let to_constr c = to_ext val_constr c
-let constr = repr_ext val_constr
-
-let of_ident c = of_ext val_ident c
-let to_ident c = to_ext val_ident c
-let ident = repr_ext val_ident
-
-let of_pattern c = of_ext val_pattern c
-let to_pattern c = to_ext val_pattern c
-let pattern = repr_ext val_pattern
-
-let internal_err =
-  let open Names in
-  let coq_prefix =
-    MPfile (DirPath.make (List.map Id.of_string ["Init"; "Ltac2"]))
-  in
-  KerName.make coq_prefix (Label.of_id (Id.of_string "Internal"))
-
-(** FIXME: handle backtrace in Ltac2 exceptions *)
-let of_exn c = match fst c with
-| LtacError (kn, c) -> ValOpn (kn, c)
-| _ -> ValOpn (internal_err, [|of_ext val_exn c|])
-
-let to_exn c = match c with
-| ValOpn (kn, c) ->
-  if Names.KerName.equal kn internal_err then
-    to_ext val_exn c.(0)
-  else
-    (LtacError (kn, c), Exninfo.null)
-| _ -> assert false
-
-let exn = {
-  r_of = of_exn;
-  r_to = to_exn;
-  r_id = false;
-}
-
-let of_option f = function
-| None -> ValInt 0
-| Some c -> ValBlk (0, [|f c|])
-
-let to_option f = function
-| ValInt 0 -> None
-| ValBlk (0, [|c|]) -> Some (f c)
-| _ -> assert false
-
-let option r = {
-  r_of = (fun l -> of_option r.r_of l);
-  r_to = (fun l -> to_option r.r_to l);
-  r_id = false;
-}
-
-let of_pp c = of_ext val_pp c
-let to_pp c = to_ext val_pp c
-let pp = repr_ext val_pp
-
-let of_tuple cl = ValBlk (0, cl)
-let to_tuple = function
-| ValBlk (0, cl) -> cl
-| _ -> assert false
-
-let of_pair f g (x, y) = ValBlk (0, [|f x; g y|])
-let to_pair f g = function
-| ValBlk (0, [|x; y|]) -> (f x, g y)
-| _ -> assert false
-let pair r0 r1 = {
-  r_of = (fun p -> of_pair r0.r_of r1.r_of p);
-  r_to = (fun p -> to_pair r0.r_to r1.r_to p);
-  r_id = false;
-}
-
-let of_array f vl = ValBlk (0, Array.map f vl)
-let to_array f = function
-| ValBlk (0, vl) -> Array.map f vl
-| _ -> assert false
-let array r = {
-  r_of = (fun l -> of_array r.r_of l);
-  r_to = (fun l -> to_array r.r_to l);
-  r_id = false;
-}
-
-let of_block (n, args) = ValBlk (n, args)
-let to_block = function
-| ValBlk (n, args) -> (n, args)
-| _ -> assert false
-
-let block = {
-  r_of = of_block;
-  r_to = to_block;
-  r_id = false;
-}
-
-let of_open (kn, args) = ValOpn (kn, args)
-
-let to_open = function
-| ValOpn (kn, args) -> (kn, args)
-| _ -> assert false
-
-let open_ = {
-  r_of = of_open;
-  r_to = to_open;
-  r_id = false;
-}
-
-let of_constant c = of_ext val_constant c
-let to_constant c = to_ext val_constant c
-let constant = repr_ext val_constant
-
-let of_reference = function
-| VarRef id -> ValBlk (0, [| of_ident id |])
-| ConstRef cst -> ValBlk (1, [| of_constant cst |])
-| IndRef ind -> ValBlk (2, [| of_ext val_inductive ind |])
-| ConstructRef cstr -> ValBlk (3, [| of_ext val_constructor cstr |])
-
-let to_reference = function
-| ValBlk (0, [| id |]) -> VarRef (to_ident id)
-| ValBlk (1, [| cst |]) -> ConstRef (to_constant cst)
-| ValBlk (2, [| ind |]) -> IndRef (to_ext val_inductive ind)
-| ValBlk (3, [| cstr |]) -> ConstructRef (to_ext val_constructor cstr)
-| _ -> assert false
-
-let reference = {
-  r_of = of_reference;
-  r_to = to_reference;
-  r_id = false;
-}
-
-type ('a, 'b) fun1 = closure
-
-let fun1 (r0 : 'a repr) (r1 : 'b repr) : ('a, 'b) fun1 repr = closure
-let to_fun1 r0 r1 f = to_closure f
-
-let rec apply : type a. a arity -> a -> valexpr list -> valexpr Proofview.tactic =
-  fun arity f args -> match args, arity with
-  | [], arity -> Proofview.tclUNIT (ValCls (MLTactic (arity, f)))
-  (* A few hardcoded cases for efficiency *)
-  | [a0], OneAty -> f a0
-  | [a0; a1], AddAty OneAty -> f a0 a1
-  | [a0; a1; a2], AddAty (AddAty OneAty) -> f a0 a1 a2
-  | [a0; a1; a2; a3], AddAty (AddAty (AddAty OneAty)) -> f a0 a1 a2 a3
-  (* Generic cases *)
-  | a :: args, OneAty ->
-    f a >>= fun f ->
-    let MLTactic (arity, f) = to_closure f in
-    apply arity f args
-  | a :: args, AddAty arity ->
-    apply arity (f a) args
-
-let apply (MLTactic (arity, f)) args = apply arity f args
-
-type n_closure =
-| NClosure : 'a arity * (valexpr list -> 'a) -> n_closure
-
-let rec abstract n f =
-  if Int.equal n 1 then NClosure (OneAty, fun accu v -> f (List.rev (v :: accu)))
-  else
-    let NClosure (arity, fe) = abstract (n - 1) f in
-    NClosure (AddAty arity, fun accu v -> fe (v :: accu))
-
-let abstract n f =
-  let () = assert (n > 0) in
-  let NClosure (arity, f) = abstract n f in
-  MLTactic (arity, f [])
-
-let app_fun1 cls r0 r1 x =
-  apply cls [r0.r_of x] >>= fun v -> Proofview.tclUNIT (r1.r_to v)
diff --git a/src/tac2ffi.mli b/src/tac2ffi.mli
deleted file mode 100644
index bfc93d99e6..0000000000
--- a/src/tac2ffi.mli
+++ /dev/null
@@ -1,189 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open EConstr
-open Tac2dyn
-open Tac2expr
-
-(** {5 Toplevel values} *)
-
-type closure
-
-type valexpr =
-| ValInt of int
-  (** Immediate integers *)
-| ValBlk of tag * valexpr array
-  (** Structured blocks *)
-| ValStr of Bytes.t
-  (** Strings *)
-| ValCls of closure
-  (** Closures *)
-| ValOpn of KerName.t * valexpr array
-  (** Open constructors *)
-| ValExt : 'a Tac2dyn.Val.tag * 'a -> valexpr
-  (** Arbitrary data *)
-
-type 'a arity
-
-val arity_one : (valexpr -> valexpr Proofview.tactic) arity
-val arity_suc : 'a arity -> (valexpr -> 'a) arity
-
-val mk_closure : 'v arity -> 'v -> closure
-
-module Valexpr :
-sig
-  type t = valexpr
-  val is_int : t -> bool
-  val tag : t -> int
-  val field : t -> int -> t
-  val set_field : t -> int -> t -> unit
-  val make_block : int -> t array -> t
-  val make_int : int -> t
-end
-
-(** {5 Ltac2 FFI} *)
-
-type 'a repr
-
-val repr_of : 'a repr -> 'a -> valexpr
-val repr_to : 'a repr -> valexpr -> 'a
-
-val make_repr : ('a -> valexpr) -> (valexpr -> 'a) -> 'a repr
-
-(** These functions allow to convert back and forth between OCaml and Ltac2
-    data representation. The [to_*] functions raise an anomaly whenever the data
-    has not expected shape. *)
-
-val of_unit : unit -> valexpr
-val to_unit : valexpr -> unit
-val unit : unit repr
-
-val of_int : int -> valexpr
-val to_int : valexpr -> int
-val int : int repr
-
-val of_bool : bool -> valexpr
-val to_bool : valexpr -> bool
-val bool : bool repr
-
-val of_char : char -> valexpr
-val to_char : valexpr -> char
-val char : char repr
-
-val of_string : Bytes.t -> valexpr
-val to_string : valexpr -> Bytes.t
-val string : Bytes.t repr
-
-val of_list : ('a -> valexpr) -> 'a list -> valexpr
-val to_list : (valexpr -> 'a) -> valexpr -> 'a list
-val list : 'a repr -> 'a list repr
-
-val of_constr : EConstr.t -> valexpr
-val to_constr : valexpr -> EConstr.t
-val constr : EConstr.t repr
-
-val of_exn : Exninfo.iexn -> valexpr
-val to_exn : valexpr -> Exninfo.iexn
-val exn : Exninfo.iexn repr
-
-val of_ident : Id.t -> valexpr
-val to_ident : valexpr -> Id.t
-val ident : Id.t repr
-
-val of_closure : closure -> valexpr
-val to_closure : valexpr -> closure
-val closure : closure repr
-
-val of_block : (int * valexpr array) -> valexpr
-val to_block : valexpr -> (int * valexpr array)
-val block : (int * valexpr array) repr
-
-val of_array : ('a -> valexpr) -> 'a array -> valexpr
-val to_array : (valexpr -> 'a) -> valexpr -> 'a array
-val array : 'a repr -> 'a array repr
-
-val of_tuple : valexpr array -> valexpr
-val to_tuple : valexpr -> valexpr array
-
-val of_pair : ('a -> valexpr) -> ('b -> valexpr) -> 'a * 'b -> valexpr
-val to_pair : (valexpr -> 'a) -> (valexpr -> 'b) -> valexpr -> 'a * 'b
-val pair : 'a repr -> 'b repr -> ('a * 'b) repr
-
-val of_option : ('a -> valexpr) -> 'a option -> valexpr
-val to_option : (valexpr -> 'a) -> valexpr -> 'a option
-val option : 'a repr -> 'a option repr
-
-val of_pattern : Pattern.constr_pattern -> valexpr
-val to_pattern : valexpr -> Pattern.constr_pattern
-val pattern : Pattern.constr_pattern repr
-
-val of_pp : Pp.t -> valexpr
-val to_pp : valexpr -> Pp.t
-val pp : Pp.t repr
-
-val of_constant : Constant.t -> valexpr
-val to_constant : valexpr -> Constant.t
-val constant : Constant.t repr
-
-val of_reference : GlobRef.t -> valexpr
-val to_reference : valexpr -> GlobRef.t
-val reference : GlobRef.t repr
-
-val of_ext : 'a Val.tag -> 'a -> valexpr
-val to_ext : 'a Val.tag -> valexpr -> 'a
-val repr_ext : 'a Val.tag -> 'a repr
-
-val of_open : KerName.t * valexpr array -> valexpr
-val to_open : valexpr -> KerName.t * valexpr array
-val open_ : (KerName.t * valexpr array) repr
-
-type ('a, 'b) fun1
-
-val app_fun1 : ('a, 'b) fun1 -> 'a repr -> 'b repr -> 'a -> 'b Proofview.tactic
-
-val to_fun1 : 'a repr -> 'b repr -> valexpr -> ('a, 'b) fun1
-val fun1 : 'a repr -> 'b repr -> ('a, 'b) fun1 repr
-
-val valexpr : valexpr repr
-
-(** {5 Dynamic tags} *)
-
-val val_constr : EConstr.t Val.tag
-val val_ident : Id.t Val.tag
-val val_pattern : Pattern.constr_pattern Val.tag
-val val_pp : Pp.t Val.tag
-val val_sort : ESorts.t Val.tag
-val val_cast : Constr.cast_kind Val.tag
-val val_inductive : inductive Val.tag
-val val_constant : Constant.t Val.tag
-val val_constructor : constructor Val.tag
-val val_projection : Projection.t Val.tag
-val val_case : Constr.case_info Val.tag
-val val_univ : Univ.Level.t Val.tag
-val val_free : Id.Set.t Val.tag
-val val_ltac1 : Geninterp.Val.t Val.tag
-
-val val_exn : Exninfo.iexn Tac2dyn.Val.tag
-(** Toplevel representation of OCaml exceptions. Invariant: no [LtacError]
-    should be put into a value with tag [val_exn]. *)
-
-(** Closures *)
-
-val apply : closure -> valexpr list -> valexpr Proofview.tactic
-(** Given a closure, apply it to some arguments. Handling of argument mismatches
-    is done automatically, i.e. in case of over or under-application. *)
-
-val abstract : int -> (valexpr list -> valexpr Proofview.tactic) -> closure
-(** Turn a fixed-arity function into a closure. The inner function is guaranteed
-    to be applied to a list whose size is the integer argument. *)
-
-(** Exception *)
-
-exception LtacError of KerName.t * valexpr array
-(** Ltac2-defined exceptions seen from OCaml side *)
diff --git a/src/tac2intern.ml b/src/tac2intern.ml
deleted file mode 100644
index de99fb167f..0000000000
--- a/src/tac2intern.ml
+++ /dev/null
@@ -1,1545 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Pp
-open Util
-open CAst
-open CErrors
-open Names
-open Libnames
-open Locus
-open Tac2env
-open Tac2print
-open Tac2expr
-
-(** Hardwired types and constants *)
-
-let coq_type n = KerName.make Tac2env.coq_prefix (Label.make n)
-
-let t_int = coq_type "int"
-let t_string = coq_type "string"
-let t_constr = coq_type "constr"
-
-(** Union find *)
-
-module UF :
-sig
-type elt
-type 'a t
-val equal : elt -> elt -> bool
-val create : unit -> 'a t
-val fresh : 'a t -> elt
-val find : elt -> 'a t -> (elt * 'a option)
-val union : elt -> elt -> 'a t -> unit
-val set : elt -> 'a -> 'a t -> unit
-module Map :
-sig
-  type key = elt
-  type +'a t
-  val empty : 'a t
-  val add : key -> 'a -> 'a t -> 'a t
-  val mem : key -> 'a t -> bool
-  val find : key -> 'a t -> 'a
-  val exists : (key -> 'a -> bool) -> 'a t -> bool
-end
-end
-=
-struct
-type elt = int
-let equal = Int.equal
-module Map = Int.Map
-
-type 'a node =
-| Canon of int * 'a option
-| Equiv of elt
-
-type 'a t = {
-  mutable uf_data : 'a node array;
-  mutable uf_size : int;
-}
-
-let resize p =
-  if Int.equal (Array.length p.uf_data) p.uf_size then begin
-    let nsize = 2 * p.uf_size + 1 in
-    let v = Array.make nsize (Equiv 0) in
-    Array.blit p.uf_data 0 v 0 (Array.length p.uf_data);
-    p.uf_data <- v;
-  end
-
-let create () = { uf_data = [||]; uf_size = 0 }
-
-let fresh p =
-  resize p;
-  let n = p.uf_size in
-  p.uf_data.(n) <- (Canon (1, None));
-  p.uf_size <- n + 1;
-  n
-
-let rec lookup n p =
-  let node = Array.get p.uf_data n in
-  match node with
-  | Canon (size, v) -> n, size, v
-  | Equiv y ->
-    let ((z, _, _) as res) = lookup y p in
-    if not (Int.equal z y) then Array.set p.uf_data n (Equiv z);
-    res
-
-let find n p =
-  let (x, _, v) = lookup n p in (x, v)
-
-let union x y p =
-  let ((x, size1, _) as xcan) = lookup x p in
-  let ((y, size2, _) as ycan) = lookup y p in
-  let xcan, ycan = if size1 < size2 then xcan, ycan else ycan, xcan in
-  let x, _, xnode = xcan in
-  let y, _, ynode = ycan in
-  assert (Option.is_empty xnode);
-  assert (Option.is_empty ynode);
-  p.uf_data.(x) <- Equiv y;
-  p.uf_data.(y) <- Canon (size1 + size2, None)
-
-let set x v p =
-  let (x, s, v') = lookup x p in
-  assert (Option.is_empty v');
-  p.uf_data.(x) <- Canon (s, Some v)
-
-end
-
-type mix_var =
-| GVar of UF.elt
-| LVar of int
-
-type mix_type_scheme = int * mix_var glb_typexpr
-
-type environment = {
-  env_var : mix_type_scheme Id.Map.t;
-  (** Type schemes of bound variables *)
-  env_cst : UF.elt glb_typexpr UF.t;
-  (** Unification state *)
-  env_als : UF.elt Id.Map.t ref;
-  (** Map user-facing type variables to unification variables *)
-  env_opn : bool;
-  (** Accept unbound type variables *)
-  env_rec : (KerName.t * int) Id.Map.t;
-  (** Recursive type definitions *)
-  env_str : bool;
-  (** True iff in strict mode *)
-}
-
-let empty_env () = {
-  env_var = Id.Map.empty;
-  env_cst = UF.create ();
-  env_als = ref Id.Map.empty;
-  env_opn = true;
-  env_rec = Id.Map.empty;
-  env_str = true;
-}
-
-let env_name env =
-  (* Generate names according to a provided environment *)
-  let mk num =
-    let base = num mod 26 in
-    let rem = num / 26 in
-    let name = String.make 1 (Char.chr (97 + base)) in
-    let suff = if Int.equal rem 0 then "" else string_of_int rem in
-    let name = name ^ suff in
-    name
-  in
-  let fold id elt acc = UF.Map.add elt (Id.to_string id) acc in
-  let vars = Id.Map.fold fold env.env_als.contents UF.Map.empty in
-  let vars = ref vars in
-  let rec fresh n =
-    let name = mk n in
-    if UF.Map.exists (fun _ name' -> String.equal name name') !vars then fresh (succ n)
-    else name
-  in
-  fun n ->
-    if UF.Map.mem n !vars then UF.Map.find n !vars
-    else
-      let ans = fresh 0 in
-      let () = vars := UF.Map.add n ans !vars in
-      ans
-
-let ltac2_env : environment Genintern.Store.field =
-  Genintern.Store.field ()
-
-let drop_ltac2_env store =
-  Genintern.Store.remove store ltac2_env
-
-let fresh_id env = UF.fresh env.env_cst
-
-let get_alias {loc;v=id} env =
-  try Id.Map.find id env.env_als.contents
-  with Not_found ->
-    if env.env_opn then
-      let n = fresh_id env in
-      let () = env.env_als := Id.Map.add id n env.env_als.contents in
-      n
-    else user_err ?loc (str "Unbound type parameter " ++ Id.print id)
-
-let push_name id t env = match id with
-| Anonymous -> env
-| Name id -> { env with env_var = Id.Map.add id t env.env_var }
-
-let error_nargs_mismatch ?loc kn nargs nfound =
-  let cstr = Tac2env.shortest_qualid_of_constructor kn in
-  user_err ?loc (str "Constructor " ++ pr_qualid cstr ++ str " expects " ++
-    int nargs ++ str " arguments, but is applied to " ++ int nfound ++
-    str " arguments")
-
-let error_nparams_mismatch ?loc nargs nfound =
-  user_err ?loc (str "Type expects " ++ int nargs ++
-    str " arguments, but is applied to " ++ int nfound ++
-    str " arguments")
-
-let rec subst_type subst (t : 'a glb_typexpr) = match t with
-| GTypVar id -> subst id
-| GTypArrow (t1, t2) -> GTypArrow (subst_type subst t1, subst_type subst t2)
-| GTypRef (qid, args) ->
-  GTypRef (qid, List.map (fun t -> subst_type subst t) args)
-
-let rec intern_type env ({loc;v=t} : raw_typexpr) : UF.elt glb_typexpr = match t with
-| CTypVar (Name id) -> GTypVar (get_alias (CAst.make ?loc id) env)
-| CTypVar Anonymous -> GTypVar (fresh_id env)
-| CTypRef (rel, args) ->
-  let (kn, nparams) = match rel with
-  | RelId qid ->
-    let id = qualid_basename qid in
-    if qualid_is_ident qid && Id.Map.mem id env.env_rec then
-      let (kn, n) = Id.Map.find id env.env_rec in
-      (Other kn, n)
-    else
-      let kn =
-        try Tac2env.locate_type qid
-        with Not_found ->
-          user_err ?loc (str "Unbound type constructor " ++ pr_qualid qid)
-      in
-      let (nparams, _) = Tac2env.interp_type kn in
-      (Other kn, nparams)
-  | AbsKn (Other kn) ->
-    let (nparams, _) = Tac2env.interp_type kn in
-    (Other kn, nparams)
-  | AbsKn (Tuple n) ->
-    (Tuple n, n)
-  in
-  let nargs = List.length args in
-  let () =
-    if not (Int.equal nparams nargs) then
-      let qid = match rel with
-      | RelId lid -> lid
-      | AbsKn (Other kn) -> shortest_qualid_of_type ?loc kn
-      | AbsKn (Tuple _) -> assert false
-      in
-      user_err ?loc (strbrk "The type constructor " ++ pr_qualid qid ++
-        strbrk " expects " ++ int nparams ++ strbrk " argument(s), but is here \
-        applied to " ++ int nargs ++ strbrk "argument(s)")
-  in
-  GTypRef (kn, List.map (fun t -> intern_type env t) args)
-| CTypArrow (t1, t2) -> GTypArrow (intern_type env t1, intern_type env t2)
-
-let fresh_type_scheme env (t : type_scheme) : UF.elt glb_typexpr =
-  let (n, t) = t in
-  let subst = Array.init n (fun _ -> fresh_id env) in
-  let substf i = GTypVar subst.(i) in
-  subst_type substf t
-
-let fresh_mix_type_scheme env (t : mix_type_scheme) : UF.elt glb_typexpr =
-  let (n, t) = t in
-  let subst = Array.init n (fun _ -> fresh_id env) in
-  let substf = function
-  | LVar i -> GTypVar subst.(i)
-  | GVar n -> GTypVar n
-  in
-  subst_type substf t
-
-let fresh_reftype env (kn : KerName.t or_tuple) =
-  let n = match kn with
-  | Other kn -> fst (Tac2env.interp_type kn)
-  | Tuple n -> n
-  in
-  let subst = Array.init n (fun _ -> fresh_id env) in
-  let t = GTypRef (kn, Array.map_to_list (fun i -> GTypVar i) subst) in
-  (subst, t)
-
-(** First-order unification algorithm *)
-let is_unfoldable kn = match snd (Tac2env.interp_type kn) with
-| GTydDef (Some _) -> true
-| GTydDef None | GTydAlg _ | GTydRec _ | GTydOpn -> false
-
-let unfold env kn args =
-  let (nparams, def) = Tac2env.interp_type kn in
-  let def = match def with
-  | GTydDef (Some t) -> t
-  | _ -> assert false
-  in
-  let args = Array.of_list args in
-  let subst n = args.(n) in
-  subst_type subst def
-
-(** View function, allows to ensure head normal forms *)
-let rec kind env t = match t with
-| GTypVar id ->
-  let (id, v) = UF.find id env.env_cst in
-  begin match v with
-  | None -> GTypVar id
-  | Some t -> kind env t
-  end
-| GTypRef (Other kn, tl) ->
-  if is_unfoldable kn then kind env (unfold env kn tl) else t
-| GTypArrow _ | GTypRef (Tuple _, _) -> t
-
-(** Normalize unification variables without unfolding type aliases *)
-let rec nf env t = match t with
-| GTypVar id ->
-  let (id, v) = UF.find id env.env_cst in
-  begin match v with
-  | None -> GTypVar id
-  | Some t -> nf env t
-  end
-| GTypRef (kn, tl) ->
-  let tl = List.map (fun t -> nf env t) tl in
-  GTypRef (kn, tl)
-| GTypArrow (t, u) ->
-  let t = nf env t in
-  let u = nf env u in
-  GTypArrow (t, u)
-
-let pr_glbtype env t =
-  let t = nf env t in
-  let name = env_name env in
-  pr_glbtype name t
-
-exception Occur
-
-let rec occur_check env id t = match kind env t with
-| GTypVar id' -> if UF.equal id id' then raise Occur
-| GTypArrow (t1, t2) ->
-  let () = occur_check env id t1 in
-  occur_check env id t2
-| GTypRef (kn, tl) ->
-  List.iter (fun t -> occur_check env id t) tl
-
-exception CannotUnify of UF.elt glb_typexpr * UF.elt glb_typexpr
-
-let unify_var env id t = match kind env t with
-| GTypVar id' ->
-  if not (UF.equal id id') then UF.union id id' env.env_cst
-| GTypArrow _ | GTypRef _ ->
-  try
-    let () = occur_check env id t in
-    UF.set id t env.env_cst
-  with Occur -> raise (CannotUnify (GTypVar id, t))
-
-let eq_or_tuple eq t1 t2 = match t1, t2 with
-| Tuple n1, Tuple n2 -> Int.equal n1 n2
-| Other o1, Other o2 -> eq o1 o2
-| _ -> false
-
-let rec unify0 env t1 t2 = match kind env t1, kind env t2 with
-| GTypVar id, t | t, GTypVar id ->
-  unify_var env id t
-| GTypArrow (t1, u1), GTypArrow (t2, u2) ->
-  let () = unify0 env t1 t2 in
-  unify0 env u1 u2
-| GTypRef (kn1, tl1), GTypRef (kn2, tl2) ->
-  if eq_or_tuple KerName.equal kn1 kn2 then
-    List.iter2 (fun t1 t2 -> unify0 env t1 t2) tl1 tl2
-  else raise (CannotUnify (t1, t2))
-| _ -> raise (CannotUnify (t1, t2))
-
-let unify ?loc env t1 t2 =
-  try unify0 env t1 t2
-  with CannotUnify (u1, u2) ->
-    user_err ?loc (str "This expression has type" ++ spc () ++ pr_glbtype env t1 ++
-      spc () ++ str "but an expression was expected of type" ++ spc () ++ pr_glbtype env t2)
-
-let unify_arrow ?loc env ft args =
-  let ft0 = ft in
-  let rec iter ft args is_fun = match kind env ft, args with
-  | t, [] -> t
-  | GTypArrow (t1, ft), (loc, t2) :: args ->
-    let () = unify ?loc env t2 t1 in
-    iter ft args true
-  | GTypVar id, (_, t) :: args ->
-    let ft = GTypVar (fresh_id env) in
-    let () = unify_var env id (GTypArrow (t, ft)) in
-    iter ft args true
-  | GTypRef _, _ :: _ ->
-    if is_fun then
-      user_err ?loc (str "This function has type" ++ spc () ++ pr_glbtype env ft0 ++
-        spc () ++ str "and is applied to too many arguments")
-    else
-      user_err ?loc (str "This expression has type" ++ spc () ++ pr_glbtype env ft0 ++
-        spc () ++ str "and is not a function")
-  in
-  iter ft args false
-
-(** Term typing *)
-
-let is_pure_constructor kn =
-  match snd (Tac2env.interp_type kn) with
-  | GTydAlg _ | GTydOpn -> true
-  | GTydRec fields ->
-    let is_pure (_, mut, _) = not mut in
-    List.for_all is_pure fields
-  | GTydDef _ -> assert false (** Type definitions have no constructors *)
-
-let rec is_value = function
-| GTacAtm (AtmInt _) | GTacVar _ | GTacRef _ | GTacFun _ -> true
-| GTacAtm (AtmStr _) | GTacApp _ | GTacLet _ -> false
-| GTacCst (Tuple _, _, el) -> List.for_all is_value el
-| GTacCst (_, _, []) -> true
-| GTacOpn (_, el) -> List.for_all is_value el
-| GTacCst (Other kn, _, el) -> is_pure_constructor kn && List.for_all is_value el
-| GTacCse _ | GTacPrj _ | GTacSet _ | GTacExt _ | GTacPrm _
-| GTacWth _ -> false
-
-let is_rec_rhs = function
-| GTacFun _ -> true
-| GTacAtm _ | GTacVar _ | GTacRef _ | GTacApp _ | GTacLet _ | GTacPrj _
-| GTacSet _ | GTacExt _ | GTacPrm _ | GTacCst _
-| GTacCse _ | GTacOpn _ | GTacWth _ -> false
-
-let rec fv_type f t accu = match t with
-| GTypVar id -> f id accu
-| GTypArrow (t1, t2) -> fv_type f t1 (fv_type f t2 accu)
-| GTypRef (kn, tl) -> List.fold_left (fun accu t -> fv_type f t accu) accu tl
-
-let fv_env env =
-  let rec f id accu = match UF.find id env.env_cst with
-  | id, None -> UF.Map.add id () accu
-  | _, Some t -> fv_type f t accu
-  in
-  let fold_var id (_, t) accu =
-    let fmix id accu = match id with
-    | LVar _ -> accu
-    | GVar id -> f id accu
-    in
-    fv_type fmix t accu
-  in
-  let fv_var = Id.Map.fold fold_var env.env_var UF.Map.empty in
-  let fold_als _ id accu = f id accu in
-  Id.Map.fold fold_als !(env.env_als) fv_var
-
-let abstract_var env (t : UF.elt glb_typexpr) : mix_type_scheme =
-  let fv = fv_env env in
-  let count = ref 0 in
-  let vars = ref UF.Map.empty in
-  let rec subst id =
-    let (id, t) = UF.find id env.env_cst in
-    match t with
-    | None ->
-      if UF.Map.mem id fv then GTypVar (GVar id)
-      else
-        begin try UF.Map.find id !vars
-        with Not_found ->
-          let n = !count in
-          let var = GTypVar (LVar n) in
-          let () = incr count in
-          let () = vars := UF.Map.add id var !vars in
-          var
-        end
-    | Some t -> subst_type subst t
-  in
-  let t = subst_type subst t in
-  (!count, t)
-
-let monomorphic (t : UF.elt glb_typexpr) : mix_type_scheme =
-  let subst id = GTypVar (GVar id) in
-  (0, subst_type subst t)
-
-let warn_not_unit =
-  CWarnings.create ~name:"not-unit" ~category:"ltac"
-    (fun () -> strbrk "The following expression should have type unit.")
-
-let warn_redundant_clause =
-  CWarnings.create ~name:"redundant-clause" ~category:"ltac"
-    (fun () -> strbrk "The following clause is redundant.")
-
-let check_elt_unit loc env t =
-  let maybe_unit = match kind env t with
-  | GTypVar _ -> true
-  | GTypArrow _ -> false
-  | GTypRef (Tuple 0, []) -> true
-  | GTypRef _ -> false
-  in
-  if not maybe_unit then warn_not_unit ?loc ()
-
-let check_elt_empty loc env t = match kind env t with
-| GTypVar _ ->
-  user_err ?loc (str "Cannot infer an empty type for this expression")
-| GTypArrow _ | GTypRef (Tuple _, _) ->
-  user_err ?loc (str "Type" ++ spc () ++ pr_glbtype env t ++ spc () ++ str "is not an empty type")
-| GTypRef (Other kn, _) ->
-  let def = Tac2env.interp_type kn in
-  match def with
-  | _, GTydAlg { galg_constructors = [] } -> kn
-  | _ ->
-    user_err ?loc (str "Type" ++ spc () ++ pr_glbtype env t ++ spc () ++ str "is not an empty type")
-
-let check_unit ?loc t =
-  let env = empty_env () in
-  (* Should not matter, t should be closed. *)
-  let t = fresh_type_scheme env t in
-  let maybe_unit = match kind env t with
-  | GTypVar _ -> true
-  | GTypArrow _ -> false
-  | GTypRef (Tuple 0, []) -> true
-  | GTypRef _ -> false
-  in
-  if not maybe_unit then warn_not_unit ?loc ()
-
-let check_redundant_clause = function
-| [] -> ()
-| (p, _) :: _ -> warn_redundant_clause ?loc:p.loc ()
-
-let get_variable0 mem var = match var with
-| RelId qid ->
-  let id = qualid_basename qid in
-  if qualid_is_ident qid && mem id then ArgVar CAst.(make ?loc:qid.CAst.loc id)
-  else
-    let kn =
-      try Tac2env.locate_ltac qid
-      with Not_found ->
-        CErrors.user_err ?loc:qid.CAst.loc (str "Unbound value " ++ pr_qualid qid)
-    in
-    ArgArg kn
-| AbsKn kn -> ArgArg kn
-
-let get_variable env var =
-  let mem id = Id.Map.mem id env.env_var in
-  get_variable0 mem var
-
-let get_constructor env var = match var with
-| RelId qid ->
-  let c = try Some (Tac2env.locate_constructor qid) with Not_found -> None in
-  begin match c with
-  | Some knc -> Other knc
-  | None ->
-    CErrors.user_err ?loc:qid.CAst.loc (str "Unbound constructor " ++ pr_qualid qid)
-  end
-| AbsKn knc -> knc
-
-let get_projection var = match var with
-| RelId qid ->
-  let kn = try Tac2env.locate_projection qid with Not_found ->
-    user_err ?loc:qid.CAst.loc (pr_qualid qid ++ str " is not a projection")
-  in
-  Tac2env.interp_projection kn
-| AbsKn kn ->
-  Tac2env.interp_projection kn
-
-let intern_atm env = function
-| AtmInt n -> (GTacAtm (AtmInt n), GTypRef (Other t_int, []))
-| AtmStr s -> (GTacAtm (AtmStr s), GTypRef (Other t_string, []))
-
-let invalid_pattern ?loc kn kn' =
-  let pr t = match t with
-  | Other kn' -> str "type " ++  pr_typref kn'
-  | Tuple n -> str "tuple of size " ++ int n
-  in
-  user_err ?loc (str "Invalid pattern, expected a pattern for " ++
-    pr kn ++ str ", found a pattern for " ++ pr kn') (** FIXME *)
-
-(** Pattern view *)
-
-type glb_patexpr =
-| GPatVar of Name.t
-| GPatRef of ltac_constructor or_tuple * glb_patexpr list
-
-let rec intern_patexpr env {loc;v=pat} = match pat with
-| CPatVar na -> GPatVar na
-| CPatRef (qid, pl) ->
-  let kn = get_constructor env qid in
-  GPatRef (kn, List.map (fun p -> intern_patexpr env p) pl)
-| CPatCnv (pat, ty) ->
-  user_err ?loc (str "Pattern not handled yet")
-
-type pattern_kind =
-| PKind_empty
-| PKind_variant of type_constant or_tuple
-| PKind_open of type_constant
-| PKind_any
-
-let get_pattern_kind env pl = match pl with
-| [] -> PKind_empty
-| p :: pl ->
-  let rec get_kind (p, _) pl = match intern_patexpr env p with
-  | GPatVar _ ->
-    begin match pl with
-    | [] -> PKind_any
-    | p :: pl -> get_kind p pl
-    end
-  | GPatRef (Other kn, pl) ->
-    let data = Tac2env.interp_constructor kn in
-    if Option.is_empty data.cdata_indx then PKind_open data.cdata_type
-    else PKind_variant (Other data.cdata_type)
-  | GPatRef (Tuple _, tp) -> PKind_variant (Tuple (List.length tp))
-  in
-  get_kind p pl
-
-(** Internalization *)
-
-(** Used to generate a fresh tactic variable for pattern-expansion *)
-let fresh_var avoid =
-  let bad id =
-    Id.Set.mem id avoid ||
-    (try ignore (locate_ltac (qualid_of_ident id)); true with Not_found -> false)
-  in
-  Namegen.next_ident_away_from (Id.of_string "p") bad
-
-let add_name accu = function
-| Name id -> Id.Set.add id accu
-| Anonymous -> accu
-
-let rec ids_of_pattern accu {v=pat} = match pat with
-| CPatVar Anonymous -> accu
-| CPatVar (Name id) -> Id.Set.add id accu
-| CPatRef (_, pl) ->
-  List.fold_left ids_of_pattern accu pl
-| CPatCnv (pat, _) -> ids_of_pattern accu pat
-
-let loc_of_relid = function
-| RelId {loc} -> loc
-| AbsKn _ -> None
-
-let extract_pattern_type ({loc;v=p} as pat) = match p with
-| CPatCnv (pat, ty) -> pat, Some ty
-| CPatVar _ | CPatRef _ -> pat, None
-
-(** Expand pattern: [p => t] becomes [x => match x with p => t end] *)
-let expand_pattern avoid bnd =
-  let fold (avoid, bnd) (pat, t) =
-    let na, expand = match pat.v with
-    | CPatVar na ->
-      (* Don't expand variable patterns *)
-      na, None
-    | _ ->
-      let id = fresh_var avoid in
-      let qid = RelId (qualid_of_ident ?loc:pat.loc id) in
-      Name id, Some qid
-    in
-    let avoid = ids_of_pattern avoid pat in
-    let avoid = add_name avoid na in
-    (avoid, (na, pat, expand) :: bnd)
-  in
-  let (_, bnd) = List.fold_left fold (avoid, []) bnd in
-  let fold e (na, pat, expand) = match expand with
-  | None -> e
-  | Some qid ->
-    let loc = loc_of_relid qid in
-    CAst.make ?loc @@ CTacCse (CAst.make ?loc @@ CTacRef qid, [pat, e])
-  in
-  let expand e = List.fold_left fold e bnd in
-  let nas = List.rev_map (fun (na, _, _) -> na) bnd in
-  (nas, expand)
-
-let is_alias env qid = match get_variable env qid with
-| ArgArg (TacAlias _) -> true
-| ArgVar _ | (ArgArg (TacConstant _)) -> false
-
-let rec intern_rec env {loc;v=e} = match e with
-| CTacAtm atm -> intern_atm env atm
-| CTacRef qid ->
-  begin match get_variable env qid with
-  | ArgVar {CAst.v=id} ->
-    let sch = Id.Map.find id env.env_var in
-    (GTacVar id, fresh_mix_type_scheme env sch)
-  | ArgArg (TacConstant kn) ->
-    let { Tac2env.gdata_type = sch } =
-      try Tac2env.interp_global kn
-      with Not_found ->
-        CErrors.anomaly (str "Missing hardwired primitive " ++ KerName.print kn)
-    in
-    (GTacRef kn, fresh_type_scheme env sch)
-  | ArgArg (TacAlias kn) ->
-    let e =
-      try Tac2env.interp_alias kn
-      with Not_found ->
-        CErrors.anomaly (str "Missing hardwired alias " ++ KerName.print kn)
-    in
-    intern_rec env e
-  end
-| CTacCst qid ->
-  let kn = get_constructor env qid in
-  intern_constructor env loc kn []
-| CTacFun (bnd, e) ->
-  let bnd = List.map extract_pattern_type bnd in
-  let map (_, t) = match t with
-  | None -> GTypVar (fresh_id env)
-  | Some t -> intern_type env t
-  in
-  let tl = List.map map bnd in
-  let (nas, exp) = expand_pattern (Id.Map.domain env.env_var) bnd in
-  let env = List.fold_left2 (fun env na t -> push_name na (monomorphic t) env) env nas tl in
-  let (e, t) = intern_rec env (exp e) in
-  let t = List.fold_right (fun t accu -> GTypArrow (t, accu)) tl t in
-  (GTacFun (nas, e), t)
-| CTacApp ({loc;v=CTacCst qid}, args) ->
-  let kn = get_constructor env qid in
-  intern_constructor env loc kn args
-| CTacApp ({v=CTacRef qid}, args) when is_alias env qid ->
-  let kn = match get_variable env qid with
-  | ArgArg (TacAlias kn) -> kn
-  | ArgVar _ | (ArgArg (TacConstant _)) -> assert false
-  in
-  let e = Tac2env.interp_alias kn in
-  let map arg =
-    (* Thunk alias arguments *)
-    let loc = arg.loc in
-    let t_unit = CAst.make ?loc @@ CTypRef (AbsKn (Tuple 0), []) in
-    let var = CAst.make ?loc @@ CPatCnv (CAst.make ?loc @@ CPatVar Anonymous, t_unit) in
-    CAst.make ?loc @@ CTacFun ([var], arg)
-  in
-  let args = List.map map args in
-  intern_rec env (CAst.make ?loc @@ CTacApp (e, args))
-| CTacApp (f, args) ->
-  let loc = f.loc in
-  let (f, ft) = intern_rec env f in
-  let fold arg (args, t) =
-    let loc = arg.loc in
-    let (arg, argt) = intern_rec env arg in
-    (arg :: args, (loc, argt) :: t)
-  in
-  let (args, t) = List.fold_right fold args ([], []) in
-  let ret = unify_arrow ?loc env ft t in
-  (GTacApp (f, args), ret)
-| CTacLet (is_rec, el, e) ->
-  let map (pat, e) =
-    let (pat, ty) = extract_pattern_type pat in
-    (pat, ty, e)
-  in
-  let el = List.map map el in
-  let fold accu (pat, _, e) =
-    let ids = ids_of_pattern Id.Set.empty pat in
-    let common = Id.Set.inter ids accu in
-    if Id.Set.is_empty common then Id.Set.union ids accu
-    else
-      let id = Id.Set.choose common in
-      user_err ?loc:pat.loc (str "Variable " ++ Id.print id ++ str " is bound several \
-        times in this matching")
-  in
-  let ids = List.fold_left fold Id.Set.empty el in
-  if is_rec then intern_let_rec env loc ids el e
-  else intern_let env loc ids el e
-| CTacCnv (e, tc) ->
-  let (e, t) = intern_rec env e in
-  let tc = intern_type env tc in
-  let () = unify ?loc env t tc in
-  (e, tc)
-| CTacSeq (e1, e2) ->
-  let loc1 = e1.loc in
-  let (e1, t1) = intern_rec env e1 in
-  let (e2, t2) = intern_rec env e2 in
-  let () = check_elt_unit loc1 env t1 in
-  (GTacLet (false, [Anonymous, e1], e2), t2)
-| CTacCse (e, pl) ->
-  intern_case env loc e pl
-| CTacRec fs ->
-  intern_record env loc fs
-| CTacPrj (e, proj) ->
-  let pinfo = get_projection proj in
-  let loc = e.loc in
-  let (e, t) = intern_rec env e in
-  let subst = Array.init pinfo.pdata_prms (fun _ -> fresh_id env) in
-  let params = Array.map_to_list (fun i -> GTypVar i) subst in
-  let exp = GTypRef (Other pinfo.pdata_type, params) in
-  let () = unify ?loc env t exp in
-  let substf i = GTypVar subst.(i) in
-  let ret = subst_type substf pinfo.pdata_ptyp in
-  (GTacPrj (pinfo.pdata_type, e, pinfo.pdata_indx), ret)
-| CTacSet (e, proj, r) ->
-  let pinfo = get_projection proj in
-  let () =
-    if not pinfo.pdata_mutb then
-      let loc = match proj with
-      | RelId {CAst.loc} -> loc
-      | AbsKn _ -> None
-      in
-      user_err ?loc (str "Field is not mutable")
-  in
-  let subst = Array.init pinfo.pdata_prms (fun _ -> fresh_id env) in
-  let params = Array.map_to_list (fun i -> GTypVar i) subst in
-  let exp = GTypRef (Other pinfo.pdata_type, params) in
-  let e = intern_rec_with_constraint env e exp in
-  let substf i = GTypVar subst.(i) in
-  let ret = subst_type substf pinfo.pdata_ptyp in
-  let r = intern_rec_with_constraint env r ret in
-  (GTacSet (pinfo.pdata_type, e, pinfo.pdata_indx, r), GTypRef (Tuple 0, []))
-| CTacExt (tag, arg) ->
-  let open Genintern in
-  let self ist e =
-    let env = match Store.get ist.extra ltac2_env with
-    | None -> empty_env ()
-    | Some env -> env
-    in
-    intern_rec env e
-  in
-  let obj = interp_ml_object tag in
-  (* External objects do not have access to the named context because this is
-     not stable by dynamic semantics. *)
-  let genv = Global.env_of_context Environ.empty_named_context_val in
-  let ist = empty_glob_sign genv in
-  let ist = { ist with extra = Store.set ist.extra ltac2_env env } in
-  let arg, tpe =
-    if env.env_str then
-      let arg () = obj.ml_intern self ist arg in
-      Flags.with_option Ltac_plugin.Tacintern.strict_check arg ()
-    else
-      obj.ml_intern self ist arg
-  in
-  let e = match arg with
-  | GlbVal arg -> GTacExt (tag, arg)
-  | GlbTacexpr e -> e
-  in
-  (e, tpe)
-
-and intern_rec_with_constraint env e exp =
-  let (er, t) = intern_rec env e in
-  let () = unify ?loc:e.loc env t exp in
-  er
-
-and intern_let env loc ids el e =
-  let avoid = Id.Set.union ids (Id.Map.domain env.env_var) in
-  let fold (pat, t, e) (avoid, accu) =
-    let nas, exp = expand_pattern avoid [pat, t] in
-    let na = match nas with [x] -> x | _ -> assert false in
-    let avoid = List.fold_left add_name avoid nas in
-    (avoid, (na, exp, t, e) :: accu)
-  in
-  let (_, el) = List.fold_right fold el (avoid, []) in
-  let fold (na, exp, tc, e) (body, el, p) =
-    let (e, t) = match tc with
-    | None -> intern_rec env e
-    | Some tc ->
-      let tc = intern_type env tc in
-      (intern_rec_with_constraint env e tc, tc)
-    in
-    let t = if is_value e then abstract_var env t else monomorphic t in
-    (exp body, (na, e) :: el, (na, t) :: p)
-  in
-  let (e, el, p) = List.fold_right fold el (e, [], []) in
-  let env = List.fold_left (fun accu (na, t) -> push_name na t accu) env p in
-  let (e, t) = intern_rec env e in
-  (GTacLet (false, el, e), t)
-
-and intern_let_rec env loc ids el e =
-  let map env (pat, t, e) =
-    let na = match pat.v with
-    | CPatVar na -> na
-    | CPatRef _ | CPatCnv _ ->
-      user_err ?loc:pat.loc (str "This kind of pattern is forbidden in let-rec bindings")
-    in
-    let id = fresh_id env in
-    let env = push_name na (monomorphic (GTypVar id)) env in
-    (env, (loc, na, t, e, id))
-  in
-  let (env, el) = List.fold_left_map map env el in
-  let fold (loc, na, tc, e, id) (el, tl) =
-    let loc_e = e.loc in
-    let (e, t) = intern_rec env e in
-    let () =
-      if not (is_rec_rhs e) then
-        user_err ?loc:loc_e (str "This kind of expression is not allowed as \
-          right-hand side of a recursive binding")
-    in
-    let () = unify ?loc env t (GTypVar id) in
-    let () = match tc with
-    | None -> ()
-    | Some tc ->
-      let tc = intern_type env tc in
-      unify ?loc env t tc
-    in
-    ((na, e) :: el, t :: tl)
-  in
-  let (el, tl) = List.fold_right fold el ([], []) in
-  let (e, t) = intern_rec env e in
-  (GTacLet (true, el, e), t)
-
-(** For now, patterns recognized by the pattern-matching compiling are limited
-    to depth-one where leaves are either variables or catch-all *)
-and intern_case env loc e pl =
-  let (e', t) = intern_rec env e in
-  let todo ?loc () = user_err ?loc (str "Pattern not handled yet") in
-  match get_pattern_kind env pl with
-  | PKind_any ->
-    let (pat, b) = List.hd pl in
-    let na = match intern_patexpr env pat with
-    | GPatVar na -> na
-    | _ -> assert false
-    in
-    let () = check_redundant_clause (List.tl pl) in
-    let env = push_name na (monomorphic t) env in
-    let (b, tb) = intern_rec env b in
-    (GTacLet (false, [na, e'], b), tb)
-  | PKind_empty ->
-    let kn = check_elt_empty loc env t in
-    let r = fresh_id env in
-    (GTacCse (e', Other kn, [||], [||]), GTypVar r)
-  | PKind_variant kn ->
-    let subst, tc = fresh_reftype env kn in
-    let () = unify ?loc:e.loc env t tc in
-    let (nconst, nnonconst, arities) = match kn with
-    | Tuple 0 -> 1, 0, [0]
-    | Tuple n -> 0, 1, [n]
-    | Other kn ->
-      let (_, def) = Tac2env.interp_type kn in
-      let galg = match def with | GTydAlg c -> c | _ -> assert false in
-      let arities = List.map (fun (_, args) -> List.length args) galg.galg_constructors in
-      galg.galg_nconst, galg.galg_nnonconst, arities
-    in
-    let const = Array.make nconst None in
-    let nonconst = Array.make nnonconst None in
-    let ret = GTypVar (fresh_id env) in
-    let rec intern_branch = function
-    | [] -> ()
-    | (pat, br) :: rem ->
-      let tbr = match pat.v with
-      | CPatVar (Name _) ->
-        let loc = pat.loc in
-        todo ?loc ()
-      | CPatVar Anonymous ->
-        let () = check_redundant_clause rem in
-        let (br', brT) = intern_rec env br in
-        (* Fill all remaining branches *)
-        let fill (ncst, narg) arity =
-          if Int.equal arity 0 then
-            let () =
-              if Option.is_empty const.(ncst) then const.(ncst) <- Some br'
-            in
-            (succ ncst, narg)
-          else
-            let () =
-              if Option.is_empty nonconst.(narg) then
-                let ids = Array.make arity Anonymous in
-                nonconst.(narg) <- Some (ids, br')
-            in
-            (ncst, succ narg)
-        in
-        let _ = List.fold_left fill (0, 0) arities in
-        brT
-      | CPatRef (qid, args) ->
-        let loc = pat.loc in
-        let knc = get_constructor env qid in
-        let kn', index, arity = match knc with
-        | Tuple n -> Tuple n, 0, List.init n (fun i -> GTypVar i)
-        | Other knc ->
-          let data = Tac2env.interp_constructor knc in
-          let index = Option.get data.cdata_indx in
-          Other data.cdata_type, index, data.cdata_args
-        in
-        let () =
-          if not (eq_or_tuple KerName.equal kn kn') then
-            invalid_pattern ?loc kn kn'
-        in
-        let get_id pat = match pat with
-        | {v=CPatVar na} -> na
-        | {loc} -> todo ?loc ()
-        in
-        let ids = List.map get_id args in
-        let nids = List.length ids in
-        let nargs = List.length arity in
-        let () = match knc with
-        | Tuple n -> assert (n == nids)
-        | Other knc ->
-          if not (Int.equal nids nargs) then error_nargs_mismatch ?loc knc nargs nids
-        in
-        let fold env id tpe =
-          (* Instantiate all arguments *)
-          let subst n = GTypVar subst.(n) in
-          let tpe = subst_type subst tpe in
-          push_name id (monomorphic tpe) env
-        in
-        let nenv = List.fold_left2 fold env ids arity in
-        let (br', brT) = intern_rec nenv br in
-        let () =
-          if List.is_empty args then
-            if Option.is_empty const.(index) then const.(index) <- Some br'
-            else warn_redundant_clause ?loc ()
-          else
-            let ids = Array.of_list ids in
-            if Option.is_empty nonconst.(index) then nonconst.(index) <- Some (ids, br')
-            else warn_redundant_clause ?loc ()
-        in
-        brT
-      | CPatCnv _ ->
-        user_err ?loc (str "Pattern not handled yet")
-      in
-      let () = unify ?loc:br.loc env tbr ret in
-      intern_branch rem
-    in
-    let () = intern_branch pl in
-    let map n is_const = function
-    | None ->
-      let kn = match kn with Other kn -> kn | _ -> assert false in
-      let cstr = pr_internal_constructor kn n is_const in
-      user_err ?loc (str "Unhandled match case for constructor " ++ cstr)
-    | Some x -> x
-    in
-    let const = Array.mapi (fun i o -> map i true o) const in
-    let nonconst = Array.mapi (fun i o -> map i false o) nonconst in
-    let ce = GTacCse (e', kn, const, nonconst) in
-    (ce, ret)
-  | PKind_open kn ->
-    let subst, tc = fresh_reftype env (Other kn) in
-    let () = unify ?loc:e.loc env t tc in
-    let ret = GTypVar (fresh_id env) in
-    let rec intern_branch map = function
-    | [] ->
-      user_err ?loc (str "Missing default case")
-    | (pat, br) :: rem ->
-      match intern_patexpr env pat with
-      | GPatVar na ->
-        let () = check_redundant_clause rem in
-        let nenv = push_name na (monomorphic tc) env in
-        let br' = intern_rec_with_constraint nenv br ret in
-        let def = (na, br') in
-        (map, def)
-      | GPatRef (knc, args) ->
-        let get = function
-        | GPatVar na -> na
-        | GPatRef _ ->
-          user_err ?loc (str "TODO: Unhandled match case") (* FIXME *)
-        in
-        let loc = pat.loc in
-        let knc = match knc with
-        | Other knc -> knc
-        | Tuple n -> invalid_pattern ?loc (Other kn) (Tuple n)
-        in
-        let ids = List.map get args in
-        let data = Tac2env.interp_constructor knc in
-        let () =
-          if not (KerName.equal kn data.cdata_type) then
-            invalid_pattern ?loc (Other kn) (Other data.cdata_type)
-        in
-        let nids = List.length ids in
-        let nargs = List.length data.cdata_args in
-        let () =
-          if not (Int.equal nids nargs) then error_nargs_mismatch ?loc knc nargs nids
-        in
-        let fold env id tpe =
-          (* Instantiate all arguments *)
-          let subst n = GTypVar subst.(n) in
-          let tpe = subst_type subst tpe in
-          push_name id (monomorphic tpe) env
-        in
-        let nenv = List.fold_left2 fold env ids data.cdata_args in
-        let br' = intern_rec_with_constraint nenv br ret in
-        let map =
-          if KNmap.mem knc map then
-            let () = warn_redundant_clause ?loc () in
-            map
-          else
-            KNmap.add knc (Anonymous, Array.of_list ids, br') map
-        in
-        intern_branch map rem
-    in
-    let (map, def) = intern_branch KNmap.empty pl in
-    (GTacWth { opn_match = e'; opn_branch = map; opn_default = def }, ret)
-
-and intern_constructor env loc kn args = match kn with
-| Other kn ->
-  let cstr = interp_constructor kn in
-  let nargs = List.length cstr.cdata_args in
-  if Int.equal nargs (List.length args) then
-    let subst = Array.init cstr.cdata_prms (fun _ -> fresh_id env) in
-    let substf i = GTypVar subst.(i) in
-    let types = List.map (fun t -> subst_type substf t) cstr.cdata_args in
-    let targs = List.init cstr.cdata_prms (fun i -> GTypVar subst.(i)) in
-    let ans = GTypRef (Other cstr.cdata_type, targs) in
-    let map arg tpe = intern_rec_with_constraint env arg tpe in
-    let args = List.map2 map args types in
-    match cstr.cdata_indx with
-    | Some idx ->
-      (GTacCst (Other cstr.cdata_type, idx, args), ans)
-    | None ->
-      (GTacOpn (kn, args), ans)
-  else
-    error_nargs_mismatch ?loc kn nargs (List.length args)
-| Tuple n ->
-  assert (Int.equal n (List.length args));
-  let types = List.init n (fun i -> GTypVar (fresh_id env)) in
-  let map arg tpe = intern_rec_with_constraint env arg tpe in
-  let args = List.map2 map args types in
-  let ans = GTypRef (Tuple n, types) in
-  GTacCst (Tuple n, 0, args), ans
-
-and intern_record env loc fs =
-  let map (proj, e) =
-    let loc = match proj with
-    | RelId {CAst.loc} -> loc
-    | AbsKn _ -> None
-    in
-    let proj = get_projection proj in
-    (loc, proj, e)
-  in
-  let fs = List.map map fs in
-  let kn = match fs with
-  | [] -> user_err ?loc (str "Cannot infer the corresponding record type")
-  | (_, proj, _) :: _ -> proj.pdata_type
-  in
-  let params, typdef = match Tac2env.interp_type kn with
-  | n, GTydRec def -> n, def
-  | _ -> assert false
-  in
-  let subst = Array.init params (fun _ -> fresh_id env) in
-  (* Set the answer [args] imperatively *)
-  let args = Array.make (List.length typdef) None in
-  let iter (loc, pinfo, e) =
-    if KerName.equal kn pinfo.pdata_type then
-      let index = pinfo.pdata_indx in
-      match args.(index) with
-      | None ->
-        let exp = subst_type (fun i -> GTypVar subst.(i)) pinfo.pdata_ptyp in
-        let e = intern_rec_with_constraint env e exp in
-        args.(index) <- Some e
-      | Some _ ->
-        let (name, _, _) = List.nth typdef pinfo.pdata_indx in
-        user_err ?loc (str "Field " ++ Id.print name ++ str " is defined \
-          several times")
-    else
-      user_err ?loc (str "Field " ++ (*KerName.print knp ++*) str " does not \
-        pertain to record definition " ++ pr_typref pinfo.pdata_type)
-  in
-  let () = List.iter iter fs in
-  let () = match Array.findi (fun _ o -> Option.is_empty o) args with
-  | None -> ()
-  | Some i ->
-    let (field, _, _) = List.nth typdef i in
-    user_err ?loc (str "Field " ++ Id.print field ++ str " is undefined")
-  in
-  let args = Array.map_to_list Option.get args in
-  let tparam = List.init params (fun i -> GTypVar subst.(i)) in
-  (GTacCst (Other kn, 0, args), GTypRef (Other kn, tparam))
-
-let normalize env (count, vars) (t : UF.elt glb_typexpr) =
-  let get_var id =
-    try UF.Map.find id !vars
-    with Not_found ->
-      let () = assert env.env_opn in
-      let n = GTypVar !count in
-      let () = incr count in
-      let () = vars := UF.Map.add id n !vars in
-      n
-  in
-  let rec subst id = match UF.find id env.env_cst with
-  | id, None -> get_var id
-  | _, Some t -> subst_type subst t
-  in
-  subst_type subst t
-
-let intern ~strict e =
-  let env = empty_env () in
-  let env = if strict then env else { env with env_str = false } in
-  let (e, t) = intern_rec env e in
-  let count = ref 0 in
-  let vars = ref UF.Map.empty in
-  let t = normalize env (count, vars) t in
-  (e, (!count, t))
-
-let intern_typedef self (ids, t) : glb_quant_typedef =
-  let env = { (empty_env ()) with env_rec = self } in
-  (* Initialize type parameters *)
-  let map id = get_alias id env in
-  let ids = List.map map ids in
-  let count = ref (List.length ids) in
-  let vars = ref UF.Map.empty in
-  let iter n id = vars := UF.Map.add id (GTypVar n) !vars in
-  let () = List.iteri iter ids in
-  (* Do not accept unbound type variables *)
-  let env = { env with env_opn = false } in
-  let intern t =
-    let t = intern_type env t in
-    normalize env (count, vars) t
-  in
-  let count = !count in
-  match t with
-  | CTydDef None -> (count, GTydDef None)
-  | CTydDef (Some t) -> (count, GTydDef (Some (intern t)))
-  | CTydAlg constrs ->
-    let map (c, t) = (c, List.map intern t) in
-    let constrs = List.map map constrs in
-    let getn (const, nonconst) (c, args) = match args with
-    | [] -> (succ const, nonconst)
-    | _ :: _ -> (const, succ nonconst)
-    in
-    let nconst, nnonconst = List.fold_left getn (0, 0) constrs in
-    let galg = {
-      galg_constructors = constrs;
-      galg_nconst = nconst;
-      galg_nnonconst = nnonconst;
-    } in
-    (count, GTydAlg galg)
-  | CTydRec fields ->
-    let map (c, mut, t) = (c, mut, intern t) in
-    let fields = List.map map fields in
-    (count, GTydRec fields)
-  | CTydOpn -> (count, GTydOpn)
-
-let intern_open_type t =
-  let env = empty_env () in
-  let t = intern_type env t in
-  let count = ref 0 in
-  let vars = ref UF.Map.empty in
-  let t = normalize env (count, vars) t in
-  (!count, t)
-
-(** Subtyping *)
-
-let check_subtype t1 t2 =
-  let env = empty_env () in
-  let t1 = fresh_type_scheme env t1 in
-  (* We build a substitution mimicking rigid variable by using dummy tuples *)
-  let rigid i = GTypRef (Tuple (i + 1), []) in
-  let (n, t2) = t2 in
-  let subst = Array.init n rigid in
-  let substf i = subst.(i) in
-  let t2 = subst_type substf t2 in
-  try unify0 env t1 t2; true with CannotUnify _ -> false
-
-(** Globalization *)
-
-let get_projection0 var = match var with
-| RelId qid ->
-  let kn = try Tac2env.locate_projection qid with Not_found ->
-    user_err ?loc:qid.CAst.loc (pr_qualid qid ++ str " is not a projection")
-  in
-  kn
-| AbsKn kn -> kn
-
-let rec globalize ids ({loc;v=er} as e) = match er with
-| CTacAtm _ -> e
-| CTacRef ref ->
-  let mem id = Id.Set.mem id ids in
-  begin match get_variable0 mem ref with
-  | ArgVar _ -> e
-  | ArgArg kn -> CAst.make ?loc @@ CTacRef (AbsKn kn)
-  end
-| CTacCst qid ->
-  let knc = get_constructor () qid in
-  CAst.make ?loc @@ CTacCst (AbsKn knc)
-| CTacFun (bnd, e) ->
-  let fold (pats, accu) pat =
-    let accu = ids_of_pattern accu pat in
-    let pat = globalize_pattern ids pat in
-    (pat :: pats, accu)
-  in
-  let bnd, ids = List.fold_left fold ([], ids) bnd in
-  let bnd = List.rev bnd in
-  let e = globalize ids e in
-  CAst.make ?loc @@ CTacFun (bnd, e)
-| CTacApp (e, el) ->
-  let e = globalize ids e in
-  let el = List.map (fun e -> globalize ids e) el in
-  CAst.make ?loc @@ CTacApp (e, el)
-| CTacLet (isrec, bnd, e) ->
-  let fold accu (pat, _) = ids_of_pattern accu pat in
-  let ext = List.fold_left fold Id.Set.empty bnd in
-  let eids = Id.Set.union ext ids in
-  let e = globalize eids e in
-  let map (qid, e) =
-    let ids = if isrec then eids else ids in
-    let qid = globalize_pattern ids qid in
-    (qid, globalize ids e)
-  in
-  let bnd = List.map map bnd in
-  CAst.make ?loc @@ CTacLet (isrec, bnd, e)
-| CTacCnv (e, t) ->
-  let e = globalize ids e in
-  CAst.make ?loc @@ CTacCnv (e, t)
-| CTacSeq (e1, e2) ->
-  let e1 = globalize ids e1 in
-  let e2 = globalize ids e2 in
-  CAst.make ?loc @@ CTacSeq (e1, e2)
-| CTacCse (e, bl) ->
-  let e = globalize ids e in
-  let bl = List.map (fun b -> globalize_case ids b) bl in
-  CAst.make ?loc @@ CTacCse (e, bl)
-| CTacRec r ->
-  let map (p, e) =
-    let p = get_projection0 p in
-    let e = globalize ids e in
-    (AbsKn p, e)
-  in
-  CAst.make ?loc @@ CTacRec (List.map map r)
-| CTacPrj (e, p) ->
-  let e = globalize ids e in
-  let p = get_projection0 p in
-  CAst.make ?loc @@ CTacPrj (e, AbsKn p)
-| CTacSet (e, p, e') ->
-  let e = globalize ids e in
-  let p = get_projection0 p in
-  let e' = globalize ids e' in
-  CAst.make ?loc @@ CTacSet (e, AbsKn p, e')
-| CTacExt (tag, arg) ->
-  let arg = str (Tac2dyn.Arg.repr tag) in
-  CErrors.user_err ?loc (str "Cannot globalize generic arguments of type" ++ spc () ++ arg)
-
-and globalize_case ids (p, e) =
-  (globalize_pattern ids p, globalize ids e)
-
-and globalize_pattern ids ({loc;v=pr} as p) = match pr with
-| CPatVar _ -> p
-| CPatRef (cst, pl) ->
-  let knc = get_constructor () cst in
-  let cst = AbsKn knc in
-  let pl = List.map (fun p -> globalize_pattern ids p) pl in
-  CAst.make ?loc @@ CPatRef (cst, pl)
-| CPatCnv (pat, ty) ->
-  let pat = globalize_pattern ids pat in
-  CAst.make ?loc @@ CPatCnv (pat, ty)
-
-(** Kernel substitution *)
-
-open Mod_subst
-
-let subst_or_tuple f subst o = match o with
-| Tuple _ -> o
-| Other v ->
-  let v' = f subst v in
-  if v' == v then o else Other v'
-
-let rec subst_type subst t = match t with
-| GTypVar _ -> t
-| GTypArrow (t1, t2) ->
-  let t1' = subst_type subst t1 in
-  let t2' = subst_type subst t2 in
-  if t1' == t1 && t2' == t2 then t
-  else GTypArrow (t1', t2')
-| GTypRef (kn, tl) ->
-  let kn' = subst_or_tuple subst_kn subst kn in
-  let tl' = List.Smart.map (fun t -> subst_type subst t) tl in
-  if kn' == kn && tl' == tl then t else GTypRef (kn', tl')
-
-let rec subst_expr subst e = match e with
-| GTacAtm _ | GTacVar _ | GTacPrm _ -> e
-| GTacRef kn -> GTacRef (subst_kn subst kn)
-| GTacFun (ids, e) -> GTacFun (ids, subst_expr subst e)
-| GTacApp (f, args) ->
-  GTacApp (subst_expr subst f, List.map (fun e -> subst_expr subst e) args)
-| GTacLet (r, bs, e) ->
-  let bs = List.map (fun (na, e) -> (na, subst_expr subst e)) bs in
-  GTacLet (r, bs, subst_expr subst e)
-| GTacCst (t, n, el) as e0 ->
-  let t' = subst_or_tuple subst_kn subst t in
-  let el' = List.Smart.map (fun e -> subst_expr subst e) el in
-  if t' == t && el' == el then e0 else GTacCst (t', n, el')
-| GTacCse (e, ci, cse0, cse1) ->
-  let cse0' = Array.map (fun e -> subst_expr subst e) cse0 in
-  let cse1' = Array.map (fun (ids, e) -> (ids, subst_expr subst e)) cse1 in
-  let ci' = subst_or_tuple subst_kn subst ci in
-  GTacCse (subst_expr subst e, ci', cse0', cse1')
-| GTacWth { opn_match = e; opn_branch = br; opn_default = (na, def) } as e0 ->
-  let e' = subst_expr subst e in
-  let def' = subst_expr subst def in
-  let fold kn (self, vars, p) accu =
-    let kn' = subst_kn subst kn in
-    let p' = subst_expr subst p in
-    if kn' == kn && p' == p then accu
-    else KNmap.add kn' (self, vars, p') (KNmap.remove kn accu)
-  in
-  let br' = KNmap.fold fold br br in
-  if e' == e && br' == br && def' == def then e0
-  else GTacWth { opn_match = e'; opn_default = (na, def'); opn_branch = br' }
-| GTacPrj (kn, e, p) as e0 ->
-  let kn' = subst_kn subst kn in
-  let e' = subst_expr subst e in
-  if kn' == kn && e' == e then e0 else GTacPrj (kn', e', p)
-| GTacSet (kn, e, p, r) as e0 ->
-  let kn' = subst_kn subst kn in
-  let e' = subst_expr subst e in
-  let r' = subst_expr subst r in
-  if kn' == kn && e' == e && r' == r then e0 else GTacSet (kn', e', p, r')
-| GTacExt (tag, arg) ->
-  let tpe = interp_ml_object tag in
-  let arg' = tpe.ml_subst subst arg in
-  if arg' == arg then e else GTacExt (tag, arg')
-| GTacOpn (kn, el) as e0 ->
-  let kn' = subst_kn subst kn in
-  let el' = List.Smart.map (fun e -> subst_expr subst e) el in
-  if kn' == kn && el' == el then e0 else GTacOpn (kn', el')
-
-let subst_typedef subst e = match e with
-| GTydDef t ->
-  let t' = Option.Smart.map (fun t -> subst_type subst t) t in
-  if t' == t then e else GTydDef t'
-| GTydAlg galg ->
-  let map (c, tl as p) =
-    let tl' = List.Smart.map (fun t -> subst_type subst t) tl in
-    if tl' == tl then p else (c, tl')
-  in
-  let constrs' = List.Smart.map map galg.galg_constructors in
-  if constrs' == galg.galg_constructors then e
-  else GTydAlg { galg with galg_constructors = constrs' }
-| GTydRec fields ->
-  let map (c, mut, t as p) =
-    let t' = subst_type subst t in
-    if t' == t then p else (c, mut, t')
-  in
-  let fields' = List.Smart.map map fields in
-  if fields' == fields then e else GTydRec fields'
-| GTydOpn -> GTydOpn
-
-let subst_quant_typedef subst (prm, def as qdef) =
-  let def' = subst_typedef subst def in
-  if def' == def then qdef else (prm, def')
-
-let subst_type_scheme subst (prm, t as sch) =
-  let t' = subst_type subst t in
-  if t' == t then sch else (prm, t')
-
-let subst_or_relid subst ref = match ref with
-| RelId _ -> ref
-| AbsKn kn ->
-  let kn' = subst_or_tuple subst_kn subst kn in
-  if kn' == kn then ref else AbsKn kn'
-
-let rec subst_rawtype subst ({loc;v=tr} as t) = match tr with
-| CTypVar _ -> t
-| CTypArrow (t1, t2) ->
-  let t1' = subst_rawtype subst t1 in
-  let t2' = subst_rawtype subst t2 in
-  if t1' == t1 && t2' == t2 then t else CAst.make ?loc @@ CTypArrow (t1', t2')
-| CTypRef (ref, tl) ->
-  let ref' = subst_or_relid subst ref in
-  let tl' = List.Smart.map (fun t -> subst_rawtype subst t) tl in
-  if ref' == ref && tl' == tl then t else CAst.make ?loc @@ CTypRef (ref', tl')
-
-let subst_tacref subst ref = match ref with
-| RelId _ -> ref
-| AbsKn (TacConstant kn) ->
-  let kn' = subst_kn subst kn in
-  if kn' == kn then ref else AbsKn (TacConstant kn')
-| AbsKn (TacAlias kn) ->
-  let kn' = subst_kn subst kn in
-  if kn' == kn then ref else AbsKn (TacAlias kn')
-
-let subst_projection subst prj = match prj with
-| RelId _ -> prj
-| AbsKn kn ->
-  let kn' = subst_kn subst kn in
-  if kn' == kn then prj else AbsKn kn'
-
-let rec subst_rawpattern subst ({loc;v=pr} as p) = match pr with
-| CPatVar _ -> p
-| CPatRef (c, pl) ->
-  let pl' = List.Smart.map (fun p -> subst_rawpattern subst p) pl in
-  let c' = subst_or_relid subst c in
-  if pl' == pl && c' == c then p else CAst.make ?loc @@ CPatRef (c', pl')
-| CPatCnv (pat, ty) ->
-  let pat' = subst_rawpattern subst pat in
-  let ty' = subst_rawtype subst ty in
-  if pat' == pat && ty' == ty then p else CAst.make ?loc @@ CPatCnv (pat', ty')
-
-(** Used for notations *)
-let rec subst_rawexpr subst ({loc;v=tr} as t) = match tr with
-| CTacAtm _ -> t
-| CTacRef ref ->
-  let ref' = subst_tacref subst ref in
-  if ref' == ref then t else CAst.make ?loc @@ CTacRef ref'
-| CTacCst ref ->
-  let ref' = subst_or_relid subst ref in
-  if ref' == ref then t else CAst.make ?loc @@ CTacCst ref'
-| CTacFun (bnd, e) ->
-  let map pat = subst_rawpattern subst pat in
-  let bnd' = List.Smart.map map bnd in
-  let e' = subst_rawexpr subst e in
-  if bnd' == bnd && e' == e then t else CAst.make ?loc @@ CTacFun (bnd', e')
-| CTacApp (e, el) ->
-  let e' = subst_rawexpr subst e in
-  let el' = List.Smart.map (fun e -> subst_rawexpr subst e) el in
-  if e' == e && el' == el then t else CAst.make ?loc @@ CTacApp (e', el')
-| CTacLet (isrec, bnd, e) ->
-  let map (na, e as p) =
-    let na' = subst_rawpattern subst na in
-    let e' = subst_rawexpr subst e in
-    if na' == na && e' == e then p else (na', e')
-  in
-  let bnd' = List.Smart.map map bnd in
-  let e' = subst_rawexpr subst e in
-  if bnd' == bnd && e' == e then t else CAst.make ?loc @@ CTacLet (isrec, bnd', e')
-| CTacCnv (e, c) ->
-  let e' = subst_rawexpr subst e in
-  let c' = subst_rawtype subst c in
-  if c' == c && e' == e then t else CAst.make ?loc @@ CTacCnv (e', c')
-| CTacSeq (e1, e2) ->
-  let e1' = subst_rawexpr subst e1 in
-  let e2' = subst_rawexpr subst e2 in
-  if e1' == e1 && e2' == e2 then t else CAst.make ?loc @@ CTacSeq (e1', e2')
-| CTacCse (e, bl) ->
-  let map (p, e as x) =
-    let p' = subst_rawpattern subst p in
-    let e' = subst_rawexpr subst e in
-    if p' == p && e' == e then x else (p', e')
-  in
-  let e' = subst_rawexpr subst e in
-  let bl' = List.Smart.map map bl in
-  if e' == e && bl' == bl then t else CAst.make ?loc @@ CTacCse (e', bl')
-| CTacRec el ->
-  let map (prj, e as p) =
-    let prj' = subst_projection subst prj in
-    let e' = subst_rawexpr subst e in
-    if prj' == prj && e' == e then p else (prj', e')
-  in
-  let el' = List.Smart.map map el in
-  if el' == el then t else CAst.make ?loc @@ CTacRec el'
-| CTacPrj (e, prj) ->
-    let prj' = subst_projection subst prj in
-    let e' = subst_rawexpr subst e in
-    if prj' == prj && e' == e then t else CAst.make ?loc @@ CTacPrj (e', prj')
-| CTacSet (e, prj, r) ->
-    let prj' = subst_projection subst prj in
-    let e' = subst_rawexpr subst e in
-    let r' = subst_rawexpr subst r in
-    if prj' == prj && e' == e && r' == r then t else CAst.make ?loc @@ CTacSet (e', prj', r')
-| CTacExt _ -> assert false (** Should not be generated by globalization *)
-
-(** Registering *)
-
-let () =
-  let open Genintern in
-  let intern ist tac =
-    let env = match Genintern.Store.get ist.extra ltac2_env with
-    | None ->
-      (* Only happens when Ltac2 is called from a constr or ltac1 quotation *)
-      let env = empty_env () in
-      if !Ltac_plugin.Tacintern.strict_check then env
-      else { env with env_str = false }
-    | Some env -> env
-    in
-    let loc = tac.loc in
-    let (tac, t) = intern_rec env tac in
-    let () = check_elt_unit loc env t in
-    (ist, tac)
-  in
-  Genintern.register_intern0 wit_ltac2 intern
-let () = Genintern.register_subst0 wit_ltac2 subst_expr
-
-let () =
-  let open Genintern in
-  let intern ist (loc, id) =
-    let env = match Genintern.Store.get ist.extra ltac2_env with
-    | None ->
-      (* Only happens when Ltac2 is called from a constr or ltac1 quotation *)
-      let env = empty_env () in
-      if !Ltac_plugin.Tacintern.strict_check then env
-      else { env with env_str = false }
-    | Some env -> env
-    in
-    let t =
-      try Id.Map.find id env.env_var
-      with Not_found ->
-        CErrors.user_err ?loc (str "Unbound value " ++ Id.print id)
-    in
-    let t = fresh_mix_type_scheme env t in
-    let () = unify ?loc env t (GTypRef (Other t_constr, [])) in
-    (ist, id)
-  in
-  Genintern.register_intern0 wit_ltac2_quotation intern
-
-let () = Genintern.register_subst0 wit_ltac2_quotation (fun _ id -> id)
diff --git a/src/tac2intern.mli b/src/tac2intern.mli
deleted file mode 100644
index d646b5cda5..0000000000
--- a/src/tac2intern.mli
+++ /dev/null
@@ -1,46 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Mod_subst
-open Tac2expr
-
-val intern : strict:bool -> raw_tacexpr -> glb_tacexpr * type_scheme
-val intern_typedef : (KerName.t * int) Id.Map.t -> raw_quant_typedef -> glb_quant_typedef
-val intern_open_type : raw_typexpr -> type_scheme
-
-(** Check that a term is a value. Only values are safe to marshall between
-    processes. *)
-val is_value : glb_tacexpr -> bool
-val check_unit : ?loc:Loc.t -> type_scheme -> unit
-
-val check_subtype : type_scheme -> type_scheme -> bool
-(** [check_subtype t1 t2] returns [true] iff all values of intances of type [t1]
-    also have type [t2]. *)
-
-val subst_type : substitution -> 'a glb_typexpr -> 'a glb_typexpr
-val subst_expr : substitution -> glb_tacexpr -> glb_tacexpr
-val subst_quant_typedef : substitution -> glb_quant_typedef -> glb_quant_typedef
-val subst_type_scheme : substitution -> type_scheme -> type_scheme
-
-val subst_rawexpr : substitution -> raw_tacexpr -> raw_tacexpr
-
-(** {5 Notations} *)
-
-val globalize : Id.Set.t -> raw_tacexpr -> raw_tacexpr
-(** Replaces all qualified identifiers by their corresponding kernel name. The
-    set represents bound variables in the context. *)
-
-(** Errors *)
-
-val error_nargs_mismatch : ?loc:Loc.t -> ltac_constructor -> int -> int -> 'a
-val error_nparams_mismatch : ?loc:Loc.t -> int -> int -> 'a
-
-(** Misc *)
-
-val drop_ltac2_env : Genintern.Store.t -> Genintern.Store.t
diff --git a/src/tac2interp.ml b/src/tac2interp.ml
deleted file mode 100644
index b0f8083aeb..0000000000
--- a/src/tac2interp.ml
+++ /dev/null
@@ -1,227 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Util
-open Pp
-open CErrors
-open Names
-open Proofview.Notations
-open Tac2expr
-open Tac2ffi
-
-exception LtacError = Tac2ffi.LtacError
-
-let backtrace : backtrace Evd.Store.field = Evd.Store.field ()
-
-let print_ltac2_backtrace = ref false
-
-let get_backtrace =
-  Proofview.tclEVARMAP >>= fun sigma ->
-  match Evd.Store.get (Evd.get_extra_data sigma) backtrace with
-  | None -> Proofview.tclUNIT []
-  | Some bt -> Proofview.tclUNIT bt
-
-let set_backtrace bt =
-  Proofview.tclEVARMAP >>= fun sigma ->
-  let store = Evd.get_extra_data sigma in
-  let store = Evd.Store.set store backtrace bt in
-  let sigma = Evd.set_extra_data store sigma in
-  Proofview.Unsafe.tclEVARS sigma
-
-let with_frame frame tac =
-  if !print_ltac2_backtrace then
-    get_backtrace >>= fun bt ->
-    set_backtrace (frame :: bt) >>= fun () ->
-    tac >>= fun ans ->
-    set_backtrace bt >>= fun () ->
-    Proofview.tclUNIT ans
-  else tac
-
-type environment = Tac2env.environment = {
-  env_ist : valexpr Id.Map.t;
-}
-
-let empty_environment = {
-  env_ist = Id.Map.empty;
-}
-
-type closure = {
-  mutable clos_env : valexpr Id.Map.t;
-  (** Mutable so that we can implement recursive functions imperatively *)
-  clos_var : Name.t list;
-  (** Bound variables *)
-  clos_exp : glb_tacexpr;
-  (** Body *)
-  clos_ref : ltac_constant option;
-  (** Global constant from which the closure originates *)
-}
-
-let push_name ist id v = match id with
-| Anonymous -> ist
-| Name id -> { env_ist = Id.Map.add id v ist.env_ist }
-
-let get_var ist id =
-  try Id.Map.find id ist.env_ist with Not_found ->
-    anomaly (str "Unbound variable " ++ Id.print id)
-
-let get_ref ist kn =
-  try
-    let data = Tac2env.interp_global kn in
-    data.Tac2env.gdata_expr
-  with Not_found ->
-    anomaly (str "Unbound reference" ++ KerName.print kn)
-
-let return = Proofview.tclUNIT
-
-let rec interp (ist : environment) = function
-| GTacAtm (AtmInt n) -> return (Tac2ffi.of_int n)
-| GTacAtm (AtmStr s) -> return (Tac2ffi.of_string (Bytes.of_string s))
-| GTacVar id -> return (get_var ist id)
-| GTacRef kn ->
-  let data = get_ref ist kn in
-  return (eval_pure (Some kn) data)
-| GTacFun (ids, e) ->
-  let cls = { clos_ref = None; clos_env = ist.env_ist; clos_var = ids; clos_exp = e } in
-  let f = interp_app cls in
-  return (Tac2ffi.of_closure f)
-| GTacApp (f, args) ->
-  interp ist f >>= fun f ->
-  Proofview.Monad.List.map (fun e -> interp ist e) args >>= fun args ->
-  Tac2ffi.apply (Tac2ffi.to_closure f) args
-| GTacLet (false, el, e) ->
-  let fold accu (na, e) =
-    interp ist e >>= fun e ->
-    return (push_name accu na e)
-  in
-  Proofview.Monad.List.fold_left fold ist el >>= fun ist ->
-  interp ist e
-| GTacLet (true, el, e) ->
-  let map (na, e) = match e with
-  | GTacFun (ids, e) ->
-    let cls = { clos_ref = None; clos_env = ist.env_ist; clos_var = ids; clos_exp = e } in
-    let f = Tac2ffi.of_closure (interp_app cls) in
-    na, cls, f
-  | _ -> anomaly (str "Ill-formed recursive function")
-  in
-  let fixs = List.map map el in
-  let fold accu (na, _, cls) = match na with
-  | Anonymous -> accu
-  | Name id -> { env_ist = Id.Map.add id cls accu.env_ist }
-  in
-  let ist = List.fold_left fold ist fixs in
-  (* Hack to make a cycle imperatively in the environment *)
-  let iter (_, e, _) = e.clos_env <- ist.env_ist in
-  let () = List.iter iter fixs in
-  interp ist e
-| GTacCst (_, n, []) -> return (Valexpr.make_int n)
-| GTacCst (_, n, el) ->
-  Proofview.Monad.List.map (fun e -> interp ist e) el >>= fun el ->
-  return (Valexpr.make_block n (Array.of_list el))
-| GTacCse (e, _, cse0, cse1) ->
-  interp ist e >>= fun e -> interp_case ist e cse0 cse1
-| GTacWth { opn_match = e; opn_branch = cse; opn_default = def } ->
-  interp ist e >>= fun e -> interp_with ist e cse def
-| GTacPrj (_, e, p) ->
-  interp ist e >>= fun e -> interp_proj ist e p
-| GTacSet (_, e, p, r) ->
-  interp ist e >>= fun e ->
-  interp ist r >>= fun r ->
-  interp_set ist e p r
-| GTacOpn (kn, el) ->
-  Proofview.Monad.List.map (fun e -> interp ist e) el >>= fun el ->
-  return (Tac2ffi.of_open (kn, Array.of_list el))
-| GTacPrm (ml, el) ->
-  Proofview.Monad.List.map (fun e -> interp ist e) el >>= fun el ->
-  with_frame (FrPrim ml) (Tac2ffi.apply (Tac2env.interp_primitive ml) el)
-| GTacExt (tag, e) ->
-  let tpe = Tac2env.interp_ml_object tag in
-  with_frame (FrExtn (tag, e)) (tpe.Tac2env.ml_interp ist e)
-
-and interp_app f =
-  let ans = fun args ->
-    let { clos_env = ist; clos_var = ids; clos_exp = e; clos_ref = kn } = f in
-    let frame = match kn with
-    | None -> FrAnon e
-    | Some kn -> FrLtac kn
-    in
-    let ist = { env_ist = ist } in
-    let ist = List.fold_left2 push_name ist ids args in
-    with_frame frame (interp ist e)
-  in
-  Tac2ffi.abstract (List.length f.clos_var) ans
-
-and interp_case ist e cse0 cse1 =
-  if Valexpr.is_int e then
-    interp ist cse0.(Tac2ffi.to_int e)
-  else
-    let (n, args) = Tac2ffi.to_block e in
-    let (ids, e) = cse1.(n) in
-    let ist = CArray.fold_left2 push_name ist ids args in
-    interp ist e
-
-and interp_with ist e cse def = 
-  let (kn, args) = Tac2ffi.to_open e in
-  let br = try Some (KNmap.find kn cse) with Not_found -> None in
-  begin match br with
-  | None ->
-    let (self, def) = def in
-    let ist = push_name ist self e in
-    interp ist def
-  | Some (self, ids, p) ->
-    let ist = push_name ist self e in
-    let ist = CArray.fold_left2 push_name ist ids args in
-    interp ist p
-  end
-
-and interp_proj ist e p =
-  return (Valexpr.field e p)
-
-and interp_set ist e p r =
-  let () = Valexpr.set_field e p r in
-  return (Valexpr.make_int 0)
-
-and eval_pure kn = function
-| GTacAtm (AtmInt n) -> Valexpr.make_int n
-| GTacRef kn ->
-  let { Tac2env.gdata_expr = e } =
-    try Tac2env.interp_global kn
-    with Not_found -> assert false
-  in
-  eval_pure (Some kn) e
-| GTacFun (na, e) ->
-  let cls = { clos_ref = kn; clos_env = Id.Map.empty; clos_var = na; clos_exp = e } in
-  let f = interp_app cls in
-  Tac2ffi.of_closure f
-| GTacCst (_, n, []) -> Valexpr.make_int n
-| GTacCst (_, n, el) -> Valexpr.make_block n (Array.map_of_list eval_unnamed el)
-| GTacOpn (kn, el) -> Tac2ffi.of_open (kn, Array.map_of_list eval_unnamed el)
-| GTacAtm (AtmStr _) | GTacLet _ | GTacVar _ | GTacSet _
-| GTacApp _ | GTacCse _ | GTacPrj _ | GTacPrm _ | GTacExt _ | GTacWth _ ->
-  anomaly (Pp.str "Term is not a syntactical value")
-
-and eval_unnamed e = eval_pure None e
-
-
-(** Cross-boundary hacks. *)
-
-open Geninterp
-
-let val_env : environment Val.typ = Val.create "ltac2:env"
-let env_ref = Id.of_string_soft "@@ltac2_env@@"
-
-let extract_env (Val.Dyn (tag, v)) : environment =
-match Val.eq tag val_env with
-| None -> assert false
-| Some Refl -> v
-
-let get_env ist =
-  try extract_env (Id.Map.find env_ref ist)
-  with Not_found -> empty_environment
-
-let set_env env ist =
-  Id.Map.add env_ref (Val.Dyn (val_env, env)) ist
diff --git a/src/tac2interp.mli b/src/tac2interp.mli
deleted file mode 100644
index 21fdcd03af..0000000000
--- a/src/tac2interp.mli
+++ /dev/null
@@ -1,37 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Tac2expr
-open Tac2ffi
-
-type environment = Tac2env.environment
-
-val empty_environment : environment
-
-val interp : environment -> glb_tacexpr -> valexpr Proofview.tactic
-
-(* val interp_app : closure -> ml_tactic *)
-
-(** {5 Cross-boundary encodings} *)
-
-val get_env : Ltac_pretype.unbound_ltac_var_map -> environment
-val set_env : environment -> Ltac_pretype.unbound_ltac_var_map -> Ltac_pretype.unbound_ltac_var_map
-
-(** {5 Exceptions} *)
-
-exception LtacError of KerName.t * valexpr array
-(** Ltac2-defined exceptions seen from OCaml side *)
-
-(** {5 Backtrace} *)
-
-val get_backtrace : backtrace Proofview.tactic
-
-val with_frame : frame -> 'a Proofview.tactic -> 'a Proofview.tactic
-
-val print_ltac2_backtrace : bool ref
diff --git a/src/tac2match.ml b/src/tac2match.ml
deleted file mode 100644
index c9e549d47e..0000000000
--- a/src/tac2match.ml
+++ /dev/null
@@ -1,232 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Context.Named.Declaration
-
-module NamedDecl = Context.Named.Declaration
-
-type context = EConstr.t
-
-type result = {
-  subst : Ltac_pretype.patvar_map ;
-}
-
-type match_pattern =
-| MatchPattern of Pattern.constr_pattern
-| MatchContext of Pattern.constr_pattern
-
-(** TODO: handle definitions *)
-type match_context_hyps = match_pattern
-
-type match_rule = match_context_hyps list * match_pattern
-
-(** {6 Utilities} *)
-
-(** Tests whether the substitution [s] is empty. *)
-let is_empty_subst = Id.Map.is_empty
-
-(** {6 Non-linear patterns} *)
-
-
-(** The patterns of Ltac are not necessarily linear. Non-linear
-    pattern are partially handled by the {!Matching} module, however
-    goal patterns are not primitive to {!Matching}, hence we must deal
-    with non-linearity between hypotheses and conclusion. Subterms are
-    considered equal up to the equality implemented in
-    [equal_instances]. *)
-(* spiwack: it doesn't seem to be quite the same rule for non-linear
-   term patterns and non-linearity between hypotheses and/or
-   conclusion. Indeed, in [Matching], matching is made modulo
-   syntactic equality, and here we merge modulo conversion. It may be
-   a good idea to have an entry point of [Matching] with a partial
-   substitution as argument instead of merging substitution here. That
-   would ensure consistency. *)
-let equal_instances env sigma c1 c2 =
-  (* How to compare instances? Do we want the terms to be convertible?
-     unifiable? Do we want the universe levels to be relevant? 
-     (historically, conv_x is used) *)
-  Reductionops.is_conv env sigma c1 c2
-
-(** Merges two substitutions. Raises [Not_coherent_metas] when
-    encountering two instances of the same metavariable which are not
-    equal according to {!equal_instances}. *)
-exception Not_coherent_metas
-let verify_metas_coherence env sigma s1 s2 =
-  let merge id oc1 oc2 = match oc1, oc2 with
-    | None, None -> None
-    | None, Some c | Some c, None -> Some c
-    | Some c1, Some c2 ->
-        if equal_instances env sigma c1 c2 then Some c1
-        else raise Not_coherent_metas
-  in
-  Id.Map.merge merge s1 s2
-
-let matching_error =
-  CErrors.UserError (Some "tactic matching" , Pp.str "No matching clauses for match.")
-
-let imatching_error = (matching_error, Exninfo.null)
-
-(** A functor is introduced to share the environment and the
-    evar_map. They do not change and it would be a pity to introduce
-    closures everywhere just for the occasional calls to
-    {!equal_instances}. *)
-module type StaticEnvironment = sig
-  val env : Environ.env
-  val sigma : Evd.evar_map
-end
-module PatternMatching (E:StaticEnvironment) = struct
-
-
-  (** {6 The pattern-matching monad } *)
-
-
-  (** To focus on the algorithmic portion of pattern-matching, the
-      bookkeeping is relegated to a monad: the composition of the
-      bactracking monad of {!IStream.t} with a "writer" effect. *)
-  (* spiwack: as we don't benefit from the various stream optimisations
-     of Haskell, it may be costly to give the monad in direct style such as
-     here. We may want to use some continuation passing style. *)
-  type 'a tac = 'a Proofview.tactic
-  type 'a m = { stream : 'r. ('a -> result -> 'r tac) -> result -> 'r tac }
-
-  (** The empty substitution. *)
-  let empty_subst = Id.Map.empty
-
-  (** Composes two substitutions using {!verify_metas_coherence}. It
-      must be a monoid with neutral element {!empty_subst}. Raises
-      [Not_coherent_metas] when composition cannot be achieved. *)
-  let subst_prod s1 s2 =
-    if is_empty_subst s1 then s2
-    else if is_empty_subst s2 then s1
-    else verify_metas_coherence E.env E.sigma s1 s2
-
-  (** Merge two writers (and ignore the first value component). *)
-  let merge m1 m2 =
-    try Some {
-      subst = subst_prod m1.subst m2.subst;
-    }
-    with Not_coherent_metas -> None
-
-  (** Monadic [return]: returns a single success with empty substitutions. *)
-  let return (type a) (lhs:a) : a m =
-    { stream = fun k ctx -> k lhs ctx }
-
-  (** Monadic bind: each success of [x] is replaced by the successes
-      of [f x]. The substitutions of [x] and [f x] are composed,
-      dropping the apparent successes when the substitutions are not
-      coherent. *)
-  let (>>=) (type a) (type b) (m:a m) (f:a -> b m) : b m =
-    { stream = fun k ctx -> m.stream (fun x ctx -> (f x).stream k ctx) ctx }
-
-  (** A variant of [(>>=)] when the first argument returns [unit]. *)
-  let (<*>) (type a) (m:unit m) (y:a m) : a m =
-    { stream = fun k ctx -> m.stream (fun () ctx -> y.stream k ctx) ctx }
-
-  (** Failure of the pattern-matching monad: no success. *)
-  let fail (type a) : a m = { stream = fun _ _ -> Proofview.tclZERO matching_error }
-
-  let run (m : 'a m) =
-    let ctx = {
-      subst = empty_subst ;
-    } in
-    let eval x ctx = Proofview.tclUNIT (x, ctx) in
-    m.stream eval ctx
-
-  (** Chooses in a list, in the same order as the list *)
-  let rec pick (l:'a list) (e, info) : 'a m = match l with
-  | [] -> { stream = fun _ _ -> Proofview.tclZERO ~info e }
-  | x :: l ->
-    { stream = fun k ctx -> Proofview.tclOR (k x ctx) (fun e -> (pick l e).stream k ctx) }
-
-  let pick l = pick l imatching_error
-
-  let put_subst subst : unit m =
-    let s = { subst } in
-    { stream = fun k ctx -> match merge s ctx with None -> Proofview.tclZERO matching_error | Some s -> k () s }
-
-  (** {6 Pattern-matching} *)
-
-  let pattern_match_term pat term = 
-    match pat with
-    | MatchPattern p ->
-        begin 
-          try
-            put_subst (Constr_matching.matches E.env E.sigma p term) <*>
-            return None
-          with Constr_matching.PatternMatchingFailure -> fail
-        end
-    | MatchContext p ->
-
-      let rec map s (e, info) =
-        { stream = fun k ctx -> match IStream.peek s with
-          | IStream.Nil -> Proofview.tclZERO ~info e
-          | IStream.Cons ({ Constr_matching.m_sub = (_, subst); m_ctx }, s) ->
-            let nctx = { subst } in
-            match merge ctx nctx with
-            | None -> (map s (e, info)).stream k ctx
-            | Some nctx -> Proofview.tclOR (k (Some (Lazy.force m_ctx)) nctx) (fun e -> (map s e).stream k ctx)
-        }
-      in
-      map (Constr_matching.match_subterm E.env E.sigma (Id.Set.empty,p) term) imatching_error
-
-  let hyp_match_type pat hyps =
-    pick hyps >>= fun decl ->
-    let id = NamedDecl.get_id decl in
-    pattern_match_term pat (NamedDecl.get_type decl) >>= fun ctx ->
-    return (id, ctx)
-
-  let _hyp_match_body_and_type bodypat typepat hyps =
-    pick hyps >>= function
-      | LocalDef (id,body,hyp) ->
-          pattern_match_term bodypat body >>= fun ctx_body ->
-          pattern_match_term typepat hyp >>= fun ctx_typ ->
-          return (id, ctx_body, ctx_typ)
-      | LocalAssum (id,hyp) -> fail
-
-  let hyp_match pat hyps =
-    match pat with
-    | typepat ->
-        hyp_match_type typepat hyps
-(*     | Def ((_,hypname),bodypat,typepat) -> *)
-(*         hyp_match_body_and_type hypname bodypat typepat hyps *)
-
-  (** [hyp_pattern_list_match pats hyps lhs], matches the list of
-      patterns [pats] against the hypotheses in [hyps], and eventually
-      returns [lhs]. *)
-  let rec hyp_pattern_list_match pats hyps accu =
-    match pats with
-    | pat::pats ->
-        hyp_match pat hyps >>= fun (matched_hyp, hyp_ctx) ->
-        let select_matched_hyp decl = Id.equal (NamedDecl.get_id decl) matched_hyp in
-        let hyps = CList.remove_first select_matched_hyp hyps in
-        hyp_pattern_list_match pats hyps ((matched_hyp, hyp_ctx) :: accu)
-    | [] -> return accu
-
-  let rule_match_goal hyps concl = function
-    | (hyppats,conclpat) ->
-        (* the rules are applied from the topmost one (in the concrete
-           syntax) to the bottommost. *)
-        let hyppats = List.rev hyppats in
-        pattern_match_term conclpat concl >>= fun ctx_concl ->
-        hyp_pattern_list_match hyppats hyps [] >>= fun hyps ->
-        return (hyps, ctx_concl)
-
-end
-
-let match_goal env sigma concl ~rev rule =
-  let open Proofview.Notations in
-  let hyps = EConstr.named_context env in
-  let hyps = if rev then List.rev hyps else hyps in
-  let module E = struct
-    let env = env
-    let sigma = sigma
-  end in
-  let module M = PatternMatching(E) in
-  M.run (M.rule_match_goal hyps concl rule) >>= fun ((hyps, ctx_concl), subst) ->
-  Proofview.tclUNIT (hyps, ctx_concl, subst.subst)
diff --git a/src/tac2match.mli b/src/tac2match.mli
deleted file mode 100644
index c82c40d238..0000000000
--- a/src/tac2match.mli
+++ /dev/null
@@ -1,33 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open EConstr
-
-(** This file extends Matching with the main logic for Ltac2 match goal. *)
-
-type context = EConstr.t
-
-type match_pattern =
-| MatchPattern of Pattern.constr_pattern
-| MatchContext of Pattern.constr_pattern
-
-(** TODO: handle definitions *)
-type match_context_hyps = match_pattern
-
-type match_rule = match_context_hyps list * match_pattern
-
-val match_goal:
-  Environ.env ->
-  Evd.evar_map ->
-  constr ->
-  rev:bool ->
-  match_rule ->
-    ((Id.t * context option) list * (* List of hypotheses matching: name + context *)
-    context option * (* Context for conclusion *)
-    Ltac_pretype.patvar_map (* Pattern variable substitution *)) Proofview.tactic
diff --git a/src/tac2print.ml b/src/tac2print.ml
deleted file mode 100644
index f4cb290265..0000000000
--- a/src/tac2print.ml
+++ /dev/null
@@ -1,488 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Util
-open Pp
-open Names
-open Tac2expr
-open Tac2env
-open Tac2ffi
-
-(** Utils *)
-
-let change_kn_label kn id =
-  let mp = KerName.modpath kn in
-  KerName.make mp (Label.of_id id)
-
-let paren p = hov 2 (str "(" ++ p ++ str ")")
-
-let t_list =
-  KerName.make Tac2env.coq_prefix (Label.of_id (Id.of_string "list"))
-
-
-(** Type printing *)
-
-type typ_level =
-| T5_l
-| T5_r
-| T2
-| T1
-| T0
-
-let t_unit =
-  KerName.make Tac2env.coq_prefix (Label.of_id (Id.of_string "unit"))
-
-let pr_typref kn =
-  Libnames.pr_qualid (Tac2env.shortest_qualid_of_type kn)
-
-let pr_glbtype_gen pr lvl c =
-  let rec pr_glbtype lvl = function
-  | GTypVar n -> str "'" ++ str (pr n)
-  | GTypRef (Other kn, []) -> pr_typref kn
-  | GTypRef (Other kn, [t]) ->
-    let paren = match lvl with
-    | T5_r | T5_l | T2 | T1 -> fun x -> x
-    | T0 -> paren
-    in
-    paren (pr_glbtype T1 t ++ spc () ++ pr_typref kn)
-  | GTypRef (Other kn, tl) ->
-    let paren = match lvl with
-    | T5_r | T5_l | T2 | T1 -> fun x -> x
-    | T0 -> paren
-    in
-    paren (str "(" ++ prlist_with_sep (fun () -> str ", ") (pr_glbtype lvl) tl ++ str ")" ++ spc () ++ pr_typref kn)
-  | GTypArrow (t1, t2) ->
-    let paren = match lvl with
-    | T5_r -> fun x -> x
-    | T5_l | T2 | T1 | T0 -> paren
-    in
-    paren (pr_glbtype T5_l t1 ++ spc () ++ str "->" ++ spc () ++ pr_glbtype T5_r t2)
-  | GTypRef (Tuple 0, []) ->
-    Libnames.pr_qualid (Tac2env.shortest_qualid_of_type t_unit)
-  | GTypRef (Tuple _, tl) ->
-    let paren = match lvl with
-    | T5_r | T5_l -> fun x -> x
-    | T2 | T1 | T0 -> paren
-    in
-    paren (prlist_with_sep (fun () -> str " * ") (pr_glbtype T2) tl)
-  in
-  hov 0 (pr_glbtype lvl c)
-
-let pr_glbtype pr c = pr_glbtype_gen pr T5_r c
-
-let int_name () =
-  let vars = ref Int.Map.empty in
-  fun n ->
-    if Int.Map.mem n !vars then Int.Map.find n !vars
-    else
-      let num = Int.Map.cardinal !vars in
-      let base = num mod 26 in
-      let rem = num / 26 in
-      let name = String.make 1 (Char.chr (97 + base)) in
-      let suff = if Int.equal rem 0 then "" else string_of_int rem in
-      let name = name ^ suff in
-      let () = vars := Int.Map.add n name !vars in
-      name
-
-(** Term printing *)
-
-let pr_constructor kn =
-  Libnames.pr_qualid (Tac2env.shortest_qualid_of_constructor kn)
-
-let pr_projection kn =
-  Libnames.pr_qualid (Tac2env.shortest_qualid_of_projection kn)
-
-type exp_level = Tac2expr.exp_level =
-| E5
-| E4
-| E3
-| E2
-| E1
-| E0
-
-let pr_atom = function
-| AtmInt n -> Pp.int n
-| AtmStr s -> qstring s
-
-let pr_name = function
-| Name id -> Id.print id
-| Anonymous -> str "_"
-
-let find_constructor n empty def =
-  let rec find n = function
-  | [] -> assert false
-  | (id, []) as ans :: rem ->
-    if empty then
-      if Int.equal n 0 then ans
-      else find (pred n) rem
-    else find n rem
-  | (id, _ :: _) as ans :: rem ->
-    if not empty then
-      if Int.equal n 0 then ans
-      else find (pred n) rem
-    else find n rem
-  in
-  find n def
-
-let pr_internal_constructor tpe n is_const =
-  let data = match Tac2env.interp_type tpe with
-  | (_, GTydAlg data) -> data
-  | _ -> assert false
-  in
-  let (id, _) = find_constructor n is_const data.galg_constructors in
-  let kn = change_kn_label tpe id in
-  pr_constructor kn
-
-let order_branches cbr nbr def =
-  let rec order cidx nidx def = match def with
-  | [] -> []
-  | (id, []) :: rem ->
-    let ans = order (succ cidx) nidx rem in
-    (id, [], cbr.(cidx)) :: ans
-  | (id, _ :: _) :: rem ->
-    let ans = order cidx (succ nidx) rem in
-    let (vars, e) = nbr.(nidx) in
-    (id, Array.to_list vars, e) :: ans
-  in
-  order 0 0 def
-
-let pr_glbexpr_gen lvl c =
-  let rec pr_glbexpr lvl = function
-  | GTacAtm atm -> pr_atom atm
-  | GTacVar id -> Id.print id
-  | GTacRef gr ->
-    let qid = shortest_qualid_of_ltac (TacConstant gr) in
-    Libnames.pr_qualid qid
-  | GTacFun (nas, c) ->
-    let nas = pr_sequence pr_name nas in
-    let paren = match lvl with
-    | E0 | E1 | E2 | E3 | E4 -> paren
-    | E5 -> fun x -> x
-    in
-    paren (hov 0 (hov 2 (str "fun" ++ spc () ++ nas) ++ spc () ++ str "=>" ++ spc () ++
-      pr_glbexpr E5 c))
-  | GTacApp (c, cl) ->
-    let paren = match lvl with
-    | E0 -> paren
-    | E1 | E2 | E3 | E4 | E5 -> fun x -> x
-    in
-    paren (hov 2 (pr_glbexpr E1 c ++ spc () ++ (pr_sequence (pr_glbexpr E0) cl)))
-  | GTacLet (mut, bnd, e) ->
-    let paren = match lvl with
-    | E0 | E1 | E2 | E3 | E4 -> paren
-    | E5 -> fun x -> x
-    in
-    let mut = if mut then str "rec" ++ spc () else mt () in
-    let pr_bnd (na, e) =
-      pr_name na ++ spc () ++ str ":=" ++ spc () ++ hov 2 (pr_glbexpr E5 e) ++ spc ()
-    in
-    let bnd = prlist_with_sep (fun () -> str "with" ++ spc ()) pr_bnd bnd in
-    paren (hv 0 (hov 2 (str "let" ++ spc () ++ mut ++ bnd ++ str "in") ++ spc () ++ pr_glbexpr E5 e))
-  | GTacCst (Tuple 0, _, _) -> str "()"
-  | GTacCst (Tuple _, _, cl) ->
-    let paren = match lvl with
-    | E0 | E1 -> paren
-    | E2 | E3 | E4 | E5 -> fun x -> x
-    in
-    paren (prlist_with_sep (fun () -> str "," ++ spc ()) (pr_glbexpr E1) cl)
-  | GTacCst (Other tpe, n, cl) ->
-    pr_applied_constructor lvl tpe n cl
-  | GTacCse (e, info, cst_br, ncst_br) ->
-    let e = pr_glbexpr E5 e in
-    let br = match info with
-    | Other kn ->
-      let def = match Tac2env.interp_type kn with
-      | _, GTydAlg { galg_constructors = def } -> def
-      | _, GTydDef _ | _, GTydRec _ | _, GTydOpn -> assert false
-      in
-      let br = order_branches cst_br ncst_br def in
-      let pr_branch (cstr, vars, p) =
-        let cstr = change_kn_label kn cstr in
-        let cstr = pr_constructor cstr in
-        let vars = match vars with
-        | [] -> mt ()
-        | _ -> spc () ++ pr_sequence pr_name vars
-        in
-        hov 4 (str "|" ++ spc () ++ hov 0 (cstr ++ vars ++ spc () ++ str "=>") ++ spc () ++
-          hov 2 (pr_glbexpr E5 p)) ++ spc ()
-      in
-      prlist pr_branch br
-    | Tuple n ->
-      let (vars, p) = if Int.equal n 0 then ([||], cst_br.(0)) else ncst_br.(0) in
-      let p = pr_glbexpr E5 p in
-      let vars = prvect_with_sep (fun () -> str "," ++ spc ()) pr_name vars in
-      hov 4 (str "|" ++ spc () ++ hov 0 (paren vars ++ spc () ++ str "=>") ++ spc () ++ p)
-    in
-    v 0 (hv 0 (str "match" ++ spc () ++ e ++ spc () ++ str "with") ++ spc () ++ br ++ spc () ++ str "end")
-  | GTacWth wth ->
-    let e = pr_glbexpr E5 wth.opn_match in
-    let pr_pattern c self vars p =
-      let self = match self with
-      | Anonymous -> mt ()
-      | Name id -> spc () ++ str "as" ++ spc () ++ Id.print id
-      in
-      hov 4 (str "|" ++ spc () ++ hov 0 (c ++ vars ++ self ++ spc () ++ str "=>") ++ spc () ++
-        hov 2 (pr_glbexpr E5 p)) ++ spc ()
-    in
-    let pr_branch (cstr, (self, vars, p)) =
-      let cstr = pr_constructor cstr in
-      let vars = match Array.to_list vars with
-      | [] -> mt ()
-      | vars -> spc () ++ pr_sequence pr_name vars
-      in
-      pr_pattern cstr self vars p
-    in
-    let br = prlist pr_branch (KNmap.bindings wth.opn_branch) in
-    let (def_as, def_p) = wth.opn_default in
-    let def = pr_pattern (str "_") def_as (mt ()) def_p in
-    let br = br ++ def in
-    v 0 (hv 0 (str "match" ++ spc () ++ e ++ spc () ++ str "with") ++ spc () ++ br ++ str "end")
-  | GTacPrj (kn, e, n) ->
-    let def = match Tac2env.interp_type kn with
-    | _, GTydRec def -> def
-    | _, GTydDef _ | _, GTydAlg _ | _, GTydOpn -> assert false
-    in
-    let (proj, _, _) = List.nth def n in
-    let proj = change_kn_label kn proj in
-    let proj = pr_projection proj in
-    let e = pr_glbexpr E0 e in
-    hov 0 (e ++ str "." ++ paren proj)
-  | GTacSet (kn, e, n, r) ->
-    let def = match Tac2env.interp_type kn with
-    | _, GTydRec def -> def
-    | _, GTydDef _ | _, GTydAlg _ | _, GTydOpn -> assert false
-    in
-    let (proj, _, _) = List.nth def n in
-    let proj = change_kn_label kn proj in
-    let proj = pr_projection proj in
-    let e = pr_glbexpr E0 e in
-    let r = pr_glbexpr E1 r in
-    hov 0 (e ++ str "." ++ paren proj ++ spc () ++ str ":=" ++ spc () ++ r)
-  | GTacOpn (kn, cl) ->
-    let paren = match lvl with
-    | E0 -> paren
-    | E1 | E2 | E3 | E4 | E5 -> fun x -> x
-    in
-    let c = pr_constructor kn in
-    paren (hov 0 (c ++ spc () ++ (pr_sequence (pr_glbexpr E0) cl)))
-  | GTacExt (tag, arg) ->
-    let tpe = interp_ml_object tag in
-    hov 0 (tpe.ml_print (Global.env ()) arg) (* FIXME *)
-  | GTacPrm (prm, args) ->
-    let args = match args with
-    | [] -> mt ()
-    | _ -> spc () ++ pr_sequence (pr_glbexpr E0) args
-    in
-    hov 0 (str "@external" ++ spc () ++ qstring prm.mltac_plugin ++ spc () ++
-      qstring prm.mltac_tactic ++ args)
-  and pr_applied_constructor lvl tpe n cl =
-    let _, data = Tac2env.interp_type tpe in
-    if KerName.equal tpe t_list then
-      let rec factorize accu = function
-      | GTacCst (_, 0, []) -> accu, None
-      | GTacCst (_, 0, [e; l]) -> factorize (e :: accu) l
-      | e -> accu, Some e
-      in
-      let l, e = factorize [] (GTacCst (Other tpe, n, cl)) in
-      match e with
-      | None ->
-        let pr e = pr_glbexpr E4 e in
-        hov 2 (str "[" ++ prlist_with_sep pr_semicolon pr (List.rev l) ++ str "]")
-      | Some e ->
-        let paren = match lvl with
-        | E0 | E1 | E2 -> paren
-        | E3 | E4 | E5 -> fun x -> x
-        in
-        let pr e = pr_glbexpr E1 e in
-        let pr_cons () = spc () ++ str "::" ++ spc () in
-        paren (hov 2 (prlist_with_sep pr_cons pr (List.rev (e :: l))))
-    else match data with
-    | GTydAlg def ->
-      let paren = match lvl with
-      | E0 ->
-        if List.is_empty cl then fun x -> x else paren
-      | E1 | E2 | E3 | E4 | E5 -> fun x -> x
-      in
-      let cstr = pr_internal_constructor tpe n (List.is_empty cl) in
-      let cl = match cl with
-      | [] -> mt ()
-      | _ -> spc () ++ pr_sequence (pr_glbexpr E0) cl
-      in
-      paren (hov 2 (cstr ++ cl))
-    | GTydRec def ->
-      let args = List.combine def cl in
-      let pr_arg ((id, _, _), arg) =
-        let kn = change_kn_label tpe id in
-        pr_projection kn ++ spc () ++ str ":=" ++ spc () ++ pr_glbexpr E1 arg
-      in
-      let args = prlist_with_sep pr_semicolon pr_arg args in
-      hv 0 (str "{" ++ spc () ++ args ++ spc () ++ str "}")
-    | (GTydDef _ | GTydOpn) -> assert false
-  in
-  hov 0 (pr_glbexpr lvl c)
-
-
-
-let pr_glbexpr c =
-  pr_glbexpr_gen E5 c
-
-(** Toplevel printers *)
-
-let rec subst_type subst (t : 'a glb_typexpr) = match t with
-| GTypVar id -> subst.(id)
-| GTypArrow (t1, t2) -> GTypArrow (subst_type subst t1, subst_type subst t2)
-| GTypRef (qid, args) ->
-  GTypRef (qid, List.map (fun t -> subst_type subst t) args)
-
-let unfold kn args =
-  let (nparams, def) = Tac2env.interp_type kn in
-  match def with
-  | GTydDef (Some def) ->
-    let args = Array.of_list args in
-    Some (subst_type args def)
-  | _ -> None
-
-let rec kind t = match t with
-| GTypVar id -> GTypVar id
-| GTypRef (Other kn, tl) ->
-  begin match unfold kn tl with
-  | None -> t
-  | Some t -> kind t
-  end
-| GTypArrow _ | GTypRef (Tuple _, _) -> t
-
-type val_printer =
-  { val_printer : 'a. Environ.env -> Evd.evar_map -> valexpr -> 'a glb_typexpr list -> Pp.t }
-
-let printers = ref KNmap.empty
-
-let register_val_printer kn pr =
-  printers := KNmap.add kn pr !printers
-
-open Tac2ffi
-
-let rec pr_valexpr env sigma v t = match kind t with
-| GTypVar _ -> str "<poly>"
-| GTypRef (Other kn, params) ->
-  let pr = try Some (KNmap.find kn !printers) with Not_found -> None in
-  begin match pr with
-  | Some pr -> pr.val_printer env sigma v params
-  | None ->
-    let n, repr = Tac2env.interp_type kn in
-    if KerName.equal kn t_list then
-      pr_val_list env sigma (to_list (fun v -> repr_to valexpr v) v) (List.hd params)
-    else match repr with
-    | GTydDef None -> str "<abstr>"
-    | GTydDef (Some _) ->
-      (* Shouldn't happen thanks to kind *)
-      assert false
-    | GTydAlg alg ->
-      if Valexpr.is_int v then
-        pr_internal_constructor kn (Tac2ffi.to_int v) true
-      else
-        let (n, args) = Tac2ffi.to_block v in
-        let (id, tpe) = find_constructor n false alg.galg_constructors in
-        let knc = change_kn_label kn id in
-        let args = pr_constrargs env sigma params args tpe in
-        hv 2 (pr_constructor knc ++ spc () ++ str "(" ++ args ++ str ")")
-    | GTydRec rcd ->
-      let (_, args) = Tac2ffi.to_block v in
-      pr_record env sigma params args rcd
-    | GTydOpn ->
-      begin match Tac2ffi.to_open v with
-      | (knc, [||]) -> pr_constructor knc
-      | (knc, args) ->
-        let data = Tac2env.interp_constructor knc in
-        let args = pr_constrargs env sigma params args data.Tac2env.cdata_args in
-        hv 2 (pr_constructor knc ++ spc () ++ str "(" ++ args ++ str ")")
-      end
-  end
-| GTypArrow _ -> str "<fun>"
-| GTypRef (Tuple 0, []) -> str "()"
-| GTypRef (Tuple _, tl) ->
-  let blk = Array.to_list (snd (to_block v)) in
-  if List.length blk == List.length tl then
-    let prs = List.map2 (fun v t -> pr_valexpr env sigma v t) blk tl in
-    hv 2 (str "(" ++ prlist_with_sep pr_comma (fun p -> p) prs ++ str ")")
-  else
-    str "<unknown>"
-
-and pr_constrargs env sigma params args tpe =
-  let subst = Array.of_list params in
-  let tpe = List.map (fun t -> subst_type subst t) tpe in
-  let args = Array.to_list args in
-  let args = List.combine args tpe in
-  prlist_with_sep pr_comma (fun (v, t) -> pr_valexpr env sigma v t) args
-
-and pr_record env sigma params args rcd =
-  let subst = Array.of_list params in
-  let map (id, _, tpe) = (id, subst_type subst tpe) in
-  let rcd = List.map map rcd in
-  let args = Array.to_list args in
-  let fields = List.combine rcd args in
-  let pr_field ((id, t), arg) =
-    Id.print id ++ spc () ++ str ":=" ++ spc () ++ pr_valexpr env sigma arg t
-  in
-  str "{" ++ spc () ++ prlist_with_sep pr_semicolon pr_field fields ++ spc () ++ str "}"
-
-and pr_val_list env sigma args tpe =
-  let pr v = pr_valexpr env sigma v tpe in
-  str "[" ++ prlist_with_sep pr_semicolon pr args ++ str "]"
-
-let register_init n f =
-  let kn = KerName.make Tac2env.coq_prefix (Label.make n) in
-  register_val_printer kn { val_printer = fun env sigma v _ -> f env sigma v }
-
-let () = register_init "int" begin fun _ _ n ->
-  let n = to_int n in
-  Pp.int n
-end
-
-let () = register_init "string" begin fun _ _ s ->
-  let s = to_string s in
-  Pp.quote (str (Bytes.to_string s))
-end
-
-let () = register_init "ident" begin fun _ _ id ->
-  let id = to_ident id in
-  str "@" ++ Id.print id
-end
-
-let () = register_init "constr" begin fun env sigma c ->
-  let c = to_constr c in
-  let c = try Printer.pr_leconstr_env env sigma c with _ -> str "..." in
-  str "constr:(" ++ c ++ str ")"
-end
-
-let () = register_init "pattern" begin fun env sigma c ->
-  let c = to_pattern c in
-  let c = try Printer.pr_lconstr_pattern_env env sigma c with _ -> str "..." in
-  str "pattern:(" ++ c ++ str ")"
-end
-
-let () = register_init "message" begin fun _ _ pp ->
-  str "message:(" ++ to_pp pp ++ str ")"
-end
-
-let () = register_init "err" begin fun _ _ e ->
-  let e = to_ext val_exn e in
-  let (e, _) = ExplainErr.process_vernac_interp_error ~allow_uncaught:true e in
-  str "err:(" ++ CErrors.print_no_report e ++ str ")"
-end
-
-let () =
-  let kn = KerName.make Tac2env.coq_prefix (Label.make "array") in
-  let val_printer env sigma v arg = match arg with
-  | [arg] ->
-    let (_, v) = to_block v in
-    str "[|" ++ spc () ++
-      prvect_with_sep pr_semicolon (fun a -> pr_valexpr env sigma a arg) v ++
-      spc () ++ str "|]"
-  | _ -> assert false
-  in
-  register_val_printer kn { val_printer }
diff --git a/src/tac2print.mli b/src/tac2print.mli
deleted file mode 100644
index 9b9db2937d..0000000000
--- a/src/tac2print.mli
+++ /dev/null
@@ -1,46 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Tac2expr
-open Tac2ffi
-
-(** {5 Printing types} *)
-
-type typ_level =
-| T5_l
-| T5_r
-| T2
-| T1
-| T0
-
-val pr_typref : type_constant -> Pp.t
-val pr_glbtype_gen : ('a -> string) -> typ_level -> 'a glb_typexpr -> Pp.t
-val pr_glbtype : ('a -> string) -> 'a glb_typexpr -> Pp.t
-
-(** {5 Printing expressions} *)
-
-val pr_constructor : ltac_constructor -> Pp.t
-val pr_internal_constructor : type_constant -> int -> bool -> Pp.t
-val pr_projection : ltac_projection -> Pp.t
-val pr_glbexpr_gen : exp_level -> glb_tacexpr -> Pp.t
-val pr_glbexpr : glb_tacexpr -> Pp.t
-
-(** {5 Printing values}*)
-
-type val_printer =
-  { val_printer : 'a. Environ.env -> Evd.evar_map -> valexpr -> 'a glb_typexpr list -> Pp.t }
-
-val register_val_printer : type_constant -> val_printer -> unit
-
-val pr_valexpr : Environ.env -> Evd.evar_map -> valexpr -> 'a glb_typexpr -> Pp.t
-
-(** {5 Utilities} *)
-
-val int_name : unit -> (int -> string)
-(** Create a function that give names to integers. The names are generated on
-    the fly, in the order they are encountered. *)
diff --git a/src/tac2qexpr.mli b/src/tac2qexpr.mli
deleted file mode 100644
index 400ab1a092..0000000000
--- a/src/tac2qexpr.mli
+++ /dev/null
@@ -1,173 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Tac2expr
-
-(** Quoted variants of Ltac syntactic categories. Contrarily to the former, they
-    sometimes allow anti-quotations. Used for notation scopes. *)
-
-type 'a or_anti =
-| QExpr of 'a
-| QAnti of Id.t CAst.t
-
-type reference_r =
-| QReference of Libnames.qualid
-| QHypothesis of Id.t
-
-type reference = reference_r CAst.t
-
-type quantified_hypothesis =
-| QAnonHyp of int CAst.t
-| QNamedHyp of Id.t CAst.t
-
-type bindings_r =
-| QImplicitBindings of Constrexpr.constr_expr list
-| QExplicitBindings of (quantified_hypothesis CAst.t or_anti * Constrexpr.constr_expr) CAst.t list
-| QNoBindings
-
-type bindings = bindings_r CAst.t
-
-type intro_pattern_r =
-| QIntroForthcoming of bool
-| QIntroNaming of intro_pattern_naming
-| QIntroAction of intro_pattern_action
-and intro_pattern_naming_r =
-| QIntroIdentifier of Id.t CAst.t or_anti
-| QIntroFresh of Id.t CAst.t or_anti
-| QIntroAnonymous
-and intro_pattern_action_r =
-| QIntroWildcard
-| QIntroOrAndPattern of or_and_intro_pattern
-| QIntroInjection of intro_pattern list CAst.t
-(* | QIntroApplyOn of Empty.t (** Not implemented yet *) *)
-| QIntroRewrite of bool
-and or_and_intro_pattern_r =
-| QIntroOrPattern of intro_pattern list CAst.t list
-| QIntroAndPattern of intro_pattern list CAst.t
-
-and intro_pattern = intro_pattern_r CAst.t
-and intro_pattern_naming = intro_pattern_naming_r CAst.t
-and intro_pattern_action = intro_pattern_action_r CAst.t
-and or_and_intro_pattern = or_and_intro_pattern_r CAst.t
-
-type occurrences_r =
-| QAllOccurrences
-| QAllOccurrencesBut of int CAst.t or_anti list
-| QNoOccurrences
-| QOnlyOccurrences of int CAst.t or_anti list
-
-type occurrences = occurrences_r CAst.t
-
-type hyp_location = (occurrences * Id.t CAst.t or_anti) * Locus.hyp_location_flag
-
-type clause_r =
-  { q_onhyps : hyp_location list option; q_concl_occs : occurrences; }
-
-type clause = clause_r CAst.t
-
-type constr_with_bindings = (Constrexpr.constr_expr * bindings) CAst.t
-
-type destruction_arg_r =
-| QElimOnConstr of constr_with_bindings
-| QElimOnIdent of Id.t CAst.t
-| QElimOnAnonHyp of int CAst.t
-
-type destruction_arg = destruction_arg_r CAst.t
-
-type induction_clause_r = {
-  indcl_arg : destruction_arg;
-  indcl_eqn : intro_pattern_naming option;
-  indcl_as : or_and_intro_pattern option;
-  indcl_in : clause option;
-}
-
-type induction_clause = induction_clause_r CAst.t
-
-type conversion_r =
-| QConvert of Constrexpr.constr_expr
-| QConvertWith of Constrexpr.constr_expr * Constrexpr.constr_expr
-
-type conversion = conversion_r CAst.t
-
-type multi_r =
-| QPrecisely of int CAst.t
-| QUpTo of int CAst.t
-| QRepeatStar
-| QRepeatPlus
-
-type multi = multi_r CAst.t
-
-type rewriting_r = {
-  rew_orient : bool option CAst.t;
-  rew_repeat : multi;
-  rew_equatn : constr_with_bindings;
-}
-
-type rewriting = rewriting_r CAst.t
-
-type dispatch_r = raw_tacexpr option list * (raw_tacexpr option * raw_tacexpr option list) option
-
-type dispatch = dispatch_r CAst.t
-
-type red_flag_r =
-| QBeta
-| QIota
-| QMatch
-| QFix
-| QCofix
-| QZeta
-| QConst of reference or_anti list CAst.t
-| QDeltaBut of reference or_anti list CAst.t
-
-type red_flag = red_flag_r CAst.t
-
-type strategy_flag = red_flag list CAst.t
-
-type constr_match_pattern_r =
-| QConstrMatchPattern of Constrexpr.constr_expr
-| QConstrMatchContext of Id.t option * Constrexpr.constr_expr
-
-type constr_match_pattern = constr_match_pattern_r CAst.t
-
-type constr_match_branch = (constr_match_pattern * raw_tacexpr) CAst.t
-
-type constr_matching = constr_match_branch list CAst.t
-
-type goal_match_pattern_r = {
-  q_goal_match_concl : constr_match_pattern;
-  q_goal_match_hyps : (Names.lname * constr_match_pattern) list;
-}
-
-type goal_match_pattern = goal_match_pattern_r CAst.t
-
-type goal_match_branch = (goal_match_pattern * raw_tacexpr) CAst.t
-
-type goal_matching = goal_match_branch list CAst.t
-
-type hintdb_r =
-| QHintAll
-| QHintDbs of Id.t CAst.t or_anti list
-
-type hintdb = hintdb_r CAst.t
-
-type move_location_r =
-| QMoveAfter of Id.t CAst.t or_anti
-| QMoveBefore of Id.t CAst.t or_anti
-| QMoveFirst
-| QMoveLast
-
-type move_location = move_location_r CAst.t
-
-type pose = (Id.t CAst.t or_anti option * Constrexpr.constr_expr) CAst.t
-
-type assertion_r =
-| QAssertType of intro_pattern option * Constrexpr.constr_expr * raw_tacexpr option
-| QAssertValue of Id.t CAst.t or_anti * Constrexpr.constr_expr
-
-type assertion = assertion_r CAst.t
diff --git a/src/tac2quote.ml b/src/tac2quote.ml
deleted file mode 100644
index a98264745e..0000000000
--- a/src/tac2quote.ml
+++ /dev/null
@@ -1,465 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Pp
-open Names
-open Util
-open CAst
-open Tac2dyn
-open Tac2expr
-open Tac2qexpr
-
-(** Generic arguments *)
-
-let wit_pattern = Arg.create "pattern"
-let wit_reference = Arg.create "reference"
-let wit_ident = Arg.create "ident"
-let wit_constr = Arg.create "constr"
-let wit_open_constr = Arg.create "open_constr"
-let wit_ltac1 = Arg.create "ltac1"
-let wit_ltac1val = Arg.create "ltac1val"
-
-(** Syntactic quoting of expressions. *)
-
-let prefix_gen n =
-  MPfile (DirPath.make (List.map Id.of_string [n; "Ltac2"]))
-
-let control_prefix = prefix_gen "Control"
-let pattern_prefix = prefix_gen "Pattern"
-let array_prefix = prefix_gen "Array"
-
-let kername prefix n = KerName.make prefix (Label.of_id (Id.of_string_soft n))
-let std_core n = kername Tac2env.std_prefix n
-let coq_core n = kername Tac2env.coq_prefix n
-let control_core n = kername control_prefix n
-let pattern_core n = kername pattern_prefix n
-
-let global_ref ?loc kn =
-  CAst.make ?loc @@ CTacRef (AbsKn (TacConstant kn))
-
-let constructor ?loc kn args =
-  let cst = CAst.make ?loc @@ CTacCst (AbsKn (Other kn)) in
-  if List.is_empty args then cst
-  else CAst.make ?loc @@ CTacApp (cst, args)
-
-let std_constructor ?loc name args =
-  constructor ?loc (std_core name) args
-
-let std_proj ?loc name =
-  AbsKn (std_core name)
-
-let thunk e =
-  let t_unit = coq_core "unit" in
-  let loc = e.loc in
-  let ty = CAst.make?loc @@ CTypRef (AbsKn (Other t_unit), []) in
-  let pat = CAst.make ?loc @@ CPatVar (Anonymous) in
-  let pat = CAst.make ?loc @@ CPatCnv (pat, ty) in
-  CAst.make ?loc @@ CTacFun ([pat], e)
-
-let of_pair f g {loc;v=(e1, e2)} =
-  CAst.make ?loc @@ CTacApp (CAst.make ?loc @@ CTacCst (AbsKn (Tuple 2)), [f e1; g e2])
-
-let of_tuple ?loc el = match el with
-| [] ->
-  CAst.make ?loc @@ CTacCst (AbsKn (Tuple 0))
-| [e] -> e
-| el ->
-  let len = List.length el in
-  CAst.make ?loc @@ CTacApp (CAst.make ?loc @@ CTacCst (AbsKn (Tuple len)), el)
-
-let of_int {loc;v=n} =
-  CAst.make ?loc @@ CTacAtm (AtmInt n)
-
-let of_option ?loc f opt = match opt with
-| None -> constructor ?loc (coq_core "None") []
-| Some e -> constructor ?loc (coq_core "Some") [f e]
-
-let inj_wit ?loc wit x =
-  CAst.make ?loc @@ CTacExt (wit, x)
-
-let of_variable {loc;v=id} =
-  let qid = Libnames.qualid_of_ident ?loc id in
-  if Tac2env.is_constructor qid then
-    CErrors.user_err ?loc (str "Invalid identifier")
-  else CAst.make ?loc @@ CTacRef (RelId qid)
-
-let of_anti f = function
-| QExpr x -> f x
-| QAnti id -> of_variable id
-
-let of_ident {loc;v=id} = inj_wit ?loc wit_ident id
-
-let of_constr c =
-  let loc = Constrexpr_ops.constr_loc c in
-  inj_wit ?loc wit_constr c
-
-let of_open_constr c =
-  let loc = Constrexpr_ops.constr_loc c in
-  inj_wit ?loc wit_open_constr c
-
-let of_bool ?loc b =
-  let c = if b then coq_core "true" else coq_core "false" in
-  constructor ?loc c []
-
-let rec of_list ?loc f = function
-| [] -> constructor (coq_core "[]") []
-| e :: l ->
-  constructor ?loc (coq_core "::") [f e; of_list ?loc f l]
-
-let of_qhyp {loc;v=h} = match h with
-| QAnonHyp n -> std_constructor ?loc "AnonHyp" [of_int n]
-| QNamedHyp id -> std_constructor ?loc "NamedHyp" [of_ident id]
-
-let of_bindings {loc;v=b} = match b with
-| QNoBindings ->
-  std_constructor ?loc "NoBindings" []
-| QImplicitBindings tl ->
-  std_constructor ?loc "ImplicitBindings" [of_list ?loc of_open_constr tl]
-| QExplicitBindings tl ->
-  let map e = of_pair (fun q -> of_anti of_qhyp q) of_open_constr e in
-  std_constructor ?loc "ExplicitBindings" [of_list ?loc map tl]
-
-let of_constr_with_bindings c = of_pair of_open_constr of_bindings c
-
-let rec of_intro_pattern {loc;v=pat} = match pat with
-| QIntroForthcoming b ->
-  std_constructor ?loc "IntroForthcoming" [of_bool b]
-| QIntroNaming iname ->
-  std_constructor ?loc "IntroNaming" [of_intro_pattern_naming iname]
-| QIntroAction iact ->
-  std_constructor ?loc "IntroAction" [of_intro_pattern_action iact]
-
-and of_intro_pattern_naming {loc;v=pat} = match pat with
-| QIntroIdentifier id ->
-  std_constructor ?loc "IntroIdentifier" [of_anti of_ident id]
-| QIntroFresh id ->
-  std_constructor ?loc "IntroFresh" [of_anti of_ident id]
-| QIntroAnonymous ->
-  std_constructor ?loc "IntroAnonymous" []
-
-and of_intro_pattern_action {loc;v=pat} = match pat with
-| QIntroWildcard ->
-  std_constructor ?loc "IntroWildcard" []
-| QIntroOrAndPattern pat ->
-  std_constructor ?loc "IntroOrAndPattern" [of_or_and_intro_pattern pat]
-| QIntroInjection il ->
-  std_constructor ?loc "IntroInjection" [of_intro_patterns il]
-| QIntroRewrite b ->
-  std_constructor ?loc "IntroRewrite" [of_bool ?loc b]
-
-and of_or_and_intro_pattern {loc;v=pat} = match pat with
-| QIntroOrPattern ill ->
-  std_constructor ?loc "IntroOrPattern" [of_list ?loc of_intro_patterns ill]
-| QIntroAndPattern il ->
-  std_constructor ?loc "IntroAndPattern" [of_intro_patterns il]
-
-and of_intro_patterns {loc;v=l} =
-  of_list ?loc of_intro_pattern l
-
-let of_hyp_location_flag ?loc = function
-| Locus.InHyp -> std_constructor ?loc "InHyp" []
-| Locus.InHypTypeOnly -> std_constructor ?loc "InHypTypeOnly" []
-| Locus.InHypValueOnly -> std_constructor ?loc "InHypValueOnly" []
-
-let of_occurrences {loc;v=occ} = match occ with
-| QAllOccurrences -> std_constructor ?loc "AllOccurrences" []
-| QAllOccurrencesBut occs ->
-  let map occ = of_anti of_int occ in
-  let occs = of_list ?loc map occs in
-  std_constructor ?loc "AllOccurrencesBut" [occs]
-| QNoOccurrences -> std_constructor ?loc "NoOccurrences" []
-| QOnlyOccurrences occs ->
-  let map occ = of_anti of_int occ in
-  let occs = of_list ?loc map occs in
-  std_constructor ?loc "OnlyOccurrences" [occs]
-
-let of_hyp_location ?loc ((occs, id), flag) =
-  of_tuple ?loc [
-    of_anti of_ident id;
-    of_occurrences occs;
-    of_hyp_location_flag ?loc flag;
-  ]
-
-let of_clause {loc;v=cl} =
-  let hyps = of_option ?loc (fun l -> of_list ?loc of_hyp_location l) cl.q_onhyps in
-  let concl = of_occurrences cl.q_concl_occs in
-  CAst.make ?loc @@ CTacRec ([
-    std_proj "on_hyps", hyps;
-    std_proj "on_concl", concl;
-  ])
-
-let of_destruction_arg {loc;v=arg} = match arg with
-| QElimOnConstr c ->
-  let arg = thunk (of_constr_with_bindings c) in
-  std_constructor ?loc "ElimOnConstr" [arg]
-| QElimOnIdent id -> std_constructor ?loc "ElimOnIdent" [of_ident id]
-| QElimOnAnonHyp n -> std_constructor ?loc "ElimOnAnonHyp" [of_int n]
-
-let of_induction_clause {loc;v=cl} =
-  let arg = of_destruction_arg cl.indcl_arg in
-  let eqn = of_option ?loc of_intro_pattern_naming cl.indcl_eqn in
-  let as_ = of_option ?loc of_or_and_intro_pattern cl.indcl_as in
-  let in_ = of_option ?loc of_clause cl.indcl_in in
-  CAst.make ?loc @@ CTacRec ([
-    std_proj "indcl_arg", arg;
-    std_proj "indcl_eqn", eqn;
-    std_proj "indcl_as", as_;
-    std_proj "indcl_in", in_;
-  ])
-
-let check_pattern_id ?loc id =
-  if Tac2env.is_constructor (Libnames.qualid_of_ident id) then
-    CErrors.user_err ?loc (str "Invalid pattern binding name " ++ Id.print id)
-
-let pattern_vars pat =
-  let rec aux () accu pat = match pat.CAst.v with
-  | Constrexpr.CPatVar id
-  | Constrexpr.CEvar (id, []) ->
-    let () = check_pattern_id ?loc:pat.CAst.loc id in
-    Id.Set.add id accu
-  | _ ->
-    Constrexpr_ops.fold_constr_expr_with_binders (fun _ () -> ()) aux () accu pat
-  in
-  aux () Id.Set.empty pat
-
-let abstract_vars loc vars tac =
-  let get_name = function Name id -> Some id | Anonymous -> None in
-  let def = try Some (List.find_map get_name vars) with Not_found -> None in
-  let na, tac = match def with
-  | None -> (Anonymous, tac)
-  | Some id0 ->
-      (* Trick: in order not to shadow a variable nor to choose an arbitrary
-         name, we reuse one which is going to be shadowed by the matched
-         variables anyways. *)
-      let build_bindings (n, accu) na = match na with
-      | Anonymous -> (n + 1, accu)
-      | Name _ ->
-        let get = global_ref ?loc (kername array_prefix "get")  in
-        let args = [of_variable CAst.(make ?loc id0); of_int CAst.(make ?loc n)] in
-        let e = CAst.make ?loc @@ CTacApp (get, args) in
-        let accu = (CAst.make ?loc @@ CPatVar na, e) :: accu in
-        (n + 1, accu)
-      in
-      let (_, bnd) = List.fold_left build_bindings (0, []) vars in
-      let tac = CAst.make ?loc @@ CTacLet (false, bnd, tac) in
-      (Name id0, tac)
-  in
-  CAst.make ?loc @@ CTacFun ([CAst.make ?loc @@ CPatVar na], tac)
-
-let of_pattern p =
-  inj_wit ?loc:p.CAst.loc wit_pattern p
-
-let of_conversion {loc;v=c} = match c with
-| QConvert c ->
-  let pat = of_option ?loc of_pattern None in
-  let c = CAst.make ?loc @@ CTacFun ([CAst.make ?loc @@ CPatVar Anonymous], of_constr c) in
-  of_tuple ?loc [pat; c]
-| QConvertWith (pat, c) ->
-  let vars = pattern_vars pat in
-  let pat = of_option ?loc of_pattern (Some pat) in
-  let c = of_constr c in
-  (* Order is critical here *)
-  let vars = List.map (fun id -> Name id) (Id.Set.elements vars) in
-  let c = abstract_vars loc vars c in
-  of_tuple [pat; c]
-
-let of_repeat {loc;v=r} = match r with
-| QPrecisely n -> std_constructor ?loc "Precisely" [of_int n]
-| QUpTo n -> std_constructor ?loc "UpTo" [of_int n]
-| QRepeatStar -> std_constructor ?loc "RepeatStar" []
-| QRepeatPlus -> std_constructor ?loc "RepeatPlus" []
-
-let of_orient loc b =
-  if b then std_constructor ?loc "LTR" []
-  else std_constructor ?loc "RTL" []
-
-let of_rewriting {loc;v=rew} =
-  let orient =
-    let {loc;v=orient} = rew.rew_orient in
-    of_option ?loc (fun b -> of_orient loc b) orient
-  in
-  let repeat = of_repeat rew.rew_repeat in
-  let equatn = thunk (of_constr_with_bindings rew.rew_equatn) in
-  CAst.make ?loc @@ CTacRec ([
-    std_proj "rew_orient", orient;
-    std_proj "rew_repeat", repeat;
-    std_proj "rew_equatn", equatn;
-  ])
-
-let of_hyp ?loc id =
-  let hyp = global_ref ?loc (control_core "hyp") in
-  CAst.make ?loc @@ CTacApp (hyp, [of_ident id])
-
-let of_exact_hyp ?loc id =
-  let refine = global_ref ?loc (control_core "refine") in
-  CAst.make ?loc @@ CTacApp (refine, [thunk (of_hyp ?loc id)])
-
-let of_exact_var ?loc id =
-  let refine = global_ref ?loc (control_core "refine") in
-  CAst.make ?loc @@ CTacApp (refine, [thunk (of_variable id)])
-
-let of_dispatch tacs =
-  let loc = tacs.loc in
-  let default = function
-  | Some e -> thunk e
-  | None -> thunk (CAst.make ?loc @@ CTacCst (AbsKn (Tuple 0)))
-  in
-  let map e = of_pair default (fun l -> of_list ?loc default l) (CAst.make ?loc e) in
-  of_pair (fun l -> of_list ?loc default l) (fun r -> of_option ?loc map r) tacs
-
-let make_red_flag l =
-  let open Genredexpr in
-  let rec add_flag red = function
-  | [] -> red
-  | {v=flag} :: lf ->
-    let red = match flag with
-    | QBeta -> { red with rBeta = true }
-    | QMatch -> { red with rMatch = true }
-    | QFix -> { red with rFix = true }
-    | QCofix -> { red with rCofix = true }
-    | QZeta -> { red with rZeta = true }
-    | QConst {loc;v=l} ->
-        if red.rDelta then
-          CErrors.user_err ?loc Pp.(str
-            "Cannot set both constants to unfold and constants not to unfold");
-        { red with rConst = red.rConst @ l }
-    | QDeltaBut {loc;v=l} ->
-        if red.rConst <> [] && not red.rDelta then
-          CErrors.user_err ?loc Pp.(str
-            "Cannot set both constants to unfold and constants not to unfold");
-        { red with rConst = red.rConst @ l; rDelta = true }
-    | QIota ->
-      { red with rMatch = true; rFix = true; rCofix = true }
-    in
-    add_flag red lf
-  in
-  add_flag
-    {rBeta = false; rMatch = false; rFix = false; rCofix = false;
-     rZeta = false; rDelta = false; rConst = []}
-    l
-
-let of_reference r =
-  let of_ref ref =
-    inj_wit ?loc:ref.loc wit_reference ref
-  in
-  of_anti of_ref r
-
-let of_strategy_flag {loc;v=flag} =
-  let open Genredexpr in
-  let flag = make_red_flag flag in
-  CAst.make ?loc @@ CTacRec ([
-    std_proj "rBeta", of_bool ?loc flag.rBeta;
-    std_proj "rMatch", of_bool ?loc flag.rMatch;
-    std_proj "rFix", of_bool ?loc flag.rFix;
-    std_proj "rCofix", of_bool ?loc flag.rCofix;
-    std_proj "rZeta", of_bool ?loc flag.rZeta;
-    std_proj "rDelta", of_bool ?loc flag.rDelta;
-    std_proj "rConst", of_list ?loc of_reference flag.rConst;
-  ])
-
-let of_hintdb {loc;v=hdb} = match hdb with
-| QHintAll -> of_option ?loc (fun l -> of_list (fun id -> of_anti of_ident id) l) None
-| QHintDbs ids -> of_option ?loc (fun l -> of_list (fun id -> of_anti of_ident id) l) (Some ids)
-
-let extract_name ?loc oid = match oid with
-| None -> Anonymous
-| Some id ->
-  let () = check_pattern_id ?loc id in
-  Name id
-
-(** For every branch in the matching, generate a corresponding term of type
-    [(match_kind * pattern * (context -> constr array -> 'a))]
-    where the function binds the names from the pattern to the contents of the
-    constr array. *)
-let of_constr_matching {loc;v=m} =
-  let map {loc;v=({loc=ploc;v=pat}, tac)} =
-    let (knd, pat, na) = match pat with
-    | QConstrMatchPattern pat ->
-      let knd = constructor ?loc (pattern_core "MatchPattern") [] in
-      (knd, pat, Anonymous)
-    | QConstrMatchContext (id, pat) ->
-      let na = extract_name ?loc id in
-      let knd = constructor ?loc (pattern_core "MatchContext") [] in
-      (knd, pat, na)
-    in
-    let vars = pattern_vars pat in
-    (* Order of elements is crucial here! *)
-    let vars = Id.Set.elements vars in
-    let vars = List.map (fun id -> Name id) vars in
-    let e = abstract_vars loc vars tac in
-    let e = CAst.make ?loc @@ CTacFun ([CAst.make ?loc @@ CPatVar na], e) in
-    let pat = inj_wit ?loc:ploc wit_pattern pat in
-    of_tuple [knd; pat; e]
-  in
-  of_list ?loc map m
-
-(** From the patterns and the body of the branch, generate:
-    - a goal pattern: (constr_match list * constr_match)
-    - a branch function (ident array -> context array -> constr array -> context -> 'a)
-*)
-let of_goal_matching {loc;v=gm} =
-  let mk_pat {loc;v=p} = match p with
-  | QConstrMatchPattern pat ->
-    let knd = constructor ?loc (pattern_core "MatchPattern") [] in
-    (Anonymous, pat, knd)
-  | QConstrMatchContext (id, pat) ->
-    let na = extract_name ?loc id in
-    let knd = constructor ?loc (pattern_core "MatchContext") [] in
-    (na, pat, knd)
-  in
-  let mk_gpat {loc;v=p} =
-    let concl_pat = p.q_goal_match_concl in
-    let hyps_pats = p.q_goal_match_hyps in
-    let (concl_ctx, concl_pat, concl_knd) = mk_pat concl_pat in
-    let vars = pattern_vars concl_pat in
-    let map accu (na, pat) =
-      let (ctx, pat, knd) = mk_pat pat in
-      let vars = pattern_vars pat in
-      (Id.Set.union vars accu, (na, ctx, pat, knd))
-    in
-    let (vars, hyps_pats) = List.fold_left_map map vars hyps_pats in
-    let map (_, _, pat, knd) = of_tuple [knd; of_pattern pat] in
-    let concl = of_tuple [concl_knd; of_pattern concl_pat] in
-    let r = of_tuple [of_list ?loc map hyps_pats; concl] in
-    let hyps = List.map (fun ({CAst.v=na}, _, _, _) -> na) hyps_pats in
-    let map (_, na, _, _) = na in
-    let hctx = List.map map hyps_pats in
-    (* Order of elements is crucial here! *)
-    let vars = Id.Set.elements vars in
-    let subst = List.map (fun id -> Name id) vars in
-    (r, hyps, hctx, subst, concl_ctx)
-  in
-  let map {loc;v=(pat, tac)} =
-    let (pat, hyps, hctx, subst, cctx) = mk_gpat pat in
-    let tac = CAst.make ?loc @@ CTacFun ([CAst.make ?loc @@ CPatVar cctx], tac) in
-    let tac = abstract_vars loc subst tac in
-    let tac = abstract_vars loc hctx tac in
-    let tac = abstract_vars loc hyps tac in
-    of_tuple ?loc [pat; tac]
-  in
-  of_list ?loc map gm
-
-let of_move_location {loc;v=mv} = match mv with
-| QMoveAfter id -> std_constructor ?loc "MoveAfter" [of_anti of_ident id]
-| QMoveBefore id -> std_constructor ?loc "MoveBefore" [of_anti of_ident id]
-| QMoveFirst -> std_constructor ?loc "MoveFirst" []
-| QMoveLast -> std_constructor ?loc "MoveLast" []
-
-let of_pose p =
-  of_pair (fun id -> of_option (fun id -> of_anti of_ident id) id) of_open_constr p
-
-let of_assertion {loc;v=ast} = match ast with
-| QAssertType (ipat, c, tac) ->
-  let ipat = of_option of_intro_pattern ipat in
-  let c = of_constr c in
-  let tac = of_option thunk tac in
-  std_constructor ?loc "AssertType" [ipat; c; tac]
-| QAssertValue (id, c) ->
-  let id = of_anti of_ident id in
-  let c = of_constr c in
-  std_constructor ?loc "AssertValue" [id; c]
diff --git a/src/tac2quote.mli b/src/tac2quote.mli
deleted file mode 100644
index 1b03dad8ec..0000000000
--- a/src/tac2quote.mli
+++ /dev/null
@@ -1,102 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Tac2dyn
-open Tac2qexpr
-open Tac2expr
-
-(** Syntactic quoting of expressions. *)
-
-(** Contrarily to Tac2ffi, which lives on the semantic level, this module
-    manipulates pure syntax of Ltac2. Its main purpose is to write notations. *)
-
-val constructor : ?loc:Loc.t -> ltac_constructor -> raw_tacexpr list -> raw_tacexpr
-
-val thunk : raw_tacexpr -> raw_tacexpr
-
-val of_anti : ('a -> raw_tacexpr) -> 'a or_anti -> raw_tacexpr
-
-val of_int : int CAst.t -> raw_tacexpr
-
-val of_pair : ('a -> raw_tacexpr) -> ('b -> raw_tacexpr) -> ('a * 'b) CAst.t -> raw_tacexpr
-
-val of_tuple : ?loc:Loc.t -> raw_tacexpr list -> raw_tacexpr
-
-val of_variable : Id.t CAst.t -> raw_tacexpr
-
-val of_ident : Id.t CAst.t -> raw_tacexpr
-
-val of_constr : Constrexpr.constr_expr -> raw_tacexpr
-
-val of_open_constr : Constrexpr.constr_expr -> raw_tacexpr
-
-val of_list : ?loc:Loc.t -> ('a -> raw_tacexpr) -> 'a list -> raw_tacexpr
-
-val of_bindings : bindings -> raw_tacexpr
-
-val of_intro_pattern : intro_pattern -> raw_tacexpr
-
-val of_intro_patterns : intro_pattern list CAst.t -> raw_tacexpr
-
-val of_clause : clause -> raw_tacexpr
-
-val of_destruction_arg : destruction_arg -> raw_tacexpr
-
-val of_induction_clause : induction_clause -> raw_tacexpr
-
-val of_conversion : conversion -> raw_tacexpr
-
-val of_rewriting : rewriting -> raw_tacexpr
-
-val of_occurrences : occurrences -> raw_tacexpr
-
-val of_hintdb : hintdb -> raw_tacexpr
-
-val of_move_location : move_location -> raw_tacexpr
-
-val of_reference : reference or_anti -> raw_tacexpr
-
-val of_hyp : ?loc:Loc.t -> Id.t CAst.t -> raw_tacexpr
-(** id ↦ 'Control.hyp @id' *)
-
-val of_exact_hyp : ?loc:Loc.t -> Id.t CAst.t -> raw_tacexpr
-(** id ↦ 'Control.refine (fun () => Control.hyp @id') *)
-
-val of_exact_var : ?loc:Loc.t -> Id.t CAst.t -> raw_tacexpr
-(** id ↦ 'Control.refine (fun () => Control.hyp @id') *)
-
-val of_dispatch : dispatch -> raw_tacexpr
-
-val of_strategy_flag : strategy_flag -> raw_tacexpr
-
-val of_pose : pose -> raw_tacexpr
-
-val of_assertion : assertion -> raw_tacexpr
-
-val of_constr_matching : constr_matching -> raw_tacexpr
-
-val of_goal_matching : goal_matching -> raw_tacexpr
-
-(** {5 Generic arguments} *)
-
-val wit_pattern : (Constrexpr.constr_expr, Pattern.constr_pattern) Arg.tag
-
-val wit_ident : (Id.t, Id.t) Arg.tag
-
-val wit_reference : (reference, GlobRef.t) Arg.tag
-
-val wit_constr : (Constrexpr.constr_expr, Glob_term.glob_constr) Arg.tag
-
-val wit_open_constr : (Constrexpr.constr_expr, Glob_term.glob_constr) Arg.tag
-
-val wit_ltac1 : (Ltac_plugin.Tacexpr.raw_tactic_expr, Ltac_plugin.Tacexpr.glob_tactic_expr) Arg.tag
-(** Ltac1 AST quotation, seen as a 'tactic'. Its type is unit in Ltac2. *)
-
-val wit_ltac1val : (Ltac_plugin.Tacexpr.raw_tactic_expr, Ltac_plugin.Tacexpr.glob_tactic_expr) Arg.tag
-(** Ltac1 AST quotation, seen as a value-returning expression, with type Ltac1.t. *)
diff --git a/src/tac2stdlib.ml b/src/tac2stdlib.ml
deleted file mode 100644
index ffef2c05fd..0000000000
--- a/src/tac2stdlib.ml
+++ /dev/null
@@ -1,578 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Genredexpr
-open Tac2expr
-open Tac2ffi
-open Tac2types
-open Tac2extffi
-open Proofview.Notations
-
-module Value = Tac2ffi
-
-(** Make a representation with a dummy from function *)
-let make_to_repr f = Tac2ffi.make_repr (fun _ -> assert false) f
-
-let return x = Proofview.tclUNIT x
-let v_unit = Value.of_unit ()
-let thaw r f = Tac2ffi.app_fun1 f unit r ()
-let uthaw r f = Tac2ffi.app_fun1 (to_fun1 unit r f) unit r ()
-let thunk r = fun1 unit r
-
-let to_name c = match Value.to_option Value.to_ident c with
-| None -> Anonymous
-| Some id -> Name id
-
-let name = make_to_repr to_name
-
-let to_occurrences = function
-| ValInt 0 -> AllOccurrences
-| ValBlk (0, [| vl |]) -> AllOccurrencesBut (Value.to_list Value.to_int vl)
-| ValInt 1 -> NoOccurrences
-| ValBlk (1, [| vl |]) -> OnlyOccurrences (Value.to_list Value.to_int vl)
-| _ -> assert false
-
-let occurrences = make_to_repr to_occurrences
-
-let to_hyp_location_flag v = match Value.to_int v with
-| 0 -> InHyp
-| 1 -> InHypTypeOnly
-| 2 -> InHypValueOnly
-| _ -> assert false
-
-let to_clause v = match Value.to_tuple v with
-| [| hyps; concl |] ->
-  let cast v = match Value.to_tuple v with
-  | [| hyp; occ; flag |] ->
-    (Value.to_ident hyp, to_occurrences occ, to_hyp_location_flag flag)
-  | _ -> assert false
-  in
-  let hyps = Value.to_option (fun h -> Value.to_list cast h) hyps in
-  { onhyps = hyps; concl_occs = to_occurrences concl; }
-| _ -> assert false
-
-let clause = make_to_repr to_clause
-
-let to_red_flag v = match Value.to_tuple v with
-| [| beta; iota; fix; cofix; zeta; delta; const |] ->
-  {
-    rBeta = Value.to_bool beta;
-    rMatch = Value.to_bool iota;
-    rFix = Value.to_bool fix;
-    rCofix = Value.to_bool cofix;
-    rZeta = Value.to_bool zeta;
-    rDelta = Value.to_bool delta;
-    rConst = Value.to_list Value.to_reference const;
-  }
-| _ -> assert false
-
-let red_flags = make_to_repr to_red_flag
-
-let pattern_with_occs = pair pattern occurrences
-
-let constr_with_occs = pair constr occurrences
-
-let reference_with_occs = pair reference occurrences
-
-let rec to_intro_pattern v = match Value.to_block v with
-| (0, [| b |]) -> IntroForthcoming (Value.to_bool b)
-| (1, [| pat |]) -> IntroNaming (to_intro_pattern_naming pat)
-| (2, [| act |]) -> IntroAction (to_intro_pattern_action act)
-| _ -> assert false
-
-and to_intro_pattern_naming = function
-| ValBlk (0, [| id |]) -> IntroIdentifier (Value.to_ident id)
-| ValBlk (1, [| id |]) -> IntroFresh (Value.to_ident id)
-| ValInt 0 -> IntroAnonymous
-| _ -> assert false
-
-and to_intro_pattern_action = function
-| ValInt 0 -> IntroWildcard
-| ValBlk (0, [| op |]) -> IntroOrAndPattern (to_or_and_intro_pattern op)
-| ValBlk (1, [| inj |]) ->
-  let map ipat = to_intro_pattern ipat in
-  IntroInjection (Value.to_list map inj)
-| ValBlk (2, [| c; ipat |]) ->
-  let c = Value.to_fun1 Value.unit Value.constr c in
-  IntroApplyOn (c, to_intro_pattern ipat)
-| ValBlk (3, [| b |]) -> IntroRewrite (Value.to_bool b)
-| _ -> assert false
-
-and to_or_and_intro_pattern v = match Value.to_block v with
-| (0, [| ill |]) ->
-  IntroOrPattern (Value.to_list to_intro_patterns ill)
-| (1, [| il |]) ->
-  IntroAndPattern (to_intro_patterns il)
-| _ -> assert false
-
-and to_intro_patterns il =
-  Value.to_list to_intro_pattern il
-
-let intro_pattern = make_to_repr to_intro_pattern
-
-let intro_patterns = make_to_repr to_intro_patterns
-
-let to_destruction_arg v = match Value.to_block v with
-| (0, [| c |]) ->
-  let c = uthaw constr_with_bindings c in
-  ElimOnConstr c
-| (1, [| id |]) -> ElimOnIdent (Value.to_ident id)
-| (2, [| n |]) -> ElimOnAnonHyp (Value.to_int n)
-| _ -> assert false
-
-let destruction_arg = make_to_repr to_destruction_arg
-
-let to_induction_clause v = match Value.to_tuple v with
-| [| arg; eqn; as_; in_ |] ->
-  let arg = to_destruction_arg arg in
-  let eqn = Value.to_option to_intro_pattern_naming eqn in
-  let as_ = Value.to_option to_or_and_intro_pattern as_ in
-  let in_ = Value.to_option to_clause in_ in
-  (arg, eqn, as_, in_)
-| _ ->
-  assert false
-
-let induction_clause = make_to_repr to_induction_clause
-
-let to_assertion v = match Value.to_block v with
-| (0, [| ipat; t; tac |]) ->
-  let to_tac t = Value.to_fun1 Value.unit Value.unit t in
-  let ipat = Value.to_option to_intro_pattern ipat in
-  let t = Value.to_constr t in
-  let tac = Value.to_option to_tac tac in
-  AssertType (ipat, t, tac)
-| (1, [| id; c |]) ->
-  AssertValue (Value.to_ident id, Value.to_constr c)
-| _ -> assert false
-
-let assertion = make_to_repr to_assertion
-
-let to_multi = function
-| ValBlk (0, [| n |]) -> Precisely (Value.to_int n)
-| ValBlk (1, [| n |]) -> UpTo (Value.to_int n)
-| ValInt 0 -> RepeatStar
-| ValInt 1 -> RepeatPlus
-| _ -> assert false
-
-let to_rewriting v = match Value.to_tuple v with
-| [| orient; repeat; c |] ->
-  let orient = Value.to_option Value.to_bool orient in
-  let repeat = to_multi repeat in
-  let c = uthaw constr_with_bindings c in
-  (orient, repeat, c)
-| _ -> assert false
-
-let rewriting = make_to_repr to_rewriting
-
-let to_debug v = match Value.to_int v with
-| 0 -> Hints.Off
-| 1 -> Hints.Info
-| 2 -> Hints.Debug
-| _ -> assert false
-
-let debug = make_to_repr to_debug
-
-let to_strategy v = match Value.to_int v with
-| 0 -> Class_tactics.Bfs
-| 1 -> Class_tactics.Dfs
-| _ -> assert false
-
-let strategy = make_to_repr to_strategy
-
-let to_inversion_kind v = match Value.to_int v with
-| 0 -> Inv.SimpleInversion
-| 1 -> Inv.FullInversion
-| 2 -> Inv.FullInversionClear
-| _ -> assert false
-
-let inversion_kind = make_to_repr to_inversion_kind
-
-let to_move_location = function
-| ValInt 0 -> Logic.MoveFirst
-| ValInt 1 -> Logic.MoveLast
-| ValBlk (0, [|id|]) -> Logic.MoveAfter (Value.to_ident id)
-| ValBlk (1, [|id|]) -> Logic.MoveBefore (Value.to_ident id)
-| _ -> assert false
-
-let move_location = make_to_repr to_move_location
-
-let to_generalize_arg v = match Value.to_tuple v with
-| [| c; occs; na |] ->
-  (Value.to_constr c, to_occurrences occs, to_name na)
-| _ -> assert false
-
-let generalize_arg = make_to_repr to_generalize_arg
-
-(** Standard tactics sharing their implementation with Ltac1 *)
-
-let pname s = { mltac_plugin = "ltac2"; mltac_tactic = s }
-
-let lift tac = tac <*> return v_unit
-
-let define_prim0 name tac =
-  let tac _ = lift tac in
-  Tac2env.define_primitive (pname name) (mk_closure arity_one tac)
-
-let define_prim1 name r0 f =
-  let tac x = lift (f (Value.repr_to r0 x)) in
-  Tac2env.define_primitive (pname name) (mk_closure arity_one tac)
-
-let define_prim2 name r0 r1 f =
-  let tac x y = lift (f (Value.repr_to r0 x) (Value.repr_to r1 y)) in
-  Tac2env.define_primitive (pname name) (mk_closure (arity_suc arity_one) tac)
-
-let define_prim3 name r0 r1 r2 f =
-  let tac x y z = lift (f (Value.repr_to r0 x) (Value.repr_to r1 y) (Value.repr_to r2 z)) in
-  Tac2env.define_primitive (pname name) (mk_closure (arity_suc (arity_suc arity_one)) tac)
-
-let define_prim4 name r0 r1 r2 r3 f =
-  let tac x y z u = lift (f (Value.repr_to r0 x) (Value.repr_to r1 y) (Value.repr_to r2 z) (Value.repr_to r3 u)) in
-  Tac2env.define_primitive (pname name) (mk_closure (arity_suc (arity_suc (arity_suc arity_one))) tac)
-
-let define_prim5 name r0 r1 r2 r3 r4 f =
-  let tac x y z u v = lift (f (Value.repr_to r0 x) (Value.repr_to r1 y) (Value.repr_to r2 z) (Value.repr_to r3 u) (Value.repr_to r4 v)) in
-  Tac2env.define_primitive (pname name) (mk_closure (arity_suc (arity_suc (arity_suc (arity_suc arity_one)))) tac)
-
-(** Tactics from Tacexpr *)
-
-let () = define_prim2 "tac_intros" bool intro_patterns begin fun ev ipat ->
-  Tac2tactics.intros_patterns ev ipat
-end
-
-let () = define_prim4 "tac_apply" bool bool (list (thunk constr_with_bindings)) (option (pair ident (option intro_pattern))) begin fun adv ev cb ipat ->
-  Tac2tactics.apply adv ev cb ipat
-end
-
-let () = define_prim3 "tac_elim" bool constr_with_bindings (option constr_with_bindings) begin fun ev c copt ->
-  Tac2tactics.elim ev c copt
-end
-
-let () = define_prim2 "tac_case" bool constr_with_bindings begin fun ev c ->
-  Tac2tactics.general_case_analysis ev c
-end
-
-let () = define_prim1 "tac_generalize" (list generalize_arg) begin fun cl ->
-  Tac2tactics.generalize cl
-end
-
-let () = define_prim1 "tac_assert" assertion begin fun ast ->
-  Tac2tactics.assert_ ast
-end
-
-let () = define_prim3 "tac_enough" constr (option (option (thunk unit))) (option intro_pattern) begin fun c tac ipat ->
-  let tac = Option.map (fun o -> Option.map (fun f -> thaw unit f) o) tac in
-  Tac2tactics.forward false tac ipat c
-end
-
-let () = define_prim2 "tac_pose" name constr begin fun na c ->
-  Tactics.letin_tac None na c None Locusops.nowhere
-end
-
-let () = define_prim3 "tac_set" bool (thunk (pair name constr)) clause begin fun ev p cl ->
-  Proofview.tclEVARMAP >>= fun sigma ->
-  thaw (pair name constr) p >>= fun (na, c) ->
-  Tac2tactics.letin_pat_tac ev None na (sigma, c) cl
-end
-
-let () = define_prim5 "tac_remember" bool name (thunk constr) (option intro_pattern) clause begin fun ev na c eqpat cl ->
-  let eqpat = Option.default (IntroNaming IntroAnonymous) eqpat in
-  match eqpat with
-  | IntroNaming eqpat ->
-    Proofview.tclEVARMAP >>= fun sigma ->
-    thaw constr c >>= fun c ->
-    Tac2tactics.letin_pat_tac ev (Some (true, eqpat)) na (sigma, c) cl
-  | _ ->
-    Tacticals.New.tclZEROMSG (Pp.str "Invalid pattern for remember")
-end
-
-let () = define_prim3 "tac_destruct" bool (list induction_clause) (option constr_with_bindings) begin fun ev ic using ->
-  Tac2tactics.induction_destruct false ev ic using
-end
-
-let () = define_prim3 "tac_induction" bool (list induction_clause) (option constr_with_bindings) begin fun ev ic using ->
-  Tac2tactics.induction_destruct true ev ic using
-end
-
-let () = define_prim1 "tac_red" clause begin fun cl ->
-  Tac2tactics.reduce (Red false) cl
-end
-
-let () = define_prim1 "tac_hnf" clause begin fun cl ->
-  Tac2tactics.reduce Hnf cl
-end
-
-let () = define_prim3 "tac_simpl" red_flags (option pattern_with_occs) clause begin fun flags where cl ->
-  Tac2tactics.simpl flags where cl
-end
-
-let () = define_prim2 "tac_cbv" red_flags clause begin fun flags cl ->
-  Tac2tactics.cbv flags cl
-end
-
-let () = define_prim2 "tac_cbn" red_flags clause begin fun flags cl ->
-  Tac2tactics.cbn flags cl
-end
-
-let () = define_prim2 "tac_lazy" red_flags clause begin fun flags cl ->
-  Tac2tactics.lazy_ flags cl
-end
-
-let () = define_prim2 "tac_unfold" (list reference_with_occs) clause begin fun refs cl ->
-  Tac2tactics.unfold refs cl
-end
-
-let () = define_prim2 "tac_fold" (list constr) clause begin fun args cl ->
-  Tac2tactics.reduce (Fold args) cl
-end
-
-let () = define_prim2 "tac_pattern" (list constr_with_occs) clause begin fun where cl ->
-  Tac2tactics.pattern where cl
-end
-
-let () = define_prim2 "tac_vm" (option pattern_with_occs) clause begin fun where cl ->
-  Tac2tactics.vm where cl
-end
-
-let () = define_prim2 "tac_native" (option pattern_with_occs) clause begin fun where cl ->
-  Tac2tactics.native where cl
-end
-
-(** Reduction functions *)
-
-let lift tac = tac >>= fun c -> Proofview.tclUNIT (Value.of_constr c)
-
-let define_red1 name r0 f =
-  let tac x = lift (f (Value.repr_to r0 x)) in
-  Tac2env.define_primitive (pname name) (mk_closure arity_one tac)
-
-let define_red2 name r0 r1 f =
-  let tac x y = lift (f (Value.repr_to r0 x) (Value.repr_to r1 y)) in
-  Tac2env.define_primitive (pname name) (mk_closure (arity_suc arity_one) tac)
-
-let define_red3 name r0 r1 r2 f =
-  let tac x y z = lift (f (Value.repr_to r0 x) (Value.repr_to r1 y) (Value.repr_to r2 z)) in
-  Tac2env.define_primitive (pname name) (mk_closure (arity_suc (arity_suc arity_one)) tac)
-
-let () = define_red1 "eval_red" constr begin fun c ->
-  Tac2tactics.eval_red c
-end
-
-let () = define_red1 "eval_hnf" constr begin fun c ->
-  Tac2tactics.eval_hnf c
-end
-
-let () = define_red3 "eval_simpl" red_flags (option pattern_with_occs) constr begin fun flags where c ->
-  Tac2tactics.eval_simpl flags where c
-end
-
-let () = define_red2 "eval_cbv" red_flags constr begin fun flags c ->
-  Tac2tactics.eval_cbv flags c
-end
-
-let () = define_red2 "eval_cbn" red_flags constr begin fun flags c ->
-  Tac2tactics.eval_cbn flags c
-end
-
-let () = define_red2 "eval_lazy" red_flags constr begin fun flags c ->
-  Tac2tactics.eval_lazy flags c
-end
-
-let () = define_red2 "eval_unfold" (list reference_with_occs) constr begin fun refs c ->
-  Tac2tactics.eval_unfold refs c
-end
-
-let () = define_red2 "eval_fold" (list constr) constr begin fun args c ->
-  Tac2tactics.eval_fold args c
-end
-
-let () = define_red2 "eval_pattern" (list constr_with_occs) constr begin fun where c ->
-  Tac2tactics.eval_pattern where c
-end
-
-let () = define_red2 "eval_vm" (option pattern_with_occs) constr begin fun where c ->
-  Tac2tactics.eval_vm where c
-end
-
-let () = define_red2 "eval_native" (option pattern_with_occs) constr begin fun where c ->
-  Tac2tactics.eval_native where c
-end
-
-let () = define_prim3 "tac_change" (option pattern) (fun1 (array constr) constr) clause begin fun pat c cl ->
-  Tac2tactics.change pat c cl
-end
-
-let () = define_prim4 "tac_rewrite" bool (list rewriting) clause (option (thunk unit)) begin fun ev rw cl by ->
-  Tac2tactics.rewrite ev rw cl by
-end
-
-let () = define_prim4 "tac_inversion" inversion_kind destruction_arg (option intro_pattern) (option (list ident)) begin fun knd arg pat ids ->
-  Tac2tactics.inversion knd arg pat ids
-end
-
-(** Tactics from coretactics *)
-
-let () = define_prim0 "tac_reflexivity" Tactics.intros_reflexivity
-
-let () = define_prim2 "tac_move" ident move_location begin fun id mv ->
-  Tactics.move_hyp id mv
-end
-
-let () = define_prim2 "tac_intro" (option ident) (option move_location) begin fun id mv ->
-  let mv = Option.default Logic.MoveLast mv in
-  Tactics.intro_move id mv
-end
-
-(*
-
-TACTIC EXTEND exact
-  [ "exact" casted_constr(c) ] -> [ Tactics.exact_no_check c ]
-END
-
-*)
-
-let () = define_prim0 "tac_assumption" Tactics.assumption
-
-let () = define_prim1 "tac_transitivity" constr begin fun c ->
-  Tactics.intros_transitivity (Some c)
-end
-
-let () = define_prim0 "tac_etransitivity" (Tactics.intros_transitivity None)
-
-let () = define_prim1 "tac_cut" constr begin fun c ->
-  Tactics.cut c
-end
-
-let () = define_prim2 "tac_left" bool bindings begin fun ev bnd ->
-  Tac2tactics.left_with_bindings ev bnd
-end
-let () = define_prim2 "tac_right" bool bindings begin fun ev bnd ->
-  Tac2tactics.right_with_bindings ev bnd
-end
-
-let () = define_prim1 "tac_introsuntil" qhyp begin fun h ->
-  Tactics.intros_until h
-end
-
-let () = define_prim1 "tac_exactnocheck" constr begin fun c ->
-  Tactics.exact_no_check c
-end
-
-let () = define_prim1 "tac_vmcastnocheck" constr begin fun c ->
-  Tactics.vm_cast_no_check c
-end
-
-let () = define_prim1 "tac_nativecastnocheck" constr begin fun c ->
-  Tactics.native_cast_no_check c
-end
-
-let () = define_prim1 "tac_constructor" bool begin fun ev ->
-  Tactics.any_constructor ev None
-end
-
-let () = define_prim3 "tac_constructorn" bool int bindings begin fun ev n bnd ->
-  Tac2tactics.constructor_tac ev None n bnd
-end
-
-let () = define_prim2 "tac_specialize" constr_with_bindings (option intro_pattern) begin fun c ipat ->
-  Tac2tactics.specialize c ipat
-end
-
-let () = define_prim1 "tac_symmetry" clause begin fun cl ->
-  Tac2tactics.symmetry cl
-end
-
-let () = define_prim2 "tac_split" bool bindings begin fun ev bnd ->
-  Tac2tactics.split_with_bindings ev bnd
-end
-
-let () = define_prim1 "tac_rename" (list (pair ident ident)) begin fun ids ->
-  Tactics.rename_hyp ids
-end
-
-let () = define_prim1 "tac_revert" (list ident) begin fun ids ->
-  Tactics.revert ids
-end
-
-let () = define_prim0 "tac_admit" Proofview.give_up
-
-let () = define_prim2 "tac_fix" ident int begin fun ident n ->
-  Tactics.fix ident n
-end
-
-let () = define_prim1 "tac_cofix" ident begin fun ident ->
-  Tactics.cofix ident
-end
-
-let () = define_prim1 "tac_clear" (list ident) begin fun ids ->
-  Tactics.clear ids
-end
-
-let () = define_prim1 "tac_keep" (list ident) begin fun ids ->
-  Tactics.keep ids
-end
-
-let () = define_prim1 "tac_clearbody" (list ident) begin fun ids ->
-  Tactics.clear_body ids
-end
-
-(** Tactics from extratactics *)
-
-let () = define_prim2 "tac_discriminate" bool (option destruction_arg) begin fun ev arg ->
-  Tac2tactics.discriminate ev arg
-end
-
-let () = define_prim3 "tac_injection" bool (option intro_patterns) (option destruction_arg) begin fun ev ipat arg ->
-  Tac2tactics.injection ev ipat arg
-end
-
-let () = define_prim1 "tac_absurd" constr begin fun c ->
-  Contradiction.absurd c
-end
-
-let () = define_prim1 "tac_contradiction" (option constr_with_bindings) begin fun c ->
-  Tac2tactics.contradiction c
-end
-
-let () = define_prim4 "tac_autorewrite" bool (option (thunk unit)) (list ident) clause begin fun all by ids cl ->
-  Tac2tactics.autorewrite ~all by ids cl
-end
-
-let () = define_prim1 "tac_subst" (list ident) begin fun ids ->
-  Equality.subst ids
-end
-
-let () = define_prim0 "tac_substall" (return () >>= fun () -> Equality.subst_all ())
-
-(** Auto *)
-
-let () = define_prim3 "tac_trivial" debug (list (thunk constr)) (option (list ident)) begin fun dbg lems dbs ->
-  Tac2tactics.trivial dbg lems dbs
-end
-
-let () = define_prim5 "tac_eauto" debug (option int) (option int) (list (thunk constr)) (option (list ident)) begin fun dbg n p lems dbs ->
-  Tac2tactics.eauto dbg n p lems dbs
-end
-
-let () = define_prim4 "tac_auto" debug (option int) (list (thunk constr)) (option (list ident)) begin fun dbg n lems dbs ->
-  Tac2tactics.auto dbg n lems dbs
-end
-
-let () = define_prim4 "tac_newauto" debug (option int) (list (thunk constr)) (option (list ident)) begin fun dbg n lems dbs ->
-  Tac2tactics.new_auto dbg n lems dbs
-end
-
-let () = define_prim3 "tac_typeclasses_eauto" (option strategy) (option int) (option (list ident)) begin fun str n dbs ->
-  Tac2tactics.typeclasses_eauto str n dbs
-end
-
-(** Firstorder *)
-
-let () = define_prim3 "tac_firstorder" (option (thunk unit)) (list reference) (list ident) begin fun tac refs ids ->
-  Tac2tactics.firstorder tac refs ids
-end
diff --git a/src/tac2stdlib.mli b/src/tac2stdlib.mli
deleted file mode 100644
index 927b57074d..0000000000
--- a/src/tac2stdlib.mli
+++ /dev/null
@@ -1,9 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Standard tactics sharing their implementation with Ltac1 *)
diff --git a/src/tac2tactics.ml b/src/tac2tactics.ml
deleted file mode 100644
index ce37a613b1..0000000000
--- a/src/tac2tactics.ml
+++ /dev/null
@@ -1,455 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Pp
-open Util
-open Names
-open Globnames
-open Tac2types
-open Tac2extffi
-open Genredexpr
-open Proofview.Notations
-
-let return = Proofview.tclUNIT
-let thaw r f = Tac2ffi.app_fun1 f Tac2ffi.unit r ()
-
-let tactic_infer_flags with_evar = {
-  Pretyping.use_typeclasses = true;
-  Pretyping.solve_unification_constraints = true;
-  Pretyping.fail_evar = not with_evar;
-  Pretyping.expand_evars = true;
-  Pretyping.program_mode = false;
-  Pretyping.polymorphic = false;
-}
-
-(** FIXME: export a better interface in Tactics *)
-let delayed_of_tactic tac env sigma =
-  let _, pv = Proofview.init sigma [] in
-  let name, poly = Id.of_string "ltac2_delayed", false in
-  let c, pv, _, _ = Proofview.apply ~name ~poly env tac pv in
-  (sigma, c)
-
-let delayed_of_thunk r tac env sigma =
-  delayed_of_tactic (thaw r tac) env sigma
-
-let mk_bindings = function
-| ImplicitBindings l -> Tactypes.ImplicitBindings l
-| ExplicitBindings l ->
-  let l = List.map CAst.make l in
-  Tactypes.ExplicitBindings l
-| NoBindings -> Tactypes.NoBindings
-
-let mk_with_bindings (x, b) = (x, mk_bindings b)
-
-let rec mk_intro_pattern = function
-| IntroForthcoming b -> CAst.make @@ Tactypes.IntroForthcoming b
-| IntroNaming ipat -> CAst.make @@ Tactypes.IntroNaming (mk_intro_pattern_naming ipat)
-| IntroAction ipat -> CAst.make @@ Tactypes.IntroAction (mk_intro_pattern_action ipat)
-
-and mk_intro_pattern_naming = function
-| IntroIdentifier id -> Namegen.IntroIdentifier id
-| IntroFresh id -> Namegen.IntroFresh id
-| IntroAnonymous -> Namegen.IntroAnonymous
-
-and mk_intro_pattern_action = function
-| IntroWildcard -> Tactypes.IntroWildcard
-| IntroOrAndPattern ipat -> Tactypes.IntroOrAndPattern (mk_or_and_intro_pattern ipat)
-| IntroInjection ipats -> Tactypes.IntroInjection (List.map mk_intro_pattern ipats)
-| IntroApplyOn (c, ipat) ->
-  let c = CAst.make @@ delayed_of_thunk Tac2ffi.constr c in
-  Tactypes.IntroApplyOn (c, mk_intro_pattern ipat)
-| IntroRewrite b -> Tactypes.IntroRewrite b
-
-and mk_or_and_intro_pattern = function
-| IntroOrPattern ipatss ->
-  Tactypes.IntroOrPattern (List.map (fun ipat -> List.map mk_intro_pattern ipat) ipatss)
-| IntroAndPattern ipats ->
-  Tactypes.IntroAndPattern (List.map mk_intro_pattern ipats)
-
-let mk_intro_patterns ipat = List.map mk_intro_pattern ipat
-
-let mk_occurrences f = function
-| AllOccurrences -> Locus.AllOccurrences
-| AllOccurrencesBut l -> Locus.AllOccurrencesBut (List.map f l)
-| NoOccurrences -> Locus.NoOccurrences
-| OnlyOccurrences l -> Locus.OnlyOccurrences (List.map f l)
-
-let mk_occurrences_expr occ =
-  mk_occurrences (fun i -> Locus.ArgArg i) occ
-
-let mk_hyp_location (id, occs, h) =
-  ((mk_occurrences_expr occs, id), h)
-
-let mk_clause cl = {
-  Locus.onhyps = Option.map (fun l -> List.map mk_hyp_location l) cl.onhyps;
-  Locus.concl_occs = mk_occurrences_expr cl.concl_occs;
-}
-
-let intros_patterns ev ipat =
-  let ipat = mk_intro_patterns ipat in
-  Tactics.intros_patterns ev ipat
-
-let apply adv ev cb cl =
-  let map c =
-    let c = thaw constr_with_bindings c >>= fun p -> return (mk_with_bindings p) in
-    None, CAst.make (delayed_of_tactic c)
-  in
-  let cb = List.map map cb in
-  match cl with
-  | None -> Tactics.apply_with_delayed_bindings_gen adv ev cb
-  | Some (id, cl) ->
-    let cl = Option.map mk_intro_pattern cl in
-    Tactics.apply_delayed_in adv ev id cb cl
-
-let mk_destruction_arg = function
-| ElimOnConstr c ->
-  let c = c >>= fun c -> return (mk_with_bindings c) in
-  Tactics.ElimOnConstr (delayed_of_tactic c)
-| ElimOnIdent id -> Tactics.ElimOnIdent CAst.(make id)
-| ElimOnAnonHyp n -> Tactics.ElimOnAnonHyp n
-
-let mk_induction_clause (arg, eqn, as_, occ) =
-  let eqn = Option.map (fun ipat -> CAst.make @@ mk_intro_pattern_naming ipat) eqn in
-  let as_ = Option.map (fun ipat -> CAst.make @@ mk_or_and_intro_pattern ipat) as_ in
-  let occ = Option.map mk_clause occ in
-  ((None, mk_destruction_arg arg), (eqn, as_), occ)
-
-let induction_destruct isrec ev (ic : induction_clause list) using =
-  let ic = List.map mk_induction_clause ic in
-  let using = Option.map mk_with_bindings using in
-  Tactics.induction_destruct isrec ev (ic, using)
-
-let elim ev c copt =
-  let c = mk_with_bindings c in
-  let copt = Option.map mk_with_bindings copt in
-  Tactics.elim ev None c copt
-
-let generalize pl =
-  let mk_occ occs = mk_occurrences (fun i -> i) occs in
-  let pl = List.map (fun (c, occs, na) -> (mk_occ occs, c), na) pl in
-  Tactics.new_generalize_gen pl
-
-let general_case_analysis ev c =
-  let c = mk_with_bindings c in
-  Tactics.general_case_analysis ev None c
-
-let constructor_tac ev n i bnd =
-  let bnd = mk_bindings bnd in
-  Tactics.constructor_tac ev n i bnd
-
-let left_with_bindings ev bnd =
-  let bnd = mk_bindings bnd in
-  Tactics.left_with_bindings ev bnd
-
-let right_with_bindings ev bnd =
-  let bnd = mk_bindings bnd in
-  Tactics.right_with_bindings ev bnd
-
-let split_with_bindings ev bnd =
-  let bnd = mk_bindings bnd in
-  Tactics.split_with_bindings ev [bnd]
-
-let specialize c pat =
-  let c = mk_with_bindings c in
-  let pat = Option.map mk_intro_pattern pat in
-  Tactics.specialize c pat
-
-let change pat c cl =
-  let open Tac2ffi in
-  Proofview.Goal.enter begin fun gl ->
-  let c subst env sigma =
-    let subst = Array.map_of_list snd (Id.Map.bindings subst) in
-    delayed_of_tactic (Tac2ffi.app_fun1 c (array constr) constr subst) env sigma
-  in
-  let cl = mk_clause cl in
-  Tactics.change pat c cl
-  end
-
-let rewrite ev rw cl by =
-  let map_rw (orient, repeat, c) =
-    let c = c >>= fun c -> return (mk_with_bindings c) in
-    (Option.default true orient, repeat, None, delayed_of_tactic c)
-  in
-  let rw = List.map map_rw rw in
-  let cl = mk_clause cl in
-  let by = Option.map (fun tac -> Tacticals.New.tclCOMPLETE (thaw Tac2ffi.unit tac), Equality.Naive) by in
-  Equality.general_multi_rewrite ev rw cl by
-
-let symmetry cl =
-  let cl = mk_clause cl in
-  Tactics.intros_symmetry cl
-
-let forward fst tac ipat c =
-  let ipat = Option.map mk_intro_pattern ipat in
-  Tactics.forward fst tac ipat c
-
-let assert_ = function
-| AssertValue (id, c) ->
-  let ipat = CAst.make @@ Tactypes.IntroNaming (Namegen.IntroIdentifier id) in
-  Tactics.forward true None (Some ipat) c
-| AssertType (ipat, c, tac) ->
-  let ipat = Option.map mk_intro_pattern ipat in
-  let tac = Option.map (fun tac -> thaw Tac2ffi.unit tac) tac in
-  Tactics.forward true (Some tac) ipat c
-
-let letin_pat_tac ev ipat na c cl =
-  let ipat = Option.map (fun (b, ipat) -> (b, CAst.make @@ mk_intro_pattern_naming ipat)) ipat in
-  let cl = mk_clause cl in
-  Tactics.letin_pat_tac ev ipat na c cl
-
-(** Ltac interface treats differently global references than other term
-    arguments in reduction expressions. In Ltac1, this is done at parsing time.
-    Instead, we parse indifferently any pattern and dispatch when the tactic is
-    called. *)
-let map_pattern_with_occs (pat, occ) = match pat with
-| Pattern.PRef (ConstRef cst) -> (mk_occurrences_expr occ, Inl (EvalConstRef cst))
-| Pattern.PRef (VarRef id) -> (mk_occurrences_expr occ, Inl (EvalVarRef id))
-| _ -> (mk_occurrences_expr occ, Inr pat)
-
-let get_evaluable_reference = function
-| VarRef id -> Proofview.tclUNIT (EvalVarRef id)
-| ConstRef cst -> Proofview.tclUNIT (EvalConstRef cst)
-| r ->
-  Tacticals.New.tclZEROMSG (str "Cannot coerce" ++ spc () ++
-    Nametab.pr_global_env Id.Set.empty r ++ spc () ++
-    str "to an evaluable reference.")
-
-let reduce r cl =
-  let cl = mk_clause cl in
-  Tactics.reduce r cl
-
-let simpl flags where cl =
-  let where = Option.map map_pattern_with_occs where in
-  let cl = mk_clause cl in
-  Proofview.Monad.List.map get_evaluable_reference flags.rConst >>= fun rConst ->
-  let flags = { flags with rConst } in
-  Tactics.reduce (Simpl (flags, where)) cl
-
-let cbv flags cl =
-  let cl = mk_clause cl in
-  Proofview.Monad.List.map get_evaluable_reference flags.rConst >>= fun rConst ->
-  let flags = { flags with rConst } in
-  Tactics.reduce (Cbv flags) cl
-
-let cbn flags cl =
-  let cl = mk_clause cl in
-  Proofview.Monad.List.map get_evaluable_reference flags.rConst >>= fun rConst ->
-  let flags = { flags with rConst } in
-  Tactics.reduce (Cbn flags) cl
-
-let lazy_ flags cl =
-  let cl = mk_clause cl in
-  Proofview.Monad.List.map get_evaluable_reference flags.rConst >>= fun rConst ->
-  let flags = { flags with rConst } in
-  Tactics.reduce (Lazy flags) cl
-
-let unfold occs cl =
-  let cl = mk_clause cl in
-  let map (gr, occ) =
-    let occ = mk_occurrences_expr occ in
-    get_evaluable_reference gr >>= fun gr -> Proofview.tclUNIT (occ, gr)
-  in
-  Proofview.Monad.List.map map occs >>= fun occs ->
-  Tactics.reduce (Unfold occs) cl
-
-let pattern where cl =
-  let where = List.map (fun (c, occ) -> (mk_occurrences_expr occ, c)) where in
-  let cl = mk_clause cl in
-  Tactics.reduce (Pattern where) cl
-
-let vm where cl =
-  let where = Option.map map_pattern_with_occs where in
-  let cl = mk_clause cl in
-  Tactics.reduce (CbvVm where) cl
-
-let native where cl =
-  let where = Option.map map_pattern_with_occs where in
-  let cl = mk_clause cl in
-  Tactics.reduce (CbvNative where) cl
-
-let eval_fun red c =
-  Tac2core.pf_apply begin fun env sigma ->
-  let (redfun, _) = Redexpr.reduction_of_red_expr env red in
-  let (sigma, ans) = redfun env sigma c in
-  Proofview.Unsafe.tclEVARS sigma >>= fun () ->
-  Proofview.tclUNIT ans
-  end
-
-let eval_red c =
-  eval_fun (Red false) c
-
-let eval_hnf c =
-  eval_fun Hnf c
-
-let eval_simpl flags where c =
-  let where = Option.map map_pattern_with_occs where in
-  Proofview.Monad.List.map get_evaluable_reference flags.rConst >>= fun rConst ->
-  let flags = { flags with rConst } in
-  eval_fun (Simpl (flags, where)) c
-
-let eval_cbv flags c =
-  Proofview.Monad.List.map get_evaluable_reference flags.rConst >>= fun rConst ->
-  let flags = { flags with rConst } in
-  eval_fun (Cbv flags) c
-
-let eval_cbn flags c =
-  Proofview.Monad.List.map get_evaluable_reference flags.rConst >>= fun rConst ->
-  let flags = { flags with rConst } in
-  eval_fun (Cbn flags) c
-
-let eval_lazy flags c =
-  Proofview.Monad.List.map get_evaluable_reference flags.rConst >>= fun rConst ->
-  let flags = { flags with rConst } in
-  eval_fun (Lazy flags) c
-
-let eval_unfold occs c =
-  let map (gr, occ) =
-    let occ = mk_occurrences_expr occ in
-    get_evaluable_reference gr >>= fun gr -> Proofview.tclUNIT (occ, gr)
-  in
-  Proofview.Monad.List.map map occs >>= fun occs ->
-  eval_fun (Unfold occs) c
-
-let eval_fold cl c =
-  eval_fun (Fold cl) c
-
-let eval_pattern where c =
-  let where = List.map (fun (pat, occ) -> (mk_occurrences_expr occ, pat)) where in
-  eval_fun (Pattern where) c
-
-let eval_vm where c =
-  let where = Option.map map_pattern_with_occs where in
-  eval_fun (CbvVm where) c
-
-let eval_native where c =
-  let where = Option.map map_pattern_with_occs where in
-  eval_fun (CbvNative where) c
-
-let on_destruction_arg tac ev arg =
-  Proofview.Goal.enter begin fun gl ->
-  match arg with
-  | None -> tac ev None
-  | Some (clear, arg) ->
-    let arg = match arg with
-    | ElimOnConstr c ->
-      let env = Proofview.Goal.env gl in
-      Proofview.tclEVARMAP >>= fun sigma ->
-      c >>= fun (c, lbind) ->
-      let lbind = mk_bindings lbind in
-      Proofview.tclEVARMAP >>= fun sigma' ->
-      let flags = tactic_infer_flags ev in
-      let (sigma', c) = Unification.finish_evar_resolution ~flags env sigma' (sigma, c) in
-      Proofview.tclUNIT (Some sigma', Tactics.ElimOnConstr (c, lbind))
-    | ElimOnIdent id -> Proofview.tclUNIT (None, Tactics.ElimOnIdent CAst.(make id))
-    | ElimOnAnonHyp n -> Proofview.tclUNIT (None, Tactics.ElimOnAnonHyp n)
-    in
-    arg >>= fun (sigma', arg) ->
-    let arg = Some (clear, arg) in
-    match sigma' with
-    | None -> tac ev arg
-    | Some sigma' ->
-      Tacticals.New.tclWITHHOLES ev (tac ev arg) sigma'
-  end
-
-let discriminate ev arg =
-  let arg = Option.map (fun arg -> None, arg) arg in
-  on_destruction_arg Equality.discr_tac ev arg
-
-let injection ev ipat arg =
-  let arg = Option.map (fun arg -> None, arg) arg in
-  let ipat = Option.map mk_intro_patterns ipat in
-  let tac ev arg = Equality.injClause None ipat ev arg in
-  on_destruction_arg tac ev arg
-
-let autorewrite ~all by ids cl =
-  let conds = if all then Some Equality.AllMatches else None in
-  let ids = List.map Id.to_string ids in
-  let cl = mk_clause cl in
-  match by with
-  | None -> Autorewrite.auto_multi_rewrite ?conds ids cl
-  | Some by ->
-    let by = thaw Tac2ffi.unit by in
-    Autorewrite.auto_multi_rewrite_with ?conds by ids cl
-
-(** Auto *)
-
-let trivial debug lems dbs =
-  let lems = List.map (fun c -> delayed_of_thunk Tac2ffi.constr c) lems in
-  let dbs = Option.map (fun l -> List.map Id.to_string l) dbs in
-  Auto.h_trivial ~debug lems dbs
-
-let auto debug n lems dbs =
-  let lems = List.map (fun c -> delayed_of_thunk Tac2ffi.constr c) lems in
-  let dbs = Option.map (fun l -> List.map Id.to_string l) dbs in
-  Auto.h_auto ~debug n lems dbs
-
-let new_auto debug n lems dbs =
-  let make_depth n = snd (Eauto.make_dimension n None) in
-  let lems = List.map (fun c -> delayed_of_thunk Tac2ffi.constr c) lems in
-  match dbs with
-  | None -> Auto.new_full_auto ~debug (make_depth n) lems
-  | Some dbs ->
-    let dbs = List.map Id.to_string dbs in
-    Auto.new_auto ~debug (make_depth n) lems dbs
-
-let eauto debug n p lems dbs =
-  let lems = List.map (fun c -> delayed_of_thunk Tac2ffi.constr c) lems in
-  let dbs = Option.map (fun l -> List.map Id.to_string l) dbs in
-  Eauto.gen_eauto (Eauto.make_dimension n p) lems dbs
-
-let typeclasses_eauto strategy depth dbs =
-  let only_classes, dbs = match dbs with
-  | None ->
-    true, [Class_tactics.typeclasses_db]
-  | Some dbs ->
-    let dbs = List.map Id.to_string dbs in
-    false, dbs
-  in
-  Class_tactics.typeclasses_eauto ~only_classes ?strategy ~depth dbs
-
-(** Inversion *)
-
-let inversion knd arg pat ids =
-  let ids = match ids with
-  | None -> []
-  | Some l -> l
-  in
-  begin match pat with
-  | None -> Proofview.tclUNIT None
-  | Some (IntroAction (IntroOrAndPattern p)) ->
-    Proofview.tclUNIT (Some (CAst.make @@ mk_or_and_intro_pattern p))
-  | Some _ ->
-    Tacticals.New.tclZEROMSG (str "Inversion only accept disjunctive patterns")
-  end >>= fun pat ->
-  let inversion _ arg =
-    begin match arg with
-    | None -> assert false
-    | Some (_, Tactics.ElimOnAnonHyp n) ->
-      Inv.inv_clause knd pat ids (AnonHyp n)
-    | Some (_, Tactics.ElimOnIdent {CAst.v=id}) ->
-      Inv.inv_clause knd pat ids (NamedHyp id)
-    | Some (_, Tactics.ElimOnConstr c) ->
-      let open Tactypes in
-      let anon = CAst.make @@ IntroNaming Namegen.IntroAnonymous in
-      Tactics.specialize c (Some anon) >>= fun () ->
-      Tacticals.New.onLastHypId (fun id -> Inv.inv_clause knd pat ids (NamedHyp id))
-    end
-  in
-  on_destruction_arg inversion true (Some (None, arg))
-
-let contradiction c =
-  let c = Option.map mk_with_bindings c in
-  Contradiction.contradiction c
-
-(** Firstorder *)
-
-let firstorder tac refs ids =
-  let open Ground_plugin in
-  let ids = List.map Id.to_string ids in
-  let tac = Option.map (fun tac -> thaw Tac2ffi.unit tac) tac in
-  G_ground.gen_ground_tac true tac refs ids
diff --git a/src/tac2tactics.mli b/src/tac2tactics.mli
deleted file mode 100644
index 026673acbf..0000000000
--- a/src/tac2tactics.mli
+++ /dev/null
@@ -1,124 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Tac2expr
-open EConstr
-open Genredexpr
-open Tac2types
-open Proofview
-
-(** Local reimplementations of tactics variants from Coq *)
-
-val intros_patterns : evars_flag -> intro_pattern list -> unit tactic
-
-val apply : advanced_flag -> evars_flag ->
-  constr_with_bindings thunk list ->
-  (Id.t * intro_pattern option) option -> unit tactic
-
-val induction_destruct : rec_flag -> evars_flag ->
-  induction_clause list -> constr_with_bindings option -> unit tactic
-
-val elim : evars_flag -> constr_with_bindings -> constr_with_bindings option ->
-  unit tactic
-
-val general_case_analysis : evars_flag -> constr_with_bindings ->  unit tactic
-
-val generalize : (constr * occurrences * Name.t) list -> unit tactic
-
-val constructor_tac : evars_flag -> int option -> int -> bindings -> unit tactic
-
-val left_with_bindings  : evars_flag -> bindings -> unit tactic
-val right_with_bindings : evars_flag -> bindings -> unit tactic
-val split_with_bindings : evars_flag -> bindings -> unit tactic
-
-val specialize : constr_with_bindings -> intro_pattern option -> unit tactic
-
-val change : Pattern.constr_pattern option -> (constr array, constr) Tac2ffi.fun1 -> clause -> unit tactic
-
-val rewrite :
-  evars_flag -> rewriting list -> clause -> unit thunk option -> unit tactic
-
-val symmetry : clause -> unit tactic
-
-val forward : bool -> unit tactic option option ->
-  intro_pattern option -> constr -> unit tactic
-
-val assert_ : assertion -> unit tactic
-
-val letin_pat_tac : evars_flag -> (bool * intro_pattern_naming) option ->
-  Name.t -> (Evd.evar_map * constr) -> clause -> unit tactic
-
-val reduce : Redexpr.red_expr -> clause -> unit tactic
-
-val simpl : GlobRef.t glob_red_flag ->
-  (Pattern.constr_pattern * occurrences) option -> clause -> unit tactic
-
-val cbv : GlobRef.t glob_red_flag -> clause -> unit tactic
-
-val cbn : GlobRef.t glob_red_flag -> clause -> unit tactic
-
-val lazy_ : GlobRef.t glob_red_flag -> clause -> unit tactic
-
-val unfold : (GlobRef.t * occurrences) list -> clause -> unit tactic
-
-val pattern : (constr * occurrences) list -> clause -> unit tactic
-
-val vm : (Pattern.constr_pattern * occurrences) option -> clause -> unit tactic
-
-val native : (Pattern.constr_pattern * occurrences) option -> clause -> unit tactic
-
-val eval_red : constr -> constr tactic
-
-val eval_hnf : constr -> constr tactic
-
-val eval_simpl : GlobRef.t glob_red_flag ->
-  (Pattern.constr_pattern * occurrences) option -> constr -> constr tactic
-
-val eval_cbv : GlobRef.t glob_red_flag -> constr -> constr tactic
-
-val eval_cbn : GlobRef.t glob_red_flag -> constr -> constr tactic
-
-val eval_lazy : GlobRef.t glob_red_flag -> constr -> constr tactic
-
-val eval_unfold : (GlobRef.t * occurrences) list -> constr -> constr tactic
-
-val eval_fold : constr list -> constr -> constr tactic
-
-val eval_pattern : (EConstr.t * occurrences) list -> constr -> constr tactic
-
-val eval_vm : (Pattern.constr_pattern * occurrences) option -> constr -> constr tactic
-
-val eval_native : (Pattern.constr_pattern * occurrences) option -> constr -> constr tactic
-
-val discriminate : evars_flag -> destruction_arg option -> unit tactic
-
-val injection : evars_flag -> intro_pattern list option -> destruction_arg option -> unit tactic
-
-val autorewrite : all:bool -> unit thunk option -> Id.t list -> clause -> unit tactic
-
-val trivial : Hints.debug -> constr thunk list -> Id.t list option ->
-  unit Proofview.tactic
-
-val auto : Hints.debug -> int option -> constr thunk list ->
-  Id.t list option -> unit Proofview.tactic
-
-val new_auto : Hints.debug -> int option -> constr thunk list ->
-  Id.t list option -> unit Proofview.tactic
-
-val eauto : Hints.debug -> int option -> int option -> constr thunk list ->
-  Id.t list option -> unit Proofview.tactic
-
-val typeclasses_eauto : Class_tactics.search_strategy option -> int option ->
-  Id.t list option -> unit Proofview.tactic
-
-val inversion : Inv.inversion_kind -> destruction_arg -> intro_pattern option -> Id.t list option -> unit tactic
-
-val contradiction : constr_with_bindings option -> unit tactic
-
-val firstorder : unit thunk option -> GlobRef.t list -> Id.t list -> unit tactic
diff --git a/src/tac2types.mli b/src/tac2types.mli
deleted file mode 100644
index fa31153a27..0000000000
--- a/src/tac2types.mli
+++ /dev/null
@@ -1,92 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open EConstr
-open Proofview
-
-(** Redefinition of Ltac1 data structures because of impedance mismatch *)
-
-type evars_flag = bool
-type advanced_flag = bool
-
-type 'a thunk = (unit, 'a) Tac2ffi.fun1
-
-type quantified_hypothesis = Tactypes.quantified_hypothesis =
-| AnonHyp of int
-| NamedHyp of Id.t
-
-type explicit_bindings = (quantified_hypothesis * EConstr.t) list
-
-type bindings =
-| ImplicitBindings of EConstr.t list
-| ExplicitBindings of explicit_bindings
-| NoBindings
-
-type constr_with_bindings = EConstr.constr * bindings
-
-type core_destruction_arg =
-| ElimOnConstr of constr_with_bindings tactic
-| ElimOnIdent of Id.t
-| ElimOnAnonHyp of int
-
-type destruction_arg = core_destruction_arg
-
-type intro_pattern =
-| IntroForthcoming of bool
-| IntroNaming of intro_pattern_naming
-| IntroAction of intro_pattern_action
-and intro_pattern_naming =
-| IntroIdentifier of Id.t
-| IntroFresh of Id.t
-| IntroAnonymous
-and intro_pattern_action =
-| IntroWildcard
-| IntroOrAndPattern of or_and_intro_pattern
-| IntroInjection of intro_pattern list
-| IntroApplyOn of EConstr.t thunk * intro_pattern
-| IntroRewrite of bool
-and or_and_intro_pattern =
-| IntroOrPattern of intro_pattern list list
-| IntroAndPattern of intro_pattern list
-
-type occurrences =
-| AllOccurrences
-| AllOccurrencesBut of int list
-| NoOccurrences
-| OnlyOccurrences of int list
-
-type hyp_location_flag = Locus.hyp_location_flag =
-| InHyp | InHypTypeOnly | InHypValueOnly
-
-type hyp_location = Id.t * occurrences * hyp_location_flag
-
-type clause =
-  { onhyps : hyp_location list option;
-    concl_occs : occurrences }
-
-type induction_clause =
-  destruction_arg *
-  intro_pattern_naming option *
-  or_and_intro_pattern option *
-  clause option
-
-type multi = Equality.multi =
-| Precisely of int
-| UpTo of int
-| RepeatStar
-| RepeatPlus
-
-type rewriting =
-  bool option *
-  multi *
-  constr_with_bindings tactic
-
-type assertion =
-| AssertType of intro_pattern option * constr * unit thunk option
-| AssertValue of Id.t * constr