# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1342646953 14400
# Node ID 61c7eb1d3867224ff9fb06e1ab0b5bbb34bb3a0c
# Parent  25824a0e8bf141e7c459d9a0020238717483bd90
Support fancy expressions in module-level 'val' declarations

diff -r 25824a0e8bf1 -r 61c7eb1d3867 include/urweb/urweb.h
--- a/include/urweb/urweb.h	Fri Jul 13 09:01:01 2012 -0400
+++ b/include/urweb/urweb.h	Wed Jul 18 17:29:13 2012 -0400
@@ -360,4 +360,7 @@
 uw_Basis_string uw_Basis_css_url(uw_context, uw_Basis_string);
 uw_Basis_string uw_Basis_property(uw_context, uw_Basis_string);
 
+void uw_begin_initializing(uw_context);
+void uw_end_initializing(uw_context);
+
 #endif
diff -r 25824a0e8bf1 -r 61c7eb1d3867 src/c/urweb.c
--- a/src/c/urweb.c	Fri Jul 13 09:01:01 2012 -0400
+++ b/src/c/urweb.c	Wed Jul 18 17:29:13 2012 -0400
@@ -465,6 +465,8 @@
 
   unsigned nextId;
 
+  int amInitializing;
+
   char error_message[ERROR_BUF_LEN];
 };
 
@@ -536,6 +538,8 @@
 
   ctx->nextId = 0;
 
+  ctx->amInitializing = 0;
+
   return ctx;
 }
 
@@ -613,6 +617,7 @@
   ctx->script_header = "";
   ctx->queryString = NULL;
   ctx->nextId = 0;
+  ctx->amInitializing = 0;
 }
 
 void uw_reset_keep_request(uw_context ctx) {
@@ -1204,14 +1209,31 @@
   ctx->heap.front = fr;
 }
 
+void uw_begin_initializing(uw_context ctx) {
+  ctx->amInitializing = 1;
+}
+
+void uw_end_initializing(uw_context ctx) {
+  ctx->amInitializing = 0;
+}
+
 void *uw_malloc(uw_context ctx, size_t len) {
   void *result;
 
-  uw_check_heap(ctx, len);
-
-  result = ctx->heap.front;
-  ctx->heap.front += len;
-  return result;
+  if (ctx->amInitializing) {
+    result = malloc(len);
+
+    if (result)
+      return result;
+    else
+      uw_error(ctx, FATAL, "uw_malloc: malloc() returns 0");
+  } else {
+    uw_check_heap(ctx, len);
+
+    result = ctx->heap.front;
+    ctx->heap.front += len;
+    return result;
+  }
 }
 
 void uw_begin_region(uw_context ctx) {
diff -r 25824a0e8bf1 -r 61c7eb1d3867 src/cjr_print.sml
--- a/src/cjr_print.sml	Fri Jul 13 09:01:01 2012 -0400
+++ b/src/cjr_print.sml	Wed Jul 18 17:29:13 2012 -0400
@@ -2320,6 +2320,8 @@
              string "}"]
     end
 
+val global_initializers : Print.PD.pp_desc list ref = ref []
+
 fun p_decl env (dAll as (d, _) : decl) =
     case d of
         DStruct (n, xts) =>
@@ -2414,14 +2416,15 @@
       | DDatatypeForward _ => box []
 
       | DVal (x, n, t, e) =>
-        box [p_typ env t,
-             space,
-             string ("__uwn_" ^ ident x ^ "_" ^ Int.toString n),
-             space,
-             string "=",
-             space,
-             p_exp env e,
-             string ";"]
+        (global_initializers := box [string ("__uwn_" ^ ident x ^ "_" ^ Int.toString n),
+                                     space,
+                                     string "=",
+                                     space,
+                                     p_exp env e,
+                                     string ";"] :: !global_initializers;
+         box [p_typ env t,
+              space,
+              string ("__uwn_" ^ ident x ^ "_" ^ Int.toString n ^ ";")])
       | DFun vi => p_fun false env vi
       | DFunRec vis =>
         let
@@ -2565,7 +2568,8 @@
                   unurlifies := IS.empty;
                   urlifies := IS.empty;
                   urlifiesL := IS.empty;
-                  self := NONE)
+                  self := NONE;
+                  global_initializers := [])
 
         val (pds, env) = ListUtil.foldlMap (fn (d, env) =>
                                                let
@@ -3474,7 +3478,12 @@
              newline,
              string "static void uw_initializer(uw_context ctx) {",
              newline,
-             box [p_list_sep (box []) (fn (x1, x2, e) => box [string "({",
+             box [string "uw_begin_initializing(ctx);",
+                  newline,
+                  p_list_sep newline (fn x => x) (rev (!global_initializers)),
+                  string "uw_end_initializing(ctx);",
+                  newline,
+                  p_list_sep (box []) (fn (x1, x2, e) => box [string "({",
                                                               newline,
                                                               string "uw_unit __uwr_",
                                                               string x1,
diff -r 25824a0e8bf1 -r 61c7eb1d3867 tests/longConst.ur
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/longConst.ur	Wed Jul 18 17:29:13 2012 -0400
@@ -0,0 +1,12 @@
+val ls = 1 :: 2 :: 3 :: 4 :: 5 :: 6
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6
+           :: 1 :: 2 :: 3 :: 4 :: 5 :: 6
+           :: []
+
+fun main () : transaction page = return <xml><body>
+  {List.mapX txt ls}<br/>
+  {List.mapX txt ls}
+</body></xml>
diff -r 25824a0e8bf1 -r 61c7eb1d3867 tests/longConst.urp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/longConst.urp	Wed Jul 18 17:29:13 2012 -0400
@@ -0,0 +1,2 @@
+$/list
+longConst