Mercurial > urweb

comparison src/cjr_print.sml @ 295:1afa94582275

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Reading ints and floats from SQL
author Adam Chlipala <adamc@hcoop.net>
date Sun, 07 Sep 2008 12:56:46 -0400
parents 6e665c7c96f6
children 59dc042629b9
comparison
equal deleted inserted replaced
294:df02b09ff1ed 295:1afa94582275
388 "lw_" ^ m ^ "_" ^ con, 388 "lw_" ^ m ^ "_" ^ con,
389 "lw_" ^ con) 389 "lw_" ^ con)
390 390
391 fun p_unsql env (tAll as (t, loc)) e = 391 fun p_unsql env (tAll as (t, loc)) e =
392 case t of 392 case t of
393 TFfi ("Basis", "int") => box [string "*(lw_Basis_int *)", e] 393 TFfi ("Basis", "int") => box [string "lw_Basis_stringToInt_error(ctx, ", e, string ")"]
394 | TFfi ("Basis", "float") => box [string "*(lw_Basis_float *)", e] 394 | TFfi ("Basis", "float") => box [string "lw_Basis_stringToFloat_error(ctx, ", e, string ")"]
395 | TFfi ("Basis", "string") => box [string "lw_Basis_strdup(ctx, ", e, string ")"] 395 | TFfi ("Basis", "string") => box [string "lw_Basis_strdup(ctx, ", e, string ")"]
396 | TFfi ("Basis", "bool") => box [string "(*(int *)", 396 | TFfi ("Basis", "bool") => box [string "lw_Basis_stringToBool_error(ctx, ", e, string ")"]
397 e,
398 string " ? lw_Basis_True : lw_Basis_False)"]
399 | _ => (ErrorMsg.errorAt loc "Don't know how to unmarshal type from SQL"; 397 | _ => (ErrorMsg.errorAt loc "Don't know how to unmarshal type from SQL";
400 Print.eprefaces' [("Type", p_typ env tAll)]; 398 Print.eprefaces' [("Type", p_typ env tAll)];
401 string "ERROR") 399 string "ERROR")
402 400
403 datatype sql_type = 401 datatype sql_type =
425 423
426 | _ => raise Fail "CjrPrint: getPargs" 424 | _ => raise Fail "CjrPrint: getPargs"
427 425
428 fun p_ensql t e = 426 fun p_ensql t e =
429 case t of 427 case t of
430 Int => box [string "(char *)&", e] 428 Int => box [string "lw_Basis_attrifyInt(ctx, ", e, string ")"]
431 | Float => box [string "(char *)&", e] 429 | Float => box [string "lw_Basis_attrifyFloat(ctx, ", e, string ")"]
432 | String => e 430 | String => e
433 | Bool => box [string "lw_Basis_ensqlBool(", e, string ")"] 431 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
434 432
435 fun p_ensql_len t e = 433 fun p_ensql_len t e =
436 case t of 434 case t of
437 Int => string "sizeof(lw_Basis_int)" 435 Int => string "sizeof(lw_Basis_int)"
438 | Float => string "sizeof(lw_Basis_float)" 436 | Float => string "sizeof(lw_Basis_float)"
749 (fn i => fn (_, t) => p_ensql t (box [string "arg", 747 (fn i => fn (_, t) => p_ensql t (box [string "arg",
750 string (Int.toString (i + 1))])) 748 string (Int.toString (i + 1))]))
751 ets, 749 ets,
752 string " };", 750 string " };",
753 newline, 751 newline,
754 newline,
755
756 string "const int paramLengths[] = { ",
757 p_list_sepi (box [string ",", space])
758 (fn i => fn (_, t) => p_ensql_len t (box [string "arg",
759 string (Int.toString (i + 1))]))
760 ets,
761 string " };",
762 newline,
763 newline,
764
765 string "const static int paramFormats[] = { ",
766 p_list_sep (box [string ",", space]) (fn _ => string "1") ets,
767 string " };",
768 newline,
769 newline] 752 newline]
770 end, 753 end,
771 string "int n, i;", 754 string "int n, i;",
772 newline, 755 newline,
773 p_typ env state, 756 p_typ env state,
779 p_exp env initial, 762 p_exp env initial,
780 string ";", 763 string ";",
781 newline, 764 newline,
782 string "PGresult *res = ", 765 string "PGresult *res = ",
783 case prepared of 766 case prepared of
784 NONE => string "PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 1);" 767 NONE => string "PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);"
785 | SOME n => box [string "PQexecPrepared(conn, \"lw", 768 | SOME n => box [string "PQexecPrepared(conn, \"lw",
786 string (Int.toString n), 769 string (Int.toString n),
787 string "\", ", 770 string "\", ",
788 string (Int.toString (length (getPargs query))), 771 string (Int.toString (length (getPargs query))),
789 string ", paramValues, paramLengths, paramFormats, 1);"], 772 string ", paramValues, NULL, NULL, 0);"],
790 newline, 773 newline,
791 newline, 774 newline,
792 775
793 string "if (res == NULL) lw_error(ctx, FATAL, \"Out of memory allocating query result.\");", 776 string "if (res == NULL) lw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
794 newline, 777 newline,