X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fgrafite_engine%2FgrafiteEngine.ml;h=89673e7d75dae131b867114380e98b37fec483f6;hb=d0e97750e19af9286400a3e7b161a1c658684848;hp=fd8d776c180749023a85e4c87a4d266113482aa0;hpb=f8d45b2e4fa7817d7ef8312b3bb8a7439bd7fb8c;p=helm.git

diff --git a/helm/software/components/grafite_engine/grafiteEngine.ml b/helm/software/components/grafite_engine/grafiteEngine.ml
index fd8d776c1..89673e7d7 100644
--- a/helm/software/components/grafite_engine/grafiteEngine.ml
+++ b/helm/software/components/grafite_engine/grafiteEngine.ml
@@ -530,18 +530,9 @@ let record_index_obj =
    end
 ;;
 
-let index_obj_for_auto status (uri, height, _, _, kind) = 
+let compute_keys uri height kind = 
  let mk_item orig_ty spec =
-   let ty,_,_ = NCicMetaSubst.saturate ~delta:max_int [] [] [] orig_ty 0 in
-   let keys = 
-     match ty with
-     | NCic.Const (NReference.Ref (_,NReference.Def h)) 
-     | NCic.Appl (NCic.Const (NReference.Ref (_,NReference.Def h))::_) 
-        when h > 0 ->
-          let ty',_,_= NCicMetaSubst.saturate ~delta:(h-1) [] [] [] orig_ty 0 in
-          [ty;ty']
-     | _ -> [ty]
-   in
+  let keys = NnAuto.keys_of_cic_term [] [] [] orig_ty in
    keys,NCic.Const(NReference.reference_of_spec uri spec)
  in
  let data = 
@@ -564,7 +555,7 @@ let index_obj_for_auto status (uri, height, _, _, kind) =
   | NCic.Constant (_,_,None, ty, _) ->
      [ mk_item ty NReference.Decl ]
  in
- let data = HExtlib.filter_map
+  HExtlib.filter_map
    (fun (keys, t) ->
      let keys = List.filter
        (function 
@@ -588,12 +579,46 @@ let index_obj_for_auto status (uri, height, _, _, kind) =
         None
       end)
    data
- in
- let status = basic_index_obj data status in
- let dump = record_index_obj data :: status#dump in
- status#set_dump dump
+;;
+
+let index_obj_for_auto status (uri, height, _, _, kind) = 
+ (*prerr_endline (string_of_int height);*)
+  let data = compute_keys uri height kind in
+  let status = basic_index_obj data status in
+  let dump = record_index_obj data :: status#dump in   
+  status#set_dump dump
 ;; 
 
+let index_eq uri status =
+  let eq_status = status#eq_cache in
+  let eq_status1 = NCicParamod.index_obj eq_status uri in
+    status#set_eq_cache eq_status1
+;;
+
+let record_index_eq =
+ let basic_index_eq uri
+   ~refresh_uri_in_universe 
+   ~refresh_uri_in_term 
+   = index_eq (NCicLibrary.refresh_uri uri) 
+ in
+  NCicLibrary.Serializer.register#run "index_eq"
+   object(_ : 'a NCicLibrary.register_type)
+     method run = basic_index_eq
+   end
+;;
+
+let index_eq_for_auto status uri =
+ if NnAuto.is_a_fact_obj status uri then
+   let newstatus = index_eq uri status in
+     if newstatus#eq_cache == status#eq_cache then status 
+     else
+       ((*prerr_endline ("recording " ^ (NUri.string_of_uri uri));*)
+	let dump = record_index_eq uri :: newstatus#dump 
+	in newstatus#set_dump dump)
+ else 
+   ((*prerr_endline "Not a fact";*)
+   status)
+;; 
 
 let basic_eval_add_constraint (u1,u2) status =
  NCicLibrary.add_constraint status u1 u2
@@ -721,7 +746,7 @@ let eval_ng_punct (_text, _prefix_len, punct) =
   match punct with
   | GrafiteAst.Dot _ -> NTactics.dot_tac 
   | GrafiteAst.Semicolon _ -> fun x -> x
-  | GrafiteAst.Branch _ -> NTactics.branch_tac 
+  | GrafiteAst.Branch _ -> NTactics.branch_tac ~force:false
   | GrafiteAst.Shift _ -> NTactics.shift_tac 
   | GrafiteAst.Pos (_,l) -> NTactics.pos_tac l
   | GrafiteAst.Wildcard _ -> NTactics.wildcard_tac 
@@ -732,6 +757,8 @@ let eval_ng_tac tac =
  let rec aux f (text, prefix_len, tac) =
   match tac with
   | GrafiteAst.NApply (_loc, t) -> NTactics.apply_tac (text,prefix_len,t) 
+  | GrafiteAst.NSmartApply (_loc, t) -> 
+      NnAuto.smart_apply_tac (text,prefix_len,t) 
   | GrafiteAst.NAssert (_loc, seqs) ->
      NTactics.assert_tac
       ((List.map
@@ -743,10 +770,11 @@ let eval_ng_tac tac =
            ) hyps,
           (text,prefix_len,concl))
        ) seqs)
-  | GrafiteAst.NAuto (_loc, (l,a)) ->
+  | GrafiteAst.NAuto (_loc, (None,a)) -> NAuto.auto_tac ~params:(None,a)
+  | GrafiteAst.NAuto (_loc, (Some l,a)) ->
       NAuto.auto_tac
-	~params:(List.map (fun x -> "",0,x) l,a)
-  | GrafiteAst.NBranch _ -> NTactics.branch_tac 
+	~params:(Some List.map (fun x -> "",0,x) l,a)
+  | GrafiteAst.NBranch _ -> NTactics.branch_tac ~force:false
   | GrafiteAst.NCases (_loc, what, where) ->
       NTactics.cases_tac 
         ~what:(text,prefix_len,what)
@@ -759,6 +787,9 @@ let eval_ng_tac tac =
      NTactics.constructor_tac 
        ?num ~args:(List.map (fun x -> text,prefix_len,x) args)
   | GrafiteAst.NCut (_loc, t) -> NTactics.cut_tac (text,prefix_len,t) 
+(*| GrafiteAst.NDiscriminate (_,what) -> NDestructTac.discriminate_tac ~what:(text,prefix_len,what)
+  | GrafiteAst.NSubst (_,what) -> NDestructTac.subst_tac ~what:(text,prefix_len,what)*)
+  | GrafiteAst.NDestruct _ -> NDestructTac.destruct_tac
   | GrafiteAst.NDot _ -> NTactics.dot_tac 
   | GrafiteAst.NElim (_loc, what, where) ->
       NTactics.elim_tac 
@@ -769,12 +800,17 @@ let eval_ng_tac tac =
       NTactics.generalize_tac ~where:(text,prefix_len,where)
   | GrafiteAst.NId _ -> (fun x -> x)
   | GrafiteAst.NIntro (_loc,n) -> NTactics.intro_tac n
+  | GrafiteAst.NInversion (_loc, what, where) ->
+      NTactics.inversion_tac 
+        ~what:(text,prefix_len,what)
+        ~where:(text,prefix_len,where)
   | GrafiteAst.NLApply (_loc, t) -> NTactics.lapply_tac (text,prefix_len,t) 
   | GrafiteAst.NLetIn (_loc,where,what,name) ->
       NTactics.letin_tac ~where:(text,prefix_len,where) 
         ~what:(text,prefix_len,what) name
   | GrafiteAst.NMerge _ -> NTactics.merge_tac 
   | GrafiteAst.NPos (_,l) -> NTactics.pos_tac l
+  | GrafiteAst.NPosbyname (_,s) -> NTactics.case_tac s
   | GrafiteAst.NReduce (_loc, reduction, where) ->
       NTactics.reduce_tac ~reduction ~where:(text,prefix_len,where)
   | GrafiteAst.NRewrite (_loc,dir,what,where) ->
@@ -845,7 +881,23 @@ 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
+        let index_obj =
+         match obj_kind with
+            NCic.Constant (_,_,_,_,(_,`Example,_))
+          | NCic.Fixpoint (_,_,(_,`Example,_)) -> false
+          | _ -> true
+        in
+        let status =
+         if index_obj then
+          let status = index_obj_for_auto status obj in
+           index_eq_for_auto status uri
+         else
+          status in
+(*
+	  try 
+	    index_eq uri status
+	  with _ -> prerr_endline "got an exception"; status
+	in *)
 (*         prerr_endline (NCicPp.ppobj obj); *)
         HLog.message ("New object: " ^ NUri.string_of_uri uri);
          (try
@@ -888,15 +940,17 @@ let rec eval_ncommand opts status (text,prefix_len,cmd) =
              ) (status,`New [] (* uris *)) boxml in             
            let _,_,_,_,nobj = obj in 
            let status = match nobj with
-               NCic.Inductive (true,leftno,[it],_) ->
+               NCic.Inductive (is_ind,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 status,invobj =
+                         NInversion.mk_inverter 
+                          (ind_name ^ "_inv_" ^
+                            (snd (NCicElim.ast_of_sort outsort)))
+                          is_ind 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)
@@ -991,6 +1045,24 @@ let rec eval_ncommand opts status (text,prefix_len,cmd) =
           [] ->
            eval_ncommand opts status ("",0,GrafiteAst.NQed Stdpp.dummy_loc)
         | _ -> status,`New [])
+  | GrafiteAst.NDiscriminator (_,_) -> assert false (*(loc, indty) ->
+      if status#ng_mode <> `CommandMode then
+        raise (GrafiteTypes.Command_error "Not in command mode")
+      else
+        let status = status#set_ng_mode `ProofMode in
+        let metasenv,subst,status,indty =
+          GrafiteDisambiguate.disambiguate_nterm None status [] [] [] (text,prefix_len,indty) in
+        let indtyno, (_,_,tys,_,_) = match indty with
+            NCic.Const ((NReference.Ref (_,NReference.Ind (_,indtyno,_))) as r) ->
+              indtyno, NCicEnvironment.get_checked_indtys r
+          | _ -> prerr_endline ("engine: indty expected... (fix this error message)"); assert false in
+        let it = List.nth tys indtyno in
+        let status,obj =  NDestructTac.mk_discriminator it status in
+        let _,_,menv,_,_ = obj in
+          (match menv with
+               [] -> eval_ncommand opts status ("",0,GrafiteAst.NQed Stdpp.dummy_loc)
+             | _ -> prerr_endline ("Discriminator: non empty metasenv");
+                    status, `New []) *)
   | GrafiteAst.NInverter (loc, name, indty, selection, sort) ->
      if status#ng_mode <> `CommandMode then
       raise (GrafiteTypes.Command_error "Not in command mode")
@@ -1015,7 +1087,7 @@ let rec eval_ncommand opts status (text,prefix_len,cmd) =
             indtyno, NCicEnvironment.get_checked_indtys r
         | _ -> prerr_endline ("engine: indty ="  ^ NCicPp.ppterm ~metasenv:[] ~subst:[] ~context:[] indty) ; assert false in
       let it = List.nth tys indtyno in
-     let status,obj = NInversion.mk_inverter name it leftno ?selection sort 
+     let status,obj = NInversion.mk_inverter name true it leftno ?selection sort 
                         status status#baseuri in
      let _,_,menv,_,_ = obj in
      (match menv with