Mercurial > urweb

comparison src/cjr_print.sml @ 1348:8a169fc0838b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Change tasks to support parametric code; add clientLeaves
author Adam Chlipala <adam@chlipala.net>
date Sat, 18 Dec 2010 14:17:45 -0500
parents b106ca8200b1
children 87156c44824f
comparison
equal deleted inserted replaced
1347:b106ca8200b1 1348:8a169fc0838b
2792 string "return 0;", 2792 string "return 0;",
2793 newline], 2793 newline],
2794 string "}", 2794 string "}",
2795 newline] 2795 newline]
2796 2796
2797 val initializers = List.mapPartial (fn (DTask (Initialize, e), _) => SOME e | _ => NONE) ds 2797 val initializers = List.mapPartial (fn (DTask (Initialize, x1, x2, e), _) => SOME (x1, x2, e) | _ => NONE) ds
2798 val expungers = List.mapPartial (fn (DTask (ClientLeaves, x1, x2, e), _) => SOME (x1, x2, e) | _ => NONE) ds
2798 2799
2799 val onError = ListUtil.search (fn (DOnError n, _) => SOME n | _ => NONE) ds 2800 val onError = ListUtil.search (fn (DOnError n, _) => SOME n | _ => NONE) ds
2800 2801
2801 val now = Time.now () 2802 val now = Time.now ()
2802 val nowD = Date.fromTimeUniv now 2803 val nowD = Date.fromTimeUniv now
2966 newline, 2967 newline,
2967 string "}", 2968 string "}",
2968 newline, 2969 newline,
2969 newline, 2970 newline,
2970 2971
2971 if hasDb then 2972 box [string "static void uw_expunger(uw_context ctx, uw_Basis_client cli) {",
2972 box [string "static void uw_expunger(uw_context ctx, uw_Basis_client cli) {", 2973 newline,
2973 newline, 2974
2975 p_list_sep (box []) (fn (x1, x2, e) => box [string "({",
2976 newline,
2977 string "uw_Basis_client __uwr_",
2978 string x1,
2979 string "_0 = cli;",
2980 newline,
2981 string "uw_unit __uwr_",
2982 string x2,
2983 string "_1 = uw_unit_v;",
2984 newline,
2985 p_exp (E.pushERel (E.pushERel env x1 (TFfi ("Basis", "client"), ErrorMsg.dummySpan))
2986 x2 dummyt) e,
2987 string ";",
2988 newline,
2989 string "});",
2990 newline]) expungers,
2991
2992 if hasDb then
2974 box [p_enamed env (!expunge), 2993 box [p_enamed env (!expunge),
2975 string "(ctx, cli);", 2994 string "(ctx, cli);",
2976 newline], 2995 newline]
2977 string "}", 2996 else
2978 newline, 2997 box [],
2979 newline, 2998 string "}"],
2980 2999
2981 string "static void uw_initializer(uw_context ctx) {", 3000 newline,
2982 newline, 3001 string "static void uw_initializer(uw_context ctx) {",
2983 box [p_list_sep (box []) (fn e => box [p_exp env e, 3002 newline,
2984 string ";", 3003 box [p_list_sep (box []) (fn (x1, x2, e) => box [string "({",
2985 newline]) initializers, 3004 newline,
2986 p_enamed env (!initialize), 3005 string "uw_unit __uwr_",
3006 string x1,
3007 string "_0 = uw_unit_v, __uwr_",
3008 string x2,
3009 string "_1 = uw_unit_v;",
3010 newline,
3011 p_exp (E.pushERel (E.pushERel env x1 dummyt) x2 dummyt) e,
3012 string ";",
3013 newline,
3014 string "});",
3015 newline]) initializers,
3016 if hasDb then
3017 box [p_enamed env (!initialize),
2987 string "(ctx, uw_unit_v);", 3018 string "(ctx, uw_unit_v);",
2988 newline], 3019 newline]
2989 string "}", 3020 else
2990 newline] 3021 box []],
2991 else 3022 string "}",
2992 box [string "static void uw_expunger(uw_context ctx, uw_Basis_client cli) { };", 3023 newline,
2993 newline,
2994 string "static void uw_initializer(uw_context ctx) { };",
2995 newline],
2996 3024
2997 case onError of 3025 case onError of
2998 NONE => box [] 3026 NONE => box []
2999 | SOME n => box [string "static void uw_onError(uw_context ctx, char *msg) {", 3027 | SOME n => box [string "static void uw_onError(uw_context ctx, char *msg) {",
3000 newline, 3028 newline,