patched and some funtions added

diff --git a/helm/ocaml/mathql_interpreter/mQILib.ml b/helm/ocaml/mathql_interpreter/mQILib.ml
index b1582f9bce63c9d618f624fdde9024a3ed3391ef..7a1e4e53b114489e568e3561da1a81add3ba7c9f 100644 (file)
--- 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 e37fa3b2da10435bf8fb4dd2f0208e790b571e48..acc465b7ae6170304917b6e318cfab9c29578b4c 100644 (file)
--- 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 67df606d18741e0058f8bb682d14cfef08abccf2..d0e127c6410f7fb37f5da78489a593581098ce2b 100644 (file)
--- 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 a7d30dd0910ade259a1a2f549c1a562384b63738..f220a270de5694cb1f4f0a33fe3b24f022bf2484 100644 (file)
--- 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 12a4de2a56dd7bed4b0483a71e1d10a522e8acaa..57d7e856fa34007df966fa55950695c1f3c0e8f9 100644 (file)
--- 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 511e01c701e5b0eef27802a6aec22628807b80b3..a459fe82954e9eaa02ca09e9c3d07bac31712dad 100644 (file)
--- 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 4be6ba298e412fb5b89c0e32af48079fe2c0d2fc..00fc9dc68701bc58cdea3250d362b8596d230dbd 100644 (file)
--- 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 da70610655a131396ce98a10405b8cb8308d8bfd..a529326b19a211ac8947d8ea0cb54164c91a378d 100644 (file)
--- 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    <string> ID STR
-   %token    LB RB SL IS LC RC CM SC LP RP AT DL FS DQ EOF 
+   %token    <string> 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: