Mercurial > urweb

comparison src/cjr_print.sml @ 338:e976b187d73a

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