From 9cbce40d56958c466459b028cf250441ec29c9fe Mon Sep 17 00:00:00 2001 From: Ferruccio Guidi Date: Fri, 10 Oct 2003 14:40:12 +0000 Subject: [PATCH] patched and improved --- helm/ocaml/mathql_interpreter/.depend | 9 +- helm/ocaml/mathql_interpreter/mQILib.ml | 326 ++++++++++-------- helm/ocaml/mathql_interpreter/mQILib.mli | 18 +- helm/ocaml/mathql_interpreter/mQIUtil.ml | 2 + helm/ocaml/mathql_interpreter/mQIUtil.mli | 6 +- helm/ocaml/mathql_interpreter/mQueryIO.ml | 47 +-- helm/ocaml/mathql_interpreter/mQueryIO.mli | 6 +- .../mathql_interpreter/mQueryInterpreter.ml | 10 +- .../ocaml/mathql_interpreter/mQueryTLexer.mll | 15 +- .../mathql_interpreter/mQueryTParser.mly | 16 +- 10 files changed, 267 insertions(+), 188 deletions(-) diff --git a/helm/ocaml/mathql_interpreter/.depend b/helm/ocaml/mathql_interpreter/.depend index fa6401505..3d89ece9a 100644 --- a/helm/ocaml/mathql_interpreter/.depend +++ b/helm/ocaml/mathql_interpreter/.depend @@ -1,6 +1,7 @@ mQIConn.cmi: mQIMap.cmi mQILib.cmi: mQIConn.cmi mQIProperty.cmi: mQIConn.cmi +mQueryIO.cmi: mQILib.cmi mQueryInterpreter.cmi: mQIConn.cmi mQIPostgres.cmo: mQIPostgres.cmi mQIPostgres.cmx: mQIPostgres.cmi @@ -16,11 +17,11 @@ mQIProperty.cmo: mQIConn.cmi mQIMap.cmi mQIPostgres.cmi mQIUtil.cmi \ mQIProperty.cmi mQIProperty.cmx: mQIConn.cmx mQIMap.cmx mQIPostgres.cmx mQIUtil.cmx \ mQIProperty.cmi -mQueryTParser.cmo: mQILib.cmi -mQueryTParser.cmx: mQILib.cmx -mQueryTLexer.cmo: mQueryTParser.cmo +mQueryTParser.cmo: mQILib.cmi mQueryTParser.cmi +mQueryTParser.cmx: mQILib.cmx mQueryTParser.cmi +mQueryTLexer.cmo: mQueryTParser.cmi mQueryTLexer.cmx: mQueryTParser.cmx -mQueryIO.cmo: mQILib.cmi mQueryTLexer.cmo mQueryTParser.cmo mQueryIO.cmi +mQueryIO.cmo: mQILib.cmi mQueryTLexer.cmo mQueryTParser.cmi mQueryIO.cmi mQueryIO.cmx: mQILib.cmx mQueryTLexer.cmx mQueryTParser.cmx mQueryIO.cmi mQueryInterpreter.cmo: mQIConn.cmi mQILib.cmi mQIProperty.cmi mQIUtil.cmi \ mQueryIO.cmi mQueryInterpreter.cmi diff --git a/helm/ocaml/mathql_interpreter/mQILib.ml b/helm/ocaml/mathql_interpreter/mQILib.ml index f816590d1..b1582f9bc 100644 --- a/helm/ocaml/mathql_interpreter/mQILib.ml +++ b/helm/ocaml/mathql_interpreter/mQILib.ml @@ -28,8 +28,8 @@ module M = MathQL module P = MQueryUtil +module C = MQIConn module U = MQIUtil -module C = MQIConn (* external function specification ******************************************) @@ -37,21 +37,21 @@ type arity_t = Const of int | Positive | Any -type eval_spec = {eval : M.query -> M.result; - handle : C.handle +type eval_spec = {eval : M.query -> M.result; + conn : C.handle } -type txt_out_spec = {out : string -> unit; - path : M.path -> unit; - query : M.query -> unit; - result : M.result -> unit - } +type text_out_spec = {out : string -> unit; + path : M.path -> unit; + query : M.query -> unit; + result : M.result -> unit + } type fun_spec = {arity_p : arity_t; arity_s : arity_t; - body : eval_spec -> txt_out_spec -> + body : eval_spec -> text_out_spec -> M.path list -> M.query list -> M.result; - txt_out : txt_out_spec -> + txt_out : text_out_spec -> M.path list -> M.query list -> unit } @@ -69,32 +69,33 @@ let int_of_set s = | _ -> raise (Failure "int_of_string") with Failure "int_of_string" -> raise (NumberError s) -let out_txt2 out commit n x1 x2 = - out "(" ; commit x1; out (" " ^ n ^ " "); commit x2; out ")" +let out_txt2 o n x1 x2 = + o.out "(" ; o.query x1; o.out (" " ^ n ^ " "); o.query x2; o.out ")" -let out_txt_ out path commit p xl = - path p; out " {"; P.flat_list out commit ", " xl; out "}" +let out_txt_ o p xl = + if p <> [] then begin o.path p; o.out " " end; + o.out "{"; P.flat_list o.out o.query ", " xl; o.out "}" -let out_txt_full out path commit p pl xl = - path p; out " {"; P.flat_list out path ", " pl; out "} {"; - P.flat_list out commit ", " xl; out "}" +let out_txt_full o p pl xl = + o.path p; o.out " {"; P.flat_list o.out o.path ", " pl; o.out "} {"; + P.flat_list o.out o.query ", " xl; o.out "}" let arity0 n r = let arity_p = Const 0 in let arity_s = Const 0 in let body _ _ _ _ = U.mql_true in - let txt_out s _ _ = s.out n in + let txt_out o _ _ = o.out n in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} let arity1 n f = let arity_p = Const 0 in let arity_s = Const 1 in - let body eval _ _ = function - | [x] -> f (eval x) + let body e _ _ = function + | [x] -> f (e.eval x) | _ -> assert false in - let txt_out out _ commit _ = function - | [x] -> out (n ^ " "); commit x + let txt_out o _ = function + | [x] -> o.out (n ^ " "); o.query x | _ -> assert false in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} @@ -102,27 +103,29 @@ let arity1 n f = let arity2 n f = let arity_p = Const 0 in let arity_s = Const 2 in - let body eval _ _ = function - | [x1; x2] -> f (eval x1) (eval x2) + let body e _ _ = function + | [x1; x2] -> f (e.eval x1) (e.eval x2) | _ -> assert false in - let txt_out out _ commit _ = function - | [x1; x2] -> out_txt2 out commit n x1 x2 + let txt_out o _ = function + | [x1; x2] -> out_txt2 o n x1 x2 | _ -> assert false in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} -let false_fun = arity0 "false" U.mql_false +let false_fun b = + let s = if b then "false" else "empty" in + arity0 s U.mql_false let true_fun = arity0 "true" U.mql_true let not_fun = let aux r = if r = U.mql_false then U.mql_true else U.mql_false in - arity1 "not" aux + arity1 "!" aux let count_fun = let aux r = [string_of_int (List.length r), []] in - arity1 "count" aux + arity1 "#" aux let diff_fun = arity2 "diff" U.mql_diff @@ -132,34 +135,63 @@ let sub_fun = arity2 "sub" U.set_sub let meet_fun = arity2 "meet" U.set_meet -let eq_fun = arity2 "eq" U.set_eq +let eq_fun = arity2 "==" U.set_eq let le_fun = let le v1 v2 = if int_of_set v1 <= int_of_set v2 then U.mql_true else U.mql_false in - arity2 "le" le + arity2 "<=" le let lt_fun = let lt v1 v2 = if int_of_set v1 < int_of_set v2 then U.mql_true else U.mql_false in - arity2 "lt" lt + arity2 "<" lt let stat_fun = let arity_p = Const 0 in let arity_s = Const 1 in - let body eval h _ = function + let body e o _ = function | [x] -> let t = P.start_time () in - let r = (eval x) in + let r = (e.eval x) in let s = P.stop_time t in - C.log h (Printf.sprintf "Stat: %s,%i\n" s (List.length r)); + o.out (Printf.sprintf "Stat: %s,%i\n" s (List.length r)); r | _ -> assert false in - let txt_out out _ commit _ = function - | [x] -> out "stat "; commit x + let txt_out o _ = function + | [x] -> o.out "stat "; o.query x + | _ -> assert false + in + {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} + +let log_fun xml src = + let log_src e o x = + let t = P.start_time () in o.query x; + let s = P.stop_time t in + if C.set e.conn C.Stat then o.out (Printf.sprintf "Log source: %s\n" s); + e.eval x + in + let log_res e o x = + let s = e.eval x in + let t = P.start_time () in o.result s; + let r = P.stop_time t in + if C.set e.conn C.Stat then o.out (Printf.sprintf "Log: %s\n" r); s + in + let txt_log o = + if xml then o.out "xml "; + if src then o.out "source " + in + let arity_p = Const 0 in + let arity_s = Const 1 in + let body e o _ = function + | [x] -> if src then log_src e o x else log_res e o x + | _ -> assert false + in + let txt_out o _ = function + | [x] -> o.out "log "; txt_log o; o.query x | _ -> assert false in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} @@ -171,14 +203,14 @@ let align_fun = in let arity_p = Const 0 in let arity_s = Const 2 in - let body eval _ _ = function + let body e _ _ = function | [y; x] -> - let l = int_of_set (eval y) in - U.mql_iter (aux l) (eval x) + let l = int_of_set (e.eval y) in + U.mql_iter (aux l) (e.eval x) | _ -> assert false in - let txt_out out _ commit _ = function - | [y; x] -> out "align "; commit y; out " in "; commit x + let txt_out o _ = function + | [y; x] -> o.out "align "; o.query y; o.out " in "; o.query x | _ -> assert false in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} @@ -186,14 +218,15 @@ let align_fun = let if_fun = let arity_p = Const 0 in let arity_s = Const 3 in - let body eval _ _ = function + let body e _ _ = function | [y; x1; x2] -> - if (eval y) = U.mql_false then (eval x2) else (eval x1) + if (e.eval y) = U.mql_false then (e.eval x2) else (e.eval x1) | _ -> assert false in - let txt_out out _ commit _ = function + let txt_out o _ = function | [y; x1; x2] -> - out "if "; commit y; out " then "; commit x1; out " else "; commit x2 + o.out "if "; o.query y; o.out " then "; o.query x1; + o.out " else "; o.query x2 | _ -> assert false in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} @@ -206,21 +239,19 @@ let intersect_fun = in let arity_p = Const 0 in let arity_s = Positive in - let body eval _ _ xl = iter eval xl in - let txt_out out path commit _ = function + let body e _ _ xl = iter e.eval xl in + let txt_out o _ = function | [] -> assert false - | [x1; x2] -> out_txt2 out commit "intersect" x1 x2 - | xl -> out_txt_ out path commit ["intersect"] xl + | [x1; x2] -> out_txt2 o "/\\" x1 x2 + | xl -> out_txt_ o ["intersect"] xl in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} let union_fun = let arity_p = Const 0 in let arity_s = Any in - let body eval _ _ xl = U.mql_iter eval xl in - let txt_out out path commit _ = function - | [x1; x2] -> out_txt2 out commit "union" x1 x2 - | xl -> out_txt_ out path commit ["union"] xl + let body e _ _ xl = U.mql_iter e.eval xl in + let txt_out o _ xl = out_txt_ o [] xl in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} @@ -233,10 +264,10 @@ let or_fun = in let arity_p = Const 0 in let arity_s = Any in - let body eval _ _ xl = iter eval xl in - let txt_out out path commit _ = function - | [x1; x2] -> out_txt2 out commit "or" x1 x2 - | xl -> out_txt_ out path commit ["or"] xl + let body e _ _ xl = iter e.eval xl in + let txt_out o _ = function + | [x1; x2] -> out_txt2 o "||" x1 x2 + | xl -> out_txt_ o ["or"] xl in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} @@ -244,39 +275,108 @@ let and_fun = let rec iter f = function | [] -> U.mql_true | head :: tail -> - if f head = U.mql_false then U.mql_false else (iter f tail) + if f head = U.mql_false then U.mql_false else iter f tail + in + let arity_p = Const 0 in + let arity_s = Any in + let body e _ _ xl = iter e.eval xl in + let txt_out o _ = function + | [x1; x2] -> out_txt2 o "&&" x1 x2 + | xl -> out_txt_ o ["and"] xl + in + {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} + +let seq_fun = + let rec iter f = function + | [] -> U.mql_true + | head :: tail -> ignore (f head); iter f tail in let arity_p = Const 0 in let arity_s = Any in - let body eval _ _ xl = iter eval xl in - let txt_out out path commit _ = function - | [x1; x2] -> out_txt2 out commit "and" x1 x2 - | xl -> out_txt_ out path commit ["and"] xl + let body e _ _ xl = iter e.eval xl in + let txt_out o _ = function + | [x1; x2] -> o.query x1; o.out " ;; "; o.query x2 + | xl -> out_txt_ o ["seq"] xl + in + {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} + +let proj_fun = + let proj_group_aux p (q, v) = if q = p then U.mql_subj v else [] in + let proj_group p a = U.mql_iter (proj_group_aux p) a in + let proj_set p (_, g) = U.mql_iter (proj_group p) g in + let arity_p = Const 1 in + let arity_s = Const 1 in + let body e _ pl xl = + match pl, xl with + | [p], [x] -> U.mql_iter (proj_set p) (e.eval x) + | _ -> assert false + in + let txt_out o pl xl = + match pl, xl with + | [p], [x] -> o.out "proj "; o.path p; o.out " of "; o.query x + | _ -> assert false + in + {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} + +let keep_fun b = + let proj (r, _) = (r, []) in + let keep_path l (p, v) t = if List.mem p l = b then t else (p, v) :: t in + let keep_grp l a = List.fold_right (keep_path l) a [] in + let keep_set l a g = + let kg = keep_grp l a in + if kg = [] then g else kg :: g + in + let keep_av l (s, g) = (s, List.fold_right (keep_set l) g []) in + let txt_allbut o = if b then o.out "allbut " in + let txt_path_list o l = P.flat_list o.out o.path ", " l in + let arity_p = Any in + let arity_s = Const 1 in + let body e _ pl xl = + match b, pl, xl with + | true, [], [x] -> e.eval x + | false, [], [x] -> List.map proj (e.eval x) + | _, l, [x] -> List.map (keep_av l) (e.eval x) + | _ -> assert false + in + let txt_out o pl xl = + match pl, xl with + | [], [x] -> o.out "keep "; txt_allbut o; o.query x + | l, [x] -> + o.out "keep "; txt_allbut o; txt_path_list o l; + o.out " in "; o.query x + | _ -> assert false in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} (* external functions interface *********************************************) let get_spec = function - | ["false"] -> false_fun - | ["true"] -> true_fun - | ["not"] -> not_fun - | ["count"] -> count_fun - | ["stat"] -> stat_fun - | ["diff"] -> diff_fun - | ["xor"] -> xor_fun - | ["sub"] -> sub_fun - | ["meet"] -> meet_fun - | ["eq"] -> eq_fun - | ["le"] -> le_fun - | ["lt"] -> lt_fun - | ["align"] -> align_fun - | ["if"] -> if_fun - | ["intersect"] -> intersect_fun - | ["union"] -> union_fun - | ["or"] -> or_fun - | ["and"] -> and_fun - | p -> raise (NameError p) + | ["empty"] -> false_fun false + | ["false"] -> false_fun true + | ["true"] -> true_fun + | ["not"] -> not_fun + | ["count"] -> count_fun + | ["stat"] -> stat_fun + | ["log"; "text"; "result"] -> log_fun false false + | ["log"; "text"; "source"] -> log_fun false true + | ["diff"] -> diff_fun + | ["xor"] -> xor_fun + | ["sub"] -> sub_fun + | ["meet"] -> meet_fun + | ["eq"] -> eq_fun + | ["le"] -> le_fun + | ["lt"] -> lt_fun + | ["align"] -> align_fun + | ["if"] -> if_fun + | ["intersect"] -> intersect_fun + | ["union"] -> union_fun + | ["or"] -> or_fun + | ["and"] -> and_fun + | ["seq"] -> seq_fun + | ["proj"] -> proj_fun + | ["keep"; "these"] -> keep_fun false + | ["keep"; "allbut"] -> keep_fun true + | p -> raise (NameError p) let check_arity p m n = let aux i = function @@ -287,60 +387,8 @@ let check_arity p m n = in aux m (get_spec p).arity_p; aux n (get_spec p).arity_s -let exec eval h p pl xl = (get_spec p).body eval h pl xl - -let txt_out out path commit p pl xl = - try (get_spec p).txt_out out path commit pl xl - with NameError q when q = p -> out_txt_full out path commit p pl xl - -(* - | M.Proj (Some p) x -> out "proj "; txt_path out p; out "of "; txt_set x - | M.Log a b x -> out "log "; txt_log a b; txt_set x - | M.Keep b l x -> out "keep "; txt_allbut b; txt_path_list l; - txt_set x - let txt_path_list l = P.flat_list out (txt_path out) ", " l in - let txt_log a b = - if a then out "xml "; - if b then out "source " - in - let txt_allbut b = if b then out "allbut " in - - | M.Proj None x -> List.map (fun (r, _) -> (r, [])) (eval_query c x) - | M.Proj (Some p) x -> - let proj_group_aux (q, v) = if q = p then subj v else [] in - let proj_group a = U.mql_iter proj_group_aux a in - let proj_set (_, g) = U.mql_iter proj_group g in - U.mql_iter proj_set (eval_query c x) - - - | M.Log _ b x -> - if b then begin - let t = P.start_time () in - F.text_of_query (C.log h) x "\n"; - let s = P.stop_time t in - if C.set h C.Stat then - C.log h (Printf.sprintf "Log source: %s\n" s); - eval_query c x - end else begin - let s = (eval_query c x) in - let t = P.start_time () in - F.text_of_result (C.log h) s "\n"; - let r = P.stop_time t in - if C.set h C.Stat then - C.log h (Printf.sprintf "Log: %s\n" r); - s - end - - | M.Keep b l x -> - let keep_path (p, v) t = - if List.mem p l = b then t else (p, v) :: t in - let keep_grp a = List.fold_right keep_path a [] in - let keep_set a g = - let kg = keep_grp a in - if kg = [] then g else kg :: g - in - let keep_av (s, g) = (s, List.fold_right keep_set g []) in - List.map keep_av (eval_query c x) - - -*) +let eval e o p pl xl = (get_spec p).body e o pl xl + +let txt_out o p pl xl = + try (get_spec p).txt_out o pl xl + with NameError q when q = p -> out_txt_full o p pl xl diff --git a/helm/ocaml/mathql_interpreter/mQILib.mli b/helm/ocaml/mathql_interpreter/mQILib.mli index 69bd3c04e..e37fa3b2d 100644 --- a/helm/ocaml/mathql_interpreter/mQILib.mli +++ b/helm/ocaml/mathql_interpreter/mQILib.mli @@ -30,23 +30,23 @@ type arity_t = Const of int | Positive | Any -type eval_spec = {eval : MathQL.query -> MathQL.result; - handle : MQIConn.handle +type eval_spec = {eval : MathQL.query -> MathQL.result; + conn : MQIConn.handle } -type txt_out_spec = {out : string -> unit; - path : MathQL.path -> unit; - query : MathQL.query -> unit; - result : MathQL.result -> unit - } +type text_out_spec = {out : string -> unit; + path : MathQL.path -> unit; + query : MathQL.query -> unit; + result : MathQL.result -> unit + } val check_arity : MathQL.path -> int -> int -> unit -val eval : eval_spec -> txt_out_spec -> +val eval : eval_spec -> text_out_spec -> MathQL.path -> MathQL.path list -> MathQL.query list -> MathQL.result -val txt_out : txt_out_spec -> +val txt_out : text_out_spec -> MathQL.path -> MathQL.path list -> MathQL.query list -> unit exception ArityError of MathQL.path * arity_t * int diff --git a/helm/ocaml/mathql_interpreter/mQIUtil.ml b/helm/ocaml/mathql_interpreter/mQIUtil.ml index f80fefeec..67df606d1 100644 --- a/helm/ocaml/mathql_interpreter/mQIUtil.ml +++ b/helm/ocaml/mathql_interpreter/mQIUtil.ml @@ -78,6 +78,8 @@ let rec iter f = function (* MathQL specific set operations ******************************************) +let mql_subj v = List.map (fun s -> (s, [])) v + let rec mql_union s1 s2 = match s1, s2 with | [], s -> s diff --git a/helm/ocaml/mathql_interpreter/mQIUtil.mli b/helm/ocaml/mathql_interpreter/mQIUtil.mli index 32e0d78dc..cd7adc760 100644 --- a/helm/ocaml/mathql_interpreter/mQIUtil.mli +++ b/helm/ocaml/mathql_interpreter/mQIUtil.mli @@ -37,9 +37,9 @@ val set_meet : MathQL.result -> MathQL.result -> MathQL.result val set_eq : MathQL.result -> MathQL.result -> MathQL.result val set_union : 'a list -> 'a list -> 'a list -(* -val set_intersect : 'a list -> 'a list -> 'a list -*) + +val mql_subj : MathQL.value -> MathQL.result + val mql_union : ('a * 'b list) list -> ('a * 'b list) list -> ('a * 'b list) list diff --git a/helm/ocaml/mathql_interpreter/mQueryIO.ml b/helm/ocaml/mathql_interpreter/mQueryIO.ml index d59b2f2b7..a7d30dd09 100644 --- a/helm/ocaml/mathql_interpreter/mQueryIO.ml +++ b/helm/ocaml/mathql_interpreter/mQueryIO.ml @@ -36,7 +36,7 @@ let txt_str out s = out ("\"" ^ s ^ "\"") let txt_path out p = out "/"; P.flat_list out (txt_str out) "/" p -let text_of_result out x sep = +let text_of_result out sep x = let txt_attr = function | (p, []) -> txt_path out p | (p, l) -> txt_path out p; out " = "; @@ -51,8 +51,8 @@ let text_of_result out x sep = let txt_set l = P.flat_list out txt_res ("; " ^ sep) l; out sep in txt_set x -let text_of_query out x sep = - let txt_svar sv = out ("%" ^ sv) in +let text_of_query out sep x = + let txt_svar sv = out ("$" ^ sv) in let txt_avar av = out ("@" ^ av) in let txt_inv i = if i then out "inverse " in let txt_ref = function @@ -96,30 +96,37 @@ let text_of_query out x sep = | M.From av -> txt_avar av and txt_set = function | M.Fun p pl xl -> - L.txt_out out (txt_path out) txt_set p pl xl - | M.Const [s, []] -> txt_str out s - | M.Const r -> text_of_result out r " " - | M.Dot av p -> txt_avar av; out "."; txt_path out p - | M.Ex b x -> out "ex "; txt_set x -(* | M.Ex b x -> out "ex ["; P.flat_list out txt_avar "," b; - out "] "; txt_set x -*) | M.SVar sv -> txt_svar sv - | M.AVar av -> txt_avar av + let o = {L.out = out; L.path = txt_path out; L.query = txt_set; + L.result = text_of_result out sep} + in + L.txt_out o p pl xl + | M.Const [s, []] -> txt_str out s + | M.Const r -> text_of_result out " " r + | M.Dot av p -> txt_avar av; out "."; txt_path out p + | M.Ex b x -> out "ex "; txt_set x +(* | M.Ex b x -> out "ex ["; P.flat_list out txt_avar "," b; + out "] "; txt_set x +*) | M.SVar sv -> txt_svar sv + | M.AVar av -> txt_avar av | M.Property q0 q1 q2 mc ct cfl xl b x -> out "property "; txt_qualif q0 q1 q2; main mc; txt_istrue ct; P.flat_list out txt_isfalse "" cfl; txt_exp_list xl; out " of "; pattern b; txt_set x - | M.Let sv x y -> out "let "; txt_svar sv; out " be "; - txt_set x; out " in "; txt_set y - | M.Select av x y -> out "select "; txt_avar av; out " from "; - txt_set x; out " where "; txt_set y - | M.For k av x y -> out "for "; txt_avar av; out " in "; - txt_set x; txt_gen k; txt_set y - | M.Add d g x -> out "add "; txt_distr d; txt_grp g; - out " in "; txt_set x + | M.Let sv x y -> out "let "; txt_svar sv; out " = "; + txt_set x; out " in "; txt_set y + | M.Select av x y -> out "select "; txt_avar av; out " from "; + txt_set x; out " where "; txt_set y + | M.For k av x y -> out "for "; txt_avar av; out " in "; + txt_set x; txt_gen k; txt_set y + | M.Add d g x -> out "add "; txt_distr d; txt_grp g; + out " in "; txt_set x in txt_set x; out sep +let text_out_spec out sep = + {L.out = out; L.path = txt_path out; L.query = text_of_query out sep; + L.result = text_of_result out sep} + let query_of_text lexbuf = MQueryTParser.query MQueryTLexer.query_token lexbuf diff --git a/helm/ocaml/mathql_interpreter/mQueryIO.mli b/helm/ocaml/mathql_interpreter/mQueryIO.mli index d74bdd280..12a4de2a5 100644 --- a/helm/ocaml/mathql_interpreter/mQueryIO.mli +++ b/helm/ocaml/mathql_interpreter/mQueryIO.mli @@ -26,10 +26,12 @@ (* AUTOR: Ferruccio Guidi *) -val text_of_query : (string -> unit) -> MathQL.query -> string -> unit +val text_of_query : (string -> unit) -> string -> MathQL.query -> unit -val text_of_result : (string -> unit) -> MathQL.result -> string -> unit +val text_of_result : (string -> unit) -> string -> MathQL.result -> unit val query_of_text : Lexing.lexbuf -> MathQL.query val result_of_text : Lexing.lexbuf -> MathQL.result + +val text_out_spec : (string -> unit) -> string -> MQILib.text_out_spec diff --git a/helm/ocaml/mathql_interpreter/mQueryInterpreter.ml b/helm/ocaml/mathql_interpreter/mQueryInterpreter.ml index 7c7ef8a56..511e01c70 100644 --- a/helm/ocaml/mathql_interpreter/mQueryInterpreter.ml +++ b/helm/ocaml/mathql_interpreter/mQueryInterpreter.ml @@ -55,15 +55,14 @@ let execute h x = if C.set h C.Warn then begin C.log h "MQIExecute: waring: reference to undefined variables: "; - F.text_of_query (C.log h) q "\n" + F.text_of_query (C.log h) "\n" q end in - let subj v = List.map (fun s -> (s, [])) v in let proj v = List.map fst v in let rec eval_query c = function | M.Const r -> r | M.Dot i p -> begin - try subj (List.assoc p (List.assoc i c.groups)) + try U.mql_subj (List.assoc p (List.assoc i c.groups)) with Not_found -> warn (M.Dot i p); [] end | M.Ex l y -> let rec ex_aux h = function @@ -133,7 +132,10 @@ let execute h x = then select_aux t else h :: select_aux t in select_aux (eval_query c x) - | M.Fun p pl xl -> L.exec (eval_query c) h p pl xl + | M.Fun p pl xl -> + let e = {L.eval = eval_query c; L.conn = h} in + L.eval e (F.text_out_spec (C.log h) "\n") + p pl xl and eval_grp c = function | M.Attr gs -> let attr_aux g (p, y) = U.mql_union g [p, proj (eval_query c y)] in diff --git a/helm/ocaml/mathql_interpreter/mQueryTLexer.mll b/helm/ocaml/mathql_interpreter/mQueryTLexer.mll index 6969fcb3e..4be6ba298 100644 --- a/helm/ocaml/mathql_interpreter/mQueryTLexer.mll +++ b/helm/ocaml/mathql_interpreter/mQueryTLexer.mll @@ -62,11 +62,12 @@ and query_token = parse | '{' { out "LC"; LC } | '}' { out "RC"; RC } | '@' { out "AT"; AT } - | '%' { out "PC"; PC } + | '$' { out "DL"; DL } | '.' { out "FS"; FS } | ',' { out "CM"; CM } | ';' { out "SC"; SC } | '/' { out "SL"; SL } + | ';' { out "SC"; SC } | "add" { out "ADD" ; ADD } | "align" { out "ALIGN" ; ALIGN } | "allbut" { out "BUT" ; BUT } @@ -106,6 +107,7 @@ and query_token = parse | "proj" { out "PROJ" ; PROJ } | "property" { out "PROP" ; PROP } | "select" { out "SELECT"; SELECT } + | "seq" { out "SEQ" ; SEQ } | "source" { out "SOURCE"; SOURCE } | "stat" { out "STAT" ; STAT } | "sub" { out "SUB" ; SUB } @@ -119,6 +121,17 @@ and query_token = parse | IDEN { let id = Lexing.lexeme lexbuf in out ("ID " ^ id); ID id } | eof { out "EOF" ; EOF } + | "=" { out "BE" ; BE } + | "#" { out "COUNT" ; COUNT } + | "!" { out "NOT" ; NOT } + | "<" { out "LT" ; LT } + | "<=" { out "LE" ; LE } + | "==" { out "EQ" ; EQ } + | "&&" { out "AND" ; AND } + | "||" { out "OR" ; OR } + | "\\/" { out "UNION" ; UNION } + | "/\\" { out "INTER" ; INTER } + | ";;" { out "SEQ" ; SEQ } and result_token = parse | SPC { result_token lexbuf } | "(*" { comm_token lexbuf; result_token lexbuf } diff --git a/helm/ocaml/mathql_interpreter/mQueryTParser.mly b/helm/ocaml/mathql_interpreter/mQueryTParser.mly index 1025cf316..da7061065 100644 --- a/helm/ocaml/mathql_interpreter/mQueryTParser.mly +++ b/helm/ocaml/mathql_interpreter/mQueryTParser.mly @@ -73,12 +73,14 @@ let t (x, y, z) = z %} %token ID STR - %token LB RB SL IS LC RC CM SC LP RP AT PC FS DQ EOF + %token LB RB SL IS LC RC CM SC LP RP AT DL FS DQ EOF %token ADD ALIGN AND AS ATTR BE BUT COUNT DIFF DISTR ELSE EMPTY EQ EX %token FALSE FOR FROM IF IN INF INTER INV ISF IST KEEP LE LET LOG LT - %token MAIN MATCH MEET NOT OF OR PAT PROJ PROP SELECT SOURCE STAT SUB - %token SUP SUPER THEN TRUE UNION WHERE XOR - %nonassoc IN SUP INF ELSE LOG STAT KEEP + %token MAIN MATCH MEET NOT OF OR PAT PROJ PROP SELECT SEQ SOURCE STAT + %token SUB SUP SUPER THEN TRUE UNION WHERE XOR + %nonassoc SOURCE + %right IN SEQ + %nonassoc SUP INF ELSE LOG STAT KEEP %left DIFF %left UNION %left INTER @@ -99,7 +101,7 @@ | STR qstr { $1 ^ $2 } ; svar: - | PC ID { $2 } + | DL ID { $2 } ; avar: | AT ID { $2 } @@ -231,7 +233,7 @@ | ALIGN set_exp IN set_exp { make_fun ["align"] [] [$2; $4] } | EMPTY - { make_fun ["false"] [] [] } + { make_fun ["empty"] [] [] } | svar { M.SVar $1 } | avar @@ -260,6 +262,8 @@ { make_fun $1 [] $3 } | path LC RC { make_fun $1 [] [] } + | set_exp SEQ set_exp + { make_fun ["seq"] [] [$1; $3] } | set_exp DIFF set_exp { make_fun ["diff"] [] [$1; $3] } | set_exp UNION set_exp -- 2.39.2