Mercurial > urweb

comparison src/cjr_print.sml @ 682:5bbb542243e8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Redo channels, making them single-client
author Adam Chlipala <adamc@hcoop.net>
date Sun, 29 Mar 2009 11:37:29 -0400
parents 5ff1ff38e2db
children 9a2c18dab11d
comparison
equal deleted inserted replaced
681:6c9b8875f347 682:5bbb542243e8
402 else 402 else
403 box [string "uw_Basis_strdup(ctx, ", e, string ")"] 403 box [string "uw_Basis_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", "channel") => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"] 406 | 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 ")"]
407 408
408 | _ => (ErrorMsg.errorAt loc "Don't know how to unmarshal type from SQL"; 409 | _ => (ErrorMsg.errorAt loc "Don't know how to unmarshal type from SQL";
409 Print.eprefaces' [("Type", p_typ env tAll)]; 410 Print.eprefaces' [("Type", p_typ env tAll)];
410 string "ERROR") 411 string "ERROR")
411 412
445 | Float 446 | Float
446 | String 447 | String
447 | Bool 448 | Bool
448 | Time 449 | Time
449 | Channel 450 | Channel
451 | Client
450 | Nullable of sql_type 452 | Nullable of sql_type
451 453
452 fun p_sql_type' t = 454 fun p_sql_type' t =
453 case t of 455 case t of
454 Int => "uw_Basis_int" 456 Int => "uw_Basis_int"
455 | Float => "uw_Basis_float" 457 | Float => "uw_Basis_float"
456 | String => "uw_Basis_string" 458 | String => "uw_Basis_string"
457 | Bool => "uw_Basis_bool" 459 | Bool => "uw_Basis_bool"
458 | Time => "uw_Basis_time" 460 | Time => "uw_Basis_time"
459 | Channel => "uw_Basis_channel" 461 | Channel => "uw_Basis_channel"
462 | Client => "uw_Basis_client"
460 | Nullable String => "uw_Basis_string" 463 | Nullable String => "uw_Basis_string"
461 | Nullable t => p_sql_type' t ^ "*" 464 | Nullable t => p_sql_type' t ^ "*"
462 465
463 fun p_sql_type t = string (p_sql_type' t) 466 fun p_sql_type t = string (p_sql_type' t)
464 467
471 | EFfiApp ("Basis", "sqlifyFloat", [e]) => [(e, Float)] 474 | EFfiApp ("Basis", "sqlifyFloat", [e]) => [(e, Float)]
472 | EFfiApp ("Basis", "sqlifyString", [e]) => [(e, String)] 475 | EFfiApp ("Basis", "sqlifyString", [e]) => [(e, String)]
473 | EFfiApp ("Basis", "sqlifyBool", [e]) => [(e, Bool)] 476 | EFfiApp ("Basis", "sqlifyBool", [e]) => [(e, Bool)]
474 | EFfiApp ("Basis", "sqlifyTime", [e]) => [(e, Time)] 477 | EFfiApp ("Basis", "sqlifyTime", [e]) => [(e, Time)]
475 | EFfiApp ("Basis", "sqlifyChannel", [e]) => [(e, Channel)] 478 | EFfiApp ("Basis", "sqlifyChannel", [e]) => [(e, Channel)]
479 | EFfiApp ("Basis", "sqlifyClient", [e]) => [(e, Client)]
476 480
477 | ECase (e, 481 | ECase (e,
478 [((PNone _, _), 482 [((PNone _, _),
479 (EPrim (Prim.String "NULL"), _)), 483 (EPrim (Prim.String "NULL"), _)),
480 ((PSome (_, (PVar _, _)), _), 484 ((PSome (_, (PVar _, _)), _),
494 case t of 498 case t of
495 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"] 499 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
496 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"] 500 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
497 | String => e 501 | String => e
498 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"] 502 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
499 | Time => box [string "uw_Basis_sqlifyTime(ctx, ", e, string ")"] 503 | Time => box [string "uw_Basis_attrifyTime(ctx, ", e, string ")"]
500 | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"] 504 | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"]
505 | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"]
501 | Nullable String => e 506 | Nullable String => e
502 | Nullable t => box [string "(", 507 | Nullable t => box [string "(",
503 e, 508 e,
504 string " == NULL ? NULL : ", 509 string " == NULL ? NULL : ",
505 p_ensql t (box [string "*", e]), 510 p_ensql t (box [string "*", e]),
1980 1985
1981 string "int uw_db_begin(uw_context ctx) {", 1986 string "int uw_db_begin(uw_context ctx) {",
1982 newline, 1987 newline,
1983 string "PGconn *conn = uw_get_db(ctx);", 1988 string "PGconn *conn = uw_get_db(ctx);",
1984 newline, 1989 newline,
1985 string "PGresult *res = PQexec(conn, \"BEGIN\");", 1990 string "PGresult *res = PQexec(conn, \"BEGIN ISOLATION LEVEL SERIALIZABLE\");",
1986 newline, 1991 newline,
1987 newline, 1992 newline,
1988 string "if (res == NULL) return 1;", 1993 string "if (res == NULL) return 1;",
1989 newline, 1994 newline,
1990 newline, 1995 newline,
2106 TFfi ("Basis", "int") => "int8" 2111 TFfi ("Basis", "int") => "int8"
2107 | TFfi ("Basis", "float") => "float8" 2112 | TFfi ("Basis", "float") => "float8"
2108 | TFfi ("Basis", "string") => "text" 2113 | TFfi ("Basis", "string") => "text"
2109 | TFfi ("Basis", "bool") => "bool" 2114 | TFfi ("Basis", "bool") => "bool"
2110 | TFfi ("Basis", "time") => "timestamp" 2115 | TFfi ("Basis", "time") => "timestamp"
2111 | TFfi ("Basis", "channel") => "int4" 2116 | TFfi ("Basis", "channel") => "int8"
2117 | TFfi ("Basis", "client") => "int4"
2112 | _ => (ErrorMsg.errorAt loc "Don't know SQL equivalent of type"; 2118 | _ => (ErrorMsg.errorAt loc "Don't know SQL equivalent of type";
2113 Print.eprefaces' [("Type", p_typ env tAll)]; 2119 Print.eprefaces' [("Type", p_typ env tAll)];
2114 "ERROR") 2120 "ERROR")
2115 2121
2116 fun p_sqltype' env (tAll as (t, loc)) = 2122 fun p_sqltype' env (tAll as (t, loc)) =
2366 string "\");", 2372 string "\");",
2367 string "uw_set_url_prefix(ctx, \"", 2373 string "uw_set_url_prefix(ctx, \"",
2368 string (!Monoize.urlPrefix), 2374 string (!Monoize.urlPrefix),
2369 string "\");", 2375 string "\");",
2370 newline]), 2376 newline]),
2377 string "uw_login(ctx);",
2378 newline,
2371 box [string "{", 2379 box [string "{",
2372 newline, 2380 newline,
2373 box (ListUtil.mapi (fn (i, t) => box [p_typ env t, 2381 box (ListUtil.mapi (fn (i, t) => box [p_typ env t,
2374 space, 2382 space,
2375 string "arg", 2383 string "arg",