X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fmathql_interpreter%2Fuse.ml;h=654c3e69b16e046a4836f2630f18dfded67589d2;hb=61872e154b77378c203e4a9b179b4067cfe7f23b;hp=f1ac7c779eff2b3b1771c3c83b71b4efa396bcbc;hpb=6a1d05b388683befc860b48b4f2bbaf42f58a112;p=helm.git diff --git a/helm/ocaml/mathql_interpreter/use.ml b/helm/ocaml/mathql_interpreter/use.ml index f1ac7c779..654c3e69b 100644 --- a/helm/ocaml/mathql_interpreter/use.ml +++ b/helm/ocaml/mathql_interpreter/use.ml @@ -1,3 +1,27 @@ +(* Copyright (C) 2000, 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://www.cs.unibo.it/helm/. + *) (* * implementazione dei comandi USE/USED BY @@ -19,115 +43,48 @@ open Dbconn;; * * output: string list list; lista su cui e' stato eseguito il * comando USE/USED BY - * - * TODO - * USE e USED BY sono identici dal punto di vista algoritmico, per questo - * sono stati accorpati in una sola funzione; stilisticamente, sarebbe meglio - * avere due implementazioni distinte... *) -let use_ex alist asvar usek = +let get_prop_id prop = + if prop="refObj" then "F" + else if prop="backPointer" then "B" + else assert false + ;; + + +let relation_ex rop path rset attl = + let usek = get_prop_id (List.hd path) in + +let _ = print_string ("RELATION "^usek) +and t = Unix.time () in +let result = let c = pgc () in - List.fold_left - (fun parziale xres -> - let r1 = pgresult_to_string (c#exec - ("select att0 from property where att2='" ^ usek ^ "'")) - and r2 = pgresult_to_string (c#exec - "select att0 from property where att2='position'") - and r3 = pgresult_to_string (c#exec - "select att0 from property where att2='occurrence'") - in - let res = c#exec ( - "select distinct t" ^ r3 ^ ".att1, t" ^ r2 ^ ".att1 " ^ - "from t" ^ r3 ^ ", t" ^ r2 ^ ", t" ^ r1 ^ " " ^ - "where " ^ "t" ^ r1 ^ ".att0 = '" ^ (List.hd xres) ^ "' and t" ^ r1 ^ - ".att1 = t" ^ r2 ^ ".att0 and t" ^ r1 ^ ".att1 = t" ^ r3 ^ - ".att0") - in - parziale - @ - if not (List.mem asvar (List.tl (List.hd alist))) then - List.map - (fun l -> [List.hd l] @ List.tl xres @ List.tl l) - res#get_list - else - List.map - (fun l -> - let t = - match xres with - hd::tl -> (List.hd l)::tl - | [] -> [] - in - List.map - snd - (Utility.set_assoc - asvar - (List.hd (List.tl l)) - (List.combine (List.hd alist) t) - ) - ) - (List.find_all - (fun l -> - let currv = - List.hd (List.tl l) - and xresv = - try ( - List.assoc - asvar - (List.combine - (List.tl (List.hd alist)) - (List.tl xres) - ) - ) with - Not_found -> "" - in - xresv = "" or xresv = currv - ) - res#get_list - ) + Sort.list + (fun (uri1-> uri1 < uri2) + (List.fold_left + (fun parziale (uri,aset)-> + print_string uri ; + let tv = + pgresult_to_string + (c#exec ("select id from registry where uri='" ^ uri ^ "'")) + in + let qq = + "select uri, context from t" ^ tv ^ " where prop_id='" ^ usek ^ + "' order by uri asc" + in + let res = c#exec qq in + (List.map + (function + [uri;context] -> {S.uri = uri ; S.attributes = [asvar, context] ; S.extra = ""} + | _ -> assert false + ) res#get_list + ) @ + parziale + ) [] rset ) - [ (List.hd alist) - @ - if not (List.mem asvar (List.tl (List.hd alist))) then - [asvar] - else - [] - ] - (List.tl alist) +in +print_string (" = " ^ string_of_int (List.length result) ^ ": ") ; +print_endline (string_of_float (Unix.time () -. t) ^ "s") ; +flush stdout ; + result ;; -(** TEST **) - -(* -let use_ex alist asvar = - if (List.find_all asvar (List.tl (List.hd alist))) = [] then - use_ex_nc alist asvar - else - use_ex_co alist asvar -;; - -List.map - (fun l -> - let t = - match xres with - hd::tl -> (List.hd l)::tl - | [] -> [] - in - let hash = List.combine (List.hd alist) t in - snd (set_assoc asvar (snd l) hash) - ) - (List.find_all - (fun l -> - let currv = - List.hd (List.tl l) - and xresv = - try ( - List.assoc asvar (List.combine (List.tl (List.hd alist)) (List.tl xres)) - ) with - Not_found -> "" - in - xresv = "" or xresv = currv - ) - res#get_list - ) -;; -*)