main.ml

   1 (**
   2   Main
   3 *)
   4
   5 open Printf
   6 open Operators
   7 open ListMore
   8 open ExtString
   9 open Apply
  10
  11 module L = List
  12 module S = String
  13
  14 let repeat f x k =
  15   let rec loop () =
  16     match f x with
  17     | Some z -> k z
  18     | None -> ()
  19   in
  20   loop ()
  21
  22 let parse_one (stmt,props) =
  23   try
  24 (*     print_endline stmt; *)
  25     let (s,p,k) = Parser.parse_stmt stmt in
  26     if not (RA.Schema.is_unique s) then
  27     begin
  28       Error.log "Error: this SQL statement will produce rowset with duplicate column names:\n%s\n" stmt
  29     end;
  30     (* fill VALUES *)
  31     let (stmt,p) = match k with
  32     | Stmt.Insert (Some s,_) ->
  33       let module B = Buffer in
  34       let b = B.create 100 in
  35       B.add_string b stmt;
  36       B.add_string b " (";
  37       let params = ref [] in
  38       s >> List.iter (fun attr ->
  39         if !params <> [] then B.add_string b ",";
  40         let name = "@" ^ attr.RA.name in
  41         let param = ((Some attr.RA.name,(B.length b,B.length b + String.length name)),Some attr.RA.domain) in
  42         B.add_string b name;
  43         params := param :: !params
  44       );
  45       B.add_string b ")";
  46       (B.contents b, p @ (List.rev !params))
  47     | _ -> (stmt,p)
  48     in
  49     Some {Stmt.schema=s; params=p; kind=k; props=Props.set props "sql" stmt}
  50   with
  51   | exn ->
  52     begin
  53       Error.log "==> %s" stmt;
  54       None
  55     end
  56
  57 let get_statements ch =
  58   let lexbuf = Lexing.from_channel ch in
  59   let f () = try Sql_lexer.ruleStatement Props.empty lexbuf with exn -> None in
  60   let rec next () =
  61     match f () with
  62     | None -> raise Enum.No_more_elements
  63     | Some sql ->
  64       begin match parse_one sql with
  65       | None -> next ()
  66       | Some stmt -> stmt
  67       end
  68   in
  69   Enum.from next
  70
  71 let with_file filename f =
  72   match catch Std.input_file filename with
  73   | None -> Error.log "cannot open file : %s" filename
  74   | Some s -> f s
  75
  76 let with_channel filename f =
  77   match catch open_in filename with
  78   | None -> Error.log "cannot open file : %s" filename
  79   | Some ch -> Std.finally (fun () -> close_in_noerr ch) f ch
  80