diff options
author | Ziv Scully <ziv@mit.edu> | 2014-05-27 21:14:13 -0400 |
---|---|---|
committer | Ziv Scully <ziv@mit.edu> | 2014-05-27 21:14:13 -0400 |
commit | b1516ed386ca303a526959586f0a06564ca77bb0 (patch) | |
tree | d37d80752e5a132615064d4b1e991dcb8ef35793 /src | |
parent | 93d6de491838eb3607a12686bfdc250366aa60e4 (diff) |
Finishes initial prototype, caching parameterless pages with table-match-based invalidation. Still has problems parsing non-Postgres SQL dialects properly.
Diffstat (limited to 'src')
-rw-r--r-- | src/c/urweb.c | 18 | ||||
-rw-r--r-- | src/cjr_print.sml | 66 | ||||
-rw-r--r-- | src/compiler.sml | 2 | ||||
-rw-r--r-- | src/sources | 5 | ||||
-rw-r--r-- | src/sql.sig | 22 | ||||
-rw-r--r-- | src/sql.sml | 2 | ||||
-rw-r--r-- | src/sql_cache.sml | 11 |
7 files changed, 106 insertions, 20 deletions
diff --git a/src/c/urweb.c b/src/c/urweb.c index ffcc0146..d4c0b439 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -477,6 +477,9 @@ struct uw_context { char *output_buffer; size_t output_buffer_size; + + // For caching. + char *recording; }; size_t uw_headers_max = SIZE_MAX; @@ -560,6 +563,8 @@ uw_context uw_init(int id, void *logger_data, uw_logger log_debug) { ctx->output_buffer = malloc(1); ctx->output_buffer_size = 1; + ctx->recording = 0; + return ctx; } @@ -1636,6 +1641,19 @@ void uw_write(uw_context ctx, const char* s) { *ctx->page.front = 0; } +void uw_recordingStart(uw_context ctx) { + // TODO: remove following debug statement. + uw_write(ctx, "<!--Recording started here-->"); + ctx->recording = ctx->page.front; +} + +char *uw_recordingRead(uw_context ctx) { + char *recording = strdup(ctx->recording); + // TODO: remove following debug statement. + uw_write(ctx, "<!--Recording read here-->"); + return recording; +} + char *uw_Basis_attrifyInt(uw_context ctx, uw_Basis_int n) { char *result; int len; diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 05dce35e..ecd29f71 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', @@ -3378,6 +3378,50 @@ fun p_file env (ds, ps) = newline, newline, + (* For caching. *) + box (List.map + (fn index => + let val i = Int.toString index + in box [string "static char *cache", + string i, + string " = NULL;", + newline, + string "static uw_Basis_bool uw_Cache_check", + string i, + string "(uw_context ctx) { puts(\"Checked ", + string i, + string "\"); if (cache", + string i, + string " == NULL) { uw_recordingStart(ctx); return uw_Basis_False; } else { uw_write(ctx, cache", + string i, + string "); return uw_Basis_True; } };", + newline, + string "static uw_unit uw_Cache_store", + string i, + string "(uw_context ctx) { cache", + string i, + string " = uw_recordingRead(ctx); puts(\"Stored ", + string i, + string "\"); return uw_unit_v; };", + newline, + string "static uw_unit uw_Cache_flush", + string i, + string "(uw_context ctx) { free(cache", + string i, + string "); cache", + string i, + string " = NULL; puts(\"Flushed ", + string i, + string "\"); return uw_unit_v; };", + newline, + string "static uw_unit uw_Cache_ready", + string i, + string "(uw_context ctx) { return uw_unit_v; };", + newline, + newline] + end) + (!SqlCache.ffiIndices)), + newline, p_list_sep newline (fn x => x) pds, newline, @@ -3433,7 +3477,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;", @@ -3480,7 +3524,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, diff --git a/src/compiler.sml b/src/compiler.sml index de10d8c8..37272758 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -606,7 +606,7 @@ fun parseUrp' accLibs fname = filterEnv = rev (!env), sources = sources, protocol = !protocol, - dbms = !dbms, + dbms = (*!dbms*) SOME "sqlite", sigFile = !sigFile, safeGets = rev (!safeGets), onError = !onError, diff --git a/src/sources b/src/sources index f75803a3..b468c9a5 100644 --- a/src/sources +++ b/src/sources @@ -186,8 +186,13 @@ $(SRC)/mono_shake.sml $(SRC)/fuse.sig $(SRC)/fuse.sml +$(SRC)/sql.sig $(SRC)/sql.sml +$(SRC)/multimap_fn.sml + +$(SRC)/sql_cache.sml + $(SRC)/iflow.sig $(SRC)/iflow.sml diff --git a/src/sql.sig b/src/sql.sig index 540844c3..573a8baf 100644 --- a/src/sql.sig +++ b/src/sql.sig @@ -1,10 +1,8 @@ signature SQL = sig -val fu : Mono.file -> unit - val debug : bool ref -type lvar +type lvar = int datatype func = DtCon0 of string @@ -41,7 +39,13 @@ datatype prop = | Reln of reln * exp list | Cond of exp * prop -datatype ('a, 'b) sum = inl of 'a | inr of 'b +datatype chunk = + String of string + | Exp of Mono.exp + +type 'a parser = chunk list -> ('a * chunk list) option + +val parse : 'a parser -> Mono.exp -> 'a option datatype Rel = Exps of exp * exp -> prop @@ -61,19 +65,27 @@ datatype sqexp = | Unmodeled | Null +datatype ('a,'b) sum = inl of 'a | inr of 'b + datatype sitem = SqField of string * string | SqExp of sqexp * string -type query1 +type query1 = {Select : sitem list, + From : (string * string) list, + Where : sqexp option} datatype query = Query1 of query1 | Union of query * query +val query : query parser + datatype dml = Insert of string * (string * sqexp) list | Delete of string * sqexp | Update of string * (string * sqexp) list * sqexp +val dml : dml parser + end diff --git a/src/sql.sml b/src/sql.sml index 6ac8bc68..8642c9d2 100644 --- a/src/sql.sml +++ b/src/sql.sml @@ -1,4 +1,4 @@ -structure Sql = struct +structure Sql :> SQL = struct open Mono diff --git a/src/sql_cache.sml b/src/sql_cache.sml index 072eefb5..7f9d98d0 100644 --- a/src/sql_cache.sml +++ b/src/sql_cache.sml @@ -10,6 +10,10 @@ structure SS = BinarySetFn (StringKey) structure SM = BinaryMapFn (StringKey) structure SIMM = MultimapFn (structure KeyMap = SM structure ValSet = IS) +val ffiIndices : int list ref = ref [] +val rs : int list ref = ref [] +val ws : int list ref = ref [] + val rec tablesRead = fn Query1 {From=tablePairs, ...} => SS.fromList (map #1 tablePairs) | Union (q1,q2) => SS.union (tablesRead q1, tablesRead q2) @@ -54,8 +58,8 @@ fun boolPat (b, loc) = (PCon (Enum, loc) fun boolTyp loc = (TFfi ("Basis", "int"), loc) -fun ffiAppExp (module, func, arg, loc) = - (EFfiApp (module, func, [(intExp (arg, loc), intTyp loc)]), loc) +fun ffiAppExp (module, func, index, loc) = + (EFfiApp (module, func ^ Int.toString index, []), loc) fun sequence (befores, center, afters, loc) = List.foldr (fn (exp, seq) => (ESeq (exp, seq), loc)) @@ -173,6 +177,9 @@ fun go file = val {readers, writers} = handlerIndices file val (fileWithChecks, tablesToIndices) = addCacheChecking (file, readers) in + rs := IS.listItems readers; + ws := IS.listItems writers; + ffiIndices := IS.listItems readers; addCacheFlushing (fileWithChecks, tablesToIndices, writers) end |