]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/ocaml/mathql_interpreter/mQueryTParser.mly
functor added
[helm.git] / helm / ocaml / mathql_interpreter / mQueryTParser.mly
index 313636c80d13327489bf4c8ade0da24f500496ef..54f8f837ccd0af63ff950cfdd7babb02d7ffbbea 100644 (file)
 
 %{
    module M = MathQL
+   module I = M.I
+   module U = AvsUtil
+   module L = MQILib
+
+   let make_fun p pl xl = 
+      L.fun_arity p (List.length pl) (List.length xl); 
+      M.Fun (p, pl, xl)
+
+   let make_gen p xl = 
+      L.gen_arity p (List.length xl); 
+      M.Gen (p, 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]
-         | 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 
+      let rec an_set = function
+         | M.Const x                              -> iter fv x
+         | 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.While (_, x, y)                      -> iter an_set [x; y]
+        | M.Fun (_, _, l)                        -> iter an_set l
+        | M.Gen (_, l)                           -> iter an_set l
+        | M.Add (_, g, x)                        -> join (an_grp g) (an_set x)
+         | M.Property (_, _, _, _, c, d, _, _, x) -> 
+           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 _ -> [] 
+        | M.From _ -> []
+      and fv (_, g) = iter (iter fg) g 
       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    <string> SVAR AVAR STR
+   %token    LB RB SL LC RC CM SC LP RP 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    FALSE FOR FROM GEN IF IN INF INTER INV ISF IST KEEP LE LET LOG LT
+   %token    MAIN MATCH MEET NOT OF OR PAT PEEK PROJ PROP READ RENDER SELECT 
+   %token    SEQ SOURCE STAT SUB SUP SUPER THEN TRUE UNION WHERE WHILE XOR
+
+   %nonassoc SOURCE
+   %right    IN SEQ
+   %nonassoc SUP INF ELSE LOG STAT KEEP RENDER PEEK READ
    %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      
       | STR qstr { $1 ^ $2 }
    ;
    svar:
-      | PC ID { $2 }
+      | SVAR { $1 }
    ;
    avar:
-      | AT ID { $2 }
-   ;
-   vvar:
-      | DL ID { $2 }
+      | AVAR { $1 }
    ;
    strs:
       | STR CM strs { $1 :: $3 }
       | STR            { [$1]     } 
    ;
    path:
-      | subpath    { $1 }
       | SL subpath { $2 }
-      | SL         { [] }
+/*    | subpath    { $1 }
+*/    | SL         { [] }
    ;   
+   ppaths:
+      | path CM ppaths { $1 :: $3 }
+      | path           { [$1]     }
+   ;
    paths:
-      | path CM paths { $1 :: $3 }
-      | path          { [$1]     }
+      | ppaths { $1 }
+      |        { [] }
+   ;
    inv:
       | INV { true  }
       |     { false }
       | 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) }
-   ;
-   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 }
+      | 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]     }
+      | x_groups { M.Attr $1 }
+      | avar     { M.From $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              }
+      | STAT set_exp                  { make_fun ["stat"] [] [$2] }
+      | RENDER set_exp                { make_fun ["render"] [] [$2] }
+      | READ set_exp                  { make_fun ["read"] [] [$2] }
+      | FALSE                         { make_fun ["false"] [] [] }
+      | TRUE                          { make_fun ["true"] [] [] }
+      | LC sets RC                    { make_fun ["union"] [] $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 ["empty"] [] [] }
+      | LOG xml source set_exp        { make_fun ["log"; $2; $3] [] [$4] }
+      | KEEP allbut ppaths IN set_exp { make_fun ["keep"; $2] $3 [$5] } 
+      | KEEP allbut set_exp           { make_fun ["keep"; $2] [] [$3] } 
+      | path LC paths RC LC sets RC   { make_fun $1 $3 $6 }
+      | 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] }
+      | PEEK set_exp                  { make_fun ["peek"] [] [$2] }
+      | IF set_exp THEN set_exp ELSE set_exp 
+         { make_fun ["if"] [] [$2; $4; $6] }
+      | STR                            { M.Const [$1, []] }
+      | LB x_resources RB              { M.Const $2 }
+      | avar FS path                   { M.Dot ($1, $3) }
+      | LP set_exp RP                  { $2 }
+      | EX set_exp                     { M.Ex (analyze $2, $2) }
+      | svar                           { M.SVar $1 }
+      | avar                           { M.AVar $1 }
+      | LET svar BE set_exp IN set_exp { M.Let (Some $2, $4, $6) }
+      | set_exp SEQ set_exp            { M.Let (None, $1, $3) }
+      | FOR avar IN set_exp gen_op     { M.For (fst $5, $2, $4, snd $5) }
+      | WHILE set_exp gen_op           { M.While (fst $3, $2, snd $3) }
+      | ADD distr grp_exp IN set_exp   { M.Add ($2, $3, $5) }
+      | PROP qualif mainc istrue isfalse attrc OF pattern set_exp     
+         { M.Property (f $2, s $2, t $2, $3, $4, $5, $6, $8, $9) }
+      | SELECT avar FROM set_exp WHERE set_exp { M.Select ($2, $4, $6) }
+      | GEN path LC sets RC { make_gen $2 $4 }
+      | GEN path IN set_exp { make_gen $2 [$4] }
+   ;   
+   psets:
+      | set_exp CM psets { $1 :: $3 }
+      | set_exp          { [$1]     }
+   ;
+   sets:
+      | psets { $1 }
+      |       { [] }
    ;
    query:
       | set_exp       { $1                }
       | set_exp error { $1                }
       | EOF           { raise End_of_file }
    ;
+   
+   x_attr:
+      | path BE set_exp { ($1, $3)                       }
+      | path            { ($1, make_fun ["empty"] [] []) }
+   ;
+   x_attrs:
+      | x_attr SC x_attrs { $1 :: $3 }
+      | x_attr            { [$1]     }
+   ;
+   x_group:
+      LC x_attrs RC { $2 }
+   ;
+   x_groups:
+      | x_group CM x_groups { $1 :: $3 }
+      | x_group             { [$1]     }
+   ;
+   x_resource:
+      | STR ATTR x_groups { ($1, $3) }
+      | STR               { ($1, []) }
+   ;
+   x_resources:
+      | x_resource SC x_resources { $1 :: $3 }
+      | x_resource                { [$1]     }
+      |                           { []       }
+   ;   
+   
    attr:
-      | path IS strs { $1, $3 }
-      | path         { $1, [] }
+      | path BE strs { U.grp_make_x $1 $3 }
+      | path         { U.grp_make_x $1 [] }
    ;
    attrs:
-      | attr SC attrs { $1 :: $3 }
-      | attr          { [$1]     }
+      | attr SC attrs { I.grp_union $1 $3 }
+      | attr          { $1                }
    ;
    group:
       LC attrs RC { $2 }
       | group           { [$1]     }
    ;
    resource:
-      | STR ATTR groups { ($1, $3) }
-      | STR             { ($1, []) }
+      | STR ATTR groups { U.make_x $1 $3 }
+      | STR             { U.make_x $1 [] }
    ;
    resources:
-      | resource SC resources { $1 :: $3 }
-      | resource              { [$1]     }
-      |                       { []       }
+      | resource SC resources { I.union $1 $3 }
+      | resource              { $1            }
+      |                       { U.val_false   }
    ;   
    result:
-      | resources { $1                }
-      | EOF       { raise End_of_file }
+      | resources       { $1                }
+      | resources error { $1                }
+      | EOF             { raise End_of_file }