X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fgrafite_engine%2FgrafiteEngine.ml;h=71ac2939a7c8d6a7ab94c17a584871c19ec6eabc;hb=fcbe3e8f67fa42c84a57e343ba5ef6a97ba8ca67;hp=5ae6e92ed682981d179a29d5f1d9549d5dfc56f9;hpb=a18562238677261e3d0b590e046290a14fe62e74;p=helm.git

diff --git a/helm/software/components/grafite_engine/grafiteEngine.ml b/helm/software/components/grafite_engine/grafiteEngine.ml
index 5ae6e92ed..71ac2939a 100644
--- a/helm/software/components/grafite_engine/grafiteEngine.ml
+++ b/helm/software/components/grafite_engine/grafiteEngine.ml
@@ -487,8 +487,10 @@ let inject_unification_hint =
  =
   let t = refresh_uri_in_term t in basic_eval_unification_hint (t,n)
  in
-  NCicLibrary.Serializer.register 
-    "unification_hints" basic_eval_unification_hint
+  NCicLibrary.Serializer.register#run "unification_hints"
+   object(_ : 'a NCicLibrary.register_type)
+     method run = basic_eval_unification_hint
+   end
 ;;
 
 let eval_unification_hint status t n = 
@@ -502,6 +504,48 @@ let eval_unification_hint status t n =
   status,`New []
 ;;
 
+let basic_index_obj l status =
+  status#set_auto_cache 
+    (List.fold_left
+      (fun t (k,v) -> 
+         NDiscriminationTree.DiscriminationTree.index t k v) 
+    status#auto_cache l) 
+;;     
+
+let record_index_obj = 
+ let aux l 
+   ~refresh_uri_in_universe 
+   ~refresh_uri_in_term
+ =
+    basic_index_obj
+      (List.map 
+        (fun k,v -> refresh_uri_in_term k, refresh_uri_in_term v) 
+      l)
+ in
+  NCicLibrary.Serializer.register#run "index_obj"
+   object(_ : 'a NCicLibrary.register_type)
+     method run = aux
+   end
+;;
+
+let index_obj_for_auto status (uri, height, _, _, kind) = 
+ let data = 
+  match kind with
+  | NCic.Fixpoint _ -> []
+  | NCic.Inductive _ -> []
+  | NCic.Constant (_,_,Some _, ty, _) ->
+     let ty,_,_ = NCicMetaSubst.saturate [] [] [] ty 0 in
+      [ty,NCic.Const(NReference.reference_of_spec uri (NReference.Def height))]
+  | NCic.Constant (_,_,None, ty, _) ->
+     let ty,_,_ = NCicMetaSubst.saturate [] [] [] ty 0 in
+      [ty,NCic.Const(NReference.reference_of_spec uri (NReference.Decl))]
+ in
+ let status = basic_index_obj data status in
+ let dump = record_index_obj data :: status#dump in
+ status#set_dump dump
+;; 
+
+
 let basic_eval_add_constraint (u1,u2) status =
  NCicLibrary.add_constraint status u1 u2
 ;;
@@ -515,7 +559,10 @@ let inject_constraint =
   let u2 = refresh_uri_in_universe u2 in 
   basic_eval_add_constraint (u1,u2)
  in
-  NCicLibrary.Serializer.register "constraints" basic_eval_add_constraint
+  NCicLibrary.Serializer.register#run "constraints"
+   object(_:'a NCicLibrary.register_type)
+     method run = basic_eval_add_constraint 
+   end
 ;;
 
 let eval_add_constraint status u1 u2 = 
@@ -648,7 +695,7 @@ let eval_ng_tac tac =
           (text,prefix_len,concl))
        ) seqs)
   | GrafiteAst.NAuto (_loc, (l,a)) ->
-      NTactics.auto_tac
+      NAuto.auto_tac
 	~params:(List.map (fun x -> "",0,x) l,a)
   | GrafiteAst.NBranch _ -> NTactics.branch_tac 
   | GrafiteAst.NCases (_loc, what, where) ->
@@ -709,6 +756,7 @@ let subst_metasenv_and_fix_names status =
    status#set_obj(u,h,NCicUntrusted.apply_subst_metasenv subst metasenv,subst,o)
 ;;
 
+
 let rec eval_ncommand opts status (text,prefix_len,cmd) =
   match cmd with
   | GrafiteAst.UnificationHint (loc, t, n) -> eval_unification_hint status t n
@@ -748,6 +796,7 @@ let rec eval_ncommand opts status (text,prefix_len,cmd) =
         let obj = uri,height,[],[],obj_kind in
         let old_status = status in
         let status = NCicLibrary.add_obj status obj in
+        let status = index_obj_for_auto status obj in
 (*         prerr_endline (NCicPp.ppobj obj); *)
         HLog.message ("New object: " ^ NUri.string_of_uri uri);
          (try
@@ -780,7 +829,29 @@ let rec eval_ncommand opts status (text,prefix_len,cmd) =
                | NCicTypeChecker.TypeCheckerFailure _ ->
                   HLog.warn "error in generating projection/eliminator";
                   status,uris
-             ) (status,`New [] (* uris *)) boxml in
+             ) (status,`New [] (* uris *)) boxml in             
+           let _,_,_,_,nobj = obj in 
+           let status = match nobj with
+               NCic.Inductive (true,leftno,[it],_) ->
+                 let _,ind_name,ty,cl = it in
+                 List.fold_left 
+                   (fun status outsort ->
+                      let status = status#set_ng_mode `ProofMode in
+                      try
+                       (let status,invobj = NInversion.mk_inverter 
+                                      (ind_name ^ "_inv_" ^ (snd (NCicElim.ast_of_sort outsort))) 
+                                      it leftno outsort status status#baseuri in
+                       let _,_,menv,_,_ = invobj in
+                       fst (match menv with
+                             [] -> eval_ncommand opts status ("",0,GrafiteAst.NQed Stdpp.dummy_loc)
+                           | _ -> status,`New []))
+                      with _ -> HLog.warn "error in generating inversion principle"; 
+                                let status = status#set_ng_mode `CommandMode in status)
+                  status
+                  (NCic.Prop::
+                    List.map (fun s -> NCic.Type s) (NCicEnvironment.get_universes ()))
+              | _ -> status
+           in
            let coercions =
             match obj with
               _,_,_,_,NCic.Inductive