+
+let rewritingstep ~dbd ~universe lhs rhs just last_step =
+ let aux ((proof,goal) as status) =
+ let (curi,metasenv,_subst,proofbo,proofty, attrs) = proof in
+ let _,context,gty = CicUtil.lookup_meta goal metasenv in
+ let eq,trans =
+ match LibraryObjects.eq_URI () with
+ None -> raise (ProofEngineTypes.Fail (lazy "You need to register the default equality first. Please use the \"default\" command"))
+ | Some uri ->
+ Cic.MutInd (uri,0,[]), Cic.Const (LibraryObjects.trans_eq_URI ~eq:uri,[])
+ in
+ let ty,_ =
+ CicTypeChecker.type_of_aux' metasenv context rhs CicUniv.oblivion_ugraph in
+ let just' =
+ match just with
+ `Auto (univ, params) ->
+ let params =
+ if not (List.exists (fun (k,_) -> k = "timeout") params) then
+ ("timeout","3")::params
+ else params
+ in
+ let params' =
+ if not (List.exists (fun (k,_) -> k = "paramodulation") params) then
+ ("paramodulation","1")::params
+ else params
+ in
+ if params = params' then
+ Tactics.auto ~dbd ~params:(univ, params) ~universe
+ else
+ Tacticals.first
+ [Tactics.auto ~dbd ~params:(univ, params) ~universe ;
+ Tactics.auto ~dbd ~params:(univ, params') ~universe]
+ | `Term just -> Tactics.apply just
+ | `SolveWith term ->
+ Tactics.solve_rewrite ~universe ~params:([term],["steps","1"]) ()
+ | `Proof ->
+ Tacticals.id_tac
+ in
+ let plhs,prhs,prepare =
+ match lhs with
+ None ->
+ let plhs,prhs =
+ match gty with
+ Cic.Appl [_;_;plhs;prhs] -> plhs,prhs
+ | _ -> assert false
+ in
+ plhs,prhs,
+ (fun continuation ->
+ ProofEngineTypes.apply_tactic continuation status)
+ | Some (None,lhs) ->
+ let plhs,prhs =
+ match gty with
+ Cic.Appl [_;_;plhs;prhs] -> plhs,prhs
+ | _ -> assert false
+ in
+ (*CSC: manca check plhs convertibile con lhs *)
+ plhs,prhs,
+ (fun continuation ->
+ ProofEngineTypes.apply_tactic continuation status)
+ | Some (Some name,lhs) ->
+ let newmeta = CicMkImplicit.new_meta metasenv [] in
+ let irl =
+ CicMkImplicit.identity_relocation_list_for_metavariable context in
+ let plhs = lhs in
+ let prhs = Cic.Meta(newmeta,irl) in
+ plhs,prhs,
+ (fun continuation ->
+ let metasenv = (newmeta, context, ty)::metasenv in
+ let mk_fresh_name_callback =
+ fun metasenv context _ ~typ ->
+ FreshNamesGenerator.mk_fresh_name ~subst:[] metasenv context
+ (Cic.Name name) ~typ
+ in
+ let proof = curi,metasenv,_subst,proofbo,proofty, attrs in
+ let proof,goals =
+ ProofEngineTypes.apply_tactic
+ (Tacticals.thens
+ ~start:(Tactics.cut ~mk_fresh_name_callback
+ (Cic.Appl [eq ; ty ; lhs ; prhs]))
+ ~continuations:[Tacticals.id_tac ; continuation]) (proof,goal)
+ in
+ let goals =
+ match just,goals with
+ `Proof, [g1;g2;g3] -> [g2;g3;newmeta;g1]
+ | _, [g1;g2] -> [g2;newmeta;g1]
+ | _, l ->
+ prerr_endline (String.concat "," (List.map string_of_int l));
+ prerr_endline (CicMetaSubst.ppmetasenv [] metasenv);
+ assert false
+ in
+ proof,goals)
+ in
+ let continuation =
+ if last_step then
+ (*CSC:manca controllo sul fatto che rhs sia convertibile con prhs*)
+ just'
+ else
+ Tacticals.thens
+ ~start:(Tactics.apply ~term:(Cic.Appl [trans;ty;plhs;rhs;prhs]))
+ ~continuations:[just' ; Tacticals.id_tac]
+ in
+ prepare continuation
+ in
+ ProofEngineTypes.mk_tactic aux