From: natile Date: Tue, 8 Oct 2002 13:59:20 +0000 (+0000) Subject: Updating contests and time misurations X-Git-Tag: new_mathql_before_first_merge~12 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=4966a96baa1f978bd48c202713b25a1f1d6b079a;p=helm.git Updating contests and time misurations --- diff --git a/helm/ocaml/mathql_interpreter/mqint.ml b/helm/ocaml/mathql_interpreter/mqint.ml index bfe85f7ea..9553f56df 100644 --- a/helm/ocaml/mathql_interpreter/mqint.ml +++ b/helm/ocaml/mathql_interpreter/mqint.ml @@ -23,18 +23,16 @@ * http://cs.unibo.it/helm/. *) + + + (* * implementazione del'interprete MathQL *) -(* -(* FG: ROBA VECCHIA DA BUTTARE (tranne apertura e chiusura database *) -open MathQL;; -open Eval;; -open Utility;; -open Pattern;;*) + open Dbconn;; open Union;; open Intersect;; @@ -43,215 +41,9 @@ open Sub;; open Context;; open Diff;; open Relation;; -(*open Sortedby;; -open Use;; -open Select;; -open Letin;; -open Mathql_semantics;; - - - -let prop_pool = ref None;; - -let fi_to_string fi = - match fi with - (None, _) -> - "" - | (Some i, y) -> - "#xpointer(1/" ^ - string_of_int i ^ - ( - match y with - None -> - "" - | Some j -> - "/" ^ (string_of_int j) - ) ^ - ")" -;; -let see_prop_pool () = - let _ = print_endline "eccomi" in - List.iter - (fun elem -> print_endline (fst elem ^ ": " ^ snd elem)) - (match !prop_pool with Some l -> l | _ -> print_endline "ciao"; assert false) -;; - - - -let get_prop_id prop = - if prop="refObj" then "F" - else if prop="backPointer" then "B" - else List.assoc prop (match !prop_pool with Some l -> l | _ -> assert false) -;; - -(* execute_ex env q *) -(* [env] is the attributed uri environment in which the query [q] *) -(* must be evaluated *) -(* [q] is the query to evaluate *) -(* It returns a [Mathql_semantics.result] *) -let rec execute_ex env = - function - MQSelect (apvar, alist, abool) -> - select_ex env apvar (execute_ex env alist) abool - | MQUsedBy (alist, asvar) -> - use_ex (execute_ex env alist) asvar (get_prop_id "refObj") (* "F" (*"refObj"*) *) - | MQUse (alist, asvar) -> - use_ex (execute_ex env alist) asvar (get_prop_id "backPointer") (* "B" (*"backPointer"*) *) - | MQPattern (apreamble, apattern, afragid) -> - pattern_ex (apreamble, apattern, afragid) - | MQUnion (l1, l2) -> - union_ex (execute_ex env l1) (execute_ex env l2) - | MQDiff (l1, l2) -> - diff_ex (execute_ex env l1) (execute_ex env l2) - | MQSortedBy (l, o, f) -> - sortedby_ex (execute_ex env l) o f - | MQIntersect (l1, l2) -> - intersect_ex (execute_ex env l1) (execute_ex env l2) - | MQListRVar rvar -> [List.assoc rvar env] - | MQLetIn (lvar, l1, l2) -> - let t = Sys.time () in - let res = - (*CSC: The interesting code *) - let _ = letin_ex lvar (execute_ex env l1) in - execute_ex env l2 - (*CSC: end of the interesting code *) - in - letdispose (); - print_string ("LETIN = " ^ string_of_int (List.length res) ^ ": ") ; - print_endline (string_of_float (Sys.time () -. t) ^ "s") ; - flush stdout ; - res - | MQListLVar lvar -> - letref_ex lvar - | MQReference l -> - let rec build_result = function - | [] -> [] - | s :: tail -> - {uri = s ; attributes = [] ; extra = ""} :: build_result tail - in build_result (List.sort compare l) -;; - -(* Let's initialize the execute in Select, creating a cyclical recursion *) -Select.execute := execute_ex;; - -(* - * converte il risultato interno di una query (uri + contesto) - * in un risultato di sole uri - * - * parametri: - * l: string list list; - * - * output: mqresult; - * - * note: - * il tipo del risultato mantenuto internamente e' diverso dal tipo di risultato - * restituito in output poiche', mentre chi effettua le query vuole come risultato - * solo le eventuali uri che soddisfano le query stesse, internamente ad una uri - * sono associati anche i valori delle variabili che ancora non sono state valutate - * perche', ad esempio, si trovano in altri rami dell'albero. - * -* Esempio: - * SELECT x IN USE PATTERN "cic:/**.con" POSITION $a WHERE $a IS MainConclusion - * L'albero corrispondente a questa query e': - * - * SELECT - * / | \ - * x USE IS - * / \ /\ - * PATTERN $a $a MainConclusion - * - * Nel momento in cui si esegue il ramo USE non sono noti i vincoli sullla variabile $a - * percui e' necessario considerare, oltre alle uri, i valori della variabile per i quali - * la uri puo' far parte del risultato. - *) -let xres_to_res l = - MQRefs (List.map (function {Mathql_semantics.uri = uri} -> uri) l) -(* - let tmp = List.map (function {Mathql_semantics.uri = uri} -> uri) l in - MQRefs - (List.map - (function l -> - (*let _ = print_endline ("DEBUG: (mqint.ml: xres_to_res)" ^ l) in*) - match Str.split (Str.regexp ":\|#\|/\|(\|)") l with - hd::""::tl -> ( - match List.rev tl with - n::"1"::"xpointer"::tail -> - ( - Some hd, - List.fold_left - (fun par t -> - match par with - [] -> [MQBC t] - | _ -> (MQBC t) :: MQBD :: par - ) - [] - tail, - [MQFC (int_of_string n)] - ) - | n::m::"1"::"xpointer"::tail -> - ( - Some hd, - List.fold_left - (fun par t -> - match par with - [] -> [MQBC t] - | _ -> (MQBC t) :: MQBD :: par - ) - [] - tail, - [MQFC (int_of_string m); MQFC (int_of_string n)] - ) - | tail -> - ( - Some hd, - List.fold_left - (fun par t -> - match par with - [] -> [MQBC t] - | _ -> (MQBC t) :: MQBD :: par - ) - [] - tail, - [] - ) - ) - | _ -> assert false - ) - tmp - ) -*) -;; - - -(* - * - *) -let execute q = - match q with - MQList qq -> xres_to_res (execute_ex [] qq) -;; - -let prop_pool = ref None;; - -*****************************************************************************) let init connection_param = Dbconn.init connection_param -(* - let c = pgc () in - let res = - c#exec "select name,id from property where ns_id in (select id from namespace where url='http://www.cs.unibo.it/helm/schemas/mattone.rdf#')" - in - prop_pool := Some - ( - List.map - (function - a::b::_ -> (a, b) - | _ -> print_endline "no"; assert false - ) - res#get_list - ) -*) let close () = Dbconn.close () @@ -266,9 +58,21 @@ let rec exec_set_exp c = function |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.Union (sexp1, sexp2) -> union_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2) - | MathQL.LetSVar (svar, sexp1, sexp2) -> let _ = (svar, (exec_set_exp c sexp1)):: (List.remove_assoc svar c.svars) - in (exec_set_exp c sexp2) + | 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 diff = string_of_float (after -. before) in + print_endline ("UNION: " ^ diff ^ "s") ; + flush stdout ; + res + | MathQL.LetSVar (svar, sexp1, sexp2) -> + 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 | MathQL.LetVVar (vvar, vexp, sexp) -> let before = Sys.time () in let c1 = upd_vvars c ((vvar, exec_val_exp c vexp) :: c.vvars) in @@ -277,17 +81,15 @@ let rec exec_set_exp c = function 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 - | MathQL.Select (rvar, sexp, bexp) -> let rset = (exec_set_exp c sexp) in - let rec select_ex rset = - match rset with - [] -> [] - | r::tl -> let c1 = upd_rvars c ((rvar,r)::c.rvars) in - if (exec_boole_exp c1 bexp) then r::(select_ex tl) - else select_ex tl - in select_ex rset - - - + | MathQL.Select (rvar, sexp, bexp) -> + let rset = (exec_set_exp c sexp) in + let rec select_ex rset = + match rset with + [] -> [] + | r::tl -> let c1 = upd_rvars c ((rvar,r)::c.rvars) in + if (exec_boole_exp c1 bexp) then r::(select_ex tl) + else select_ex tl + in select_ex rset | MathQL.Diff (sexp1, sexp2) -> diff_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2) | _ -> assert false @@ -305,30 +107,29 @@ and exec_boole_exp c = function | MathQL.Ex l bexp -> if l = [] then (exec_boole_exp c bexp) else - let latt = List.map (fun uri -> - let (r,attl) = List.assoc uri c.rvars - in (uri,attl)) l (*latt = l + attributi*) - in - try - let rec prod c = function - [] -> if (exec_boole_exp c bexp) then raise BooleExpTrue - | (uri,attl)::tail1 -> let rec sub_prod attl = + let latt = List.map (fun uri -> + let (r,attl) = List.assoc uri c.rvars in (uri,attl)) l (*latt = l + attributi*) + in + try + let rec prod c = function + [] -> if (exec_boole_exp c bexp) then raise BooleExpTrue + | (uri,attl)::tail1 -> let rec sub_prod attl = match attl with (*per ogni el. di attl *) [] -> () (*devo andare in ric. su tail1*) | att::tail2 -> let c1 = upd_groups c ((uri,att)::c.groups) in prod c1 tail1; sub_prod tail2 in sub_prod attl - in - prod c latt; false - with BooleExpTrue -> true + in + prod c latt; false + with BooleExpTrue -> true | _ -> assert false (* valuta una MathQL.val_exp e ritorna un MathQL.value *) and exec_val_exp c = function | MathQL.Const x -> let - ol = List.sort compare x in + ol = List.sort compare x in let rec edup = function [] -> [] diff --git a/helm/ocaml/mathql_interpreter/union.ml b/helm/ocaml/mathql_interpreter/union.ml index 35999170c..e2d9fcb01 100644 --- a/helm/ocaml/mathql_interpreter/union.ml +++ b/helm/ocaml/mathql_interpreter/union.ml @@ -27,85 +27,7 @@ * implementazione del comando UNION *) -(* -(* - * - *) -let xres_fill_context hr h1 l1 = - match l1 with - [] -> [] - | _ -> - let hh = List.combine h1 l1 - in - List.map - (fun x -> - if (List.mem_assoc x hh) then - List.assoc x hh - else - "" - ) - hr -;; -(* - * implementazione del comando UNION - *) -let union_ex alist1 alist2 = - let head1 = List.hd alist1 - and tail1 = List.tl alist1 - and head2 = List.hd alist2 - and tail2 = List.tl alist2 (* e fin qui ... *) - in - match (head1, head2) with - ([], _) -> assert false (* gli header non devono mai essere vuoti *) - | (_, []) -> assert false (* devono contenere almeno [retVal] *) - | (_, _) -> let headr = (head2 @ - (List.find_all - (function t -> not (List.mem t head2)) - head1) - ) in (* header del risultato finale *) - List.append (* il risultato finale e' la concatenazione ...*) - [headr] (* ... dell'header costruito prima ...*) - (Sort.list - (fun l m -> List.hd l < List.hd m) - (match (tail1, tail2) with (* e di una coda "unione" *) - ([], _) -> tail2 (* va bene perche' l'altra lista e' vuota *) - | (_, []) -> tail1 (* va bene perche' l'altra lista e' vuota *) - | (_, _) -> - let first = (* parte dell'unione che riguarda solo il primo set *) - List.map - ( - fun l -> - [List.hd l] @ - xres_fill_context (List.tl headr) (List.tl head1) (List.tl l) - ) - tail1 - in - List.fold_left - (fun par x -> - let y = (* elemento candidato ad entrare *) - [List.hd x] - @ - xres_fill_context - (List.tl headr) (List.tl head2) (List.tl x) - in - par @ if (List.find_all (fun t -> t = y) par) = [] then - [y] - else - [] - ) - first (* List.fold_left *) - tail2 (* List.fold_left *) -(* first @ - List.map (fun l -> [List.hd l] @ - xres_fill_context - (List.tl headr) (List.tl head2) (List.tl l) - ) tail2 -*) - ) (* match *) - ) -;; -*) (* Merges two attribute group lists preserves order and gets rid of duplicates*) let rec merge l1 l2 = match (l1,l2) with @@ -127,14 +49,4 @@ let rec union_ex rs1 rs2 = else (uri1,merge l1 l2)::(union_ex tl1 tl2) ;; -let union_ex l1 l2 = - let before = Sys.time () in - let res = union_ex l1 l2 in - let after = Sys.time () in - let ll1 = string_of_int (List.length l1) in - let ll2 = string_of_int (List.length l2) in - let diff = string_of_float (after -. before) in - print_endline ("UNION(" ^ ll1 ^ "," ^ ll2 ^ "): " ^ diff ^ "s") ; - flush stdout ; - res -;; +