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   | Ignore_token -> Printf.sprintf "Ignore_token"
  35 ;;
  36
  37 let kwht = Hashtbl.create 29
  38 ;;
  39
  40 List.iter
  41   (fun (text, kw) ->
  42      Hashtbl.add kwht (String.uppercase text) kw
  43   )
  44   [ ("create", Create )
  45   ; ("table",  Table  )
  46   ; ("insert", Insert )
  47   ; ("into",   Into   )
  48   ; ("values", Values )
  49   ; ("commit", Ignore_token)
  50   ]
  51 ;;
  52
  53 let kw_or_ident text =
  54   try Hashtbl.find kwht (String.uppercase text)
  55   with Not_found -> Ident text
  56 ;;
  57
  58 }
  59
  60
  61 let ident_head = ['A'-'Z' 'a'-'z' '_']
  62 let dig = ['0'-'9']
  63 let ident_body = ident_head | dig | ['.' '#' '$']
  64 let eol = [ '\n' '\r' ]
  65 let no_eol = [^ '\n' '\r' ]
  66 let spc = [ ' ' '\t' ]
  67 let eol_eof = eol | eof
  68
  69
  70 rule sqltoken = parse
  71   eof                            { Eof }
  72 | (ident_head ident_body*) as i  { kw_or_ident i }
  73 | '"'                            { Ident (dblquoted lexbuf) }
  74 | '\''                           { Str (singlequoted lexbuf) }
  75 | ( spc*
  76     (
  77      ( (['-' '+'] | spc*)?
  78        ( ( dig+ (('.' dig*)?) )
  79        | ('.' dig+)
  80        )
  81      ) as n
  82     )
  83   )                         { Num n }
  84 | spc* eol+ spc* '/' spc* eol+   { Sep }
  85 | ( spc | eol )+                 { sqltoken lexbuf }
  86 | '(' { LParen }
  87 | ')' { RParen }
  88 | ',' { Comma }
  89 | (';' spc*)+ { Sep }
  90 | "--" no_eol* eol_eof  { sqltoken lexbuf }
  91
  92  and dblquoted = parse
  93   ([^ '"']* as i) '"'   { i }
  94 | _  { failwith "double-quoted string not terminated" }
  95
  96  and singlequoted = parse
  97   ( ( ( [^ '\'']* )
  98       ( ( "''" [^ '\'']* )* )
  99     ) as i) '\''  { undq i }
 100 | _  { failwith "single-quoted string not terminated" }