summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2012-07-18 17:29:13 -0400
committerGravatar Adam Chlipala <adam@chlipala.net>2012-07-18 17:29:13 -0400
commitdb71493ffd90e2668259efbb549f7a781c2530db (patch)
treeeda48e786ad2690ca0f2dc994a44290d74302129 /src
parente2b9068b56e352d5e3680fe5e4e0849169c5f419 (diff)
Support fancy expressions in module-level 'val' declarations
Diffstat (limited to 'src')
-rw-r--r--src/c/urweb.c30
-rw-r--r--src/cjr_print.sml29
2 files changed, 45 insertions, 14 deletions
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 802a1620..d0b6987c 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -465,6 +465,8 @@ struct uw_context {
unsigned nextId;
+ int amInitializing;
+
char error_message[ERROR_BUF_LEN];
};
@@ -536,6 +538,8 @@ uw_context uw_init(int id, void *logger_data, uw_logger log_debug) {
ctx->nextId = 0;
+ ctx->amInitializing = 0;
+
return ctx;
}
@@ -613,6 +617,7 @@ void uw_reset_keep_error_message(uw_context ctx) {
ctx->script_header = "";
ctx->queryString = NULL;
ctx->nextId = 0;
+ ctx->amInitializing = 0;
}
void uw_reset_keep_request(uw_context ctx) {
@@ -1204,14 +1209,31 @@ void uw_set_heap_front(uw_context ctx, char *fr) {
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);
+ if (ctx->amInitializing) {
+ result = malloc(len);
- result = ctx->heap.front;
- ctx->heap.front += len;
- return result;
+ 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 --git a/src/cjr_print.sml b/src/cjr_print.sml
index 5c087fe0..c7be5526 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2320,6 +2320,8 @@ fun p_fun isRec env (fx, n, args, ran, e) =
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 @@ fun p_decl env (dAll as (d, _) : decl) =
| 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 @@ fun p_file env (ds, ps) =
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 @@ fun p_file env (ds, ps) =
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,