X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matita%2Fcomponents%2Fng_tactics%2FnDestructTac.ml;h=f25114817de9256f58ed85eb66167a38f30b3daa;hb=3f57ed2589601e79478c85d74708d8ebdec2cf20;hp=990cc672bbede15aaa17f8f9a2a088e8c452319e;hpb=5ac2dc4e01aca542ddd13c02b304c646d8df9799;p=helm.git

diff --git a/matita/components/ng_tactics/nDestructTac.ml b/matita/components/ng_tactics/nDestructTac.ml
index 990cc672b..f25114817 100644
--- a/matita/components/ng_tactics/nDestructTac.ml
+++ b/matita/components/ng_tactics/nDestructTac.ml
@@ -130,7 +130,7 @@ let arg_list nleft t =
 
 let nargs it nleft consno =
   pp (lazy (Printf.sprintf "nargs %d %d" nleft consno));
-  let _,indname,_,cl = it in
+  let _,_indname,_,cl = it in
   let _,_,t_k = List.nth cl consno in
   List.length (arg_list nleft t_k) ;;
 
@@ -174,7 +174,7 @@ let hp_pattern_jm n =
 (* creates the discrimination = injection+contradiction principle *)
 exception ConstructorTooBig of string;;
 
-let mk_discriminator ~use_jmeq name it leftno status baseuri =
+let mk_discriminator ~use_jmeq ?(force=false) name it leftno status baseuri =
   let itnargs = 
     let _,_,arity,_ = it in 
     List.length (arg_list 0 arity) in
@@ -291,7 +291,7 @@ let mk_discriminator ~use_jmeq name it leftno status baseuri =
                  List.map
                    (fun i -> 
                       let nargs_kty = nargs it leftno i in
-                      if (nargs_kty > 5 && not use_jmeq) then raise (ConstructorTooBig (kname i)); 
+                      if (nargs_kty > 5 && not use_jmeq && not force) then raise (ConstructorTooBig (kname i)); 
                       let ts = iter (fun m acc -> mk_id ("t" ^ (string_of_int m))::acc)
                                  (nargs_kty - 1) [] in
                      let nones = 
@@ -321,20 +321,20 @@ let mk_discriminator ~use_jmeq name it leftno status baseuri =
   (* PHASE 2: create the object for the proof of the principle: we'll name it
    * "theorem" *)
   let status, theorem =
-   GrafiteDisambiguate.disambiguate_nobj status ~baseuri 
+   let attrs = `Generated, `Theorem, `DiscriminationPrinciple in
+   GrafiteDisambiguate.disambiguate_nobj status ~baseuri
     (baseuri ^ name ^ ".def",0,
       NotationPt.Theorem
-       (`Theorem,name,principle,
-         Some (NotationPt.Implicit (`Tagged "inv")),`DiscriminationPrinciple))
+       (name, principle, Some (NotationPt.Implicit (`Tagged "inv")), attrs))
   in 
-  let uri,height,nmenv,nsubst,nobj = theorem in
+  let _uri,_height,nmenv,_nsubst,_nobj = theorem in
   let ninitial_stack = Continuationals.Stack.of_nmetasenv nmenv in
   let status = status#set_obj theorem in
   let status = status#set_stack ninitial_stack in
   let status = subst_metasenv_and_fix_names status in
 
   (* PHASE 3: we finally prove the discrimination principle *)
-  let dbranch it ~use_jmeq leftno consno =
+  let dbranch it ~use_jmeq:__ leftno consno =
     let refl_id = mk_sym "refl" in
     pp (lazy (Printf.sprintf "dbranch %d %d" leftno consno));
     let nlist = HExtlib.list_seq 0 (nargs it leftno consno) in
@@ -482,7 +482,7 @@ let subst_tac ~context ~dir skip cur_eq =
     else 
     let gen_tac x =
       (fun s -> 
-      let x' = String.concat " " x in
+      (*let x' = String.concat " " x in*)
       let x = List.map mk_id x in
       (* let s = NTactics.print_tac false ("@generalize " ^ x') s in *)
       generalize0_tac x s) in
@@ -619,7 +619,7 @@ let select_eq ctx acc domain status goal =
            | _ -> status, `NonEq 
            in match kind with
               | `Identity ->
-                  let status, goalty = term_of_cic_term status (get_goalty status goal) ctx in
+                  let status, _goalty = term_of_cic_term status (get_goalty status goal) ctx in
                      status, Some (List.length ctx - i), kind
               | `Cycle | `Blob | `NonEq -> aux (i+1) (* XXX: skip cyclic/blob equations for now *)
               | _ ->