X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fmathql_interpreter%2Fmqint.ml;h=af3298cce4493df4696656db34c72393934b6cf0;hb=fd1cdc0fff3f15c67d949e016135c77c7c4a7ebd;hp=ad27d1959cc4da46bf634a76c0de5e5cf7d257c2;hpb=d77da66c4cfe47042485fe6b8cab5c44d1e03c35;p=helm.git diff --git a/helm/ocaml/mathql_interpreter/mqint.ml b/helm/ocaml/mathql_interpreter/mqint.ml index ad27d1959..af3298cce 100644 --- a/helm/ocaml/mathql_interpreter/mqint.ml +++ b/helm/ocaml/mathql_interpreter/mqint.ml @@ -26,18 +26,32 @@ (* * 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 Pattern;; open Union;; open Intersect;; +open Meet;; +open Sub;; +open Context;; open Diff;; -open Sortedby;; +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 @@ -56,10 +70,20 @@ let fi_to_string fi = ")" ;; -(* - * inizializzazione della connessione al database - *) -let init () = Dbconn.init ();; +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] *) @@ -71,9 +95,9 @@ let rec execute_ex env = MQSelect (apvar, alist, abool) -> select_ex env apvar (execute_ex env alist) abool | MQUsedBy (alist, asvar) -> - use_ex (execute_ex env alist) asvar "F" (*"refObj"*) + use_ex (execute_ex env alist) asvar (get_prop_id "refObj") (* "F" (*"refObj"*) *) | MQUse (alist, asvar) -> - use_ex (execute_ex env alist) asvar "B" (*"backPointer"*) + 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) -> @@ -84,12 +108,28 @@ let rec execute_ex env = sortedby_ex (execute_ex env l) o f | MQIntersect (l1, l2) -> intersect_ex (execute_ex env l1) (execute_ex env l2) - | MQLRVar rvar -> [List.assoc rvar env] + | MQListRVar rvar -> [List.assoc rvar env] | MQLetIn (lvar, l1, l2) -> - let _ = letin_ex lvar (execute_ex env l1) in - execute_ex env l2 - | MQLetRef rvar -> - letref_ex rvar + let t = Unix.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 (Unix.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 *) @@ -192,8 +232,124 @@ let execute q = MQList qq -> xres_to_res (execute_ex [] qq) ;; +let prop_pool = ref None;; + +*****************************************************************************) + +let init () = Dbconn.init () +(* + 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 () + +let check () = Dbconn.pgc () + +exception BooleExpTrue + +(* 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.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.LetVVar (vvar, vexp, sexp) -> let _ = (vvar, (exec_val_exp c vexp)):: (List.remove_assoc vvar c.vvars) + in (exec_set_exp c sexp) + | 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.Diff (sexp1, sexp2) -> diff_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2) + | _ -> assert false + +(* valuta una MathQL.boole_exp e ritorna un boole *) + +and exec_boole_exp c = function + | MathQL.False -> false + | MathQL.True -> true + | MathQL.Not x -> not (exec_boole_exp c x) + | MathQL.And (x, y) -> (exec_boole_exp c x) && (exec_boole_exp c y) + | MathQL.Or (x, y) -> (exec_boole_exp c x) || (exec_boole_exp c y) + | MathQL.Sub (vexp1, vexp2) -> sub_ex (exec_val_exp c vexp1) (exec_val_exp c vexp2) + | MathQL.Meet (vexp1, vexp2) -> meet_ex (exec_val_exp c vexp1) (exec_val_exp c vexp2) + | MathQL.Eq (vexp1, vexp2) -> (exec_val_exp c vexp1) = (exec_val_exp c vexp2) + | 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 = + 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 + | _ -> 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 + let rec edup = function + + [] -> [] + | s::tl -> if tl <> [] then + if s = (List.hd tl) then edup tl + else s::(edup tl) + else s::[] + in + edup ol + | MathQL.Record (rvar, vvar) -> List.assoc vvar (List.assoc rvar c.groups) + + | MathQL.VVar s -> List.assoc s c.vvars + | MathQL.RefOf sexp -> List.map (fun (s,_) -> s) (exec_set_exp c sexp) + + | _ -> assert false + + +(* valuta una MathQL.set_exp nel contesto vuoto e ritorna un MathQL.resource_set *) + +and execute x = + exec_set_exp {svars = []; rvars = []; groups = []; vvars = []} x + + + + (* * chiusura della connessione al database - *) -let close () = Dbconn.close ();; + *) + let close () = Dbconn.close ();;