Mercurial > urweb

comparison src/cjr_print.sml @ 1294:b4480a56cab7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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, _) =