trunk/query/query_parse.ml

open Location
open Ast
open Ident
open Printf

open Parser.Hook
open Query
#load "pa_extend.cmo";;


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)

let cst_nil =  Const Sequence.nil_cst
let parse_ident = U.mk

let id_dummy = U.mk "$$$"

let label = parse_ident

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

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

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

EXTEND 
  GLOBAL: expr pat keyword;


  expr: [
    "top" RIGHTA[
     "select"; e = expr;
     "from";l = LIST1 [ x= pat ; "in"; e = expr -> (x,e)] SEP "," ;
       z=OPT[ "where"  ; w = cond -> w]  -> 
        let (condi,fin) =
          match z with
              Some w -> 
                (w, exp loc 
                   (Parser.if_then_else (Query.ast_of_bool(w,tloc loc)) 
                      (Pair (e,cst_nil)) 
                      cst_nil))
            | None -> (True, exp loc (Pair(e,cst_nil)))
        in 
        if !Query.nooptim 
        then Query.select(tloc loc,fin,l)
        else Query.selectOpt(tloc loc,Pair (e,cst_nil),l,condi)
    ]];
   
  cond:
      [ [ 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)
       |"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
      ]
    ];


  keyword: [ [ a = [ "select" | "from" ] -> a ] ];
END


1	open Location
2	open Ast
3	open Ident
4	open Printf
5
6	open Parser.Hook
7	open Query
8	#load "pa_extend.cmo";;
9
10
11	let tloc (i,j) = (i.Lexing.pos_cnum,j.Lexing.pos_cnum)
12	let mk loc x = Location.mk (tloc loc) x
13
14	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	let label = parse_ident
22
23	let rec multi_prod loc = function
24	\| [ x ] -> x
25	\| x :: l -> mk loc (Prod (x, multi_prod loc l))
26	\| [] -> assert false
27
28	let if_then_else cond e1 e2 = Match (cond, [pat_true,e1; pat_false,e2])
29
30	let op2 op e1 e2 = Apply (Apply (Var (U.mk op), e1), e2)
31
32	EXTEND
33	GLOBAL: expr pat keyword;
34
35
36	expr: [
37	"top" RIGHTA[
38	"select"; e = expr;
39	"from";l = LIST1 [ x= pat ; "in"; e = expr -> (x,e)] SEP "," ;
40	z=OPT[ "where" ; w = cond -> w] ->
41	let (condi,fin) =
42	match z with
43	Some w ->
44	(w, exp loc
45	(Parser.if_then_else (Query.ast_of_bool(w,tloc loc))
46	(Pair (e,cst_nil))
47	cst_nil))
48	\| None -> (True, exp loc (Pair(e,cst_nil)))
49	in
50	if !Query.nooptim
51	then Query.select(tloc loc,fin,l)
52	else Query.selectOpt(tloc loc,Pair (e,cst_nil),l,condi)
53	]];
54
55	cond:
56	[ [ a = expr ->
57	(match a with
58	\| LocatedExpr(_, Atom at) ->
59	(match U.get_str at with
60	\| "true" -> Query.True
61	\| "false" -> Query.False
62	\| _ -> Query.Varb a)
63	\| _ -> Query.Varb a)
64	\|"not"; a = cond -> Query.Not(a)
65	\| a = cond ; "or" ; b = cond -> Query.Ou(a,b)
66	\| a = cond ; "and" ; b = cond -> Query.Et(a,b)
67	\| "(" ; a=cond ; ")" -> a
68	]
69	];
70
71
72	keyword: [ [ a = [ "select" \| "from" ] -> a ] ];
73	END
74
75
76
77