Mercurial > urweb
changeset 1782:61c7eb1d3867
Support fancy expressions in module-level 'val' declarations
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Wed, 18 Jul 2012 17:29:13 -0400 |
| parents | 25824a0e8bf1 |
| children | 5bc4fbf9c0fe |
| files | include/urweb/urweb.h src/c/urweb.c src/cjr_print.sml tests/longConst.ur tests/longConst.urp |
| diffstat | 5 files changed, 63 insertions(+), 15 deletions(-) [+] |
line wrap: on
line diff
--- 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
--- 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) {
--- 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,
--- /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>