helm/ocaml/mathql_interpreter/mQueryTParser.mly

   1 /* Copyright (C) 2000, HELM Team.
   2  *
   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.
   6  *
   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.
  11  *
  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.
  16  *
  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,
  20  * MA  02111-1307, USA.
  21  *
  22  * For details, see the HELM World-Wide-Web page,
  23  * http://cs.unibo.it/helm/.
  24  */
  25
  26 /*  AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
  27  */
  28
  29 %{
  30    module M = MathQL
  31    module L = MQILib
  32
  33    let make_fun p pl xl =
  34       L.check_arity p (List.length pl) (List.length xl);
  35       M.Fun p pl xl
  36
  37    let analyze x =
  38       let rec join l1 l2 = match l1, l2 with
  39          | [], _                           -> l2
  40          | _, []                           -> l1
  41          | s1 :: tl1, s2 :: _ when s1 < s2 -> s1 :: join tl1 l2
  42          | s1 :: _, s2 :: tl2 when s2 < s1 -> s2 :: join l1 tl2
  43          | s1 :: tl1, s2 :: tl2            -> s1 :: join tl1 tl2
  44       in
  45       let rec iter f = function
  46          | []  -> []
  47          | head :: tail -> join (f head) (iter f tail)
  48       in
  49       let rec an_set = function
  50          | M.Const _
  51          | M.SVar _
  52          | M.AVar _
  53          | M.Ex _                       -> []
  54          | M.Dot rv _                   -> [rv]
  55          | M.Let _ x y
  56          | M.Select _ x y
  57          | M.For _ _ x y                -> iter an_set [x; y]
  58          | M.Fun _ _ l                  -> iter an_set l
  59          | M.Add _ g x                  -> join (an_grp g) (an_set x)
  60          | M.Property _ _ _ _ c d _ _ x ->
  61             join (an_set x) (iter an_con [c; List.concat d])
  62       and fc (_, _, v) = an_set v
  63       and an_con c = iter fc c
  64       and fg (_, v) = an_set v
  65       and an_grp = function
  66          | M.Attr g -> iter (iter fg) g
  67          | M.From _ -> []
  68       in
  69       an_set x
  70
  71    let f (x, y, z) = x
  72    let s (x, y, z) = y
  73    let t (x, y, z) = z
  74 %}
  75    %token    <string> ID STR
  76    %token    LB RB SL IS LC RC CM SC LP RP AT DL FS DQ EOF
  77    %token    ADD ALIGN AND AS ATTR BE BUT COUNT DIFF DISTR ELSE EMPTY EQ EX
  78    %token    FALSE FOR FROM IF IN INF INTER INV ISF IST KEEP LE LET LOG LT
  79    %token    MAIN MATCH MEET NOT OF OR PAT PROJ PROP SELECT SEQ SOURCE STAT
  80    %token    SUB SUP SUPER THEN TRUE UNION WHERE XOR
  81    %nonassoc SOURCE
  82    %right    IN SEQ
  83    %nonassoc SUP INF ELSE LOG STAT KEEP
  84    %left     DIFF
  85    %left     UNION
  86    %left     INTER
  87    %nonassoc WHERE EX
  88    %left     XOR OR
  89    %left     AND
  90    %nonassoc NOT
  91    %nonassoc SUB MEET EQ LT LE
  92    %nonassoc OF PROJ COUNT ALIGN
  93
  94    %start    qstr query result
  95    %type     <string>        qstr
  96    %type     <MathQL.query>  query
  97    %type     <MathQL.result> result
  98 %%
  99    qstr:
 100       | DQ       { ""      }
 101       | STR qstr { $1 ^ $2 }
 102    ;
 103    svar:
 104       | DL ID { $2 }
 105    ;
 106    avar:
 107       | AT ID { $2 }
 108    ;
 109    strs:
 110       | STR CM strs { $1 :: $3 }
 111       | STR         { [$1]     }
 112    ;
 113    subpath:
 114       | STR SL subpath { $1 :: $3 }
 115       | STR            { [$1]     }
 116    ;
 117    path:
 118       | SL subpath { $2 }
 119       | SL         { [] }
 120    ;
 121    paths:
 122       | path CM paths { $1 :: $3 }
 123       | path          { [$1]     }
 124    inv:
 125       | INV { true  }
 126       |     { false }
 127    ;
 128    ref:
 129       | SUB   { M.RefineSub   }
 130       | SUPER { M.RefineSuper }
 131       |       { M.RefineExact }
 132    ;
 133    qualif:
 134       | inv ref path { $1, $2, $3 }
 135    ;
 136    cons:
 137       | path IN set_exp    { (false, $1, $3) }
 138       | path MATCH set_exp { (true, $1, $3)  }
 139    ;
 140    conss:
 141       | cons CM conss { $1 :: $3 }
 142       | cons          { [$1]     }
 143    ;
 144    istrue:
 145       | IST conss { $2 }
 146       |           { [] }
 147    ;
 148    isfalse:
 149       |                   { []       }
 150       | ISF conss isfalse { $2 :: $3 }
 151    ;
 152    mainc:
 153       | MAIN path { $2 }
 154       |           { [] }
 155    ;
 156    exp:
 157       | path AS path { $1, Some $3 }
 158       | path         { $1, None    }
 159    ;
 160    exps:
 161       | exp CM exps { $1 :: $3 }
 162       | exp         { [$1]     }
 163    ;
 164    attrc:
 165       | ATTR exps { $2 }
 166       |           { [] }
 167    ;
 168    pattern:
 169       | PAT { true  }
 170       |     { false }
 171    ;
 172    ass:
 173       | set_exp AS path { ($3, $1) }
 174    ;
 175    asss:
 176       | ass CM asss { $1 :: $3 }
 177       | ass         { [$1]     }
 178    ;
 179    assg:
 180       | asss SC assg { $1 :: $3 }
 181       | asss         { [$1]     }
 182    ;
 183    distr:
 184       | DISTR { true  }
 185       |       { false }
 186    ;
 187    allbut:
 188       | BUT { "allbut" }
 189       |     { "these"  }
 190    ;
 191    gen_op:
 192       | SUP set_exp { M.GenFJoin, $2 }
 193       | INF set_exp { M.GenFMeet, $2 }
 194    ;
 195    source:
 196       | SOURCE { "source" }
 197       |        { "result" }
 198    ;
 199    xml:
 200       | { "text" }
 201    ;
 202    grp_exp:
 203       | assg { M.Attr $1 }
 204       | avar { M.From $1 }
 205    ;
 206    set_exp:
 207       | FALSE
 208          { make_fun ["false"] [] [] }
 209       | TRUE
 210          { make_fun ["true"] [] [] }
 211       | STR
 212          { M.Const [$1, []] }
 213       | LB resources RB
 214          { M.Const $2 }
 215       | avar FS path
 216          { M.Dot $1 $3 }
 217       | LC sets RC
 218          { make_fun ["union"] [] $2 }
 219       | LC RC
 220          { make_fun ["union"] [] [] }
 221       | LP set_exp RP
 222          { $2 }
 223       | STAT set_exp
 224          { make_fun ["stat"] [] [$2] }
 225       | EX set_exp
 226          { M.Ex (analyze $2) $2 }
 227       | NOT set_exp
 228          { make_fun ["not"] [] [$2] }
 229       | PROJ path OF set_exp
 230          { make_fun ["proj"] [$2] [$4] }
 231       | COUNT set_exp
 232          { make_fun ["count"] [] [$2] }
 233       | ALIGN set_exp IN set_exp
 234          { make_fun ["align"] [] [$2; $4] }
 235       | EMPTY
 236          { make_fun ["empty"] [] [] }
 237       | svar
 238          { M.SVar $1 }
 239       | avar
 240          { M.AVar $1 }
 241       | LET svar BE set_exp IN set_exp
 242          { M.Let $2 $4 $6 }
 243       | FOR avar IN set_exp gen_op
 244          { M.For (fst $5) $2 $4 (snd $5) }
 245       | ADD distr grp_exp IN set_exp
 246          { M.Add $2 $3 $5 }
 247       | IF set_exp THEN set_exp ELSE set_exp
 248          { make_fun ["diff"] [] [$2; $4; $6] }
 249       | PROP qualif mainc istrue isfalse attrc OF pattern set_exp
 250          { M.Property (f $2) (s $2) (t $2) $3 $4 $5 $6 $8 $9 }
 251       | LOG xml source set_exp
 252          { make_fun ["log"; $2; $3] [] [$4] }
 253       | KEEP allbut paths IN set_exp
 254          { make_fun ["keep"; $2] $3 [$5] }
 255       | KEEP allbut set_exp
 256          { make_fun ["keep"; $2] [] [$3] }
 257       | SELECT avar FROM set_exp WHERE set_exp
 258          { M.Select $2 $4 $6 }
 259       | path LC paths RC LC sets RC
 260          { make_fun $1 $3 $6 }
 261       | path LC sets RC
 262          { make_fun $1 [] $3 }
 263       | path LC RC
 264          { make_fun $1 [] [] }
 265       | set_exp SEQ set_exp
 266          { make_fun ["seq"] [] [$1; $3] }
 267       | set_exp DIFF set_exp
 268          { make_fun ["diff"] [] [$1; $3] }
 269       | set_exp UNION set_exp
 270          { make_fun ["union"] [] [$1; $3] }
 271       | set_exp INTER set_exp
 272          { make_fun ["intersect"] [] [$1; $3] }
 273       | set_exp XOR set_exp
 274          { make_fun ["xor"] [] [$1; $3] }
 275       | set_exp OR set_exp
 276          { make_fun ["or"] [] [$1; $3] }
 277       | set_exp AND set_exp
 278          { make_fun ["and"] [] [$1; $3] }
 279       | set_exp SUB set_exp
 280          { make_fun ["sub"] [] [$1; $3] }
 281       | set_exp MEET set_exp
 282          { make_fun ["meet"] [] [$1; $3] }
 283       | set_exp EQ set_exp
 284          { make_fun ["eq"] [] [$1; $3] }
 285       | set_exp LE set_exp
 286          { make_fun ["le"] [] [$1; $3] }
 287       | set_exp LT set_exp
 288          { make_fun ["lt"] [] [$1; $3] }
 289    ;
 290    sets:
 291       | set_exp CM sets { $1 :: $3 }
 292       | set_exp         { [$1]     }
 293    ;
 294    query:
 295       | set_exp       { $1                }
 296       | set_exp error { $1                }
 297       | EOF           { raise End_of_file }
 298    ;
 299    attr:
 300       | path IS strs { $1, $3 }
 301       | path         { $1, [] }
 302    ;
 303    attrs:
 304       | attr SC attrs { $1 :: $3 }
 305       | attr          { [$1]     }
 306    ;
 307    group:
 308       LC attrs RC { $2 }
 309    ;
 310    groups:
 311       | group CM groups { $1 :: $3 }
 312       | group           { [$1]     }
 313    ;
 314    resource:
 315       | STR ATTR groups { ($1, $3) }
 316       | STR             { ($1, []) }
 317    ;
 318    resources:
 319       | resource SC resources { $1 :: $3 }
 320       | resource              { [$1]     }
 321       |                       { []       }
 322    ;
 323    result:
 324       | resources       { $1                }
 325       | resources error { $1                }
 326       | EOF             { raise End_of_file }