gen.ml

   1 (* C++ code generation *)
   2
   3 open Sql
   4 open Printf
   5 open ExtList
   6 open ExtString
   7 open Operators
   8
   9 module Cpp =
  10 struct
  11   type param = string * string
  12   type t = param list
  13
  14   let to_string x =
  15     String.concat ", " (List.map (fun (t,n) -> t ^ " " ^ n) x)
  16
  17   let inline x =
  18     String.concat ", " (List.map (fun (t,n) -> n) x)
  19 end
  20
  21 let (inc_indent,dec_indent,make_indent) =
  22   let v = ref 0 in
  23   (fun () -> v := !v + 2),
  24   (fun () -> v := !v - 2),
  25   (fun () -> String.make !v ' ')
  26
  27 let print_indent () = print_string (make_indent ())
  28 let indent s = print_indent (); print_string s
  29 let indent_endline s = print_indent (); print_endline s
  30 let empty_line () = print_newline ()
  31 let output fmt = Printf.kprintf indent_endline fmt
  32 let print fmt = Printf.kprintf print_endline fmt
  33 let quote_comment_inline = String.replace_chars (function '\n' -> "\n// " | c -> String.make 1 c)
  34 let comment fmt = Printf.kprintf (indent_endline & quote_comment_inline & (^) "// ") fmt
  35 let open_curly () = output "{"; inc_indent ()
  36 let close_curly fmt = dec_indent (); indent "}"; print fmt
  37 let start_struct name =
  38    output "struct %s" name;
  39    open_curly ()
  40 let end_struct name =
  41    close_curly "; // struct %s" name;
  42    empty_line ()
  43 let out_public () = dec_indent(); output "public:"; inc_indent()
  44 let out_private () = dec_indent(); output "private:"; inc_indent()
  45 let in_namespace name f =
  46   output "namespace %s" name;
  47   open_curly ();
  48   f ();
  49   close_curly " // namespace %s" name;
  50   empty_line ()
  51
  52 let generate_header () =
  53     output "// DO NOT EDIT MANUALLY";
  54     output "";
  55     output "// generated by sql2cpp";
  56     output "";
  57     output "#pragma once";
  58     output ""
  59
  60 (*
  61 let ns_name table = table.Table.cpp_name
  62 let item_name _ = "row"
  63 let prefix_name _ = ""
  64 *)
  65
  66 let set_column attr index =
  67   output "Traits::set_column_%s(stmt, %u, obj.%s);"
  68     (Type.to_string attr.RA.domain)
  69     index
  70     attr.RA.name
  71
  72 let get_column attr index =
  73   output "Traits::get_column_%s(stmt, %u, obj.%s);"
  74     (Type.to_string attr.RA.domain)
  75     index
  76     attr.RA.name
  77
  78 open Stmt.Raw
  79
  80 let set_param_code param index =
  81   let (id,t) = param in
  82   sprintf "Traits::set_param_%s(stmt, obj.%s, %u);"
  83     (Option.map_default Type.to_string "Any" t)
  84     (match id with
  85      | Next -> sprintf "_%u" index
  86      | Numbered x -> sprintf "_%u" x
  87      | Named s -> s)
  88     index
  89
  90 let output_scheme_binder index scheme =
  91   let name = sprintf "binder_%u" index in
  92   output "template <class T>";
  93   start_struct name;
  94
  95   output "static void of_stmt(sqlite3_stmt* stmt, T& obj)";
  96   open_curly ();
  97   List.iteri (fun index attr -> get_column attr index) scheme;
  98   close_curly "";
  99
 100   output "static void to_stmt(sqlite3_stmt* stmt, const T& obj)";
 101   open_curly ();
 102   List.iteri (fun index attr -> set_column attr (index + 1)) scheme;
 103   close_curly "";
 104   end_struct name;
 105   name
 106
 107 let output_scheme_binder i s = in_namespace "detail" (fun () -> output_scheme_binder i s)
 108 (*
 109 let generate_table_code table =
 110   out_public ();
 111   start_struct (item_name table);
 112   List.iter
 113     (fun col -> output (sprintf "%s %s;" (Col.type_to_cpp_string col) col.Col.cpp_name))
 114     table.Table.cols;
 115   end_struct (item_name table)
 116
 117 let make_const_params inputs =
 118   (List.map (fun (name,t) -> (sprintf "const %s&" (Type.to_cpp_string t)),name) inputs)
 119
 120 let output_extra_param_defs placeholders =
 121   List.iter (fun (name,t) -> output (sprintf "const %s& %s_;" (Type.to_cpp_string t) name)) placeholders
 122
 123 let output_extra_params_init names =
 124   match names with
 125   | [] -> ()
 126   | _ -> output (" : " ^ (String.concat "," (List.map (fun name -> sprintf "%s_(%s)" name name) names)))
 127
 128 let output_params_binder binder_index cols_binder ofs inputs =
 129   out_private ();
 130   let name = (sprintf "params_binder_%u" binder_index) in
 131   start_struct name;
 132   output_extra_param_defs inputs;
 133   begin match cols_binder with
 134   | Some binder -> output (sprintf "const row& obj_;")
 135   | None -> ()
 136   end;
 137   output "";
 138   let params = (match cols_binder with | Some binder -> [sprintf "const row&","obj"] | None -> []) @
 139                (make_const_params inputs)
 140   in
 141   output (sprintf "%s(%s)" name (Cpp.to_string params));
 142   let names = List.map (fun (name,_) -> name) inputs in
 143   let names = (match cols_binder with | Some _ -> "obj"::names | None -> names) in
 144   output_extra_params_init names;
 145   open_curly ();
 146   close_curly "";
 147   output "";
 148   output (sprintf "void set_params(sqlite3_stmt* stmt)");
 149   open_curly ();
 150   begin match cols_binder with
 151   | Some binder -> output (sprintf "%s::to_stmt(stmt,obj_);" binder)
 152   | None -> ()
 153   end;
 154   List.iteri (fun index param -> output (param_binder_code (index+1+ofs) param)) inputs;
 155   close_curly "";
 156   output "";
 157   end_struct name;
 158   name
 159
 160 let output_params_binder index table cols inputs =
 161   let binder_name = (match cols with
 162                      | [] -> None
 163                      | _ -> Some (output_scheme_binder table cols index))
 164   in
 165   match binder_name,inputs with
 166   | None,[] -> "typename Traits::no_params"
 167   | _,_ -> output_params_binder index binder_name (List.length cols) inputs
 168
 169 let make_name props default =
 170   match Props.get props "name" with
 171   | Some v -> v
 172   | None -> default
 173
 174 let default_name table str index = sprintf "%s%s_%u" (prefix_name table) str index
 175
 176 *)
 177 let generate_select_code index scheme params =
 178    let scheme_binder_name = output_scheme_binder index scheme in
 179    ignore (scheme_binder_name);
 180 (*    let params_binder_name = output_params_binder index params in *)
 181 (*
 182    out_public ();
 183    output "template<class T>";
 184    let params = Cpp.Params.to_string
 185      (["sqlite3*","db"; "T&","result"] @ (make_const_params inputs))
 186    in
 187    let name = make_name props (default_name table "select" index) in
 188    output
 189      (sprintf "static bool %s(%s)" name params);
 190    open_curly ();
 191    output
 192      (sprintf "return Traits::do_select(db,result,_T(\"%s\"),%s(),%s(%s));"
 193               sql binder_name params_binder_name (Cpp.Params.inline (make_const_params inputs)));
 194    close_curly "";
 195 *)
 196    output ""
 197 (*
 198 let generate_insert_code columns table index (placeholders,props) sql =
 199       out_public ();
 200       let name = make_name props (default_name table "insert" index) in
 201       output (sprintf "static bool %s(sqlite3* db, const %s& val)" name (item_name table));
 202       open_curly ();
 203       output (sprintf "return Traits::do_insert<binder_%s>(db,val,_T(\"%s\"));" (item_name table) sql);
 204       close_curly "";
 205       output ""
 206   *)
 207
 208 (*
 209 let generate_modify_code table cols inputs index props sql =
 210   (* if there is only one input column - do not require full object as a param *)
 211   let (cols,inputs) = match cols with
 212   | [(x,_)] -> [],(x.Sql.Col.name,x.Sql.Col.sqltype)::inputs
 213   | _ -> cols,inputs
 214   in
 215   let params_binder_name = output_params_binder index table cols inputs in
 216   out_public ();
 217   let data_params = make_const_params inputs in
 218   let data_params = (match cols with
 219     | [] -> data_params
 220     | _ -> ((sprintf "const %s&" (item_name table)),"val")::data_params)
 221   in
 222   let params = Cpp.Params.to_string (("sqlite3*","db") :: data_params) in
 223   let name = make_name props (default_name table "modify" index) in
 224   output (sprintf "static int %s(%s)" name params);
 225   open_curly ();
 226   output (sprintf "return Traits::do_execute(db,\"%s\",%s(%s));" sql
 227       params_binder_name (Cpp.inline data_params));
 228   close_curly "";
 229   output ""
 230
 231 let generate_delete_code table inputs index props sql =
 232   let params_binder_name = output_params_binder index table [] inputs in
 233   out_public ();
 234   let data_params = make_const_params inputs in
 235   let params = Cpp.Params.to_string (("sqlite3*","db") :: data_params) in
 236   let name = make_name props (default_name table "delete" index) in
 237   output (sprintf "static int %s(%s)" name params);
 238   open_curly ();
 239   output (sprintf "return Traits::do_execute(db,\"%s\",%s(%s));" sql
 240       params_binder_name (Cpp.Params.inline data_params));
 241   close_curly "";
 242   output ""
 243
 244 let generate_create_code table sql =
 245   out_public ();
 246   output (sprintf "static int %screate(sqlite3* db)" (prefix_name table));
 247   open_curly ();
 248   output (sprintf "return Traits::do_execute(db,\"%s\",typename Traits::no_params());" sql);
 249   close_curly "";
 250   output ""
 251 *)
 252
 253 let generate_code index stmt =
 254   let ((scheme,params),props) = stmt in
 255   begin match Props.get props "sql" with
 256   | Some s -> comment "%s" s
 257   | None -> ()
 258   end;
 259   generate_select_code index scheme params
 260
 261 let process stmts =
 262 (*
 263   let generate_code index stmt =
 264     let (kind,table,props,sql) = stmt in
 265     match kind with
 266     | Stmt.Create -> generate_table_code table;
 267                      generate_create_code table sql
 268     | Stmt.Select (outputs,exprs,inputs) ->
 269         generate_select_code table inputs outputs index props sql
 270     | Stmt.Modify (cols,inputs) -> generate_modify_code table cols inputs index props sql
 271     | Stmt.Delete (inputs) -> generate_delete_code table inputs index props sql
 272   in
 273 *)
 274   generate_header ();
 275   output "namespace sql2cpp";
 276   open_curly ();
 277   List.iteri generate_code stmts;
 278   close_curly " // namespace sql2cpp"