- aux test_equality_only context s1 s2 && (* sure?! *)
- aux test_equality_only ((name1, C.Decl s1)::context) t1 t2
-
- | (C.Meta (n1,l1), C.Meta (n2,l2)) ->
- if n1 = n2 then
- let b2, ugraph1 =
- let l1 = CicUtil.clean_up_local_context subst metasenv n1 l1 in
- let l2 = CicUtil.clean_up_local_context subst metasenv n2 l2 in
- List.fold_left2
- (fun (b,ugraph) t1 t2 ->
- if b then
- match t1,t2 with
- None,_
- | _,None -> true,ugraph
- | Some t1',Some t2' ->
- aux test_equality_only context t1' t2' ugraph
- else
- false,ugraph
- ) (true,ugraph) l1 l2
- in
- if b2 then true,ugraph1 else false,ugraph
- else
- false,ugraph
- | C.Meta (n1,l1), _ ->
- (try
- let _,term,_ = NCicUtils.lookup_subst n1 subst in
- let term' = CicSubstitution.subst_meta l1 term in
- aux test_equality_only context term' t2 ugraph
- with CicUtil.Subst_not_found _ -> false,ugraph)
- | _, C.Meta (n2,l2) ->
- (try
- let _,term,_ = CicUtil.lookup_subst n2 subst in
- let term' = CicSubstitution.subst_meta l2 term in
- aux test_equality_only context t1 term' ugraph
- with CicUtil.Subst_not_found _ -> false,ugraph)
- | (C.LetIn (name1,s1,t1), C.LetIn(_,s2,t2)) ->
- let b',ugraph' = aux test_equality_only context s1 s2 ugraph in
- if b' then
- aux test_equality_only
- ((Some (name1, (C.Def (s1,None))))::context) t1 t2 ugraph'
- else
- false,ugraph
- | (C.Appl l1, C.Appl l2) ->
- (try
- List.fold_right2
- (fun x y (b,ugraph) ->
- if b then
- aux test_equality_only context x y ugraph
- else
- false,ugraph) l1 l2 (true,ugraph)
- with
- Invalid_argument _ -> false,ugraph
- )
- | (C.Const (uri1,exp_named_subst1), C.Const (uri2,exp_named_subst2)) ->
- let b' = U.eq uri1 uri2 in
- if b' then
- (try
- List.fold_right2
- (fun (uri1,x) (uri2,y) (b,ugraph) ->
- if b && U.eq uri1 uri2 then
- aux test_equality_only context x y ugraph
- else
- false,ugraph
- ) exp_named_subst1 exp_named_subst2 (true,ugraph)
- with
- Invalid_argument _ -> false,ugraph
- )
- else
- false,ugraph
- | (C.MutInd (uri1,i1,exp_named_subst1),
- C.MutInd (uri2,i2,exp_named_subst2)
- ) ->
- let b' = U.eq uri1 uri2 && i1 = i2 in
- if b' then
- (try
- List.fold_right2
- (fun (uri1,x) (uri2,y) (b,ugraph) ->
- if b && U.eq uri1 uri2 then
- aux test_equality_only context x y ugraph
- else
- false,ugraph
- ) exp_named_subst1 exp_named_subst2 (true,ugraph)
- with
- Invalid_argument _ -> false,ugraph
- )
- else
- false,ugraph
- | (C.MutConstruct (uri1,i1,j1,exp_named_subst1),
- C.MutConstruct (uri2,i2,j2,exp_named_subst2)
- ) ->
- let b' = U.eq uri1 uri2 && i1 = i2 && j1 = j2 in
- if b' then
- (try
- List.fold_right2
- (fun (uri1,x) (uri2,y) (b,ugraph) ->
- if b && U.eq uri1 uri2 then
- aux test_equality_only context x y ugraph
- else
- false,ugraph
- ) exp_named_subst1 exp_named_subst2 (true,ugraph)
- with
- Invalid_argument _ -> false,ugraph
- )
- else
- false,ugraph
- | (C.MutCase (uri1,i1,outtype1,term1,pl1),
- C.MutCase (uri2,i2,outtype2,term2,pl2)) ->
- let b' = U.eq uri1 uri2 && i1 = i2 in
- if b' then
- let b'',ugraph''=aux test_equality_only context
- outtype1 outtype2 ugraph in
- if b'' then
- let b''',ugraph'''= aux test_equality_only context
- term1 term2 ugraph'' in
- List.fold_right2
- (fun x y (b,ugraph) ->
- if b then
- aux test_equality_only context x y ugraph
- else
- false,ugraph)
- pl1 pl2 (b''',ugraph''')
- else
- false,ugraph
- else
- false,ugraph
- | (C.Fix (i1,fl1), C.Fix (i2,fl2)) ->
- let tys,_ =
- List.fold_left
- (fun (types,len) (n,_,ty,_) ->
- (Some (C.Name n,(C.Decl (CicSubstitution.lift len ty)))::types,
- len+1)
- ) ([],0) fl1
- in
- if i1 = i2 then
- List.fold_right2
- (fun (_,recindex1,ty1,bo1) (_,recindex2,ty2,bo2) (b,ugraph) ->
- if b && recindex1 = recindex2 then
- let b',ugraph' = aux test_equality_only context ty1 ty2
- ugraph in
- if b' then
- aux test_equality_only (tys@context) bo1 bo2 ugraph'
- else
- false,ugraph
- else
- false,ugraph)
- fl1 fl2 (true,ugraph)
- else
- false,ugraph
- | (C.CoFix (i1,fl1), C.CoFix (i2,fl2)) ->
- let tys,_ =
- List.fold_left
- (fun (types,len) (n,ty,_) ->
- (Some (C.Name n,(C.Decl (CicSubstitution.lift len ty)))::types,
- len+1)
- ) ([],0) fl1
- in
- if i1 = i2 then
- List.fold_right2
- (fun (_,ty1,bo1) (_,ty2,bo2) (b,ugraph) ->
- if b then
- let b',ugraph' = aux test_equality_only context ty1 ty2
- ugraph in
- if b' then
- aux test_equality_only (tys@context) bo1 bo2 ugraph'
- else
- false,ugraph
- else
- false,ugraph)
- fl1 fl2 (true,ugraph)
- else
- false,ugraph
- | C.Cast (bo,_),t -> aux2 test_equality_only bo t ugraph
- | t,C.Cast (bo,_) -> aux2 test_equality_only t bo ugraph
- | (C.Implicit _, _) | (_, C.Implicit _) -> assert false
- | (_,_) -> false,ugraph
+ aux true context s1 s2 &&
+ aux true ((name1, C.Decl s1)::context) t1 t2
+ | (C.LetIn (name1,ty1,s1,t1), C.LetIn(_,ty2,s2,t2)) ->
+ aux test_equality_only context ty1 ty2 &&
+ aux test_equality_only context s1 s2 &&
+ aux test_equality_only ((name1, C.Def (s1,ty1))::context) t1 t2
+
+ | (C.Meta (n1,(s1, C.Irl i1)), C.Meta (n2,(s2, C.Irl i2)))
+ when n1 = n2 && s1 = s2 -> true
+ | (C.Meta (n1,(s1, l1)), C.Meta (n2,(s2, l2))) when n1 = n2 ->
+ let l1 = NCicUtils.expand_local_context l1 in
+ let l2 = NCicUtils.expand_local_context l2 in
+ (try List.for_all2
+ (fun t1 t2 -> aux test_equality_only context
+ (NCicSubstitution.lift s1 t1)
+ (NCicSubstitution.lift s2 t2))
+ l1 l2
+ with Invalid_argument _ -> false)
+
+ | C.Meta (n1,l1), _ ->
+ (try
+ let _,_,term,_ = NCicUtils.lookup_subst n1 subst in
+ let term = NCicSubstitution.subst_meta l1 term in
+ aux test_equality_only context term t2
+ with NCicUtils.Subst_not_found _ -> false)
+ | _, C.Meta (n2,l2) ->
+ (try
+ let _,_,term,_ = NCicUtils.lookup_subst n2 subst in
+ let term = NCicSubstitution.subst_meta l2 term in
+ aux test_equality_only context t1 term
+ with NCicUtils.Subst_not_found _ -> false)
+
+ | (C.Appl l1, C.Appl l2) ->
+ (try List.for_all2 (aux test_equality_only context) l1 l2
+ with Invalid_argument _ -> false)
+
+ | (C.Match (ref1,outtype1,term1,pl1),
+ C.Match (ref2,outtype2,term2,pl2)) ->
+ NReference.eq ref1 ref2 &&
+ aux test_equality_only context outtype1 outtype2 &&
+ aux test_equality_only context term1 term2 &&
+ (try List.for_all2 (aux test_equality_only context) pl1 pl2
+ with Invalid_argument _ -> false)
+
+ | (C.Implicit _, _) | (_, C.Implicit _) -> assert false
+ | (_,_) -> false