gen.ml

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