Mercurial > urweb
comparison 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 |
comparison
equal
deleted
inserted
replaced
1293:acabf3935060 | 1294:b4480a56cab7 |
---|---|
111 and p_typ env = p_typ' false env | 111 and p_typ env = p_typ' false env |
112 | 112 |
113 fun p_rel env n = string ("__uwr_" ^ ident (#1 (E.lookupERel env n)) ^ "_" ^ Int.toString (E.countERels env - n - 1)) | 113 fun p_rel env n = string ("__uwr_" ^ ident (#1 (E.lookupERel env n)) ^ "_" ^ Int.toString (E.countERels env - n - 1)) |
114 handle CjrEnv.UnboundRel _ => string ("__uwr_UNBOUND_" ^ Int.toString (E.countERels env - n - 1)) | 114 handle CjrEnv.UnboundRel _ => string ("__uwr_UNBOUND_" ^ Int.toString (E.countERels env - n - 1)) |
115 | 115 |
116 fun p_enamed env n = | 116 fun p_enamed' env n = |
117 string ("__uwn_" ^ ident (#1 (E.lookupENamed env n)) ^ "_" ^ Int.toString n) | 117 "__uwn_" ^ ident (#1 (E.lookupENamed env n)) ^ "_" ^ Int.toString n |
118 handle CjrEnv.UnboundNamed _ => string ("__uwn_UNBOUND_" ^ Int.toString n) | 118 handle CjrEnv.UnboundNamed _ => "__uwn_UNBOUND_" ^ Int.toString n |
119 | |
120 fun p_enamed env n = string (p_enamed' env n) | |
119 | 121 |
120 fun p_con_named env n = | 122 fun p_con_named env n = |
121 string ("__uwc_" ^ ident (#1 (E.lookupConstructor env n)) ^ "_" ^ Int.toString n) | 123 string ("__uwc_" ^ ident (#1 (E.lookupConstructor env n)) ^ "_" ^ Int.toString n) |
122 handle CjrEnv.UnboundNamed _ => string ("__uwc_UNBOUND_" ^ Int.toString n) | 124 handle CjrEnv.UnboundNamed _ => string ("__uwc_UNBOUND_" ^ Int.toString n) |
123 | 125 |
2154 string s, | 2156 string s, |
2155 space, | 2157 space, |
2156 string "*/"] | 2158 string "*/"] |
2157 | 2159 |
2158 | DTask _ => box [] | 2160 | DTask _ => box [] |
2161 | DOnError _ => box [] | |
2159 | 2162 |
2160 datatype 'a search = | 2163 datatype 'a search = |
2161 Found of 'a | 2164 Found of 'a |
2162 | NotFound | 2165 | NotFound |
2163 | Error | 2166 | Error |
2789 string "}", | 2792 string "}", |
2790 newline] | 2793 newline] |
2791 | 2794 |
2792 val initializers = List.mapPartial (fn (DTask (Initialize, e), _) => SOME e | _ => NONE) ds | 2795 val initializers = List.mapPartial (fn (DTask (Initialize, e), _) => SOME e | _ => NONE) ds |
2793 | 2796 |
2797 val onError = ListUtil.search (fn (DOnError n, _) => SOME n | _ => NONE) ds | |
2798 | |
2794 val now = Time.now () | 2799 val now = Time.now () |
2795 val nowD = Date.fromTimeUniv now | 2800 val nowD = Date.fromTimeUniv now |
2796 val rfcFmt = "%a, %d %b %Y %H:%M:%S" | 2801 val rfcFmt = "%a, %d %b %Y %H:%M:%S" |
2797 in | 2802 in |
2798 box [string "#include \"", | 2803 box [string "#include \"", |
2955 box [string "static void uw_expunger(uw_context ctx, uw_Basis_client cli) { };", | 2960 box [string "static void uw_expunger(uw_context ctx, uw_Basis_client cli) { };", |
2956 newline, | 2961 newline, |
2957 string "static void uw_initializer(uw_context ctx) { };", | 2962 string "static void uw_initializer(uw_context ctx) { };", |
2958 newline], | 2963 newline], |
2959 | 2964 |
2965 case onError of | |
2966 NONE => box [] | |
2967 | SOME n => box [string "static void uw_onError(uw_context ctx, char *msg) {", | |
2968 newline, | |
2969 box [string "uw_write(ctx, ", | |
2970 p_enamed env n, | |
2971 string "(ctx, msg, uw_unit_v));", | |
2972 newline], | |
2973 string "}", | |
2974 newline, | |
2975 newline], | |
2976 | |
2960 string "uw_app uw_application = {", | 2977 string "uw_app uw_application = {", |
2961 p_list_sep (box [string ",", newline]) string | 2978 p_list_sep (box [string ",", newline]) string |
2962 [Int.toString (SM.foldl Int.max 0 fnums + 1), | 2979 [Int.toString (SM.foldl Int.max 0 fnums + 1), |
2963 Int.toString (Settings.getTimeout ()), | 2980 Int.toString (Settings.getTimeout ()), |
2964 "\"" ^ Settings.getUrlPrefix () ^ "\"", | 2981 "\"" ^ Settings.getUrlPrefix () ^ "\"", |
2965 "uw_client_init", "uw_initializer", "uw_expunger", | 2982 "uw_client_init", "uw_initializer", "uw_expunger", |
2966 "uw_db_init", "uw_db_begin", "uw_db_commit", "uw_db_rollback", "uw_db_close", | 2983 "uw_db_init", "uw_db_begin", "uw_db_commit", "uw_db_rollback", "uw_db_close", |
2967 "uw_handle", | 2984 "uw_handle", |
2968 "uw_input_num", "uw_cookie_sig", "uw_check_url", "uw_check_mime"], | 2985 "uw_input_num", "uw_cookie_sig", "uw_check_url", "uw_check_mime", |
2986 case onError of NONE => "NULL" | SOME _ => "uw_onError"], | |
2969 string "};", | 2987 string "};", |
2970 newline] | 2988 newline] |
2971 end | 2989 end |
2972 | 2990 |
2973 fun p_sql env (ds, _) = | 2991 fun p_sql env (ds, _) = |