From adffbc39d6c144eb159d0003b877b016055ec325 Mon Sep 17 00:00:00 2001
From: Enrico Tassi <enrico.tassi@inria.fr>
Date: Wed, 7 Oct 2009 13:35:20 +0000
Subject: [PATCH] the wrap function takes a string argument so that we know
 which wrapper function failed

---
 .../components/ng_tactics/nTacStatus.ml       | 22 ++++++++++---------
 1 file changed, 12 insertions(+), 10 deletions(-)

diff --git a/helm/software/components/ng_tactics/nTacStatus.ml b/helm/software/components/ng_tactics/nTacStatus.ml
index 41319b473..dc059d50d 100644
--- a/helm/software/components/ng_tactics/nTacStatus.ml
+++ b/helm/software/components/ng_tactics/nTacStatus.ml
@@ -16,14 +16,14 @@ let fail ?exn msg = raise (Error (msg,exn))
 
 module NRef = NReference
 
-let wrap f x =
+let wrap fname f x =
   try f x 
   with 
   | MultiPassDisambiguator.DisambiguationError _ 
   | NCicRefiner.RefineFailure _ 
   | NCicUnification.UnificationFailure _ 
   | NCicTypeChecker.TypeCheckerFailure _ 
-  | NCicMetaSubst.MetaSubstFailure _ as exn -> fail ~exn (lazy "")
+  | NCicMetaSubst.MetaSubstFailure _ as exn -> fail ~exn (lazy fname)
 ;;
 
 class pstatus =
@@ -94,7 +94,7 @@ let relocate status destination (source,t as orig) =
   let status = status#set_obj (u, d, metasenv, subst, o) in
   status, (destination, t)
 ;;
-let relocate a b c = wrap (relocate a b) c;;
+let relocate a b c = wrap "relocate" (relocate a b) c;;
 
 let term_of_cic_term s t c = 
   let s, (_,t) = relocate s c t in
@@ -121,7 +121,7 @@ let disambiguate status t ty context =
  let new_pstatus = uri,height,metasenv,subst,obj in
   status#set_obj new_pstatus, (context, t) 
 ;;
-let disambiguate a b c d = wrap (disambiguate a b c) d;;
+let disambiguate a b c d = wrap "disambiguate" (disambiguate a b c) d;;
 
 let typeof status ctx t =
   let status, (_,t) = relocate status ctx t in
@@ -129,7 +129,7 @@ let typeof status ctx t =
   let ty = NCicTypeChecker.typeof ~subst ~metasenv ctx t in
   status, (ctx, ty)
 ;;
-let typeof a b c = wrap (typeof a b) c;;
+let typeof a b c = wrap "typeof" (typeof a b) c;;
   
 let whd status ?delta ctx t =
   let status, (_,t) = relocate status ctx t in
@@ -152,14 +152,14 @@ let unify status ctx a b =
   let metasenv, subst = NCicUnification.unify status metasenv subst ctx a b in
    status#set_obj (n,h,metasenv,subst,o)
 ;;
-let unify a b c d = wrap (unify a b c) d;;
+let unify a b c d = wrap "unify" (unify a b c) d;;
 
 let fix_sorts (ctx,t) =
  let f () =
   let t = NCicUnification.fix_sorts t in
    ctx,t
  in
-  wrap f ()
+  wrap "fix_sorts" f ()
 ;;
 
 let refine status ctx term expty =
@@ -176,12 +176,14 @@ let refine status ctx term expty =
   in
    status#set_obj (name,height,metasenv,subst,obj), (ctx,t), (ctx,ty)
 ;;
-let refine a b c d = wrap (refine a b c) d;;
+let refine a b c d = wrap "refine" (refine a b c) d;;
 
 let get_goalty status g =
  let _,_,metasenv,_,_ = status#obj in
- let _, a, b = List.assoc g metasenv in
- a, b
+ try
+   let _, ctx, ty = NCicUtils.lookup_meta g metasenv in
+   ctx, ty
+ with NCicUtils.Meta_not_found _ as exn -> fail ~exn (lazy "get_goalty")
 ;;
 
 let instantiate status i t =
-- 
2.39.2