Release 0.5.9.

[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 e7d5bb3b532ee1eac2b6fdcee560ad8b58cb61c2..b58eb5558a8d95a2f6ce5564a0ea7ab228f19f2f 100644 (file)
--- 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