diff src/corify.sml @ 1878:df6a040f5389

Make transactional FFI functions effectful by default
author Adam Chlipala <adam@chlipala.net>
date Thu, 10 Oct 2013 18:01:30 -0400
parents 21ecf340f05c
children c1ee5dec9cff
line wrap: on
line diff
--- a/src/corify.sml	Thu Oct 10 14:48:43 2013 -0400
+++ b/src/corify.sml	Thu Oct 10 18:01:30 2013 -0400
@@ -796,7 +796,7 @@
         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 @@
                                                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,