diff options
| -rw-r--r-- | doc/manual.tex | 1 | ||||
| -rw-r--r-- | src/compiler.sig | 1 | ||||
| -rw-r--r-- | src/compiler.sml | 9 | ||||
| -rw-r--r-- | src/demo.sml | 1 | ||||
| -rw-r--r-- | src/mono_reduce.sml | 6 | ||||
| -rw-r--r-- | src/settings.sig | 4 | ||||
| -rw-r--r-- | src/settings.sml | 33 |
7 files changed, 37 insertions, 18 deletions
diff --git a/doc/manual.tex b/doc/manual.tex index 6ac5a8d5..d9d40919 100644 --- a/doc/manual.tex +++ b/doc/manual.tex @@ -135,6 +135,7 @@ For each entry \texttt{M} in the module list, the file \texttt{M.urs} is include 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 --git a/src/compiler.sig b/src/compiler.sig index 3d77a4cd..63da4e5c 100644 --- a/src/compiler.sig +++ b/src/compiler.sig @@ -44,6 +44,7 @@ signature COMPILER = sig 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 --git a/src/compiler.sml b/src/compiler.sml index c74a0915..f0313c8b 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -48,6 +48,7 @@ type job = { 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 @@ val parseUr = { 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 @@ fun p_job ({prefix, database, exe, sql, sources, debug, profile, 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 @@ fun parseUrp' accLibs fname = 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 @@ fun parseUrp' accLibs fname = 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 @@ fun parseUrp' accLibs fname = 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 @@ fun parseUrp' accLibs fname = | "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 @@ fun parseUrp' accLibs fname = 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 --git a/src/demo.sml b/src/demo.sml index 6280400b..6ae64264 100644 --- a/src/demo.sml +++ b/src/demo.sml @@ -105,6 +105,7 @@ fun make' {prefix, dirname, guided} = scripts = [], clientToServer = [], effectful = [], + benignEffectful = [], clientOnly = [], serverOnly = [], jsFuncs = [], diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index 10de1c56..6bd5ceb8 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -52,7 +52,7 @@ fun simpleImpure (tsyms, syms) = | 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 @@ fun impure (e, _) = | 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 @@ fun reduce file = | 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 --git a/src/settings.sig b/src/settings.sig index 348c47d4..3179c229 100644 --- a/src/settings.sig +++ b/src/settings.sig @@ -58,6 +58,10 @@ signature SETTINGS = sig 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 --git a/src/settings.sml b/src/settings.sml index f600d2ac..cd081725 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -80,28 +80,33 @@ fun mayClientToServer x = S.member (!clientToServer, x) 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", |