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://www.cs.unibo.it/helm/.
27 * implementazione del comando SELECT
34 exception ExecuteFunctionNotInitialized;;
37 (function _ -> raise ExecuteFunctionNotInitialized)
41 * valutazione di una stringa
44 let module S = Mathql_semantics in
49 let {S.uri = uri} = List.assoc rvar env in
51 | MQStringRVar rvar ->
52 let {S.uri = uri} = List.assoc rvar env in
54 | MQStringSVar svar ->
55 let (_,{S.attributes = attributes}) = List.hd env in
56 List.assoc svar attributes
67 let module S = Mathql_semantics in
70 (is_good env b1) && (is_good env b2)
72 (is_good env b1) || (is_good env b2)
80 (stringeval env s1) = (stringeval env s2)
81 (*CSC: magari le prossime funzioni dovrebbero andare in un file a parte, *)
82 (*CSC: insieme alla [execute] che utilizzano *)
83 | MQSetEqual (q1,q2) ->
84 (* set_of_result returns an ordered list of uris without duplicates *)
85 let rec set_of_result =
88 | (Some olduri as v),{S.uri = uri}::tl when uri = olduri ->
90 | _,{S.uri = uri}::tl ->
91 uri::(set_of_result (Some uri, tl))
93 let ul1 = set_of_result (None,!execute env q1) in
94 let ul2 = set_of_result (None,!execute env q2) in
95 prerr_endline ("MQSETEQUAL(" ^ string_of_int (List.length (!execute env q1)) ^ ">" ^ string_of_int (List.length ul1) ^ "," ^ string_of_int (List.length (!execute env q2)) ^ ">" ^ string_of_int (List.length ul2) ^ ")") ; flush stderr ;
97 List.fold_left2 (fun b uri1 uri2 -> b && uri1=uri2) true ul1 ul2
100 | MQSubset (q1,q2) ->
101 (*CSC: codice cut&paste da sopra: ridurlo facendo un'unica funzione h.o. *)
102 (* set_of_result returns an ordered list of uris without duplicates *)
103 let rec set_of_result =
106 | (Some olduri as v),{S.uri = uri}::tl when uri = olduri ->
108 | _,{S.uri = uri}::tl ->
109 uri::(set_of_result (Some uri, tl))
111 let ul1 = set_of_result (None,!execute env q1) in
112 let ul2 = set_of_result (None,!execute env q2) in
113 prerr_endline ("MQSUBSET(" ^ string_of_int (List.length (!execute env q1)) ^ ">" ^ string_of_int (List.length ul1) ^ "," ^ string_of_int (List.length (!execute env q2)) ^ ">" ^ string_of_int (List.length ul2) ^ ")") ; flush stderr ;
114 let rec is_subset s1 s2 =
118 | uri1::tl1,uri2::tl2 when uri1 = uri2 ->
120 | uri1::_,uri2::tl2 when uri1 > uri2 ->
129 * implementazione del comando SELECT
133 let select_ex env avar alist abool =
134 let _ = print_string ("SELECT = ")
135 and t = Unix.time () in
137 List.filter (function entry -> is_good ((avar,entry)::env) abool) alist
139 print_string (string_of_int (List.length result) ^ ": ") ;
140 print_endline (string_of_float (Unix.time () -. t) ^ "s") ;