1 (* Copyright (C) 2000, HELM Team.
3 * This file is part of HELM, an Hypertextual, Electronic
4 * Library of Mathematics, developed at the Computer Science
5 * Department, University of Bologna, Italy.
7 * HELM is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
12 * HELM is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
17 * You should have received a copy of the GNU General Public License
18 * along with HELM; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
22 * For details, see the HELM World-Wide-Web page,
23 * http://cs.unibo.it/helm/.
26 (* modifiers ***************************************************************)
34 (* contexts *****************************************************************)
36 type svar_context = (MathQL.svar * MathQL.resource_set) list
38 type avar_context = (MathQL.avar * MathQL.resource) list
40 type group_context = (MathQL.avar * MathQL.attribute_group) list
42 type vvar_context = (MathQL.vvar * MathQL.value) list
44 type context = {svars: svar_context;
46 groups: group_context; (* auxiliary context *)
50 (* execute *****************************************************************)
60 if String.contains m warn_char then
62 out "MQIExecute: waring: reference to undefined variables: ";
63 P.text_of_query out q "\n"
66 let rec eval_val c = function
67 | M.False -> U.mql_false
68 | M.True -> U.mql_true
70 | M.Set l -> U.iter (eval_val c) l
73 if eval_val c y1 = U.mql_false then U.mql_false else eval_val c y2
76 let v1 = eval_val c y1 in
77 if v1 = U.mql_false then eval_val c y2 else v1
79 let h f y1 y2 = f (eval_val c y1) (eval_val c y2) in
84 | M.Sub -> h U.set_sub
85 | M.Meet -> h U.set_meet
92 if eval_val c y = U.mql_false then U.mql_true else U.mql_false
94 try List.assoc i c.vvars
95 with Not_found -> warn (M.Subj (M.VVar i)); [] end
97 try List.assoc p (List.assoc i c.groups)
98 with Not_found -> warn (M.Subj (M.Dot i p)); [] end
99 | M.Proj None x -> List.map (fun (r, _) -> r) (eval_query c x)
100 | M.Proj (Some p) x ->
101 let proj_group_aux (q, v) = if q = p then v else [] in
102 let proj_group a = U.iter proj_group_aux a in
103 let proj_set (_, g) = U.iter proj_group g in
104 U.iter proj_set (eval_query c x)
106 let rec ex_aux h = function
108 let d = {c with groups = h} in
109 if eval_val d y = U.mql_false then () else raise Found
113 let (_, a) = List.assoc i c.avars in
114 let rec add_group = function
116 | g :: t -> ex_aux ((i, g) :: h) tail; add_group t
122 (try ex_aux [] l; U.mql_false with Found -> U.mql_true)
124 let t = U.start_time () in
125 let r = (eval_val c y) in
126 let s = U.stop_time t in
127 out (Printf.sprintf "Stat: %s,%i\n" s (List.length r));
129 | M.Count y -> [string_of_int (List.length (eval_val c y))]
130 | M.Align s y -> U.iter (U.align s) (eval_val c y)
131 and eval_query c = function
134 List.map (fun s -> (s, [])) (eval_val c x)
137 let t = U.start_time () in
138 P.text_of_query out x "\n";
139 let s = U.stop_time t in
140 if String.contains m stat_char then
141 out (Printf.sprintf "Log source: %s\n" s);
144 let s = (eval_query c x) in
145 let t = U.start_time () in
146 P.text_of_result out s "\n";
147 let r = U.stop_time t in
148 if String.contains m stat_char then
149 out (Printf.sprintf "Log: %s\n" r);
153 if (eval_val c y) = U.mql_false
154 then (eval_query c x2) else (eval_query c x1)
157 | M.BinFJoin -> U.mql_union
158 | M.BinFMeet -> U.mql_intersect
159 | M.BinFDiff -> U.mql_diff
161 f (eval_query c x1) (eval_query c x2)
163 try List.assoc i c.svars
164 with Not_found -> warn (M.SVar i); [] end
166 try [List.assoc i c.avars]
167 with Not_found -> warn (M.AVar i); [] end
168 | M.LetSVar i x1 x2 ->
169 let d = {c with svars = U.set (i, eval_query c x1) c.svars} in
172 let d = {c with vvars = U.set (i, eval_val c y) c.vvars} in
176 | M.GenFJoin -> U.mql_union
177 | M.GenFMeet -> U.mql_intersect
179 let rec for_aux = function
182 let d = {c with avars = U.set (i, h) c.avars} in
183 f (eval_query d x2) (for_aux t)
185 for_aux (eval_query c x1)
187 let f = if b then U.mql_prod else U.set_union in
188 let g a s = (fst a, f (snd a) (eval_grp c z)) :: s in
189 List.fold_right g (eval_query c x) []
190 | M.Property q0 q1 q2 mc ct cf el pat y ->
192 if q0 then [], (pat, q2 @ mc, eval_val c y)
193 else (q2 @ mc), (pat, [], eval_val c y)
195 let f = if String.contains m galax_char
196 then MQIProperty.galax else MQIProperty.postgres
198 let eval_cons (pat, p, y) = (pat, q2 @ p, eval_val c y) in
199 let cons_true = mct :: List.map eval_cons ct in
200 let cons_false = List.map eval_cons cf in
201 let eval_exp (p, po) = (q2 @ p, po) in
202 let exp = List.map eval_exp el in
203 let t = U.start_time () in
204 let r = f q1 subj cons_true cons_false exp in
205 let s = U.stop_time t in
206 if String.contains m stat_char then
207 out (Printf.sprintf "Property: %s,%i\n" s (List.length r));
210 let t = U.start_time () in
211 let r = (eval_query c x) in
212 let s = U.stop_time t in
213 out (Printf.sprintf "Stat: %s,%i\n" s (List.length r));
216 let rec select_aux = function
219 let d = {c with avars = U.set (i, h) c.avars} in
220 if eval_val d y = U.mql_false
221 then select_aux t else h :: select_aux t
223 select_aux (eval_query c x)
225 let keep_path (p, v) t =
226 if List.mem p l = b then t else (p, v) :: t in
227 let keep_grp a = List.fold_right keep_path a [] in
229 let kg = keep_grp a in
230 if kg = [] then g else kg :: g
232 let keep_av (s, g) = (s, List.fold_right keep_set g []) in
233 List.map keep_av (eval_query c x)
234 and eval_grp c = function
236 let attr_aux g (p, y) = U.mql_union g [(p, eval_val c y)] in
237 [List.fold_left attr_aux [] l]
239 try snd (List.assoc i c.avars)
240 with Not_found -> warn (M.AVar i); []
242 let c = {svars = []; avars = []; groups = []; vvars = []} in
243 let t = U.start_time () in
244 let r = eval_query c x in
245 let s = U.stop_time t in
246 if String.contains m stat_char then
247 out (Printf.sprintf "MQIExecute: %s,%s\n" s m);