Mercurial > urweb
diff src/cjr_print.sml @ 1294:b4480a56cab7
Server-side 'onError'
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Tue, 07 Sep 2010 08:28:07 -0400 |
parents | acabf3935060 |
children | 929981850d9d |
line wrap: on
line diff
--- a/src/cjr_print.sml Sun Sep 05 14:00:57 2010 -0400 +++ b/src/cjr_print.sml Tue Sep 07 08:28:07 2010 -0400 @@ -113,9 +113,11 @@ fun p_rel env n = string ("__uwr_" ^ ident (#1 (E.lookupERel env n)) ^ "_" ^ Int.toString (E.countERels env - n - 1)) handle CjrEnv.UnboundRel _ => string ("__uwr_UNBOUND_" ^ Int.toString (E.countERels env - n - 1)) -fun p_enamed env n = - string ("__uwn_" ^ ident (#1 (E.lookupENamed env n)) ^ "_" ^ Int.toString n) - handle CjrEnv.UnboundNamed _ => string ("__uwn_UNBOUND_" ^ Int.toString n) +fun p_enamed' env n = + "__uwn_" ^ ident (#1 (E.lookupENamed env n)) ^ "_" ^ Int.toString n + handle CjrEnv.UnboundNamed _ => "__uwn_UNBOUND_" ^ Int.toString n + +fun p_enamed env n = string (p_enamed' env n) fun p_con_named env n = string ("__uwc_" ^ ident (#1 (E.lookupConstructor env n)) ^ "_" ^ Int.toString n) @@ -2156,6 +2158,7 @@ string "*/"] | DTask _ => box [] + | DOnError _ => box [] datatype 'a search = Found of 'a @@ -2791,6 +2794,8 @@ val initializers = List.mapPartial (fn (DTask (Initialize, e), _) => SOME e | _ => NONE) ds + val onError = ListUtil.search (fn (DOnError n, _) => SOME n | _ => NONE) ds + val now = Time.now () val nowD = Date.fromTimeUniv now val rfcFmt = "%a, %d %b %Y %H:%M:%S" @@ -2957,6 +2962,18 @@ string "static void uw_initializer(uw_context ctx) { };", newline], + case onError of + NONE => box [] + | SOME n => box [string "static void uw_onError(uw_context ctx, char *msg) {", + newline, + box [string "uw_write(ctx, ", + p_enamed env n, + string "(ctx, msg, uw_unit_v));", + newline], + string "}", + newline, + newline], + string "uw_app uw_application = {", p_list_sep (box [string ",", newline]) string [Int.toString (SM.foldl Int.max 0 fnums + 1), @@ -2965,7 +2982,8 @@ "uw_client_init", "uw_initializer", "uw_expunger", "uw_db_init", "uw_db_begin", "uw_db_commit", "uw_db_rollback", "uw_db_close", "uw_handle", - "uw_input_num", "uw_cookie_sig", "uw_check_url", "uw_check_mime"], + "uw_input_num", "uw_cookie_sig", "uw_check_url", "uw_check_mime", + case onError of NONE => "NULL" | SOME _ => "uw_onError"], string "};", newline] end