plugin for sql
[afterthought.git] / aft_lexer.mll
1 {
2   open Aft_parser
3   open Xpath_ext
4   open Parsing
5   open Printf
6   open Lexing
7
8   let cut_at_ws s c =
9     let l = String.length s in
10     let rec aux i =
11       if i = l then s 
12       else match s.[i] with
13         | ' ' | '\t' | '\r' | '\n' -> String.sub s 0 i
14         | z when z=c -> String.sub s 0 i
15         | _ -> aux (succ i)
16     in
17     aux 0
18 }
19
20 let letter = ['a'-'z''A'-'Z']
21
22 let ascii_digit = ['0'-'9']
23 let digit = ascii_digit
24
25 let ncnamechar = letter | digit | '.' | '-' | '_' 
26
27 let ncname = ( letter | '_' ) ncnamechar*
28
29 let qname = (ncname ':')? ncname
30
31 let ws = [ ' ' '\t' '\r' '\n' ]
32
33 let nl = '\n'
34 let number = ascii_digit+ ('.' (ascii_digit+)?)?
35
36 let literal = ('"' [^ '"']* '"') | ('\'' [^ '\'']* '\'')
37
38 rule token_after_not_op = parse
39   | '*'    { MUL }
40   | ncname { 
41       match Lexing.lexeme lexbuf with
42         | "and" -> AND
43         | "or"  -> OR
44         | "mod" -> MOD
45         | "div" -> DIV
46         | s -> failwith ("Unknown operator "^s)
47     }
48     | nl     { new_line lexbuf; token_after_not_op lexbuf }
49   | ws     { token_after_not_op lexbuf }
50   | ""     { token lexbuf }
51
52 and token = parse
53   | ncname ws* "::" { 
54       let s = Lexing.lexeme lexbuf in
55       let s = cut_at_ws s ':' in
56       AXIS s
57     }
58
59   | qname ws* '(' {
60       let s = Lexing.lexeme lexbuf in
61       let s = cut_at_ws s '(' in
62       match s with
63         | "comment" | "text" | "processing-instruction" | "node" -> NODE_TYPE s
64         | _ -> FUNCTION_NAME s
65     }
66       
67
68   | "//"   { DOUBLESLASH }
69   | '/'    { SLASH }
70  
71   | '}'    { RBRACE }
72   | '{'    { LBRACE }
73   | "->"   { POINT }
74
75   | ')'    { RPAREN }
76   | '('    { LPAREN }
77
78   | '['    { LBRACKET }
79   | ']'    { RBRACKET }
80
81
82   | ".."   { DOUBLEDOT }
83   | '.'    { DOT }
84
85   | '@'    { AT }
86   | ','    { COMMA }
87   | '|'    { PIPE }
88   (*| "||"    { DOUBLEPIPE }*)
89   | '='    { EQUAL }
90   | "!="   { NOTEQUAL }
91   | '<'    { LT }
92   | '>'    { GT }
93   | "<="   { LTE }
94   | ">="   { GTE }
95   | '+'    { PLUS }
96   | '-'    { MINUS }
97
98   | '$' qname { 
99       let s = Lexing.lexeme lexbuf in
100       let s = String.sub s 1 (String.length s - 1) in
101       VAR s
102     }
103
104  | '*' | (ncname ":*") | qname  { NAME_TEST (Lexing.lexeme lexbuf) }
105
106  | literal   {  
107      let s = Lexing.lexeme lexbuf in
108      let s = String.sub s 1 (String.length s - 2) in
109      LITERAL s 
110    }
111
112  | number    { NUMBER (float_of_string (Lexing.lexeme lexbuf)) }
113  | nl        { new_line lexbuf; token lexbuf }
114  | ws        { token lexbuf }
115  | eof       { EOF }
116
117 {
118   let make_lexer () =
119     let previous_op = ref true in
120     fun lexbuf ->
121       let tok = 
122         if !previous_op then token lexbuf 
123         else token_after_not_op lexbuf in
124       (match tok with
125          | AT | AXIS _ | FUNCTION_NAME _ | NODE_TYPE _ | LBRACKET | LPAREN
126          | AND | OR | MOD | DIV | MUL | SLASH | DOUBLESLASH
127          | PIPE | PLUS | MINUS | EQUAL | NOTEQUAL | LT | GT | LTE | GTE 
128              -> previous_op := true
129          | _ -> previous_op := false
130       );
131       tok
132
133   let parse_expr x =    
134     let lexbuf = Lexing.from_string x in
135     let lexer  = make_lexer () in
136     let result = Aft_parser.aft_pattern_match lexer lexbuf in
137         result
138
139   let parse_from_channel x = 
140     let lexbuf = Lexing.from_channel x in
141     let lexer = make_lexer () in
142     let result = 
143         try 
144             Aft_parser.access_spec lexer lexbuf 
145         with Parse_error ->
146             printf "Error at line %d char %d.\n" (lexbuf.lex_curr_p.pos_lnum)
147                 (lexbuf.lex_curr_p.pos_cnum);
148             raise Parse_error
149         in
150             result
151 }