/* Copyright (C) 2000, HELM Team. * * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science * Department, University of Bologna, Italy. * * HELM is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * HELM is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with HELM; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, * MA 02111-1307, USA. * * For details, see the HELM World-Wide-Web page, * http://cs.unibo.it/helm/. */ /* AUTOR: Ferruccio Guidi */ %{ module M = MathQL let analyze x = let rec join l1 l2 = match l1, l2 with | [], _ -> l2 | _, [] -> l1 | s1 :: tl1, s2 :: _ when s1 < s2 -> s1 :: join tl1 l2 | s1 :: _, s2 :: tl2 when s2 < s1 -> s2 :: join l1 tl2 | s1 :: tl1, s2 :: tl2 -> s1 :: join tl1 tl2 in let rec iter f = function | [] -> [] | head :: tail -> join (f head) (iter f tail) in let rec an_val = function | M.True -> [] | M.False -> [] | M.Const _ -> [] | M.VVar _ -> [] | M.Ex _ -> [] | M.Dot (rv,_) -> [rv] | M.Not x -> an_val x | M.StatVal x -> an_val x | M.Count x -> an_val x | M.Align (_,x) -> an_val x | M.Proj (_,x) -> an_set x | M.Test (_,x,y) -> iter an_val [x; y] | M.Set l -> iter an_val l and an_set = function | M.Empty -> [] | M.SVar _ -> [] | M.AVar _ -> [] | M.Subj x -> an_val x | M.Keep (_,_,x) -> an_set x | M.Log (_,_,x) -> an_set x | M.StatQuery x -> an_set x | M.Bin (_,x,y) -> iter an_set [x; y] | M.LetSVar (_,x,y) -> iter an_set [x; y] | M.For (_,_,x,y) -> iter an_set [x; y] | M.Add (_,g,x) -> join (an_grp g) (an_set x) | M.LetVVar (_,x,y) -> join (an_val x) (an_set y) | M.Select (_,x,y) -> join (an_set x) (an_val y) | M.Property (_,_,_,_,c,d,_,_,x) -> join (an_val x) (iter an_con [c; List.concat d]) | M.If (x,y,z) -> join (an_val x) (iter an_set [y; z]) and fc (_, _, v) = an_val v and an_con c = iter fc c and fg (_, v) = an_val v and an_grp = function | M.Attr g -> iter (iter fg) g | M.From _ -> [] in an_val x let f (x, y, z) = x let s (x, y, z) = y let t (x, y, z) = z %} %token ID STR %token SL IS LC RC CM SC LP RP AT PC DL FS DQ EOF %token ADD ALIGN AND AS ATTR BE BUT COUNT DIFF DISTR ELSE EMPTY EQ EX %token FALSE FOR FROM IF IN INF INTER INV ISF IST KEEP LE LET LOG LT %token MAIN MATCH MEET NOT OF OR PAT PROJ PROP SELECT SOURCE STAT SUB %token SUBJ SUP SUPER THEN TRUE UNION WHERE XOR %nonassoc IN SUP INF ELSE LOG STAT %left DIFF %left UNION %left INTER %nonassoc WHERE EX %left XOR OR %left AND %nonassoc NOT %nonassoc SUB MEET EQ LT LE %nonassoc SUBJ OF PROJ COUNT ALIGN %start qstr query result %type qstr %type query %type result %% qstr: | DQ { "" } | STR qstr { $1 ^ $2 } ; svar: | PC ID { $2 } ; avar: | AT ID { $2 } ; vvar: | DL ID { $2 } ; strs: | STR CM strs { $1 :: $3 } | STR { [$1] } ; subpath: | STR SL subpath { $1 :: $3 } | STR { [$1] } ; path: | subpath { $1 } | SL subpath { $2 } | SL { [] } ; paths: | path CM paths { $1 :: $3 } | path { [$1] } inv: | INV { true } | { false } ; ref: | SUB { M.RefineSub } | SUPER { M.RefineSuper } | { M.RefineExact } ; qualif: | inv ref path { $1, $2, $3 } ; cons: | path IN val_exp { (false, $1, $3) } | path MATCH val_exp { (true, $1, $3) } ; conss: | cons CM conss { $1 :: $3 } | cons { [$1] } ; istrue: | IST conss { $2 } | { [] } ; isfalse: | { [] } | ISF conss isfalse { $2 :: $3 } ; mainc: | MAIN path { $2 } | { [] } ; exp: | path AS path { $1, Some $3 } | path { $1, None } ; exps: | exp CM exps { $1 :: $3 } | exp { [$1] } ; attrc: | ATTR exps { $2 } | { [] } ; pattern: | PAT { true } | { false } ; opt_path: | path { Some $1 } | { None } ; ass: | val_exp AS path { ($3, $1) } ; asss: | ass CM asss { $1 :: $3 } | ass { [$1] } ; assg: | asss SC assg { $1 :: $3 } | asss { [$1] } ; distr: | DISTR { true } | { false } ; allbut: | BUT { true } | { false } ; bin_op: | set_exp DIFF set_exp { M.BinFDiff, $1, $3 } | set_exp UNION set_exp { M.BinFJoin, $1, $3 } | set_exp INTER set_exp { M.BinFMeet, $1, $3 } ; gen_op: | SUP set_exp { M.GenFJoin, $2 } | INF set_exp { M.GenFMeet, $2 } ; test_op: | val_exp XOR val_exp { M.Xor, $1, $3 } | val_exp OR val_exp { M.Or, $1, $3 } | val_exp AND val_exp { M.And, $1, $3 } | val_exp SUB val_exp { M.Sub, $1, $3 } | val_exp MEET val_exp { M.Meet, $1, $3 } | val_exp EQ val_exp { M.Eq, $1, $3 } | val_exp LE val_exp { M.Le, $1, $3 } | val_exp LT val_exp { M.Lt, $1, $3 } ; source: | SOURCE { true } | { false } ; xml: | { false} ; grp_exp: | assg { M.Attr $1 } | avar { M.From $1 } ; val_exp: | TRUE { M.True } | FALSE { M.False } | STR { M.Const $1 } | avar FS path { M.Dot ($1,$3) } | vvar { M.VVar $1 } | LC vals RC { M.Set $2 } | LC RC { M.Set [] } | LP val_exp RP { $2 } | STAT val_exp { M.StatVal $2 } | EX val_exp { M.Ex ((analyze $2),$2) } | NOT val_exp { M.Not $2 } | test_op { M.Test ((f $1),(s $1),(t $1)) } | PROJ opt_path set_exp { M.Proj ($2,$3) } | COUNT val_exp { M.Count $2 } | ALIGN STR IN val_exp { M.Align ($2,$4) } ; vals: | val_exp CM vals { $1 :: $3 } | val_exp { [$1] } ; set_exp: | EMPTY { M.Empty } | LP set_exp RP { $2 } | svar { M.SVar $1 } | avar { M.AVar $1 } | LET svar BE set_exp IN set_exp { M.LetSVar ($2,$4,$6) } | LET vvar BE val_exp IN set_exp { M.LetVVar ($2,$4,$6) } | FOR avar IN set_exp gen_op { M.For ((fst $5),$2,$4,(snd $5)) } | ADD distr grp_exp IN set_exp { M.Add ($2,$3,$5) } | IF val_exp THEN set_exp ELSE set_exp { M.If ($2,$4,$6) } | PROP qualif mainc istrue isfalse attrc OF pattern val_exp { M.Property ((f $2),(s $2),(t $2),$3,$4,$5,$6,$8,$9) } | LOG xml source set_exp { M.Log ($2,$3,$4) } | STAT set_exp { M.StatQuery $2 } | KEEP allbut paths IN set_exp { M.Keep ($2,$3,$5) } | KEEP allbut IN set_exp { M.Keep ($2,[],$4) } | bin_op { M.Bin ((f $1),(s $1),(t $1)) } | SELECT avar FROM set_exp WHERE val_exp { M.Select ($2,$4,$6) } | SUBJ val_exp { M.Subj $2 } ; query: | set_exp { $1 } | set_exp error { $1 } | EOF { raise End_of_file } ; attr: | path IS strs { $1, $3 } | path { $1, [] } ; attrs: | attr SC attrs { $1 :: $3 } | attr { [$1] } ; group: LC attrs RC { $2 } ; groups: | group CM groups { $1 :: $3 } | group { [$1] } ; resource: | STR ATTR groups { ($1, $3) } | STR { ($1, []) } ; resources: | resource SC resources { $1 :: $3 } | resource { [$1] } | { [] } ; result: | resources { $1 } | EOF { raise End_of_file }