(* Copyright (C) 2005, HELM Team. * * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science * Department, University of Bologna, Italy. * * HELM is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * HELM is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with HELM; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, * MA 02111-1307, USA. * * For details, see the HELM World-Wide-Web page, * http://helm.cs.unibo.it/ *) type coerc_carr = Uri of UriManager.uri | Sort of Cic.sort | Term of Cic.term exception EqCarrNotImplemented of string Lazy.t exception EqCarrOnNonMetaClosed let db = ref [] let use_coercions = ref true let coerc_carr_of_term t = try Uri (CicUtil.uri_of_term t) with Invalid_argument _ -> match t with | Cic.Sort s -> Sort s | t -> Term t ;; let eq_carr src tgt = match src, tgt with | Uri src, Uri tgt -> UriManager.eq src tgt | Sort (Cic.Type _), Sort (Cic.Type _) -> true | Sort src, Sort tgt when src = tgt -> true | Term t1, Term t2 -> if CicUtil.is_meta_closed t1 && CicUtil.is_meta_closed t2 then raise (EqCarrNotImplemented (lazy ("Unsupported carr for coercions: " ^ CicPp.ppterm t1 ^ " or " ^ CicPp.ppterm t2))) else raise EqCarrOnNonMetaClosed | _, _ -> false let name_of_carr = function | Uri u -> UriManager.name_of_uri u | Sort s -> CicPp.ppsort s | Term _ -> assert false let to_list () = !db let add_coercion c = db := c :: !db let remove_coercion p = db := List.filter (fun u -> not(p u)) !db let find_coercion f = if !use_coercions then List.map (fun (_,_,x) -> x) (List.filter (fun (s,t,_) -> f (s,t)) !db) else []