+ let body e _ _ xl = iter e.eval xl in
+ let txt_out o _ = function
+ | [x1; x2] -> o.query x1; o.out " ;; "; o.query x2
+ | xl -> out_txt_ o ["seq"] xl
+ in
+ {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out}
+
+let proj_fun =
+ let proj_group_aux p (q, v) = if q = p then U.mql_subj v else [] in
+ let proj_group p a = U.mql_iter (proj_group_aux p) a in
+ let proj_set p (_, g) = U.mql_iter (proj_group p) g in
+ let arity_p = Const 1 in
+ let arity_s = Const 1 in
+ let body e _ pl xl =
+ match pl, xl with
+ | [p], [x] -> U.mql_iter (proj_set p) (e.eval x)
+ | _ -> assert false
+ in
+ let txt_out o pl xl =
+ match pl, xl with
+ | [p], [x] -> o.out "proj "; o.path p; o.out " of "; o.query x
+ | _ -> assert false
+ in
+ {arity_p = arity_p; arity_s = arity_s; body = body; txt_out = txt_out}
+
+let keep_fun b =
+ let proj (r, _) = (r, []) in
+ let keep_path l (p, v) t = if List.mem p l = b then t else (p, v) :: t in
+ let keep_grp l a = List.fold_right (keep_path l) a [] in
+ let keep_set l a g =
+ let kg = keep_grp l a in
+ if kg = [] then g else kg :: g
+ in
+ let keep_av l (s, g) = (s, List.fold_right (keep_set l) g []) in
+ let txt_allbut o = if b then o.out "allbut " in
+ let txt_path_list o l = P.flat_list o.out o.path ", " l in
+ let arity_p = Any in
+ let arity_s = Const 1 in
+ let body e _ pl xl =
+ match b, pl, xl with
+ | true, [], [x] -> e.eval x
+ | false, [], [x] -> List.map proj (e.eval x)
+ | _, l, [x] -> List.map (keep_av l) (e.eval x)
+ | _ -> assert false
+ in
+ let txt_out o pl xl =
+ match pl, xl with
+ | [], [x] -> o.out "keep "; txt_allbut o; o.query x
+ | l, [x] ->
+ o.out "keep "; txt_allbut o; txt_path_list o l;
+ o.out " in "; o.query x
+ | _ -> assert false