From b691dfb678a18667a623b45111683c480476051b Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 8 Mar 2009 13:28:21 -0400 Subject: RPC returning a default datatype --- src/cjr_print.sml | 151 +++++++++++++++++++++++++----------------------------- src/cjrize.sml | 11 ++-- tests/rpcDD.ur | 26 ++++++++++ tests/rpcDD.urp | 5 ++ 4 files changed, 109 insertions(+), 84 deletions(-) create mode 100644 tests/rpcDD.ur create mode 100644 tests/rpcDD.urp 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 => + | OtherNil => That's impossible! + | Cons (x, ls') => {[x]}
{show ls'} + in + s <- source Nil; + return +