diff options
| author |  Adam Chlipala <adam@chlipala.net> | 2013-10-10 18:01:30 -0400 |
|---|---|---|
| committer | Adam Chlipala <adam@chlipala.net> | 2013-10-10 18:01:30 -0400 |
| commit | 08bee251e9471ab1c1e634e85cd2e1c3830cd566 (patch) | |
| tree | 36da11fa0eda62dae9ec1f9b6b2e759f28039265 /src | |
| parent | 8b2c97e6fe1a63cb59655d83c1411fe75d9505d4 (diff) | |
Make transactional FFI functions effectful by default
Diffstat (limited to 'src')
| -rw-r--r-- | src/corify.sml | 21 | ||||
| -rw-r--r-- | src/settings.sig | 1 | ||||
| -rw-r--r-- | src/settings.sml | 1 |
3 files changed, 22 insertions, 1 deletions
diff --git a/src/corify.sml b/src/corify.sml index 5cfd87b3..4ab45983 100644 --- a/src/corify.sml +++ b/src/corify.sml @@ -796,7 +796,7 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) = end | L.DFfiStr (m, n, (sgn, _)) => - (case sgn of + (print ("~~~" ^ m ^ "\n"); case sgn of L.SgnConst sgis => let val (ds, cmap, conmap, st, _) = @@ -936,7 +936,26 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) = in transactify c end + + fun isTransactional (c, _) = + case c of + L'.TFun (_, c) => isTransactional c + | L'.CApp ((L'.CFfi ("Basis", "transaction"), _), _) => true + | _ => false in + Print.epreface (x, CorePrint.p_con CoreEnv.empty c); + + if isTransactional c then + let + val ffi = (m, x) + in + if Settings.isBenignEffectful ffi then + () + else + Settings.addEffectful ffi + end + else + (); (ds, SM.insert (cmap, x, c), conmap, diff --git a/src/settings.sig b/src/settings.sig index 7675b9c8..40cfbacc 100644 --- a/src/settings.sig +++ b/src/settings.sig @@ -73,6 +73,7 @@ signature SETTINGS = sig (* Which FFI functions have side effects? *) val setEffectful : ffi list -> unit + val addEffectful : ffi -> unit val isEffectful : ffi -> bool (* Which FFI functions should not have their calls removed or reordered, but cause no lasting effects? *) diff --git a/src/settings.sml b/src/settings.sml index afe84617..948906ed 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -152,6 +152,7 @@ val effectfulBase = basis ["dml", val effectful = ref effectfulBase fun setEffectful ls = effectful := S.addList (effectfulBase, ls) fun isEffectful x = S.member (!effectful, x) +fun addEffectful x = effectful := S.add (!effectful, x) val benignBase = basis ["get_cookie", "new_client_source", |