comparison src/cjr_print.sml @ 307:52d4c60518d4

First INSERT works
author Adam Chlipala <adamc@hcoop.net>
date Sun, 07 Sep 2008 15:05:52 -0400
parents 59dc042629b9
children 9ad92047a499
comparison
equal deleted inserted replaced
306:99e4f39e820d 307:52d4c60518d4
854 newline, 854 newline,
855 string "acc;", 855 string "acc;",
856 newline, 856 newline,
857 string "})"] 857 string "})"]
858 end 858 end
859
860 | EDml {dml, prepared} =>
861 box [string "({",
862 newline,
863 string "PGconn *conn = lw_get_db(ctx);",
864 newline,
865 case prepared of
866 NONE => box [string "char *dml = ",
867 p_exp env dml,
868 string ";",
869 newline]
870 | SOME _ =>
871 let
872 val ets = getPargs dml
873 in
874 box [p_list_sepi newline
875 (fn i => fn (e, t) =>
876 box [p_sql_type t,
877 space,
878 string "arg",
879 string (Int.toString (i + 1)),
880 space,
881 string "=",
882 space,
883 p_exp env e,
884 string ";"])
885 ets,
886 newline,
887 newline,
888
889 string "const char *paramValues[] = { ",
890 p_list_sepi (box [string ",", space])
891 (fn i => fn (_, t) => p_ensql t (box [string "arg",
892 string (Int.toString (i + 1))]))
893 ets,
894 string " };",
895 newline,
896 newline]
897 end,
898 newline,
899 newline,
900 string "PGresult *res = ",
901 case prepared of
902 NONE => string "PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);"
903 | SOME n => box [string "PQexecPrepared(conn, \"lw",
904 string (Int.toString n),
905 string "\", ",
906 string (Int.toString (length (getPargs dml))),
907 string ", paramValues, NULL, NULL, 0);"],
908 newline,
909 newline,
910
911 string "if (res == NULL) lw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
912 newline,
913 newline,
914
915 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
916 newline,
917 box [string "PQclear(res);",
918 newline,
919 string "lw_error(ctx, FATAL, \"",
920 string (ErrorMsg.spanToString loc),
921 string ": DML failed:\\n%s\\n%s\", ",
922 case prepared of
923 NONE => string "dml"
924 | SOME _ => p_exp env dml,
925 string ", PQerrorMessage(conn));",
926 newline],
927 string "}",
928 newline,
929 newline,
930
931 string "PQclear(res);",
932 newline,
933 string "lw_unit_v;",
934 newline,
935 string "})"]
859 936
860 and p_exp env = p_exp' false env 937 and p_exp env = p_exp' false env
861 938
862 fun p_fun env (fx, n, args, ran, e) = 939 fun p_fun env (fx, n, args, ran, e) =
863 let 940 let