comparison src/cjr_print.sml @ 277:286f734db702

First query execution (not retrieving results yet)
author Adam Chlipala <adamc@hcoop.net>
date Tue, 02 Sep 2008 15:29:45 -0400
parents ed4af33681d8
children 137744c5b1ae
comparison
equal deleted inserted replaced
276:ed4af33681d8 277:286f734db702
547 string ";", 547 string ";",
548 newline, 548 newline,
549 string "})"] 549 string "})"]
550 550
551 | EQuery {exps, tables, rnum, state, query, body, initial} => 551 | EQuery {exps, tables, rnum, state, query, body, initial} =>
552 string "(lw_error(ctx, FATAL, \"I would have run a query.\"), NULL)" 552 box [string "({",
553 newline,
554 string "PGconn *conn = lw_get_db(ctx);",
555 newline,
556 string "char *query = ",
557 p_exp env query,
558 string ";",
559 newline,
560 string "int n, i;",
561 newline,
562 p_typ env state,
563 space,
564 string "acc",
565 space,
566 string "=",
567 space,
568 p_exp env initial,
569 string ";",
570 newline,
571 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 1);",
572 newline,
573 newline,
574
575 string "if (res == NULL) lw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
576 newline,
577 newline,
578
579 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
580 newline,
581 box [string "PQclear(res);",
582 newline,
583 string "lw_error(ctx, FATAL, \"",
584 string (ErrorMsg.spanToString loc),
585 string ": Query failed:\\n%s\\n%s\", query, PQerrorMessage(conn));",
586 newline],
587 string "}",
588 newline,
589 newline,
590
591 string "n = PQntuples(res);",
592 newline,
593 string "for (i = 0; i < n; ++i) {",
594 newline,
595 box [string "struct",
596 space,
597 string "__lws_",
598 string (Int.toString rnum),
599 space,
600 string "__lwr_r_",
601 string (Int.toString (E.countERels env)),
602 string ";",
603 newline,
604 p_typ env state,
605 space,
606 string "__lwr_acc_",
607 string (Int.toString (E.countERels env + 1)),
608 space,
609 string "=",
610 space,
611 string "acc;",
612 newline,
613 newline,
614 string "acc",
615 space,
616 string "=",
617 space,
618 p_exp (E.pushERel
619 (E.pushERel env "r" (TRecord rnum, loc))
620 "acc" state)
621 body,
622 string ";",
623 newline],
624 string "}",
625 newline,
626 newline,
627 string "PQclear(res);",
628 newline,
629 string "acc;",
630 newline,
631 string "})"]
553 632
554 and p_exp env = p_exp' false env 633 and p_exp env = p_exp' false env
555 634
556 fun p_fun env (fx, n, args, ran, e) = 635 fun p_fun env (fx, n, args, ran, e) =
557 let 636 let