Mercurial > urweb
changeset 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 | 39faa4a037f4 |
| children | cdea39473c78 |
| files | caching-tests/test.db caching-tests/test.sql caching-tests/test.ur caching-tests/test.urp include/urweb/urweb_cpp.h src/c/urweb.c src/cjr_print.sml src/compiler.sml src/sources src/sql.sig src/sql.sml src/sql_cache.sml |
| diffstat | 12 files changed, 165 insertions(+), 91 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/caching-tests/test.sql Tue May 27 21:14:13 2014 -0400 @@ -0,0 +1,11 @@ +CREATE TABLE uw_Test_foo01(uw_id integer NOT NULL, uw_bar text NOT NULL, + PRIMARY KEY (uw_id) + + ); + + CREATE TABLE uw_Test_foo10(uw_id integer NOT NULL, uw_bar text NOT NULL, + PRIMARY KEY (uw_id) + + ); + + \ No newline at end of file
--- a/caching-tests/test.ur Tue Mar 25 02:04:06 2014 -0400 +++ b/caching-tests/test.ur Tue May 27 21:14:13 2014 -0400 @@ -1,81 +1,53 @@ table foo01 : {Id : int, Bar : string} PRIMARY KEY Id table foo10 : {Id : int, Bar : string} PRIMARY KEY Id -(* val query = (SELECT * FROM foo WHERE foo.Bar = "baz") *) -(* val insert = (INSERT INTO foo (Id, Bar) VALUES (42, "baz")) *) +fun flush01 () : transaction page = + dml (INSERT INTO foo01 (Id, Bar) VALUES (42, "baz01")); + dml (UPDATE foo01 SET Bar = "baz01" WHERE Id = 42); + return <xml><body> + Flushed 1! + </body></xml> -fun flush01 () : transaction page= - dml (INSERT INTO foo01 (Id, Bar) VALUES (42, "baz")); - return - <xml> - <body> - Flushed 1! - </body> - </xml> +fun flush10 () : transaction page = + dml (UPDATE foo10 SET Bar = "baz10" WHERE Id = 42); + return <xml><body> + Flushed 2! + </body></xml> -fun flush10 () : transaction page= - dml (INSERT INTO foo10 (Id, Bar) VALUES (42, "baz")); - return - <xml> - <body> - Flushed 2! - </body> - </xml> - -fun flush11 () : transaction page= - dml (INSERT INTO foo01 (Id, Bar) VALUES (42, "baz")); - dml (INSERT INTO foo10 (Id, Bar) VALUES (42, "baz")); - return - <xml> - <body> - Flushed 1 and 2! - </body> - </xml> +fun flush11 () : transaction page = + dml (UPDATE foo01 SET Bar = "baz11" WHERE Id = 42); + dml (UPDATE foo10 SET Bar = "baz11" WHERE Id = 42); + return <xml><body> + Flushed 1 and 2! + </body></xml> fun cache01 () : transaction page = - res <- oneOrNoRows (SELECT foo01.Id, foo01.Bar - FROM foo01 - WHERE foo01.Bar = "baz"); - return - <xml> - <body> - Reading 1. - {case res of - None => <xml></xml> - | Some row => <xml>{[row.Foo01.Bar]}</xml>} - </body> - </xml> + res <- oneOrNoRows (SELECT foo01.Bar FROM foo01 WHERE foo01.Id = 42); + return <xml><body> + Reading 1. + {case res of + None => <xml></xml> + | Some row => <xml>{[row.Foo01.Bar]}</xml>} + </body></xml> fun cache10 () : transaction page = - res <- oneOrNoRows (SELECT foo10.Id, foo10.Bar - FROM foo10 - WHERE foo10.Bar = "baz"); - return - <xml> - <body> - Reading 2. - {case res of - None => <xml></xml> - | Some row => <xml>{[row.Foo10.Bar]}</xml>} - </body> - </xml> + res <- oneOrNoRows (SELECT foo10.Bar FROM foo10 WHERE foo10.Id = 42); + return <xml><body> + Reading 2. + {case res of + None => <xml></xml> + | Some row => <xml>{[row.Foo10.Bar]}</xml>} + </body></xml> fun cache11 () : transaction page = - res <- oneOrNoRows (SELECT foo01.Id, foo01.Bar - FROM foo01 - WHERE foo01.Bar = "baz"); - bla <- oneOrNoRows (SELECT foo10.Id, foo10.Bar - FROM foo10 - WHERE foo10.Bar = "baz"); - return - <xml> - <body> - Reading 1 and 2. - {case res of - None => <xml></xml> - | Some row => <xml>{[row.Foo01.Bar]}</xml>} - {case bla of - None => <xml></xml> - | Some row => <xml>{[row.Foo10.Bar]}</xml>} - </body> - </xml> + res <- oneOrNoRows (SELECT foo01.Bar FROM foo01 WHERE foo01.Id = 42); + bla <- oneOrNoRows (SELECT foo10.Bar FROM foo10 WHERE foo10.Id = 42); + return <xml><body> + Reading 1 and 2. + {case res of + None => <xml></xml> + | Some row => <xml>{[row.Foo01.Bar]}</xml>} + {case bla of + None => <xml></xml> + | Some row => <xml>{[row.Foo10.Bar]}</xml>} + </body></xml>
--- a/caching-tests/test.urp Tue Mar 25 02:04:06 2014 -0400 +++ b/caching-tests/test.urp Tue May 27 21:14:13 2014 -0400 @@ -1,4 +1,5 @@ -database dbname=test +database test.db +sql test.sql safeGet Test/flush01 safeGet Test/flush10 safeGet Test/flush11
--- a/include/urweb/urweb_cpp.h Tue Mar 25 02:04:06 2014 -0400 +++ b/include/urweb/urweb_cpp.h Tue May 27 21:14:13 2014 -0400 @@ -75,6 +75,10 @@ void uw_write(struct uw_context *, const char*); +// For caching. +void uw_recordingStart(struct uw_context *); +char *uw_recordingRead(struct uw_context *); + uw_Basis_source uw_Basis_new_client_source(struct uw_context *, uw_Basis_string); uw_unit uw_Basis_set_client_source(struct uw_context *, uw_Basis_source, uw_Basis_string);
--- a/src/c/urweb.c Tue Mar 25 02:04:06 2014 -0400 +++ b/src/c/urweb.c Tue May 27 21:14:13 2014 -0400 @@ -477,6 +477,9 @@ char *output_buffer; size_t output_buffer_size; + + // For caching. + char *recording; }; size_t uw_headers_max = SIZE_MAX; @@ -560,6 +563,8 @@ ctx->output_buffer = malloc(1); ctx->output_buffer_size = 1; + ctx->recording = 0; + return ctx; } @@ -1636,6 +1641,19 @@ *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;
--- a/src/cjr_print.sml Tue Mar 25 02:04:06 2014 -0400 +++ b/src/cjr_print.sml Tue May 27 21:14:13 2014 -0400 @@ -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 @@ string (Int.toString (size has_arg)), string ", ((*request)[0] == '/' ? ++*request : NULL), ", newline, - + if unboxable then unurlify' "(*request)" (#1 t) else @@ -914,7 +914,7 @@ space, string "4, ((*request)[0] == '/' ? ++*request : NULL), ", newline, - + string "({", newline, p_typ env (t, loc), @@ -1188,7 +1188,7 @@ string "(ctx,", space, string "it", - string (Int.toString level), + string (Int.toString level), string ");", newline] else @@ -1388,7 +1388,7 @@ string (Int.toString level), string ");", newline]) - + | _ => (ErrorMsg.errorAt loc "Unable to choose a URL encoding function"; space) in @@ -1578,7 +1578,7 @@ newline], string "tmp;", newline, - string "})"] + string "})"] end | ENone _ => string "NULL" | ESome (t, e) => @@ -2078,7 +2078,7 @@ 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 @@ newline, string "uw_ensure_transaction(ctx);", newline, - + case prepared of NONE => box [string "char *query = ", @@ -2187,7 +2187,7 @@ string "uw_ensure_transaction(ctx);", newline, newline, - + #dmlPrepared (Settings.currentDbms ()) {loc = loc, id = id, dml = dml', @@ -3378,6 +3378,50 @@ 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 @@ 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 @@ 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,
--- a/src/compiler.sml Tue Mar 25 02:04:06 2014 -0400 +++ b/src/compiler.sml Tue May 27 21:14:13 2014 -0400 @@ -606,7 +606,7 @@ filterEnv = rev (!env), sources = sources, protocol = !protocol, - dbms = !dbms, + dbms = (*!dbms*) SOME "sqlite", sigFile = !sigFile, safeGets = rev (!safeGets), onError = !onError,
--- a/src/sources Tue Mar 25 02:04:06 2014 -0400 +++ b/src/sources Tue May 27 21:14:13 2014 -0400 @@ -186,8 +186,13 @@ $(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
--- a/src/sql.sig Tue Mar 25 02:04:06 2014 -0400 +++ b/src/sql.sig Tue May 27 21:14:13 2014 -0400 @@ -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 @@ | 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 @@ | 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
--- a/src/sql.sml Tue Mar 25 02:04:06 2014 -0400 +++ b/src/sql.sml Tue May 27 21:14:13 2014 -0400 @@ -1,4 +1,4 @@ -structure Sql = struct +structure Sql :> SQL = struct open Mono
--- a/src/sql_cache.sml Tue Mar 25 02:04:06 2014 -0400 +++ b/src/sql_cache.sml Tue May 27 21:14:13 2014 -0400 @@ -10,6 +10,10 @@ 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 @@ 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 @@ 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