+(* COERCIONS ***********************************************************)
+
+let remove_all_coercions () =
+ UriManager.UriHashtbl.clear coercion_hashtbl;
+ CoercDb.remove_coercion (fun (_,_,u1) -> true)
+
+let add_coercion ~basedir ~add_composites uri =
+ let coer_ty,_ =
+ let coer = CicUtil.term_of_uri uri in
+ CicTypeChecker.type_of_aux' [] [] coer CicUniv.empty_ugraph
+ in
+ (* we have to get the source and the tgt type uri
+ * in Coq syntax we have already their names, but
+ * since we don't support Funclass and similar I think
+ * all the coercion should be of the form
+ * (A:?)(B:?)T1->T2
+ * So we should be able to extract them from the coercion type
+ *
+ * Currently only (_:T1)T2 is supported.
+ * should we saturate it with metas in case we insert it?
+ *
+ *)
+ let extract_last_two_p ty =
+ let rec aux = function
+ | Cic.Prod( _, src, Cic.Prod (n,t1,t2)) ->
+ assert false
+ (* not implemented: aux (Cic.Prod(n,t1,t2)) *)
+ | Cic.Prod( _, src, tgt) -> src, tgt
+ | _ -> assert false
+ in
+ aux ty
+ in
+ let ty_src, ty_tgt = extract_last_two_p coer_ty in
+ let src_uri = CoercDb.coerc_carr_of_term (CicReduction.whd [] ty_src) in
+ let tgt_uri = CoercDb.coerc_carr_of_term (CicReduction.whd [] ty_tgt) in
+ let new_coercions = CicCoercion.close_coercion_graph src_uri tgt_uri uri in
+ let composite_uris = List.map (fun (_,_,uri,_) -> uri) new_coercions in
+ (* update the DB *)
+ List.iter
+ (fun (src,tgt,uri,_) -> CoercDb.add_coercion (src,tgt,uri))
+ new_coercions;
+ CoercDb.add_coercion (src_uri, tgt_uri, uri);
+ (* add the composites obj and they eventual lemmas *)
+ let lemmas =
+ if add_composites then
+ List.fold_left
+ (fun acc (_,_,uri,obj) ->
+ add_single_obj ~basedir uri obj;
+ uri::acc)
+ composite_uris new_coercions
+ else
+ []
+ in
+ (* store that composite_uris are related to uri. the first component is the
+ * stuff in the DB while the second is stuff for remove_obj *)
+ prerr_endline ("aggiungo: " ^ string_of_bool add_composites ^ UriManager.string_of_uri uri);
+ List.iter (fun u -> prerr_endline (UriManager.string_of_uri u))
+ composite_uris;
+ UriManager.UriHashtbl.add coercion_hashtbl uri
+ (composite_uris,if add_composites then composite_uris else []);
+ lemmas
+
+let remove_coercion uri =
+ try
+ let (composites_in_db, composites_in_lib) =
+ UriManager.UriHashtbl.find coercion_hashtbl uri
+ in
+ prerr_endline ("removing: " ^UriManager.string_of_uri uri);
+ List.iter (fun u -> prerr_endline (UriManager.string_of_uri u))
+ composites_in_db;
+ UriManager.UriHashtbl.remove coercion_hashtbl uri;
+ CoercDb.remove_coercion (fun (_,_,u) -> UriManager.eq uri u);
+ (* remove from the DB *)
+ List.iter
+ (fun u -> CoercDb.remove_coercion (fun (_,_,u1) -> UriManager.eq u u1))
+ composites_in_db;
+ (* remove composites from the lib *)
+ List.iter remove_single_obj composites_in_lib
+ with
+ Not_found -> () (* mhh..... *)
+
+