summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/cjr_print.sml151
-rw-r--r--src/cjrize.sml11
-rw-r--r--tests/rpcDD.ur26
-rw-r--r--tests/rpcDD.urp5
4 files changed, 109 insertions, 84 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 630f9f7c..73024aa5 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1004,11 +1004,14 @@ fun urlify env t =
newline]
end
- | TDatatype (Default, i, _) => box []
- (*if IS.member (rf, i) then
- box [string "unurlify_",
+ | TDatatype (Default, i, _) =>
+ if IS.member (rf, i) then
+ box [string "urlify_",
string (Int.toString i),
- string "()"]
+ string "(it",
+ string (Int.toString level),
+ string ");",
+ newline]
else
let
val (x, xncs) = E.lookupDatatype env i
@@ -1017,87 +1020,72 @@ fun urlify env t =
fun doEm xncs =
case xncs of
- [] => string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype "
- ^ x ^ "\"), NULL)")
+ [] => box [string ("uw_error(ctx, FATAL, \"Error urlifying datatype "
+ ^ x ^ " (%d)\", it0->data);"),
+ newline]
| (x', n, to) :: rest =>
- box [string "((!strncmp(request, \"",
- string x',
- string "\", ",
- string (Int.toString (size x')),
- string ") && (request[",
- string (Int.toString (size x')),
- string "] == 0 || request[",
- string (Int.toString (size x')),
- string "] == '/')) ? ({",
- newline,
- string "struct",
+ box [string "if",
space,
- string ("__uwd_" ^ ident x ^ "_" ^ Int.toString i),
- space,
- string "*tmp = uw_malloc(ctx, sizeof(struct __uwd_",
- string x,
+ string "(it0->tag==__uwc_",
+ string (ident x'),
string "_",
- string (Int.toString i),
- string "));",
- newline,
- string "tmp->tag",
- space,
- string "=",
- space,
- string ("__uwc_" ^ ident x' ^ "_" ^ Int.toString n),
- string ";",
- newline,
- string "request",
- space,
- string "+=",
- space,
- string (Int.toString (size x')),
- string ";",
- newline,
- string "if (request[0] == '/') ++request;",
+ string (Int.toString n),
+ string ") {",
newline,
case to of
- NONE => box []
- | SOME (t, _) => box [string "tmp->data.uw_",
- p_ident x',
- space,
- string "=",
- space,
- unurlify' rf t,
- string ";",
- newline],
- string "tmp;",
+ NONE => box [string "uw_write(ctx, \"",
+ string x',
+ string "\");",
+ newline]
+ | SOME t => box [string "uw_write(ctx, \"",
+ string x',
+ string "/\");",
+ newline,
+ p_typ env t,
+ space,
+ string "it1",
+ space,
+ string "=",
+ space,
+ string "it0->data.uw_",
+ string x',
+ string ";",
+ newline,
+ urlify' rf 1 t,
+ newline],
+ string "} else {",
newline,
- string "})",
- space,
- string ":",
- space,
- doEm rest,
- string ")"]
+ box [doEm rest,
+ newline],
+ string "}",
+ newline]
in
box [string "({",
space,
- p_typ env (t, ErrorMsg.dummySpan),
+ string "void",
space,
- string "unurlify_",
+ string "urlify_",
string (Int.toString i),
- string "(void) {",
+ string "(",
+ p_typ env t,
+ space,
+ string "it0) {",
newline,
- box [string "return",
- space,
- doEm xncs,
- string ";",
+ box [doEm xncs,
newline],
- string "}",
newline,
+ string "}",
newline,
- string "unurlify_",
+ string "urlify_",
string (Int.toString i),
- string "();",
+ string "(it",
+ string (Int.toString level),
+ string ");",
newline,
- string "})"]
- end*)
+ string "});",
+ newline]
+ end
| TOption t => box []
(*box [string "(request[0] == '/' ? ++request : request, ",
@@ -1439,8 +1427,7 @@ fun p_exp' par env (e, loc) =
val wontLeakStrings = notLeaky env true state
val wontLeakAnything = notLeaky env false state
in
- box [string "(uw_begin_region(ctx), ",
- if wontLeakAnything then
+ box [if wontLeakAnything then
string "uw_begin_region(ctx), "
else
box [],
@@ -1448,6 +1435,18 @@ fun p_exp' par env (e, loc) =
newline,
string "PGconn *conn = uw_get_db(ctx);",
newline,
+ p_typ env state,
+ space,
+ string "acc",
+ space,
+ string "=",
+ space,
+ p_exp env initial,
+ string ";",
+ newline,
+ string "int n, i, dummy = (uw_begin_region(ctx), 0);",
+ newline,
+
case prepared of
NONE => box [string "char *query = ",
p_exp env query,
@@ -1481,17 +1480,7 @@ fun p_exp' par env (e, loc) =
newline,
newline]
end,
- string "int n, i;",
- newline,
- p_typ env state,
- space,
- string "acc",
- space,
- string "=",
- space,
- p_exp env initial,
- string ";",
- newline,
+
string "PGresult *res = ",
case prepared of
NONE => string "PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);"
@@ -1589,7 +1578,7 @@ fun p_exp' par env (e, loc) =
box [],
string "acc;",
newline,
- string "}))"]
+ string "})"]
end
| EDml {dml, prepared} =>
diff --git a/src/cjrize.sml b/src/cjrize.sml
index 16a82ec8..9d9ab36c 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -544,15 +544,20 @@ fun cjrize ds =
let
val (dop, pop, sm) = cifyDecl (d, sm)
+ val dsF = case dop of
+ SOME (L'.DDatatype (dk, x, n, _), loc) =>
+ (L'.DDatatypeForward (dk, x, n), loc) :: dsF
+ | _ => dsF
+
+ val dsF = map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm)
+ @ dsF
+
val (dsF, ds) = case dop of
NONE => (dsF, ds)
| SOME (d as (L'.DDatatype _, loc)) =>
(d :: dsF, ds)
| SOME d => (dsF, d :: ds)
- val dsF = map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm)
- @ dsF
-
val ps = case pop of
NONE => ps
| SOME p => p :: ps
diff --git a/tests/rpcDD.ur b/tests/rpcDD.ur
new file mode 100644
index 00000000..13293b83
--- /dev/null
+++ b/tests/rpcDD.ur
@@ -0,0 +1,26 @@
+datatype list t = Nil | OtherNil | Cons of t * list t
+
+table t : {A : int}
+
+fun main () : transaction page =
+ let
+ fun rows () =
+ query (SELECT * FROM t)
+ (fn r ls => return (Cons (r.T.A, ls)))
+ Nil
+
+ fun show ls =
+ case ls of
+ Nil => <xml/>
+ | OtherNil => <xml>That's impossible!</xml>
+ | Cons (x, ls') => <xml>{[x]}<br/>{show ls'}</xml>
+ in
+ s <- source Nil;
+ return <xml><body>
+ <button value="Get It On!"
+ onclick={ls <- rows ();
+ set s ls}/><br/>
+ <br/>
+ Current: <dyn signal={ls <- signal s; return (show ls)}/>
+ </body></xml>
+ end
diff --git a/tests/rpcDD.urp b/tests/rpcDD.urp
new file mode 100644
index 00000000..118ea723
--- /dev/null
+++ b/tests/rpcDD.urp
@@ -0,0 +1,5 @@
+debug
+sql rpcDD.sql
+database dbname=rpcdd
+
+rpcDD
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-18 06:09:04 +0000