Mercurial > urweb

comparison src/postgres.sml @ 873:41971801b62d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
MySQL query gets up to C linking
author Adam Chlipala <adamc@hcoop.net>
date Sun, 12 Jul 2009 13:16:05 -0400
parents 9654bce27cff
children 3c7b48040dcf
comparison
equal deleted inserted replaced
872:9654bce27cff 873:41971801b62d
31 open Print.PD 31 open Print.PD
32 open Print 32 open Print
33 33
34 val ident = String.translate (fn #"'" => "PRIME" 34 val ident = String.translate (fn #"'" => "PRIME"
35 | ch => str ch) 35 | ch => str ch)
36
37 fun p_sql_type t =
38 case t of
39 Int => "int8"
40 | Float => "float8"
41 | String => "text"
42 | Bool => "bool"
43 | Time => "timestamp"
44 | Blob => "bytea"
45 | Channel => "int8"
46 | Client => "int4"
47 | Nullable t => p_sql_type t
36 48
37 fun p_sql_type_base t = 49 fun p_sql_type_base t =
38 case t of 50 case t of
39 Int => "bigint" 51 Int => "bigint"
40 | Float => "double precision" 52 | Float => "double precision"
538 string ")"] 550 string ")"]
539 in 551 in
540 getter t 552 getter t
541 end 553 end
542 554
543 fun queryCommon {loc, query, numCols, doCols} = 555 fun queryCommon {loc, query, cols, doCols} =
544 box [string "int n, i;", 556 box [string "int n, i;",
545 newline, 557 newline,
546 newline, 558 newline,
547 559
548 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating query result.\");", 560 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
562 string "}", 574 string "}",
563 newline, 575 newline,
564 newline, 576 newline,
565 577
566 string "if (PQnfields(res) != ", 578 string "if (PQnfields(res) != ",
567 string (Int.toString numCols), 579 string (Int.toString (length cols)),
568 string ") {", 580 string ") {",
569 newline, 581 newline,
570 box [string "int nf = PQnfields(res);", 582 box [string "int nf = PQnfields(res);",
571 newline, 583 newline,
572 string "PQclear(res);", 584 string "PQclear(res);",
573 newline, 585 newline,
574 string "uw_error(ctx, FATAL, \"", 586 string "uw_error(ctx, FATAL, \"",
575 string (ErrorMsg.spanToString loc), 587 string (ErrorMsg.spanToString loc),
576 string ": Query returned %d columns instead of ", 588 string ": Query returned %d columns instead of ",
577 string (Int.toString numCols), 589 string (Int.toString (length cols)),
578 string ":\\n%s\\n%s\", nf, ", 590 string ":\\n%s\\n%s\", nf, ",
579 query, 591 query,
580 string ", PQerrorMessage(conn));", 592 string ", PQerrorMessage(conn));",
581 newline], 593 newline],
582 string "}", 594 string "}",
596 newline, 608 newline,
597 newline, 609 newline,
598 string "uw_pop_cleanup(ctx);", 610 string "uw_pop_cleanup(ctx);",
599 newline] 611 newline]
600 612
601 fun query {loc, numCols, doCols} = 613 fun query {loc, cols, doCols} =
602 box [string "PGconn *conn = uw_get_db(ctx);", 614 box [string "PGconn *conn = uw_get_db(ctx);",
603 newline, 615 newline,
604 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);", 616 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
605 newline, 617 newline,
606 newline, 618 newline,
607 queryCommon {loc = loc, numCols = numCols, doCols = doCols, query = string "query"}] 619 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}]
608 620
609 fun p_ensql t e = 621 fun p_ensql t e =
610 case t of 622 case t of
611 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"] 623 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
612 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"] 624 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
621 e, 633 e,
622 string " == NULL ? NULL : ", 634 string " == NULL ? NULL : ",
623 p_ensql t (box [string "(*", e, string ")"]), 635 p_ensql t (box [string "(*", e, string ")"]),
624 string ")"] 636 string ")"]
625 637
626 fun queryPrepared {loc, id, query, inputs, numCols, doCols} = 638 fun queryPrepared {loc, id, query, inputs, cols, doCols} =
627 box [string "PGconn *conn = uw_get_db(ctx);", 639 box [string "PGconn *conn = uw_get_db(ctx);",
628 newline, 640 newline,
629 string "const int paramFormats[] = { ", 641 string "const int paramFormats[] = { ",
630 p_list_sep (box [string ",", space]) 642 p_list_sep (box [string ",", space])
631 (fn t => if isBlob t then string "1" else string "0") inputs, 643 (fn t => if isBlob t then string "1" else string "0") inputs,
660 string "\", ", 672 string "\", ",
661 string (Int.toString (length inputs)), 673 string (Int.toString (length inputs)),
662 string ", NULL, paramValues, paramLengths, paramFormats, 0);"], 674 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
663 newline, 675 newline,
664 newline, 676 newline,
665 queryCommon {loc = loc, numCols = numCols, doCols = doCols, query = box [string "\"", 677 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
666 string (String.toString query), 678 string (String.toString query),
667 string "\""]}] 679 string "\""]}]
668 680
669 fun dmlCommon {loc, dml} = 681 fun dmlCommon {loc, dml} =
670 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");", 682 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
671 newline, 683 newline,
672 newline, 684 newline,
819 val () = addDbms {name = "postgres", 831 val () = addDbms {name = "postgres",
820 header = "postgresql/libpq-fe.h", 832 header = "postgresql/libpq-fe.h",
821 link = "-lpq", 833 link = "-lpq",
822 global_init = box [string "void uw_client_init() { }", 834 global_init = box [string "void uw_client_init() { }",
823 newline], 835 newline],
836 p_sql_type = p_sql_type,
824 init = init, 837 init = init,
825 query = query, 838 query = query,
826 queryPrepared = queryPrepared, 839 queryPrepared = queryPrepared,
827 dml = dml, 840 dml = dml,
828 dmlPrepared = dmlPrepared, 841 dmlPrepared = dmlPrepared,