diff options
| author |  Adam Chlipala <adam@chlipala.net> | 2019-10-07 16:47:39 -0400 |
|---|---|---|
| committer | Adam Chlipala <adam@chlipala.net> | 2019-10-07 16:47:39 -0400 |
| commit | 56bb940f305fb3d32cc218a6dbc8fa1b1fd7ef89 (patch) | |
| tree | b47f6daf74d0ebb7abdda4b78514527613ba21ae | |
| parent | 39bfe4b44542852a656a3793d1f245bf31503b49 (diff) | |
Update urlification of unit values for RPC results, to track a previous change elsewhere
| -rw-r--r-- | src/cjr_print.sml | 59 | ||||
| -rw-r--r-- | tests/rpc_unit.ur | 8 |
2 files changed, 31 insertions, 36 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 5dcfbe89..d7b8017e 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -1014,52 +1014,39 @@ fun urlify env t = let fun urlify' level (t as (_, loc)) = case #1 t of - TFfi ("Basis", "unit") => box [] + TFfi ("Basis", "unit") => box [string "uw_Basis_urlifyString_w(ctx, \"\");", + newline] | TFfi (m, t) => box [string ("uw_" ^ ident m ^ "_urlify" ^ capitalize t ^ "_w(ctx, it" ^ Int.toString level ^ ");"), newline] - | TRecord 0 => box [] + | TRecord 0 => box [string "uw_Basis_urlifyString_w(ctx, \"\");", + newline] | TRecord i => let - fun empty (t, _) = - case t of - TFfi ("Basis", "unit") => true - | TRecord 0 => true - | TRecord j => - List.all (fn (_, t) => empty t) (E.lookupStruct env j) - | _ => false - val xts = E.lookupStruct env i val (blocks, _) = foldl (fn ((x, t), (blocks, printingSinceLastSlash)) => - let - val thisEmpty = empty t - in - if thisEmpty then - (blocks, printingSinceLastSlash) - else - (box [string "{", - newline, - p_typ env t, - space, - string ("it" ^ Int.toString (level + 1)), - space, - string "=", - space, - string ("it" ^ Int.toString level ^ ".__uwf_" ^ x ^ ";"), - newline, - box (if printingSinceLastSlash then - [string "uw_write(ctx, \"/\");", - newline] - else - []), - urlify' (level + 1) t, - string "}", - newline] :: blocks, - true) - end) + (box [string "{", + newline, + p_typ env t, + space, + string ("it" ^ Int.toString (level + 1)), + space, + string "=", + space, + string ("it" ^ Int.toString level ^ ".__uwf_" ^ x ^ ";"), + newline, + box (if printingSinceLastSlash then + [string "uw_write(ctx, \"/\");", + newline] + else + []), + urlify' (level + 1) t, + string "}", + newline] :: blocks, + true)) ([], false) xts in box (rev blocks) diff --git a/tests/rpc_unit.ur b/tests/rpc_unit.ur new file mode 100644 index 00000000..befd6045 --- /dev/null +++ b/tests/rpc_unit.ur @@ -0,0 +1,8 @@ +val callme = return ((), (), "A", (), ()) + +val main : transaction page = return <xml><body> + <button value="CLICK ME" + onclick={fn _ => + (_, _, s, _, _) <- rpc callme; + alert s}/> +</body></xml> |