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 execute_aux handle x =
let module M = MathQL in
let module X = MQueryMisc in
let rec exec_set_exp c = function
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.Pattern vexp -> pattern_ex handle (exec_val_exp c vexp)
| M.Intersect (sexp1, sexp2) ->
let before = X.start_time() in
let rs1 = exec_set_exp c sexp1 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) ^
+ if MQIConn.set handle MQIConn.Stat then
+ MQIConn.log handle ("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");
+ if MQIConn.set handle MQIConn.Stat then MQIConn.log handle ("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");
+ if MQIConn.set handle MQIConn.Stat then begin
+ MQIConn.log handle ("LETIN " ^ svar ^ " = " ^ string_of_int (List.length res) ^ ": ");
+ MQIConn.log handle (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");
+ if MQIConn.set handle MQIConn.Stat then begin
+ MQIConn.log handle ("LETIN " ^ vvar ^ " = " ^ string_of_int (List.length res) ^ ": ");
+ MQIConn.log handle (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")
+ if MQIConn.set handle MQIConn.Galax then begin
+ let res = relation_galax_ex handle inv rop path (exec_set_exp c sexp) assl in
+ if MQIConn.set handle MQIConn.Stat then begin
+ MQIConn.log handle ("RELATION-GALAX " ^ (fst path) ^ " = " ^ string_of_int(List.length res) ^ ": ");
+ MQIConn.log handle (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")
+ let res = relation_ex handle inv rop path (exec_set_exp c sexp) assl in
+ if MQIConn.set handle MQIConn.Stat then begin
+ MQIConn.log handle ("RELATION " ^ (fst path) ^ " = " ^ string_of_int(List.length res) ^ ": ");
+ MQIConn.log handle (X.stop_time before ^ "\n")
end;
res
end
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");
+ if MQIConn.set handle MQIConn.Stat then begin
+ MQIConn.log handle ("SELECT " ^ rvar ^ " = " ^ string_of_int (List.length res) ^ ": ");
+ MQIConn.log handle (X.stop_time before ^ "\n");
end;
res
| M.Diff (sexp1, sexp2) -> diff_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2)
with Not_found ->
raise (VVarUnbound s))
| M.RefOf sexp -> List.map (fun (s,_) -> s) (exec_set_exp c sexp)
- | M.Fun (s, vexp) -> fun_ex s (exec_val_exp c vexp)
- | M.Property (inv, rop, path, vexp) -> property_ex rop path inv (exec_val_exp c vexp)
+ | M.Fun (s, vexp) -> fun_ex handle s (exec_val_exp c vexp)
+ | M.Property (inv, rop, path, vexp) -> property_ex handle rop path inv (exec_val_exp c vexp)
(* valuta una MathQL.set_exp nel contesto vuoto e ritorna un MathQL.resource_set *)
in
(* new interface ***********************************************************)
-module type Callbacks =
- sig
- val log : string -> unit (* logging function *)
- end
-
-module Make (C: Callbacks) =
- struct
-
- let postgres = "P"
- let galax = "G"
- let stat = "S"
- let quiet = "Q"
- let warn = "W"
-
- let execute m x = execute_aux C.log m x
+let execute handle x = execute_aux handle x
- let init m =
- let default_connection_string =
- "host=mowgli.cs.unibo.it dbname=helm_mowgli_new_schema user=helm"
- in
- let connection_string =
- try Sys.getenv "POSTGRESQL_CONNECTION_STRING"
- with Not_found -> default_connection_string
- in
- if String.contains m galax_char then true else
- try Dbconn.init connection_string; true
- with ConnectionFailed s -> false
-
- let close m =
- if String.contains m galax_char then () else Dbconn.close ()
-
- let check m =
- if String.contains m galax_char then false else
- try ignore (Dbconn.pgc ()); true with InvalidConnection -> false
-
- end
projects / helm.git / blobdiff