X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fmathql%2FmQueryUtil.ml;h=3b16bb6b046d22a383b9c2f6bd03b5190a7dc6ed;hb=1ade90b417bd1815dc502ab42de8688e72c1701b;hp=98371c0538aeda098e851288730238f0f2c11da4;hpb=fb7df84a9ffea7a67817b303a1d6983fb52e963d;p=helm.git diff --git a/helm/ocaml/mathql/mQueryUtil.ml b/helm/ocaml/mathql/mQueryUtil.ml index 98371c053..3b16bb6b0 100644 --- a/helm/ocaml/mathql/mQueryUtil.ml +++ b/helm/ocaml/mathql/mQueryUtil.ml @@ -23,92 +23,150 @@ * http://cs.unibo.it/helm/. *) -(******************************************************************************) -(* *) -(* PROJECT HELM *) -(* *) -(* Ferruccio Guidi *) -(* 30/04/2002 *) -(* *) -(* *) -(******************************************************************************) - +(* AUTOR: Ferruccio Guidi + *) (* 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_path (p0, p1) = - txt_str p0 ^ (if p1 <> [] then "/" ^ txt_list txt_str "/" p1 else "") - -let txt_svar sv = "%" ^ sv - -let txt_rvar rv = "@" ^ rv +let txt_str out s = out ("\"" ^ s ^ "\"") -let txt_vvar vv = "$" ^ vv +let txt_path out p = out "/"; txt_list out (txt_str out) "/" p -let text_of_query x = - let module M = MathQL in - let txt_inv i = if i then "inverse " else "" in +let text_of_query out x sep = + let module M = MathQL in + let txt_path_list l = txt_list out (txt_path out) ", " l in + let txt_svar sv = out ("%" ^ sv) in + let txt_avar av = out ("@" ^ av) in + let txt_vvar vv = out ("$" ^ vv) 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_qualif i r p = txt_inv i; txt_ref r; txt_path out p in + let main = function + | [] -> () + | p -> out " main "; txt_path out p + in + let txt_exp = function + | (pl, None) -> txt_path out pl + | (pl, Some pr) -> txt_path out pl; out " as "; txt_path out pr + in + let txt_exp_list = function + | [] -> () + | l -> out " attr "; txt_list out txt_exp ", " l + in + let pattern b = if b then out "pattern " in + let txt_opt_path = function + | None -> () + | Some p -> txt_path out p; out " " + in + let txt_distr d = if d then out "distr " in + let txt_bin = function + | M.BinFJoin -> out " union " + | M.BinFMeet -> out " intersect " + | M.BinFDiff -> out " diff " 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 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 - and txt_boole = function - | M.False -> "false" - | M.True -> "true" - | M.Ex b x -> "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 ^ ")" + let txt_gen = function + | M.GenFJoin -> out " sup " + | M.GenFMeet -> out " inf " + in + let txt_test = function + | M.Xor -> out " xor " + | M.Or -> out " or " + | M.And -> out " and " + | M.Sub -> out " sub " + | M.Meet -> out " meet " + | M.Eq -> out " eq " + | M.Le -> out " le " + | M.Lt -> out " lt " + 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 + let rec txt_con (pat, p, x) = + txt_path out p; + if pat then out " match " else out " in "; + txt_val x + and txt_con_list s = function + | [] -> () + | l -> out s; txt_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_val x; out " as "; txt_path out p + and txt_ass_list l = txt_list out txt_ass ", " l + and txt_assg_list g = txt_list out txt_ass_list "; " g + and txt_val_list = function + | [v] -> txt_val v + | l -> out "{"; txt_list out txt_val ", " l; out "}" + and txt_grp = function + | M.Attr g -> txt_assg_list g + | M.From av -> txt_avar av + and txt_val = function + | M.True -> out "true" + | M.False -> out "false" + | M.Const s -> txt_str out s + | M.Set l -> txt_val_list l + | M.VVar vv -> txt_vvar vv + | M.Dot av p -> txt_avar av; out "."; txt_path out p + | M.Proj op x -> out "proj "; txt_opt_path op; txt_set x + | M.Ex b x -> out "ex "; txt_val x +(* | M.Ex b x -> out "ex ["; txt_list out txt_avar "," b; out "] "; txt_val x +*) | M.Not x -> out "not "; txt_val x + | M.Test k x y -> out "("; txt_val x; txt_test k; txt_val y; out ")" + | M.StatVal x -> out "stat "; txt_val x + | M.Count x -> out "count "; txt_val x + | M.Align s x -> out "align "; txt_str out s; out " in "; txt_val x 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 - | _ -> assert false + | M.Empty -> out "empty" + | 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; txt_list out txt_isfalse "" cfl; txt_exp_list xl; + out " of "; pattern b; txt_val x + | M.Bin k x y -> out "("; txt_set x; txt_bin k; txt_set y; + out ")" + | M.LetSVar sv x y -> out "let "; txt_svar sv; out " be "; + txt_set x; out " in "; txt_set y + | M.LetVVar vv x y -> out "let "; txt_vvar vv; out " be "; + txt_val x; out " in "; txt_set y + | M.Select av x y -> out "select "; txt_avar av; out " from "; + txt_set x; out " where "; txt_val y + | M.Subj x -> out "subj "; txt_val x + | M.For k av x y -> out "for "; txt_avar av; out " in "; + txt_set x; txt_gen k; txt_set y + | M.If x y z -> out "if "; txt_val x; out " then "; + txt_set y; out " else "; txt_set z + | M.Add d g x -> out "add "; txt_distr d; txt_grp g; + out " in "; txt_set x + | M.Log a b x -> out "log "; txt_log a b; txt_set x + | M.StatQuery x -> out "stat "; txt_set x + | M.Keep b l x -> out "keep "; txt_allbut b; txt_path_list l; + txt_set x + 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_path out p + | (p, l) -> txt_path out 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 + let txt_set l = txt_list out txt_res ("; " ^ sep) l; out sep in txt_set x let query_of_text lexbuf = @@ -117,6 +175,18 @@ let query_of_text lexbuf = let result_of_text lexbuf = MQueryTParser.result MQueryTLexer.result_token lexbuf +(* time handling ***********************************************************) + +type time = float * float + +let start_time () = + (Sys.time (), Unix.time ()) + +let stop_time (s0, u0) = + let s1 = Sys.time () in + let u1 = Unix.time () in + Printf.sprintf "%.2fs,%.2fs" (s1 -. s0) (u1 -. u0) + (* conversion functions *****************************************************) type uriref = UriManager.uri * (int list) @@ -129,3 +199,4 @@ let string_of_uriref (uri, fi) = | [] -> str | [t] -> str ^ xp t ^ ")" | t :: c :: _ -> str ^ xp t ^ "/" ^ string_of_int c ^ ")" +