Mercurial > urweb

comparison src/cjr_print.sml @ 678:5ff1ff38e2db

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Preliminary work supporting channels in databases
author Adam Chlipala <adamc@hcoop.net>
date Thu, 26 Mar 2009 16:22:34 -0400
parents a8effb6159c2
children 5bbb542243e8
comparison
equal deleted inserted replaced
677:81573f62d6c3 678:5ff1ff38e2db
401 e 401 e
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 407
407 | _ => (ErrorMsg.errorAt loc "Don't know how to unmarshal type from SQL"; 408 | _ => (ErrorMsg.errorAt loc "Don't know how to unmarshal type from SQL";
408 Print.eprefaces' [("Type", p_typ env tAll)]; 409 Print.eprefaces' [("Type", p_typ env tAll)];
409 string "ERROR") 410 string "ERROR")
410 411
443 Int 444 Int
444 | Float 445 | Float
445 | String 446 | String
446 | Bool 447 | Bool
447 | Time 448 | Time
449 | Channel
448 | Nullable of sql_type 450 | Nullable of sql_type
449 451
450 fun p_sql_type' t = 452 fun p_sql_type' t =
451 case t of 453 case t of
452 Int => "uw_Basis_int" 454 Int => "uw_Basis_int"
453 | Float => "uw_Basis_float" 455 | Float => "uw_Basis_float"
454 | String => "uw_Basis_string" 456 | String => "uw_Basis_string"
455 | Bool => "uw_Basis_bool" 457 | Bool => "uw_Basis_bool"
456 | Time => "uw_Basis_time" 458 | Time => "uw_Basis_time"
459 | Channel => "uw_Basis_channel"
457 | Nullable String => "uw_Basis_string" 460 | Nullable String => "uw_Basis_string"
458 | Nullable t => p_sql_type' t ^ "*" 461 | Nullable t => p_sql_type' t ^ "*"
459 462
460 fun p_sql_type t = string (p_sql_type' t) 463 fun p_sql_type t = string (p_sql_type' t)
461 464
467 | EFfiApp ("Basis", "sqlifyInt", [e]) => [(e, Int)] 470 | EFfiApp ("Basis", "sqlifyInt", [e]) => [(e, Int)]
468 | EFfiApp ("Basis", "sqlifyFloat", [e]) => [(e, Float)] 471 | EFfiApp ("Basis", "sqlifyFloat", [e]) => [(e, Float)]
469 | EFfiApp ("Basis", "sqlifyString", [e]) => [(e, String)] 472 | EFfiApp ("Basis", "sqlifyString", [e]) => [(e, String)]
470 | EFfiApp ("Basis", "sqlifyBool", [e]) => [(e, Bool)] 473 | EFfiApp ("Basis", "sqlifyBool", [e]) => [(e, Bool)]
471 | EFfiApp ("Basis", "sqlifyTime", [e]) => [(e, Time)] 474 | EFfiApp ("Basis", "sqlifyTime", [e]) => [(e, Time)]
472 475 | EFfiApp ("Basis", "sqlifyChannel", [e]) => [(e, Channel)]
473 | EFfiApp ("Basis", "sqlifyIntN", [e]) => [(e, Nullable Int)] 476
474 | EFfiApp ("Basis", "sqlifyFloatN", [e]) => [(e, Nullable Float)] 477 | ECase (e,
475 | EFfiApp ("Basis", "sqlifyStringN", [e]) => [(e, Nullable String)] 478 [((PNone _, _),
476 | EFfiApp ("Basis", "sqlifyBoolN", [e]) => [(e, Nullable Bool)] 479 (EPrim (Prim.String "NULL"), _)),
477 | EFfiApp ("Basis", "sqlifyTimeN", [e]) => [(e, Nullable Time)] 480 ((PSome (_, (PVar _, _)), _),
481 (EFfiApp (m, x, [(ERel 0, _)]), _))],
482 _) => map (fn (x, y) => (x, Nullable y)) (getPargs (EFfiApp (m, x, [e]), #2 e))
478 483
479 | ECase (e, 484 | ECase (e,
480 [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, _), _), 485 [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, _), _),
481 (EPrim (Prim.String "TRUE"), _)), 486 (EPrim (Prim.String "TRUE"), _)),
482 ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, _), _), 487 ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, _), _),
490 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"] 495 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
491 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"] 496 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
492 | String => e 497 | String => e
493 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"] 498 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
494 | Time => box [string "uw_Basis_sqlifyTime(ctx, ", e, string ")"] 499 | Time => box [string "uw_Basis_sqlifyTime(ctx, ", e, string ")"]
500 | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"]
495 | Nullable String => e 501 | Nullable String => e
496 | Nullable t => box [string "(", 502 | Nullable t => box [string "(",
497 e, 503 e,
498 string " == NULL ? NULL : ", 504 string " == NULL ? NULL : ",
499 p_ensql t (box [string "*", e]), 505 p_ensql t (box [string "*", e]),
2100 TFfi ("Basis", "int") => "int8" 2106 TFfi ("Basis", "int") => "int8"
2101 | TFfi ("Basis", "float") => "float8" 2107 | TFfi ("Basis", "float") => "float8"
2102 | TFfi ("Basis", "string") => "text" 2108 | TFfi ("Basis", "string") => "text"
2103 | TFfi ("Basis", "bool") => "bool" 2109 | TFfi ("Basis", "bool") => "bool"
2104 | TFfi ("Basis", "time") => "timestamp" 2110 | TFfi ("Basis", "time") => "timestamp"
2111 | TFfi ("Basis", "channel") => "int4"
2105 | _ => (ErrorMsg.errorAt loc "Don't know SQL equivalent of type"; 2112 | _ => (ErrorMsg.errorAt loc "Don't know SQL equivalent of type";
2106 Print.eprefaces' [("Type", p_typ env tAll)]; 2113 Print.eprefaces' [("Type", p_typ env tAll)];
2107 "ERROR") 2114 "ERROR")
2108 2115
2109 fun p_sqltype' env (tAll as (t, loc)) = 2116 fun p_sqltype' env (tAll as (t, loc)) =