From 2ef44e8d1a908a08d31e6114c15898ae7dc8109e Mon Sep 17 00:00:00 2001 From: lordi Date: Fri, 24 May 2002 17:27:09 +0000 Subject: [PATCH] faster database format implemented --- helm/ocaml/mathql_interpreter/Makefile | 2 +- helm/ocaml/mathql_interpreter/intersect.ml | 9 ++- helm/ocaml/mathql_interpreter/mqint.ml | 35 ++++---- helm/ocaml/mathql_interpreter/pattern.ml | 5 +- helm/ocaml/mathql_interpreter/select.ml | 20 +++-- helm/ocaml/mathql_interpreter/use.ml | 94 ++++++++-------------- 6 files changed, 75 insertions(+), 90 deletions(-) diff --git a/helm/ocaml/mathql_interpreter/Makefile b/helm/ocaml/mathql_interpreter/Makefile index 20335f6ce..5769f6cde 100644 --- a/helm/ocaml/mathql_interpreter/Makefile +++ b/helm/ocaml/mathql_interpreter/Makefile @@ -1,5 +1,5 @@ PACKAGE = mathql_interpreter -REQUIRES = helm-urimanager pgocaml +REQUIRES = helm-urimanager pgocaml unix PREDICATES = INTERFACE_FILES = dbconn.mli eval.mli utility.mli func.mli diff.mli \ diff --git a/helm/ocaml/mathql_interpreter/intersect.ml b/helm/ocaml/mathql_interpreter/intersect.ml index f869838f3..e346101cf 100644 --- a/helm/ocaml/mathql_interpreter/intersect.ml +++ b/helm/ocaml/mathql_interpreter/intersect.ml @@ -68,7 +68,8 @@ let intersect_tails h1 t1 h2 t2 = try (*match xres_join_context h1 tl1 h2 tl2 with [] -> aux tll1 tll2 - | t ->*) (l1::(xres_join_context h1 tl1 h2 tl2))::(aux tll1 tll2) + | t -> (l1::(xres_join_context h1 tl1 h2 tl2))::(aux tll1 tll2)*) + (l1::(tl1 @ tl2))::(aux tll1 tll2) with Join_must_be_empty -> aux tll1 tll2 else @@ -85,6 +86,9 @@ let intersect_tails h1 t1 h2 t2 = * implementazione del comando INTERSECT *) let intersect_ex l1 l2 = + let _ = print_string ("INTERSECT ") + and t = Unix.time () in + let result = match (l1, l2) with ((head1::tail1), (head2::tail2)) -> (match (head1, head2) with @@ -129,5 +133,8 @@ let intersect_ex l1 l2 = ) (* match *) ) | _ -> [] + in + let _ = print_endline (string_of_float (Unix.time () -. t)); flush stdout in + result ;; diff --git a/helm/ocaml/mathql_interpreter/mqint.ml b/helm/ocaml/mathql_interpreter/mqint.ml index 8aa07a368..c78465aa7 100644 --- a/helm/ocaml/mathql_interpreter/mqint.ml +++ b/helm/ocaml/mathql_interpreter/mqint.ml @@ -69,24 +69,23 @@ let init () = Dbconn.init ();; * output: string list list; risultato internto formato da uri + contesto. *) let rec execute_ex q = - match q with - MQSelect (apvar, alist, abool) -> - select_ex apvar (execute_ex alist) abool - | MQUsedBy (alist, asvar) -> - use_ex (execute_ex alist) asvar "refObj" - | MQUse (alist, asvar) -> - use_ex (execute_ex alist) asvar "backPointer" - | MQPattern (apreamble, apattern, afragid) -> - (*let _ = print_endline ("*********" ^ apreamble ^ (fi_to_string afragid)); flush stdout in*) - pattern_ex apreamble apattern afragid - | MQUnion (l1, l2) -> - union_ex (execute_ex l1) (execute_ex l2) - | MQDiff (l1, l2) -> - diff_ex (execute_ex l1) (execute_ex l2) - | MQSortedBy (l, o, f) -> - sortedby_ex (execute_ex l) o f - | MQIntersect (l1, l2) -> - intersect_ex (execute_ex l1) (execute_ex l2) + match q with + MQSelect (apvar, alist, abool) -> + select_ex apvar (execute_ex alist) abool + | MQUsedBy (alist, asvar) -> + use_ex (execute_ex alist) asvar "F" (*"refObj"*) + | MQUse (alist, asvar) -> + use_ex (execute_ex alist) asvar "B" (*"backPointer"*) + | MQPattern (apreamble, apattern, afragid) -> + pattern_ex apreamble apattern afragid + | MQUnion (l1, l2) -> + union_ex (execute_ex l1) (execute_ex l2) + | MQDiff (l1, l2) -> + diff_ex (execute_ex l1) (execute_ex l2) + | MQSortedBy (l, o, f) -> + sortedby_ex (execute_ex l) o f + | MQIntersect (l1, l2) -> + intersect_ex (execute_ex l1) (execute_ex l2) ;; (* diff --git a/helm/ocaml/mathql_interpreter/pattern.ml b/helm/ocaml/mathql_interpreter/pattern.ml index cc03b61b8..b68baa9a4 100644 --- a/helm/ocaml/mathql_interpreter/pattern.ml +++ b/helm/ocaml/mathql_interpreter/pattern.ml @@ -33,8 +33,9 @@ open Eval;; let pattern_ex apreamble apattern afragid = let c = pgc () in - let r1 = helm_class_id "MathResource" in - let qq = "select att0 from t" ^ r1 ^ " where att0 " ^ (pattern_match apreamble apattern afragid) ^ " order by t" ^ r1 ^ ".att0 asc" in + (*let r1 = helm_class_id "MathResource" in*) + (*let qq = "select att0 from t" ^ r1 ^ " where att0 " ^ (pattern_match apreamble apattern afragid) ^ " order by t" ^ r1 ^ ".att0 asc" in*) + let qq = "select uri from registry where uri " ^ (pattern_match apreamble apattern afragid) ^ " order by registry.uri asc" in (*let _ = print_endline qq in*) let res = c#exec (qq) diff --git a/helm/ocaml/mathql_interpreter/select.ml b/helm/ocaml/mathql_interpreter/select.ml index 191ffde34..f408b8bfe 100644 --- a/helm/ocaml/mathql_interpreter/select.ml +++ b/helm/ocaml/mathql_interpreter/select.ml @@ -193,12 +193,18 @@ let rec replace avar newval l = * implementazione del comando SELECT *) let select_ex avar alist abool = - let wrt = replace avar "retVal" abool in - (*let j = print_booltree wrt in*) - [List.hd alist] - @ - List.find_all - (fun l -> is_good (List.combine (List.hd alist) l) wrt) - (List.tl alist) + let _ = print_string ("SELECT ") + and t = Unix.time () in + let result = + let wrt = replace avar "retVal" abool in + (*let j = print_booltree wrt in*) + [List.hd alist] + @ + List.find_all + (fun l -> is_good (List.combine (List.hd alist) l) wrt) + (List.tl alist) + in + let _ = print_endline (string_of_float (Unix.time () -. t)); flush stdout in + result ;; diff --git a/helm/ocaml/mathql_interpreter/use.ml b/helm/ocaml/mathql_interpreter/use.ml index 899a2bf89..7755ff20a 100644 --- a/helm/ocaml/mathql_interpreter/use.ml +++ b/helm/ocaml/mathql_interpreter/use.ml @@ -45,70 +45,42 @@ open Dbconn;; * comando USE/USED BY *) let use_ex alist asvar usek = - let c = pgc () in - List.fold_left - (fun parziale xres -> - let r1 = helm_property_id usek - and r2 = helm_property_id "position" - and r3 = helm_property_id "occurrence" - in - let qq = "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 order by t" ^ r3 ^ ".att1 asc" + let _ = print_string ("USE ") + and t = Unix.time () in + let result = + let c = pgc () + in + [ (List.hd alist) @ [asvar] ] + @ + Sort.list + (fun l m -> List.hd l < List.hd m) + (List.fold_left + (fun parziale xres -> + (*let r1 = helm_property_id usek + and r2 = helm_property_id "position" + and r3 = helm_property_id "occurrence" in - (*let _ = print_endline ("use: " ^ qq) in*) - let res = c#exec qq in - parziale - @ - if not (List.mem asvar (List.tl (List.hd alist))) then - List.map + let qq = "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 order by t" ^ r3 ^ ".att1 asc"*) + let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ (List.hd xres) ^ "'")) in + let qq = "select uri, context from t" ^ tv ^ " where back_for='" ^ usek ^ "'" + in + let res = c#exec qq in + (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 - ) + ) + @ + parziale + ) + [] + (List.tl alist) ) - [ (List.hd alist) - @ - if not (List.mem asvar (List.tl (List.hd alist))) then - [asvar] - else - [] - ] - (List.tl alist) + in + let _ = print_endline (string_of_float (Unix.time () -. t)); flush stdout in + result ;; -- 2.39.2