diff options
| author | Hugo Herbelin | 2014-10-02 18:58:54 +0200 |
|---|---|---|
| committer | Hugo Herbelin | 2014-10-02 18:59:07 +0200 |
| commit | 0c320e79ba30bf567d4ca194bc114d733baf76e5 (patch) | |
| tree | 881b5a63de22e0078bcd27480c8157ac76190bfe | |
| parent | 2b26c3e9a011af1f77e4f4fc61c73943d2bb0dfc (diff) | |
Fixing interpretation of constr under binders which was broken after
it became possible to have binding names themselves bound to ltac
variables (2fcc458af16b).
| -rw-r--r-- | dev/top_printers.ml | 2 | ||||
| -rw-r--r-- | pretyping/pretyping.ml | 5 |
2 files changed, 4 insertions, 3 deletions
diff --git a/dev/top_printers.ml b/dev/top_printers.ml index 2cbac21753..0345ddfabc 100644 --- a/dev/top_printers.ml +++ b/dev/top_printers.ml @@ -104,7 +104,7 @@ let ppevarsubst = ppidmap (fun id0 -> prset (fun (c,copt,id) -> else spc () ++ str "<canonical: " ++ pr_id id ++ str ">")))) let ppconstrunderbindersidmap l = ppidmap (fun id (l,c) -> - Id.print id ++ str "->" ++ hov 1 (str"[" ++ prlist Id.print l ++ str"]") + Id.print id ++ str "->" ++ hov 1 (str"[" ++ prlist_with_sep spc Id.print l ++ str"]") ++ str "," ++ spc () ++ Termops.print_constr c) let ppunbound_ltac_var_map l = ppidmap (fun id arg -> diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index 69aee0a602..b20af031df 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -257,7 +257,8 @@ let ltac_interp_name { ltac_idents ; ltac_genargs } = function str"It cannot be used in a binder.") else n -let invert_ltac_bound_name env id0 id = +let invert_ltac_bound_name lvar env id0 id = + let id = Id.Map.find id lvar.ltac_idents in try mkRel (pi1 (lookup_rel_id id (rel_context env))) with Not_found -> errorlabstrm "" (str "Ltac variable " ++ pr_id id0 ++ @@ -285,7 +286,7 @@ let pretype_id pretype loc env evdref lvar id = (* Check if [id] is an ltac variable *) try let (ids,c) = Id.Map.find id lvar.ltac_constrs in - let subst = List.map (invert_ltac_bound_name env id) ids in + let subst = List.map (invert_ltac_bound_name lvar env id) ids in let c = substl subst c in { uj_val = c; uj_type = protected_get_type_of env sigma c } with Not_found -> try |