changeset 1083:2eb585274501

Stop skipping Especialization of generated functions; fix Compiler.parseUrp; expose uw_really_write(); allow more NULL arguments to uw_register_transactional()
author Adam Chlipala <adamc@hcoop.net>
date Wed, 23 Dec 2009 12:25:34 -0500
parents 4b2f50829af5
children 8e240c007442
files include/urweb.h src/c/urweb.c src/compiler.sml src/especialize.sml
diffstat 4 files changed, 15 insertions(+), 11 deletions(-) [+]
line wrap: on
line diff
--- a/include/urweb.h	Tue Dec 22 15:29:38 2009 -0500
+++ b/include/urweb.h	Wed Dec 23 12:25:34 2009 -0500
@@ -6,6 +6,7 @@
 #include "types.h"
 
 int uw_really_send(int sock, const void *buf, ssize_t len);
+int uw_really_write(int fd, const void *buf, size_t len);
 
 extern uw_unit uw_unit_v;
 
--- a/src/c/urweb.c	Tue Dec 22 15:29:38 2009 -0500
+++ b/src/c/urweb.c	Wed Dec 23 12:25:34 2009 -0500
@@ -2773,11 +2773,13 @@
 
   for (i = 0; i < ctx->used_transactionals; ++i)
     if (ctx->transactionals[i].rollback != NULL)
-      ctx->transactionals[i].commit(ctx->transactionals[i].data);
+      if (ctx->transactionals[i].commit)
+        ctx->transactionals[i].commit(ctx->transactionals[i].data);
 
   for (i = 0; i < ctx->used_transactionals; ++i)
     if (ctx->transactionals[i].rollback == NULL)
-      ctx->transactionals[i].commit(ctx->transactionals[i].data);
+      if (ctx->transactionals[i].commit)
+        ctx->transactionals[i].commit(ctx->transactionals[i].data);
 
   if (uw_db_commit(ctx))
     uw_error(ctx, FATAL, "Error running SQL COMMIT");
@@ -2795,7 +2797,8 @@
     release_client(ctx->client);
 
   for (i = 0; i < ctx->used_transactionals; ++i)
-    ctx->transactionals[i].free(ctx->transactionals[i].data);
+    if (ctx->transactionals[i].free)
+      ctx->transactionals[i].free(ctx->transactionals[i].data);
 
   // Splice script data into appropriate part of page
   if (ctx->returning_indirectly || ctx->script_header[0] == 0) {
@@ -2855,9 +2858,6 @@
 
 void uw_register_transactional(uw_context ctx, void *data, uw_callback commit, uw_callback rollback,
                                uw_callback free) {
-  if (commit == NULL)
-    uw_error(ctx, FATAL, "uw_register_transactional: NULL commit callback");
-
   if (ctx->used_transactionals >= ctx->n_transactionals) {
     ctx->transactionals = realloc(ctx->transactionals, ctx->used_transactionals+1);
     ++ctx->n_transactionals;
--- a/src/compiler.sml	Tue Dec 22 15:29:38 2009 -0500
+++ b/src/compiler.sml	Wed Dec 23 12:25:34 2009 -0500
@@ -596,12 +596,12 @@
 fun p_job' {Job = j, Libs = _ : string list} = p_job j
 
 val parseUrp = {
-    func = #Job o parseUrp' false,
+    func = #Job o parseUrp' true,
     print = p_job
 }
 
 val parseUrp' = {
-    func = parseUrp' true,
+    func = parseUrp' false,
     print = p_job'
 }
 
--- a/src/especialize.sml	Tue Dec 22 15:29:38 2009 -0500
+++ b/src/especialize.sml	Wed Dec 23 12:25:34 2009 -0500
@@ -324,10 +324,13 @@
                                                  | _ => false) fxs'
                                orelse (IS.numItems fvs >= length fxs
                                        andalso IS.exists (fn n => functionInside (#2 (List.nth (env, n)))) fvs) then
-                                default ()
+                                ((*Print.prefaces "No" [("name", Print.PD.string name),
+                                                      ("fxs'",
+                                                       Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs')];*)
+                                 default ())
                             else
                                 case (KM.find (args, fxs'),
-                                      SS.member (!mayNotSpec, name) orelse IS.member (#specialized st, f)) of
+                                      SS.member (!mayNotSpec, name) (*orelse IS.member (#specialized st, f)*)) of
                                     (SOME f', _) =>
                                     let
                                         val e = (ENamed f', loc)
@@ -340,7 +343,7 @@
                                                        [("e'", CorePrint.p_exp CoreEnv.empty e)];*)
                                         (e, st)
                                     end
-                                  | (_, true) => ((*Print.prefaces ("No(" ^ name ^ ")")
+                                  | (_, true) => ((*Print.prefaces ("No!(" ^ name ^ ")")
                                                                  [("fxs'",
                                                                    Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs')];*)
                                                   default ())