/* 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
   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
         | [], _                           -> 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_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.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_set v
      and an_grp = function
         | M.Attr g -> iter (iter fg) g
	 | M.From _ -> [] 
      in
      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    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    SUP SUPER THEN TRUE UNION WHERE XOR
   %nonassoc IN SUP INF ELSE LOG STAT KEEP 
   %left     DIFF   
   %left     UNION
   %left     INTER
   %nonassoc WHERE EX
   %left     XOR OR
   %left     AND
   %nonassoc NOT 
   %nonassoc SUB MEET EQ LT LE
   %nonassoc 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 }
   ;
   strs:
      | STR CM strs { $1 :: $3 }
      | STR         { [$1]     } 
   ;
   subpath:
      | STR SL subpath { $1 :: $3 }
      | STR            { [$1]     } 
   ;
   path:
      | 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 set_exp    { (false, $1, $3) }
      | path MATCH set_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 }
   ;
   ass:
      | set_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 { "allbut" }
      |     { "these"  }
   ;   
   gen_op:
      | SUP set_exp { M.GenFJoin, $2 }
      | INF set_exp { M.GenFMeet, $2 }
   ;   
   source:
      | SOURCE { "source" }
      |        { "result" }
   ;
   xml:
      | { "text" }
   ;
   grp_exp:
      | assg { M.Attr $1 }
      | avar { M.From $1 }
   ;
   set_exp:
      | 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 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
         { 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                }
      | 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                }
      | resources error { $1                }
      | EOF             { raise End_of_file }