# HG changeset patch
# User Ziv Scully <ziv@mit.edu>
# Date 1443387734 14400
# Node ID b1ba35ce2613b81830401ce3db850c4523f3f2f0
# Parent  28a541bd2d235089247926e3a820c89194a94863
Fix bug where pure caching didn't treat FFI applications as effectful.

diff -r 28a541bd2d23 -r b1ba35ce2613 src/lru_cache.sml
--- a/src/lru_cache.sml	Sun Sep 27 14:46:12 2015 -0400
+++ b/src/lru_cache.sml	Sun Sep 27 17:02:14 2015 -0400
@@ -13,7 +13,13 @@
 fun withTyp typ = map (fn exp => (exp, typ))
 
 fun ffiAppCache' (func, index, argTyps) =
-    EFfiApp ("Sqlcache", func ^ Int.toString 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)
diff -r 28a541bd2d23 -r b1ba35ce2613 src/sqlcache.sml
--- a/src/sqlcache.sml	Sun Sep 27 14:46:12 2015 -0400
+++ b/src/sqlcache.sml	Sun Sep 27 17:02:14 2015 -0400
@@ -26,23 +26,23 @@
 val ffiEffectful =
     (* ASK: how can this be less hard-coded? *)
     let
-        val fs = SS.fromList ["htmlifyInt_w",
-                              "htmlifyFloat_w",
-                              "htmlifyString_w",
-                              "htmlifyBool_w",
-                              "htmlifyTime_w",
-                              "attrifyInt_w",
-                              "attrifyFloat_w",
-                              "attrifyString_w",
-                              "attrifyChar_w",
-                              "urlifyInt_w",
-                              "urlifyFloat_w",
-                              "urlifyString_w",
-                              "urlifyBool_w",
-                              "urlifyChannel_w"]
+        val okayWrites = SS.fromList ["htmlifyInt_w",
+                                      "htmlifyFloat_w",
+                                      "htmlifyString_w",
+                                      "htmlifyBool_w",
+                                      "htmlifyTime_w",
+                                      "attrifyInt_w",
+                                      "attrifyFloat_w",
+                                      "attrifyString_w",
+                                      "attrifyChar_w",
+                                      "urlifyInt_w",
+                                      "urlifyFloat_w",
+                                      "urlifyString_w",
+                                      "urlifyBool_w",
+                                      "urlifyChannel_w"]
     in
         fn (m, f) => Settings.isEffectful (m, f)
-                     orelse not (m = "Basis" andalso SS.member (fs, f))
+                     andalso not (m = "Basis" andalso SS.member (okayWrites, f))
     end
 
 val cache = ref LruCache.cache
@@ -548,7 +548,7 @@
                         let
                             val n = length newVars
                         in
-                            (* This is the (n + 1)th new variable, so there are
+                            (* This is the (n+1)th new variable, so there are
                                already n new variables bound, so we increment
                                indices by n. *)
                             (strcat ((ERel (~(n+1)), loc), qText), incRels n e :: newVars)
@@ -586,7 +586,7 @@
                                         dummyLoc)
                 val (EQuery {query = queryText, ...}, _) = queryExp
                 (* DEBUG *)
-                val () = Print.preface ("sqlcache> ", (MonoPrint.p_exp MonoEnv.empty queryText))
+                (* val () = Print.preface ("sqlcache> ", MonoPrint.p_exp MonoEnv.empty queryText) *)
                 val args = List.tabulate (numArgs, fn n => (ERel n, dummyLoc))
                 fun bind x f = Option.mapPartial f x
                 fun guard b x = if b then x else NONE
@@ -682,7 +682,7 @@
                 val dmlText = incRels numArgs newDmlText
                 val dmlExp = EDml (dmlText, failureMode)
                 (* DEBUG *)
-                val () = Print.preface ("sqlcache> ", (MonoPrint.p_exp MonoEnv.empty dmlText))
+                (* val () = Print.preface ("sqlcache> ", (MonoPrint.p_exp MonoEnv.empty dmlText)) *)
                 val invs =
                     case Sql.parse Sql.dml dmlText of
                         SOME dmlParsed =>
@@ -795,6 +795,8 @@
           0
           IS.empty
 
+val expSize = MonoUtil.Exp.fold {typ = #2, exp = fn (_, n) => n+1} 0
+
 datatype subexp = Pure of unit -> exp | Impure of exp
 
 val isImpure =
@@ -810,16 +812,18 @@
         NONE => NONE
       | SOME (TFun _, _) => NONE
       | SOME typ =>
-        case List.foldr (fn ((_, _), NONE) => NONE
-                          | ((n, typ), SOME args) =>
-                            case MonoFooify.urlify env ((ERel n, dummyLoc), typ) of
-                                NONE => NONE
-                              | SOME arg => SOME (arg :: args))
-                        (SOME [])
-                        (map (fn n => (n, #2 (MonoEnv.lookupERel env n)))
-                             (freeVars (exp', dummyLoc))) of
-            NONE => NONE
-          | SOME args => cacheWrap (env, (exp', dummyLoc), typ, args, index)
+        if expSize (exp', dummyLoc) < 5 (* TODO: pick a number. *)
+        then NONE
+        else case List.foldr (fn ((_, _), NONE) => NONE
+                               | ((n, typ), SOME args) =>
+                                 case MonoFooify.urlify env ((ERel n, dummyLoc), typ) of
+                                     NONE => NONE
+                                   | SOME arg => SOME (arg :: args))
+                             (SOME [])
+                             (map (fn n => (n, #2 (MonoEnv.lookupERel env n)))
+                                  (freeVars (exp', dummyLoc))) of
+                 NONE => NONE
+               | SOME args => cacheWrap (env, (exp', dummyLoc), typ, args, index)
 
 fun pureCache (effs : IS.set) ((env, exp as (exp', loc)), index) : subexp * int =
     let
@@ -848,8 +852,11 @@
             ECon (dk, pc, SOME e) => wrap1 (fn e => ECon (dk, pc, SOME e)) e
           | ESome (t, e) => wrap1 (fn e => ESome (t, e)) e
           | EFfiApp (s1, s2, args) =>
-            wrapN (fn es => EFfiApp (s1, s2, ListPair.map (fn (e, (_, t)) => (e, t)) (es, args)))
-                  (map #1 args)
+            if ffiEffectful (s1, s2)
+            then (Impure exp, index)
+            else wrapN (fn es =>
+                           EFfiApp (s1, s2, ListPair.map (fn (e, (_, t)) => (e, t)) (es, args)))
+                       (map #1 args)
           | EApp (e1, e2) => wrap2 EApp (e1, e2)
           | EAbs (s, t1, t2, e) =>
             wrapBind1 (fn e => EAbs (s, t1, t2, e))
@@ -918,7 +925,6 @@
         (* Important that this happens after the MonoFooify.urlify calls! *)
         val fmDecls = MonoFooify.getNewFmDecls ()
     in
-        print (Int.toString (length fmDecls));
         (* ASK: fmDecls before or after? *)
         (fmDecls @ decls, sideInfo)
     end