1 (* C++ code generation *)
12 type value = string * string
16 String.concat
", " (List.map
(fun (n
,t
) -> t ^
" " ^ n
) x
)
19 String.concat
", " (List.map
(fun (n
,t
) -> n
) x
)
21 let quote = String.replace_chars
(function '
\n'
-> "\\\n" | '
"' -> "\\\"" | c -> String.make 1 c)
22 let quote s = "\"" ^ quote s ^ "\""
25 let (inc_indent,dec_indent,make_indent) =
27 (fun () -> v := !v + 2),
28 (fun () -> v := !v - 2),
29 (fun () -> String.make !v ' ')
31 let print_indent () = print_string (make_indent ())
32 let indent s = print_indent (); print_string s
33 let indent_endline s = print_indent (); print_endline s
34 let empty_line () = print_newline ()
35 let output fmt = Printf.kprintf indent_endline fmt
36 let print fmt = Printf.kprintf print_endline fmt
37 let quote_comment_inline = String.replace_chars (function '\n' -> "\n// " | c -> String.make 1 c)
38 let comment fmt = Printf.kprintf (indent_endline & quote_comment_inline & (^) "// ") fmt
39 let open_curly () = output "{"; inc_indent ()
40 let close_curly fmt = dec_indent (); indent "}"; print fmt
41 let start_struct name =
42 output "struct %s
" name;
45 close_curly "; // struct %s
" name;
47 let out_public () = dec_indent(); output "public
:"; inc_indent()
48 let out_private () = dec_indent(); output "private:"; inc_indent()
49 let in_namespace name f =
50 output "namespace %s
" name;
53 close_curly " // namespace %s
" name;
57 let generate_header () =
58 output "// DO NOT EDIT MANUALLY
";
60 output "// generated by sql2cpp
";
62 output "#pragma once
";
66 let ns_name table = table.Table.cpp_name
67 let item_name _ = "row
"
68 let prefix_name _ = ""
71 let name_of attr index =
72 match attr.RA.name with
73 | "" -> sprintf "_%u
" index
76 let set_column attr index =
77 output "Traits
::set_column_%s
(stmt
, %u
, obj
.%s
);"
78 (Type.to_string attr.RA.domain)
82 let get_column attr index =
83 output "Traits
::get_column_%s
(stmt
, %u
, obj
.%s
);"
84 (Type.to_string attr.RA.domain)
86 (name_of attr (index+1))
88 let param_type_to_string t = Option.map_default Type.to_string "Any
" t
89 let param_type_to_cpp_string t = "typename Traits
::" ^ (param_type_to_string t)
91 let param_name_to_string id index =
93 | Next -> sprintf "_%u
" index
94 | Numbered x -> sprintf "_%u
" x
97 let make_name props default = Option.default default (Props.get props "name
")
98 let default_name str index = sprintf "%s_%u
" str index
100 let set_param index param =
101 let (id,t) = param in
102 output "Traits
::set_param_%s
(stmt
, %s
, %u
);"
103 (param_type_to_string t)
104 (param_name_to_string id index)
105 (index+1) (* FIXME sqlite3 specific *)
107 let output_scheme_binder index scheme =
109 let name = default_name "output" index in
110 output "template
<class T
>";
113 output "static void of_stmt
(sqlite3_stmt
* stmt
, T
& obj
)";
115 List.iteri (fun index attr -> get_column attr index) scheme;
121 let output_scheme_binder index scheme =
124 | _ -> Some (output_scheme_binder index scheme)
126 let params_to_values = List.mapi (fun i (n,t) -> param_name_to_string n i, param_type_to_cpp_string t)
127 let make_const_values = List.map (fun (name,t) -> name, sprintf "%s const
&" t)
129 let output_value_defs vals =
130 vals >> List.iter (fun (name,t) -> output "%s %s
;" t name)
132 let scheme_to_values = List.mapi (fun i attr -> name_of attr i, Type.to_cpp_string attr.RA.domain)
134 let output_scheme_data index scheme =
136 let name = default_name "data
" index in
138 scheme >> scheme_to_values >> output_value_defs;
141 let output_value_inits vals =
146 (String.concat "," (List.map (fun (name,_) -> sprintf "%s
(%s
)" name name) vals))
148 let output_params_binder index params =
150 let name = default_name "params
" index in
152 let values = params_to_values params in
153 values >> make_const_values >> output_value_defs;
155 output "%s
(%s
)" name (Cpp.to_string (make_const_values values));
156 output_value_inits values;
160 output "void set_params
(sqlite3_stmt
* stmt
)";
162 List.iteri set_param params;
168 let output_params_binder index params =
170 | [] -> "typename Traits
::no_params
"
171 | _ -> output_params_binder index params
173 let generate_code index scheme params kind props =
174 let scheme_binder_name = output_scheme_binder index scheme in
175 let params_binder_name = output_params_binder index params in
176 if (Option.is_some scheme_binder_name) then output_scheme_data index scheme;
178 if (Option.is_some scheme_binder_name) then output "template
<class T
>";
179 let values = params_to_values params in
180 let result = match scheme_binder_name with None -> [] | Some _ -> ["result","T
&"] in
181 let all_params = Cpp.to_string
182 (["db
","sqlite3
*"] @ result @ (make_const_values values))
184 let name = make_name props (default_name (Show.show<Stmt.Raw.kind>(kind) >> String.lowercase) index) in
185 let sql = Props.get props "sql" >> Option.get in
186 let sql = match kind with
187 | Insert -> sql ^ " (" ^ (String.concat "," (List.map (fun _ -> "?
") params)) ^ ")"
188 | Select | Update | Delete | Create -> sql
190 let sql = Cpp.quote sql in
191 let inline_params = Cpp.inline (make_const_values values) in
192 output "static
bool %s
(%s
)" name all_params;
194 begin match scheme_binder_name with
195 | None -> output "return Traits
::do_execute
(db
,_T
(%s
),%s
(%s
));" sql params_binder_name inline_params
196 | Some scheme_name ->output "return Traits
::do_select
(db
,result,_T
(%s
),%s
(),%s
(%s
));"
197 sql (scheme_name ^ "<typename T
::value_type
>") params_binder_name inline_params
202 let generate_code index stmt =
203 let ((scheme,params,kind),props) = stmt in
204 begin match Props.get props "sql" with
205 | Some s -> comment "%s
" s
208 generate_code index scheme params kind props
212 output "template
<class Traits
>";
213 start_struct "sql2cpp
";
214 List.iteri generate_code stmts;