Mercurial > urweb
comparison src/cjr_print.sml @ 2304:6fb9232ade99
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))), |