WIP: optimize duplicate parameters

ppx/ppx_pgsql.ml

@@ -388,14 +388,23 @@ let pgsql_expand ~genobject ?(flags = []) loc dbh query =
       *)
       let i = ref 0 in (* Counts parameters. *)
       let j = ref 0 in (* Counts placeholders. *)
+      let deja = Hashtbl.create 4 in
       let query = String.concat "" (
           List.map (
             function
             | `Text text -> text
-            | `Var (_varname, false, _) ->    (* non-list item *)
-              let () = incr i in        (* next parameter *)
-              let () = incr j in        (* next placeholder number *)
-              "$" ^ string_of_int j.contents
+            | `Var (_varname, false, _) as var ->    (* non-list item *)
+              let j =
+                if Hashtbl.mem deja var
+                then j.contents
+                else begin
+                  let () = incr i in  (* next parameter *)
+                  let () = incr j in  (* next placeholder number *)
+                  let _ = Hashtbl.add deja var j.contents in
+                  j.contents
+                end
+              in
+              "$" ^ string_of_int j
             | `Var (_varname, true, _) -> (* list item *)
               let param = List.nth params i.contents in
               let () = incr i in        (* next parameter *)
@@ -412,6 +421,16 @@ let pgsql_expand ~genobject ?(flags = []) loc dbh query =
 
       (* Flatten the parameters to a simple list now. *)
       let params = List.flatten params in
+      let params =
+        List.fold_left
+          (fun acc param ->
+            if List.mem param acc
+            then acc
+            else param :: acc)
+          []
+          params
+        |> List.rev
+      in
 
       (* Get a unique name for this query using an MD5 digest. *)
       let name = "ppx_pgsql." ^ Digest.to_hex (Digest.string query) in

tests_ppx/dune

@@ -1,7 +1,7 @@
 (executable
   (name test_ppx)
-  (libraries oUnit result pgocaml.ppx)
-  (preprocess (pps pgocaml.ppx)))
+  (libraries oUnit result pgocaml_ppx)
+  (preprocess (pps pgocaml_ppx)))
 
 (alias
   (name runtest)

tests_ppx/test_ppx.ml

@@ -4,29 +4,30 @@ let init_dbh dbh =
 id serial not null primary key,
 name text not null,
 salary int4 not null,
+pay int4 not null,
 email text
 )"]
 
 let employee_exists dbh ?email n =
-  [%pgsql dbh "SELECT EXISTS (SELECT 1 FROM employees WHERE name = $n AND email = $?email AND email = $email)"]
+  [%pgsql dbh "SELECT EXISTS (SELECT 1 FROM employees WHERE name = $n AND email = $?email)"]
 
 let () =
   let dbh = PGOCaml.connect () in
 
   init_dbh dbh;
 
-  let insert name salary email = [%pgsql dbh "insert into employees (name, salary, email) values ($name, $salary, $?email)"] in
+  let insert name salary  email = [%pgsql dbh "insert into employees (name, salary, pay, email) values ($name, $salary, $salary, $?email)"] in
   insert "Ann" 10_000_l None;
   insert "Bob" 45_000_l None;
   insert "Jim" 20_000_l None;
   insert "Mary" 30_000_l (Some "mary@example.com");
 
-  let rows = [%pgsql dbh "select id, name, salary, email from employees"] in
+  let rows = [%pgsql dbh "select id, name, salary, pay, email from employees"] in
   List.iter
     begin
-      fun (id, name, salary, email) ->
+      fun (id, name, salary, pay, email) ->
         let email = match email with Some email -> email | None -> "-" in
-        Printf.printf "%ld %S %ld %S\n" id name salary email
+        Printf.printf "%ld %S %ld %ld %S\n" id name salary pay email
     end rows;
 
   let ids = [ 1_l; 3_l ] in