| 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)
T.type_of_aux' metasenv context arg
in
let fresh_name =
- FreshNamesGenerator.mk_fresh_name
+ FreshNamesGenerator.mk_fresh_name ~subst:[]
metasenv context (Cic.Name "Heta") ~typ:argty
in
(C.Appl [C.Lambda (fresh_name,argty,aux 0 t) ; arg])
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
Cic.Appl (term'::arguments)
)
in
- let newmetasenv'' = new_uninstantiatedmetas@old_uninstantiatedmetas in
- let (newproof, newmetasenv''') =
- let subst_in = CicMetaSubst.apply_subst ((metano,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 *)
in
mk_tactic (apply_tac ~term)
-let intros_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name) ()=
+let intros_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[]) ()=
let intros_tac
- ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name) ()
+ ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[]) ()
(proof, goal)
=
let module C = Cic in
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 ~subst:[]) ~term=
let cut_tac
- ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name)
+ ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[])
term (proof, goal)
=
let module C = Cic in
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 ~subst:[]) ~term=
let letin_tac
- ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name)
+ ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[])
term (proof, goal)
=
let module C = Cic in
C.Appl (eliminator_ref :: make_tl term (args_no - 1))
in
let metasenv', term_to_refine' =
- CicMkImplicit.expand_implicits metasenv context term_to_refine in
+ CicMkImplicit.expand_implicits metasenv [] context term_to_refine in
let refined_term,_,metasenv'' =
CicRefine.type_of_aux' metasenv' context term_to_refine'
in