]> matita.cs.unibo.it Git - helm.git/blobdiff - matita/components/ng_tactics/nInversion.ml
Most warnings turned into errors and avoided
[helm.git] / matita / components / ng_tactics / nInversion.ml
index dbbf0da0f4a17b225df93321cc8ffaf6230036a1..f1da10cb7a08c3ab60f22fbdd9381620cd5b6c04 100644 (file)
@@ -71,7 +71,7 @@ let rec jmeqpatt = function
 let rec mk_arrows ~jmeq xs ys selection target = 
   match selection,xs,ys with
     [],[],[] -> target
-  | false :: l,x::xs,y::ys -> mk_arrows ~jmeq xs ys l target
+  | false :: l,_x::xs,_y::ys -> mk_arrows ~jmeq xs ys l target
   | true :: l,x::xs,y::ys when jmeq ->
      NotationPt.Binder (`Forall, (mk_id "_",
        Some (mk_appl [mk_sym "jmsimeq" ; 
@@ -95,7 +95,7 @@ let subst_metasenv_and_fix_names status =
    status#set_obj(u,h,NCicUntrusted.apply_subst_metasenv status subst metasenv,subst,o)
 ;;
 
-let mk_inverter ~jmeq name is_ind it leftno ?selection outsort (status: #NCic.status) baseuri =
+let mk_inverter ~jmeq name _is_ind it leftno ?selection outsort (status: #NCic.status) baseuri =
  pp (lazy ("leftno = " ^ string_of_int leftno));
  let _,ind_name,ty,cl = it in
  pp (lazy ("arity: " ^ status#ppterm ~metasenv:[] ~subst:[] ~context:[] ty));
@@ -110,11 +110,10 @@ let mk_inverter ~jmeq name is_ind it leftno ?selection outsort (status: #NCic.st
  let nparams = List.length args in
 
  (* the default is a dependent inversion *)
- (*let is_dependent = selection = None in*)
- let is_dependent = true in
+ let is_dependent = (selection = None && (jmeq || nparams = 0)) in
 
  pp (lazy ("nparams = " ^ string_of_int nparams));
- if nparams = 0 
+ if (nparams = 0 && not is_dependent)
    then raise (Failure "inverter: the type must have at least one right parameter") 
    else 
      let xs = List.map (fun n -> "x" ^ (string_of_int n)) (HExtlib.list_seq 1 (leftno+nparams+1)) in
@@ -143,7 +142,7 @@ let mk_inverter ~jmeq name is_ind it leftno ?selection outsort (status: #NCic.st
        in (hypaux 1 ncons)
      in
     
-     let outsort, suffix = NCicElim.ast_of_sort outsort in
+     let outsort, _suffix = NCicElim.ast_of_sort outsort in
      let theorem =
       mk_prods xs
        (NotationPt.Binder (`Forall, (mk_id "Hterm", Some (mk_appl (List.map mk_id (ind_name::xs)))),
@@ -151,13 +150,13 @@ let mk_inverter ~jmeq name is_ind it leftno ?selection outsort (status: #NCic.st
         mk_prods hyplist (mk_appl (mk_id "P"::id_rs))))))
      in
      let status, theorem =
-      GrafiteDisambiguate.disambiguate_nobj status ~baseuri 
+      let attrs = `Generated, `Theorem, `InversionPrinciple in 
+      GrafiteDisambiguate.disambiguate_nobj status ~baseuri
        (baseuri ^ name ^ ".def",0,
          NotationPt.Theorem
-          (`Theorem,name,theorem,
-            Some (NotationPt.Implicit (`Tagged "inv")),`InversionPrinciple))
+          (name,theorem, 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
@@ -176,7 +175,11 @@ NotationPt.Implicit (`Tagged "end"));
       "",0,(None,[],
         Some (if jmeq then jmeqpatt selection
                      else leibpatt selection)) in
-     let elim_tac = if is_ind then NTactics.elim_tac else NTactics.cases_tac in
+     (* let elim_tac = if is_ind then NTactics.elim_tac else NTactics.cases_tac in *)
+     let elim_tac ~what ~where s =
+       try NTactics.elim_tac ~what ~where s 
+       with NTacStatus.Error _ -> NTactics.cases_tac ~what ~where s
+     in
      let status =
       NTactics.block_tac 
        (NTactics.branch_tac ::
@@ -202,6 +205,6 @@ NotationPt.Implicit (`Tagged "end"));
 
 let mk_inverter name is_ind it leftno ?selection outsort status baseuri =
  try mk_inverter ~jmeq:true name is_ind it leftno ?selection outsort status baseuri
- with NTacStatus.Error (s,_) -> 
+ with NTacStatus.Error (_s,_) -> 
    mk_inverter ~jmeq:false name is_ind it leftno ?selection outsort status baseuri
 ;;