]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/ocaml/mathql_interpreter/mQueryTParser.mly
first version
[helm.git] / helm / ocaml / mathql_interpreter / mQueryTParser.mly
index 313636c80d13327489bf4c8ade0da24f500496ef..1025cf3167b1e578e4eb7b897de6b0b293fe9d2f 100644 (file)
 
 %{
    module M = MathQL
+   module L = MQILib
+
+   let make_fun p pl xl = 
+      L.check_arity p (List.length pl) (List.length xl); 
+      M.Fun p pl xl
 
    let analyze x =
       let rec join l1 l2 = match l1, l2 with
          | []  -> []
         | 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]
+      let rec an_set = function
+         | M.Const _
+         | 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.Fun _ _ l                  -> iter an_set l
         | 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 
+           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_val v
+      and fg (_, v) = an_set v
       and an_grp = function
          | M.Attr g -> iter (iter fg) g
         | M.From _ -> [] 
       in
-      an_val x
+      an_set 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    LB RB SL IS LC RC CM SC LP RP AT PC 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 
+   %token    SUP SUPER THEN TRUE UNION WHERE XOR
+   %nonassoc IN SUP INF ELSE LOG STAT KEEP 
    %left     DIFF   
    %left     UNION
    %left     INTER
    %left     AND
    %nonassoc NOT 
    %nonassoc SUB MEET EQ LT LE
-   %nonassoc SUBJ OF PROJ COUNT ALIGN
+   %nonassoc OF PROJ COUNT ALIGN
    
    %start    qstr query result
    %type     <string>        qstr      
    avar:
       | AT ID { $2 }
    ;
-   vvar:
-      | DL ID { $2 }
-   ;
    strs:
       | STR CM strs { $1 :: $3 }
       | STR         { [$1]     } 
       | STR            { [$1]     } 
    ;
    path:
-      | subpath    { $1 }
       | SL subpath { $2 }
       | SL         { [] }
    ;   
       | inv ref path { $1, $2, $3 } 
    ;
    cons:
-      | path IN val_exp    { (false, $1, $3) }
-      | path MATCH val_exp { (true, $1, $3)  }
+      | path IN set_exp    { (false, $1, $3) }
+      | path MATCH set_exp { (true, $1, $3)  }
    ;
    conss:
       | cons CM conss { $1 :: $3 }
       | PAT { true  }
       |     { false }
    ;
-   opt_path:
-      | path { Some $1 }
-      |      { None    }
-   ;
    ass:
-      | val_exp AS path { ($3, $1) }
+      | set_exp AS path { ($3, $1) }
    ;
    asss:
       | ass CM asss { $1 :: $3 }
       |       { 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 }
+      | BUT { "allbut" }
+      |     { "these"  }
    ;   
    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 }
+      | SOURCE { "source" }
+      |        { "result" }
    ;
    xml:
-      |    { false}
+      | { "text" }
    ;
    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     }
+      | FALSE
+         { make_fun ["false"] [] [] }
+      | TRUE
+         { make_fun ["true"] [] [] }
+      | STR 
+         { M.Const [$1, []] }
+      | LB resources RB 
+         { M.Const $2 }
+      | avar FS path
+         { M.Dot $1 $3 }
+      | LC sets RC
+         { make_fun ["union"] [] $2 }
+      | LC RC
+         { make_fun ["union"] [] [] }
+      | LP set_exp RP
+         { $2 }
+      | STAT set_exp
+         { make_fun ["stat"] [] [$2] }
+      | EX set_exp
+         { M.Ex (analyze $2) $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 ["false"] [] [] }
+      | svar
+         { M.SVar $1 }
+      | avar
+         { M.AVar $1 }
+      | LET svar BE set_exp IN set_exp
+         { M.Let $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     
+      | ADD distr grp_exp IN set_exp
+         { M.Add $2 $3 $5 }
+      | IF set_exp THEN set_exp ELSE set_exp
+         { make_fun ["diff"] [] [$2; $4; $6] }
+      | PROP qualif mainc istrue isfalse attrc OF pattern set_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              }
+      | LOG xml source set_exp
+         { make_fun ["log"; $2; $3] [] [$4] }
+      | KEEP allbut paths IN set_exp
+         { make_fun ["keep"; $2] $3 [$5] } 
+      | KEEP allbut set_exp
+         { make_fun ["keep"; $2] [] [$3] } 
+      | SELECT avar FROM set_exp WHERE set_exp
+         { M.Select $2 $4 $6 }
+      | path LC paths RC LC sets RC
+         { make_fun $1 $3 $6 }
+      | path LC sets RC
+         { make_fun $1 [] $3 }    
+      | path LC RC
+         { make_fun $1 [] [] }
+      | 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] }
+   ;   
+   sets:
+      | set_exp CM sets { $1 :: $3 }
+      | set_exp         { [$1]     }
    ;
    query:
       | set_exp       { $1                }
       |                       { []       }
    ;   
    result:
-      | resources { $1                }
-      | EOF       { raise End_of_file }
+      | resources       { $1                }
+      | resources error { $1                }
+      | EOF             { raise End_of_file }