Mercurial > urweb
comparison src/cjr_print.sml @ 2204:01c8aceac480
Finishes initial prototype, caching parameterless pages with table-match-based invalidation. Still has problems parsing non-Postgres SQL dialects properly.
author | Ziv Scully <ziv@mit.edu> |
---|---|
date | Tue, 27 May 2014 21:14:13 -0400 |
parents | ac1be85e91ad |
children | 0ca11d57c175 |
comparison
equal
deleted
inserted
replaced
2203:39faa4a037f4 | 2204:01c8aceac480 |
---|---|
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}] |
3376 newline, | 3376 newline, |
3377 string "static int uw_db_rollback(uw_context ctx) { return 0; };"], | 3377 string "static int uw_db_rollback(uw_context ctx) { return 0; };"], |
3378 newline, | 3378 newline, |
3379 newline, | 3379 newline, |
3380 | 3380 |
3381 (* For caching. *) | |
3382 box (List.map | |
3383 (fn index => | |
3384 let val i = Int.toString index | |
3385 in box [string "static char *cache", | |
3386 string i, | |
3387 string " = NULL;", | |
3388 newline, | |
3389 string "static uw_Basis_bool uw_Cache_check", | |
3390 string i, | |
3391 string "(uw_context ctx) { puts(\"Checked ", | |
3392 string i, | |
3393 string "\"); if (cache", | |
3394 string i, | |
3395 string " == NULL) { uw_recordingStart(ctx); return uw_Basis_False; } else { uw_write(ctx, cache", | |
3396 string i, | |
3397 string "); return uw_Basis_True; } };", | |
3398 newline, | |
3399 string "static uw_unit uw_Cache_store", | |
3400 string i, | |
3401 string "(uw_context ctx) { cache", | |
3402 string i, | |
3403 string " = uw_recordingRead(ctx); puts(\"Stored ", | |
3404 string i, | |
3405 string "\"); return uw_unit_v; };", | |
3406 newline, | |
3407 string "static uw_unit uw_Cache_flush", | |
3408 string i, | |
3409 string "(uw_context ctx) { free(cache", | |
3410 string i, | |
3411 string "); cache", | |
3412 string i, | |
3413 string " = NULL; puts(\"Flushed ", | |
3414 string i, | |
3415 string "\"); return uw_unit_v; };", | |
3416 newline, | |
3417 string "static uw_unit uw_Cache_ready", | |
3418 string i, | |
3419 string "(uw_context ctx) { return uw_unit_v; };", | |
3420 newline, | |
3421 newline] | |
3422 end) | |
3423 (!SqlCache.ffiIndices)), | |
3424 newline, | |
3381 | 3425 |
3382 p_list_sep newline (fn x => x) pds, | 3426 p_list_sep newline (fn x => x) pds, |
3383 newline, | 3427 newline, |
3384 newline, | 3428 newline, |
3385 string "static int uw_input_num(const char *name) {", | 3429 string "static int uw_input_num(const char *name) {", |
3431 makeChecker ("uw_check_responseHeader", Settings.getResponseHeaderRules ()), | 3475 makeChecker ("uw_check_responseHeader", Settings.getResponseHeaderRules ()), |
3432 newline, | 3476 newline, |
3433 | 3477 |
3434 makeChecker ("uw_check_envVar", Settings.getEnvVarRules ()), | 3478 makeChecker ("uw_check_envVar", Settings.getEnvVarRules ()), |
3435 newline, | 3479 newline, |
3436 | 3480 |
3437 string "extern void uw_sign(const char *in, char *out);", | 3481 string "extern void uw_sign(const char *in, char *out);", |
3438 newline, | 3482 newline, |
3439 string "extern int uw_hash_blocksize;", | 3483 string "extern int uw_hash_blocksize;", |
3440 newline, | 3484 newline, |
3441 string "static uw_Basis_string uw_cookie_sig(uw_context ctx) {", | 3485 string "static uw_Basis_string uw_cookie_sig(uw_context ctx) {", |
3478 newline, | 3522 newline, |
3479 string "uw_write_header(ctx, \"Content-type: text/javascript\\r\\n\");", | 3523 string "uw_write_header(ctx, \"Content-type: text/javascript\\r\\n\");", |
3480 newline, | 3524 newline, |
3481 string ("uw_write_header(ctx, \"Last-modified: " ^ Date.fmt rfcFmt nowD ^ "\\r\\n\");"), | 3525 string ("uw_write_header(ctx, \"Last-modified: " ^ Date.fmt rfcFmt nowD ^ "\\r\\n\");"), |
3482 newline, | 3526 newline, |
3483 string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"), | 3527 string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"), |
3484 newline, | 3528 newline, |
3485 string "uw_write(ctx, jslib);", | 3529 string "uw_write(ctx, jslib);", |
3486 newline, | 3530 newline, |
3487 string "return;", | 3531 string "return;", |
3488 newline], | 3532 newline], |