new interface for text_of_query/text_of_result + bug fixes

diff --git a/helm/ocaml/mathql/mQueryUtil.ml b/helm/ocaml/mathql/mQueryUtil.ml
index 98371c0538aeda098e851288730238f0f2c11da4..ba2382ef99be82526e2b36dd592bf1bae24735cf 100644 (file)
--- a/helm/ocaml/mathql/mQueryUtil.ml
+++ b/helm/ocaml/mathql/mQueryUtil.ml
@@ -36,80 +36,80 @@
 
 (* text linearization and parsing *******************************************)
 
-let rec txt_list f s = function
-   | []        -> ""
+let rec txt_list out f s = function
+   | []        -> ()
    | [a]       -> f a
-   | a :: tail -> f a ^ s ^ txt_list f s tail
+   | a :: tail -> f a; out s; txt_list out f s tail
    
-let txt_str s = "\"" ^ s ^ "\""
+let txt_str out s = out ("\"" ^ s ^ "\"")
 
-let txt_path (p0, p1) =
-   txt_str p0 ^ (if p1 <> [] then "/" ^ txt_list txt_str "/" p1 else "")
+let txt_path out (p0, p1) =
+   txt_str out p0; if p1 <> [] then out "/"; txt_list out (txt_str out) "/" p1
 
-let txt_svar sv = "%" ^ sv 
+let txt_svar out sv = out ("%" ^ sv) 
 
-let txt_rvar rv = "@" ^ rv 
+let txt_rvar out rv = out ("@" ^ rv) 
 
-let txt_vvar vv = "$" ^ vv 
+let txt_vvar out vv = out ("$" ^ vv) 
 
-let text_of_query x =
+let text_of_query out x sep =
    let module M = MathQL in
-   let txt_inv i = if i then "inverse " else "" in
+   let txt_inv i = if i then out "inverse " in
    let txt_ref = function
-      | M.RefineExact -> ""
-      | M.RefineSub   -> "sub "
-      | M.RefineSuper -> "super "
+      | M.RefineExact -> ()
+      | M.RefineSub   -> out "sub "
+      | M.RefineSuper -> out "super "
    in
-   let txt_refpath i r p = txt_inv i ^ txt_ref r ^ txt_path p ^ " " in
-   let txt_assign (pl, pr) = txt_vvar (fst pl) ^ " <- " ^ txt_path pr in
+   let txt_refpath i r p = txt_inv i; txt_ref r; txt_path out p; out " " in
+   let txt_assign (pl, pr) = txt_vvar out (fst pl); out " <- "; txt_path out pr in
    let rec txt_val = function
-      | M.Const [s]             -> txt_str s
-      | M.Const l               -> "{" ^ txt_list txt_str ", " l ^ "}"
-      | M.VVar vv               -> txt_vvar vv
-      | M.Record (rv, p)        -> txt_rvar rv ^ "." ^ txt_vvar (fst p)
-      | M.Fun (s, x)            -> "fun " ^ txt_str s ^ " " ^ txt_val x
-      | M.Property (i, r, p, x) -> "property " ^ txt_refpath i r p ^ txt_val x
-      | M.RefOf x               -> "refof " ^ txt_set x
+      | M.Const [s]             -> txt_str out s
+      | M.Const l               -> out "{"; txt_list out (txt_str out) ", " l; out "}"
+      | M.VVar vv               -> txt_vvar out vv
+      | M.Record (rv, p)        -> txt_rvar out rv; out "."; txt_vvar out (fst p)
+      | M.Fun (s, x)            -> out "fun "; txt_str out s; out " "; txt_val x
+      | M.Property (i, r, p, x) -> out "property "; txt_refpath i r p; txt_val x
+      | M.RefOf x               -> out "refof "; txt_set x
    and txt_boole = function
-      | M.False       -> "false"
-      | M.True        -> "true"
-      | M.Ex b x      -> "ex " ^ txt_boole x
+      | M.False       -> out "false"
+      | M.True        -> out "true"
+      | M.Ex b x      -> out "ex "; txt_boole x
 (*    | M.Ex b x      -> "ex [" ^ txt_list txt_rvar "," b ^ "] " ^ txt_boole x
-*)    | M.Not x       -> "not " ^ txt_boole x
-      | M.And (x, y)  -> "(" ^ txt_boole x ^ " and " ^ txt_boole y ^ ")"
-      | M.Or (x, y)   -> "(" ^ txt_boole x ^ " or " ^ txt_boole y ^ ")"
-      | M.Sub (x, y)  -> "(" ^ txt_val x ^ " sub " ^ txt_val y ^ ")"
-      | M.Meet (x, y) -> "(" ^ txt_val x ^ " meet " ^ txt_val y ^ ")"
-      | M.Eq (x, y)   -> "(" ^ txt_val x ^ " eq " ^ txt_val y ^ ")"
+*)    | M.Not x       -> out "not "; txt_boole x
+      | M.And (x, y)  -> out "("; txt_boole x; out " and "; txt_boole y; out ")"
+      | M.Or (x, y)   -> out "("; txt_boole x; out " or "; txt_boole y; out ")"
+      | M.Sub (x, y)  -> out "("; txt_val x; out " sub "; txt_val y; out ")"
+      | M.Meet (x, y) -> out "("; txt_val x; out " meet "; txt_val y; out ")"
+      | M.Eq (x, y)   -> out "("; txt_val x; out " eq "; txt_val y; out ")"
    and txt_set = function
-      | M.SVar sv                   -> txt_svar sv
-      | M.RVar rv                   -> txt_rvar rv
-      | M.Relation (i, r, p, M.Ref x, []) -> "relation " ^ txt_refpath i r p ^ txt_val x
-      | M.Relation (i, r, p, M.Ref x, l)  -> "relation " ^ txt_refpath i r p ^ txt_val x ^ " attr " ^ txt_list txt_assign ", " l
-      | M.Union (x, y)              -> "(" ^ txt_set x ^ " union " ^ txt_set y ^ ")"
-      | M.Intersect (x, y)          -> "(" ^ txt_set x ^ " intersect " ^ txt_set y ^ ")"
-      | M.Diff (x, y)               -> "(" ^ txt_set x ^ " diff " ^ txt_set y ^ ")"
-      | M.LetSVar (sv, x, y)        -> "let " ^ txt_svar sv ^ " be " ^ txt_set x ^ " in " ^ txt_set y
-      | M.LetVVar (vv, x, y)        -> "let " ^ txt_vvar vv ^ " be " ^ txt_val x ^ " in " ^ txt_set y
-      | M.Select (rv, x, y)         -> "select " ^ txt_rvar rv ^ " in " ^ txt_set x ^ " where " ^ txt_boole y
-      | M.Pattern x                 -> "pattern " ^ txt_val x
-      | M.Ref x                     -> "ref " ^ txt_val x
+      | M.SVar sv                   -> txt_svar out sv
+      | M.RVar rv                   -> txt_rvar out rv
+      | M.Relation (i, r, p, M.Ref x, []) -> out "relation "; txt_refpath i r p; txt_val x
+      | M.Relation (i, r, p, M.Ref x, l)  -> out "relation "; txt_refpath i r p; txt_val x; out " attr "; txt_list out txt_assign ", " l
+      | M.Union (x, y)              -> out "("; txt_set x; out " union "; txt_set y; out ")"
+      | M.Intersect (x, y)          -> out "("; txt_set x; out " intersect "; txt_set y; out ")"
+      | M.Diff (x, y)               -> out "("; txt_set x; out " diff "; txt_set y; out ")"
+      | M.LetSVar (sv, x, y)        -> out "let "; txt_svar out sv; out " be "; txt_set x; out " in "; txt_set y
+      | M.LetVVar (vv, x, y)        -> out "let "; txt_vvar out vv; out " be "; txt_val x; out " in "; txt_set y
+      | M.Select (rv, x, y)         -> out "select "; txt_rvar out rv; out " in "; txt_set x; out " where "; txt_boole y
+      | M.Pattern x                 -> out "pattern "; txt_val x
+      | M.Ref x                     -> out "ref "; txt_val x
       | _                           -> assert false
    in 
-   txt_set x
+   txt_set x; out sep
 
-let text_of_result x sep =
+let text_of_result out x sep =
    let txt_attr = function
-      | (p, []) -> txt_vvar (fst p)
-      | (p, l)  -> txt_vvar (fst p) ^ " = " ^ txt_list txt_str ", " l
+      | (p, []) -> txt_vvar out (fst p)
+      | (p, l)  -> txt_vvar out (fst p); out " = "; txt_list out (txt_str out) ", " l
    in
-   let txt_group l = "{" ^ txt_list txt_attr "; " l ^ "}" in
+   let txt_group l = out "{"; txt_list out txt_attr "; " l; out "}" in
    let txt_res = function
-      | (s, []) -> txt_str s 
-      | (s, l)  -> txt_str s ^ " attr " ^ txt_list txt_group ", " l
+      | (s, []) -> txt_str out s 
+      | (s, l)  -> txt_str out s; out " attr "; txt_list out txt_group ", " l
    in   
-   let txt_set l = txt_list txt_res ("; " ^ sep) l ^ sep in
-   txt_set x
+   let txt_set l = txt_list out txt_res ("; " ^ sep) l in
+   txt_set x; out sep
 
 let query_of_text lexbuf =
    MQueryTParser.query MQueryTLexer.query_token lexbuf 

diff --git a/helm/ocaml/mathql/mQueryUtil.mli b/helm/ocaml/mathql/mQueryUtil.mli
index 9881b3b545b0b8d762cf657dd43f481f43d7e70c..83337ddfbf31d295349ecd22141101f3e39814d5 100644 (file)
--- a/helm/ocaml/mathql/mQueryUtil.mli
+++ b/helm/ocaml/mathql/mQueryUtil.mli
@@ -34,9 +34,9 @@
 (******************************************************************************)
 
 
-val text_of_query  : MathQL.query -> string
+val text_of_query  : (string -> unit) -> MathQL.query -> string -> unit
 
-val text_of_result : MathQL.result -> string -> string
+val text_of_result : (string -> unit) -> MathQL.result -> string -> unit
 
 val query_of_text  : Lexing.lexbuf -> MathQL.query
 

diff --git a/helm/ocaml/mathql_interpreter/pattern.ml b/helm/ocaml/mathql_interpreter/pattern.ml
index 45b43995211ca97244daca79a47881f4255cb8b4..5fddf5729b4a9a7e719c9c5970bc0eee31758732 100644 (file)
--- a/helm/ocaml/mathql_interpreter/pattern.ml
+++ b/helm/ocaml/mathql_interpreter/pattern.ml
@@ -40,7 +40,7 @@ let rec pattern_ex l =
              let c = pgc () in
              let qq = "select uri from registry where uri ~ '" ^ s ^ "' order by registry.uri asc" in
              let res = c#exec (qq) in
-             List.map (function uri -> (uri,[])) (pgresult_to_string_list res)
+             List.map (function uri -> (List.hd uri,[])) res#get_list
              (*for i = 0 to res#ntuples do 
             List.map (function uri -> (uri,[])) (res#get_tuple_list i)
              done*)

diff --git a/helm/ocaml/mathql_interpreter/relation.ml b/helm/ocaml/mathql_interpreter/relation.ml
index e5b700064bb297e6d35e533a3d4b73af334c7c31..96b97f6578c727f4ac867a5ed0da38ebdc658b81 100644 (file)
--- a/helm/ocaml/mathql_interpreter/relation.ml
+++ b/helm/ocaml/mathql_interpreter/relation.ml
@@ -65,7 +65,7 @@ let relation_ex inv rop path rset assl =
  
     "refObj" 
   | "backPointer" ->               (* proprieta` refObj e backPointer *)
-    print_endline "IN BACKPOINTER";
+(*    print_endline "IN BACKPOINTER"; *)
     let prop = get_prop_id relk in
     if assl = [] then    (* se non ci sono assegnamenti *)
       let c = pgc () in
@@ -73,11 +73,11 @@ let relation_ex inv rop path rset assl =
       (List.fold_left (fun acc (uri,l) ->
         let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ uri ^ "'")) in
         let qq = "select uri from t" ^ tv ^ " where prop_id='" ^ prop ^ "' order by uri asc" in
-       print_endline qq;
+(*     print_endline qq; *)
         let res = c#exec qq in
         
        let l = (pgresult_to_string_list res) in
-       List.iter print_endline l;
+(*     List.iter print_endline l; *)
         (List.map
          (function  
                [uri] -> [(uri,[])]