Added support for Ltac-matching terms with variables bound in the pattern

- Instances found by matching.ml now collect the set of bound
  variables they possibly depend on in the pattern (see type
  Pattern.extended_patvar_map); the variables names are canonically
  ordered so that non-linear matching takes actual names into account.
- Removed typing of matching constr instances in advance (in
  tacinterp.ml) and did it only at use time (in pretyping.ml). Drawback
  is that we may have to re-type several times the same term but it is
  necessary for considering terms with locally bound variables of which
  we do not keep the type (and if even we had kept the type, we would have
  to adjust the indices to the actual context the term occurs).
- A bit of documentation of pattern.mli, matching.mli and pretyping.mli.
- Incidentally add env while printing idtac messages. It seems more correct
  and I hope I did not break some intended existing behavior.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@13080 85f007b7-540e-0410-9357-904b9bb8a0f7

1 files changed, 21 insertions, 12 deletions

diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index 71a21f6c88..e63b9a234f 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -45,8 +45,10 @@ open Evarconv
 open Pattern
 
 type typing_constraint = OfType of types option | IsType
-type var_map = (identifier * unsafe_judgment) list
+type var_map = (identifier * constr_under_binders) list
 type unbound_ltac_var_map = (identifier * identifier option) list
+type ltac_var_map = var_map * unbound_ltac_var_map
+type rawconstr_ltac_closure = ltac_var_map * rawconstr
 
 (************************************************************************)
 (* This concerns Cases *)
@@ -131,7 +133,7 @@ sig
   *)
 
   val understand_ltac :
-    bool -> evar_map -> env -> var_map * unbound_ltac_var_map ->
+    bool -> evar_map -> env -> ltac_var_map ->
     typing_constraint -> rawconstr -> evar_map * constr
 
   (* Standard call to get a constr from a rawconstr, resolving implicit args *)
@@ -162,18 +164,15 @@ sig
    *)
   val pretype :
     type_constraint -> env -> evar_map ref ->
-    var_map * (identifier * identifier option) list ->
-    rawconstr -> unsafe_judgment
+    ltac_var_map -> rawconstr -> unsafe_judgment
 
   val pretype_type :
     val_constraint -> env -> evar_map ref ->
-    var_map * (identifier * identifier option) list ->
-    rawconstr -> unsafe_type_judgment
+    ltac_var_map -> rawconstr -> unsafe_type_judgment
 
   val pretype_gen :
     bool -> bool -> bool -> evar_map ref -> env ->
-    var_map * (identifier * identifier option) list ->
-    typing_constraint -> rawconstr -> constr
+    ltac_var_map -> typing_constraint -> rawconstr -> constr
 
     (*i*)
 end
@@ -225,7 +224,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct
   let check_branches_message loc env evdref c (explft,lft) =
     for i = 0 to Array.length explft - 1 do
       if not (e_cumul env evdref lft.(i) explft.(i)) then
-	let sigma =  !evdref in
+	let sigma = !evdref in
 	  error_ill_formed_branch_loc loc env sigma c i lft.(i) explft.(i)
     done
 
@@ -243,7 +242,14 @@ module Pretyping_F (Coercion : Coercion.S) = struct
     | Anonymous -> name'
     | _ -> name
 
-  let pretype_id loc env (lvar,unbndltacvars) id =
+  let invert_ltac_bound_name env id0 id =
+    try mkRel (pi1 (lookup_rel_id id (rel_context env)))
+    with Not_found ->
+      errorlabstrm "" (str "Ltac variable " ++ pr_id id0 ++
+	str " depends on pattern variable name " ++ pr_id id ++
+	str " which is not bound in current context.")
+
+  let pretype_id loc env sigma (lvar,unbndltacvars) id =
     (* Look for the binder of [id] *)
     try
       let (n,_,typ) = lookup_rel_id id (rel_context env) in
@@ -251,7 +257,10 @@ module Pretyping_F (Coercion : Coercion.S) = struct
     with Not_found ->
     (* Check if [id] is an ltac variable *)
     try
-      List.assoc id lvar
+      let (ids,c) = List.assoc id lvar in
+      let subst = List.map (invert_ltac_bound_name env id) ids in
+      let c = substl subst c in
+      { uj_val = c; uj_type = Retyping.get_type_of env sigma c }
     with Not_found ->
     (* Check if [id] is a section or goal variable *)
     try
@@ -295,7 +304,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 
     | RVar (loc, id) ->
 	inh_conv_coerce_to_tycon loc env evdref
-	  (pretype_id loc env lvar id)
+	  (pretype_id loc env !evdref lvar id)
 	  tycon
 
     | REvar (loc, evk, instopt) ->