Remove some allocation

4 files changed, 64 insertions, 16 deletions

diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 7c13fcb5..b1eb04b3 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1186,10 +1186,6 @@ fun p_exp' par env (e, loc) =
                  p_exp env initial,
                  string ";",
                  newline,
-                 case prepared of
-                     NONE => box [string "printf(\"Executing: %s\\n\", query);",
-                                  newline]
-                   | _ => box [],
                  string "PGresult *res = ",
                  case prepared of
                      NONE => string "PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);"
@@ -1371,8 +1367,15 @@ fun p_exp' par env (e, loc) =
 
       | ENextval {seq, prepared} =>
         let
-            val query = (EFfiApp ("Basis", "strcat", [seq, (EPrim (Prim.String "')"), loc)]), loc)
-            val query = (EFfiApp ("Basis", "strcat", [(EPrim (Prim.String "SELECT NEXTVAL('"), loc), query]), loc)
+            val query = case seq of
+                            (EPrim (Prim.String s), loc) =>
+                            (EPrim (Prim.String ("SELECT NEXTVAL('" ^ s ^ "')")), loc)
+                          | _ =>
+                            let
+                                val query = (EFfiApp ("Basis", "strcat", [seq, (EPrim (Prim.String "')"), loc)]), loc)
+                            in
+                                (EFfiApp ("Basis", "strcat", [(EPrim (Prim.String "SELECT NEXTVAL('"), loc), query]), loc)
+                            end
         in
             box [string "(uw_begin_region(ctx), ",
                  string "({",
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index 93cb888b..e350db1d 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -320,11 +320,39 @@ fun exp e =
 
       | EWrite (EQuery {exps, tables, state, query,
                         initial = (EPrim (Prim.String ""), _),
+                        body}, loc) =>
+        let
+            fun passLets (depth, (e', _), lets) =
+                case e' of
+                    EStrcat ((ERel x, _), e'') =>
+                    if x = depth then
+                        let
+                            val body = (optExp (EWrite e'', loc), loc)
+                            val body = foldl (fn ((x, t, e'), e) =>
+                                                 (ELet (x, t, e', e), loc))
+                                             body lets
+                        in
+                            EQuery {exps = exps, tables = tables, query = query,
+                                    state = (TRecord [], loc),
+                                    initial = (ERecord [], loc),
+                                    body = body}
+                        end
+                    else
+                        e
+                  | ELet (x, t, e', e'') =>
+                    passLets (depth + 1, e'', (x, t, e') :: lets)
+                  | _ => e
+        in
+            passLets (0, body, [])
+        end
+
+      (*| EWrite (EQuery {exps, tables, state, query,
+                        initial = (EPrim (Prim.String ""), _),
                         body = (EStrcat ((ERel 0, _), e'), _)}, loc) =>
         EQuery {exps = exps, tables = tables, query = query,
                 state = (TRecord [], loc),
                 initial = (ERecord [], loc),
-                body = (optExp (EWrite e', loc), loc)}
+                body = (optExp (EWrite e', loc), loc)}*)
 
       | EWrite (ELet (x, t, e1, e2), loc) =>
         optExp (ELet (x, t, e1, (EWrite e2, loc)), loc)
diff --git a/src/mono_reduce.sig b/src/mono_reduce.sig
index 2495c7f9..a6b6cc81 100644
--- a/src/mono_reduce.sig
+++ b/src/mono_reduce.sig
@@ -33,4 +33,6 @@ signature MONO_REDUCE = sig
 
     val subExpInExp : int * Mono.exp -> Mono.exp -> Mono.exp
 
+    val impure : Mono.exp -> bool
+
 end
diff --git a/src/prepare.sml b/src/prepare.sml
index b20c7fec..28c14639 100644
--- a/src/prepare.sml
+++ b/src/prepare.sml
@@ -176,13 +176,21 @@ fun prepExp (e as (_, loc), sns) =
         end
 
       | EQuery {exps, tables, rnum, state, query, body, initial, ...} =>
-        (case prepString (query, [], 0) of
-             NONE => (e, sns)
-           | SOME (ss, n) =>
-             ((EQuery {exps = exps, tables = tables, rnum = rnum,
-                       state = state, query = query, body = body,
-                       initial = initial, prepared = SOME (#2 sns)}, loc),
-              ((String.concat (rev ss), n) :: #1 sns, #2 sns + 1)))
+        let
+            val (body, sns) = prepExp (body, sns)
+        in
+            case prepString (query, [], 0) of
+                NONE =>
+                ((EQuery {exps = exps, tables = tables, rnum = rnum,
+                          state = state, query = query, body = body,
+                          initial = initial, prepared = SOME (#2 sns)}, loc),
+                 sns)
+              | SOME (ss, n) =>
+                ((EQuery {exps = exps, tables = tables, rnum = rnum,
+                          state = state, query = query, body = body,
+                          initial = initial, prepared = SOME (#2 sns)}, loc),
+                 ((String.concat (rev ss), n) :: #1 sns, #2 sns + 1))
+        end
 
       | EDml {dml, ...} =>
         (case prepString (dml, [], 0) of
@@ -193,8 +201,15 @@ fun prepExp (e as (_, loc), sns) =
 
       | ENextval {seq, ...} =>
         let
-            val s = (EFfiApp ("Basis", "strcat", [seq, (EPrim (Prim.String "')"), loc)]), loc)
-            val s = (EFfiApp ("Basis", "strcat", [(EPrim (Prim.String "SELECT NEXTVAL('"), loc), s]), loc)
+            val s = case seq of
+                        (EPrim (Prim.String s), loc) =>
+                        (EPrim (Prim.String ("SELECT NEXTVAL('" ^ s ^ "')")), loc)
+                      | _ =>
+                        let
+                            val s' = (EFfiApp ("Basis", "strcat", [seq, (EPrim (Prim.String "')"), loc)]), loc)
+                        in
+                            (EFfiApp ("Basis", "strcat", [(EPrim (Prim.String "SELECT NEXTVAL('"), loc), s']), loc)
+                        end
         in
             case prepString (s, [], 0) of
                 NONE => (e, sns)