bumped changelog line to match upload date

[helm.git] / helm / ocaml / tactics / primitiveTactics.ml

diff --git a/helm/ocaml/tactics/primitiveTactics.ml b/helm/ocaml/tactics/primitiveTactics.ml
index cc743d7cc66e90e9a43651f9ea539c0c71b638e9..fa696856010431f53bb14546df11163a440c61b0 100644 (file)
--- a/helm/ocaml/tactics/primitiveTactics.ml
+++ b/helm/ocaml/tactics/primitiveTactics.ml
@@ -72,7 +72,11 @@ let eta_expand metasenv context t arg =
     | C.Var (uri,exp_named_subst) ->
        let exp_named_subst' = aux_exp_named_subst n exp_named_subst in
         C.Var (uri,exp_named_subst')
-    | C.Meta _
+    | C.Meta (i,l) ->
+       let l' =
+        List.map (function None -> None | Some t -> Some (aux n t)) l
+       in
+        C.Meta (i, l')
     | C.Sort _
     | C.Implicit _ as t -> t
     | C.Cast (te,ty) -> C.Cast (aux n te, aux n ty)
@@ -256,7 +260,7 @@ let
     new_fresh_meta,newmetasenvfragment,exp_named_subst',exp_named_subst_diff
 ;;
 
-let apply_tac ~term (proof, goal) =
+let apply_tac_verbose ~term (proof, goal) =
   (* Assumption: The term "term" must be closed in the current context *)
  let module T = CicTypeChecker in
  let module R = CicReduction in
@@ -324,15 +328,27 @@ let apply_tac ~term (proof, goal) =
              Cic.Appl (term'::arguments)
            )
          in
-          let newmetasenv'' = new_uninstantiatedmetas@old_uninstantiatedmetas in
-          let (newproof, newmetasenv''') =
-           let subst_in =
-             CicMetaSubst.apply_subst ((metano,(context, bo'))::subst)
-           in
-            subst_meta_and_metasenv_in_proof
-              proof metano subst_in newmetasenv''
-          in
-           (newproof, List.map (function (i,_,_) -> i) new_uninstantiatedmetas)
+         let newmetasenv'' = new_uninstantiatedmetas@old_uninstantiatedmetas in
+         let subst_in =
+           (* if we just apply the subtitution, the type is irrelevant:
+             we may use Implicit, since it will be dropped *)
+           CicMetaSubst.apply_subst 
+            ((metano,(context, bo', Cic.Implicit None))::subst)
+         in
+         let (newproof, newmetasenv''') =
+           subst_meta_and_metasenv_in_proof
+             proof metano subst_in newmetasenv''
+         in
+           (subst_in,(newproof, List.map (function (i,_,_) -> i) new_uninstantiatedmetas))
+
+let apply_tac ~term status = snd (apply_tac_verbose ~term status)
+
+let apply_tac_verbose ~term status =
+  try
+    apply_tac_verbose ~term status
+      (* TODO cacciare anche altre eccezioni? *)
+  with CicUnification.UnificationFailure _ as e ->
+    raise (Fail (Printexc.to_string e))
 
   (* TODO per implementare i tatticali e' necessario che tutte le tattiche
   sollevino _solamente_ Fail *)
@@ -366,7 +382,7 @@ let intros_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name) ()=
  in
   mk_tactic (intros_tac ~mk_fresh_name_callback ())
   
-let cut_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name) term=
+let cut_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name) ~term=
  let cut_tac
   ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name)
   term (proof, goal)
@@ -401,7 +417,7 @@ let cut_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name) term=
  in
   mk_tactic (cut_tac ~mk_fresh_name_callback term)
 
-let letin_tac ?(mk_fresh_name_callback=FreshNamesGenerator.mk_fresh_name) term=
+let letin_tac ?(mk_fresh_name_callback=FreshNamesGenerator.mk_fresh_name) ~term=
  let letin_tac
   ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name)
   term (proof, goal)