Mercurial > urweb
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",