# HG changeset patch # User Adam Chlipala # Date 1267307351 18000 # Node ID 7a2a7a8f9cab3d249e5fc6cf39ed6740bdc0b0b1 # Parent 52c6ac6a59f16383be56f2b6dd2ad1ac95c5824f benignEffectful diff -r 52c6ac6a59f1 -r 7a2a7a8f9cab doc/manual.tex --- 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. diff -r 52c6ac6a59f1 -r 7a2a7a8f9cab src/compiler.sig --- 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, diff -r 52c6ac6a59f1 -r 7a2a7a8f9cab src/compiler.sml --- 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); diff -r 52c6ac6a59f1 -r 7a2a7a8f9cab src/demo.sml --- 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 = [], diff -r 52c6ac6a59f1 -r 7a2a7a8f9cab src/mono_reduce.sml --- 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) diff -r 52c6ac6a59f1 -r 7a2a7a8f9cab src/settings.sig --- 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 diff -r 52c6ac6a59f1 -r 7a2a7a8f9cab src/settings.sml --- 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",