Mercurial > urweb
comparison src/cjr_print.sml @ 338:e976b187d73a
SQL sequences
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 14 Sep 2008 11:02:18 -0400 |
parents | 18d5affa790d |
children | 6fd102fa28f9 |
comparison
equal
deleted
inserted
replaced
337:18d5affa790d | 338:e976b187d73a |
---|---|
974 newline, | 974 newline, |
975 string "uw_unit_v;", | 975 string "uw_unit_v;", |
976 newline, | 976 newline, |
977 string "}))"] | 977 string "}))"] |
978 | 978 |
979 | ENextval {seq, prepared} => | |
980 let | |
981 val query = (EFfiApp ("Basis", "strcat", [seq, (EPrim (Prim.String "')"), loc)]), loc) | |
982 val query = (EFfiApp ("Basis", "strcat", [(EPrim (Prim.String "SELECT NEXTVAL('"), loc), query]), loc) | |
983 in | |
984 box [string "(uw_begin_region(ctx), ", | |
985 string "({", | |
986 newline, | |
987 string "PGconn *conn = uw_get_db(ctx);", | |
988 newline, | |
989 case prepared of | |
990 NONE => box [string "char *query = ", | |
991 p_exp env query, | |
992 string ";", | |
993 newline] | |
994 | SOME _ => | |
995 box [], | |
996 newline, | |
997 string "PGresult *res = ", | |
998 case prepared of | |
999 NONE => string "PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);" | |
1000 | SOME n => box [string "PQexecPrepared(conn, \"uw", | |
1001 string (Int.toString n), | |
1002 string "\", 0, NULL, NULL, NULL, 0);"], | |
1003 newline, | |
1004 string "uw_Basis_int n;", | |
1005 newline, | |
1006 newline, | |
1007 | |
1008 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");", | |
1009 newline, | |
1010 newline, | |
1011 | |
1012 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {", | |
1013 newline, | |
1014 box [string "PQclear(res);", | |
1015 newline, | |
1016 string "uw_error(ctx, FATAL, \"", | |
1017 string (ErrorMsg.spanToString loc), | |
1018 string ": Query failed:\\n%s\\n%s\", ", | |
1019 case prepared of | |
1020 NONE => string "query" | |
1021 | SOME _ => p_exp env query, | |
1022 string ", PQerrorMessage(conn));", | |
1023 newline], | |
1024 string "}", | |
1025 newline, | |
1026 newline, | |
1027 | |
1028 string "uw_end_region(ctx);", | |
1029 newline, | |
1030 string "n = PQntuples(res);", | |
1031 newline, | |
1032 string "if (n != 1) {", | |
1033 newline, | |
1034 box [string "PQclear(res);", | |
1035 newline, | |
1036 string "uw_error(ctx, FATAL, \"", | |
1037 string (ErrorMsg.spanToString loc), | |
1038 string ": Wrong number of result rows:\\n%s\\n%s\", ", | |
1039 case prepared of | |
1040 NONE => string "query" | |
1041 | SOME _ => p_exp env query, | |
1042 string ", PQerrorMessage(conn));", | |
1043 newline], | |
1044 string "}", | |
1045 newline, | |
1046 newline, | |
1047 | |
1048 string "n = ", | |
1049 p_unsql true env (TFfi ("Basis", "int"), loc) | |
1050 (string "PQgetvalue(res, 0, 0)"), | |
1051 string ";", | |
1052 newline, | |
1053 string "PQclear(res);", | |
1054 newline, | |
1055 string "n;", | |
1056 newline, | |
1057 string "}))"] | |
1058 end | |
1059 | |
979 and p_exp env = p_exp' false env | 1060 and p_exp env = p_exp' false env |
980 | 1061 |
981 fun p_fun env (fx, n, args, ran, e) = | 1062 fun p_fun env (fx, n, args, ran, e) = |
982 let | 1063 let |
983 val nargs = length args | 1064 val nargs = length args |
1117 end | 1198 end |
1118 | DTable (x, _) => box [string "/* SQL table ", | 1199 | DTable (x, _) => box [string "/* SQL table ", |
1119 string x, | 1200 string x, |
1120 string " */", | 1201 string " */", |
1121 newline] | 1202 newline] |
1203 | DSequence x => box [string "/* SQL sequence ", | |
1204 string x, | |
1205 string " */", | |
1206 newline] | |
1122 | DDatabase s => box [string "static void uw_db_validate(uw_context);", | 1207 | DDatabase s => box [string "static void uw_db_validate(uw_context);", |
1123 newline, | 1208 newline, |
1124 string "static void uw_db_prepare(uw_context);", | 1209 string "static void uw_db_prepare(uw_context);", |
1125 newline, | 1210 newline, |
1126 newline, | 1211 newline, |
1936 space, | 2021 space, |
1937 string "NULL"]) xts, | 2022 string "NULL"]) xts, |
1938 string ");", | 2023 string ");", |
1939 newline, | 2024 newline, |
1940 newline] | 2025 newline] |
2026 | DSequence s => | |
2027 box [string "CREATE SEQUENCE ", | |
2028 string s, | |
2029 string ";", | |
2030 newline, | |
2031 newline] | |
1941 | _ => box [] | 2032 | _ => box [] |
1942 in | 2033 in |
1943 (pp, E.declBinds env dAll) | 2034 (pp, E.declBinds env dAll) |
1944 end) | 2035 end) |
1945 env ds | 2036 env ds |