diff src/mono_reduce.sml @ 462:21bb5bbba2e9

Setting a cookie
author Adam Chlipala <adamc@hcoop.net>
date Thu, 06 Nov 2008 11:29:16 -0500
parents 1a4fa157fedd
children bb27c7efcd90
line wrap: on
line diff
--- a/src/mono_reduce.sml	Thu Nov 06 10:48:02 2008 -0500
+++ b/src/mono_reduce.sml	Thu Nov 06 11:29:16 2008 -0500
@@ -50,6 +50,7 @@
       | ENone _ => false
       | ESome (_, e) => impure e
       | EFfi _ => false
+      | EFfiApp ("Basis", "set_cookie", _) => true
       | EFfiApp _ => false
       | EApp ((EFfi _, _), _) => false
       | EApp _ => true
@@ -231,6 +232,7 @@
       | ENone _ => []
       | ESome (_, e) => summarize d e
       | EFfi _ => []
+      | EFfiApp ("Basis", "set_cookie", _) => [Unsure]
       | EFfiApp (_, _, es) => List.concat (map (summarize d) es)
       | EApp ((EFfi _, _), e) => summarize d e
       | EApp _ => [Unsure]
@@ -347,12 +349,16 @@
                 #1 (reduceExp env (ELet (x, t, e,
                                          (EApp (b, liftExpInExp 0 e'), loc)), loc))
 
-              | ELet (x, t, e, (EAbs (x', t' as (TRecord [], _), ran, e'), loc)) =>
-                EAbs (x', t', ran, (ELet (x, t, liftExpInExp 0 e, swapExpVars 0 e'), loc))
+              | ELet (x, t, e', (EAbs (x', t' as (TRecord [], _), ran, e''), loc)) =>
+                if impure e' then
+                    e
+                else
+                    EAbs (x', t', ran, (ELet (x, t, liftExpInExp 0 e', swapExpVars 0 e''), loc))
 
               | ELet (x, t, e', b) =>
                 let
-                    fun doSub () = #1 (reduceExp env (subExpInExp (0, e') b))
+                    fun doSub () =
+                        #1 (reduceExp env (subExpInExp (0, e') b))
 
                     fun trySub () =
                         case t of