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 /* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
33 let make_fun p pl xl =
34 L.fun_arity p (List.length pl) (List.length xl);
38 L.gen_arity p (List.length xl);
42 let rec join l1 l2 = match l1, l2 with
45 | s1 :: tl1, s2 :: _ when s1 < s2 -> s1 :: join tl1 l2
46 | s1 :: _, s2 :: tl2 when s2 < s1 -> s2 :: join l1 tl2
47 | s1 :: tl1, s2 :: tl2 -> s1 :: join tl1 tl2
49 let rec iter f = function
51 | head :: tail -> join (f head) (iter f tail)
53 let rec an_set = function
61 | M.For _ _ x y -> iter an_set [x; y]
62 | M.Fun _ _ l -> iter an_set l
63 | M.Gen _ l -> iter an_set l
64 | M.Add _ g x -> join (an_grp g) (an_set x)
65 | M.Property _ _ _ _ c d _ _ x ->
66 join (an_set x) (iter an_con [c; List.concat d])
67 and fc (_, _, v) = an_set v
68 and an_con c = iter fc c
69 and fg (_, v) = an_set v
71 | M.Attr g -> iter (iter fg) g
80 %token <string> SVAR AVAR STR
81 %token LB RB SL LC RC CM SC LP RP FS DQ EOF
82 %token ADD ALIGN AND AS ATTR BE BUT COUNT DIFF DISTR ELSE EMPTY EQ EX
83 %token FALSE FOR FROM GEN IF IN INF INTER INV ISF IST KEEP LE LET LOG LT
84 %token MAIN MATCH MEET NOT OF OR PAT PEEK PROJ PROP READ RENDER SELECT
85 %token SEQ SOURCE STAT SUB SUP SUPER THEN TRUE UNION WHERE XOR
89 %nonassoc SUP INF ELSE LOG STAT KEEP RENDER PEEK READ
97 %nonassoc SUB MEET EQ LT LE
98 %nonassoc OF PROJ COUNT ALIGN
100 %start qstr query result
102 %type <MathQL.query> query
103 %type <MathQL.result> result
107 | STR qstr { $1 ^ $2 }
116 | STR CM strs { $1 :: $3 }
120 | STR SL subpath { $1 :: $3 }
129 | path CM ppaths { $1 :: $3 }
141 | SUB { M.RefineSub }
142 | SUPER { M.RefineSuper }
146 | inv ref path { $1, $2, $3 }
149 | path IN set_exp { (false, $1, $3) }
150 | path MATCH set_exp { (true, $1, $3) }
153 | cons CM conss { $1 :: $3 }
162 | ISF conss isfalse { $2 :: $3 }
169 | path AS path { $1, Some $3 }
173 | exp CM exps { $1 :: $3 }
185 | set_exp AS path { ($3, $1) }
188 | ass CM asss { $1 :: $3 }
192 | asss SC assg { $1 :: $3 }
204 | SUP set_exp { M.GenFJoin, $2 }
205 | INF set_exp { M.GenFMeet, $2 }
208 | SOURCE { "source" }
219 | STAT set_exp { make_fun ["stat"] [] [$2] }
220 | RENDER set_exp { make_fun ["render"] [] [$2] }
221 | READ set_exp { make_fun ["read"] [] [$2] }
222 | FALSE { make_fun ["false"] [] [] }
223 | TRUE { make_fun ["true"] [] [] }
224 | LC sets RC { make_fun ["union"] [] $2 }
225 | NOT set_exp { make_fun ["not"] [] [$2] }
226 | PROJ path OF set_exp { make_fun ["proj"] [$2] [$4] }
227 | COUNT set_exp { make_fun ["count"] [] [$2] }
228 | ALIGN set_exp IN set_exp { make_fun ["align"] [] [$2; $4] }
229 | EMPTY { make_fun ["empty"] [] [] }
230 | LOG xml source set_exp { make_fun ["log"; $2; $3] [] [$4] }
231 | KEEP allbut ppaths IN set_exp { make_fun ["keep"; $2] $3 [$5] }
232 | KEEP allbut set_exp { make_fun ["keep"; $2] [] [$3] }
233 | path LC paths RC LC sets RC { make_fun $1 $3 $6 }
234 | set_exp SEQ set_exp { make_fun ["seq"] [] [$1; $3] }
235 | set_exp DIFF set_exp { make_fun ["diff"] [] [$1; $3] }
236 | set_exp UNION set_exp { make_fun ["union"] [] [$1; $3] }
237 | set_exp INTER set_exp { make_fun ["intersect"] [] [$1; $3] }
238 | set_exp XOR set_exp { make_fun ["xor"] [] [$1; $3] }
239 | set_exp OR set_exp { make_fun ["or"] [] [$1; $3] }
240 | set_exp AND set_exp { make_fun ["and"] [] [$1; $3] }
241 | set_exp SUB set_exp { make_fun ["sub"] [] [$1; $3] }
242 | set_exp MEET set_exp { make_fun ["meet"] [] [$1; $3] }
243 | set_exp EQ set_exp { make_fun ["eq"] [] [$1; $3] }
244 | set_exp LE set_exp { make_fun ["le"] [] [$1; $3] }
245 | set_exp LT set_exp { make_fun ["lt"] [] [$1; $3] }
246 | PEEK set_exp { make_fun ["peek"] [] [$2] }
247 | IF set_exp THEN set_exp ELSE set_exp
248 { make_fun ["if"] [] [$2; $4; $6] }
249 | STR { M.Const [$1, []] }
250 | LB resources RB { M.Const $2 }
251 | avar FS path { M.Dot $1 $3 }
252 | LP set_exp RP { $2 }
253 | EX set_exp { M.Ex (analyze $2) $2 }
256 | LET svar BE set_exp IN set_exp { M.Let $2 $4 $6 }
257 | FOR avar IN set_exp gen_op { M.For (fst $5) $2 $4 (snd $5) }
258 | ADD distr grp_exp IN set_exp { M.Add $2 $3 $5 }
259 | PROP qualif mainc istrue isfalse attrc OF pattern set_exp
260 { M.Property (f $2) (s $2) (t $2) $3 $4 $5 $6 $8 $9 }
261 | SELECT avar FROM set_exp WHERE set_exp { M.Select $2 $4 $6 }
262 | GEN path LC sets RC { make_gen $2 $4 }
263 | GEN path IN set_exp { make_gen $2 [$4] }
266 | set_exp CM psets { $1 :: $3 }
275 | set_exp error { $1 }
276 | EOF { raise End_of_file }
279 | path BE strs { $1, $3 }
283 | attr SC attrs { $1 :: $3 }
290 | group CM groups { $1 :: $3 }
294 | STR ATTR groups { ($1, $3) }
298 | resource SC resources { $1 :: $3 }
304 | resources error { $1 }
305 | EOF { raise End_of_file }