]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/ocaml/mathql/mQueryTParser.mly
- the mathql interpreter is not helm-dependent any more
[helm.git] / helm / ocaml / mathql / mQueryTParser.mly
index 7bc2f97bf2162389d5433e8942b6333c5b9d2e1a..313636c80d13327489bf4c8ade0da24f500496ef 100644 (file)
  * http://cs.unibo.it/helm/.
  */
 
-/******************************************************************************/
-/*                                                                            */
-/*                               PROJECT HELM                                 */
-/*                                                                            */
-/*                     Ferruccio Guidi <fguidi@cs.unibo.it>                   */
-/*                                 23/05/2002                                 */
-/*                                                                            */
-/*                                                                            */
-/******************************************************************************/
+/*  AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
+ */ 
 
 %{
+   module M = MathQL
+
    let analyze x =
-      let module M = MathQL in
       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 :: _ 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.Const _                -> []
-         | M.VVar _                 -> []
-         | M.Record (rv, _)         -> [rv]
-         | M.Fun (_, x)             -> an_val x
-         | M.Attribute (_, _, _, x) -> an_val x
-         | M.RefOf x                -> an_set x
-      and an_boole = function
-         | M.False       -> []
-         | M.True        -> []
-         | M.Ex _        -> []
-         | M.Not x       -> an_boole x
-         | M.And (x, y)  -> join (an_boole x) (an_boole y)
-         | M.Or (x, y)   -> join (an_boole x) (an_boole y)
-         | M.Sub (x, y)  -> join (an_val x) (an_val y)
-         | M.Meet (x, y) -> join (an_val x) (an_val y)
-         | M.Eq (x, y)   -> join (an_val x) (an_val y)
+        | 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.SVar _                   -> []
-         | M.RVar _                   -> []
-         | M.Relation (_, _, _, x, _) -> an_set x
-         | M.Pattern x                -> an_val x
-         | M.Ref x                    -> an_val x
-         | M.Union (x, y)             -> join (an_set x) (an_set y)
-         | M.Intersect (x, y)         -> join (an_set x) (an_set y)
-         | M.Diff (x, y)              -> join (an_set x) (an_set y)
-         | M.LetSVar (_, x, y)        -> join (an_set x) (an_set y)
-         | M.LetVVar (_, x, y)        -> join (an_val x) (an_set y)
-         | M.Select (_, x, y)         -> join (an_set x) (an_boole y)
+        | 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_boole x
+      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    AND ATTR ATTRIB BE DIFF EQ EX FALSE FUN IN INTER INV LET MEET NOT
-   %token    OR PAT REF REFOF REL SELECT SUB SUPER TRUE UNION WHERE
-   %left     DIFF WHERE REFOF  
-   %left     OR UNION
-   %left     AND INTER
-   %nonassoc REL
-   %nonassoc NOT EX IN ATTR
-
+   %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
    svar:
       | PC ID { $2 }
    ;
-   rvar:
+   avar:
       | AT ID { $2 }
    ;
    vvar:
       | STR            { [$1]     } 
    ;
    path:
-      | STR SL subpath { ($1, $3) }
-      | STR            { ($1, []) }
+      | subpath    { $1 }
+      | SL subpath { $2 }
+      | SL         { [] }
    ;   
+   paths:
+      | path CM paths { $1 :: $3 }
+      | path          { [$1]     }
    inv:
       | INV { true  }
       |     { false }
    ;
    ref:
-      | SUB   { MathQL.RefineSub   }
-      | SUPER { MathQL.RefineSuper }
-      |       { MathQL.RefineExact }
+      | 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:
-      | STR                         { MathQL.Const [$1]                 } 
-      | FUN STR val_exp             { MathQL.Fun ($2, $3)               }
-      | ATTRIB inv ref path val_exp { MathQL.Attribute ($2, $3, $4, $5) }
-      | rvar FS path                { MathQL.Record ($1, $3)            }
-      | vvar                        { MathQL.VVar $1                    }
-      | LC strs RC                  { MathQL.Const $2                   }
-      | LC RC                       { MathQL.Const []                   }
-      | REFOF set_exp               { MathQL.RefOf $2                   }
-      | LP val_exp RP               { $2                                }
-   ;
-   boole_exp:
-      | TRUE                    { MathQL.True               }
-      | FALSE                   { MathQL.False              }
-      | LP boole_exp RP         { $2                        }
-      | NOT boole_exp           { MathQL.Not $2             }
-      | EX boole_exp            { MathQL.Ex (analyze $2) $2 }
-      | val_exp SUB val_exp     { MathQL.Sub ($1, $3)       }
-      | val_exp MEET val_exp    { MathQL.Meet ($1, $3)      }
-      | val_exp EQ val_exp      { MathQL.Eq ($1, $3)        }
-      | boole_exp AND boole_exp { MathQL.And ($1, $3)       }
-      | boole_exp OR boole_exp  { MathQL.Or ($1, $3)        }
+      | 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:
-      | REF val_exp                            { MathQL.Ref $2                    }
-      | PAT val_exp                            { MathQL.Pattern $2                } 
-      | LP set_exp RP                          { $2                               }
-      | SELECT rvar IN set_exp WHERE boole_exp { MathQL.Select ($2, $4, $6)       }
-      | REL inv ref path set_exp ATTR strs     { MathQL.Relation ($2, $3, $4, $5, $7) }
-      | REL inv ref path set_exp               { MathQL.Relation ($2, $3, $4, $5, []) }
-      | svar                                   { MathQL.SVar $1                   }
-      | rvar                                   { MathQL.RVar $1                   }
-      | set_exp UNION set_exp                  { MathQL.Union ($1, $3)            }
-      | set_exp INTER set_exp                  { MathQL.Intersect ($1, $3)        }
-      | set_exp DIFF set_exp                   { MathQL.Diff ($1, $3)             }
-      | LET svar BE set_exp IN set_exp         { MathQL.LetSVar ($2, $4, $6)      }      
-      | LET vvar BE val_exp IN set_exp         { MathQL.LetVVar ($2, $4, $6)      }      
+      | 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 EOF { $1 }
+      | set_exp       { $1                }
+      | set_exp error { $1                }
+      | EOF           { raise End_of_file }
    ;
    attr:
-      | path IS strs { ($1, $3) }
-      | path         { ($1, []) }
+      | path IS strs { $1, $3 }
+      | path         { $1, [] }
    ;
    attrs:
       | attr SC attrs { $1 :: $3 }
       |                       { []       }
    ;   
    result:
-      | resources EOF { $1 }
+      | resources { $1                }
+      | EOF       { raise End_of_file }