summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2013-10-10 18:01:30 -0400
committerGravatar Adam Chlipala <adam@chlipala.net>2013-10-10 18:01:30 -0400
commit08bee251e9471ab1c1e634e85cd2e1c3830cd566 (patch)
tree36da11fa0eda62dae9ec1f9b6b2e759f28039265 /src
parent8b2c97e6fe1a63cb59655d83c1411fe75d9505d4 (diff)
Make transactional FFI functions effectful by default
Diffstat (limited to 'src')
-rw-r--r--src/corify.sml21
-rw-r--r--src/settings.sig1
-rw-r--r--src/settings.sml1
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",