changeset 1171:7a2a7a8f9cab

benignEffectful
author Adam Chlipala <adamc@hcoop.net>
date Sat, 27 Feb 2010 16:49:11 -0500
parents 52c6ac6a59f1
children ad15700272f6
files doc/manual.tex src/compiler.sig src/compiler.sml src/demo.sml src/mono_reduce.sml src/settings.sig src/settings.sml
diffstat 7 files changed, 37 insertions(+), 18 deletions(-) [+]
line wrap: on
line diff
--- a/doc/manual.tex	Sat Feb 27 14:57:57 2010 -0500
+++ b/doc/manual.tex	Sat Feb 27 16:49:11 2010 -0500
@@ -135,6 +135,7 @@
 Here is the complete list of directive forms.  ``FFI'' stands for ``foreign function interface,'' Ur's facility for interaction between Ur programs and C and JavaScript libraries.
 \begin{itemize}
 \item \texttt{[allow|deny] [url|mime] PATTERN} registers a rule governing which URLs or MIME types are allowed in this application.  The first such rule to match a URL or MIME type determines the verdict.  If \texttt{PATTERN} ends in \texttt{*}, it is interpreted as a prefix rule.  Otherwise, a string must match it exactly.
+\item \texttt{benignEffectful Module.ident} registers an FFI function or transaction as having side effects.  The optimizer avoids removing, moving, or duplicating calls to such functions.  Every effectful FFI function must be registered, or the optimizer may make invalid transformations.  This version of the \texttt{effectful} directive registers that this function has only session-local side effects.
 \item \texttt{clientOnly Module.ident} registers an FFI function or transaction that may only be run in client browsers.
 \item \texttt{clientToServer Module.ident} adds FFI type \texttt{Module.ident} to the list of types that are OK to marshal from clients to servers.  Values like XML trees and SQL queries are hard to marshal without introducing expensive validity checks, so it's easier to ensure that the server never trusts clients to send such values.  The file \texttt{include/urweb.h} shows examples of the C support functions that are required of any type that may be marshalled.  These include \texttt{attrify}, \texttt{urlify}, and \texttt{unurlify} functions.
 \item \texttt{database DBSTRING} sets the string to pass to libpq to open a database connection.
--- a/src/compiler.sig	Sat Feb 27 14:57:57 2010 -0500
+++ b/src/compiler.sig	Sat Feb 27 16:49:11 2010 -0500
@@ -44,6 +44,7 @@
          scripts : string list,
          clientToServer : Settings.ffi list,
          effectful : Settings.ffi list,
+         benignEffectful : Settings.ffi list,
          clientOnly : Settings.ffi list,
          serverOnly : Settings.ffi list,
          jsFuncs : (Settings.ffi * string) list,
--- a/src/compiler.sml	Sat Feb 27 14:57:57 2010 -0500
+++ b/src/compiler.sml	Sat Feb 27 16:49:11 2010 -0500
@@ -48,6 +48,7 @@
      scripts : string list,
      clientToServer : Settings.ffi list,
      effectful : Settings.ffi list,
+     benignEffectful : Settings.ffi list,
      clientOnly : Settings.ffi list,
      serverOnly : Settings.ffi list,
      jsFuncs : (Settings.ffi * string) list,
@@ -212,7 +213,7 @@
 
 fun p_job ({prefix, database, exe, sql, sources, debug, profile,
             timeout, ffi, link, headers, scripts,
-            clientToServer, effectful, clientOnly, serverOnly, jsFuncs, ...} : job) =
+            clientToServer, effectful, benignEffectful, clientOnly, serverOnly, jsFuncs, ...} : job) =
     let
         open Print.PD
         open Print
@@ -248,6 +249,7 @@
              p_list_sep (box []) (fn s => box [string "Link", space, string s, newline]) link,
              p_ffi "ClientToServer" clientToServer,
              p_ffi "Effectful" effectful,
+             p_ffi "BenignEffectful" benignEffectful,
              p_ffi "ClientOnly" clientOnly,
              p_ffi "ServerOnly" serverOnly,
              p_list_sep (box []) (fn ((m, s), s') =>
@@ -371,6 +373,7 @@
                 val scripts = ref []
                 val clientToServer = ref []
                 val effectful = ref []
+                val benignEffectful = ref []
                 val clientOnly = ref []
                 val serverOnly = ref []
                 val jsFuncs = ref []
@@ -399,6 +402,7 @@
                             scripts = rev (!scripts),
                             clientToServer = rev (!clientToServer),
                             effectful = rev (!effectful),
+                            benignEffectful = rev (!benignEffectful),
                             clientOnly = rev (!clientOnly),
                             serverOnly = rev (!serverOnly),
                             jsFuncs = rev (!jsFuncs),
@@ -439,6 +443,7 @@
                             scripts = #scripts old @ #scripts new,
                             clientToServer = #clientToServer old @ #clientToServer new,
                             effectful = #effectful old @ #effectful new,
+                            benignEffectful = #benignEffectful old @ #benignEffectful new,
                             clientOnly = #clientOnly old @ #clientOnly new,
                             serverOnly = #serverOnly old @ #serverOnly new,
                             jsFuncs = #jsFuncs old @ #jsFuncs new,
@@ -564,6 +569,7 @@
                               | "script" => scripts := arg :: !scripts
                               | "clientToServer" => clientToServer := ffiS () :: !clientToServer
                               | "effectful" => effectful := ffiS () :: !effectful
+                              | "benignEffectful" => benignEffectful := ffiS () :: !benignEffectful
                               | "clientOnly" => clientOnly := ffiS () :: !clientOnly
                               | "serverOnly" => serverOnly := ffiS () :: !serverOnly
                               | "jsFunc" => jsFuncs := ffiM () :: !jsFuncs
@@ -626,6 +632,7 @@
                 Settings.setScripts (#scripts job);
                 Settings.setClientToServer (#clientToServer job);
                 Settings.setEffectful (#effectful job);
+                Settings.setBenignEffectful (#benignEffectful job);
                 Settings.setClientOnly (#clientOnly job);
                 Settings.setServerOnly (#serverOnly job);
                 Settings.setJsFuncs (#jsFuncs job);
--- a/src/demo.sml	Sat Feb 27 14:57:57 2010 -0500
+++ b/src/demo.sml	Sat Feb 27 16:49:11 2010 -0500
@@ -105,6 +105,7 @@
             scripts = [],
             clientToServer = [],
             effectful = [],
+            benignEffectful = [],
             clientOnly = [],
             serverOnly = [],
             jsFuncs = [],
--- a/src/mono_reduce.sml	Sat Feb 27 14:57:57 2010 -0500
+++ b/src/mono_reduce.sml	Sat Feb 27 16:49:11 2010 -0500
@@ -52,7 +52,7 @@
                               | EDml _ => true
                               | ENextval _ => true
                               | ESetval _ => true
-                              | EFfiApp (m, x, _) => Settings.isEffectful (m, x)
+                              | EFfiApp (m, x, _) => Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x)
                               | EServerCall _ => true
                               | ERecv _ => true
                               | ESleep _ => true
@@ -87,7 +87,7 @@
       | ENone _ => false
       | ESome (_, e) => impure e
       | EFfi _ => false
-      | EFfiApp (m, x, _) => Settings.isEffectful (m, x)
+      | EFfiApp (m, x, _) => Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x)
       | EApp ((EFfi _, _), _) => false
       | EApp _ => true
 
@@ -372,7 +372,7 @@
                       | ESome (_, e) => summarize d e
                       | EFfi _ => []
                       | EFfiApp (m, x, es) =>
-                        if Settings.isEffectful (m, x) then
+                        if Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x) then
                             List.concat (map (summarize d) es) @ [Unsure]
                         else
                             List.concat (map (summarize d) es)
--- a/src/settings.sig	Sat Feb 27 14:57:57 2010 -0500
+++ b/src/settings.sig	Sat Feb 27 16:49:11 2010 -0500
@@ -58,6 +58,10 @@
     val setEffectful : ffi list -> unit
     val isEffectful : ffi -> bool
 
+    (* Which FFI functions should not have their calls removed or reordered, but cause no lasting effects? *)
+    val setBenignEffectful : ffi list -> unit
+    val isBenignEffectful : ffi -> bool
+
     (* Which FFI functions may only be run in clients? *)
     val setClientOnly : ffi list -> unit
     val isClientOnly : ffi -> bool
--- a/src/settings.sml	Sat Feb 27 14:57:57 2010 -0500
+++ b/src/settings.sml	Sat Feb 27 16:49:11 2010 -0500
@@ -80,28 +80,33 @@
 val effectfulBase = basis ["dml",
                            "nextval",
                            "setval",
-                           "get_cookie",
                            "set_cookie",
                            "clear_cookie",
-                           "new_client_source",
-                           "get_client_source",
-                           "set_client_source",
-                           "current",
-                           "alert",
                            "new_channel",
-                           "send",
-                           "onError",
-                           "onFail",
-                           "onConnectFail",
-                           "onDisconnect",
-                           "onServerError",
-                           "kc",
-                           "debug"]
+                           "send"]
 
 val effectful = ref effectfulBase
 fun setEffectful ls = effectful := S.addList (effectfulBase, ls)
 fun isEffectful x = S.member (!effectful, x)
 
+val benignBase = basis ["get_cookie",
+                        "new_client_source",
+                        "get_client_source",
+                        "set_client_source",
+                        "current",
+                        "alert",
+                        "onError",
+                        "onFail",
+                        "onConnectFail",
+                        "onDisconnect",
+                        "onServerError",
+                        "kc",
+                        "debug"]
+
+val benign = ref benignBase
+fun setBenignEffectful ls = benign := S.addList (benignBase, ls)
+fun isBenignEffectful x = S.member (!benign, x)
+
 val clientBase = basis ["get",
                         "set",
                         "current",