Mercurial > urweb

comparison src/cjr_print.sml @ 278:137744c5b1ae

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First query example working
author Adam Chlipala <adamc@hcoop.net>
date Tue, 02 Sep 2008 16:10:07 -0400
parents 286f734db702
children fdd7a698be01
comparison
equal deleted inserted replaced
277:286f734db702 278:137744c5b1ae
319 | PConFfi {mod = m, datatyp, con, ...} => 319 | PConFfi {mod = m, datatyp, con, ...} =>
320 ("lw_" ^ m ^ "_" ^ datatyp, 320 ("lw_" ^ m ^ "_" ^ datatyp,
321 "lw_" ^ m ^ "_" ^ con, 321 "lw_" ^ m ^ "_" ^ con,
322 "lw_" ^ con) 322 "lw_" ^ con)
323 323
324 fun p_unsql env (tAll as (t, loc)) e =
325 case t of
326 TFfi ("Basis", "int") => box [string "*(lw_Basis_int *)", e]
327 | TFfi ("Basis", "float") => box [string "*(lw_Basis_float *)", e]
328 | TFfi ("Basis", "string") => box [string "lw_Basis_strdup(ctx, ", e, string ")"]
329 | TFfi ("Basis", "bool") => box [string "(*(int *)",
330 e,
331 string " ? lw_Basis_True : lw_Basis_False)"]
332 | _ => (ErrorMsg.errorAt loc "Don't know how to unmarshal type from SQL";
333 Print.eprefaces' [("Type", p_typ env tAll)];
334 string "ERROR")
335
324 fun p_exp' par env (e, loc) = 336 fun p_exp' par env (e, loc) =
325 case e of 337 case e of
326 EPrim p => Prim.p_t_GCC p 338 EPrim p => Prim.p_t_GCC p
327 | ERel n => p_rel env n 339 | ERel n => p_rel env n
328 | ENamed n => p_enamed env n 340 | ENamed n => p_enamed env n
547 string ";", 559 string ";",
548 newline, 560 newline,
549 string "})"] 561 string "})"]
550 562
551 | EQuery {exps, tables, rnum, state, query, body, initial} => 563 | EQuery {exps, tables, rnum, state, query, body, initial} =>
552 box [string "({", 564 let
553 newline, 565 val exps = map (fn (x, t) => ("__lwf_" ^ x, t)) exps
554 string "PGconn *conn = lw_get_db(ctx);", 566 val tables = ListUtil.mapConcat (fn (x, xts) =>
555 newline, 567 map (fn (x', t) => ("__lwf_" ^ x ^ ".__lwf_" ^ x', t)) xts)
556 string "char *query = ", 568 tables
557 p_exp env query, 569
558 string ";", 570 val outputs = exps @ tables
559 newline, 571 in
560 string "int n, i;", 572 box [string "({",
561 newline, 573 newline,
562 p_typ env state, 574 string "PGconn *conn = lw_get_db(ctx);",
563 space, 575 newline,
564 string "acc", 576 string "char *query = ",
565 space, 577 p_exp env query,
566 string "=", 578 string ";",
567 space, 579 newline,
568 p_exp env initial, 580 string "int n, i;",
569 string ";", 581 newline,
570 newline, 582 p_typ env state,
571 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 1);", 583 space,
572 newline, 584 string "acc",
573 newline, 585 space,
574 586 string "=",
575 string "if (res == NULL) lw_error(ctx, FATAL, \"Out of memory allocating query result.\");", 587 space,
576 newline, 588 p_exp env initial,
577 newline, 589 string ";",
578 590 newline,
579 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {", 591 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 1);",
580 newline, 592 newline,
581 box [string "PQclear(res);", 593 newline,
582 newline, 594
583 string "lw_error(ctx, FATAL, \"", 595 string "if (res == NULL) lw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
584 string (ErrorMsg.spanToString loc), 596 newline,
585 string ": Query failed:\\n%s\\n%s\", query, PQerrorMessage(conn));", 597 newline,
586 newline], 598
587 string "}", 599 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
588 newline, 600 newline,
589 newline, 601 box [string "PQclear(res);",
590 602 newline,
591 string "n = PQntuples(res);", 603 string "lw_error(ctx, FATAL, \"",
592 newline, 604 string (ErrorMsg.spanToString loc),
593 string "for (i = 0; i < n; ++i) {", 605 string ": Query failed:\\n%s\\n%s\", query, PQerrorMessage(conn));",
594 newline, 606 newline],
595 box [string "struct", 607 string "}",
596 space, 608 newline,
597 string "__lws_", 609 newline,
598 string (Int.toString rnum), 610
599 space, 611 string "n = PQntuples(res);",
600 string "__lwr_r_", 612 newline,
601 string (Int.toString (E.countERels env)), 613 string "for (i = 0; i < n; ++i) {",
602 string ";", 614 newline,
603 newline, 615 box [string "struct",
604 p_typ env state, 616 space,
605 space, 617 string "__lws_",
606 string "__lwr_acc_", 618 string (Int.toString rnum),
607 string (Int.toString (E.countERels env + 1)), 619 space,
608 space, 620 string "__lwr_r_",
609 string "=", 621 string (Int.toString (E.countERels env)),
610 space, 622 string ";",
611 string "acc;", 623 newline,
612 newline, 624 p_typ env state,
613 newline, 625 space,
614 string "acc", 626 string "__lwr_acc_",
615 space, 627 string (Int.toString (E.countERels env + 1)),
616 string "=", 628 space,
617 space, 629 string "=",
618 p_exp (E.pushERel 630 space,
619 (E.pushERel env "r" (TRecord rnum, loc)) 631 string "acc;",
620 "acc" state) 632 newline,
621 body, 633 newline,
622 string ";", 634
623 newline], 635 p_list_sepi (box []) (fn i =>
624 string "}", 636 fn (proj, t) =>
625 newline, 637 box [string "__lwr_r_",
626 newline, 638 string (Int.toString (E.countERels env)),
627 string "PQclear(res);", 639 string ".",
628 newline, 640 string proj,
629 string "acc;", 641 space,
630 newline, 642 string "=",
631 string "})"] 643 space,
644 p_unsql env t
645 (box [string "PQgetvalue(res, i, ",
646 string (Int.toString i),
647 string ")"]),
648 string ";",
649 newline]) outputs,
650
651 newline,
652 newline,
653
654 string "acc",
655 space,
656 string "=",
657 space,
658 p_exp (E.pushERel
659 (E.pushERel env "r" (TRecord rnum, loc))
660 "acc" state)
661 body,
662 string ";",
663 newline],
664 string "}",
665 newline,
666 newline,
667 string "PQclear(res);",
668 newline,
669 string "acc;",
670 newline,
671 string "})"]
672 end
632 673
633 and p_exp env = p_exp' false env 674 and p_exp env = p_exp' false env
634 675
635 fun p_fun env (fx, n, args, ran, e) = 676 fun p_fun env (fx, n, args, ran, e) =
636 let 677 let