Mercurial > urweb

comparison src/cjr_print.sml @ 640:63b0bcacd535

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
RPC returning a default datatype
author Adam Chlipala <adamc@hcoop.net>
date Sun, 08 Mar 2009 13:28:21 -0400
parents 9da62680adc5
children b98f547a6a45
comparison
equal deleted inserted replaced
639:9da62680adc5 640:63b0bcacd535
1002 newline, 1002 newline,
1003 string "});", 1003 string "});",
1004 newline] 1004 newline]
1005 end 1005 end
1006 1006
1007 | TDatatype (Default, i, _) => box [] 1007 | TDatatype (Default, i, _) =>
1008 (*if IS.member (rf, i) then 1008 if IS.member (rf, i) then
1009 box [string "unurlify_", 1009 box [string "urlify_",
1010 string (Int.toString i), 1010 string (Int.toString i),
1011 string "()"] 1011 string "(it",
1012 string (Int.toString level),
1013 string ");",
1014 newline]
1012 else 1015 else
1013 let 1016 let
1014 val (x, xncs) = E.lookupDatatype env i 1017 val (x, xncs) = E.lookupDatatype env i
1015 1018
1016 val rf = IS.add (rf, i) 1019 val rf = IS.add (rf, i)
1017 1020
1018 fun doEm xncs = 1021 fun doEm xncs =
1019 case xncs of 1022 case xncs of
1020 [] => string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype " 1023 [] => box [string ("uw_error(ctx, FATAL, \"Error urlifying datatype "
1021 ^ x ^ "\"), NULL)") 1024 ^ x ^ " (%d)\", it0->data);"),
1025 newline]
1022 | (x', n, to) :: rest => 1026 | (x', n, to) :: rest =>
1023 box [string "((!strncmp(request, \"", 1027 box [string "if",
1024 string x',
1025 string "\", ",
1026 string (Int.toString (size x')),
1027 string ") && (request[",
1028 string (Int.toString (size x')),
1029 string "] == 0 || request[",
1030 string (Int.toString (size x')),
1031 string "] == '/')) ? ({",
1032 newline,
1033 string "struct",
1034 space, 1028 space,
1035 string ("__uwd_" ^ ident x ^ "_" ^ Int.toString i), 1029 string "(it0->tag==__uwc_",
1036 space, 1030 string (ident x'),
1037 string "*tmp = uw_malloc(ctx, sizeof(struct __uwd_",
1038 string x,
1039 string "_", 1031 string "_",
1040 string (Int.toString i), 1032 string (Int.toString n),
1041 string "));", 1033 string ") {",
1042 newline,
1043 string "tmp->tag",
1044 space,
1045 string "=",
1046 space,
1047 string ("__uwc_" ^ ident x' ^ "_" ^ Int.toString n),
1048 string ";",
1049 newline,
1050 string "request",
1051 space,
1052 string "+=",
1053 space,
1054 string (Int.toString (size x')),
1055 string ";",
1056 newline,
1057 string "if (request[0] == '/') ++request;",
1058 newline, 1034 newline,
1059 case to of 1035 case to of
1060 NONE => box [] 1036 NONE => box [string "uw_write(ctx, \"",
1061 | SOME (t, _) => box [string "tmp->data.uw_", 1037 string x',
1062 p_ident x', 1038 string "\");",
1063 space, 1039 newline]
1064 string "=", 1040 | SOME t => box [string "uw_write(ctx, \"",
1065 space, 1041 string x',
1066 unurlify' rf t, 1042 string "/\");",
1067 string ";", 1043 newline,
1068 newline], 1044 p_typ env t,
1069 string "tmp;", 1045 space,
1046 string "it1",
1047 space,
1048 string "=",
1049 space,
1050 string "it0->data.uw_",
1051 string x',
1052 string ";",
1053 newline,
1054 urlify' rf 1 t,
1055 newline],
1056 string "} else {",
1070 newline, 1057 newline,
1071 string "})", 1058 box [doEm rest,
1072 space, 1059 newline],
1073 string ":", 1060 string "}",
1074 space, 1061 newline]
1075 doEm rest,
1076 string ")"]
1077 in 1062 in
1078 box [string "({", 1063 box [string "({",
1079 space, 1064 space,
1080 p_typ env (t, ErrorMsg.dummySpan), 1065 string "void",
1081 space, 1066 space,
1082 string "unurlify_", 1067 string "urlify_",
1083 string (Int.toString i), 1068 string (Int.toString i),
1084 string "(void) {", 1069 string "(",
1070 p_typ env t,
1071 space,
1072 string "it0) {",
1085 newline, 1073 newline,
1086 box [string "return", 1074 box [doEm xncs,
1087 space,
1088 doEm xncs,
1089 string ";",
1090 newline], 1075 newline],
1076 newline,
1091 string "}", 1077 string "}",
1092 newline, 1078 newline,
1079
1080 string "urlify_",
1081 string (Int.toString i),
1082 string "(it",
1083 string (Int.toString level),
1084 string ");",
1093 newline, 1085 newline,
1094 1086 string "});",
1095 string "unurlify_", 1087 newline]
1096 string (Int.toString i), 1088 end
1097 string "();",
1098 newline,
1099 string "})"]
1100 end*)
1101 1089
1102 | TOption t => box [] 1090 | TOption t => box []
1103 (*box [string "(request[0] == '/' ? ++request : request, ", 1091 (*box [string "(request[0] == '/' ? ++request : request, ",
1104 string "((!strncmp(request, \"None\", 4) ", 1092 string "((!strncmp(request, \"None\", 4) ",
1105 string "&& (request[4] == 0 || request[4] == '/')) ", 1093 string "&& (request[4] == 0 || request[4] == '/')) ",
1437 val outputs = ListMergeSort.sort (fn ((s1, _), (s2, _)) => String.compare (s1, s2) = GREATER) outputs 1425 val outputs = ListMergeSort.sort (fn ((s1, _), (s2, _)) => String.compare (s1, s2) = GREATER) outputs
1438 1426
1439 val wontLeakStrings = notLeaky env true state 1427 val wontLeakStrings = notLeaky env true state
1440 val wontLeakAnything = notLeaky env false state 1428 val wontLeakAnything = notLeaky env false state
1441 in 1429 in
1442 box [string "(uw_begin_region(ctx), ", 1430 box [if wontLeakAnything then
1443 if wontLeakAnything then
1444 string "uw_begin_region(ctx), " 1431 string "uw_begin_region(ctx), "
1445 else 1432 else
1446 box [], 1433 box [],
1447 string "({", 1434 string "({",
1448 newline, 1435 newline,
1449 string "PGconn *conn = uw_get_db(ctx);", 1436 string "PGconn *conn = uw_get_db(ctx);",
1450 newline, 1437 newline,
1438 p_typ env state,
1439 space,
1440 string "acc",
1441 space,
1442 string "=",
1443 space,
1444 p_exp env initial,
1445 string ";",
1446 newline,
1447 string "int n, i, dummy = (uw_begin_region(ctx), 0);",
1448 newline,
1449
1451 case prepared of 1450 case prepared of
1452 NONE => box [string "char *query = ", 1451 NONE => box [string "char *query = ",
1453 p_exp env query, 1452 p_exp env query,
1454 string ";", 1453 string ";",
1455 newline] 1454 newline]
1479 ets, 1478 ets,
1480 string " };", 1479 string " };",
1481 newline, 1480 newline,
1482 newline] 1481 newline]
1483 end, 1482 end,
1484 string "int n, i;", 1483
1485 newline,
1486 p_typ env state,
1487 space,
1488 string "acc",
1489 space,
1490 string "=",
1491 space,
1492 p_exp env initial,
1493 string ";",
1494 newline,
1495 string "PGresult *res = ", 1484 string "PGresult *res = ",
1496 case prepared of 1485 case prepared of
1497 NONE => string "PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);" 1486 NONE => string "PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);"
1498 | SOME n => box [string "PQexecPrepared(conn, \"uw", 1487 | SOME n => box [string "PQexecPrepared(conn, \"uw",
1499 string (Int.toString n), 1488 string (Int.toString n),
1587 newline] 1576 newline]
1588 else 1577 else
1589 box [], 1578 box [],
1590 string "acc;", 1579 string "acc;",
1591 newline, 1580 newline,
1592 string "}))"] 1581 string "})"]
1593 end 1582 end
1594 1583
1595 | EDml {dml, prepared} => 1584 | EDml {dml, prepared} =>
1596 box [string "(uw_begin_region(ctx), ({", 1585 box [string "(uw_begin_region(ctx), ({",
1597 newline, 1586 newline,