X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_tactics%2FnTacStatus.ml;h=b58eb5558a8d95a2f6ce5564a0ea7ab228f19f2f;hb=a90c31c1b53222bd6d57360c5ba5c2d0fe7d5207;hp=e7d5bb3b532ee1eac2b6fdcee560ad8b58cb61c2;hpb=4377e950998c9c63937582952a79975947aa9a45;p=helm.git diff --git a/helm/software/components/ng_tactics/nTacStatus.ml b/helm/software/components/ng_tactics/nTacStatus.ml index e7d5bb3b5..b58eb5558 100644 --- a/helm/software/components/ng_tactics/nTacStatus.ml +++ b/helm/software/components/ng_tactics/nTacStatus.ml @@ -31,29 +31,20 @@ 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 (self) + object 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 type tactic_pattern = GrafiteAst.npattern Disambiguate.disambiguator_input -let pp_tac_status status = - prerr_endline (NCicPp.ppobj status#obj); - prerr_endline ("STACK:\n" ^ Continuationals.Stack.pp status#stack) +let pp_status status = + pp (lazy (NCicPp.ppobj status#obj)) ;; type cic_term = NCic.context * NCic.term @@ -249,15 +240,11 @@ let to_subst status i entry = status#set_obj (name,height,metasenv,subst,obj) ;; -let instantiate status ?refine:(dorefine=true) i t = +let instantiate status i t = let _,_,metasenv,_,_ = status#obj in let gname, context, gty = List.assoc i metasenv in - if dorefine then - let status, (_,t), (_,ty) = refine status context t (Some (context,gty)) in - to_subst status i (gname,context,t,ty) - else - let status,(_,ty) = typeof status context t in - to_subst status i (gname,context,snd t,ty) + let status, (_,t), (_,ty) = refine status context t (Some (context,gty)) in + to_subst status i (gname,context,t,ty) ;; let instantiate_with_ast status i t = @@ -414,7 +401,7 @@ let analyse_indty status ty = | _,NCic.Const ref -> ref, [] | _,NCic.Appl (NCic.Const (NRef.Ref (_,(NRef.Ind _)) as ref) :: args) -> ref, args - | _,_ -> fail (lazy ("not an inductive type: " ^ ppterm status ty)) in + | _,_ -> fail (lazy ("not an inductive type")) in let _,lno,tl,_,i = NCicEnvironment.get_checked_indtys ref in let _,_,_,cl = List.nth tl i in let consno = List.length cl in @@ -428,11 +415,6 @@ let apply_subst status ctx t = status, (ctx, NCicUntrusted.apply_subst subst ctx t) ;; -let apply_subst_context status ~fix_projections ctx = - let _,_,_,subst,_ = status#obj in - NCicUntrusted.apply_subst_context ~fix_projections subst ctx -;; - let metas_of_term status (context,t) = let _,_,_,subst,_ = status#obj in NCicUntrusted.metas_of_term subst context t @@ -440,21 +422,13 @@ 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 (self) + object 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