Changeset 14639 for src/Pugs/Eval.hs

Timestamp:

11/05/06 18:46:26 (2 years ago)

Author:

audreyt

svk:copy_cache_prev:

41990

Message:

* t/var/let.t: All tests passed, 0 TODOs.

Files:

• src/Pugs/Eval.hs (modified) (1 diff)

src/Pugs/Eval.hs

@@ -364 +364 @@
         -- if the liftSTM is reached, exp evaluated without error; no need to shift out
         evalExp exp `finallyM` liftSTM (writeTVar isNonLocal False)
+    when (isFailure val) $ do
+        mapM_ (\tmp -> evalExp $ App (Val tmp) Nothing []) tmps
     isn <- liftSTM $ readTVar isNonLocal
-    if isn
-        then do
-            when (isFailure val) $ do
-                mapM_ (\tmp -> evalExp $ App (Val tmp) Nothing []) tmps
-            retShift val
-        else return val
-    where
-    isFailure (VControl (ControlLeave{ leaveValue = v }))
-        | VUndef <- v = True
-        | VRef r <- v = refType r == mkType "Failure"
-        | otherwise   = False
+    if isn then retShift val else return val
+    where
+    isFailure (VControl ControlLeave{ leaveValue = v }) = isFailure v
     isFailure VControl{}    = True
+    isFailure VUndef        = True
+    isFailure VError{}      = True
+    isFailure (VRef r)      = refType r == mkType "Failure"
     isFailure _             = False
-
-
 
 reducePad _ lex exp = do