From 09d844ebdc60010b6b19d1833c213bcbba035515 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Thu, 6 Nov 2008 11:29:16 -0500
Subject: Setting a cookie

---
 src/mono_reduce.sml | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

(limited to 'src/mono_reduce.sml')

diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 57a9cc6d..7420f14f 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -50,6 +50,7 @@ fun impure (e, _) =
       | ENone _ => false
       | ESome (_, e) => impure e
       | EFfi _ => false
+      | EFfiApp ("Basis", "set_cookie", _) => true
       | EFfiApp _ => false
       | EApp ((EFfi _, _), _) => false
       | EApp _ => true
@@ -231,6 +232,7 @@ fun summarize d (e, _) =
       | 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 @@ fun exp env e =
                 #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
-- 
cgit v1.2.3