X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2Focaml%2Ftactics%2Ftacticals.ml;fp=helm%2Focaml%2Ftactics%2Ftacticals.ml;h=0000000000000000000000000000000000000000;hp=8d4eb891e049a8e0601daabf7d8289898f20bf02;hb=1696761e4b8576e8ed81caa905fd108717019226;hpb=5325734bc2e4927ed7ec146e35a6f0f2b49f50c1 diff --git a/helm/ocaml/tactics/tacticals.ml b/helm/ocaml/tactics/tacticals.ml deleted file mode 100644 index 8d4eb891e..000000000 --- a/helm/ocaml/tactics/tacticals.ml +++ /dev/null @@ -1,249 +0,0 @@ -(* Copyright (C) 2002, HELM Team. - * - * This file is part of HELM, an Hypertextual, Electronic - * Library of Mathematics, developed at the Computer Science - * Department, University of Bologna, Italy. - * - * HELM is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * HELM is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with HELM; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, - * MA 02111-1307, USA. - * - * For details, see the HELM World-Wide-Web page, - * http://cs.unibo.it/helm/. - *) - -open CicReduction -open ProofEngineTypes -open UriManager - -(** DEBUGGING *) - - (** perform debugging output? *) -let debug = false - - (** debugging print *) -let warn s = - if debug then - prerr_endline ("TACTICALS WARNING: " ^ s) - - -(** TACTIC{,AL}S *) - - (* not a tactical, but it's used only here (?) *) - -let id_tac (proof,goal) = (proof,[goal]) - - - (** - naive implementation of ORELSE tactical, try a sequence of tactics in turn: - if one fails pass to the next one and so on, eventually raises (failure "no - tactics left") - TODO warning: not tail recursive due to "try .. with" boxing - - Galla: is this exactly Coq's "First"? - - *) -let rec try_tactics ~(tactics: (string * tactic) list) status = - warn "in Tacticals.try_tactics"; - match tactics with - | (descr, tac)::tactics -> - warn ("Tacticals.try_tactics IS TRYING " ^ descr); - (try - let res = tac status in - warn ("Tacticals.try_tactics: " ^ descr ^ " succedeed!!!"); - res - with - e -> - match e with - (Fail _) - | (CicTypeChecker.TypeCheckerFailure _) - | (CicUnification.UnificationFailure _) -> - warn ( - "Tacticals.try_tactics failed with exn: " ^ - Printexc.to_string e); - try_tactics ~tactics status - | _ -> raise e (* [e] must not be caught ; let's re-raise it *) - ) - | [] -> raise (Fail "try_tactics: no tactics left") - - - -let thens ~start ~continuations status = - let (proof,new_goals) = start status in - try - List.fold_left2 - (fun (proof,goals) goal tactic -> - let (proof',new_goals') = tactic (proof,goal) in - (proof',goals@new_goals') - ) (proof,[]) new_goals continuations - with - Invalid_argument _ -> raise (Fail "thens: wrong number of new goals") - - - -let then_ ~start ~continuation status = - let (proof,new_goals) = start status in - List.fold_left - (fun (proof,goals) goal -> - let (proof',new_goals') = continuation (proof,goal) in - (proof',goals@new_goals') - ) (proof,[]) new_goals - - -(* Galla *) -(* si suppone che tutte le tattiche sollevino solamente Fail? *) - - -(* TODO: x debug: i due tatticali seguenti non contano quante volte hanno applicato la tattica *) - -(* This keep on appling tactic until it fails *) -(* When generates more than one goal, you have a tree of - application on the tactic, repeat_tactic works in depth on this tree *) - -let rec repeat_tactic ~tactic status = - warn "in repeat_tactic"; - try let (proof, goallist) = tactic status in - let rec step proof goallist = - match goallist with - [] -> (proof, []) - | head::tail -> - let (proof', goallist') = repeat_tactic ~tactic (proof, head) in - let (proof'', goallist'') = step proof' tail in - proof'', goallist'@goallist'' - in - step proof goallist - with - (Fail _) as e -> - warn ("Tacticals.repeat_tactic failed after nth time with exception: " ^ Printexc.to_string e) ; - id_tac status -;; - - - -(* This tries to apply tactic n times *) - -let rec do_tactic ~n ~tactic status = - warn "in do_tactic"; - try - let (proof, goallist) = - if (n>0) then tactic status - else id_tac status in -(* else (proof, []) in *)(* perche' non va bene questo? stessa questione di ##### ? *) - let rec step proof goallist = - match goallist with - [] -> (proof, []) - | head::tail -> - let (proof', goallist') = do_tactic ~n:(n-1) ~tactic (proof, head) in - let (proof'', goallist'') = step proof' tail in - proof'', goallist'@goallist'' - in - step proof goallist - with - (Fail _) as e -> - warn ("Tacticals.do_tactic failed after nth time with exception: " ^ Printexc.to_string e) ; - id_tac status -;; - - - -(* This applies tactic and catches its possible failure *) - -let rec try_tactic ~tactic status = - warn "in Tacticals.try_tactic"; - try - tactic status - with - (Fail _) as e -> - warn ( "Tacticals.try_tactic failed with exn: " ^ Printexc.to_string e); - id_tac status -;; - - -(* This tries tactics until one of them doesn't _solve_ the goal *) -(* TODO: si puo' unificare le 2(due) chiamate ricorsive? *) - -let rec solve_tactics ~(tactics: (string * tactic) list) status = - warn "in Tacticals.solve_tactics"; - match tactics with - | (descr, currenttactic)::moretactics -> - warn ("Tacticals.solve_tactics is trying " ^ descr); - (try - let (proof, goallist) = currenttactic status in - match goallist with - [] -> warn ("Tacticals.solve_tactics: " ^ descr ^ " solved the goal!!!"); -(* questo significa che non ci sono piu' goal, o che current_tactic non ne ha aperti di nuovi? (la 2a!) ##### *) -(* nel secondo caso basta per dire che solve_tactics has solved the goal? (si!) *) - (proof, goallist) - | _ -> warn ("Tacticals.solve_tactics: try the next tactic"); - solve_tactics ~tactics:(moretactics) status - with - (Fail _) as e -> - warn ("Tacticals.solve_tactics: current tactic failed with exn: " ^ Printexc.to_string e); - solve_tactics ~tactics status - ) - | [] -> raise (Fail "solve_tactics cannot solve the goal"); - id_tac status -;; - - - - - - - - - - - (** tattica di prova per debuggare i tatticali *) -(* -let thens' ~start ~continuations status = - let (proof,new_goals) = start status in - try - List.fold_left2 - (fun (proof,goals) goal tactic -> - let (proof',new_goals') = tactic (proof,goal) in - (proof',goals@new_goals') - ) (proof,[]) new_goals continuations - with - Invalid_argument _ -> raise (Fail "thens: wrong number of new goals") - -let prova_tac = - let apply_T_tac status = - let (proof, goal) = status in - let curi,metasenv,pbo,pty = proof in - let metano,context,gty = CicUtil.lookup_meta goal metasenv in - let rel = - let rec find n = - function - [] -> assert false - | (Some (Cic.Name name,_))::_ when name = "T" -> n - | _::tl -> find (n+1) tl - in - prerr_endline ("eseguo find"); - find 1 context - in - prerr_endline ("eseguo apply"); - apply_tac ~term:(Cic.Rel rel) status - in -(* do_tactic ~n:2 *) - repeat_tactic - ~tactic: - (then_ - ~start:(intros_tac ~name:"pippo") - ~continuation:(thens' ~start:apply_T_tac ~continuations:[id_tac ; apply_tac ~term:(Cic.Rel 1)])) -(* id_tac *) -;; -*) - -