]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/components/grafite_engine/grafiteEngine.ml
Added an implicit parameter to branch_tac to allow branching on a
[helm.git] / helm / software / components / grafite_engine / grafiteEngine.ml
index f1aea02da0a71efd0bece6fa26c0df667a5cc685..239d30d2d1480ff0b0c354a757cacbf4105cc058 100644 (file)
@@ -33,6 +33,7 @@ exception IncludedFileNotCompiled of string * string
 exception Macro of
  GrafiteAst.loc *
   (Cic.context -> GrafiteTypes.status * (Cic.term,Cic.lazy_term) GrafiteAst.macro)
+exception NMacro of GrafiteAst.loc * GrafiteAst.nmacro
 
 type 'a disambiguator_input = string * int * 'a
 
@@ -40,6 +41,11 @@ type options = {
   do_heavy_checks: bool ; 
 }
 
+let concat_nuris uris nuris =
+   match uris,nuris with
+   | `New uris, `New nuris -> `New (nuris@uris)
+   | _ -> assert false
+;;
 (** create a ProofEngineTypes.mk_fresh_name_type function which uses given
   * names as long as they are available, then it fallbacks to name generation
   * using FreshNamesGenerator module *)
@@ -481,7 +487,10 @@ let inject_unification_hint =
  =
   let t = refresh_uri_in_term t in basic_eval_unification_hint (t,n)
  in
-  NRstatus.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 = 
@@ -495,246 +504,150 @@ let eval_unification_hint status t n =
   status,`New []
 ;;
 
-let product f l1 l2 =
-  List.fold_left
-    (fun acc x ->
-      List.fold_left 
-        (fun acc y ->
-           f x y :: acc)
-        acc l2)
-    [] l1  
-;;
-
-let pos_in_list x l =
-      match 
-        HExtlib.list_findopt (fun y i -> if y = x then Some i else None) l
-      with
-      | Some i -> i
-      | None -> assert false
-;;
-
-let pos_of x t = 
-  match t with
-  | NCic.Appl l -> pos_in_list x l
-  | _ -> assert false
-;;
-
-let rec count_prod = function
-  | NCic.Prod (_,_,x) -> 1 + count_prod x
-  | _ -> 0
-;;
-
-let term_at i t =
-  match t with
-  | NCic.Appl l -> 
-      (match 
-        HExtlib.list_findopt (fun y j -> if i+1=j then Some y else None) l
-      with
-      | Some i -> i
-      | None -> assert false)
-  | _ -> assert false
-;;
+let basic_index_obj l status =
+  status#set_auto_cache 
+    (List.fold_left
+      (fun t (ks,v) -> 
+         List.fold_left (fun t k ->
+           NDiscriminationTree.DiscriminationTree.index t k v)
+          t ks) 
+    status#auto_cache l) 
+;;     
 
-let src_tgt_of_ty_cpos_arity ty cpos arity =
-  let pis = count_prod ty in
-  let tpos = pis - arity in
-  let rec aux i j = function
-    | NCic.Prod (_,s,_) when i = j -> s
-    | NCic.Prod (_,_,t) -> aux (i+1) j t
-    | t -> assert (i = j); t
-  in
-  let mask t =
-    let rec aux () = function
-      | NCic.Meta _ 
-      | NCic.Implicit _ as x -> x
-      | NCic.Rel _ -> NCic.Implicit `Type
-      | t -> NCicUtils.map (fun _ () -> ()) () aux t
-    in
-     aux () t
-  in 
-  mask (aux 0 cpos ty), mask (aux 0 tpos ty)
-;;
-
-let close_in_context t metasenv = 
-  let rec aux m_subst subst ctx = function
-   | (i,(tag,[],ty)) :: tl ->
-        let name = "x" ^ string_of_int (List.length ctx) in
-        let subst = (i,(tag,[],NCic.Rel (List.length tl+1),ty))::subst in
-        let ty = NCicUntrusted.apply_subst (m_subst (List.length ctx)) ctx ty in
-        let m_subst m = 
-          (i,(tag,[],NCic.Rel (m-List.length ctx),ty))::(m_subst m)
-        in
-        NCic.Lambda (name, ty, aux m_subst subst ((name,NCic.Decl ty)::ctx) tl)
-   | [] -> NCicUntrusted.apply_subst subst ctx
-             (NCicSubstitution.lift (List.length ctx) t)
-   | _ -> assert false
-  in
-  aux (fun _ -> []) [] [] metasenv
-;;
-
-let toposort metasenv = 
-  let module T = HTopoSort.Make(
-    struct type t = int * NCic.conjecture let compare (i,_) (j,_) = i-j end) 
-  in
-  let deps (_,(_,_,t)) =
-    List.filter (fun (j,_) -> 
-      List.mem j (NCicUntrusted.metas_of_term [] [] t)) metasenv
-  in
-  T.topological_sort metasenv deps
-;;
-
-let basic_eval_ncoercion (name,t,s,d,p,a) status =
-  let to_s = 
-    NCicCoercion.look_for_coercion status [] [] [] (NCic.Implicit `Type) s
-  in
-  let from_d = 
-    NCicCoercion.look_for_coercion status [] [] [] d (NCic.Implicit `Type)
-  in
-  let status = NCicCoercion.index_coercion status t s d a p in
-  let c =
-    List.find 
-     (function (_,NCic.Appl (x::_),_,_) -> x = t | _ -> assert false) 
-      (NCicCoercion.look_for_coercion status [] [] [] s d)
-  in
-  let composites = 
-    let to_s_o_c = 
-      product (fun (m1,t1,_,j) (mc,c,_,i) -> m1@mc,c,[i,t1],j,a) 
-        to_s [c]
-    in
-    let c_o_from_d = 
-      product (fun (mc,c,_,j) (m1,t1,ty,i) -> m1@mc,t1,[i,c],j,count_prod ty) 
-        [c] from_d
-    in
-    let to_s_o_c_o_from_d =
-      product (fun (m1,t1,_,j) (m,t,upl,i,a)-> 
-       m@m1,t,(i,t1)::upl,j,a)
-       to_s c_o_from_d
-    in
-    to_s_o_c @ c_o_from_d @ to_s_o_c_o_from_d
-  in
-  let composites =
-    HExtlib.filter_map
-     (fun (metasenv, bo, upl, p, arity) ->
-        try
-         let metasenv, subst = 
-           List.fold_left 
-            (fun (metasenv,subst) (a,b) ->
-                NCicUnification.unify status metasenv subst [] a b)
-            (metasenv,[]) upl
-         in
-         let bo = NCicUntrusted.apply_subst subst [] bo in
-         let metasenv = toposort metasenv in
-         let bo = close_in_context bo metasenv in
-         let pos = 
-           match p with 
-           | NCic.Meta (p,_) -> pos_in_list p (List.map fst metasenv) 
-           | _ -> assert false
-         in
-         let ty = NCicTypeChecker.typeof ~metasenv:[] ~subst:[] [] bo in
-         let src,tgt = src_tgt_of_ty_cpos_arity ty pos arity in
-         prerr_endline (
-           NCicPp.ppterm ~metasenv:[] ~subst:[] ~context:[] bo ^ " : " ^
-           NCicPp.ppterm ~metasenv:[] ~subst:[] ~context:[] ty ^ " as " ^
-           NCicPp.ppterm ~metasenv:[] ~subst:[] ~context:[] src ^ " ===> " ^
-           NCicPp.ppterm ~metasenv:[] ~subst:[] ~context:[] tgt ^
-           " cpos=" ^ string_of_int pos ^ " arity=" ^ string_of_int arity);
-         Some (bo,src,tgt,arity,pos)
-       with 
-       | NCicTypeChecker.TypeCheckerFailure _
-       | NCicUnification.UnificationFailure _ 
-       | NCicUnification.Uncertain _ -> None
-     ) composites
-  in
-  List.fold_left 
-    (fun st (t,s,d,a,p) -> NCicCoercion.index_coercion st t s d a p) 
-    status composites
+let record_index_obj = 
+ let aux l 
+   ~refresh_uri_in_universe 
+   ~refresh_uri_in_term
+ =
+    basic_index_obj
+      (List.map 
+        (fun ks,v -> List.map refresh_uri_in_term ks, refresh_uri_in_term v) 
+      l)
+ in
+  NCicLibrary.Serializer.register#run "index_obj"
+   object(_ : 'a NCicLibrary.register_type)
+     method run = aux
+   end
 ;;
 
-let inject_ncoercion =
- let basic_eval_ncoercion x ~refresh_uri_in_universe ~refresh_uri_in_term =
-  basic_eval_ncoercion x
+let index_obj_for_auto status (uri, height, _, _, kind) = 
+ (*prerr_endline (string_of_int height);*)
+ 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
+   keys,NCic.Const(NReference.reference_of_spec uri spec)
  in
-  NRstatus.Serializer.register "ncoercion" basic_eval_ncoercion
-;;
+ let data = 
+  match kind with
+  | NCic.Fixpoint (ind,ifl,_) -> 
+     HExtlib.list_mapi 
+       (fun (_,_,rno,ty,_) i -> 
+          if ind then mk_item ty (NReference.Fix (i,rno,height)) 
+          else mk_item ty (NReference.CoFix height)) ifl
+  | NCic.Inductive (b,lno,itl,_) -> 
+     HExtlib.list_mapi 
+       (fun (_,_,ty,_) i -> mk_item ty (NReference.Ind (b,i,lno))) itl 
+     @
+     List.map (fun ((_,_,ty),i,j) -> mk_item ty (NReference.Con (i,j+1,lno)))
+       (List.flatten (HExtlib.list_mapi 
+         (fun (_,_,_,cl) i -> HExtlib.list_mapi (fun x j-> x,i,j) cl)
+         itl))
+  | NCic.Constant (_,_,Some _, ty, _) -> 
+     [ mk_item ty (NReference.Def height) ]
+  | NCic.Constant (_,_,None, ty, _) ->
+     [ mk_item ty NReference.Decl ]
+ in
+ let data = HExtlib.filter_map
+   (fun (keys, t) ->
+     let keys = List.filter
+       (function 
+         | (NCic.Meta _) 
+         | (NCic.Appl (NCic.Meta _::_)) -> false 
+         | _ -> true) 
+       keys
+     in
+     if keys <> [] then 
+      begin
+        HLog.debug ("Indexing:" ^ 
+          NCicPp.ppterm ~metasenv:[] ~subst:[] ~context:[] t);
+        HLog.debug ("With keys:" ^ String.concat "\n" (List.map (fun t ->
+          NCicPp.ppterm ~metasenv:[] ~subst:[] ~context:[] t) keys));
+        Some (keys,t) 
+      end
+     else 
+      begin
+        HLog.debug ("Not indexing:" ^ 
+          NCicPp.ppterm ~metasenv:[] ~subst:[] ~context:[] t);
+        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 src_tgt_cpos_arity_of_ty_id_src_tgt status ty id src tgt =
-  let status, src, cpos = 
-    let rec aux cpos ctx = function
-      | NCic.Prod (name,ty,bo) ->
-         if name <> id then aux (cpos+1) ((name,NCic.Decl ty)::ctx) bo
-         else
-           (try 
-            let metasenv,subst,status,src =
-              GrafiteDisambiguate.disambiguate_nterm 
-                None status ctx [] [] ("",0,src) in
-            let src = NCicUntrusted.apply_subst subst [] src in
-            (* CHECK that the declared pattern matches the abstraction *)
-            let _ = NCicUnification.unify status metasenv subst ctx ty src in
-            status, src, cpos
-           with 
-           | NCicUnification.UnificationFailure _
-           | NCicUnification.Uncertain _
-           | MultiPassDisambiguator.DisambiguationError _ ->
-               raise (GrafiteTypes.Command_error "bad source pattern"))
-      | _ -> assert false
-    in
-      aux 0 [] ty
-  in
-  let status, tgt, arity = 
-    let metasenv,subst,status,tgt =
-      GrafiteDisambiguate.disambiguate_nterm 
-        None status [] [] [] ("",0,tgt) in
-    let tgt = NCicUntrusted.apply_subst subst [] tgt in
-    (* CHECK che sia unificabile mancante *)
-    let rec count_prod = function
-      | NCic.Prod (_,_,x) -> 1 + count_prod x
-      | _ -> 0
-    in
-     status, tgt, count_prod tgt
-  in
-  status, src, tgt, cpos, arity
+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 eval_ncoercion status name t ty (id,src) tgt = 
-
- let metasenv,subst,status,ty =
-  GrafiteDisambiguate.disambiguate_nterm None status [] [] [] ("",0,ty) in
- assert (metasenv=[]);
- let ty = NCicUntrusted.apply_subst subst [] ty in
- let metasenv,subst,status,t =
-  GrafiteDisambiguate.disambiguate_nterm (Some ty) status [] [] [] ("",0,t) in
- assert (metasenv=[]);
- let t = NCicUntrusted.apply_subst subst [] t in
-
- let status, src, tgt, cpos, arity = 
-   src_tgt_cpos_arity_of_ty_id_src_tgt status ty id src tgt
+let record_index_eq =
+ let basic_index_eq uri
+   ~refresh_uri_in_universe 
+   ~refresh_uri_in_term 
+   = index_eq (NCicLibrary.refresh_uri uri) 
  in
-
- let status = basic_eval_ncoercion (name,t,src,tgt,cpos,arity) status in
- let dump = inject_ncoercion (name,t,src,tgt,cpos,arity)::status#dump in
- let status = status#set_dump dump in
-  status,`New []
+  NCicLibrary.Serializer.register#run "index_eq"
+   object(_ : 'a NCicLibrary.register_type)
+     method run = basic_index_eq
+   end
 ;;
 
-let basic_eval_add_constraint (s,u1,u2) status =
- NCicLibrary.add_constraint status s u1 u2
+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
 ;;
 
 let inject_constraint =
- let basic_eval_add_constraint (s,u1,u2) 
+ let basic_eval_add_constraint (u1,u2) 
        ~refresh_uri_in_universe 
        ~refresh_uri_in_term
  =
   let u1 = refresh_uri_in_universe u1 in 
   let u2 = refresh_uri_in_universe u2 in 
-  basic_eval_add_constraint (s,u1,u2)
+  basic_eval_add_constraint (u1,u2)
  in
-  NRstatus.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 = 
- let status = basic_eval_add_constraint (s,u1,u2) status in
- let dump = inject_constraint (s,u1,u2)::status#dump in
+let eval_add_constraint status u1 u2 = 
+ let status = basic_eval_add_constraint (u1,u2) status in
+ let dump = inject_constraint (u1,u2)::status#dump in
  let status = status#set_dump dump in
   status,`Old []
 ;;
@@ -839,7 +752,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 
@@ -850,6 +763,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
@@ -862,9 +777,9 @@ 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.NBranch _ -> NTactics.branch_tac ~force:false
   | GrafiteAst.NCases (_loc, what, where) ->
       NTactics.cases_tac 
         ~what:(text,prefix_len,what)
@@ -873,6 +788,13 @@ let eval_ng_tac tac =
   | GrafiteAst.NChange (_loc, pat, ww) -> 
       NTactics.change_tac 
        ~where:(text,prefix_len,pat) ~with_what:(text,prefix_len,ww) 
+  | GrafiteAst.NConstructor (_loc,num,args) -> 
+     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 
@@ -883,11 +805,13 @@ 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.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) ->
@@ -918,11 +842,12 @@ 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
   | GrafiteAst.NCoercion (loc, name, t, ty, source, target) ->
-      eval_ncoercion status name t ty source target
+      NCicCoercDeclaration.eval_ncoercion status name t ty source target
   | GrafiteAst.NQed loc ->
      if status#ng_mode <> `ProofMode then
       raise (GrafiteTypes.Command_error "Not in proof mode")
@@ -955,31 +880,112 @@ let rec eval_ncommand opts status (text,prefix_len,cmd) =
           | _ -> obj_kind
         in
         let obj = uri,height,[],[],obj_kind in
-         let status = NCicLibrary.add_obj status obj in
-       prerr_endline (NCicPp.ppobj obj);
-         let boxml = NCicElim.mk_elims obj in
+        let old_status = status in
+        let status = NCicLibrary.add_obj status obj in
+        let status = index_obj_for_auto status obj in
+        let status = index_eq_for_auto status uri in
 (*
-         let objs = [] in
-         let timestamp,uris_rev =
-           List.fold_left
-            (fun (status,uris_rev) (uri,_,_,_,_) as obj ->
-              let status = NCicLibrary.add_obj status obj in
-               status,uri::uris_rev
-            ) (status,[]) objs in
-         let uris = uri::List.rev uris_rev 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
+       (*prerr_endline (NCicPp.ppobj obj);*)
+           let boxml = NCicElim.mk_elims obj in
+           let boxml = boxml @ NCicElim.mk_projections obj in
+(*
+           let objs = [] in
+           let timestamp,uris_rev =
+             List.fold_left
+              (fun (status,uris_rev) (uri,_,_,_,_) as obj ->
+                let status = NCicLibrary.add_obj status obj in
+                 status,uri::uris_rev
+              ) (status,[]) objs in
+           let uris = uri::List.rev uris_rev in
 *)
-         let status = status#set_ng_mode `CommandMode in
-let status = LexiconSync.add_aliases_for_objs status (`New [uri]) in
-         List.fold_left
-          (fun (status,uris) boxml ->
-            let status,nuris =
-             eval_ncommand opts status
-              ("",0,GrafiteAst.NObj (HExtlib.dummy_floc,boxml))
-            in
-             match uris,nuris with
-                `New uris, `New nuris -> status,`New (nuris@uris)
-              | _ -> assert false
-          ) (status,`New [] (* uris *)) boxml
+           let status = status#set_ng_mode `CommandMode in
+           let status = LexiconSync.add_aliases_for_objs status (`New [uri]) in
+           let status,uris =
+            List.fold_left
+             (fun (status,uris) boxml ->
+               try
+                let nstatus,nuris =
+                 eval_ncommand opts status
+                  ("",0,GrafiteAst.NObj (HExtlib.dummy_floc,boxml))
+                in
+                if nstatus#ng_mode <> `CommandMode then
+                  begin
+                    HLog.error "error in generating projection/eliminator";
+                    prerr_endline (NCicPp.ppobj nstatus#obj);
+                    nstatus, uris
+                  end
+                else
+                  nstatus, concat_nuris uris nuris
+               with
+               | MultiPassDisambiguator.DisambiguationError _ 
+               | NCicTypeChecker.TypeCheckerFailure _ ->
+                  HLog.warn "error in generating projection/eliminator";
+                  status,uris
+             ) (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 []))
+                       (* XXX *)
+                      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
+               (true,leftno,[_,_,_,[_,_,_]],(_,`Record fields))
+               ->
+                HExtlib.filter_map
+                 (fun (name,is_coercion,arity) ->
+                   if is_coercion then Some(name,leftno,arity) else None) fields
+            | _ -> [] in
+           let status,uris =
+            List.fold_left
+             (fun (status,uris) (name,cpos,arity) ->
+               try
+                 let metasenv,subst,status,t =
+                  GrafiteDisambiguate.disambiguate_nterm None status [] [] []
+                   ("",0,CicNotationPt.Ident (name,None)) in
+                 assert (metasenv = [] && subst = []);
+                 let status, nuris = 
+                   NCicCoercDeclaration.
+                     basic_eval_and_record_ncoercion_from_t_cpos_arity 
+                      status (name,t,cpos,arity)
+                 in
+                 let uris = concat_nuris nuris uris in
+                 status, uris
+               with MultiPassDisambiguator.DisambiguationError _-> 
+                 HLog.warn ("error in generating coercion: "^name);
+                 status, uris) 
+             (status,uris) coercions
+           in
+            status,uris
+          with
+           exn ->
+            NCicLibrary.time_travel old_status;
+            raise exn)
   | GrafiteAst.NCopy (log,tgt,src_uri, map) ->
      if status#ng_mode <> `CommandMode then
       raise (GrafiteTypes.Command_error "Not in command mode")
@@ -1006,7 +1012,7 @@ let status = LexiconSync.add_aliases_for_objs status (`New [uri]) in
        in
        let ninitial_stack = Continuationals.Stack.of_nmetasenv [] in
        let status = status#set_obj (tgt_uri,0,[],[],ok) in
-       prerr_endline (NCicPp.ppobj (tgt_uri,0,[],[],ok));
+       (*prerr_endline (NCicPp.ppobj (tgt_uri,0,[],[],ok));*)
        let status = status#set_stack ninitial_stack in
        let status = subst_metasenv_and_fix_names status in
        let status = status#set_ng_mode `ProofMode in
@@ -1028,8 +1034,57 @@ let status = LexiconSync.add_aliases_for_objs status (`New [uri]) in
           [] ->
            eval_ncommand opts status ("",0,GrafiteAst.NQed Stdpp.dummy_loc)
         | _ -> status,`New [])
-  | GrafiteAst.NUnivConstraint (loc,strict,u1,u2) ->
-      eval_add_constraint status strict [false,u1] [false,u2]
+  | 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")
+     else
+      let metasenv,subst,status,sort = match sort with
+        | None -> [],[],status,NCic.Sort NCic.Prop
+        | Some s -> GrafiteDisambiguate.disambiguate_nterm None status [] [] []
+                      (text,prefix_len,s) 
+      in
+      assert (metasenv = []);
+      let sort = NCicReduction.whd ~subst [] sort in
+      let sort = match sort with 
+          NCic.Sort s -> s
+        | _ ->  raise (Invalid_argument (Printf.sprintf "ninverter: found target %s, which is not a sort" 
+                                           (NCicPp.ppterm ~metasenv ~subst ~context:[] sort)))
+      in
+      let status = status#set_ng_mode `ProofMode in
+      let metasenv,subst,status,indty =
+       GrafiteDisambiguate.disambiguate_nterm None status [] [] subst (text,prefix_len,indty) in
+      let indtyno,(_,leftno,tys,_,_) = match indty with
+          NCic.Const ((NReference.Ref (_,NReference.Ind (_,indtyno,_))) as r) -> 
+            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 
+                        status status#baseuri in
+     let _,_,menv,_,_ = obj in
+     (match menv with
+        [] ->
+          eval_ncommand opts status ("",0,GrafiteAst.NQed Stdpp.dummy_loc)
+      | _ -> assert false)
+  | GrafiteAst.NUnivConstraint (loc,u1,u2) ->
+      eval_add_constraint status [`Type,u1] [`Type,u2]
 ;;
 
 let rec eval_command = {ec_go = fun ~disambiguate_command opts status
@@ -1115,7 +1170,7 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status
        status
      in
       let status =
-       NRstatus.Serializer.require ~baseuri:(NUri.uri_of_string baseuri)
+       NCicLibrary.Serializer.require ~baseuri:(NUri.uri_of_string baseuri)
         status in
       let status =
        GrafiteTypes.add_moo_content
@@ -1268,6 +1323,8 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status
       eval_ncommand opts status (text,prefix_len,cmd)
   | GrafiteAst.Macro (loc, macro) ->
      raise (Macro (loc,disambiguate_macro status (text,prefix_len,macro)))
+  | GrafiteAst.NMacro (loc, macro) ->
+     raise (NMacro (loc,macro))
 
 } and eval_from_moo = {efm_go = fun status fname ->
   let ast_of_cmd cmd =