From 70ddfe8d7aad2f58a759736c5678fa99e2611da3 Mon Sep 17 00:00:00 2001 From: Claudio Sacerdoti Coen Date: Fri, 6 Dec 2002 13:13:29 +0000 Subject: [PATCH] * bug fixed: the property construct did not sort and did not remove duplicates from the answer * Not_found are now always catched in Mqint. Informative exceptions are raised. --- helm/ocaml/mathql_interpreter/mqint.ml | 103 +++++++++++++++------- helm/ocaml/mathql_interpreter/property.ml | 9 +- helm/ocaml/mathql_interpreter/sub.ml | 9 ++ 3 files changed, 84 insertions(+), 37 deletions(-) diff --git a/helm/ocaml/mathql_interpreter/mqint.ml b/helm/ocaml/mathql_interpreter/mqint.ml index 03247f64f..b275de355 100644 --- a/helm/ocaml/mathql_interpreter/mqint.ml +++ b/helm/ocaml/mathql_interpreter/mqint.ml @@ -45,6 +45,11 @@ open Relation;; open Func;; open Pattern;; +exception SVarUnbound of string;; +exception RVarUnbound of string;; +exception VVarUnbound of string;; +exception PathUnbound of (string * string list);; + exception BooleExpTrue let init connection_param = Dbconn.init connection_param @@ -76,8 +81,16 @@ let get_database () = ! dbname (* 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.SVar svar -> + (try + List.assoc svar c.svars + with Not_found -> + raise (SVarUnbound svar)) + | MathQL.RVar rvar -> + (try + [List.assoc rvar c.rvars] + with Not_found -> + raise (RVarUnbound rvar)) | MathQL.Ref vexp -> List.map (fun s -> (s,[])) (exec_val_exp c vexp) | MathQL.Pattern vexp -> pattern_ex (exec_val_exp c vexp) | MathQL.Intersect (sexp1, sexp2) -> @@ -160,34 +173,49 @@ let rec exec_set_exp c = function (* 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*) +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) = + (try + List.assoc uri c.rvars + with Not_found -> assert false) + 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 + try + let rec prod c = + function + [] -> if (exec_boole_exp c bexp) then raise BooleExpTrue + | (uri,attl)::tail1 -> + (*per ogni el. di attl devo andare in ric. su tail1*) + let rec sub_prod attl = + match attl with + [] -> () + | 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 (* valuta una MathQL.val_exp e ritorna un MathQL.value *) @@ -203,9 +231,20 @@ and exec_val_exp c = function else s::[] in edup ol - | MathQL.Record (rvar, path) -> List.assoc path (List.assoc rvar c.groups) - - | MathQL.VVar s -> List.assoc s c.vvars + | MathQL.Record (rvar, path) -> + (try + List.assoc path + (try + List.assoc rvar c.groups + with Not_found -> + raise (RVarUnbound rvar)) + with Not_found -> + raise (PathUnbound path)) + | MathQL.VVar s -> + (try + List.assoc s c.vvars + with Not_found -> + raise (VVarUnbound s)) | MathQL.RefOf sexp -> List.map (fun (s,_) -> s) (exec_set_exp c sexp) | MathQL.Fun (s, vexp) -> fun_ex s (exec_val_exp c vexp) | MathQL.Property (inv, rop, path, vexp) -> property_ex rop path inv (exec_val_exp c vexp) diff --git a/helm/ocaml/mathql_interpreter/property.ml b/helm/ocaml/mathql_interpreter/property.ml index 071d2884c..1158d3012 100644 --- a/helm/ocaml/mathql_interpreter/property.ml +++ b/helm/ocaml/mathql_interpreter/property.ml @@ -57,8 +57,8 @@ let rec property_ex rop path inv = function let mpid = getpid mprop in let res = let c = pgc () in - let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ s ^ "'")) in - let q = "select t" ^ tv ^ "." ^ prop ^ " from t" ^ tv ^ " where prop_id= '" ^ mpid ^ "'" in + let tv = pgresult_to_string (c#exec ("select distinct id from registry where uri='" ^ s ^ "' order by id")) in + let q = "select distinct t" ^ tv ^ "." ^ prop ^ " from t" ^ tv ^ " where prop_id= '" ^ mpid ^ "' order by t" ^ tv ^ "." ^ prop in print_endline q; pgresult_to_string_list (c#exec q) in @@ -72,7 +72,7 @@ let rec property_ex rop path inv = function if inv then (* restituisco gli uri che il valore della prop richiesta uguale a s *) let res = let c = pgc () in - let q = ("select h" ^ mprop ^ ".uri from h" ^ mprop ^ " where h" ^ mprop ^ "." ^ prop ^ "= '" ^ s ^ "'") in + let q = ("select distinct h" ^ mprop ^ ".uri from h" ^ mprop ^ " where h" ^ mprop ^ "." ^ prop ^ "= '" ^ s ^ "' order by h" ^ mprop ^ ".uri") in print_endline q; pgresult_to_string_list (c#exec q) in @@ -81,11 +81,10 @@ let rec property_ex rop path inv = function else let res = (* restituisco il valore della prop relativo all'uri rappresentato da s*) let c = pgc () in - let q = ("select h" ^ mprop ^ "." ^ prop ^" from h" ^ mprop ^ " where h" ^ mprop ^ ".uri = '" ^ s ^ "'") in + let q = ("select distinct h" ^ mprop ^ "." ^ prop ^" from h" ^ mprop ^ " where h" ^ mprop ^ ".uri = '" ^ s ^ "' order by h" ^ mprop ^ "." ^ prop) in pgresult_to_string_list (c#exec q) in append (res,(property_ex rop path inv tl)) - | _ -> (* metadati DC !!!! Controllare se i nomi delle tabelle cominciano con h !!!!*) diff --git a/helm/ocaml/mathql_interpreter/sub.ml b/helm/ocaml/mathql_interpreter/sub.ml index e59bf049d..a8ca9e629 100644 --- a/helm/ocaml/mathql_interpreter/sub.ml +++ b/helm/ocaml/mathql_interpreter/sub.ml @@ -32,3 +32,12 @@ let rec sub_ex v1 v2 = | s1::_, s2::tl2 when s2 < s1 -> sub_ex v1 tl2 | s1::tl1, s2::tl2 -> sub_ex tl1 tl2 ;; + +(* DEBUGGING ONLY +let sub_ex v1 v2 = + let b = sub_ex v1 v2 in + prerr_endline + ("SUB({" ^ String.concat "," v1 ^ "},{" ^ String.concat "," v2 ^"}) = " ^ + if b then "tt" else "ff") ; + b +;; *) -- 2.39.2