exception Found
+module U = AvsUtil
module M = MathQL
+module I = M.I
module P = MQueryUtil
module C = MQIConn
-module U = MQIUtil
module L = MQILib
module F = MQueryIO
(* contexts *****************************************************************)
-type svar_context = (M.svar * M.resource_set) list
+type svar_context = (M.svar * M.result) list
-type avar_context = (M.avar * M.resource) list
+type avar_context = (M.avar * (string * M.group list)) list
-type group_context = (M.avar * M.attribute_group) list
+type group_context = (M.avar * M.group) list
type context = {svars: svar_context;
avars: avar_context;
F.text_of_query (C.log h) "\n" q
end
in
- let proj v = List.map fst v in
let rec eval_query c = function
- | M.Const r -> c, r
- | M.Dot i p ->
+ | M.Const r ->
+ let aux2 s g = I.make s (eval_list c g) in
+ let aux (s, gl) = U.iter (aux2 s) gl in
+ c, U.iter aux r
+ | M.Dot (i, p) ->
begin
- try c, U.mql_subj (List.assoc p (List.assoc i c.groups))
- with Not_found -> warn (M.Dot i p); c, []
+ try c, I.grp_read (List.assoc i c.groups) p
+ with Not_found -> warn (M.Dot (i, p)); c, I.empty
end
- | M.Ex l y ->
+ | M.Ex (l, y) ->
let rec ex_aux h = function
| [] ->
let d = {c with groups = h} in
- if snd (eval_query d y) = U.mql_false then () else raise Found
+ if snd (eval_query d y) = U.val_false then () else raise Found
| i :: tail ->
begin
try
with Not_found -> ()
end
in
- begin try ex_aux [] l; c, U.mql_false with Found -> c, U.mql_true end
+ begin try ex_aux [] l; c, U.val_false with Found -> c, U.val_true end
| M.SVar i ->
begin
try c, List.assoc i c.svars
- with Not_found -> warn (M.SVar i); c, []
+ with Not_found -> warn (M.SVar i); c, I.empty
end
| M.AVar i ->
begin
- try c, [List.assoc i c.avars]
- with Not_found -> warn (M.AVar i); c, []
+ try
+ let s, gl = List.assoc i c.avars in
+ c, U.make_x s gl
+ with Not_found -> warn (M.AVar i); c, I.empty
end
- | M.Let (Some i) x1 x2 ->
+ | M.Let (Some i, x1, x2) ->
let d, r = eval_query c x1 in
let d = {d with svars = P.add_assoc (i, r) d.svars} in
eval_query d x2
- | M.Let None x1 x2 ->
+ | M.Let (None, x1, x2) ->
let d, r = eval_query c x1 in eval_query d x2
- | M.For k i x1 x2 ->
+ | M.For (k, i, x1, x2) ->
let f = match k with
- | M.GenFJoin -> U.mql_union
- | M.GenFMeet -> U.mql_intersect
+ | M.GenFJoin -> I.union
+ | M.GenFMeet -> I.intersect
in
- let rec for_aux (d, r) = match r with
- | [] -> d, []
- | h :: t ->
- let d = {d with avars = P.add_assoc (i, h) d.avars} in
- let d, r = eval_query d x2 in
- let d, s = for_aux (d, t) in
- d, f r s
- in
- for_aux (eval_query c x1)
- | M.While k x1 x2 ->
+ let for_aux (d, r) s gl _ =
+ let d = {d with avars = P.add_assoc (i, (s, gl)) d.avars} in
+ let d, s = eval_query d x2 in
+ d, f r s
+ in
+ let d, r = eval_query c x1 in
+ I.x_iter for_aux (d, I.empty) r
+ | M.While (k, x1, x2) ->
let f = match k with
- | M.GenFJoin -> U.mql_union
- | M.GenFMeet -> U.mql_intersect
+ | M.GenFJoin -> I.union
+ | M.GenFMeet -> I.intersect
in
let rec while_aux (d, r) =
let d, b = eval_query d x1 in
- if b = U.mql_false then d, r else
+ if b = U.val_false then d, r else
let d, s = eval_query d x2 in
while_aux (d, f r s)
in
- while_aux (c, U.mql_false)
- | M.Add b z x ->
- let f = if b then U.mql_prod else U.set_union in
- let g a s = (fst a, f (snd a) (eval_grp c z)) :: s in
+ while_aux (c, U.val_false)
+ | M.Add (b, z, x) ->
+ let f = if b then I.d_union else I.union in
+ let agl = eval_grp c z in
+ let aux r sj gl _ =
+ I.append (f (U.make_x sj gl) (U.make_x sj agl)) r
+ in
let _, r = eval_query c x in
- c, List.fold_right g r []
- | M.Property q0 q1 q2 mc ct cfl el pat y ->
+ c, I.x_iter aux I.empty r
+ | M.Property (q0, q1, q2, mc, ct, cfl, el, pat, y) ->
let _, r = eval_query c y in
let subj, mct =
if q0 then [], (pat, q2 @ mc, r) else (q2 @ mc), (pat, [], r)
let r = MQIProperty.exec h q1 subj cons_true cons_false exp in
let s = P.stop_time t in
if C.set h C.Stat then
- C.log h (Printf.sprintf "Property: %s,%i\n" s (List.length r));
+ C.log h (Printf.sprintf "Property: %s,%i\n" s (U.count r));
c, r
- | M.Select i x y ->
- let rec select_aux (d, r) = match r with
- | [] -> d, []
- | h :: t ->
- let d = {d with avars = P.add_assoc (i, h) d.avars} in
- let d, r = eval_query d y in
- let d, s = select_aux (d, t) in
- if r = U.mql_false then d, s else d, (h :: s)
+ | M.Select (i, x, y) ->
+ let aux (d, r) sj gl _ =
+ let d = {d with avars = P.add_assoc (i, (sj, gl)) d.avars} in
+ let d, s = eval_query d y in
+ if s = U.val_false then d, r else d, (I.append (U.make_x sj gl) r)
in
- select_aux (eval_query c x)
- | M.Fun p pl xl ->
+ let d, r = eval_query c x in
+ I.x_iter aux (d, I.empty) r
+ | M.Fun (p, pl, xl) ->
let e = {L.eval = (fun x -> snd (eval_query c x)); L.conn = h} in
c, L.fun_eval e (F.text_out_spec (C.log h) "\n") F.text_in_spec
p pl xl
- | M.Gen p xl ->
+ | M.Gen (p, xl) ->
let e = {L.eval = (fun x -> snd (eval_query c x)); L.conn = h} in
eval_query c (L.gen_eval e p xl)
+ and eval_list c l =
+ let aux (p, y) =
+ let _, r = eval_query c y in
+ U.x_grp_make_x p r
+ in
+ U.grp_iter aux l
and eval_grp c = function
| M.Attr gs ->
- let attr_aux g (p, y) =
- let _, r = eval_query c y in
- U.mql_union g [p, proj r]
- in
- let attr_auxs s l = U.set_union s [List.fold_left attr_aux [] l] in
+ let attr_auxs s l = I.grps_make s (eval_list c l) in
List.fold_left attr_auxs [] gs
| M.From i ->
try snd (List.assoc i c.avars)
projects / helm.git / blobdiff