]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/ocaml/mathql_interpreter/mQueryTParser.mly
test branch
[helm.git] / helm / ocaml / mathql_interpreter / mQueryTParser.mly
diff --git a/helm/ocaml/mathql_interpreter/mQueryTParser.mly b/helm/ocaml/mathql_interpreter/mQueryTParser.mly
new file mode 100644 (file)
index 0000000..2f88961
--- /dev/null
@@ -0,0 +1,314 @@
+/* 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 }