/* 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 module I = M.I module U = AvsUtil module L = MQILib let make_fun p pl xl = L.fun_arity p (List.length pl) (List.length xl); M.Fun (p, pl, xl) let make_gen p xl = L.gen_arity p (List.length xl); M.Gen (p, xl) 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_set = function | M.Const x -> iter fv x | M.SVar _ | M.AVar _ | M.Ex _ -> [] | M.Dot (rv, _) -> [rv] | M.Let (_, x, y) | M.Select (_, x, y) | M.For (_, _, x, y) -> iter an_set [x; y] | M.While (_, x, y) -> iter an_set [x; y] | M.Fun (_, _, l) -> iter an_set l | M.Gen (_, l) -> iter an_set l | M.Add (_, g, x) -> join (an_grp g) (an_set x) | M.Property (_, _, _, _, c, d, _, _, x) -> join (an_set x) (iter an_con [c; List.concat d]) and fc (_, _, v) = an_set v and an_con c = iter fc c and fg (_, v) = an_set v and an_grp = function | M.Attr g -> iter (iter fg) g | M.From _ -> [] and fv (_, g) = iter (iter fg) g in an_set x let f (x, y, z) = x let s (x, y, z) = y let t (x, y, z) = z %} %token SVAR AVAR STR %token LB RB SL LC RC CM SC LP RP FS DQ EOF %token ADD ALIGN AND AS ATTR BE BUT COUNT DIFF DISTR ELSE EMPTY EQ EX %token FALSE FOR FROM GEN IF IN INF INTER INV ISF IST KEEP LE LET LOG LT %token MAIN MATCH MEET NOT OF OR PAT PEEK PROJ PROP READ RENDER SELECT %token SEQ SOURCE STAT SUB SUP SUPER THEN TRUE UNION WHERE WHILE XOR %nonassoc SOURCE %right IN SEQ %nonassoc SUP INF ELSE LOG STAT KEEP RENDER PEEK READ %left DIFF %left UNION %left INTER %nonassoc WHERE EX %left XOR OR %left AND %nonassoc NOT %nonassoc SUB MEET EQ LT LE %nonassoc OF PROJ COUNT ALIGN %start qstr query result %type qstr %type query %type result %% qstr: | DQ { "" } | STR qstr { $1 ^ $2 } ; svar: | SVAR { $1 } ; avar: | AVAR { $1 } ; strs: | STR CM strs { $1 :: $3 } | STR { [$1] } ; subpath: | STR SL subpath { $1 :: $3 } | STR { [$1] } ; path: | SL subpath { $2 } /* | subpath { $1 } */ | SL { [] } ; ppaths: | path CM ppaths { $1 :: $3 } | path { [$1] } ; paths: | ppaths { $1 } | { [] } ; inv: | INV { true } | { false } ; ref: | SUB { M.RefineSub } | SUPER { M.RefineSuper } | { M.RefineExact } ; qualif: | inv ref path { $1, $2, $3 } ; cons: | path IN set_exp { (false, $1, $3) } | path MATCH set_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 } ; distr: | DISTR { true } | { false } ; allbut: | BUT { "allbut" } | { "these" } ; gen_op: | SUP set_exp { M.GenFJoin, $2 } | INF set_exp { M.GenFMeet, $2 } ; source: | SOURCE { "source" } | { "result" } ; xml: | { "text" } ; grp_exp: | x_groups { M.Attr $1 } | avar { M.From $1 } ; set_exp: | STAT set_exp { make_fun ["stat"] [] [$2] } | RENDER set_exp { make_fun ["render"] [] [$2] } | READ set_exp { make_fun ["read"] [] [$2] } | FALSE { make_fun ["false"] [] [] } | TRUE { make_fun ["true"] [] [] } | LC sets RC { make_fun ["union"] [] $2 } | NOT set_exp { make_fun ["not"] [] [$2] } | PROJ path OF set_exp { make_fun ["proj"] [$2] [$4] } | COUNT set_exp { make_fun ["count"] [] [$2] } | ALIGN set_exp IN set_exp { make_fun ["align"] [] [$2; $4] } | EMPTY { make_fun ["empty"] [] [] } | LOG xml source set_exp { make_fun ["log"; $2; $3] [] [$4] } | KEEP allbut ppaths IN set_exp { make_fun ["keep"; $2] $3 [$5] } | KEEP allbut set_exp { make_fun ["keep"; $2] [] [$3] } | path LC paths RC LC sets RC { make_fun $1 $3 $6 } | set_exp DIFF set_exp { make_fun ["diff"] [] [$1; $3] } | set_exp UNION set_exp { make_fun ["union"] [] [$1; $3] } | set_exp INTER set_exp { make_fun ["intersect"] [] [$1; $3] } | set_exp XOR set_exp { make_fun ["xor"] [] [$1; $3] } | set_exp OR set_exp { make_fun ["or"] [] [$1; $3] } | set_exp AND set_exp { make_fun ["and"] [] [$1; $3] } | set_exp SUB set_exp { make_fun ["sub"] [] [$1; $3] } | set_exp MEET set_exp { make_fun ["meet"] [] [$1; $3] } | set_exp EQ set_exp { make_fun ["eq"] [] [$1; $3] } | set_exp LE set_exp { make_fun ["le"] [] [$1; $3] } | set_exp LT set_exp { make_fun ["lt"] [] [$1; $3] } | PEEK set_exp { make_fun ["peek"] [] [$2] } | IF set_exp THEN set_exp ELSE set_exp { make_fun ["if"] [] [$2; $4; $6] } | STR { M.Const [$1, []] } | LB x_resources RB { M.Const $2 } | avar FS path { M.Dot ($1, $3) } | LP set_exp RP { $2 } | EX set_exp { M.Ex (analyze $2, $2) } | svar { M.SVar $1 } | avar { M.AVar $1 } | LET svar BE set_exp IN set_exp { M.Let (Some $2, $4, $6) } | set_exp SEQ set_exp { M.Let (None, $1, $3) } | FOR avar IN set_exp gen_op { M.For (fst $5, $2, $4, snd $5) } | WHILE set_exp gen_op { M.While (fst $3, $2, snd $3) } | ADD distr grp_exp IN set_exp { M.Add ($2, $3, $5) } | PROP qualif mainc istrue isfalse attrc OF pattern set_exp { M.Property (f $2, s $2, t $2, $3, $4, $5, $6, $8, $9) } | SELECT avar FROM set_exp WHERE set_exp { M.Select ($2, $4, $6) } | GEN path LC sets RC { make_gen $2 $4 } | GEN path IN set_exp { make_gen $2 [$4] } ; psets: | set_exp CM psets { $1 :: $3 } | set_exp { [$1] } ; sets: | psets { $1 } | { [] } ; query: | set_exp { $1 } | set_exp error { $1 } | EOF { raise End_of_file } ; x_attr: | path BE set_exp { ($1, $3) } | path { ($1, make_fun ["empty"] [] []) } ; x_attrs: | x_attr SC x_attrs { $1 :: $3 } | x_attr { [$1] } ; x_group: LC x_attrs RC { $2 } ; x_groups: | x_group CM x_groups { $1 :: $3 } | x_group { [$1] } ; x_resource: | STR ATTR x_groups { ($1, $3) } | STR { ($1, []) } ; x_resources: | x_resource SC x_resources { $1 :: $3 } | x_resource { [$1] } | { [] } ; attr: | path BE strs { U.grp_make_x $1 $3 } | path { U.grp_make_x $1 [] } ; attrs: | attr SC attrs { I.grp_union $1 $3 } | attr { $1 } ; group: LC attrs RC { $2 } ; groups: | group CM groups { $1 :: $3 } | group { [$1] } ; resource: | STR ATTR groups { U.make_x $1 $3 } | STR { U.make_x $1 [] } ; resources: | resource SC resources { I.union $1 $3 } | resource { $1 } | { U.val_false } ; result: | resources { $1 } | resources error { $1 } | EOF { raise End_of_file }