From c172220b965a4d0e95004ae42911a886faac878c Mon Sep 17 00:00:00 2001 From: Ferruccio Guidi Date: Thu, 30 Oct 2003 15:41:03 +0000 Subject: [PATCH] patched and some funtions added --- helm/ocaml/mathql_interpreter/mQILib.ml | 215 +++++++++++++----- helm/ocaml/mathql_interpreter/mQILib.mli | 10 +- helm/ocaml/mathql_interpreter/mQIUtil.ml | 2 +- helm/ocaml/mathql_interpreter/mQueryIO.ml | 31 ++- helm/ocaml/mathql_interpreter/mQueryIO.mli | 2 + .../mathql_interpreter/mQueryInterpreter.ml | 2 +- .../ocaml/mathql_interpreter/mQueryTLexer.mll | 38 ++-- .../mathql_interpreter/mQueryTParser.mly | 50 ++-- 8 files changed, 243 insertions(+), 107 deletions(-) diff --git a/helm/ocaml/mathql_interpreter/mQILib.ml b/helm/ocaml/mathql_interpreter/mQILib.ml index b1582f9bc..7a1e4e53b 100644 --- a/helm/ocaml/mathql_interpreter/mQILib.ml +++ b/helm/ocaml/mathql_interpreter/mQILib.ml @@ -42,16 +42,18 @@ type eval_spec = {eval : M.query -> M.result; } type text_out_spec = {out : string -> unit; - path : M.path -> unit; - query : M.query -> unit; - result : M.result -> unit + path : (string -> unit) -> M.path -> unit; + query : (string -> unit) -> string -> M.query -> unit; + result : (string -> unit) -> string -> M.result -> unit } +type text_in_spec = {result_in : Lexing.lexbuf -> M.result} + type fun_spec = {arity_p : arity_t; arity_s : arity_t; - body : eval_spec -> text_out_spec -> + body : eval_spec -> text_out_spec -> text_in_spec -> M.path list -> M.query list -> M.result; - txt_out : text_out_spec -> + txt_out : text_out_spec -> M.path list -> M.query list -> unit } @@ -61,41 +63,76 @@ exception NameError of M.path exception NumberError of M.result +type std_text_out_spec = {s_out : string -> unit; + s_path : M.path -> unit; + s_query : M.query -> unit; + s_result : M.result -> unit +} + (* external functions implementation ****************************************) -let int_of_set s = - try match s with - | [s, _] -> int_of_string s +let std o = + {s_out = o.out; s_path = o.path o.out; + s_query = o.query o.out ""; s_result = o.result o.out "\n" + } + +type t = End + | Space + | Figure of int + | Error + +let my_int_of_string s = + let l = String.length s in + let get_t i = + if i = l then End else + match s.[i] with + | ' ' | '\t' | '\r' | 'n' -> Space + | '0' .. '9' -> Figure (Char.code s.[i] - Char.code '0') + | _ -> Error + in + let rec aux i xv = match get_t i, xv with + | Error, _ + | End, None -> raise (Failure "int_of_string") + | End, Some v -> v + | Space, xv -> aux (succ i) xv + | Figure f, None -> aux (succ i) (Some f) + | Figure f, Some v -> aux (succ i) (Some (10 * v + f)) + in + aux 0 None + +let int_of_set r = + try match r with + | [s, _] -> my_int_of_string s | _ -> raise (Failure "int_of_string") - with Failure "int_of_string" -> raise (NumberError s) + with Failure "int_of_string" -> raise (NumberError r) let out_txt2 o n x1 x2 = - o.out "(" ; o.query x1; o.out (" " ^ n ^ " "); o.query x2; o.out ")" + o.s_out "(" ; o.s_query x1; o.s_out (" " ^ n ^ " "); o.s_query x2; o.s_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 "}" + if p <> [] then begin o.s_path p; o.s_out " " end; + o.s_out "{"; P.flat_list o.s_out o.s_query ", " xl; o.s_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 "}" + o.s_path p; o.s_out " {"; P.flat_list o.s_out o.s_path ", " pl; o.s_out "} {"; + P.flat_list o.s_out o.s_query ", " xl; o.s_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 o _ _ = o.out n in + let body _ _ _ _ _ = r in + let txt_out o _ _ = (std o).s_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 e _ _ = function + let body e _ _ _ = function | [x] -> f (e.eval x) | _ -> assert false in let txt_out o _ = function - | [x] -> o.out (n ^ " "); o.query x + | [x] -> let o = std o in o.s_out (n ^ " "); o.s_query x | _ -> assert false in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} @@ -103,12 +140,12 @@ let arity1 n f = let arity2 n f = let arity_p = Const 0 in let arity_s = Const 2 in - let body e _ _ = function + let body e _ _ _ = function | [x1; x2] -> f (e.eval x1) (e.eval x2) | _ -> assert false in let txt_out o _ = function - | [x1; x2] -> out_txt2 o n x1 x2 + | [x1; x2] -> let o = std o in out_txt2 o n x1 x2 | _ -> assert false in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} @@ -126,7 +163,11 @@ let not_fun = let count_fun = let aux r = [string_of_int (List.length r), []] in arity1 "#" aux - + +let peek_fun = + let aux = function [] -> [] | hd :: _ -> [hd] in + arity1 "peek" aux + let diff_fun = arity2 "diff" U.mql_diff let xor_fun = arity2 "xor" U.xor @@ -152,7 +193,7 @@ let lt_fun = let stat_fun = let arity_p = Const 0 in let arity_s = Const 1 in - let body e o _ = function + let body e o _ _ = function | [x] -> let t = P.start_time () in let r = (e.eval x) in @@ -162,36 +203,72 @@ let stat_fun = | _ -> assert false in let txt_out o _ = function - | [x] -> o.out "stat "; o.query x + | [x] -> let o = std o in o.s_out "stat "; o.s_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 t = P.start_time () in o.s_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); + if C.set e.conn C.Stat then o.s_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 t = P.start_time () in o.s_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 + if C.set e.conn C.Stat then o.s_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 " + if xml then o.s_out "xml "; + if src then o.s_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 + let body e o _ _ = function + | [x] -> let o = std o in 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 + | [x] -> let o = std o in o.s_out "log "; txt_log o; o.s_query x + | _ -> assert false + in + {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} + +let render_fun = + let arity_p = Const 0 in + let arity_s = Const 1 in + let body e o _ _ = function + | [x] -> + let rs = ref "" in + let out s = rs := ! rs ^ s in + o.result out " " (e.eval x); + [! rs, []] + | _ -> assert false + in + let txt_out o _ = function + | [x] -> let o = std o in o.s_out "render "; o.s_query x + | _ -> assert false + in + {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} + +let read_fun = + let arity_p = Const 0 in + let arity_s = Const 1 in + let body e o i _ = function + | [x] -> + let aux av = + let ich = open_in (fst av) in + let r = i.result_in (Lexing.from_channel ich) in + close_in ich; r + in + U.mql_iter aux (e.eval x) + | _ -> assert false + in + let txt_out o _ = function + | [x] -> let o = std o in o.s_out "read "; o.s_query x | _ -> assert false in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} @@ -203,14 +280,16 @@ let align_fun = in let arity_p = Const 0 in let arity_s = Const 2 in - let body e _ _ = function + let body e _ _ _ = function | [y; x] -> let l = int_of_set (e.eval y) in U.mql_iter (aux l) (e.eval x) | _ -> assert false in let txt_out o _ = function - | [y; x] -> o.out "align "; o.query y; o.out " in "; o.query x + | [y; x] -> + let o = std o in + o.s_out "align "; o.s_query y; o.s_out " in "; o.s_query x | _ -> assert false in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} @@ -218,15 +297,16 @@ let align_fun = let if_fun = let arity_p = Const 0 in let arity_s = Const 3 in - let body e _ _ = function + let body e _ _ _ = function | [y; x1; x2] -> if (e.eval y) = U.mql_false then (e.eval x2) else (e.eval x1) | _ -> assert false in let txt_out o _ = function | [y; x1; x2] -> - o.out "if "; o.query y; o.out " then "; o.query x1; - o.out " else "; o.query x2 + let o = std o in + o.s_out "if "; o.s_query y; o.s_out " then "; o.s_query x1; + o.s_out " else "; o.s_query x2 | _ -> assert false in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} @@ -239,19 +319,19 @@ let intersect_fun = in let arity_p = Const 0 in let arity_s = Positive in - let body e _ _ xl = iter e.eval xl in + let body e _ _ _ xl = iter e.eval xl in let txt_out o _ = function | [] -> assert false - | [x1; x2] -> out_txt2 o "/\\" x1 x2 - | xl -> out_txt_ o ["intersect"] xl + | [x1; x2] -> let o = std o in out_txt2 o "/\\" x1 x2 + | xl -> let o = std o in 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 e _ _ xl = U.mql_iter e.eval xl in - let txt_out o _ xl = out_txt_ o [] xl + let body e _ _ _ xl = U.mql_iter e.eval xl in + let txt_out o _ xl = let o = std o in out_txt_ o [] xl in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} @@ -264,39 +344,42 @@ let or_fun = in let arity_p = Const 0 in let arity_s = Any in - let body e _ _ xl = iter e.eval xl 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 ["or"] xl + | [x1; x2] -> let o = std o in out_txt2 o "||" x1 x2 + | xl -> let o = std o in out_txt_ o ["or"] xl in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} let and_fun = let rec iter f = function | [] -> U.mql_true + | [head] -> f head | head :: 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 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 + | [x1; x2] -> let o = std o in out_txt2 o "&&" x1 x2 + | xl -> let o = std o in 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] -> f head | head :: tail -> ignore (f head); 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 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 + | [x1; x2] -> + let o = std o in o.s_query x1; o.s_out " ;; "; o.s_query x2 + | xl -> let o = std o in out_txt_ o ["seq"] xl in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} @@ -306,14 +389,16 @@ let proj_fun = 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 = + 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 + | [p], [x] -> + let o = std o in + o.s_out "proj "; o.s_path p; o.s_out " of "; o.s_query x | _ -> assert false in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} @@ -327,11 +412,11 @@ let keep_fun b = 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 txt_allbut o = if b then o.s_out "allbut " in + let txt_path_list o l = P.flat_list o.s_out o.s_path ", " l in let arity_p = Any in let arity_s = Const 1 in - let body e _ pl xl = + let body e _ _ pl xl = match b, pl, xl with | true, [], [x] -> e.eval x | false, [], [x] -> List.map proj (e.eval x) @@ -340,10 +425,13 @@ let keep_fun b = in let txt_out o pl xl = match pl, xl with - | [], [x] -> o.out "keep "; txt_allbut o; o.query x + | [], [x] -> + let o = std o in + o.s_out "keep "; txt_allbut o; o.s_query x | l, [x] -> - o.out "keep "; txt_allbut o; txt_path_list o l; - o.out " in "; o.query x + let o = std o in + o.s_out "keep "; txt_allbut o; txt_path_list o l; + o.s_out " in "; o.s_query x | _ -> assert false in {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out} @@ -359,6 +447,9 @@ let get_spec = function | ["stat"] -> stat_fun | ["log"; "text"; "result"] -> log_fun false false | ["log"; "text"; "source"] -> log_fun false true + | ["render"] -> render_fun + | ["read"] -> read_fun + | ["peek"] -> peek_fun | ["diff"] -> diff_fun | ["xor"] -> xor_fun | ["sub"] -> sub_fun @@ -383,12 +474,12 @@ let check_arity p m n = | Const k when i = k -> () | Positive when i > 0 -> () | Any -> () - | a -> raise (ArityError (p, a, i)) + | a -> raise (ArityError (p, a, i)) in aux m (get_spec p).arity_p; aux n (get_spec p).arity_s -let eval e o p pl xl = (get_spec p).body e o pl xl +let eval e o i p pl xl = (get_spec p).body e o i 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 + with NameError q when q = p -> out_txt_full (std o) p pl xl diff --git a/helm/ocaml/mathql_interpreter/mQILib.mli b/helm/ocaml/mathql_interpreter/mQILib.mli index e37fa3b2d..acc465b7a 100644 --- a/helm/ocaml/mathql_interpreter/mQILib.mli +++ b/helm/ocaml/mathql_interpreter/mQILib.mli @@ -35,14 +35,16 @@ type eval_spec = {eval : MathQL.query -> MathQL.result; } type text_out_spec = {out : string -> unit; - path : MathQL.path -> unit; - query : MathQL.query -> unit; - result : MathQL.result -> unit + path : (string -> unit) -> MathQL.path -> unit; + query : (string -> unit) -> string -> MathQL.query -> unit; + result : (string -> unit) -> string -> MathQL.result -> unit } +type text_in_spec = {result_in : Lexing.lexbuf -> MathQL.result} + val check_arity : MathQL.path -> int -> int -> unit -val eval : eval_spec -> text_out_spec -> +val eval : eval_spec -> text_out_spec -> text_in_spec -> MathQL.path -> MathQL.path list -> MathQL.query list -> MathQL.result diff --git a/helm/ocaml/mathql_interpreter/mQIUtil.ml b/helm/ocaml/mathql_interpreter/mQIUtil.ml index 67df606d1..d0e127c64 100644 --- a/helm/ocaml/mathql_interpreter/mQIUtil.ml +++ b/helm/ocaml/mathql_interpreter/mQIUtil.ml @@ -30,7 +30,7 @@ let mql_false = [] -let mql_true = [("", [])] +let mql_true = ["", []] (* set theoretic operations *************************************************) diff --git a/helm/ocaml/mathql_interpreter/mQueryIO.ml b/helm/ocaml/mathql_interpreter/mQueryIO.ml index a7d30dd09..f220a270d 100644 --- a/helm/ocaml/mathql_interpreter/mQueryIO.ml +++ b/helm/ocaml/mathql_interpreter/mQueryIO.ml @@ -32,7 +32,22 @@ module L = MQILib (* text linearization and parsing *******************************************) -let txt_str out s = out ("\"" ^ s ^ "\"") +let txt_quote s = + let rec aux r i l s = + let commit c = + let l = pred (l - i) in + aux (r ^ String.sub s 0 i ^ c) 0 l (String.sub s (succ i) l) + in + if i = l then r ^ s else + match s.[i] with + | '\\' -> commit "\\\\^" + | '^' -> commit "\\^^" + | '\"' -> commit "\\\"^" + | _ -> aux r (succ i) l s + in + aux "" 0 (String.length s) s + +let txt_str out s = out ("\"" ^ txt_quote s ^ "\"") let txt_path out p = out "/"; P.flat_list out (txt_str out) "/" p @@ -51,7 +66,7 @@ let text_of_result out sep x = let txt_set l = P.flat_list out txt_res ("; " ^ sep) l; out sep in txt_set x -let text_of_query out sep x = +let rec 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 @@ -96,8 +111,9 @@ let text_of_query out sep x = | M.From av -> txt_avar av and txt_set = function | M.Fun p pl xl -> - let o = {L.out = out; L.path = txt_path out; L.query = txt_set; - L.result = text_of_result out sep} + let o = {L.out = out; L.path = txt_path; + L.query = text_of_query; L.result = text_of_result + } in L.txt_out o p pl xl | M.Const [s, []] -> txt_str out s @@ -124,11 +140,14 @@ let text_of_query out sep x = 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} + {L.out = out; L.path = txt_path; + L.query = text_of_query; L.result = text_of_result + } let query_of_text lexbuf = MQueryTParser.query MQueryTLexer.query_token lexbuf let result_of_text lexbuf = MQueryTParser.result MQueryTLexer.result_token lexbuf + +let text_in_spec = {L.result_in = result_of_text} diff --git a/helm/ocaml/mathql_interpreter/mQueryIO.mli b/helm/ocaml/mathql_interpreter/mQueryIO.mli index 12a4de2a5..57d7e856f 100644 --- a/helm/ocaml/mathql_interpreter/mQueryIO.mli +++ b/helm/ocaml/mathql_interpreter/mQueryIO.mli @@ -35,3 +35,5 @@ 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 + +val text_in_spec : MQILib.text_in_spec diff --git a/helm/ocaml/mathql_interpreter/mQueryInterpreter.ml b/helm/ocaml/mathql_interpreter/mQueryInterpreter.ml index 511e01c70..a459fe829 100644 --- a/helm/ocaml/mathql_interpreter/mQueryInterpreter.ml +++ b/helm/ocaml/mathql_interpreter/mQueryInterpreter.ml @@ -134,7 +134,7 @@ let execute h x = select_aux (eval_query c x) | 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") + L.eval e (F.text_out_spec (C.log h) "\n") F.text_in_spec p pl xl and eval_grp c = function | M.Attr gs -> diff --git a/helm/ocaml/mathql_interpreter/mQueryTLexer.mll b/helm/ocaml/mathql_interpreter/mQueryTLexer.mll index 4be6ba298..00fc9dc68 100644 --- a/helm/ocaml/mathql_interpreter/mQueryTLexer.mll +++ b/helm/ocaml/mathql_interpreter/mQueryTLexer.mll @@ -29,6 +29,8 @@ { open MQueryTParser + let strip s = String.sub s 1 (pred (String.length s)) + let debug = false let out s = if debug then prerr_endline s @@ -39,6 +41,8 @@ let ALPHA = ['A'-'Z' 'a'-'z' '_'] let NUM = ['0'-'9'] let IDEN = ALPHA (NUM | ALPHA)* let QSTR = [^ '"' '\\']+ +let Q = ['\\' '^' '\"'] +let NQ = [^ '\\' '^' '\"'] rule comm_token = parse | "(*" { comm_token lexbuf; comm_token lexbuf } @@ -47,7 +51,8 @@ rule comm_token = parse | [^ '*' '(']* { comm_token lexbuf } and string_token = parse | '"' { DQ } - | '\\' _ { STR (String.sub (Lexing.lexeme lexbuf) 1 1) } + | '\\' Q '^' { STR (String.sub (Lexing.lexeme lexbuf) 1 1) } + | '\\' NQ '^' { STR (Lexing.lexeme lexbuf) } | QSTR { STR (Lexing.lexeme lexbuf) } | eof { EOF } and query_token = parse @@ -61,13 +66,15 @@ and query_token = parse | ']' { out "RB"; RB } | '{' { out "LC"; LC } | '}' { out "RC"; RC } - | '@' { out "AT"; AT } - | '$' { out "DL"; DL } | '.' { out "FS"; FS } | ',' { out "CM"; CM } | ';' { out "SC"; SC } | '/' { out "SL"; SL } | ';' { out "SC"; SC } + | "@" IDEN { let id = Lexing.lexeme lexbuf in + out ("AVAR " ^ id); AVAR (strip id) } + | "$" IDEN { let id = Lexing.lexeme lexbuf in + out ("SVAR " ^ id); SVAR (strip id) } | "add" { out "ADD" ; ADD } | "align" { out "ALIGN" ; ALIGN } | "allbut" { out "BUT" ; BUT } @@ -104,8 +111,11 @@ and query_token = parse | "of" { out "OF" ; OF } | "or" { out "OR" ; OR } | "pattern" { out "PAT" ; PAT } + | "peek" { out "PEEK" ; PEEK } | "proj" { out "PROJ" ; PROJ } | "property" { out "PROP" ; PROP } + | "read" { out "READ" ; READ } + | "render" { out "RENDER"; RENDER } | "select" { out "SELECT"; SELECT } | "seq" { out "SEQ" ; SEQ } | "source" { out "SOURCE"; SOURCE } @@ -118,8 +128,6 @@ and query_token = parse | "union" { out "UNION" ; UNION } | "where" { out "WHERE" ; WHERE } | "xor" { out "XOR" ; XOR } - | IDEN { let id = Lexing.lexeme lexbuf in - out ("ID " ^ id); ID id } | eof { out "EOF" ; EOF } | "=" { out "BE" ; BE } | "#" { out "COUNT" ; COUNT } @@ -132,14 +140,18 @@ and query_token = parse | "\\/" { out "UNION" ; UNION } | "/\\" { out "INTER" ; INTER } | ";;" { out "SEQ" ; SEQ } + | "begin" { out "LP" ; LP } + | "end" { out "RP" ; RP } and result_token = parse | SPC { result_token lexbuf } | "(*" { comm_token lexbuf; result_token lexbuf } - | '"' { STR (qstr string_token lexbuf) } - | '{' { LC } - | '}' { RC } - | ',' { CM } - | ';' { SC } - | '=' { IS } - | "attr" { ATTR } - | eof { EOF } + | '"' { let str = qstr string_token lexbuf in + out ("STR " ^ str); STR str } + | '/' { out "SL" ; SL } + | '{' { out "LC" ; LC } + | '}' { out "RC" ; RC } + | ',' { out "CM" ; CM } + | ';' { out "SC" ; SC } + | '=' { out "BE" ; BE } + | "attr" { out "ATTR"; ATTR } + | eof { out "EOF" ; EOF } diff --git a/helm/ocaml/mathql_interpreter/mQueryTParser.mly b/helm/ocaml/mathql_interpreter/mQueryTParser.mly index da7061065..a529326b1 100644 --- a/helm/ocaml/mathql_interpreter/mQueryTParser.mly +++ b/helm/ocaml/mathql_interpreter/mQueryTParser.mly @@ -72,15 +72,16 @@ let s (x, y, z) = y let t (x, y, z) = z %} - %token ID STR - %token LB RB SL IS LC RC CM SC LP RP AT DL FS DQ EOF + %token SVAR AVAR STR + %token LB RB SL LC RC CM SC LP RP 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 SEQ SOURCE STAT - %token SUB SUP SUPER THEN TRUE UNION WHERE XOR + %token MAIN MATCH MEET NOT OF OR PAT PEEK PROJ PROP READ RENDER SELECT + %token SEQ SOURCE STAT SUB SUP SUPER THEN TRUE UNION WHERE XOR + %nonassoc SOURCE %right IN SEQ - %nonassoc SUP INF ELSE LOG STAT KEEP + %nonassoc SUP INF ELSE LOG STAT KEEP RENDER PEEK READ %left DIFF %left UNION %left INTER @@ -101,10 +102,10 @@ | STR qstr { $1 ^ $2 } ; svar: - | DL ID { $2 } + | SVAR { $1 } ; avar: - | AT ID { $2 } + | AVAR { $1 } ; strs: | STR CM strs { $1 :: $3 } @@ -118,9 +119,14 @@ | SL subpath { $2 } | SL { [] } ; + ppaths: + | path CM ppaths { $1 :: $3 } + | path { [$1] } + ; paths: - | path CM paths { $1 :: $3 } - | path { [$1] } + | ppaths { $1 } + | { [] } + ; inv: | INV { true } | { false } @@ -216,12 +222,14 @@ { M.Dot $1 $3 } | LC sets RC { make_fun ["union"] [] $2 } - | LC RC - { make_fun ["union"] [] [] } | LP set_exp RP { $2 } | STAT set_exp { make_fun ["stat"] [] [$2] } + | RENDER set_exp + { make_fun ["render"] [] [$2] } + | READ set_exp + { make_fun ["read"] [] [$2] } | EX set_exp { M.Ex (analyze $2) $2 } | NOT set_exp @@ -245,12 +253,12 @@ | ADD distr grp_exp IN set_exp { M.Add $2 $3 $5 } | IF set_exp THEN set_exp ELSE set_exp - { make_fun ["diff"] [] [$2; $4; $6] } + { make_fun ["if"] [] [$2; $4; $6] } | PROP qualif mainc istrue isfalse attrc OF pattern set_exp { M.Property (f $2) (s $2) (t $2) $3 $4 $5 $6 $8 $9 } | LOG xml source set_exp { make_fun ["log"; $2; $3] [] [$4] } - | KEEP allbut paths IN set_exp + | KEEP allbut ppaths IN set_exp { make_fun ["keep"; $2] $3 [$5] } | KEEP allbut set_exp { make_fun ["keep"; $2] [] [$3] } @@ -258,10 +266,6 @@ { M.Select $2 $4 $6 } | path LC paths RC LC sets RC { make_fun $1 $3 $6 } - | path LC sets RC - { 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 @@ -286,10 +290,16 @@ { make_fun ["le"] [] [$1; $3] } | set_exp LT set_exp { make_fun ["lt"] [] [$1; $3] } + | PEEK set_exp + { make_fun ["peek"] [] [$2] } ; + psets: + | set_exp CM psets { $1 :: $3 } + | set_exp { [$1] } + ; sets: - | set_exp CM sets { $1 :: $3 } - | set_exp { [$1] } + | psets { $1 } + | { [] } ; query: | set_exp { $1 } @@ -297,7 +307,7 @@ | EOF { raise End_of_file } ; attr: - | path IS strs { $1, $3 } + | path BE strs { $1, $3 } | path { $1, [] } ; attrs: -- 2.39.2