comparison src/cjr_print.sml @ 1546:133c71008bef

Add prototypes for [un]urlification functions
author Adam Chlipala <adam@chlipala.net>
date Sun, 21 Aug 2011 10:55:31 -0400
parents 5f530f8e3511
children 553a5cc3a4b5
comparison
equal deleted inserted replaced
1545:5f530f8e3511 1546:133c71008bef
522 "" 522 ""
523 else 523 else
524 str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE) 524 str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
525 525
526 local 526 local
527 val urlHandlers = ref ([] : pp_desc list) 527 val urlHandlers = ref ([] : (pp_desc * pp_desc) list)
528 in 528 in
529 529
530 fun addUrlHandler v = urlHandlers := v :: !urlHandlers 530 fun addUrlHandler v = urlHandlers := v :: !urlHandlers
531 531
532 fun latestUrlHandlers () = 532 fun latestUrlHandlers () =
641 (no_arg, has_arg, t) 641 (no_arg, has_arg, t)
642 | _ => raise Fail "CjrPrint: unfooify misclassified Option datatype" 642 | _ => raise Fail "CjrPrint: unfooify misclassified Option datatype"
643 in 643 in
644 unurlifies := IS.add (!unurlifies, i); 644 unurlifies := IS.add (!unurlifies, i);
645 addUrlHandler (box [string "static", 645 addUrlHandler (box [string "static",
646 space,
647 p_typ env t,
648 space,
649 string "*unurlify_",
650 string (Int.toString i),
651 string "(uw_context, char **);",
652 newline],
653 box [string "static",
646 space, 654 space,
647 p_typ env t, 655 p_typ env t,
648 space, 656 space,
649 string "*unurlify_", 657 string "*unurlify_",
650 string (Int.toString i), 658 string (Int.toString i),
797 space, 805 space,
798 p_typ env (t, ErrorMsg.dummySpan), 806 p_typ env (t, ErrorMsg.dummySpan),
799 space, 807 space,
800 string "unurlify_", 808 string "unurlify_",
801 string (Int.toString i), 809 string (Int.toString i),
810 string "(uw_context, char **);",
811 newline],
812 box [string "static",
813 space,
814 p_typ env (t, ErrorMsg.dummySpan),
815 space,
816 string "unurlify_",
817 string (Int.toString i),
802 string "(uw_context ctx, char **request) {", 818 string "(uw_context ctx, char **request) {",
803 newline, 819 newline,
804 box [string "return", 820 box [string "return",
805 space, 821 space,
806 doEm xncs, 822 doEm xncs,
821 string (Int.toString i), 837 string (Int.toString i),
822 string ("(ctx, " ^ deStar request ^ ")")] 838 string ("(ctx, " ^ deStar request ^ ")")]
823 else 839 else
824 (unurlifies := IS.add (!unurlifies, i); 840 (unurlifies := IS.add (!unurlifies, i);
825 addUrlHandler (box [string "static", 841 addUrlHandler (box [string "static",
842 space,
843 p_typ env (t, loc),
844 space,
845 string "unurlify_list_",
846 string (Int.toString i),
847 string "(uw_context, char **);",
848 newline],
849 box [string "static",
826 space, 850 space,
827 p_typ env (t, loc), 851 p_typ env (t, loc),
828 space, 852 space,
829 string "unurlify_list_", 853 string "unurlify_list_",
830 string (Int.toString i), 854 string (Int.toString i),
1035 space, 1059 space,
1036 string "void", 1060 string "void",
1037 space, 1061 space,
1038 string "urlify_", 1062 string "urlify_",
1039 string (Int.toString i), 1063 string (Int.toString i),
1064 string "(uw_context,",
1065 space,
1066 p_typ env t,
1067 space,
1068 if isUnboxable t then
1069 box []
1070 else
1071 string "*",
1072 string ");",
1073 newline],
1074 box [string "static",
1075 space,
1076 string "void",
1077 space,
1078 string "urlify_",
1079 string (Int.toString i),
1040 string "(uw_context ctx,", 1080 string "(uw_context ctx,",
1041 space, 1081 space,
1042 p_typ env t, 1082 p_typ env t,
1043 space, 1083 space,
1044 if isUnboxable t then 1084 if isUnboxable t then
1151 space, 1191 space,
1152 string "void", 1192 string "void",
1153 space, 1193 space,
1154 string "urlify_", 1194 string "urlify_",
1155 string (Int.toString i), 1195 string (Int.toString i),
1196 string "(uw_context,",
1197 space,
1198 p_typ env t,
1199 string ");",
1200 newline],
1201 box [string "static",
1202 space,
1203 string "void",
1204 space,
1205 string "urlify_",
1206 string (Int.toString i),
1156 string "(uw_context ctx,", 1207 string "(uw_context ctx,",
1157 space, 1208 space,
1158 p_typ env t, 1209 p_typ env t,
1159 space, 1210 space,
1160 string "it0) {", 1211 string "it0) {",
1219 string ");", 1270 string ");",
1220 newline] 1271 newline]
1221 else 1272 else
1222 (urlifiesL := IS.add (!urlifiesL, i); 1273 (urlifiesL := IS.add (!urlifiesL, i);
1223 addUrlHandler (box [string "static", 1274 addUrlHandler (box [string "static",
1275 space,
1276 string "void",
1277 space,
1278 string "urlifyl_",
1279 string (Int.toString i),
1280 string "(uw_context,",
1281 space,
1282 string "struct __uws_",
1283 string (Int.toString i),
1284 space,
1285 string "*);",
1286 newline],
1287 box [string "static",
1224 space, 1288 space,
1225 string "void", 1289 string "void",
1226 space, 1290 space,
1227 string "urlifyl_", 1291 string "urlifyl_",
1228 string (Int.toString i), 1292 string (Int.toString i),
2321 self := NONE) 2385 self := NONE)
2322 2386
2323 val (pds, env) = ListUtil.foldlMap (fn (d, env) => 2387 val (pds, env) = ListUtil.foldlMap (fn (d, env) =>
2324 let 2388 let
2325 val d' = p_decl env d 2389 val d' = p_decl env d
2390 val hs = latestUrlHandlers ()
2391 val (protos, defs) = ListPair.unzip hs
2326 in 2392 in
2327 (box (List.revAppend (latestUrlHandlers (), [d'])), 2393 (box (List.revAppend (protos, (List.revAppend (defs, [d'])))),
2328 E.declBinds env d) 2394 E.declBinds env d)
2329 end) 2395 end)
2330 env ds 2396 env ds
2331 2397
2332 fun flatFields always (t : typ) = 2398 fun flatFields always (t : typ) =
2846 let 2912 let
2847 val p' = p_page p 2913 val p' = p_page p
2848 in 2914 in
2849 (p', latestUrlHandlers () @ handlers) 2915 (p', latestUrlHandlers () @ handlers)
2850 end) [] ps 2916 end) [] ps
2851 2917 val (protos, defs) = ListPair.unzip handlers
2918
2852 val hasDb = ref false 2919 val hasDb = ref false
2853 val tables = ref [] 2920 val tables = ref []
2854 val views = ref [] 2921 val views = ref []
2855 val sequences = ref [] 2922 val sequences = ref []
2856 val dbstring = ref "" 2923 val dbstring = ref ""
3118 newline], 3185 newline],
3119 string "}", 3186 string "}",
3120 newline, 3187 newline,
3121 newline, 3188 newline,
3122 3189
3123 box (rev handlers), 3190 box (rev protos),
3191 box (rev defs),
3124 3192
3125 string "static void uw_handle(uw_context ctx, char *request) {", 3193 string "static void uw_handle(uw_context ctx, char *request) {",
3126 newline, 3194 newline,
3127 string "if (!strcmp(request, \"", 3195 string "if (!strcmp(request, \"",
3128 string app_js, 3196 string app_js,