Mercurial > urweb

comparison src/cjr_print.sml @ 743:cd67c3a942e3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Handling nullable blobs
author Adam Chlipala <adamc@hcoop.net>
date Sun, 26 Apr 2009 10:53:36 -0400
parents 43553c93dd8c
children e42f08f96eb5
comparison
equal deleted inserted replaced
742:43553c93dd8c 743:cd67c3a942e3
390 | PConFfi {mod = m, datatyp, con, ...} => 390 | PConFfi {mod = m, datatyp, con, ...} =>
391 ("uw_" ^ ident m ^ "_" ^ ident datatyp, 391 ("uw_" ^ ident m ^ "_" ^ ident datatyp,
392 "uw_" ^ ident m ^ "_" ^ ident con, 392 "uw_" ^ ident m ^ "_" ^ ident con,
393 "uw_" ^ ident con) 393 "uw_" ^ ident con)
394 394
395 fun p_unsql wontLeakStrings env (tAll as (t, loc)) e = 395 fun p_unsql wontLeakStrings env (tAll as (t, loc)) e eLen =
396 case t of 396 case t of
397 TFfi ("Basis", "int") => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"] 397 TFfi ("Basis", "int") => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"]
398 | TFfi ("Basis", "float") => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"] 398 | TFfi ("Basis", "float") => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"]
399 | TFfi ("Basis", "string") => 399 | TFfi ("Basis", "string") =>
400 if wontLeakStrings then 400 if wontLeakStrings then
401 e 401 e
402 else 402 else
403 box [string "uw_strdup(ctx, ", e, string ")"] 403 box [string "uw_strdup(ctx, ", e, string ")"]
404 | TFfi ("Basis", "bool") => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"] 404 | TFfi ("Basis", "bool") => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"]
405 | TFfi ("Basis", "time") => box [string "uw_Basis_stringToTime_error(ctx, ", e, string ")"] 405 | TFfi ("Basis", "time") => box [string "uw_Basis_stringToTime_error(ctx, ", e, string ")"]
406 | TFfi ("Basis", "blob") => box [string "uw_Basis_stringToBlob_error(ctx, ",
407 e,
408 string ", ",
409 eLen,
410 string ")"]
406 | TFfi ("Basis", "channel") => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"] 411 | TFfi ("Basis", "channel") => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"]
407 | TFfi ("Basis", "client") => box [string "uw_Basis_stringToClient_error(ctx, ", e, string ")"] 412 | TFfi ("Basis", "client") => box [string "uw_Basis_stringToClient_error(ctx, ", e, string ")"]
408 413
409 | _ => (ErrorMsg.errorAt loc "Don't know how to unmarshal type from SQL"; 414 | _ => (ErrorMsg.errorAt loc "Don't know how to unmarshal type from SQL";
410 Print.eprefaces' [("Type", p_typ env tAll)]; 415 Print.eprefaces' [("Type", p_typ env tAll)];
432 newline, 437 newline,
433 string "tmp;", 438 string "tmp;",
434 newline, 439 newline,
435 string "})"], 440 string "})"],
436 string ")"] 441 string ")"]
437
438 | TFfi ("Basis", "blob") => box [string "uw_Basis_stringToBlob_error(ctx, PQgetvalue(res, i, ",
439 string (Int.toString i),
440 string "), PQgetlength(res, i, ",
441 string (Int.toString i),
442 string "))"]
443
444 | _ => 442 | _ =>
445 p_unsql wontLeakStrings env tAll 443 p_unsql wontLeakStrings env tAll
446 (box [string "PQgetvalue(res, i, ", 444 (box [string "PQgetvalue(res, i, ",
445 string (Int.toString i),
446 string ")"])
447 (box [string "PQgetlength(res, i, ",
447 string (Int.toString i), 448 string (Int.toString i),
448 string ")"]) 449 string ")"])
449 450
450 datatype sql_type = 451 datatype sql_type =
451 Int 452 Int
524 | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"] 525 | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"]
525 | Nullable String => e 526 | Nullable String => e
526 | Nullable t => box [string "(", 527 | Nullable t => box [string "(",
527 e, 528 e,
528 string " == NULL ? NULL : ", 529 string " == NULL ? NULL : ",
529 p_ensql t (box [string "*", e]), 530 p_ensql t (box [string "(*", e, string ")"]),
530 string ")"] 531 string ")"]
531 532
532 fun notLeaky env allowHeapAllocated = 533 fun notLeaky env allowHeapAllocated =
533 let 534 let
534 fun nl ok (t, _) = 535 fun nl ok (t, _) =
1819 newline, 1820 newline,
1820 newline, 1821 newline,
1821 1822
1822 string "n = ", 1823 string "n = ",
1823 p_unsql true env (TFfi ("Basis", "int"), loc) 1824 p_unsql true env (TFfi ("Basis", "int"), loc)
1824 (string "PQgetvalue(res, 0, 0)"), 1825 (string "PQgetvalue(res, 0, 0)")
1826 (box []),
1825 string ";", 1827 string ";",
1826 newline, 1828 newline,
1827 string "PQclear(res);", 1829 string "PQclear(res);",
1828 newline, 1830 newline,
1829 string "n;", 1831 string "n;",