+++ /dev/null
-/* 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 <fguidi@cs.unibo.it>
- */
-
-%{
- 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 <string> 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 <string> qstr
- %type <MathQL.query> query
- %type <MathQL.result> 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 }
projects / helm.git / blobdiff