]> matita.cs.unibo.it Git - helm.git/blobdiff - matita/components/ng_tactics/nTactics.ml
Most warnings turned into errors and avoided
[helm.git] / matita / components / ng_tactics / nTactics.ml
index dbc134319424b94f1397903077ebc1e38e68772c..1aba2be9d46002737c49d5f09a9f9b3c9446fd00 100644 (file)
@@ -312,7 +312,7 @@ let assumption_tac status = distribute_tac (fun status goal ->
 let find_in_context name context =
   let rec aux acc = function
     | [] -> raise Not_found
-    | (hd,_) :: tl when hd = name -> acc
+    | (hd,_) :: _ when hd = name -> acc
     | _ :: tl ->  aux (acc + 1) tl
   in
   aux 1 context
@@ -390,7 +390,7 @@ let select0_tac ~where ~job  =
    let status, instance = 
      mk_meta status newgoalctx (`Decl newgoalty) `IsTerm
    in
-   instantiate ~refine:false status goal instance)
+   instantiate ~refine:false status goal instance) 
 ;;
 
 let select_tac ~where:((txt,txtlen,(wanted,hyps,path)) as where) ~job
@@ -424,7 +424,7 @@ let generalize_tac ~where =
                _,_,(None,_,_)  -> fail (lazy "No term to generalize")
              | txt,txtlen,(Some what,_,_) ->
                 let status, what =
-                 disambiguate status (ctx_of goalty) (txt,txtlen,what) None
+                 disambiguate status (ctx_of goalty) (txt,txtlen,what) `XTNone
                 in
                  status,what,[]
            )
@@ -466,7 +466,8 @@ let reduce_tac ~reduction ~where =
 
 let change_tac ~where ~with_what =
   let change status t = 
-    let status, ww = disambiguate status (ctx_of t) with_what  None in
+(* FG: `XTSort could be used when we change the whole goal *)    
+    let status, ww = disambiguate status (ctx_of t) with_what `XTNone in
     let status = unify status (ctx_of t) t ww in
     status, ww
   in
@@ -499,9 +500,9 @@ let ref_of_indtyinfo iti = iti.reference;;
 let analyze_indty_tac ~what indtyref =
  distribute_tac (fun (status as orig_status) goal ->
   let goalty = get_goalty status goal in
-  let status, what = disambiguate status (ctx_of goalty) what None in
+  let status, what = disambiguate status (ctx_of goalty) what `XTInd in
   let status, ty_what = typeof status (ctx_of what) what in 
-  let status, (r,consno,lefts,rights) = analyse_indty status ty_what in
+  let _status, (r,consno,lefts,rights) = analyse_indty status ty_what in
   let leftno = List.length lefts in
   let rightno = List.length rights in
   indtyref := Some { 
@@ -514,7 +515,9 @@ let sort_of_goal_tac sortref = distribute_tac (fun status goal ->
   let goalty = get_goalty status goal in
   let status,sort = typeof status (ctx_of goalty) goalty in
   let status, sort = fix_sorts status sort in
-  let status, sort = term_of_cic_term status sort (ctx_of goalty) in
+  let ctx = ctx_of goalty in
+  let status, sort = whd status (ctx_of sort) sort in
+  let status, sort = term_of_cic_term status sort ctx in
    sortref := sort;
    status)
 ;;
@@ -592,14 +595,14 @@ let intros_tac ?names_ref names s =
 
 let cases ~what status goal =
  let gty = get_goalty status goal in
- let status, what = disambiguate status (ctx_of gty) what None in
+ let status, what = disambiguate status (ctx_of gty) what `XTInd in
  let status, ty = typeof status (ctx_of what) what in
  let status, (ref, consno, _, _) = analyse_indty status ty in
  let status, what = term_of_cic_term status what (ctx_of gty) in
  let t =
   NCic.Match (ref,NCic.Implicit `Term, what,
     HExtlib.mk_list (NCic.Implicit `Term) consno)
- in
+ in 
  instantiate status goal (mk_cic_term (ctx_of gty) t)
 ;;
 
@@ -624,9 +627,9 @@ let case1_tac name =
 ;;
 
 let constructor_tac ?(num=1) ~args = distribute_tac (fun status goal ->
-  if num < 1 then fail (lazy "constructor numbers begin with 1");
   let gty = get_goalty status goal in
-  let status, (r,_,_,_) = analyse_indty status gty in
+  let status, (r,consno,_,_) = analyse_indty status gty in
+  if num < 1 || num > consno then fail (lazy "Non existant constructor");
   let ref = NReference.mk_constructor num r in
   let t = 
     if args = [] then Ast.NRef ref else
@@ -639,7 +642,7 @@ let constructor_tac ?(num=1) ~args = distribute_tac (fun status goal ->
 let assert0_tac (hyps,concl) = distribute_tac (fun status goal ->
  let gty = get_goalty status goal in
  let eq status ctx t1 t2 =
-  let status,t1 = disambiguate status ctx t1 None in
+  let status,t1 = disambiguate status ctx t1 `XTSort in
   let status,t1 = apply_subst status ctx t1 in
   let status,t1 = term_of_cic_term status t1 ctx in
   let t2 = mk_cic_term ctx t2 in
@@ -672,7 +675,7 @@ let assert0_tac (hyps,concl) = distribute_tac (fun status goal ->
 let assert_tac seqs status =
  match status#stack with
   | [] -> assert false
-  | (g,_,_,_) :: s ->
+  | (g,_,_,_) :: _s ->
      assert (List.length g = List.length seqs);
      (match seqs with
          [] -> id_tac
@@ -705,7 +708,7 @@ let inversion_tac ~what:(txt,len,what) ~where =
      in
      let eliminator = 
        let _,_,w = what in
-       Ast.Appl [ Ast.Ident (name,None) ; Ast.Implicit `Vector ; w ]
+       Ast.Appl [ Ast.Ident (name,None) ; Ast.Implicit `Vector ; w ; Ast.Implicit `Vector]
      in
      exact_tac ("",0,eliminator) status) ]) 
 ;;