proofEngineStructuralRules.cmx: proofEngineTypes.cmx \
proofEngineStructuralRules.cmi
proofEngineStructuralRules.cmi: proofEngineTypes.cmo
+tacticals.cmo: proofEngineTypes.cmo tacticals.cmi
+tacticals.cmx: proofEngineTypes.cmx tacticals.cmi
+tacticals.cmi: proofEngineTypes.cmo
+reductionTactics.cmo: proofEngineReduction.cmi reductionTactics.cmi
+reductionTactics.cmx: proofEngineReduction.cmx reductionTactics.cmi
+reductionTactics.cmi: proofEngineTypes.cmo
primitiveTactics.cmo: proofEngineHelpers.cmi proofEngineReduction.cmi \
- proofEngineTypes.cmo primitiveTactics.cmi
+ proofEngineTypes.cmo reductionTactics.cmi tacticals.cmi \
+ primitiveTactics.cmi
primitiveTactics.cmx: proofEngineHelpers.cmx proofEngineReduction.cmx \
- proofEngineTypes.cmx primitiveTactics.cmi
+ proofEngineTypes.cmx reductionTactics.cmx tacticals.cmx \
+ primitiveTactics.cmi
primitiveTactics.cmi: proofEngineTypes.cmo
-tacticals.cmo: primitiveTactics.cmi proofEngineTypes.cmo tacticals.cmi
-tacticals.cmx: primitiveTactics.cmx proofEngineTypes.cmx tacticals.cmi
-tacticals.cmi: proofEngineTypes.cmo
ring.cmo: primitiveTactics.cmi proofEngineStructuralRules.cmi \
proofEngineTypes.cmo tacticals.cmi ring.cmi
ring.cmx: primitiveTactics.cmx proofEngineStructuralRules.cmx \
DEPOBJS = xml2Gdome.ml xml2Gdome.mli proofEngineTypes.ml proofEngineHelpers.ml \
proofEngineReduction.ml proofEngineReduction.mli \
proofEngineStructuralRules.ml proofEngineStructuralRules.mli \
- primitiveTactics.ml primitiveTactics.mli tacticals.ml tacticals.mli \
+ tacticals.ml tacticals.mli reductionTactics.ml reductionTactics.mli \
+ primitiveTactics.ml primitiveTactics.mli \
ring.ml ring.mli fourier.ml fourierR.ml fourierR.mli\
proofEngine.ml proofEngine.mli \
doubleTypeInference.ml doubleTypeInference.mli cic2acic.ml \
TOPLEVELOBJS = xml2Gdome.cmo proofEngineTypes.cmo proofEngineHelpers.cmo \
proofEngineReduction.cmo proofEngineStructuralRules.cmo \
- primitiveTactics.cmo tacticals.cmo ring.cmo \
- fourier.cmo fourierR.cmo proofEngine.cmo \
+ tacticals.cmo reductionTactics.cmo primitiveTactics.cmo \
+ ring.cmo fourier.cmo fourierR.cmo proofEngine.cmo \
doubleTypeInference.cmo cic2acic.cmo cic2Xml.cmo \
logicalOperations.cmo sequentPp.cmo mQueryGenerator.cmo \
gTopLevel.cmo
(proof',[fresh_meta])
;;
-
-
-let simpl_tac ~status:(proof,goal) =
- let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
-
-prerr_endline("simpl_tac su "^CicPp.ppterm ty);
-
- let new_ty = ProofEngineReduction.simpl context ty in
-
-prerr_endline("ritorna "^CicPp.ppterm new_ty);
-
- let new_metasenv =
- List.map
- (function
- (n,_,_) when n = metano -> (metano,context,new_ty)
- | _ as t -> t
- ) metasenv
- in
- (curi,new_metasenv,pbo,pty), [metano]
-
-;;
-
-let rewrite_simpl_tac ~term ~status =
-
- Tacticals.then_ ~start:(rewrite_tac ~term) ~continuation:simpl_tac ~status
-
+let rewrite_simpl_tac ~term =
+ Tacticals.then_ ~start:(rewrite_tac ~term)
+ ~continuation:ReductionTactics.simpl_tac
;;
(******************** THE FOURIER TACTIC ***********************)
let apply rendering_window =
call_tactic_with_input ProofEngine.apply rendering_window
;;
-let elimintrossimpl rendering_window =
- call_tactic_with_input ProofEngine.elim_intros_simpl rendering_window
+let elimsimplintros rendering_window =
+ call_tactic_with_input ProofEngine.elim_simpl_intros rendering_window
;;
let elimtype rendering_window =
call_tactic_with_input ProofEngine.elim_type rendering_window
let applyb =
GButton.button ~label:"Apply"
~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
- let elimintrossimplb =
- GButton.button ~label:"ElimIntrosSimpl"
+ let elimsimplintrosb =
+ GButton.button ~label:"ElimSimplIntros"
~packing:(hbox3#pack ~expand:false ~fill:false ~padding:5) () in
let elimtypeb =
GButton.button ~label:"ElimType"
ignore(searchpatternb#connect#clicked (searchPattern self)) ;
ignore(exactb#connect#clicked (exact self)) ;
ignore(applyb#connect#clicked (apply self)) ;
- ignore(elimintrossimplb#connect#clicked (elimintrossimpl self)) ;
+ ignore(elimsimplintrosb#connect#clicked (elimsimplintros self)) ;
ignore(elimtypeb#connect#clicked (elimtype self)) ;
ignore(whdb#connect#clicked (whd self)) ;
ignore(reduceb#connect#clicked (reduce self)) ;
exception NoHypothesesFound
exception WrongUriToVariable of string
-(* TODO problemone del fresh_name, aggiungerlo allo status? *)
-let fresh_name () = "FOO"
-
(* lambda_abstract newmeta ty *)
(* returns a triple [bo],[context],[ty'] where *)
(* [ty] = Pi/LetIn [context].[ty'] ([context] is a vector!) *)
in
(C.Appl [C.Lambda ((C.Name "dummy"),argty,aux 0 t) ; arg])
-(*CSC: The call to the Intros tactic is embedded inside the code of the *)
-(*CSC: Elim tactic. Do we already need tacticals? *)
-(* Auxiliary function for apply: given a type (a backbone), it returns its *)
-(* head, a META environment in which there is new a META for each hypothesis,*)
-(* a list of arguments for the new applications and the indexes of the first *)
-(* and last new METAs introduced. The nth argument in the list of arguments *)
-(* is the nth new META lambda-abstracted as much as possible. Hence, this *)
-(* functions already provides the behaviour of Intros on the new goals. *)
-let new_metasenv_for_apply_intros proof context ty =
- let module C = Cic in
- let module S = CicSubstitution in
- let rec aux newmeta =
- function
- C.Cast (he,_) -> aux newmeta he
- | C.Prod (name,s,t) ->
- let newcontext,ty',newargument =
- lambda_abstract context newmeta s (fresh_name ())
- in
- let (res,newmetasenv,arguments,lastmeta) =
- aux (newmeta + 1) (S.subst newargument t)
- in
- res,(newmeta,newcontext,ty')::newmetasenv,newargument::arguments,lastmeta
- | t -> t,[],[],newmeta
- in
- let newmeta = new_meta ~proof in
- (* WARNING: here we are using the invariant that above the most *)
- (* recente new_meta() there are no used metas. *)
- let (res,newmetasenv,arguments,lastmeta) = aux newmeta ty in
- res,newmetasenv,arguments,newmeta,lastmeta
-
(*CSC: ma serve solamente la prima delle new_uninst e l'unione delle due!!! *)
let classify_metas newmeta in_subst_domain subst_in metasenv =
List.fold_right
raise (Fail "The type of the provided term is not the one expected.")
-(* not really "primite" tactics .... *)
+(* not really "primitive" tactics .... *)
-let elim_intros_simpl_tac ~term ~status:(proof, goal) =
+let elim_tac ~term ~status:(proof, goal) =
let module T = CicTypeChecker in
let module U = UriManager in
let module R = CicReduction in
C.MutInd (uri,typeno,exp_named_subst) -> (uri,exp_named_subst,typeno,[])
| C.Appl ((C.MutInd (uri,typeno,exp_named_subst))::args) ->
(uri,exp_named_subst,typeno,args)
- | _ ->
- prerr_endline ("MALFATTORE" ^ (CicPp.ppterm termty));
- flush stderr;
- raise NotAnInductiveTypeToEliminate
+ | _ -> raise NotAnInductiveTypeToEliminate
in
let eliminator_uri =
let buri = U.buri_of_uri uri in
in
U.uri_of_string (buri ^ "/" ^ name ^ ext ^ ".con")
in
-(*CSC: BUG HERE!!! [] MUST BE COMPUTED SOMEHOW. USING UNIFICATION? *)
- let eliminator_ref = C.Const (eliminator_uri,[]) in
- let ety =
- T.type_of_aux' [] [] eliminator_ref
- in
- let (econclusion,newmetas,arguments,newmeta,lastmeta) =
-(*
- new_metasenv_for_apply context ety
-*)
- new_metasenv_for_apply_intros proof context ety
+ let eliminator_ref = C.Const (eliminator_uri,exp_named_subst) in
+ let ety = T.type_of_aux' metasenv context eliminator_ref in
+ let newmeta = new_meta ~proof in
+ let (econclusion,newmetas,arguments,lastmeta) =
+ new_metasenv_for_apply newmeta proof context ety
in
(* Here we assume that we have only one inductive hypothesis to *)
(* eliminate and that it is the last hypothesis of the theorem. *)
(* to refine the term. *)
let emeta, fargs =
match ueconclusion with
-(*CSC: Code to be used for Apply
C.Appl ((C.Meta (emeta,_))::fargs) -> emeta,fargs
| C.Meta (emeta,_) -> emeta,[]
-*)
-(*CSC: Code to be used for ApplyIntros *)
- C.Appl (he::fargs) ->
- let rec find_head =
- function
- C.Meta (emeta,_) -> emeta
- | C.Lambda (_,_,t) -> find_head t
- | C.LetIn (_,_,t) -> find_head t
- | _ ->raise NotTheRightEliminatorShape
- in
- find_head he,fargs
- | C.Meta (emeta,_) -> emeta,[]
-(* *)
| _ -> raise NotTheRightEliminatorShape
in
let ty' = CicUnification.apply_subst subst1 ty in
List.exists eq_to_i subst1 ||
List.exists eq_to_i subst2
in
-(*CSC: codice per l'elim
(* When unwinding the META that corresponds to the elimination *)
(* predicate (which is emeta), we must also perform one-step *)
(* beta-reduction. apply_subst doesn't need the context. Hence *)
CicUnification.apply_subst_reducing
subst2 (Some (emeta,List.length fargs)) t'
in
-*)
-(*CSC: codice per l'elim_intros_simpl. Non effettua semplificazione. *)
- let apply_subst context t =
- let t' = CicUnification.apply_subst (subst1@subst2) t in
- ProofEngineReduction.simpl context t'
- in
-(* *)
let old_uninstantiatedmetas,new_uninstantiatedmetas =
classify_metas newmeta in_subst_domain apply_subst
newmetasenv''
(* we also substitute metano with bo'. *)
(*CSC: Nota: sostituire nuovamente subst1 e' superfluo, *)
(*CSC: no? *)
-(*CSC: codice per l'elim
let apply_subst' t =
let t' = CicUnification.apply_subst subst1 t in
CicUnification.apply_subst_reducing
((metano,bo')::subst2)
(Some (emeta,List.length fargs)) t'
in
-*)
-(*CSC: codice per l'elim_intros_simpl *)
- let apply_subst' t =
- CicUnification.apply_subst
- ((metano,bo')::(subst1@subst2)) t
- in
-(* *)
subst_meta_and_metasenv_in_proof
proof metano apply_subst' newmetasenv'''
in
(newproof,
List.map (function (i,_,_) -> i) new_uninstantiatedmetas)
+;;
+
+let elim_simpl_intros_tac ~term =
+ Tacticals.then_ ~start:(elim_tac ~term)
+ ~continuation:
+ (Tacticals.then_ ~start:ReductionTactics.simpl_tac
+ ~continuation:(intros_tac ~name:"FOO"))
+;;
exception NotConvertible
val letin_tac:
term: Cic.term -> ProofEngineTypes.tactic
-val elim_intros_simpl_tac:
+val elim_simpl_intros_tac:
term: Cic.term -> ProofEngineTypes.tactic
val change_tac:
let cut term = apply_tactic (PrimitiveTactics.cut_tac ~term)
let letin term = apply_tactic (PrimitiveTactics.letin_tac ~term)
let exact term = apply_tactic (PrimitiveTactics.exact_tac ~term)
-let elim_intros_simpl term =
- apply_tactic (PrimitiveTactics.elim_intros_simpl_tac ~term)
+let elim_simpl_intros term =
+ apply_tactic (PrimitiveTactics.elim_simpl_intros_tac ~term)
let change ~goal_input:what ~input:with_what =
apply_tactic (PrimitiveTactics.change_tac ~what ~with_what)
val cut : Cic.term -> unit
val letin : Cic.term -> unit
val exact : Cic.term -> unit
-val elim_intros_simpl : Cic.term -> unit
+val elim_simpl_intros : Cic.term -> unit
val change : goal_input:Cic.term -> input:Cic.term -> unit
(* structural tactics *)
--- /dev/null
+(* 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/.
+ *)
+
+let reduction_tac ~reduction ~status:(proof,goal) =
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let new_ty = reduction context ty in
+ let new_metasenv =
+ List.map
+ (function
+ (n,_,_) when n = metano -> (metano,context,new_ty)
+ | _ as t -> t
+ ) metasenv
+ in
+ (curi,new_metasenv,pbo,pty), [metano]
+;;
+
+let simpl_tac = reduction_tac ~reduction:ProofEngineReduction.simpl ;;
+let reduce_tac = reduction_tac ~reduction:ProofEngineReduction.reduce ;;
+let whd_tac = reduction_tac ~reduction:CicReduction.whd ;;
--- /dev/null
+(* 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/.
+ *)
+
+val simpl_tac: ProofEngineTypes.tactic
+val reduce_tac: ProofEngineTypes.tactic
+val whd_tac: ProofEngineTypes.tactic
let elim_type_tac ~term ~status =
warn "in Ring.elim_type_tac";
Tacticals.thens ~start:(cut_tac ~term)
- ~continuations:[elim_intros_simpl_tac ~term:(Cic.Rel 1) ; id_tac] ~status
+ ~continuations:[elim_simpl_intros_tac ~term:(Cic.Rel 1) ; id_tac] ~status
(**
auxiliary tactic, use elim_type and try to close 2nd subgoal using proof
*)
open CicReduction
-open PrimitiveTactics
open ProofEngineTypes
open UriManager
(** DEBUGGING *)
(** perform debugging output? *)
-let debug = true
+let debug = false
(** debugging print *)
let warn s =
projects / helm.git / commitdiff