*)
open MathQL;;
-exception DBInvalidURI of string
-exception DBConnectionFailed of string
-exception DBInvalidConnection of string
-
-
-
-(*
- * paramentri della connessione
- *
- * TODO: bisogna scegliere se questi parametri vengono
- * passati come argomento
- *)
-(*let connection_param = "dbname=helm";;*)
-let connection_param = "host=mowgli.cs.unibo.it dbname=helm user=helm";;
+exception InvalidURI of string
+exception ConnectionFailed of string
+exception InvalidConnection
(*
* connessione al db
*)
-let conn = ref None;;
+let conn = ref None
(*
* controllo sulla connessione
*)
let pgc () =
match !conn with
- None -> raise (DBInvalidConnection connection_param)
+ None -> raise InvalidConnection
| Some c -> c
;;
* TODO
* passare i parametri della connessione come argomento di init
*)
-let init () =
+let init connection_param =
try (
conn := Some (new Postgres.connection connection_param);
- prerr_endline "connected."
) with
- _ -> raise (DBConnectionFailed ("init: " ^ connection_param))
+ _ -> raise (ConnectionFailed ("init: " ^ connection_param))
;;
(*
*)
val pgc : unit -> Postgres.connection
-val init : unit -> unit
+val init : string -> unit
val close : unit -> unit
let diff_ex l1 l2 =
- let before = Unix.time () in
+ let before = Sys.time () in
let res = diff_ex l1 l2 in
- let after = Unix.time () 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
res
;;
-(*
-
-let intersect_ex l1 l2 =
- (* PRE-CLAUDIO
- (*let _ = print_string ("INTERSECT ")
- and t = Unix.time () in*)
- let result =
- match (l1, l2) with
- ((head1::tail1), (head2::tail2)) ->
- (match (head1, head2) with
- ([], _) -> assert false (* gli header non devono mai essere vuoti *)
- | (_, []) -> assert false (* devono contenere almeno [retVal] *)
- | (_, _) ->
- (match (tail1, tail2) with
- ([], _) -> [["retVal"]] (* se una delle due code e' vuota... *)
- | (_, []) -> [["retVal"]] (* ... l'intersezione e' vuota *)
- | (_, _) ->
- [head2 @
- (List.find_all
- (function t -> not (List.mem t head2))
- head1
- )
- ] (* header del risultato finale *)
- @
- intersect_tails (List.tl head1) tail1 (List.tl head2) tail2
- (*
- List.fold_left
- (fun par1 elem1 -> par1 @
- List.map
- (fun elem2 ->
- [(List.hd elem1)] @
- (xres_join_context (List.tl head1) (List.tl elem1)
- (List.tl head2) (List.tl elem2)
- )
- )
- (List.find_all (* *)
- (fun elem2 -> (* trova tutti gli elementi della lista tail2 *)
- ((List.hd elem1) = (List.hd elem2)) && (* che stanno in tail1 *)
- not ((xres_join_context (List.tl head1) (List.tl elem1)
- (List.tl head2) (List.tl elem2)) = [])
- (* e per i quali la xres_join_context non sia vuota *)
- )
- tail2 (* List.find_all *)
- )
- )
- []
- tail1 (* per ogni elemento di tail1 applica la List.fold_left *)
- *)
- ) (* match *)
- )
- | _ -> []
- in
- (*let _ = print_endline (string_of_float (Unix.time () -. t)); flush stdout in*)
- result*)
- let before = Sys.time () in
- let res = intersect_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
- ("INTERSECT(" ^ ll1 ^ "," ^ ll2 ^ ") = " ^ string_of_int (List.length res) ^
- ": " ^ diff ^ "s") ;
- flush stdout ;
- res
-;;
-
-*)
intersect_ex (execute_ex env l1) (execute_ex env l2)
| MQListRVar rvar -> [List.assoc rvar env]
| MQLetIn (lvar, l1, l2) ->
- let t = Unix.time () in
+ let t = Sys.time () in
let res =
(*CSC: The interesting code *)
let _ = letin_ex lvar (execute_ex env l1) in
in
letdispose ();
print_string ("LETIN = " ^ string_of_int (List.length res) ^ ": ") ;
- print_endline (string_of_float (Unix.time () -. t) ^ "s") ;
+ print_endline (string_of_float (Sys.time () -. t) ^ "s") ;
flush stdout ;
res
| MQListLVar lvar ->
* sono associati anche i valori delle variabili che ancora non sono state valutate
* perche', ad esempio, si trovano in altri rami dell'albero.
*
- * Esempio:
+* Esempio:
* SELECT x IN USE PATTERN "cic:/**.con" POSITION $a WHERE $a IS MainConclusion
* L'albero corrispondente a questa query e':
*
*****************************************************************************)
-let init () = Dbconn.init ()
+let init connection_param = Dbconn.init connection_param
(*
let c = pgc () in
let res =
| 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.LetVVar (vvar, vexp, sexp) ->
+ let before = Sys.time () in
+ let c1 = upd_vvars c ((vvar, exec_val_exp c vexp) :: c.vvars) in
+ let res = exec_set_exp c1 sexp in
+ print_string ("LETIN " ^ vvar ^ " = " ^ string_of_int (List.length res) ^ ": ") ;
+ 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 =
and execute x =
exec_set_exp {svars = []; rvars = []; groups = []; vvars = []} x
-
-
-
-
-(*
- * chiusura della connessione al database
- *)
- let close () = Dbconn.close ();;
-
* http://cs.unibo.it/helm/.
*)
-val init : unit -> unit (* open database *)
+val init : string -> unit (* open database *)
val execute : MathQL.query -> MathQL.result (* execute query *)
let pattern_ex (apreamble, apattern, afragid) =
let c = pgc () in
(*let _ = print_string ("USE ")
- and t = Unix.time () in*)
+ and t = Sys.time () in*)
(*let r1 = helm_class_id "MathResource" in*)
(*let qq = "select att0 from t" ^ r1 ^ " where att0 " ^ (pattern_match apreamble apattern afragid) ^ " order by t" ^ r1 ^ ".att0 asc" in*)
(*PRE-CLAUDIO
c#exec (qq)
in
(* PRE-CLAUDIO
- (*let _ = print_endline (string_of_float (Unix.time () -. t)); flush stdout in*)
+ (*let _ = print_endline (string_of_float (Sys.time () -. t)); flush stdout in*)
result*)
List.map
(function uri -> {uri = uri ; attributes = [] ; extra = ""})
in
(*let (uril,atts) = List.split rset in*)
let _ = print_string ("RELATION "^usek)
-and t = Unix.time () in
+and t = Sys.time () in
let result =
let c = pgc () in
in
print_string (" = " ^ string_of_int (List.length result) ^ ": ") ;
-print_endline (string_of_float (Unix.time () -. t) ^ "s") ;
+print_endline (string_of_float (Sys.time () -. t) ^ "s") ;
flush stdout ;
result
;;
*)
let select_ex env avar alist abool =
let _ = print_string ("SELECT = ")
- and t = Unix.time () in
+ and t = Sys.time () in
let result =
List.filter (function entry -> is_good ((avar,entry)::env) abool) alist
in
print_string (string_of_int (List.length result) ^ ": ") ;
- print_endline (string_of_float (Unix.time () -. t) ^ "s") ;
+ print_endline (string_of_float (Sys.time () -. t) ^ "s") ;
flush stdout ;
result
;; *)
* implementazione del comando SORTEDBY
*)
let sortedby_ex alist order afunc =
- let before = Unix.time () in
+ let before = Sys.time () in
let res =
let module S = Mathql_semantics in
(Sort.list
)
)
in
- let after = Unix.time ()
+ let after = Sys.time ()
and ll1 = string_of_int (List.length alist) in
let diff = string_of_float (after -. before) in
print_endline
;;
let union_ex l1 l2 =
- let before = Unix.time () in
+ let before = Sys.time () in
let res = union_ex l1 l2 in
- let after = Unix.time () 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
let usek = get_prop_id (List.hd path) in
let _ = print_string ("RELATION "^usek)
-and t = Unix.time () in
+and t = Sys.time () in
let result =
let c = pgc () in
Sort.list
)
in
print_string (" = " ^ string_of_int (List.length result) ^ ": ") ;
-print_endline (string_of_float (Unix.time () -. t) ^ "s") ;
+print_endline (string_of_float (Sys.time () -. t) ^ "s") ;
flush stdout ;
result
;;
projects / helm.git / commitdiff