Mercurial > urweb

comparison src/cjr_print.sml @ 282:0236d9412ad2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Ran a prepared statement with one string parameter
author Adam Chlipala <adamc@hcoop.net>
date Sun, 07 Sep 2008 09:28:13 -0400
parents fdd7a698be01
children c0e4ac23522d
comparison
equal deleted inserted replaced
281:7d5860add50f 282:0236d9412ad2
331 string " ? lw_Basis_True : lw_Basis_False)"] 331 string " ? lw_Basis_True : lw_Basis_False)"]
332 | _ => (ErrorMsg.errorAt loc "Don't know how to unmarshal type from SQL"; 332 | _ => (ErrorMsg.errorAt loc "Don't know how to unmarshal type from SQL";
333 Print.eprefaces' [("Type", p_typ env tAll)]; 333 Print.eprefaces' [("Type", p_typ env tAll)];
334 string "ERROR") 334 string "ERROR")
335 335
336 datatype sql_type =
337 Int
338 | Float
339 | String
340 | Bool
341
342 fun p_sql_type t =
343 string (case t of
344 Int => "lw_Basis_int"
345 | Float => "lw_Basis_float"
346 | String => "lw_Basis_string"
347 | Bool => "lw_Basis_bool")
348
349 fun getPargs (e, _) =
350 case e of
351 EPrim (Prim.String _) => []
352 | EFfiApp ("Basis", "strcat", [e1, e2]) => getPargs e1 @ getPargs e2
353
354 | EFfiApp ("Basis", "sqlifyInt", [e]) => [(e, Int)]
355 | EFfiApp ("Basis", "sqlifyFloat", [e]) => [(e, Float)]
356 | EFfiApp ("Basis", "sqlifyString", [e]) => [(e, String)]
357 | EFfiApp ("Basis", "sqlifyBool", [e]) => [(e, Bool)]
358
359 | _ => raise Fail "CjrPrint: getPargs"
360
361 fun p_ensql t e =
362 case t of
363 Int => box [string "(char *)&", e]
364 | Float => box [string "(char *)&", e]
365 | String => e
366 | Bool => box [string "lw_Basis_ensqlBool(", e, string ")"]
367
368 fun p_ensql_len t e =
369 case t of
370 Int => string "sizeof(lw_Basis_int)"
371 | Float => string "sizeof(lw_Basis_float)"
372 | String => box [string "strlen(", e, string ")"]
373 | Bool => string "sizeof(lw_Basis_bool)"
374
336 fun p_exp' par env (e, loc) = 375 fun p_exp' par env (e, loc) =
337 case e of 376 case e of
338 EPrim p => Prim.p_t_GCC p 377 EPrim p => Prim.p_t_GCC p
339 | ERel n => p_rel env n 378 | ERel n => p_rel env n
340 | ENamed n => p_enamed env n 379 | ENamed n => p_enamed env n
558 p_exp (E.pushERel env x t) e2, 597 p_exp (E.pushERel env x t) e2,
559 string ";", 598 string ";",
560 newline, 599 newline,
561 string "})"] 600 string "})"]
562 601
563 | EQuery {exps, tables, rnum, state, query, body, initial} => 602 | EQuery {exps, tables, rnum, state, query, body, initial, prepared} =>
564 let 603 let
565 val exps = map (fn (x, t) => ("__lwf_" ^ x, t)) exps 604 val exps = map (fn (x, t) => ("__lwf_" ^ x, t)) exps
566 val tables = ListUtil.mapConcat (fn (x, xts) => 605 val tables = ListUtil.mapConcat (fn (x, xts) =>
567 map (fn (x', t) => ("__lwf_" ^ x ^ ".__lwf_" ^ x', t)) xts) 606 map (fn (x', t) => ("__lwf_" ^ x ^ ".__lwf_" ^ x', t)) xts)
568 tables 607 tables
571 in 610 in
572 box [string "({", 611 box [string "({",
573 newline, 612 newline,
574 string "PGconn *conn = lw_get_db(ctx);", 613 string "PGconn *conn = lw_get_db(ctx);",
575 newline, 614 newline,
576 string "char *query = ", 615 case prepared of
577 p_exp env query, 616 NONE => box [string "char *query = ",
578 string ";", 617 p_exp env query,
579 newline, 618 string ";",
619 newline]
620 | SOME _ =>
621 let
622 val ets = getPargs query
623 in
624 box [p_list_sepi newline
625 (fn i => fn (e, t) =>
626 box [p_sql_type t,
627 space,
628 string "arg",
629 string (Int.toString (i + 1)),
630 space,
631 string "=",
632 space,
633 p_exp env e,
634 string ";"])
635 ets,
636 newline,
637 newline,
638
639 string "const char *paramValues[] = { ",
640 p_list_sepi (box [string ",", space])
641 (fn i => fn (_, t) => p_ensql t (box [string "arg",
642 string (Int.toString (i + 1))]))
643 ets,
644 string " };",
645 newline,
646 newline,
647
648 string "const int paramLengths[] = { ",
649 p_list_sepi (box [string ",", space])
650 (fn i => fn (_, t) => p_ensql_len t (box [string "arg",
651 string (Int.toString (i + 1))]))
652 ets,
653 string " };",
654 newline,
655 newline,
656
657 string "const static int paramFormats[] = { ",
658 p_list_sep (box [string ",", space]) (fn _ => string "1") ets,
659 string " };",
660 newline,
661 newline]
662 end,
580 string "int n, i;", 663 string "int n, i;",
581 newline, 664 newline,
582 p_typ env state, 665 p_typ env state,
583 space, 666 space,
584 string "acc", 667 string "acc",
586 string "=", 669 string "=",
587 space, 670 space,
588 p_exp env initial, 671 p_exp env initial,
589 string ";", 672 string ";",
590 newline, 673 newline,
591 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 1);", 674 string "PGresult *res = ",
675 case prepared of
676 NONE => string "PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 1);"
677 | SOME n => box [string "PQexecPrepared(conn, \"lw",
678 string (Int.toString n),
679 string "\", ",
680 string (Int.toString (length (getPargs query))),
681 string ", paramValues, paramLengths, paramFormats, 1);"],
592 newline, 682 newline,
593 newline, 683 newline,
594 684
595 string "if (res == NULL) lw_error(ctx, FATAL, \"Out of memory allocating query result.\");", 685 string "if (res == NULL) lw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
596 newline, 686 newline,
600 newline, 690 newline,
601 box [string "PQclear(res);", 691 box [string "PQclear(res);",
602 newline, 692 newline,
603 string "lw_error(ctx, FATAL, \"", 693 string "lw_error(ctx, FATAL, \"",
604 string (ErrorMsg.spanToString loc), 694 string (ErrorMsg.spanToString loc),
605 string ": Query failed:\\n%s\\n%s\", query, PQerrorMessage(conn));", 695 string ": Query failed:\\n%s\\n%s\", ",
696 case prepared of
697 NONE => string "query"
698 | SOME _ => p_exp env query,
699 string ", PQerrorMessage(conn));",
606 newline], 700 newline],
607 string "}", 701 string "}",
608 newline, 702 newline,
609 newline, 703 newline,
610 704
811 | DTable (x, _) => box [string "/* SQL table ", 905 | DTable (x, _) => box [string "/* SQL table ",
812 string x, 906 string x,
813 string " */", 907 string " */",
814 newline] 908 newline]
815 | DDatabase s => box [string "static void lw_db_validate(lw_context);", 909 | DDatabase s => box [string "static void lw_db_validate(lw_context);",
910 newline,
911 string "static void lw_db_prepare(lw_context);",
816 newline, 912 newline,
817 newline, 913 newline,
818 string "void lw_db_init(lw_context ctx) {", 914 string "void lw_db_init(lw_context ctx) {",
819 newline, 915 newline,
820 string "PGconn *conn = PQconnectdb(\"", 916 string "PGconn *conn = PQconnectdb(\"",
841 newline, 937 newline,
842 string "lw_set_db(ctx, conn);", 938 string "lw_set_db(ctx, conn);",
843 newline, 939 newline,
844 string "lw_db_validate(ctx);", 940 string "lw_db_validate(ctx);",
845 newline, 941 newline,
942 string "lw_db_prepare(ctx);",
943 newline,
846 string "}", 944 string "}",
847 newline, 945 newline,
848 newline, 946 newline,
849 string "void lw_db_close(lw_context ctx) {", 947 string "void lw_db_close(lw_context ctx) {",
850 newline, 948 newline,
851 string "PQfinish(lw_get_db(ctx));", 949 string "PQfinish(lw_get_db(ctx));",
852 newline, 950 newline,
853 string "}", 951 string "}",
854 newline] 952 newline]
953
954 | DPreparedStatements ss =>
955 box [string "static void lw_db_prepare(lw_context ctx) {",
956 newline,
957 string "PGconn *conn = lw_get_db(ctx);",
958 newline,
959 string "PGresult *res;",
960 newline,
961 newline,
962
963 p_list_sepi newline (fn i => fn (s, n) =>
964 box [string "res = PQprepare(conn, \"lw",
965 string (Int.toString i),
966 string "\", \"",
967 string (String.toString s),
968 string "\", ",
969 string (Int.toString n),
970 string ", NULL);",
971 newline,
972 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
973 newline,
974 box [string "char msg[1024];",
975 newline,
976 string "strncpy(msg, PQerrorMessage(conn), 1024);",
977 newline,
978 string "msg[1023] = 0;",
979 newline,
980 string "PQclear(res);",
981 newline,
982 string "PQfinish(conn);",
983 newline,
984 string "lw_error(ctx, FATAL, \"Unable to create prepared statement:\\n",
985 string (String.toString s),
986 string "\\n%s\", msg);",
987 newline],
988 string "}",
989 newline,
990 string "PQclear(res);",
991 newline])
992 ss,
993
994 string "}"]
855 995
856 datatype 'a search = 996 datatype 'a search =
857 Found of 'a 997 Found of 'a
858 | NotFound 998 | NotFound
859 | Error 999 | Error