summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-09-02 15:29:45 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-09-02 15:29:45 -0400
commitbe2a1797452302e2e2f559bb45c1fed431e4dfc8 (patch)
tree38007bd0aec2ef369937aac999f32809a0d98051 /src
parent230df59a100ea7f1b8b74297fe28dcb567a283c6 (diff)
First query execution (not retrieving results yet)
Diffstat (limited to 'src')
-rw-r--r--src/cjr_print.sml81
-rw-r--r--src/monoize.sml6
2 files changed, 83 insertions, 4 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index b1f9fd6c..a12e5bc1 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -549,7 +549,86 @@ fun p_exp' par env (e, loc) =
string "})"]
| EQuery {exps, tables, rnum, state, query, body, initial} =>
- string "(lw_error(ctx, FATAL, \"I would have run a query.\"), NULL)"
+ box [string "({",
+ newline,
+ string "PGconn *conn = lw_get_db(ctx);",
+ newline,
+ string "char *query = ",
+ p_exp env query,
+ string ";",
+ newline,
+ string "int n, i;",
+ newline,
+ p_typ env state,
+ space,
+ string "acc",
+ space,
+ string "=",
+ space,
+ p_exp env initial,
+ string ";",
+ newline,
+ string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 1);",
+ newline,
+ newline,
+
+ string "if (res == NULL) lw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
+ newline,
+ newline,
+
+ string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
+ newline,
+ box [string "PQclear(res);",
+ newline,
+ string "lw_error(ctx, FATAL, \"",
+ string (ErrorMsg.spanToString loc),
+ string ": Query failed:\\n%s\\n%s\", query, PQerrorMessage(conn));",
+ newline],
+ string "}",
+ newline,
+ newline,
+
+ string "n = PQntuples(res);",
+ newline,
+ string "for (i = 0; i < n; ++i) {",
+ newline,
+ box [string "struct",
+ space,
+ string "__lws_",
+ string (Int.toString rnum),
+ space,
+ string "__lwr_r_",
+ string (Int.toString (E.countERels env)),
+ string ";",
+ newline,
+ p_typ env state,
+ space,
+ string "__lwr_acc_",
+ string (Int.toString (E.countERels env + 1)),
+ space,
+ string "=",
+ space,
+ string "acc;",
+ newline,
+ newline,
+ string "acc",
+ space,
+ string "=",
+ space,
+ p_exp (E.pushERel
+ (E.pushERel env "r" (TRecord rnum, loc))
+ "acc" state)
+ body,
+ string ";",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "PQclear(res);",
+ newline,
+ string "acc;",
+ newline,
+ string "})"]
and p_exp env = p_exp' false env
diff --git a/src/monoize.sml b/src/monoize.sml
index b0b4309e..c79bea67 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -623,7 +623,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
@ map (fn (x, xts) =>
strcatComma loc
(map (fn (x', _) =>
- sc (x ^ "." ^ x'))
+ sc (x ^ ".lw_" ^ x'))
xts)) stables),
sc " FROM ",
strcatComma loc (map (fn (x, _) => strcat loc [(L'.EField (gf "From", x), loc),
@@ -650,7 +650,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
strcatComma loc (map (fn (x, xts) =>
strcatComma loc
(map (fn (x', _) =>
- sc (x ^ "." ^ x'))
+ sc (x ^ ".lw_" ^ x'))
xts)) grouped)
],
@@ -871,7 +871,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
_), _),
_), _),
(L.CName tab, _)), _),
- (L.CName field, _)) => ((L'.EPrim (Prim.String (tab ^ "." ^ field)), loc), fm)
+ (L.CName field, _)) => ((L'.EPrim (Prim.String (tab ^ ".lw_" ^ field)), loc), fm)
| L.ECApp (
(L.ECApp (