functor added

[helm.git] / helm / ocaml / mathql_interpreter / mQueryIO.ml

diff --git a/helm/ocaml/mathql_interpreter/mQueryIO.ml b/helm/ocaml/mathql_interpreter/mQueryIO.ml
index 5af9c7b1056816146c025cb9d4fb80e214e0ad4e..14199e513136d396f88380fe130346200d430395 100644 (file)
--- a/helm/ocaml/mathql_interpreter/mQueryIO.ml
+++ b/helm/ocaml/mathql_interpreter/mQueryIO.ml
@@ -27,6 +27,7 @@
  *)
 
 module M = MathQL
+module I = M.I
 module P = MQueryUtil
 module L = MQILib
 
@@ -51,22 +52,37 @@ let txt_str out s = out ("\"" ^ txt_quote s ^ "\"")
 
 let txt_path out p = out "/"; P.flat_list out (txt_str out) "/" p 
 
-let text_of_result out sep x = 
-   let txt_attr = function
-      | (p, []) -> txt_path out p
-      | (p, l)  -> txt_path out p; out " = "; 
-                   P.flat_list out (txt_str out) ", " l
+let text_of_result out sep x =
+   let txt_attr _ p l b = 
+      txt_path out p;
+      if l <> [] then begin 
+         out " = "; P.flat_list out (txt_str out) ", " l
+      end; 
+      if b then out ("; " ^ sep)
    in
+   let txt_group l = out "{"; I.x_grp_iter txt_attr () l; out "}" in 
+   let txt_res _ s l b = 
+      txt_str out s; 
+      if l <> [] then begin 
+         out " = "; P.flat_list out txt_group ", " l
+      end;
+      if b then out "; "
+   in
+   I.x_iter txt_res () x; out sep
+
+let rec xtext_of_groups out l = 
+   let txt_attr (p, x) = txt_path out p; out " = "; text_of_query out "" x in
    let txt_group l = out "{"; P.flat_list out txt_attr "; " l; out "}" in
+   P.flat_list out txt_group ", " l
+
+and xtext_of_result out x =
    let txt_res = function
       | (s, []) -> txt_str out s 
-      | (s, l)  -> txt_str out s; out " attr "; 
-                   P.flat_list out txt_group ", " l
+      | (s, l)  -> txt_str out s; out " attr "; xtext_of_groups out l
    in   
-   let txt_set l = P.flat_list out txt_res ("; " ^ sep) l; out sep in
-   txt_set x
+   P.flat_list out txt_res "; " x
 
-let rec text_of_query out sep x = 
+and 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
@@ -103,44 +119,41 @@ let rec text_of_query out sep x =
       | l  -> out s; P.flat_list out txt_con ", " l 
    and txt_istrue lt = txt_con_list " istrue " lt 
    and txt_isfalse lf = txt_con_list " isfalse " lf
-   and txt_ass (p, x) = txt_set x; out " as "; txt_path out p
-   and txt_ass_list l = P.flat_list out txt_ass ", " l
-   and txt_assg_list g = P.flat_list out txt_ass_list "; " g
    and txt_grp = function
-      | M.Attr g  -> txt_assg_list g
+      | M.Attr g  -> xtext_of_groups out g
       | M.From av -> txt_avar av
    and txt_set = function
-      | M.Fun p pl xl      -> 
+      | M.Fun (p, pl, xl)      -> 
          let o = {L.out = out; L.path = txt_path; 
                  L.query = text_of_query; L.result = text_of_result
                 } 
         in
         L.fun_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 -> 
+      | M.Const [s, []]       -> txt_str out s
+      | M.Const r             -> xtext_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 (Some sv) x y -> out "let "; txt_svar sv; out " = "; 
-                               txt_set x; out " in "; txt_set y
-      | M.Let None x y      -> txt_set x; out " ;; "; 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.While k x y       -> out "while "; 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.Gen p [x]         -> out "gen "; txt_path out p; out " in "; txt_set x
-      | M.Gen p l           -> out "gen "; txt_path out p; out " {";
-                               P.flat_list out txt_set ", " l; out "}"
+      | M.Let (Some sv, x, y) -> out "let "; txt_svar sv; out " = "; 
+                                 txt_set x; out " in "; txt_set y
+      | M.Let (None, x, y)    -> txt_set x; out " ;; "; 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.While (k, x, y)     -> out "while "; 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.Gen (p, [x])        -> out "gen "; txt_path out p; out " in "; txt_set x
+      | M.Gen (p, l)          -> out "gen "; txt_path out p; out " {";
+                                 P.flat_list out txt_set ", " l; out "}"
    in 
    txt_set x; out sep