diff options
author | Adam Chlipala <adamc@hcoop.net> | 2008-09-02 11:57:25 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2008-09-02 11:57:25 -0400 |
commit | 48a39b87c0f2b01c85e1bb78072387e30ab0f235 (patch) | |
tree | ce3a9139ccc98bb2c4d7034e44138b10c2221545 /src/cjr_print.sml | |
parent | b4398c433195b75d5e03d0774b1128fae14e9f41 (diff) |
Initializing database connection
Diffstat (limited to 'src/cjr_print.sml')
-rw-r--r-- | src/cjr_print.sml | 77 |
1 files changed, 47 insertions, 30 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml index cefcad44..fd534c4a 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -533,7 +533,10 @@ fun p_exp' par env (e, loc) = newline, p_typ env t, space, - p_rel env 0, + string "__lwr_", + string x, + string "_", + string (Int.toString (E.countERels env)), space, string "=", space, @@ -546,31 +549,7 @@ fun p_exp' par env (e, loc) = string "})"] | EQuery {exps, tables, rnum, state, query, body, initial} => - box [string "query[", - p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) exps, - string "] [", - p_list (fn (x, xts) => box [string x, - space, - string ":", - space, - string "{", - p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) xts, - string "}"]) tables, - string "] [", - p_typ env state, - string "] [", - string (Int.toString rnum), - string "]", - space, - p_exp env query, - space, - string "initial", - space, - p_exp env initial, - space, - string "in", - space, - p_exp (E.pushERel (E.pushERel env "r" dummyt) "acc" dummyt) body] + string "(lw_error(ctx, FATAL, \"I would have run a query.\"), NULL)" and p_exp env = p_exp' false env @@ -709,9 +688,41 @@ fun p_decl env (dAll as (d, _) : decl) = p_list_sep newline (p_fun env) vis, newline] end - | DDatabase s => box [string "database", - space, - string s] + | DDatabase s => box [string "void lw_db_init(lw_context ctx) {", + newline, + string "PGconn *conn = PQconnectdb(\"", + string (String.toString s), + string "\");", + newline, + string "if (conn == NULL) lw_error(ctx, BOUNDED_RETRY, ", + string "\"libpq can't allocate a connection.\");", + newline, + string "if (PQstatus(conn) != CONNECTION_OK) {", + newline, + box [string "char msg[1024];", + newline, + string "strncpy(msg, PQerrorMessage(conn), 1024);", + newline, + string "msg[1023] = 0;", + newline, + string "PQfinish(conn);", + newline, + string "lw_error(ctx, BOUNDED_RETRY, ", + string "\"Connection to Postgres server failed: %s\", msg);"], + newline, + string "}", + newline, + string "lw_set_db(ctx, conn);", + newline, + string "}", + newline, + newline, + string "void lw_db_close(lw_context ctx) {", + newline, + string "PQfinish(lw_get_db(ctx));", + newline, + string "}", + newline] datatype 'a search = Found of 'a @@ -1172,7 +1183,9 @@ fun p_file env (ds, ps) = string "(", p_list_sep (box [string ",", space]) (fn x => x) - (string "ctx" :: ListUtil.mapi (fn (i, _) => string ("arg" ^ Int.toString i)) ts), + (string "ctx" + :: ListUtil.mapi (fn (i, _) => string ("arg" ^ Int.toString i)) ts + @ [string "lw_unit_v"]), inputsVar, string ");", newline, @@ -1190,6 +1203,10 @@ fun p_file env (ds, ps) = newline, string "#include <stdlib.h>", newline, + string "#include <string.h>", + newline, + string "#include <postgresql/libpq-fe.h>", + newline, newline, string "#include \"urweb.h\"", newline, |