Mercurial > urweb
view src/toy_cache.sml @ 2261:f81f1930c5d6
Fix SQL-parsing and declaration-ordering bugs.
author | Ziv Scully <ziv@mit.edu> |
---|---|
date | Wed, 30 Sep 2015 00:33:52 -0400 |
parents | 6951a645ccdf |
children | 34ad83d9b729 |
line wrap: on
line source
structure ToyCache : sig val cache : Cache.cache end = struct (* Mono *) open Mono val dummyLoc = ErrorMsg.dummySpan val stringTyp = (TFfi ("Basis", "string"), dummyLoc) val optionStringTyp = (TOption stringTyp, dummyLoc) fun withTyp typ = map (fn exp => (exp, typ)) fun ffiAppCache' (func, index, argTyps) = let val m = "Sqlcache" val f = func ^ Int.toString index in Settings.addEffectful (m, f); EFfiApp (m, f, argTyps) end fun check (index, keys) = ffiAppCache' ("check", index, withTyp stringTyp keys) fun store (index, keys, value) = ffiAppCache' ("store", index, (value, stringTyp) :: withTyp stringTyp keys) fun flush (index, keys) = ffiAppCache' ("flush", index, withTyp optionStringTyp keys) (* Cjr *) open Print open Print.PD fun setupQuery {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 Print.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 ") {", newline, string "if (cacheQuery", string i, (* ASK: is returning the pointer okay? Should we duplicate? *) string " == NULL", string eqs, string ") {", newline, string "puts(\"SQLCACHE: miss ", string i, string ".\");", newline, string "uw_recordingStart(ctx);", newline, string "return NULL;", newline, string "} else {", newline, string "puts(\"SQLCACHE: hit ", string i, string ".\");", newline, string "uw_write(ctx, cacheWrite", string i, string ");", newline, string "return cacheQuery", string i, string ";", newline, string "} };", newline, string "static uw_unit uw_Sqlcache_store", string i, string "(uw_context ctx, uw_Basis_string s", string args, string ") {", newline, string "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 ".\");", newline, string "return uw_unit_v;", newline, string "};", newline, string "static uw_unit uw_Sqlcache_flush", string i, string "(uw_context ctx", string args, string ") {", newline, string "if (cacheQuery", string i, string " != NULL", string eqsNull, string ") {", newline, string "free(cacheQuery", string i, string ");", newline, string "cacheQuery", string i, string " = NULL;", newline, string "puts(\"SQLCACHE: flush ", string i, string ".\");}", newline, string "else { puts(\"SQLCACHE: keep ", string i, string ".\"); } return uw_unit_v;", newline, string "};", newline, newline] end val setupGlobal = string "/* No global setup for toy cache. */" (* Bundled up. *) val cache = {check = check, store = store, flush = flush, setupQuery = setupQuery, setupGlobal = setupGlobal} end