Mercurial > urweb

comparison src/cjr_print.sml @ 272:4d80d6122df1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initializing database connection
author Adam Chlipala <adamc@hcoop.net>
date Tue, 02 Sep 2008 11:57:25 -0400
parents 42dfb0d61cf0
children 09c66a30ef32
comparison
equal deleted inserted replaced
271:42dfb0d61cf0 272:4d80d6122df1
531 string ")"] 531 string ")"]
532 | ELet (x, t, e1, e2) => box [string "({", 532 | ELet (x, t, e1, e2) => box [string "({",
533 newline, 533 newline,
534 p_typ env t, 534 p_typ env t,
535 space, 535 space,
536 p_rel env 0, 536 string "__lwr_",
537 string x,
538 string "_",
539 string (Int.toString (E.countERels env)),
537 space, 540 space,
538 string "=", 541 string "=",
539 space, 542 space,
540 p_exp env e1, 543 p_exp env e1,
541 string ";", 544 string ";",
544 string ";", 547 string ";",
545 newline, 548 newline,
546 string "})"] 549 string "})"]
547 550
548 | EQuery {exps, tables, rnum, state, query, body, initial} => 551 | EQuery {exps, tables, rnum, state, query, body, initial} =>
549 box [string "query[", 552 string "(lw_error(ctx, FATAL, \"I would have run a query.\"), NULL)"
550 p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) exps,
551 string "] [",
552 p_list (fn (x, xts) => box [string x,
553 space,
554 string ":",
555 space,
556 string "{",
557 p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) xts,
558 string "}"]) tables,
559 string "] [",
560 p_typ env state,
561 string "] [",
562 string (Int.toString rnum),
563 string "]",
564 space,
565 p_exp env query,
566 space,
567 string "initial",
568 space,
569 p_exp env initial,
570 space,
571 string "in",
572 space,
573 p_exp (E.pushERel (E.pushERel env "r" dummyt) "acc" dummyt) body]
574 553
575 and p_exp env = p_exp' false env 554 and p_exp env = p_exp' false env
576 555
577 fun p_fun env (fx, n, args, ran, e) = 556 fun p_fun env (fx, n, args, ran, e) =
578 let 557 let
707 string ");"]) vis, 686 string ");"]) vis,
708 newline, 687 newline,
709 p_list_sep newline (p_fun env) vis, 688 p_list_sep newline (p_fun env) vis,
710 newline] 689 newline]
711 end 690 end
712 | DDatabase s => box [string "database", 691 | DDatabase s => box [string "void lw_db_init(lw_context ctx) {",
713 space, 692 newline,
714 string s] 693 string "PGconn *conn = PQconnectdb(\"",
694 string (String.toString s),
695 string "\");",
696 newline,
697 string "if (conn == NULL) lw_error(ctx, BOUNDED_RETRY, ",
698 string "\"libpq can't allocate a connection.\");",
699 newline,
700 string "if (PQstatus(conn) != CONNECTION_OK) {",
701 newline,
702 box [string "char msg[1024];",
703 newline,
704 string "strncpy(msg, PQerrorMessage(conn), 1024);",
705 newline,
706 string "msg[1023] = 0;",
707 newline,
708 string "PQfinish(conn);",
709 newline,
710 string "lw_error(ctx, BOUNDED_RETRY, ",
711 string "\"Connection to Postgres server failed: %s\", msg);"],
712 newline,
713 string "}",
714 newline,
715 string "lw_set_db(ctx, conn);",
716 newline,
717 string "}",
718 newline,
719 newline,
720 string "void lw_db_close(lw_context ctx) {",
721 newline,
722 string "PQfinish(lw_get_db(ctx));",
723 newline,
724 string "}",
725 newline]
715 726
716 datatype 'a search = 727 datatype 'a search =
717 Found of 'a 728 Found of 'a
718 | NotFound 729 | NotFound
719 | Error 730 | Error
1170 defInputs, 1181 defInputs,
1171 p_enamed env n, 1182 p_enamed env n,
1172 string "(", 1183 string "(",
1173 p_list_sep (box [string ",", space]) 1184 p_list_sep (box [string ",", space])
1174 (fn x => x) 1185 (fn x => x)
1175 (string "ctx" :: ListUtil.mapi (fn (i, _) => string ("arg" ^ Int.toString i)) ts), 1186 (string "ctx"
1187 :: ListUtil.mapi (fn (i, _) => string ("arg" ^ Int.toString i)) ts
1188 @ [string "lw_unit_v"]),
1176 inputsVar, 1189 inputsVar,
1177 string ");", 1190 string ");",
1178 newline, 1191 newline,
1179 string "return;", 1192 string "return;",
1180 newline, 1193 newline,
1188 in 1201 in
1189 box [string "#include <stdio.h>", 1202 box [string "#include <stdio.h>",
1190 newline, 1203 newline,
1191 string "#include <stdlib.h>", 1204 string "#include <stdlib.h>",
1192 newline, 1205 newline,
1206 string "#include <string.h>",
1207 newline,
1208 string "#include <postgresql/libpq-fe.h>",
1209 newline,
1193 newline, 1210 newline,
1194 string "#include \"urweb.h\"", 1211 string "#include \"urweb.h\"",
1195 newline, 1212 newline,
1196 newline, 1213 newline,
1197 p_list_sep newline (fn x => x) pds, 1214 p_list_sep newline (fn x => x) pds,