Mercurial > urweb
diff src/cjr_print.sml @ 324:b91480c9a729
More opportunities to use regions and lack of string copying
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 11 Sep 2008 13:06:51 -0400 |
parents | 5030e909fbf3 |
children | e457d8972ff1 |
line wrap: on
line diff
--- a/src/cjr_print.sml Thu Sep 11 12:40:40 2008 -0400 +++ b/src/cjr_print.sml Thu Sep 11 13:06:51 2008 -0400 @@ -393,11 +393,15 @@ "uw_" ^ ident m ^ "_" ^ ident con, "uw_" ^ ident con) -fun p_unsql env (tAll as (t, loc)) e = +fun p_unsql wontLeakStrings env (tAll as (t, loc)) e = case t of TFfi ("Basis", "int") => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"] | TFfi ("Basis", "float") => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"] - | TFfi ("Basis", "string") => box [string "uw_Basis_strdup(ctx, ", e, string ")"] + | TFfi ("Basis", "string") => + if wontLeakStrings then + e + else + box [string "uw_Basis_strdup(ctx, ", e, string ")"] | TFfi ("Basis", "bool") => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"] | _ => (ErrorMsg.errorAt loc "Don't know how to unmarshal type from SQL"; Print.eprefaces' [("Type", p_typ env tAll)]; @@ -443,6 +447,29 @@ | String => box [string "strlen(", e, string ")"] | Bool => string "sizeof(uw_Basis_bool)" +fun notLeaky env allowHeapAllocated = + let + fun nl (t, _) = + case t of + TFun _ => false + | TRecord n => + let + val xts = E.lookupStruct env n + in + List.all (fn (_, t) => nl t) xts + end + | TDatatype (dk, _, ref cons) => + (allowHeapAllocated orelse dk = Enum) + andalso List.all (fn (_, _, to) => case to of + NONE => true + | SOME t => nl t) cons + | TFfi ("Basis", "string") => false + | TFfi _ => true + | TOption t => allowHeapAllocated andalso nl t + in + nl + end + fun p_exp' par env (e, loc) = case e of EPrim p => Prim.p_t_GCC p @@ -711,8 +738,16 @@ tables val outputs = exps @ tables + + val wontLeakStrings = notLeaky env true state + val wontLeakAnything = notLeaky env false state in - box [string "(uw_begin_region(ctx), ({", + box [string "(uw_begin_region(ctx), ", + if wontLeakAnything then + string "uw_begin_regio(ctx), " + else + box [], + string "({", newline, string "PGconn *conn = uw_get_db(ctx);", newline, @@ -826,7 +861,7 @@ space, string "=", space, - p_unsql env t + p_unsql wontLeakStrings env t (box [string "PQgetvalue(res, i, ", string (Int.toString i), string ")"]), @@ -851,6 +886,11 @@ newline, string "PQclear(res);", newline, + if wontLeakAnything then + box [string "uw_end_region(ctx);", + newline] + else + box [], string "acc;", newline, string "}))"]