-open Dbconn;;
-open Union;;
-open Intersect;;
-open Meet;;
-open Property;;
-open Sub;;
-open Context;;
-open Diff;;
-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 InvalidConnection
-exception ConnectionFailed of string
-
-exception BooleExpTrue
-
-(* valuta una MathQL.set_exp e ritorna un MathQL.resource_set *)
-
-let galax_char = 'G'
-let stat_char = 'S'
-
-let execute_aux log m x =
- let module M = MathQL in
- let module X = MQueryMisc in
-let rec exec_set_exp c = function
- M.SVar svar ->
- (try
- List.assoc svar c.svars
- with Not_found ->
- raise (SVarUnbound svar))
- | M.RVar rvar ->
- (try
- [List.assoc rvar c.rvars]
- with Not_found ->
- raise (RVarUnbound rvar))
- | M.Ref vexp -> List.map (fun s -> (s,[])) (exec_val_exp c vexp)
- | M.Pattern vexp -> pattern_ex (exec_val_exp c vexp)
- | M.Intersect (sexp1, sexp2) ->
- let before = X.start_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 diff = X.stop_time before in
- let ll1 = string_of_int (List.length rs1) in
- let ll2 = string_of_int (List.length rs2) in
- if String.contains m stat_char then
- log ("INTERSECT(" ^ ll1 ^ "," ^ ll2 ^ ") = " ^ string_of_int (List.length res) ^
- ": " ^ diff ^ "\n");
- res
- | M.Union (sexp1, sexp2) ->
- let before = X.start_time () in
- let res = union_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2) in
- let diff = X.stop_time before in
- if String.contains m stat_char then log ("UNION: " ^ diff ^ "\n");
- res
- | M.LetSVar (svar, sexp1, sexp2) ->
- let before = X.start_time() in
- let c1 = upd_svars c ((svar, exec_set_exp c sexp1) :: c.svars) in
- let res = exec_set_exp c1 sexp2 in
- if String.contains m stat_char then begin
- log ("LETIN " ^ svar ^ " = " ^ string_of_int (List.length res) ^ ": ");
- log (X.stop_time before ^ "\n");
- end;
- res
- | M.LetVVar (vvar, vexp, sexp) ->
- let before = X.start_time() in
- let c1 = upd_vvars c ((vvar, exec_val_exp c vexp) :: c.vvars) in
- let res = exec_set_exp c1 sexp in
- if String.contains m stat_char then begin
- log ("LETIN " ^ vvar ^ " = " ^ string_of_int (List.length res) ^ ": ");
- log (X.stop_time before ^ "\n");
- end;
- res
- | M.Relation (inv, rop, path, sexp, assl) ->
- let before = X.start_time() in
- if String.contains m galax_char then begin
- let res = relation_galax_ex inv rop path (exec_set_exp c sexp) assl in
- if String.contains m stat_char then begin
- log ("RELATION-GALAX " ^ (fst path) ^ " = " ^ string_of_int(List.length res) ^ ": ");
- log (X.stop_time before ^ "\n")
- end;
- res
- end else begin
- let res = relation_ex inv rop path (exec_set_exp c sexp) assl in
- if String.contains m stat_char then begin
- log ("RELATION " ^ (fst path) ^ " = " ^ string_of_int(List.length res) ^ ": ");
- log (X.stop_time before ^ "\n")
- end;
- res
- end
- | M.Select (rvar, sexp, bexp) ->
- let before = X.start_time() in
- let rset = (exec_set_exp c sexp) in
- let rec select_ex =
- function
- [] -> []
- | 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
- let res = select_ex rset in
- if String.contains m stat_char then begin
- log ("SELECT " ^ rvar ^ " = " ^ string_of_int (List.length res) ^ ": ");
- log (X.stop_time before ^ "\n");
- end;
- res
- | M.Diff (sexp1, sexp2) -> diff_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2)
-
-(* valuta una MathQL.boole_exp e ritorna un boole *)