X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fmathql%2FmQueryUtil.ml;h=3b16bb6b046d22a383b9c2f6bd03b5190a7dc6ed;hb=d9b059cc6ee460f5a0b0c606fd70241be49f0125;hp=ba2382ef99be82526e2b36dd592bf1bae24735cf;hpb=3d70d837a733b4daed65d7c568f4be08f3c37b54;p=helm.git diff --git a/helm/ocaml/mathql/mQueryUtil.ml b/helm/ocaml/mathql/mQueryUtil.ml index ba2382ef9..3b16bb6b0 100644 --- a/helm/ocaml/mathql/mQueryUtil.ml +++ b/helm/ocaml/mathql/mQueryUtil.ml @@ -23,16 +23,8 @@ * http://cs.unibo.it/helm/. *) -(******************************************************************************) -(* *) -(* PROJECT HELM *) -(* *) -(* Ferruccio Guidi *) -(* 30/04/2002 *) -(* *) -(* *) -(******************************************************************************) - +(* AUTOR: Ferruccio Guidi + *) (* text linearization and parsing *******************************************) @@ -43,73 +35,139 @@ let rec txt_list out f s = function let txt_str out s = out ("\"" ^ s ^ "\"") -let txt_path out (p0, p1) = - txt_str out p0; if p1 <> [] then out "/"; txt_list out (txt_str out) "/" p1 - -let txt_svar out sv = out ("%" ^ sv) - -let txt_rvar out rv = out ("@" ^ rv) - -let txt_vvar out vv = out ("$" ^ vv) +let txt_path out p = out "/"; txt_list out (txt_str out) "/" p let text_of_query out x sep = - let module M = MathQL in + 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 -> out "sub " | M.RefineSuper -> out "super " 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 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 -> 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 -> 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 ")" + 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_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 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 + | 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; out sep -let text_of_result out x sep = +let text_of_result out x sep = let txt_attr = function - | (p, []) -> txt_vvar out (fst p) - | (p, l) -> txt_vvar out (fst p); out " = "; txt_list out (txt_str out) ", " 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 = out "{"; txt_list out txt_attr "; " l; out "}" in let txt_res = function | (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 out txt_res ("; " ^ sep) l in - txt_set x; out sep + let txt_set l = txt_list out txt_res ("; " ^ sep) l; out sep in + txt_set x let query_of_text lexbuf = MQueryTParser.query MQueryTLexer.query_token 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 ^ ")" +