;;
(* Product between an attribute set and a group of attributes *)
-let rec sub_prod (aset, gr) = (*prende un aset e un gr e fa la somma tra tutti i gruppi di aset e gr *)
+let rec sub_prod (aset, gr) = (*prende un aset e un gr, fa la somma tra tutti i gruppi di aset e gr*)
match aset with
[] -> []
| gr1::tl1 -> sum_groups (gr1, gr)::(sub_prod(tl1, gr))
;;
(* Intersection between two resource sets, preserves order and gets rid of duplicates *)
-let intersect_ex rs1 rs2 =
- let rec intersect_aux rs1 rs2 =
- match (rs1, rs2) with
- [],_
- | _,[] -> []
- | (uri1,_)::tl1,
- (uri2,_)::_ when uri1 < uri2 -> intersect_aux tl1 rs2
- | (uri1,_)::_,
- (uri2,_)::tl2 when uri2 < uri1 -> intersect_aux rs1 tl2
- | (uri1,as1)::tl1,
- (uri2,as2)::tl2 -> (uri1, prod(as1,as2))::intersect_aux tl1 tl2
- in
- let before = Sys.time () in
- let res = intersect_aux rs1 rs2 in
- let after = Sys.time () in
- let ll1 = string_of_int (List.length rs1) in
- let ll2 = string_of_int (List.length rs2) in
- let diff = string_of_float (after -. before) in
- print_endline
- ("INTERSECT(" ^ ll1 ^ "," ^ ll2 ^ ") = " ^ string_of_int (List.length res) ^
- ": " ^ diff ^ "s") ;
- flush stdout ;
- res
+let rec intersect_ex rs1 rs2 =
+ match (rs1, rs2) with
+ [],_
+ | _,[] -> []
+ | (uri1,_)::tl1, (uri2,_)::_ when uri1 < uri2 -> intersect_ex tl1 rs2
+ | (uri1,_)::_, (uri2,_)::tl2 when uri2 < uri1 -> intersect_ex rs1 tl2
+ | (uri1,as1)::tl1, (uri2,as2)::tl2 -> (uri1, prod(as1,as2))::intersect_ex tl1 tl2
;;
-
exception BooleExpTrue
+let stat = ref true
+
+let set_stat b = stat := b
+
(* valuta una MathQL.set_exp e ritorna un MathQL.resource_set *)
let rec exec_set_exp c = function
|MathQL.SVar svar -> List.assoc svar c.svars
|MathQL.RVar rvar -> [List.assoc rvar c.rvars]
| MathQL.Ref vexp -> List.map (fun s -> (s,[])) (exec_val_exp c vexp)
- | MathQL.Intersect (sexp1, sexp2) -> intersect_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2)
+ | MathQL.Intersect (sexp1, sexp2) ->
+ let before = Sys.time() in
+ let rs1 = exec_set_exp c sexp1 in
+ let rs2 = exec_set_exp c sexp2 in
+ let res = intersect_ex rs1 rs2 in
+ let after = Sys.time() in
+ let ll1 = string_of_int (List.length rs1) in
+ let ll2 = string_of_int (List.length rs2) in
+ let diff = string_of_float (after -. before) in
+ if !stat then
+ (print_endline("INTERSECT(" ^ ll1 ^ "," ^ ll2 ^ ") = " ^ string_of_int (List.length res) ^
+ ": " ^ diff ^ "s");
+ flush stdout);
+ res
| MathQL.Union (sexp1, sexp2) ->
let before = Sys.time () in
let res = union_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2) in
- let after = Sys.time () in
+ let after = Sys.time() in
let diff = string_of_float (after -. before) in
- print_endline ("UNION: " ^ diff ^ "s") ;
- flush stdout ;
+ if !stat then
+ (print_endline ("UNION: " ^ diff ^ "s");
+ flush stdout);
res
| MathQL.LetSVar (svar, sexp1, sexp2) ->
- let before = Sys.time () in
+ let before = Sys.time() in
let c1 = upd_svars c ((svar, exec_set_exp c sexp1) :: c.svars) in
let res = exec_set_exp c1 sexp2 in
- print_string ("LETIN " ^ svar ^ " = " ^ string_of_int (List.length res) ^ ": ") ;
- print_endline (string_of_float (Sys.time () -. before) ^ "s") ;
- flush stdout ; res
+ if !stat then
+ (print_string ("LETIN " ^ svar ^ " = " ^ string_of_int (List.length res) ^ ": ");
+ print_endline (string_of_float (Sys.time() -. before) ^ "s");
+ flush stdout);
+ res
| MathQL.LetVVar (vvar, vexp, sexp) ->
- let before = Sys.time () in
+ let before = Sys.time() in
let c1 = upd_vvars c ((vvar, exec_val_exp c vexp) :: c.vvars) in
let res = exec_set_exp c1 sexp in
- print_string ("LETIN " ^ vvar ^ " = " ^ string_of_int (List.length res) ^ ": ") ;
- print_endline (string_of_float (Sys.time () -. before) ^ "s") ;
- flush stdout ; res
- | MathQL.Relation (rop, path, sexp, attl) -> relation_ex rop path (exec_set_exp c sexp) attl
+ if !stat then
+ (print_string ("LETIN " ^ vvar ^ " = " ^ string_of_int (List.length res) ^ ": ");
+ print_endline (string_of_float (Sys.time() -. before) ^ "s");
+ flush stdout);
+ res
+ | MathQL.Relation (rop, path, sexp, attl) ->
+ let before = Sys.time() in
+ let res = relation_ex rop path (exec_set_exp c sexp) attl in
+ if !stat then
+ (print_string ("RELATION " ^ (List.hd path) ^ " = " ^ string_of_int(List.length res) ^ ": ");
+ print_endline (string_of_float (Sys.time() -. before) ^ "s");
+ flush stdout);
+ res
| MathQL.Select (rvar, sexp, bexp) ->
- let before = Sys.time () in
+ let before = Sys.time() in
let rset = (exec_set_exp c sexp) in
let rec select_ex rset =
match rset with
else select_ex tl
in
let res = select_ex rset in
- print_string ("SELECT " ^ rvar ^ " = " ^ string_of_int (List.length res) ^ ": ") ;
- print_endline (string_of_float (Sys.time () -. before) ^ "s") ;
- flush stdout ; res
+ if !stat then
+ (print_string ("SELECT " ^ rvar ^ " = " ^ string_of_int (List.length res) ^ ": ");
+ print_endline (string_of_float (Sys.time() -. before) ^ "s");
+ flush stdout);
+ res
| MathQL.Diff (sexp1, sexp2) -> diff_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2)
| _ -> assert false
in
sub_prod attl
in
- prod c latt;false
+ prod c latt; false
with BooleExpTrue -> true
(* valuta una MathQL.val_exp e ritorna un MathQL.value *)
* http://www.cs.unibo.it/helm/.
*)
-open Union;;
-open Dbconn;;
-open Utility;;
+
(*
* implementazione del comando Relation
*)
+
+
+open Union;;
+open Dbconn;;
+open Utility;;
+
+
+
+
let get_prop_id propl =
- let prop = List.hd propl in
+ let prop = List.hd propl in
if prop="refObj" then "F"
else if prop="backPointer" then "B"
else assert false
;;
-
let relation_ex rop path rset attl =
- if path = [] then []
- else
- let usek = get_prop_id path in
-
-let vvar = if attl = [] then "position"
- else List.hd attl
-in
-(*let (uril,atts) = List.split rset in*)
-let _ = print_string ("RELATION "^usek)
-and t = Sys.time () in
-let result =
- let c = pgc () in
-
-let rset_list = (* lista di singoletti:resource_set di un elemento *)
-(List.fold_left (fun acc (uri,l) ->
- 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] -> [(uri,[[(vvar,[context])]])]
- | _ -> assert false )
- res#get_list) @ acc
- )
- [] rset
-)
-in
- let rec edup = function
- [] -> []
- | rs1::tl -> union_ex rs1 (edup tl)
- in
- edup rset_list
-
-
-in
-print_string (" = " ^ string_of_int (List.length result) ^ ": ") ;
-print_endline (string_of_float (Sys.time () -. t) ^ "s") ;
-flush stdout ;
- result
+ if path = [] then []
+ else
+ let usek = get_prop_id path in
+ let vvar = if attl = [] then "position"
+ else List.hd attl
+ in
+ let c = pgc () in
+ let rset_list = (* lista di singoletti:resource_set di un elemento *)
+ (List.fold_left (fun acc (uri,l) ->
+ 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] -> [(uri,[[(vvar,[context])]])]
+ | _ -> assert false )
+ res#get_list) @ acc
+ )
+ [] rset
+ )
+ in
+ let rec edup = function
+ [] -> []
+ | rs1::tl -> union_ex rs1 (edup tl)
+ in
+ edup rset_list
;;
-
projects / helm.git / commitdiff