query_parse.ml 1.71 KB
Newer Older
1 2 3 4
open Location
open Ast
open Ident
open Printf
5

6 7
open Parser.Hook
open Query
8 9 10
#load "pa_extend.cmo";;


11 12 13 14
let tloc (i,j) = (i.Lexing.pos_cnum,j.Lexing.pos_cnum)
let mk loc x = Location.mk (tloc loc) x

let exp pos e = LocatedExpr (loc_of_pos (tloc pos),e)
15

16
let cst_nil =  Const Sequence.nil_cst
17
let parse_ident = U.mk
18

19
let id_dummy = U.mk "$$$"
20 21 22 23 24 25 26

let label = parse_ident

let rec multi_prod loc = function
  | [ x ] -> x
  | x :: l -> mk loc (Prod (x, multi_prod loc l))
  | [] -> assert false
27 28 29

let if_then_else cond e1 e2 = Match (cond, [pat_true,e1; pat_false,e2])

30 31
let op2 op e1 e2 = Apply (Apply (Var (U.mk op), e1), e2)

32
EXTEND 
33
  GLOBAL: expr pat keyword;
34 35 36


  expr: [
37
    "top" RIGHTA[
38 39
     "select"; e = expr;
     "from";l = LIST1 [ x= pat ; "in"; e = expr -> (x,e)] SEP "," ;
40
       z=OPT[ "where"  ; w = cond -> w]  -> 
41 42 43 44
	let (condi,fin) =
	  match z with
              Some w -> 
                (w, exp loc 
45
		   (Parser.if_then_else (Query.ast_of_bool(w,tloc loc)) 
46 47 48 49 50
		      (Pair (e,cst_nil)) 
		      cst_nil))
            | None -> (True, exp loc (Pair(e,cst_nil)))
	in 
	if !Query.nooptim 
51 52
        then Query.select(tloc loc,fin,l)
      	else Query.selectOpt(tloc loc,Pair (e,cst_nil),l,condi)
53
    ]];
54
   
55
  cond:
56 57 58 59 60 61 62 63
      [ [ a = expr -> 
	  (match a with
             | LocatedExpr(_, Atom at) ->
	         (match U.get_str at with
                  | "true" -> Query.True
                  | "false" -> Query.False
                  | _ -> Query.Varb a)
             | _ -> Query.Varb a)
64 65 66 67 68 69 70
       |"not"; a = cond -> Query.Not(a)
       | a = cond ; "or" ; b = cond -> Query.Ou(a,b)
       | a = cond ; "and" ; b = cond -> Query.Et(a,b)
       | "(" ; a=cond ; ")" -> a
      ]
    ];

71

72
  keyword: [ [ a = [ "select" | "from" ] -> a ] ];
73 74 75 76 77
END