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],