]> matita.cs.unibo.it Git - helm.git/commitdiff
A few other tactics made available to matita.
authorClaudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Mon, 27 Jun 2005 16:57:10 +0000 (16:57 +0000)
committerClaudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Mon, 27 Jun 2005 16:57:10 +0000 (16:57 +0000)
A few tactics (change, fold, replace) generalized to patterns.
The argument of clear and clearbody is now an identifier.

WARNING: the implementation of change, fold and replace has been commented
out to generalize them to patterns. To be committed soon.

20 files changed:
helm/ocaml/cic_disambiguation/cicTextualParser2.ml
helm/ocaml/cic_transformations/tacticAst.ml
helm/ocaml/cic_transformations/tacticAst2Box.ml
helm/ocaml/cic_transformations/tacticAstPp.ml
helm/ocaml/tactics/eliminationTactics.ml
helm/ocaml/tactics/equalityTactics.ml
helm/ocaml/tactics/equalityTactics.mli
helm/ocaml/tactics/fourierR.ml
helm/ocaml/tactics/primitiveTactics.mli
helm/ocaml/tactics/proofEngineStructuralRules.ml
helm/ocaml/tactics/proofEngineStructuralRules.mli
helm/ocaml/tactics/reductionTactics.ml
helm/ocaml/tactics/reductionTactics.mli
helm/ocaml/tactics/ring.ml
helm/ocaml/tactics/tacticals.ml
helm/ocaml/tactics/tacticals.mli
helm/ocaml/tactics/tactics.ml
helm/ocaml/tactics/tactics.mli
helm/ocaml/tactics/variousTactics.ml
helm/ocaml/tactics/variousTactics.mli

index 3fdda212d83339aac2c681bbdcc573eac5361e66..0ef9ec617f2ba7a0ea3e9f1a9b689e5aaba735ab 100644 (file)
@@ -352,6 +352,10 @@ EXTEND
       depth = OPT [ IDENT "depth"; SYMBOL "="; i = NUM -> int_of_string i ];
       width = OPT [ IDENT "depth"; SYMBOL "="; i = NUM -> int_of_string i ] -> 
           TacticAst.Auto (loc,depth,width)
+    | IDENT "clear"; id = IDENT ->
+        TacticAst.Clear (loc,id)
+    | IDENT "clearbody"; id = IDENT ->
+        TacticAst.ClearBody (loc,id)
     | IDENT "change"; t1 = tactic_term; "with"; t2 = tactic_term; "in";
       where = pattern_spec ->
         TacticAst.Change (loc, t1, t2, where)
@@ -378,8 +382,11 @@ EXTEND
         TacticAst.Exact (loc, t)
     | IDENT "exists" ->
         TacticAst.Exists loc
-    | IDENT "fold"; kind = reduction_kind; t = tactic_term ->
-        TacticAst.Fold (loc, kind, t)
+    | IDENT "fail" -> TacticAst.Fail loc
+    | IDENT "fold"; kind = reduction_kind; t = tactic_term;
+      p = OPT [ pattern_spec ] ->
+        let p = match p with None -> [], None | Some p -> p in
+        TacticAst.Fold (loc, kind, t, p)
     | IDENT "fourier" ->
         TacticAst.Fourier loc
     | IDENT "fwd"; t = term ->
@@ -391,6 +398,7 @@ EXTEND
        TacticAst.Generalize (loc,t,id,p)
     | IDENT "goal"; n = NUM ->
         TacticAst.Goal (loc, int_of_string n)
+    | IDENT "id" -> TacticAst.IdTac loc
     | IDENT "injection"; t = term ->
         TacticAst.Injection (loc, t)
     | IDENT "intros"; num = OPT [num = int -> num]; idents = OPT ident_list0 ->
@@ -410,8 +418,9 @@ EXTEND
         TacticAst.Reduce (loc, kind, p)
     | IDENT "reflexivity" ->
         TacticAst.Reflexivity loc
-    | IDENT "replace"; t1 = tactic_term; "with"; t2 = tactic_term ->
-        TacticAst.Replace (loc, t1, t2)
+    | IDENT "replace"; p = OPT [ pattern_spec ]; "with"; t = tactic_term ->
+        let p = match p with None -> [], None | Some p -> p in
+        TacticAst.Replace (loc, p, t)
     | IDENT "rewrite" ; d = direction; t = term ; p = OPT [ pattern_spec ] ->
         let p = match p with None -> [], None | Some p -> p in
         TacticAst.Rewrite (loc, d, t, p)
@@ -449,8 +458,6 @@ EXTEND
           TacticAst.Tries (loc, tacs)
       | IDENT "try"; tac = NEXT ->
           TacticAst.Try (loc, tac)
-      | IDENT "fail" -> TacticAst.Fail loc
-      | IDENT "id" -> TacticAst.IdTac loc
       | PAREN "("; tac = tactical; PAREN ")" -> tac
       | tac = tactic -> TacticAst.Tactic (loc, tac)
       ]
index 47f275a6892130a348d27005331b7169da9faec3..7622ce963c12f654ceade2d519153c98228feaa1 100644 (file)
@@ -37,6 +37,8 @@ type ('term, 'ident) tactic =
   | Assumption of loc
   | Auto of loc * int option * int option (* depth, width *)
   | Change of loc * 'term * 'term * ('term,'ident) pattern (* what, with what, where *)
+  | Clear of loc * 'ident
+  | ClearBody of loc * 'ident
   | Compare of loc * 'term
   | Constructor of loc * int
   | Contradiction of loc
@@ -48,11 +50,13 @@ type ('term, 'ident) tactic =
   | ElimType of loc * 'term
   | Exact of loc * 'term
   | Exists of loc
-  | Fold of loc * reduction_kind * 'term
+  | Fail of loc
+  | Fold of loc * reduction_kind * 'term * ('term, 'ident) pattern
   | Fourier of loc
   | FwdSimpl of loc * 'term
   | Generalize of loc * 'term * 'ident option * ('term, 'ident) pattern
   | Goal of loc * int (* change current goal, argument is goal number 1-based *)
+  | IdTac of loc
   | Injection of loc * 'term
   | Intros of loc * int option * 'ident list
   | LApply of loc * 'term option * 'term
@@ -60,7 +64,7 @@ type ('term, 'ident) tactic =
   | LetIn of loc * 'term * 'ident
   | Reduce of loc * reduction_kind * ('term, 'ident) pattern 
   | Reflexivity of loc
-  | Replace of loc * 'term * 'term (* what, with what *)
+  | Replace of loc * ('term, 'ident) pattern * 'term
   | Rewrite of loc * direction * 'term * ('term, 'ident) pattern
   | Right of loc
   | Ring of loc
@@ -135,9 +139,7 @@ type ('term,'obj) command =
 
 type ('term, 'ident) tactical =
   | Tactic of loc * ('term, 'ident) tactic
-  | Fail of loc
   | Do of loc * int * ('term, 'ident) tactical
-  | IdTac of loc
   | Repeat of loc * ('term, 'ident) tactical
   | Seq of loc * ('term, 'ident) tactical list (* sequential composition *)
   | Then of loc * ('term, 'ident) tactical * ('term, 'ident) tactical list
index f0626c7724d3056b0e224a3cda39ecdb5c3195b9..ba14fd0d635372a4480f3e9e7daa4af681e14ecf 100644 (file)
@@ -65,8 +65,6 @@ let rec count_tactic current_size tac =
     | ElimType (_, term) -> countterm (current_size + 10) term
     | Exact (_, term) -> countterm (current_size + 6) term
     | Exists _ -> current_size + 6
-    | Fold (_, kind, term) ->
-       countterm (current_size + 5) term
     | Fourier _ -> current_size + 7
     | Goal (_, n) -> current_size + 4 + int_of_float (ceil (log10 (float n)))
     | Injection (_, term) ->
@@ -79,9 +77,6 @@ let rec count_tactic current_size tac =
     | LetIn (_, term, ident) ->
        countterm (current_size + 5 + String.length ident) term
     | Reflexivity _ -> current_size + 11
-    | Replace (_, t1, t2) -> 
-       let size1 = countterm (current_size + 14) t1 in (* replace, with *)
-         countterm size1 t2    
     | Right _ -> current_size + 5
     | Ring _ -> current_size + 4
     | Split _ -> current_size + 5
@@ -162,11 +157,6 @@ and big_tactic2box = function
       Box.V([],[Box.Text([],"exact");
                Box.indent(ast2astBox term)])
   | Exists _ -> Box.Text([],"exists")
-  | Fold (_, kind, term) ->
-      Box.V([],[Box.H([],[Box.Text([],"fold");
-                         Box.smallskip;
-                         Box.Text([],string_of_kind kind)]);
-               Box.indent(ast2astBox term)])
   | Fourier _ -> Box.Text([],"fourier")
   | Goal (_, n) -> Box.Text([],"goal " ^ string_of_int n)
   | Intros (_, num, idents) ->
@@ -188,14 +178,6 @@ and big_tactic2box = function
                          Box.Text([],"=")]);
                Box.indent (ast2astBox term)])
   | Reflexivity _ -> Box.Text([],"reflexivity")
-  | Replace (_, t1, t2) -> 
-      Box.V([],
-           (pretty_append 
-              [Box.Text([],"replace")]
-              t1)@
-           (pretty_append 
-              [Box.Text([],"with")]
-              t2))
   | Right _ -> Box.Text([],"right")
   | Ring _ ->  Box.Text([],"ring")
   | Split _ -> Box.Text([],"split")
@@ -209,16 +191,9 @@ open TacticAst
 
 let rec tactical2box = function
   | Tactic (_, tac) -> tactic2box tac
-(*
-  | Command cmd -> (* TODO dummy implementation *)
-      Box.Text([], TacticAstPp.pp_tactical (Command cmd))
-*)
-
-  | Fail _ -> Box.Text([],"fail")
   | Do (_, count, tac) -> 
       Box.V([],[Box.Text([],"do " ^ string_of_int count);
                Box.indent (tactical2box tac)])
-  | IdTac _ -> Box.Text([],"id")
   | Repeat (_, tac) -> 
       Box.V([],[Box.Text([],"repeat");
                Box.indent (tactical2box tac)])
index 019ba6172a2c413c777f737f4250c57475f8afd6..452976e59fde7f99e63abb7b2fd75260b56da2fb 100644 (file)
@@ -55,7 +55,7 @@ let pp_pattern (hyp, goal) =
     | Some p -> pp_term_ast p
   in
   let separator = 
-    if hyp <> [] then " \vdash " else " "
+    if hyp <> [] then " \\vdash " else " "
   in
    "in " ^ pp_hyp_pattern hyp ^ separator ^ pp_goal_pattern goal
 
@@ -65,8 +65,10 @@ let rec pp_tactic = function
   | Auto _ -> "auto"
   | Assumption _ -> "assumption"
   | Change (_, t1, t2, where) ->
-      sprintf "change %s with %s%s" (pp_term_ast t1) (pp_term_ast t2)
+      sprintf "change %s with %s %s" (pp_term_ast t1) (pp_term_ast t2)
        (pp_pattern where)
+  | Clear (_,id) -> sprintf "clear %s" id
+  | ClearBody (_,id) -> sprintf "clearbody %s" id
   | Compare (_,term) -> "compare " ^ pp_term_ast term
   | Constructor (_,n) -> "constructor " ^ string_of_int n
   | Contradiction _ -> "contradiction"
@@ -83,14 +85,17 @@ let rec pp_tactic = function
   | ElimType (_, term) -> "elim type " ^ pp_term_ast term
   | Exact (_, term) -> "exact " ^ pp_term_ast term
   | Exists _ -> "exists"
-  | Fold (_, kind, term) ->
-      sprintf "fold %s %s" (pp_reduction_kind kind) (pp_term_ast term)
+  | Fold (_, kind, term, pattern) ->
+      sprintf "fold %s %s %s" (pp_reduction_kind kind) (pp_term_ast term)
+       (pp_pattern pattern)
   | Generalize (_, term, ident, pattern) ->
      sprintf "generalize %s%s %s" (pp_term_ast term)
       (match ident with None -> "" | Some id -> " as " ^ id)
       (pp_pattern pattern)
   | Goal (_, n) -> "goal " ^ string_of_int n
+  | Fail _ -> "fail"
   | Fourier _ -> "fourier"
+  | IdTac _ -> "id"
   | Injection (_, term) -> "injection " ^ pp_term_ast term
   | Intros (_, None, []) -> "intro"
   | Intros (_, num, idents) ->
@@ -102,8 +107,8 @@ let rec pp_tactic = function
   | Reduce (_, kind, pat) ->
       sprintf "%s %s" (pp_reduction_kind kind) (pp_pattern pat)
   | Reflexivity _ -> "reflexivity"
-  | Replace (_, t1, t2) ->
-      sprintf "replace %s with %s" (pp_term_ast t1) (pp_term_ast t2)
+  | Replace (_, pattern, t) ->
+      sprintf "replace %s with %s" (pp_pattern pattern) (pp_term_ast t)
   | Rewrite (_, pos, t, pattern) -> 
       sprintf "rewrite %s %s %s" 
         (if pos = `Left then "left" else "right") (pp_term_ast t)
@@ -221,10 +226,7 @@ let pp_command = function
 
 let rec pp_tactical = function
   | Tactic (_, tac) -> pp_tactic tac
-
-  | Fail _ -> "fail"
   | Do (_, count, tac) -> sprintf "do %d %s" count (pp_tactical tac)
-  | IdTac _ -> "id"
   | Repeat (_, tac) -> "repeat " ^ pp_tactical tac
   | Seq (_, tacs) -> pp_tacticals tacs
   | Then (_, tac, tacs) ->
index d018dc52cf229ca42f1f9087fc2ea5128bc8dd69..4f840764a8d17466acf6f094e98dec00f1cac49f 100644 (file)
@@ -158,12 +158,18 @@ let decompose_tac ?(uris_choice_callback=(function l -> l)) term =
                             let new_context_len = List.length context in   
                              warn ("newcon=" ^ (string_of_int new_context_len) ^ " & oldcon=" ^ (string_of_int old_context_len) ^ " & old_nr_of_hyp=" ^ (string_of_int nr_of_hyp_still_to_elim));
                              let new_nr_of_hyp_still_to_elim = nr_of_hyp_still_to_elim + (new_context_len - old_context_len) - 1 in
+                             let hyp_name =
+                              match List.nth context new_nr_of_hyp_still_to_elim with
+                                 None
+                               | Some (Cic.Anonymous,_) -> assert false
+                               | Some (Cic.Name name,_) -> name
+                             in
                             ProofEngineTypes.apply_tactic
                              (T.then_ 
                                 ~start:(
                                   if (term'==term) (* if it's the first application of elim, there's no need to clear the hyp *) 
                                    then begin debug_print ("%%%%%%% no clear"); T.id_tac end
-                                   else begin debug_print ("%%%%%%% clear " ^ (string_of_int (new_nr_of_hyp_still_to_elim))); (S.clear ~hyp:(List.nth context (new_nr_of_hyp_still_to_elim))) end)
+                                   else begin debug_print ("%%%%%%% clear " ^ (string_of_int (new_nr_of_hyp_still_to_elim))); (S.clear ~hyp:hyp_name) end)
                                 ~continuation:(ProofEngineTypes.mk_tactic (elim_clear_tac ~term':(C.Rel new_nr_of_hyp_still_to_elim) ~nr_of_hyp_still_to_elim:new_nr_of_hyp_still_to_elim)))
                                 status
                         )))
index 8cbfed96b9a9b13aef53f70ee58089be41554df7..b9db6f705777eb9ae7acb09bace47a5cc6b1857c 100644 (file)
@@ -143,8 +143,9 @@ let rewrite_back_simpl_tac ?where ~term () =
   ProofEngineTypes.mk_tactic (rewrite_back_simpl_tac ~term)
 ;;
 
-let replace_tac ~what ~with_what =
- let replace_tac ~what ~with_what status =
+let replace_tac ~pattern ~with_what =
+(*
+ let replace_tac ~pattern ~with_what status =
   let (proof, goal) = status in
   let module C = Cic in
   let module U = UriManager in
@@ -179,6 +180,7 @@ let replace_tac ~what ~with_what =
       raise (ProofEngineTypes.Fail "Replace: empty context")
  in
    ProofEngineTypes.mk_tactic (replace_tac ~what ~with_what)
+*) assert false
 ;;
 
 
index 698b34e9c9edc79c3b2e246f5668e3ad350d376f..d156ae440d0199940fa8f8b0d47e849c8f74e759 100644 (file)
@@ -37,7 +37,8 @@ val rewrite_back_simpl_tac:
   term:Cic.term -> unit -> ProofEngineTypes.tactic
   
 val replace_tac: 
-  what:Cic.term -> with_what:Cic.term -> ProofEngineTypes.tactic
+  pattern:ProofEngineTypes.pattern ->
+  with_what:Cic.term -> ProofEngineTypes.tactic
 
 val reflexivity_tac: ProofEngineTypes.tactic
 val symmetry_tac: ProofEngineTypes.tactic
index 2ee088edbaf551c19239c51a2aab496a6b1dc8c4..724d2c64708d4e4f0a6c2e07d6cf31e49a7224e0 100644 (file)
@@ -693,7 +693,7 @@ let tac_zero_infeq_false gl (n,d) =
    (Tacticals.then_
     ~start:
       (ReductionTactics.fold_tac ~reduction:CicReduction.whd
-        ~also_in_hypotheses:false
+        ~pattern:([],None)
         ~term:
           (Cic.Appl
             [_Rle ; _R0 ;
index 81385510c15c10a8e11aa1ed6a57f19f6698a3f2..4d4eef84909c77f72c9df07397d3b0bd26a25de6 100644 (file)
@@ -56,8 +56,5 @@ val elim_intros_simpl_tac:
 val elim_intros_tac:
   term: Cic.term -> ProofEngineTypes.tactic 
 
-val elim_intros_tac:
-  term: Cic.term -> ProofEngineTypes.tactic 
-
 val change_tac:
   what: Cic.term -> with_what: Cic.term -> ProofEngineTypes.tactic 
index 3b8b6f92c933c89b01ee7e264dae952ed9436be2..17378ffe79c8efffe0feaec4538f6871d2d1673e 100644 (file)
@@ -28,135 +28,131 @@ open ProofEngineTypes
 let clearbody ~hyp = 
  let clearbody ~hyp (proof, goal) =
   let module C = Cic in
-   match hyp with
-      None -> assert false
-    | Some (_, C.Def (_, Some _)) -> assert false
-    | Some (_, C.Decl _) -> raise (Fail "No Body To Clear")
-    | Some (n_to_clear_body, C.Def (term,None)) as hyp_to_clear_body ->
-       let curi,metasenv,pbo,pty = proof in
-        let metano,_,_ = CicUtil.lookup_meta goal metasenv in
-         let string_of_name =
-          function
-             C.Name n -> n
-           | C.Anonymous -> "_"
-         in
-         let metasenv' =
-          List.map
-           (function
-               (m,canonical_context,ty) when m = metano ->
-                 let canonical_context' =
-                  List.fold_right
-                   (fun entry context ->
-                     match entry with
-                        t when t == hyp_to_clear_body ->
-                         let cleared_entry =
-                          let ty,_ =
-                           CicTypeChecker.type_of_aux' metasenv context term
-                            CicUniv.empty_ugraph (* TASSI: FIXME *)
-                          in
-                           Some (n_to_clear_body, Cic.Decl ty)
-                         in
-                          cleared_entry::context
-                      | None -> None::context
-                      | Some (n,C.Decl t)
-                      | Some (n,C.Def (t,None)) ->
-                         let _,_ =
-                          try
-                           CicTypeChecker.type_of_aux' metasenv context t
-                            CicUniv.empty_ugraph (* TASSI: FIXME *)
-                          with
-                           _ ->
-                             raise
-                              (Fail
-                                ("The correctness of hypothesis " ^
-                                 string_of_name n ^
-                                 " relies on the body of " ^
-                                 string_of_name n_to_clear_body)
-                              )
-                         in
-                          entry::context
-                      | Some (_,Cic.Def (_,Some _)) -> assert false
-                   ) canonical_context []
-                 in
-                  let _,_ =
-                   try
-                    CicTypeChecker.type_of_aux' metasenv canonical_context' ty
-                     CicUniv.empty_ugraph (* TASSI: FIXME *)
-                   with
-                    _ ->
-                     raise
-                      (Fail
-                       ("The correctness of the goal relies on the body of " ^
-                        string_of_name n_to_clear_body))
-                  in
-                   m,canonical_context',ty
-             | t -> t
-           ) metasenv
-         in
-          (curi,metasenv',pbo,pty), [goal]
+   let curi,metasenv,pbo,pty = proof in
+    let metano,_,_ = CicUtil.lookup_meta goal metasenv in
+     let string_of_name =
+      function
+         C.Name n -> n
+       | C.Anonymous -> "_"
+     in
+     let metasenv' =
+      List.map
+       (function
+           (m,canonical_context,ty) when m = metano ->
+             let canonical_context' =
+              List.fold_right
+               (fun entry context ->
+                 match entry with
+                    Some (C.Name hyp',C.Def (term,ty)) when hyp = hyp' ->
+                     let cleared_entry =
+                      let ty =
+                       match ty with
+                          Some ty -> ty
+                        | None ->
+                           fst
+                            (CicTypeChecker.type_of_aux' metasenv context term
+                              CicUniv.empty_ugraph) (* TASSI: FIXME *)
+                      in
+                       Some (C.Name hyp, Cic.Decl ty)
+                     in
+                      cleared_entry::context
+                  | None -> None::context
+                  | Some (n,C.Decl t)
+                  | Some (n,C.Def (t,None)) ->
+                     let _,_ =
+                      try
+                       CicTypeChecker.type_of_aux' metasenv context t
+                        CicUniv.empty_ugraph (* TASSI: FIXME *)
+                      with
+                       _ ->
+                         raise
+                          (Fail
+                            ("The correctness of hypothesis " ^
+                             string_of_name n ^
+                             " relies on the body of " ^ hyp)
+                          )
+                     in
+                      entry::context
+                  | Some (_,Cic.Def (_,Some _)) -> assert false
+               ) canonical_context []
+             in
+              let _,_ =
+               try
+                CicTypeChecker.type_of_aux' metasenv canonical_context' ty
+                 CicUniv.empty_ugraph (* TASSI: FIXME *)
+               with
+                _ ->
+                 raise
+                  (Fail
+                   ("The correctness of the goal relies on the body of " ^
+                    hyp))
+              in
+               m,canonical_context',ty
+         | t -> t
+       ) metasenv
+     in
+      (curi,metasenv',pbo,pty), [goal]
  in
   mk_tactic (clearbody ~hyp)
 
 let clear ~hyp =
- let clear ~hyp:hyp_to_clear (proof, goal) =
+ let clear ~hyp (proof, goal) =
   let module C = Cic in
-   match hyp_to_clear with
-      None -> assert false
-    | Some (n_to_clear, _) ->
-       let curi,metasenv,pbo,pty = proof in
-        let metano,context,ty =
-         CicUtil.lookup_meta goal metasenv
-        in
-         let string_of_name =
-          function
-             C.Name n -> n
-           | C.Anonymous -> "_"
-         in
-         let metasenv' =
-          List.map
-           (function
-               (m,canonical_context,ty) when m = metano ->
-                 let canonical_context' =
-                  List.fold_right
-                   (fun entry context ->
-                     match entry with
-                        t when t == hyp_to_clear -> None::context
-                      | None -> None::context
-                      | Some (_,Cic.Def (_,Some _)) -> assert false
-                      | Some (n,C.Decl t)
-                      | Some (n,C.Def (t,None)) ->
-                         let _,_ =
-                          try
-                           CicTypeChecker.type_of_aux' metasenv context t
-                            CicUniv.empty_ugraph (* TASSI: FIXME *)
-                          with
-                           _ ->
-                             raise
-                              (Fail
-                                ("Hypothesis " ^
-                                 string_of_name n ^
-                                 " uses hypothesis " ^
-                                 string_of_name n_to_clear)
-                              )
-                         in
-                          entry::context
-                   ) canonical_context []
-                 in
-                  let _,_ =
-                   try
-                    CicTypeChecker.type_of_aux' metasenv canonical_context' ty
-                     CicUniv.empty_ugraph (* TASSI: FIXME *)
-                   with
-                    _ ->
-                     raise
-                      (Fail
-                       ("Hypothesis " ^ string_of_name n_to_clear ^
-                        " occurs in the goal"))
-                  in
-                   m,canonical_context',ty
-             | t -> t
-           ) metasenv
-         in
-          (curi,metasenv',pbo,pty), [goal]
+   let curi,metasenv,pbo,pty = proof in
+    let metano,context,ty =
+     CicUtil.lookup_meta goal metasenv
+    in
+     let string_of_name =
+      function
+         C.Name n -> n
+       | C.Anonymous -> "_"
+     in
+     let metasenv' =
+      List.map
+       (function
+           (m,canonical_context,ty) when m = metano ->
+             let canonical_context' =
+              List.fold_right
+               (fun entry context ->
+                 match entry with
+                    Some (Cic.Name hyp',_) when hyp' = hyp -> None::context
+                  | None -> None::context
+                  | Some (_,Cic.Def (_,Some _)) -> assert false
+                  | Some (n,C.Decl t)
+                  | Some (n,C.Def (t,None)) ->
+                     let _,_ =
+                      try
+                       CicTypeChecker.type_of_aux' metasenv context t
+                        CicUniv.empty_ugraph (* TASSI: FIXME *)
+                      with _ ->
+                       raise
+                        (Fail
+                          ("Hypothesis " ^ string_of_name n ^
+                           " uses hypothesis " ^ hyp))
+                     in
+                      entry::context
+               ) canonical_context []
+             in
+              let _,_ =
+               try
+                CicTypeChecker.type_of_aux' metasenv canonical_context' ty
+                 CicUniv.empty_ugraph (* TASSI: FIXME *)
+               with _ ->
+                raise (Fail ("Hypothesis " ^ hyp ^ " occurs in the goal"))
+              in
+               m,canonical_context',ty
+         | t -> t
+       ) metasenv
+     in
+      (curi,metasenv',pbo,pty), [goal]
  in
   mk_tactic (clear ~hyp)
+
+let set_goal n =
+  ProofEngineTypes.mk_tactic
+    (fun (proof, goal) ->
+       let (_, metasenv, _, _) = proof in
+       if CicUtil.exists_meta n metasenv then
+         (proof, [n])
+       else
+         raise (ProofEngineTypes.Fail ("no such meta: " ^ string_of_int n)))
index 32ba812ace93f5de25ea1e688bc3c3a305a28d1a..142b82b6812e1306a385c429e9ba044e43cb128e 100644 (file)
@@ -23,5 +23,8 @@
  * http://cs.unibo.it/helm/.
  *)
 
-val clearbody: hyp: Cic.hypothesis -> ProofEngineTypes.tactic
-val clear: hyp: Cic.hypothesis -> ProofEngineTypes.tactic
+val clearbody: hyp:string -> ProofEngineTypes.tactic
+val clear: hyp:string -> ProofEngineTypes.tactic
+
+  (* change the current goal to those referred by the given meta number *)
+val set_goal: int -> ProofEngineTypes.tactic
index 430414b78b8f25376355b126afe3d5a727ce0ae2..bfbfdb2a37c0a1113336f9b2d8dec4339f799859 100644 (file)
@@ -125,15 +125,13 @@ let whd_tac ~pattern =
 let normalize_tac ~pattern = 
  mk_tactic (reduction_tac ~reduction:CicReduction.normalize ~pattern );;
 
-let fold_tac ~reduction ~also_in_hypotheses ~term =
- let fold_tac ~reduction ~also_in_hypotheses ~term (proof,goal) =
+let fold_tac ~reduction ~pattern ~term =
+(*
+ let fold_tac ~reduction ~pattern:(hyp_patterns,goal_pattern) ~term (proof,goal)
+ =
   let curi,metasenv,pbo,pty = proof in
   let metano,context,ty = CicUtil.lookup_meta goal metasenv in
    let term' = reduction context term in
-    (* We don't know if [term] is a subterm of [ty] or a subterm of *)
-    (* the type of one metavariable. So we replace it everywhere.   *)
-    (*CSC: ma si potrebbe ovviare al problema. Ma non credo *)
-    (*CSC: che si guadagni nulla in fatto di efficienza.    *) 
     let replace =
      ProofEngineReduction.replace ~equality:(=) ~what:[term'] ~with_what:[term]
     in
@@ -160,5 +158,6 @@ let fold_tac ~reduction ~also_in_hypotheses ~term =
      in
       (curi,metasenv',pbo,pty), [metano]
  in
-  mk_tactic (fold_tac ~reduction ~also_in_hypotheses ~term)
+  mk_tactic (fold_tac ~reduction ~pattern ~term)
+*) assert false
 ;;
index bb4ca3c70bee42cb4472ef0484ccb1de8838a95a..dbee7c5cddd715f13b831a71391f37f0cdcc375d 100644 (file)
@@ -31,4 +31,4 @@ val normalize_tac: pattern:ProofEngineTypes.pattern -> ProofEngineTypes.tactic
 
 val fold_tac:
  reduction:(Cic.context -> Cic.term -> Cic.term) ->
also_in_hypotheses:bool -> term:Cic.term -> ProofEngineTypes.tactic
pattern:ProofEngineTypes.pattern -> term:Cic.term -> ProofEngineTypes.tactic
index cebb4cf91b35416d73a637cbf73a7aabb5861136..ab7bde56f8dfa4049ca0989ccb55e64d3ac7eada 100644 (file)
@@ -437,9 +437,15 @@ let purge_hyps_tac ~count =
     match (n, context) with
     | (0, _) -> status
     | (n, hd::tl) ->
-        aux (n-1) tl
-         (status_of_single_goal_tactic_result 
-         (ProofEngineTypes.apply_tactic (S.clear ~hyp:hd) status))
+        let name_of_hyp =
+         match hd with
+            None
+          | Some (Cic.Anonymous,_) -> assert false
+          | Some (Cic.Name name,_) -> name
+        in
+         aux (n-1) tl
+          (status_of_single_goal_tactic_result 
+          (ProofEngineTypes.apply_tactic (S.clear ~hyp:name_of_hyp) status))
     | (_, []) -> failwith "Ring.purge_hyps_tac: no hypotheses left"
   in
    let (_, metasenv, _, _) = proof in
index 62f1ce322c4a98be3b42ef890700b6588e903de5..3c89150adb96f80b1e1721e433eccce810c0d3e4 100644 (file)
@@ -194,7 +194,7 @@ let try_tactic ~tactic =
   mk_tactic (try_tactic ~tactic)
 ;;
 
-let fail = mk_tactic (fun _ -> raise (Fail "fail tactical"))
+let fail_tac = mk_tactic (fun _ -> raise (Fail "fail tactical"))
 
 (* This tries tactics until one of them doesn't _solve_ the goal *)
 (* TODO: si puo' unificare le 2(due) chiamate ricorsive? *)
@@ -226,55 +226,3 @@ let solve_tactics ~tactics =
  in
   mk_tactic (solve_tactics ~tactics)
 ;;
-
-
-
-
-
-
-
-
-
-
-  (** 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
-     debug_print ("eseguo find");
-     find 1 context
-   in
-    debug_print ("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 *)
-;;
-*)
-
-
index d7cc2754575375a55b1a7467289527a2f11af931..ab2f718238aebaab580376085b2b9ada202ed7f6 100644 (file)
@@ -54,8 +54,4 @@ val try_tactic:
 val solve_tactics:
  tactics: (string * ProofEngineTypes.tactic) list -> ProofEngineTypes.tactic
 
-val fail: ProofEngineTypes.tactic
-
-(*
-val prova_tac : ProofEngineTypes.tactic
-*)
+val fail_tac: ProofEngineTypes.tactic
index e67fa5fde13c4256376a67944a8b2597a38f4e1f..fc2c1c75dc39e7e4d54cd1e188183d95b4270042 100644 (file)
@@ -28,6 +28,8 @@ let apply = PrimitiveTactics.apply_tac
 let assumption = VariousTactics.assumption_tac
 let auto = AutoTactic.auto_tac
 let change = PrimitiveTactics.change_tac
+let clear = ProofEngineStructuralRules.clear
+let clearbody = ProofEngineStructuralRules.clearbody
 let compare = DiscriminationTactics.compare_tac
 let constructor = IntroductionTactics.constructor_tac
 let contradiction = NegationTactics.contradiction_tac
@@ -40,10 +42,12 @@ let elim_intros_simpl = PrimitiveTactics.elim_intros_simpl_tac
 let elim_type = EliminationTactics.elim_type_tac
 let exact = PrimitiveTactics.exact_tac
 let exists = IntroductionTactics.exists_tac
+let fail = Tacticals.fail_tac
 let fold = ReductionTactics.fold_tac
 let fourier = FourierR.fourier_tac
 let fwd_simpl = FwdSimplTactic.fwd_simpl_tac
 let generalize = VariousTactics.generalize_tac
+let id = Tacticals.id_tac
 let injection = DiscriminationTactics.injection_tac
 let intros = PrimitiveTactics.intros_tac
 let lapply = FwdSimplTactic.lapply_tac
@@ -59,7 +63,7 @@ let rewrite_back_simpl = EqualityTactics.rewrite_back_simpl_tac
 let rewrite_simpl = EqualityTactics.rewrite_simpl_tac
 let right = IntroductionTactics.right_tac
 let ring = Ring.ring_tac
-let set_goal = VariousTactics.set_goal
+let set_goal = ProofEngineStructuralRules.set_goal
 let simpl = ReductionTactics.simpl_tac
 let split = IntroductionTactics.split_tac
 let symmetry = EqualityTactics.symmetry_tac
index d5016dabc7829eb9f149119462226f0b4a69fcfe..c4c1a32e43572c272d585629ab0f93149319c943 100644 (file)
@@ -6,6 +6,8 @@ val auto :
   ?depth:int ->
   ?width:int -> dbd:Mysql.dbd -> unit -> ProofEngineTypes.tactic
 val change : what:Cic.term -> with_what:Cic.term -> ProofEngineTypes.tactic
+val clear : hyp:string -> ProofEngineTypes.tactic
+val clearbody : hyp:string -> ProofEngineTypes.tactic
 val compare : term:Cic.term -> ProofEngineTypes.tactic
 val constructor : n:int -> ProofEngineTypes.tactic
 val contradiction : ProofEngineTypes.tactic
@@ -27,14 +29,17 @@ val elim_intros_simpl : term:Cic.term -> ProofEngineTypes.tactic
 val elim_type : term:Cic.term -> ProofEngineTypes.tactic
 val exact : term:Cic.term -> ProofEngineTypes.tactic
 val exists : ProofEngineTypes.tactic
+val fail : ProofEngineTypes.tactic
 val fold :
   reduction:(Cic.context -> Cic.term -> Cic.term) ->
-  also_in_hypotheses:bool -> term:Cic.term -> ProofEngineTypes.tactic
+  pattern:ProofEngineTypes.pattern ->
+  term:Cic.term -> ProofEngineTypes.tactic
 val fourier : ProofEngineTypes.tactic
 val fwd_simpl : what:Cic.term -> dbd:Mysql.dbd -> ProofEngineTypes.tactic
 val generalize :
   ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
   term:Cic.term -> ProofEngineTypes.pattern -> ProofEngineTypes.tactic
+val id : ProofEngineTypes.tactic
 val injection : term:Cic.term -> ProofEngineTypes.tactic
 val intros :
   ?howmany:int ->
@@ -50,7 +55,9 @@ val letin :
 val normalize : pattern:ProofEngineTypes.pattern -> ProofEngineTypes.tactic
 val reduce : pattern:ProofEngineTypes.pattern -> ProofEngineTypes.tactic
 val reflexivity : ProofEngineTypes.tactic
-val replace : what:Cic.term -> with_what:Cic.term -> ProofEngineTypes.tactic
+val replace :
+  pattern:ProofEngineTypes.pattern ->
+  with_what:Cic.term -> ProofEngineTypes.tactic
 val rewrite :
   ?where:ProofEngineTypes.pattern ->
   term:Cic.term -> unit -> ProofEngineTypes.tactic
index 9fcbb966fc2d9ae3072df98935d31bbdb1059fd7..226a8c87c831d29531078d1d56707ec3e9a919e0 100644 (file)
@@ -131,13 +131,3 @@ let generalize_tac
  in
   PET.mk_tactic (generalize_tac mk_fresh_name_callback ~term pattern)
 ;;
-
-let set_goal n =
-  ProofEngineTypes.mk_tactic
-    (fun (proof, goal) ->
-       let (_, metasenv, _, _) = proof in
-       if CicUtil.exists_meta n metasenv then
-         (proof, [n])
-       else
-         raise (ProofEngineTypes.Fail ("no such meta: " ^ string_of_int n)))
-
index 2c891b036b75e635a38242383c61e8530f62c162..264168ed71cc8763f3fbe7bf329b18cce76bb575 100644 (file)
@@ -32,6 +32,3 @@ val generalize_tac:
  ?mk_fresh_name_callback:ProofEngineTypes.mk_fresh_name_type ->
  term:Cic.term -> ProofEngineTypes.pattern ->
   ProofEngineTypes.tactic
-
-  (* change the current goal to those referred by the given meta number *)
-val set_goal: int -> ProofEngineTypes.tactic