summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-11-09 18:19:47 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-11-09 18:19:47 -0500
commita676c53ffcf88833514d12968ee5b6b28aa8cc8a (patch)
tree20f7896237fd6c5305a66766a96cdc17fdbbfcec
parent15dbb86a5905e505527ab60972087e8bed0c9088 (diff)
Remove some allocation
-rw-r--r--src/cjr_print.sml15
-rw-r--r--src/mono_opt.sml30
-rw-r--r--src/mono_reduce.sig2
-rw-r--r--src/prepare.sml33
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)