]> matita.cs.unibo.it Git - helm.git/blobdiff - matita/components/ng_tactics/declarative.ml
Update online helper entries
[helm.git] / matita / components / ng_tactics / declarative.ml
index 4fa6b5bcbf85e8cab94c6d1690e3f4e44ccb398c..a136a51dd88afc306661a18aee087139dadaf99f 100644 (file)
@@ -43,19 +43,18 @@ let extract_first_goal_from_status status =
   let s = status#stack in
   match s with
   | [] -> fail (lazy "There's nothing to prove")
-  | (g1, _, k, tag1, _) :: tl ->
+  | (g1, _, _k, _tag1, _) :: _tl ->
     let goals = filter_open g1 in
     match goals with
       [] -> fail (lazy "No goals under focus")
-    | loc::tl -> 
+    | loc::_tl -> 
       let goal = goal_of_loc (loc) in
       goal ;;
 
 let extract_conclusion_type status goal =
   let gty = get_goalty status goal in
   let ctx = ctx_of gty in
-  let status,gty = term_of_cic_term status gty ctx in
-  gty
+  term_of_cic_term status gty ctx
 ;;
 
 let alpha_eq_tacterm_kerterm ty t status goal =
@@ -83,7 +82,7 @@ let clear_volatile_params_tac status =
   | (g,t,k,tag,p)::tl -> 
     let rec remove_volatile = function
         [] -> []
-      | (k,v as hd')::tl' ->
+      | (k,_v as hd')::tl' ->
         let re = Str.regexp "volatile_.*" in
         if Str.string_match re k 0 then
           remove_volatile tl'
@@ -107,7 +106,7 @@ let add_parameter_tac key value status =
 *)
 let lambda_abstract_tac id t1 status goal =
   match extract_conclusion_type status goal with
-  | NCic.Prod (_,t,_) ->
+  | status,NCic.Prod (_,t,_) ->
     if alpha_eq_tacterm_kerterm t1 t status goal then
       let (_,_,t1) = t1 in
       block_tac [exact_tac ("",0,(Ast.Binder (`Lambda,(Ast.Ident (id,None),Some t1),Ast.Implicit
@@ -136,12 +135,12 @@ let suppose t1 id status =
 ;;
 
 let assert_tac t1 t2 status goal continuation =
-  let t = extract_conclusion_type status goal in
+  let status,t = extract_conclusion_type status goal in
   if alpha_eq_tacterm_kerterm t1 t status goal then
     match t2 with
     | None -> continuation
     | Some t2 ->
-      let status,res = are_convertible t1 t2 status goal in
+      let _status,res = are_convertible t1 t2 status goal in
       if res then continuation
       else
         raise NotEquivalentTypes
@@ -161,7 +160,7 @@ let branch_dot_tac status =
 let status_parameter key status =
   match status#stack with
     [] -> ""
-  | (g,t,k,tag,p)::_ -> try List.assoc key p with _ -> ""
+  | (_g,_t,_k,_tag,p)::_ -> try List.assoc key p with _ -> ""
 ;;
 
 let beta_rewriting_step t status =
@@ -170,7 +169,7 @@ let beta_rewriting_step t status =
     (
       let newhypo = status_parameter "volatile_newhypo" status in
       if newhypo = "" then
-        fail (lazy "Invalid use of 'or equivalently'")
+        fail (lazy "Invalid use of 'that is equivalent to'")
       else
         change_tac ~where:("",0,(None,[newhypo,Ast.UserInput],None)) ~with_what:t status
     )
@@ -238,7 +237,6 @@ let we_need_to_prove t id status =
 
 let by_just_we_proved just ty id status =
   let goal = extract_first_goal_from_status status in
-  let wrappedjust = just in
   let just = mk_just status goal just in
   match id with
   | None ->
@@ -412,12 +410,12 @@ let print_goals_names_tac s (status:#NTacStatus.tac_status) =
 (* Useful as it does not change the order in the list *)
 let rec list_change_assoc k v = function
     [] -> []
-  | (k',v' as hd) :: tl -> if k' = k then (k',v) :: tl else hd :: (list_change_assoc k v tl)
+  | (k',_v' as hd) :: tl -> if k' = k then (k',v) :: tl else hd :: (list_change_assoc k v tl)
 ;;
 
 let add_names_to_goals_tac (cl:NCic.constructor list ref) (status:#NTacStatus.tac_status) =
   let add_name_to_goal name goal metasenv =
-    let (mattrs,ctx,t as conj) = try List.assoc goal metasenv with _ -> assert false in
+    let (mattrs,ctx,t) = try List.assoc goal metasenv with _ -> assert false in
     let mattrs = (`Name name) :: (List.filter (function `Name _ -> false | _ -> true) mattrs) in
     let newconj = (mattrs,ctx,t) in
     list_change_assoc goal newconj metasenv
@@ -427,7 +425,7 @@ let add_names_to_goals_tac (cl:NCic.constructor list ref) (status:#NTacStatus.ta
      * the new goals, when they are still under focus *)
     match status#stack with
       [] -> fail (lazy "Can not add names to an empty stack")
-    | (g,_,_,_,_) :: tl -> 
+    | (g,_,_,_,_) :: _tl -> 
       let rec sublist n = function
           [] -> []
         | hd :: tl -> if n = 0 then [] else hd :: (sublist (n-1) tl)
@@ -540,7 +538,11 @@ let we_proceed_by_cases_on ((txt,len,ast1) as t1)  t2 status =
   | FirstTypeWrong -> fail (lazy "What you want to prove is different from the conclusion")
 ;;
 
-let byinduction t1 id = suppose t1 id ;;
+let byinduction t1 id status =
+  let ctx = status_parameter "context" status in
+  if ctx <> "induction" then fail (lazy "You can't use this tactic outside of an induction context")
+  else suppose t1 id status
+;;
 
 let name_of_conj conj =
   let mattrs,_,_ = conj in
@@ -567,7 +569,7 @@ let rec loc_of_goal goal l =
 let has_focused_goal status =
   match status#stack with
     [] -> false
-  | ([],_,_,_,_) :: tl -> false
+  | ([],_,_,_,_) :: _tl -> false
   | _ -> true
 ;;