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/.
38 exception SVarUnbound of string;;
39 exception RVarUnbound of string;;
40 exception VVarUnbound of string;;
41 exception PathUnbound of (string * string list);;
43 exception BooleExpTrue
45 (* valuta una MathQL.set_exp e ritorna un MathQL.resource_set *)
50 let execute_aux handle x =
51 let module M = MathQL in
52 let module X = MQueryMisc in
53 let rec exec_set_exp c = function
56 List.assoc svar c.svars
58 raise (SVarUnbound svar))
61 [List.assoc rvar c.rvars]
63 raise (RVarUnbound rvar))
64 | M.Ref vexp -> List.map (fun s -> (s,[])) (exec_val_exp c vexp)
65 | M.Pattern vexp -> pattern_ex handle (exec_val_exp c vexp)
66 | M.Intersect (sexp1, sexp2) ->
67 let before = X.start_time() in
68 let rs1 = exec_set_exp c sexp1 in
69 let rs2 = exec_set_exp c sexp2 in
70 let res = intersect_ex rs1 rs2 in
71 let diff = X.stop_time before in
72 let ll1 = string_of_int (List.length rs1) in
73 let ll2 = string_of_int (List.length rs2) in
74 if MQIConn.set handle MQIConn.Stat then
75 MQIConn.log handle ("INTERSECT(" ^ ll1 ^ "," ^ ll2 ^ ") = " ^ string_of_int (List.length res) ^
78 | M.Union (sexp1, sexp2) ->
79 let before = X.start_time () in
80 let res = union_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2) in
81 let diff = X.stop_time before in
82 if MQIConn.set handle MQIConn.Stat then MQIConn.log handle ("UNION: " ^ diff ^ "\n");
84 | M.LetSVar (svar, sexp1, sexp2) ->
85 let before = X.start_time() in
86 let c1 = upd_svars c ((svar, exec_set_exp c sexp1) :: c.svars) in
87 let res = exec_set_exp c1 sexp2 in
88 if MQIConn.set handle MQIConn.Stat then begin
89 MQIConn.log handle ("LETIN " ^ svar ^ " = " ^ string_of_int (List.length res) ^ ": ");
90 MQIConn.log handle (X.stop_time before ^ "\n");
93 | M.LetVVar (vvar, vexp, sexp) ->
94 let before = X.start_time() in
95 let c1 = upd_vvars c ((vvar, exec_val_exp c vexp) :: c.vvars) in
96 let res = exec_set_exp c1 sexp in
97 if MQIConn.set handle MQIConn.Stat then begin
98 MQIConn.log handle ("LETIN " ^ vvar ^ " = " ^ string_of_int (List.length res) ^ ": ");
99 MQIConn.log handle (X.stop_time before ^ "\n");
102 | M.Relation (inv, rop, path, sexp, assl) ->
103 let before = X.start_time() in
104 if MQIConn.set handle MQIConn.Galax then begin
105 let res = relation_galax_ex handle inv rop path (exec_set_exp c sexp) assl in
106 if MQIConn.set handle MQIConn.Stat then begin
107 MQIConn.log handle ("RELATION-GALAX " ^ (fst path) ^ " = " ^ string_of_int(List.length res) ^ ": ");
108 MQIConn.log handle (X.stop_time before ^ "\n")
112 let res = relation_ex handle inv rop path (exec_set_exp c sexp) assl in
113 if MQIConn.set handle MQIConn.Stat then begin
114 MQIConn.log handle ("RELATION " ^ (fst path) ^ " = " ^ string_of_int(List.length res) ^ ": ");
115 MQIConn.log handle (X.stop_time before ^ "\n")
119 | M.Select (rvar, sexp, bexp) ->
120 let before = X.start_time() in
121 let rset = (exec_set_exp c sexp) in
126 let c1 = upd_rvars c ((rvar,r)::c.rvars) in
127 if (exec_boole_exp c1 bexp) then
132 let res = select_ex rset in
133 if MQIConn.set handle MQIConn.Stat then begin
134 MQIConn.log handle ("SELECT " ^ rvar ^ " = " ^ string_of_int (List.length res) ^ ": ");
135 MQIConn.log handle (X.stop_time before ^ "\n");
138 | M.Diff (sexp1, sexp2) -> diff_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2)
140 (* valuta una MathQL.boole_exp e ritorna un boole *)
142 and exec_boole_exp c =
146 | M.Not x -> not (exec_boole_exp c x)
147 | M.And (x, y) -> (exec_boole_exp c x) && (exec_boole_exp c y)
148 | M.Or (x, y) -> (exec_boole_exp c x) || (exec_boole_exp c y)
149 | M.Sub (vexp1, vexp2) ->
150 sub_ex (exec_val_exp c vexp1) (exec_val_exp c vexp2)
151 | M.Meet (vexp1, vexp2) ->
152 meet_ex (exec_val_exp c vexp1) (exec_val_exp c vexp2)
153 | M.Eq (vexp1, vexp2) -> (exec_val_exp c vexp1) = (exec_val_exp c vexp2)
156 (exec_boole_exp c bexp)
163 List.assoc uri c.rvars
164 with Not_found -> assert false)
167 ) l (*latt = l + attributi*)
172 [] -> if (exec_boole_exp c bexp) then raise BooleExpTrue
173 | (uri,attl)::tail1 ->
174 (*per ogni el. di attl devo andare in ric. su tail1*)
175 let rec sub_prod attl =
179 let c1 = upd_groups c ((uri,att)::c.groups) in
180 prod c1 tail1; sub_prod tail2
186 with BooleExpTrue -> true
188 (* valuta una MathQL.val_exp e ritorna un MathQL.value *)
190 and exec_val_exp c = function
192 ol = List.sort compare x in
193 let rec edup = function
196 | s::tl -> if tl <> [] then
197 if s = (List.hd tl) then edup tl
202 | M.Record (rvar, path) ->
206 List.assoc rvar c.groups
208 raise (RVarUnbound rvar))
210 raise (PathUnbound path))
215 raise (VVarUnbound s))
216 | M.RefOf sexp -> List.map (fun (s,_) -> s) (exec_set_exp c sexp)
217 | M.Fun (s, vexp) -> fun_ex handle s (exec_val_exp c vexp)
218 | M.Property (inv, rop, path, vexp) -> property_ex handle rop path inv (exec_val_exp c vexp)
220 (* valuta una MathQL.set_exp nel contesto vuoto e ritorna un MathQL.resource_set *)
222 exec_set_exp {svars = []; rvars = []; groups = []; vvars = []} x
224 (* new interface ***********************************************************)
226 let execute handle x = execute_aux handle x