Add missing file.

1 files changed, 185 insertions, 0 deletions

diff --git a/src/toy_cache.sml b/src/toy_cache.sml
new file mode 100644
index 00000000..23dfe4fe
--- /dev/null
+++ b/src/toy_cache.sml
@@ -0,0 +1,185 @@
+structure ToyCache = 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) =
+    EFfiApp ("Sqlcache", func ^ Int.toString index, argTyps)
+
+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. */"
+
+end