diff options
Diffstat (limited to 'src/cjr_print.sml')
| -rw-r--r-- | src/cjr_print.sml | 131 |
1 files changed, 119 insertions, 12 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml index b3b12fe8..1b1d656d 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -734,7 +734,7 @@ fun unurlify fromClient env (t, loc) = string (Int.toString (size has_arg)), string ", ((*request)[0] == '/' ? ++*request : NULL), ", newline, - + if unboxable then unurlify' "(*request)" (#1 t) else @@ -914,7 +914,7 @@ fun unurlify fromClient env (t, loc) = space, string "4, ((*request)[0] == '/' ? ++*request : NULL), ", newline, - + string "({", newline, p_typ env (t, loc), @@ -1188,7 +1188,7 @@ fun urlify env t = string "(ctx,", space, string "it", - string (Int.toString level), + string (Int.toString level), string ");", newline] else @@ -1388,7 +1388,7 @@ fun urlify env t = string (Int.toString level), string ");", newline]) - + | _ => (ErrorMsg.errorAt loc "Unable to choose a URL encoding function"; space) in @@ -1578,7 +1578,7 @@ and p_exp' par tail env (e, loc) = newline], string "tmp;", newline, - string "})"] + string "})"] end | ENone _ => string "NULL" | ESome (t, e) => @@ -2078,7 +2078,7 @@ and p_exp' par tail env (e, loc) = space, p_exp' false false (E.pushERel (E.pushERel env "r" (TRecord rnum, loc)) - "acc" state) + "acc" state) body, string ";", newline] @@ -2102,7 +2102,7 @@ and p_exp' par tail env (e, loc) = newline, string "uw_ensure_transaction(ctx);", newline, - + case prepared of NONE => box [string "char *query = ", @@ -2187,7 +2187,7 @@ and p_exp' par tail env (e, loc) = string "uw_ensure_transaction(ctx);", newline, newline, - + #dmlPrepared (Settings.currentDbms ()) {loc = loc, id = id, dml = dml', @@ -3403,6 +3403,113 @@ fun p_file env (ds, ps) = newline, newline, + (* For sqlcache. *) + box (List.map + (fn {index, params} => + let val i = Int.toString index + fun paramRepeat itemi sep = + let + fun f n = + if n < 0 then "" + else if n = 0 then itemi (Int.toString 0) + else f (n-1) ^ sep ^ itemi (Int.toString n) + in + f (params - 1) + end + fun paramRepeatInit itemi sep = + if params = 0 then "" else sep ^ paramRepeat itemi sep + val args = paramRepeatInit (fn p => "uw_Basis_string p" ^ p) ", " + val decls = paramRepeat (fn p => "uw_Basis_string param" ^ i ^ "_" + ^ p ^ " = NULL;") + "\n" + val sets = paramRepeat (fn p => "param" ^ i ^ "_" ^ p + ^ " = strdup(p" ^ p ^ ");") + "\n" + val frees = paramRepeat (fn p => "free(param" ^ i ^ "_" ^ p ^ ");") + "\n" + val eqs = paramRepeatInit (fn p => "strcmp(param" ^ i ^ "_" ^ p + ^ ", p" ^ p ^ ")") + " || " + (* Using [!=] instead of [==] to mimic [strcmp]. *) + val eqsNull = paramRepeatInit (fn p => "(p" ^ p ^ " == NULL || " + ^ "!strcmp(param" ^ i ^ "_" + ^ p ^ ", p" ^ p ^ "))") + " && " + in box [string "static char *cacheQuery", + string i, + string " = NULL;", + newline, + string "static char *cacheWrite", + string i, + string " = NULL;", + newline, + string decls, + newline, + string "static uw_Basis_string uw_Sqlcache_check", + string i, + string "(uw_context ctx", + string args, + string ") {\n if (cacheQuery", + string i, + (* ASK: is returning the pointer okay? Should we duplicate? *) + string " == NULL", + string eqs, + string ") {\n puts(\"SQLCACHE: miss ", + string i, + string ".\");\n uw_recordingStart(ctx);\n return NULL;\n } else {\n puts(\"SQLCACHE: hit ", + string i, + string ".\");\n uw_write(ctx, cacheWrite", + string i, + string ");\n return cacheQuery", + string i, + string ";\n } };", + newline, + string "static uw_unit uw_Sqlcache_store", + string i, + string "(uw_context ctx, uw_Basis_string s", + string args, + string ") {\n free(cacheQuery", + string i, + string "); free(cacheWrite", + string i, + string ");", + newline, + string frees, + newline, + string "cacheQuery", + string i, + string " = strdup(s); cacheWrite", + string i, + string " = uw_recordingRead(ctx);", + newline, + string sets, + newline, + string "puts(\"SQLCACHE: store ", + string i, + string ".\");\n return uw_unit_v;\n };", + newline, + string "static uw_unit uw_Sqlcache_flush", + string i, + string "(uw_context ctx", + string args, + string ") {\n if (cacheQuery", + string i, + string " != NULL", + string eqsNull, + string ") {\n free(cacheQuery", + string i, + string ");\n cacheQuery", + string i, + string " = NULL;\n puts(\"SQLCACHE: flush ", + string i, + string ".\");}\n else { puts(\"SQLCACHE: keep ", + string i, + string ".\"); } return uw_unit_v;\n };", + newline, + newline] + end) + (Sqlcache.getFfiInfo ())), + newline, p_list_sep newline (fn x => x) pds, newline, @@ -3458,7 +3565,7 @@ fun p_file env (ds, ps) = makeChecker ("uw_check_envVar", Settings.getEnvVarRules ()), newline, - + string "extern void uw_sign(const char *in, char *out);", newline, string "extern int uw_hash_blocksize;", @@ -3505,7 +3612,7 @@ fun p_file env (ds, ps) = newline, string ("uw_write_header(ctx, \"Last-Modified: " ^ Date.fmt rfcFmt nowD ^ "\\r\\n\");"), newline, - string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"), + string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"), newline, string "uw_write(ctx, jslib);", newline, @@ -3530,7 +3637,7 @@ fun p_file env (ds, ps) = newline, string ("uw_write_header(ctx, \"Content-Length: " ^ Int.toString (Word8Vector.length (#Bytes r)) ^ "\\r\\n\");"), newline, - string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"), + string ("uw_write_header(ctx, \"Cache-Control: max-age=31536000, public\\r\\n\");"), newline, string "uw_replace_page(ctx, \"", string (hexify (#Bytes r)), |