remove old code
[sqlgg.git] / gen.ml
blob1441d89e29969c5470acaf4582aabff37881411e
1 (* C++ code generation *)
3 open Sql
4 open Printf
5 open ExtList
6 open ExtString
7 open Operators
8 open Stmt
10 module Cpp =
11 struct
12 type value = string * string
13 type t = value list
15 let to_string x =
16 String.concat ", " (List.map (fun (n,t) -> t ^ " " ^ n) x)
18 let inline 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 ^ "\""
23 end
25 let (inc_indent,dec_indent,make_indent) =
26 let v = ref 0 in
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;
43 open_curly ()
44 let end_struct name =
45 close_curly "; // struct %s" name;
46 empty_line ()
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;
51 open_curly ();
52 let result = f () in
53 close_curly " // namespace %s" name;
54 empty_line ();
55 result
57 let generate_header () =
58 output "// DO NOT EDIT MANUALLY";
59 output "";
60 output "// generated by sql2cpp";
61 output "";
62 output "#pragma once";
63 output ""
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
74 | s -> s
76 let set_column attr index =
77 output "Traits::set_column_%s(stmt, %u, obj.%s);"
78 (Type.to_string attr.RA.domain)
79 index
80 (name_of attr index)
82 let get_column attr index =
83 output "Traits::get_column_%s(stmt, %u, obj.%s);"
84 (Type.to_string attr.RA.domain)
85 index
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 =
92 match id with
93 | Next -> sprintf "_%u" index
94 | Numbered x -> sprintf "_%u" x
95 | Named s -> s
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
107 let output_scheme_binder index scheme =
108 out_private ();
109 let name = default_name "output" index in
110 output "template <class T>";
111 start_struct name;
113 output "static void of_stmt(typename Traits::statement stmt, T& obj)";
114 open_curly ();
115 List.iteri (fun index attr -> get_column attr index) scheme;
116 close_curly "";
118 end_struct name;
119 name
121 let output_scheme_binder index scheme =
122 match scheme with
123 | [] -> None
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 =
135 out_public ();
136 let name = default_name "data" index in
137 start_struct name;
138 scheme >> scheme_to_values >> output_value_defs;
139 end_struct name
141 let output_value_inits vals =
142 match vals with
143 | [] -> ()
144 | _ ->
145 output " : %s"
146 (String.concat "," (List.map (fun (name,_) -> sprintf "%s(%s)" name name) vals))
148 let output_params_binder index params =
149 out_private ();
150 let name = default_name "params" index in
151 start_struct name;
152 let values = params_to_values params in
153 values >> make_const_values >> output_value_defs;
154 empty_line ();
155 output "%s(%s)" name (Cpp.to_string (make_const_values values));
156 output_value_inits values;
157 open_curly ();
158 close_curly "";
159 empty_line ();
160 output "void set_params(typename Traits::statement stmt)";
161 open_curly ();
162 List.iteri set_param params;
163 close_curly "";
164 empty_line ();
165 end_struct name;
166 name
168 let output_params_binder index params =
169 match params with
170 | [] -> "typename Traits::no_params"
171 | _ -> output_params_binder index params
173 let choose_name props kind index =
174 (* let name = default_name (Show.show<Stmt.Raw.kind>(kind) >> String.lowercase) index in *)
175 let name = match kind with
176 | Create t -> sprintf "create_%s" t
177 | Update t -> sprintf "update_%s_%u" t index
178 | Insert t -> sprintf "insert_%s_%u" t index
179 | Delete t -> sprintf "delete_%s_%u" t index
180 | Select -> sprintf "select_%u" index
182 make_name props name
184 let generate_code index scheme params kind props =
185 let scheme_binder_name = output_scheme_binder index scheme in
186 let params_binder_name = output_params_binder index params in
187 if (Option.is_some scheme_binder_name) then output_scheme_data index scheme;
188 out_public ();
189 if (Option.is_some scheme_binder_name) then output "template<class T>";
190 let values = params_to_values params in
191 let result = match scheme_binder_name with None -> [] | Some _ -> ["result","T&"] in
192 let all_params = Cpp.to_string
193 (["db","typename Traits::connection"] @ result @ (make_const_values values))
195 let name = choose_name props kind index in
196 let sql = Props.get props "sql" >> Option.get in
197 (* fill VALUES *)
198 let sql = match kind with
199 | Insert _ -> sql ^ " (" ^ (String.concat "," (List.map (fun _ -> "?") params)) ^ ")"
200 | Select | Update _ | Delete _ | Create _ -> sql
202 let sql = Cpp.quote sql in
203 let inline_params = Cpp.inline (make_const_values values) in
204 output "static bool %s(%s)" name all_params;
205 open_curly ();
206 begin match scheme_binder_name with
207 | None -> output "return Traits::do_execute(db,_T(%s),%s(%s));" sql params_binder_name inline_params
208 | Some scheme_name ->output "return Traits::do_select(db,result,_T(%s),%s(),%s(%s));"
209 sql (scheme_name ^ "<typename T::value_type>") params_binder_name inline_params
210 end;
211 close_curly "";
212 empty_line ()
214 let generate_code index stmt =
215 let ((scheme,params,kind),props) = stmt in
216 begin match Props.get props "sql" with
217 | Some s -> comment "%s" s
218 | None -> ()
219 end;
220 generate_code index scheme params kind props
222 let process stmts =
223 generate_header ();
224 output "template <class Traits>";
225 start_struct "sql2cpp";
226 List.iteri generate_code stmts;
227 end_struct "sql2cpp"