simplesqllex.mll

   1 {
   2 open Simplesqlparse
   3 ;;
   4
   5 let rec undq s =
   6   try
   7     let i = String.index s '\'' in
   8     let () = assert (s.[i+1] = '\'') in
   9     (String.sub s 0 (i+1)) ^
  10     (undq
  11        (String.sub s (i+2)
  12           ((String.length s) - (i+2))
  13        )
  14     )
  15   with
  16     Not_found -> s
  17 ;;
  18
  19 let string_of_sqltoken t =
  20   match t with
  21     Ident s -> Printf.sprintf "Ident(%S)" s
  22   | Str s -> Printf.sprintf "Str(%S)" s
  23   | Num s -> Printf.sprintf "Num(%S)" s
  24   | LParen -> "LParen"
  25   | RParen -> "RParen"
  26   | Comma  -> "Comma"
  27   | Sep    -> "Sep"
  28   | Eof    -> "Eof"
  29   | Create -> "Create"
  30   | Table -> "Table"
  31   | Insert -> "Insert"
  32   | Into -> "Into"
  33   | Values -> "Values"
  34 ;;
  35
  36 let kwht = Hashtbl.create 29
  37 ;;
  38
  39 List.iter
  40   (fun (text, kw) ->
  41      Hashtbl.add kwht (String.uppercase text) kw
  42   )
  43   [ ("create", Create )
  44   ; ("table",  Table  )
  45   ; ("insert", Insert )
  46   ; ("into",   Into   )
  47   ; ("values", Values )
  48   ]
  49 ;;
  50
  51 let kw_or_ident text =
  52   try Hashtbl.find kwht (String.uppercase text)
  53   with Not_found -> Ident text
  54 ;;
  55
  56 }
  57
  58
  59 let ident_head = ['A'-'Z' 'a'-'z' '_']
  60 let dig = ['0'-'9']
  61 let ident_body = ident_head | dig | ['.' '#' '$']
  62 let eol = [ '\n' '\r' ]
  63 let no_eol = [^ '\n' '\r' ]
  64 let spc = [ ' ' '\t' ]
  65 let eol_eof = eol | eof
  66
  67
  68 rule sqltoken = parse
  69   eof                            { Eof }
  70 | (ident_head ident_body*) as i  { kw_or_ident i }
  71 | '"'                            { Ident (dblquoted lexbuf) }
  72 | '\''                           { Str (singlequoted lexbuf) }
  73 | ( spc*
  74     (
  75      ( (['-' '+'] | spc*)?
  76        ( ( dig+ (('.' dig*)?) )
  77        | ('.' dig+)
  78        )
  79      ) as n
  80     )
  81   )                         { Num n }
  82 | spc* eol+ spc* '/' spc* eol+   { Sep }
  83 | ( spc | eol )+                 { sqltoken lexbuf }
  84 | '(' { LParen }
  85 | ')' { RParen }
  86 | ',' { Comma }
  87 | (';' spc*)+ { Sep }
  88 | "--" no_eol* eol_eof  { sqltoken lexbuf }
  89
  90  and dblquoted = parse
  91   ([^ '"']* as i) '"'   { i }
  92 | _  { failwith "double-quoted string not terminated" }
  93
  94  and singlequoted = parse
  95   ( ( ( [^ '\'']* )
  96       ( ( "''" [^ '\'']* )* )
  97     ) as i) '\''  { undq i }
  98 | _  { failwith "single-quoted string not terminated" }