Changeset 16487

Timestamp:

05/21/07 21:40:31 (18 months ago)

Author:

audreyt

Message:

* Per dduncan++'s request, make "die" and "warn" output stack trace.

Location:

src/Pugs

Files:

• Monads.hs (modified) (3 diffs)
• Prim.hs (modified) (2 diffs)

src/Pugs/Monads.hs

@@ -305 +305 @@
             local doFix runAction
 
-        _ | typ >= SubBlock -> tryT $ do
+--      _ | typ >= SubBlock -> tryT $ do
+        _ -> tryT $ do
             doFix <- fixEnv return env pad
             local doFix runAction
-
+{-
         _ -> tryT . callCC $ \cc -> do
             doFix <- fixEnv cc env pad
             local doFix runAction
+-}
 
     -- warn "XXX" ()
@@ -329 +331 @@
                 else retControl l{ leaveDepth = depth' }
         VControl ControlExit{}  -> retShift rv
-        VError{}                -> do
-            -- XXX - Implement CATCH block here
-            retShift rv
+        VError{}                -> retShift rv -- XXX - Implement CATCH block here
         _ -> return rv
     where
@@ -361 +361 @@
 
     fixEnv :: (Val -> Eval Val) -> Env -> Pad -> Eval (Env -> Env)
-    fixEnv cc env pad
+    fixEnv _cc env pad
         | SubPrim <- typ = do
             return $ \e -> e

src/Pugs/Prim.hs

@@ -379 +379 @@
     return $ VBool True
 op1 "die" = \v -> do
-    pos <- asks envPos
     v'  <- fromVal $! v
-    retShift $! VError (errmsg $! v') [pos]
+    env <- ask
+    retShift $! VError (errmsg $! v') (collectPos (Just env))
     where
     errmsg VUndef      = VStr "Died"
@@ -389 +389 @@
     errmsg (VList [x]) = x
     errmsg x           = x
+    collectPos Nothing    = []
+    collectPos (Just env) = (envPos env:collectPos (envCaller env))
 op1 "warn" = \v -> do
     strs <- fromVal v
     errh <- readVar $ cast "$*ERR"
-    pos  <- asks envPos
-    op2 "IO::say" errh $ VList [ VStr $ pretty (VError (errmsg strs) [pos]) ]
+    env  <- ask
+    op2 "IO::say" errh $ VList [ VStr $ pretty (VError (errmsg strs) (collectPos (Just env))) ]
     where
     errmsg "" = VStr "Warning: something's wrong"
     errmsg x  = VStr x
+    collectPos Nothing    = []
+    collectPos (Just env) = (envPos env:collectPos (envCaller env))
 op1 "fail" = op1 "fail_" -- XXX - to be replaced by Prelude later
 op1 "fail_" = \v -> do