Mercurial > urweb

comparison src/cjr_print.sml @ 2304:6fb9232ade99

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge Sqlcache
author Adam Chlipala <adam@chlipala.net>
date Sun, 20 Dec 2015 14:18:52 -0500
parents 6eae499c56cb 2b1af5dc6dee
children
comparison
equal deleted inserted replaced
2201:1091227f535a 2304:6fb9232ade99
14 * 14 *
15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
732 string "+=", 732 string "+=",
733 space, 733 space,
734 string (Int.toString (size has_arg)), 734 string (Int.toString (size has_arg)),
735 string ", ((*request)[0] == '/' ? ++*request : NULL), ", 735 string ", ((*request)[0] == '/' ? ++*request : NULL), ",
736 newline, 736 newline,
737 737
738 if unboxable then 738 if unboxable then
739 unurlify' "(*request)" (#1 t) 739 unurlify' "(*request)" (#1 t)
740 else 740 else
741 box [string "({", 741 box [string "({",
742 newline, 742 newline,
912 space, 912 space,
913 string "+=", 913 string "+=",
914 space, 914 space,
915 string "4, ((*request)[0] == '/' ? ++*request : NULL), ", 915 string "4, ((*request)[0] == '/' ? ++*request : NULL), ",
916 newline, 916 newline,
917 917
918 string "({", 918 string "({",
919 newline, 919 newline,
920 p_typ env (t, loc), 920 p_typ env (t, loc),
921 space, 921 space,
922 string "tmp", 922 string "tmp",
1186 box [string "urlify_", 1186 box [string "urlify_",
1187 string (Int.toString i), 1187 string (Int.toString i),
1188 string "(ctx,", 1188 string "(ctx,",
1189 space, 1189 space,
1190 string "it", 1190 string "it",
1191 string (Int.toString level), 1191 string (Int.toString level),
1192 string ");", 1192 string ");",
1193 newline] 1193 newline]
1194 else 1194 else
1195 let 1195 let
1196 val (x, xncs) = E.lookupDatatype env i 1196 val (x, xncs) = E.lookupDatatype env i
1386 space, 1386 space,
1387 string "it", 1387 string "it",
1388 string (Int.toString level), 1388 string (Int.toString level),
1389 string ");", 1389 string ");",
1390 newline]) 1390 newline])
1391 1391
1392 | _ => (ErrorMsg.errorAt loc "Unable to choose a URL encoding function"; 1392 | _ => (ErrorMsg.errorAt loc "Unable to choose a URL encoding function";
1393 space) 1393 space)
1394 in 1394 in
1395 urlify' 0 t 1395 urlify' 0 t
1396 end 1396 end
1576 p_exp' false false env e, 1576 p_exp' false false env e,
1577 string ";", 1577 string ";",
1578 newline], 1578 newline],
1579 string "tmp;", 1579 string "tmp;",
1580 newline, 1580 newline,
1581 string "})"] 1581 string "})"]
1582 end 1582 end
1583 | ENone _ => string "NULL" 1583 | ENone _ => string "NULL"
1584 | ESome (t, e) => 1584 | ESome (t, e) =>
1585 if isUnboxable t then 1585 if isUnboxable t then
1586 p_exp' par tail env e 1586 p_exp' par tail env e
2076 space, 2076 space,
2077 string "=", 2077 string "=",
2078 space, 2078 space,
2079 p_exp' false false (E.pushERel 2079 p_exp' false false (E.pushERel
2080 (E.pushERel env "r" (TRecord rnum, loc)) 2080 (E.pushERel env "r" (TRecord rnum, loc))
2081 "acc" state) 2081 "acc" state)
2082 body, 2082 body,
2083 string ";", 2083 string ";",
2084 newline] 2084 newline]
2085 in 2085 in
2086 box [if wontLeakAnything then 2086 box [if wontLeakAnything then
2100 newline, 2100 newline,
2101 string "int dummy = (uw_begin_region(ctx), 0);", 2101 string "int dummy = (uw_begin_region(ctx), 0);",
2102 newline, 2102 newline,
2103 string "uw_ensure_transaction(ctx);", 2103 string "uw_ensure_transaction(ctx);",
2104 newline, 2104 newline,
2105 2105
2106 case prepared of 2106 case prepared of
2107 NONE => 2107 NONE =>
2108 box [string "char *query = ", 2108 box [string "char *query = ",
2109 p_exp' false false env query, 2109 p_exp' false false env query,
2110 string ";", 2110 string ";",
2185 inputs, 2185 inputs,
2186 newline, 2186 newline,
2187 string "uw_ensure_transaction(ctx);", 2187 string "uw_ensure_transaction(ctx);",
2188 newline, 2188 newline,
2189 newline, 2189 newline,
2190 2190
2191 #dmlPrepared (Settings.currentDbms ()) {loc = loc, 2191 #dmlPrepared (Settings.currentDbms ()) {loc = loc,
2192 id = id, 2192 id = id,
2193 dml = dml', 2193 dml = dml',
2194 inputs = map #2 inputs, 2194 inputs = map #2 inputs,
2195 mode = mode}] 2195 mode = mode}]
3394 newline, 3394 newline,
3395 string "static int uw_db_rollback(uw_context ctx) { return 0; };"], 3395 string "static int uw_db_rollback(uw_context ctx) { return 0; };"],
3396 newline, 3396 newline,
3397 newline, 3397 newline,
3398 3398
3399 (* For sqlcache. *)
3400 let
3401 val {setupGlobal, setupQuery, ...} = Sqlcache.getCache ()
3402 in
3403 box (setupGlobal :: newline :: List.map setupQuery (Sqlcache.getFfiInfo ()))
3404 end,
3405 newline,
3399 3406
3400 p_list_sep newline (fn x => x) pds, 3407 p_list_sep newline (fn x => x) pds,
3401 newline, 3408 newline,
3402 newline, 3409 newline,
3403 string "static int uw_input_num(const char *name) {", 3410 string "static int uw_input_num(const char *name) {",
3449 makeChecker ("uw_check_responseHeader", Settings.getResponseHeaderRules ()), 3456 makeChecker ("uw_check_responseHeader", Settings.getResponseHeaderRules ()),
3450 newline, 3457 newline,
3451 3458
3452 makeChecker ("uw_check_envVar", Settings.getEnvVarRules ()), 3459 makeChecker ("uw_check_envVar", Settings.getEnvVarRules ()),
3453 newline, 3460 newline,
3454 3461
3455 string "extern void uw_sign(const char *in, char *out);", 3462 string "extern void uw_sign(const char *in, char *out);",
3456 newline, 3463 newline,
3457 string "extern int uw_hash_blocksize;", 3464 string "extern int uw_hash_blocksize;",
3458 newline, 3465 newline,
3459 string "static uw_Basis_string uw_cookie_sig(uw_context ctx) {", 3466 string "static uw_Basis_string uw_cookie_sig(uw_context ctx) {",
3496 newline, 3503 newline,
3497 string "uw_write_header(ctx, \"Content-Type: text/javascript\\r\\n\");", 3504 string "uw_write_header(ctx, \"Content-Type: text/javascript\\r\\n\");",
3498 newline, 3505 newline,
3499 string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt nowD ^ "\\r\\n\");"), 3506 string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt nowD ^ "\\r\\n\");"),
3500 newline, 3507 newline,
3501 string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"), 3508 string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"),
3502 newline, 3509 newline,
3503 string "uw_write(ctx, jslib);", 3510 string "uw_write(ctx, jslib);",
3504 newline, 3511 newline,
3505 string "return;", 3512 string "return;",
3506 newline], 3513 newline],
3521 newline]), 3528 newline]),
3522 string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt (Date.fromTimeUniv (#LastModified r)) ^ "\\r\\n\");"), 3529 string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt (Date.fromTimeUniv (#LastModified r)) ^ "\\r\\n\");"),
3523 newline, 3530 newline,
3524 string ("uw_write_header(ctx, \"Content-Length: " ^ Int.toString (Word8Vector.length (#Bytes r)) ^ "\\r\\n\");"), 3531 string ("uw_write_header(ctx, \"Content-Length: " ^ Int.toString (Word8Vector.length (#Bytes r)) ^ "\\r\\n\");"),
3525 newline, 3532 newline,
3526 string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"), 3533 string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"),
3527 newline, 3534 newline,
3528 string "uw_replace_page(ctx, \"", 3535 string "uw_replace_page(ctx, \"",
3529 string (hexify (#Bytes r)), 3536 string (hexify (#Bytes r)),
3530 string "\", ", 3537 string "\", ",
3531 string (Int.toString (Word8Vector.length (#Bytes r))), 3538 string (Int.toString (Word8Vector.length (#Bytes r))),