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/.
26 (* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
29 type path = Avs.path (* the name of an attribute *)
31 type value = Avs.value (* the value of an attribute *)
33 type attribute = path * value (* an attribute *)
35 type group = attribute list (* a group of attributes *)
37 type attribute_set = group list (* the attributes of an URI *)
39 type av = string * attribute_set (* an attributed URI *)
41 type avs = av list (* the query result *)
44 | Single of (string * group list)
45 | Many of (string * group list)
48 (* constructors *************************************************************)
52 let grp_make p v = [(p, [v])]
60 (* projections **************************************************************)
62 let subj v = List.rev (List.rev_map (fun x -> (x, [])) v)
64 let grp_read g p = subj (List.assoc p g)
70 (* iterators ****************************************************************)
72 let rec iter f a = function
74 | [s, _] -> f a s false
75 | (s, _) :: v -> iter f (f a s true) v
77 let rec x_iter f a = function
79 | [s, gl] -> f a s gl false
80 | (s, gl) :: v -> x_iter f (f a s gl true) v
82 let rec x_grp_iter f a g = x_iter f a g
84 (* tests ********************************************************************)
90 | (h1, _) :: _, (h2, _) :: _ when h1 < h2 -> false
91 | (h1, _) :: _, (h2, _) :: t2 when h1 > h2 -> sub v1 t2
92 | _ :: t1, _ :: t2 -> sub t1 t2
98 | (h1, _) :: t1, (h2, _) :: _ when h1 < h2 -> meet t1 v2
99 | (h1, _) :: _, (h2, _) :: t2 when h1 > h2 -> meet v1 t2
105 | (h1, _) :: t1, (h2, _) :: t2 when h1 = h2 -> eq t1 t2
108 (* union ********************************************************************)
110 let rec set_union v1 v2 =
114 | h1 :: t1, h2 :: t2 when h1 < h2 -> h1 :: set_union t1 v2
115 | h1 :: t1, h2 :: t2 when h1 > h2 -> h2 :: set_union v1 t2
116 | h1 :: t1, _ :: t2 -> h1 :: set_union t1 t2
118 let set_iter f al = List.fold_left (fun s a -> set_union (f a) s) [] al
120 let grps_make l g = set_union l [g]
122 let rec union s1 s2 =
126 | (r1, g1) :: t1, (r2, _) :: _ when r1 < r2 ->
127 (r1, g1) :: union t1 s2
128 | (r1, _) :: _, (r2, g2) :: t2 when r1 > r2 ->
129 (r2, g2) :: union s1 t2
130 | (r1, g1) :: t1, (_, g2) :: t2 ->
131 (r1, set_union g1 g2) :: union t1 t2
133 let grp_union = union
141 let aux a = set_iter (fun h -> [union a h]) g2 in
144 let rec d_union s1 s2 =
148 | (r1, g1) :: t1, (r2, _) :: _ when r1 < r2 ->
149 (r1, g1) :: d_union t1 s2
150 | (r1, _) :: _, (r2, g2) :: t2 when r1 > r2 ->
151 (r2, g2) :: d_union s1 t2
152 | (r1, g1) :: t1, (_, g2) :: t2 ->
153 (r1, prod g1 g2) :: d_union t1 t2
155 (* intersect ****************************************************************)
157 let rec set_intersect v1 v2 =
161 | h1 :: t1, h2 :: _ when h1 < h2 -> set_intersect t1 v2
162 | h1 :: _, h2 :: t2 when h1 > h2 -> set_intersect v1 t2
163 | h1 :: t1, _ :: t2 -> h1 :: set_intersect t1 t2
165 let rec intersect s1 s2 =
169 | (r1, _) :: t1, (r2, _) :: _ when r1 < r2 -> intersect t1 s2
170 | (r1, _) :: _, (r2, _) :: t2 when r1 > r2 -> intersect s1 t2
171 | (r1, g1) :: t1, (_, g2) :: t2 ->
172 (r1, set_intersect g1 g2) :: intersect t1 t2
174 (* diff *********************************************************************)
180 | (r1, g1) :: t1 , (r2, _) ::_ when r1 < r2 ->
181 (r1, g1) :: (diff t1 s2)
182 | (r1, _) :: _, (r2, _) :: t2 when r1 > r2 -> diff s1 t2
183 | _ :: t1, _ :: t2 -> diff t1 t2
185 (* peeking ******************************************************************)
189 | [s, gl] -> Single (s, gl)
190 | (s, gl) :: _ -> Many (s, gl)
192 (* optimization *************************************************************)
194 let optimize = List.rev