Fixed a few bugs

[helm.git] / helm / software / components / ng_tactics / nTacStatus.ml

diff --git a/helm/software/components/ng_tactics/nTacStatus.ml b/helm/software/components/ng_tactics/nTacStatus.ml
index 0bef3a794448b6a9834e1be363f401bb3b0b1e8a..6d5df31963f70f2b49da8c63ee53a3ca480b7292 100644 (file)
--- a/helm/software/components/ng_tactics/nTacStatus.ml
+++ b/helm/software/components/ng_tactics/nTacStatus.ml
@@ -31,13 +31,21 @@ let wrap fname f x =
   | NCicMetaSubst.MetaSubstFailure _ as exn -> fail ~exn (lazy fname)
 ;;
 
+class type g_pstatus =
+ object
+  inherit NEstatus.g_status
+  method obj: NCic.obj
+ end
+
 class pstatus =
  fun (o: NCic.obj) ->
-  object
+ object (self)
    inherit NEstatus.status
    val obj = o
    method obj = obj
    method set_obj o = {< obj = o >}
+   method set_pstatus : 'status. #g_pstatus as 'status -> 'self
+   = fun o -> (self#set_estatus o)#set_obj o#obj
   end
 
 type tactic_term = CicNotationPt.term Disambiguate.disambiguator_input
@@ -229,6 +237,10 @@ let get_goalty status g =
  with NCicUtils.Meta_not_found _ as exn -> fail ~exn (lazy "get_goalty")
 ;;
 
+let get_subst status =
+  let _,_,_,subst,_ = status#obj in subst
+;;
+
 let to_subst status i entry =
  let name,height,metasenv,subst,obj = status#obj in
  let metasenv = List.filter (fun j,_ -> j <> i) metasenv in
@@ -267,6 +279,7 @@ let mk_meta status ?(attrs=[]) ctx bo_or_ty kind =
       let n,h,metasenv,subst,o = status#obj in
       let metasenv, metano, instance, _ = 
         NCicMetaSubst.mk_meta ~attrs metasenv ctx ~with_type:ty kind in
+      let attrs,_,_ = NCicUtils.lookup_meta metano metasenv in
       let metasenv = List.filter (fun j,_ -> j <> metano) metasenv in
       let subst = (metano, (attrs, ctx, bo_, ty)) :: subst in
       let status = status#set_obj (n,h,metasenv,subst,o) in
@@ -417,13 +430,21 @@ let metas_of_term status (context,t) =
 
 (* ============= move this elsewhere ====================*)
 
+class type ['stack] g_status =
+ object
+  inherit g_pstatus
+  method stack: 'stack
+ end
+
 class ['stack] status =
  fun (o: NCic.obj) (s: 'stack) ->
-  object
+ object (self)
    inherit (pstatus o)
    val stack = s
    method stack = stack
    method set_stack s = {< stack = s >}
+   method set_status : 'status. 'stack #g_status as 'status -> 'self
+   = fun o -> (self#set_pstatus o)#set_stack o#stack
   end
 
 class type lowtac_status = [unit] status