diff options
Diffstat (limited to 'src')
| -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 |
6 files changed, 36 insertions, 18 deletions
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", |