From f521d86d73b5c50eb3f7feff3b7fd5d49c574dbc Mon Sep 17 00:00:00 2001
From: Andrea Asperti <andrea.asperti@unibo.it>
Date: Thu, 27 Apr 2006 10:07:47 +0000
Subject: [PATCH] Equality chains. -This line, and those below, will be
 ignored--

M    acic_content/acic2content.ml
---
 .../components/acic_content/acic2content.ml   | 61 +++++++++++++++++++
 1 file changed, 61 insertions(+)

diff --git a/helm/software/components/acic_content/acic2content.ml b/helm/software/components/acic_content/acic2content.ml
index 57b8502bb..e72d466d5 100644
--- a/helm/software/components/acic_content/acic2content.ml
+++ b/helm/software/components/acic_content/acic2content.ml
@@ -505,6 +505,9 @@ and acic2content seed ?name ~ids_to_inner_sorts ~ids_to_inner_types t =
          with NotApplicable ->
          try inductive 
           seed name id li ~ids_to_inner_types ~ids_to_inner_sorts
+         with NotApplicable ->
+	 try transitivity 
+           seed name id li ~ids_to_inner_types ~ids_to_inner_sorts
          with NotApplicable ->
           let subproofs, args =
             build_subproofs_and_args 
@@ -843,8 +846,66 @@ and rewrite seed name id li ~ids_to_inner_types ~ids_to_inner_sorts =
           } 
       else raise NotApplicable
   | _ -> raise NotApplicable
+
+and transitivity seed name id li ~ids_to_inner_types ~ids_to_inner_sorts =
+  let module C2A = Cic2acic in
+  let module K = Content in
+  let module C = Cic in
+  match li with 
+    | C.AConst (sid,uri,exp_named_subst)::args 
+	when LibraryObjects.is_trans_eq_URI uri ->
+	let exp_args = List.map snd exp_named_subst in
+	let t1,t2,t3,p1,p2 =
+	  match exp_args@args with
+	    | [_;t1;t2;t3;p1;p2] -> t1,t2,t3,p1,p2
+	    | _ -> raise NotApplicable
+	in
+	  { K.proof_name = name;
+            K.proof_id  = gen_id proof_prefix seed;
+            K.proof_context = []; 
+            K.proof_apply_context = [];
+            K.proof_conclude = 
+              { K.conclude_id = gen_id conclude_prefix seed; 
+                K.conclude_aref = id;
+                K.conclude_method = "Eq_chain";
+                K.conclude_args = 
+                   K.Term t1::
+		     (transitivity_aux 
+			seed ~ids_to_inner_types ~ids_to_inner_sorts p1)@
+		     [K.Term t2]@
+		     (transitivity_aux 
+			seed ~ids_to_inner_types ~ids_to_inner_sorts p2)@
+		     [K.Term t3];
+                K.conclude_conclusion = 
+                   try Some 
+                     (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized
+                   with Not_found -> None
+              }
+          } 
+    | _ -> raise NotApplicable
+
+and transitivity_aux seed ~ids_to_inner_types ~ids_to_inner_sorts t =
+  let module C2A = Cic2acic in
+  let module K = Content in
+  let module C = Cic in
+  match t with 
+    | C.AAppl (_,C.AConst (sid,uri,exp_named_subst)::args) 
+	when LibraryObjects.is_trans_eq_URI uri ->
+	let exp_args = List.map snd exp_named_subst in
+	let t1,t2,t3,p1,p2 =
+	  match exp_args@args with
+	    | [_;t1;t2;t3;p1;p2] -> t1,t2,t3,p1,p2
+	    | _ -> raise NotApplicable
+	in
+          (transitivity_aux seed ~ids_to_inner_types ~ids_to_inner_sorts p1)
+	  @[K.Term t2]
+	  @(transitivity_aux seed ~ids_to_inner_types ~ids_to_inner_sorts p2)
+    | _ -> [K.ArgProof 
+	(acic2content seed ~ids_to_inner_sorts ~ids_to_inner_types t)]
+
 ;; 
 
+
 let map_conjectures
  seed ~ids_to_inner_sorts ~ids_to_inner_types (id,n,context,ty)
 =
-- 
2.39.2