X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic%2FlibraryObjects.ml;fp=helm%2Focaml%2Fcic%2FlibraryObjects.ml;h=cc04322fa970d94606e237dd034f5f07aab7fab1;hb=792b5d29ebae8f917043d9dd226692919b5d6ca1;hp=0000000000000000000000000000000000000000;hpb=a14a8c7637fd0b95e9d4deccb20c6abc98e8f953;p=helm.git diff --git a/helm/ocaml/cic/libraryObjects.ml b/helm/ocaml/cic/libraryObjects.ml new file mode 100644 index 000000000..cc04322fa --- /dev/null +++ b/helm/ocaml/cic/libraryObjects.ml @@ -0,0 +1,116 @@ +(* 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/ + *) + +(* $Id$ *) + +(**** TABLES ****) + +let default_eq_URIs = + [HelmLibraryObjects.Logic.eq_URI, + HelmLibraryObjects.Logic.sym_eq_URI, + HelmLibraryObjects.Logic.trans_eq_URI, + HelmLibraryObjects.Logic.eq_ind_URI, + HelmLibraryObjects.Logic.eq_ind_r_URI];; + +let default_true_URIs = [HelmLibraryObjects.Logic.true_URI] +let default_false_URIs = [HelmLibraryObjects.Logic.false_URI] +let default_absurd_URIs = [HelmLibraryObjects.Logic.absurd_URI] + +(* eq, sym_eq, trans_eq, eq_ind, eq_ind_R *) +let eq_URIs_ref = + ref [HelmLibraryObjects.Logic.eq_URI, + HelmLibraryObjects.Logic.sym_eq_URI, + HelmLibraryObjects.Logic.trans_eq_URI, + HelmLibraryObjects.Logic.eq_ind_URI, + HelmLibraryObjects.Logic.eq_ind_r_URI];; + +let true_URIs_ref = ref [HelmLibraryObjects.Logic.true_URI] +let false_URIs_ref = ref [HelmLibraryObjects.Logic.false_URI] +let absurd_URIs_ref = ref [HelmLibraryObjects.Logic.absurd_URI] + + +(**** SET_DEFAULT ****) + +exception NotRecognized;; + +(* insert an element in front of the list, removing from the list all the + previous elements with the same key associated *) +let insert_unique e extract l = + let uri = extract e in + let l' = + List.filter (fun x -> let uri' = extract x in not (UriManager.eq uri uri')) l + in + e :: l' + +let set_default what l = + match what,l with + "equality",[eq_URI;sym_eq_URI;trans_eq_URI;eq_ind_URI;eq_ind_r_URI] -> + eq_URIs_ref := + insert_unique (eq_URI,sym_eq_URI,trans_eq_URI,eq_ind_URI,eq_ind_r_URI) + (fun x,_,_,_,_ -> x) !eq_URIs_ref + | "true",[true_URI] -> + true_URIs_ref := insert_unique true_URI (fun x -> x) !true_URIs_ref + | "false",[false_URI] -> + false_URIs_ref := insert_unique false_URI (fun x -> x) !false_URIs_ref + | "absurd",[absurd_URI] -> + absurd_URIs_ref := insert_unique absurd_URI (fun x -> x) !absurd_URIs_ref + | _,_ -> raise NotRecognized + +let reset_defaults () = + eq_URIs_ref := default_eq_URIs; + true_URIs_ref := default_true_URIs; + false_URIs_ref := default_false_URIs; + absurd_URIs_ref := default_absurd_URIs + +(**** LOOKUP FUNCTIONS ****) + +let eq_URI () = let eq,_,_,_,_ = List.hd !eq_URIs_ref in eq + +let is_eq_URI uri = + List.exists (fun (eq,_,_,_,_) -> UriManager.eq eq uri) !eq_URIs_ref + +let sym_eq_URI ~eq:uri = + try + let _,x,_,_,_ = List.find (fun eq,_,_,_,_ -> UriManager.eq eq uri) !eq_URIs_ref in x + with Not_found -> raise NotRecognized + +let trans_eq_URI ~eq:uri = + try + let _,_,x,_,_ = List.find (fun eq,_,_,_,_ -> UriManager.eq eq uri) !eq_URIs_ref in x + with Not_found -> raise NotRecognized + +let eq_ind_URI ~eq:uri = + try + let _,_,_,x,_ = List.find (fun eq,_,_,_,_ -> UriManager.eq eq uri) !eq_URIs_ref in x + with Not_found -> raise NotRecognized + +let eq_ind_r_URI ~eq:uri = + try + let _,_,_,_,x = List.find (fun eq,_,_,_,_ -> UriManager.eq eq uri) !eq_URIs_ref in x + with Not_found -> raise NotRecognized + +let true_URI () = List.hd !true_URIs_ref +let false_URI () = List.hd !false_URIs_ref +let absurd_URI () = List.hd !absurd_URIs_ref