# HG changeset patch # User Adam Chlipala # Date 1226272787 18000 # Node ID 8e055bbbd28b7857405860f487bc626065b864fc # Parent 3ce20b0b6914c4e8923d216667f7f9316993cc34 Remove some allocation diff -r 3ce20b0b6914 -r 8e055bbbd28b src/cjr_print.sml --- a/src/cjr_print.sml Sun Nov 09 17:27:34 2008 -0500 +++ b/src/cjr_print.sml Sun Nov 09 18:19:47 2008 -0500 @@ -1186,10 +1186,6 @@ 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 @@ | 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 -r 3ce20b0b6914 -r 8e055bbbd28b src/mono_opt.sml --- a/src/mono_opt.sml Sun Nov 09 17:27:34 2008 -0500 +++ b/src/mono_opt.sml Sun Nov 09 18:19:47 2008 -0500 @@ -320,11 +320,39 @@ | 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 -r 3ce20b0b6914 -r 8e055bbbd28b src/mono_reduce.sig --- a/src/mono_reduce.sig Sun Nov 09 17:27:34 2008 -0500 +++ b/src/mono_reduce.sig Sun Nov 09 18:19:47 2008 -0500 @@ -33,4 +33,6 @@ val subExpInExp : int * Mono.exp -> Mono.exp -> Mono.exp + val impure : Mono.exp -> bool + end diff -r 3ce20b0b6914 -r 8e055bbbd28b src/prepare.sml --- a/src/prepare.sml Sun Nov 09 17:27:34 2008 -0500 +++ b/src/prepare.sml Sun Nov 09 18:19:47 2008 -0500 @@ -176,13 +176,21 @@ 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 @@ | 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)