1) the home button of CicBrowser now works also for NG

[helm.git] / helm / software / components / ng_refiner / nCicUnification.ml

diff --git a/helm/software/components/ng_refiner/nCicUnification.ml b/helm/software/components/ng_refiner/nCicUnification.ml
index 006fcafe144f61d48c8c1713b4876c8d24420669..59bc5d7e72ef9f11ee048545d11c616d367e2820 100644 (file)
--- a/helm/software/components/ng_refiner/nCicUnification.ml
+++ b/helm/software/components/ng_refiner/nCicUnification.ml
@@ -302,23 +302,24 @@ and unify hdb test_eq_only metasenv subst context t1 t2 =
                   unify hdb test_eq_only metasenv subst context term1 term2
               with NCicUtils.Subst_not_found _-> raise (UnificationFailure msg))
        
-       | NCic.Appl (NCic.Meta (i,l)::args), NCic.Meta (n, _) when 
-         not (NCicMetaSubst.flexible subst args) &&
-         is_locked n subst &&
-         not (List.mem_assoc i subst) 
-         ->
-           (* we verify that none of the args is a Meta, 
-              since beta expanding w.r.t a metavariable makes no sense  *)
-              let metasenv, lambda_Mj =
-                lambda_intros metasenv subst context t1 args
-              in
-              let metasenv, subst = 
-                unify hdb test_eq_only metasenv subst context 
-                  (C.Meta (i,l)) lambda_Mj
-              in
+       | _, NCic.Meta (n, _) when is_locked n subst ->
+           (let (metasenv, subst), i = 
+              match NCicReduction.whd ~subst context t1 with
+              | NCic.Appl (NCic.Meta (i,l)::args) when
+                  not (NCicMetaSubst.flexible subst args) 
+                ->
+                 let metasenv, lambda_Mj =
+                   lambda_intros metasenv subst context t1 args
+                 in
+                   unify hdb test_eq_only metasenv subst context 
+                    (C.Meta (i,l)) lambda_Mj,
+                   i
+              | NCic.Meta (i,_) -> (metasenv, subst), i
+              | _ -> assert false
+             in
               let t1 = NCicReduction.whd ~subst context t1 in
               let j, lj = 
-                match t1 with NCic.Meta (i,l) -> i, l | _ -> assert false
+                match t1 with NCic.Meta (j,l) -> j, l | _ -> assert false
               in
               let metasenv, subst = 
                 instantiate hdb test_eq_only metasenv subst context j lj t2 true
@@ -328,7 +329,7 @@ and unify hdb test_eq_only metasenv subst context t1 t2 =
                 let term = eta_reduce subst term in
                 let subst = List.filter (fun (j,_) -> j <> i) subst in
                 metasenv, ((i, (name, ctx, term, ty)) :: subst)
-              with Not_found -> assert false)
+              with Not_found -> assert false))
 
        | C.Meta (n,lc), t -> 
            (try 
@@ -416,7 +417,10 @@ and unify hdb test_eq_only metasenv subst context t1 t2 =
            let relevance = NCicEnvironment.get_relevance r1 in
            let relevance = match r1 with
              | Ref.Ref (_,Ref.Con (_,_,lno)) ->
-                 let _,relevance = HExtlib.split_nth lno relevance in
+                 let relevance =
+                  try snd (HExtlib.split_nth lno relevance)
+                  with Failure _ -> []
+                 in
                    HExtlib.mk_list false lno @ relevance
              | _ -> relevance
            in
@@ -611,8 +615,6 @@ pp (lazy (string_of_bool norm1 ^ " ?? " ^ string_of_bool norm2));
  (*D*)  in outside(); rc with exn -> outside (); raise exn 
 ;;
 
-let unify hdb = 
+let unify hdb ?(test_eq_only=false) = 
   indent := "";      
-  unify hdb false;;
-
-
+  unify hdb test_eq_only;;