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 "}))"]