X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Ftactics%2FprimitiveTactics.ml;h=1de72fb5d2d7368da9eba47a0301017e7fe7a742;hb=9f60b3b0f4460aec52ec241037f6c475b421dd15;hp=5c187b05367c92eecd6241b4db3378531b245fc1;hpb=f4b9cc6f689b52e0408ac3231ba2a480d71216fb;p=helm.git diff --git a/helm/ocaml/tactics/primitiveTactics.ml b/helm/ocaml/tactics/primitiveTactics.ml index 5c187b053..1de72fb5d 100644 --- a/helm/ocaml/tactics/primitiveTactics.ml +++ b/helm/ocaml/tactics/primitiveTactics.ml @@ -37,13 +37,13 @@ exception WrongUriToVariable of string (* and [bo] = Lambda/LetIn [context].(Meta [newmeta]) *) (* So, lambda_abstract is the core of the implementation of *) (* the Intros tactic. *) -let lambda_abstract context newmeta ty mk_fresh_name = +let lambda_abstract metasenv context newmeta ty mk_fresh_name = let module C = Cic in let rec collect_context context = function C.Cast (te,_) -> collect_context context te | C.Prod (n,s,t) -> - let n' = mk_fresh_name context n ~typ:s in + let n' = mk_fresh_name metasenv context n ~typ:s in let (context',ty,bo) = collect_context ((Some (n',(C.Decl s)))::context) t in @@ -74,7 +74,7 @@ let eta_expand metasenv context t arg = C.Var (uri,exp_named_subst') | C.Meta _ | C.Sort _ - | C.Implicit as t -> t + | C.Implicit _ as t -> t | C.Cast (te,ty) -> C.Cast (aux n te, aux n ty) | C.Prod (nn,s,t) -> C.Prod (nn, aux n s, aux (n+1) t) | C.Lambda (nn,s,t) -> C.Lambda (nn, aux n s, aux (n+1) t) @@ -115,7 +115,8 @@ let eta_expand metasenv context t arg = T.type_of_aux' metasenv context arg in let fresh_name = - ProofEngineHelpers.mk_fresh_name context (Cic.Name "Heta") ~typ:argty + FreshNamesGenerator.mk_fresh_name + metasenv context (Cic.Name "Heta") ~typ:argty in (C.Appl [C.Lambda (fresh_name,argty,aux 0 t) ; arg]) @@ -264,12 +265,10 @@ let apply_tac ~term ~status:(proof, goal) = | _ -> [],newmeta,[],term in let metasenv' = metasenv@newmetasenvfragment in -prerr_endline ("^^^^^TERM': " ^ CicPp.ppterm term') ; let termty = CicSubstitution.subst_vars exp_named_subst_diff (CicTypeChecker.type_of_aux' metasenv' context term) in -prerr_endline ("^^^^^TERMTY: " ^ CicPp.ppterm termty) ; (* newmeta is the lowest index of the new metas introduced *) let (consthead,newmetas,arguments,_) = new_metasenv_for_apply newmeta' proof context termty @@ -312,7 +311,7 @@ let apply_tac ~term ~status = raise (Fail (Printexc.to_string e)) let intros_tac - ?(mk_fresh_name_callback = ProofEngineHelpers.mk_fresh_name) () + ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name) () ~status:(proof, goal) = let module C = Cic in @@ -321,7 +320,7 @@ let intros_tac let metano,context,ty = CicUtil.lookup_meta goal metasenv in let newmeta = new_meta_of_proof ~proof in let (context',ty',bo') = - lambda_abstract context newmeta ty mk_fresh_name_callback + lambda_abstract metasenv context newmeta ty mk_fresh_name_callback in let (newproof, _) = subst_meta_in_proof proof metano bo' [newmeta,context',ty'] @@ -329,7 +328,7 @@ let intros_tac (newproof, [newmeta]) let cut_tac - ?(mk_fresh_name_callback = ProofEngineHelpers.mk_fresh_name) + ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name) term ~status:(proof, goal) = let module C = Cic in @@ -338,7 +337,7 @@ let cut_tac let newmeta1 = new_meta_of_proof ~proof in let newmeta2 = newmeta1 + 1 in let fresh_name = - mk_fresh_name_callback context (Cic.Name "Hcut") ~typ:term in + mk_fresh_name_callback metasenv context (Cic.Name "Hcut") ~typ:term in let context_for_newmeta1 = (Some (fresh_name,C.Decl term))::context in let irl1 = @@ -361,7 +360,7 @@ let cut_tac (newproof, [newmeta1 ; newmeta2]) let letin_tac - ?(mk_fresh_name_callback = ProofEngineHelpers.mk_fresh_name) + ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name) term ~status:(proof, goal) = let module C = Cic in @@ -370,7 +369,7 @@ let letin_tac let _ = CicTypeChecker.type_of_aux' metasenv context term in let newmeta = new_meta_of_proof ~proof in let fresh_name = - mk_fresh_name_callback context (Cic.Name "Hletin") ~typ:term in + mk_fresh_name_callback metasenv context (Cic.Name "Hletin") ~typ:term in let context_for_newmeta = (Some (fresh_name,C.Def (term,None)))::context in let irl =