Changeset 14123 for src/Pugs/Eval.hs

Timestamp:

10/09/06 17:26:38 (2 years ago)

Author:

audreyt

Message:

* Pugs.Eval: Finish excising of resetT and shiftT and replace

them with tryT and retControl.

Files:

• src/Pugs/Eval.hs (modified) (4 diffs)

src/Pugs/Eval.hs

@@ -121 +121 @@
     evalExp (Syn "=" [_Var "@*INIT", Syn "," []])
     -- The main runtime
-    resetT (evaluate exp) `finallyM` do
+    tryT (evaluate exp) `finallyM` do
         -- S04: END {...}       at run time, ALAP
         endAV       <- reduceVar $ cast "@*END"
@@ -346 +346 @@
     -- default to nonlocal exit
     isNonLocal  <- liftSTM $ newTVar True
-    val <- resetT $ do
+    val <- tryT $ do
         -- if the liftSTM is reached, exp evaluated without error; no need to shift out
         evalExp exp `finallyM` liftSTM (writeTVar isNonLocal False)
     mapM_ (\tmp -> evalExp $ App (Val tmp) Nothing []) tmps
     isn <- liftSTM $ readTVar isNonLocal
-    (if isn then (shiftT . const) else id) (return val)
+    (if isn then retShift else return) val
 
 reducePad _ lex exp = do
@@ -942 +942 @@
         retVal val
     , "&return"     ... \args -> do
-        op1Return . shiftT . const . fmap (VControl . ControlLeave (<= SubRoutine) 0) $ 
+        (op1Return . retControl . ControlLeave (<= SubRoutine) 0) =<<
             case args of
                 []      -> retEmpty
@@ -959 +959 @@
         local callerEnv $ do
             val <- apply sub Nothing args
-            shiftT $ const (retVal val)
+            retShift =<< retVal val
             retEmpty
     , "&call"       ... \inv args -> do