X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_tactics%2FnTacStatus.ml;h=6d5df31963f70f2b49da8c63ee53a3ca480b7292;hb=320c0f89a7e31e996b6eff2b4165eb74e8141cec;hp=0bef3a794448b6a9834e1be363f401bb3b0b1e8a;hpb=f8d45b2e4fa7817d7ef8312b3bb8a7439bd7fb8c;p=helm.git diff --git a/helm/software/components/ng_tactics/nTacStatus.ml b/helm/software/components/ng_tactics/nTacStatus.ml index 0bef3a794..6d5df3196 100644 --- 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