X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Ftactics%2Fdeclarative.ml;h=db1345344d741d48c4a432b05a95bd198d9cb283;hb=ba5c1c83e77e701ef11625687ec27931bc4bb944;hp=b0615edb36c728415c5a03e8926278f03c3006a3;hpb=ca2a604c2817deb118d595611b94a0d77978eab6;p=helm.git diff --git a/helm/software/components/tactics/declarative.ml b/helm/software/components/tactics/declarative.ml index b0615edb3..db1345344 100644 --- a/helm/software/components/tactics/declarative.ml +++ b/helm/software/components/tactics/declarative.ml @@ -48,7 +48,7 @@ let suppose t id ty = let by_term_we_proved ~dbd ~universe t ty id ty' = let just = match t with - None -> Tactics.auto ~dbd ~params:[] ~universe + | None -> Tactics.auto ~dbd ~params:([],[]) ~universe | Some t -> Tactics.apply t in match id with @@ -63,24 +63,30 @@ let by_term_we_proved ~dbd ~universe t ty id ty' = ~continuation:just ) | Some id -> - let continuation = + let ty',continuation = match ty' with - None -> Tacticals.id_tac + None -> ty,just | Some ty' -> - Tactics.change ~pattern:(None,[id,Cic.Implicit (Some `Hole)],None) - (fun _ metasenv ugraph -> ty',metasenv,ugraph) + ty', + Tacticals.then_ + ~start: + (Tactics.change + ~with_cast:true + ~pattern:(None,[id,Cic.Implicit (Some `Hole)],None) + (fun _ metasenv ugraph -> ty,metasenv,ugraph)) + ~continuation:just in Tacticals.thens ~start: - (Tactics.cut ty + (Tactics.cut ty' ~mk_fresh_name_callback:(fun _ _ _ ~typ -> Cic.Name id)) - ~continuations:[ continuation ; just ] + ~continuations:[ Tacticals.id_tac ; continuation ] ;; let bydone ~dbd ~universe t = let just = match t with - None -> Tactics.auto ~dbd ~params:[] ~universe + | None -> Tactics.auto ~dbd ~params:([],[]) ~universe | Some t -> Tactics.apply t in just @@ -138,7 +144,7 @@ let existselim ~dbd ~universe t id1 t1 id2 t2 = incr i; if !i = 1 then Cic.Name id1 else Cic.Name id2) ; (match t with - None -> Tactics.auto ~dbd ~params:[] ~universe + | None -> Tactics.auto ~dbd ~params:([],[]) ~universe | Some t -> Tactics.apply t) ]) (proof', goal) in @@ -165,9 +171,9 @@ let rewritingstep ~dbd ~universe lhs rhs just last_step = in let ty,_ = CicTypeChecker.type_of_aux' metasenv context rhs CicUniv.empty_ugraph in - let just = + let just' = match just with - `Auto params -> + `Auto (univ, params) -> let params = if not (List.exists (fun (k,_) -> k = "timeout") params) then ("timeout","3")::params @@ -179,20 +185,14 @@ let rewritingstep ~dbd ~universe lhs rhs just last_step = else params in if params = params' then - Tactics.auto ~dbd ~params ~universe + Tactics.auto ~dbd ~params:(univ, params) ~universe else Tacticals.first - [Tactics.auto ~dbd ~params ~universe ; - Tactics.auto ~dbd ~params:params' ~universe] - | `Term just -> - let ty,_ = - CicTypeChecker.type_of_aux' metasenv context just - CicUniv.empty_ugraph - in - Tactics.solve_rewrite - ~universe:(Universe.index Universe.empty - (Universe.key ty) just) ~steps:1 () - (* Tactics.apply just *) + [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 @@ -240,20 +240,24 @@ let rewritingstep ~dbd ~universe lhs rhs just last_step = ~continuations:[Tacticals.id_tac ; continuation]) (proof,goal) in let goals = - match goals with - [g1;g2] -> [g2;newmeta;g1] - | _ -> assert false + 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 + just' else Tacticals.thens ~start:(Tactics.apply ~term:(Cic.Appl [trans;ty;plhs;rhs;prhs])) - ~continuations:[just ; Tacticals.id_tac] + ~continuations:[just' ; Tacticals.id_tac] in prepare continuation in