Merge pull request #954 from GaloisInc/repl-catch

Catch stack trace exceptions in the REPL

Author: chameco

saw/SAWScript/REPL/Command.hs

@@ -139,14 +139,13 @@ genHelp cs = map cmdHelp cs
 runCommand :: Command -> REPL ()
 runCommand c = case c of
 
-  Command cmd -> cmd `SAWScript.REPL.Monad.catch` handler
-                     `SAWScript.REPL.Monad.catchIO` handlerIO
-                     `SAWScript.REPL.Monad.catchFail` handler2
-                     `SAWScript.REPL.Monad.catchTypeErrors` handlerIO
+  Command cmd -> cmd `SAWScript.REPL.Monad.catch` handlerPP
+                     `SAWScript.REPL.Monad.catchFail` handlerFail
+                     `SAWScript.REPL.Monad.catchOther` handlerPrint
     where
-    handler re = io (putStrLn "" >> print (pp re))
-    handler2 s = io (putStrLn "" >> putStrLn s)
-    handlerIO e = io (putStrLn "" >> print e)
+    handlerPP re = io (putStrLn "" >> print (pp re))
+    handlerPrint e = io (putStrLn "" >> print e)
+    handlerFail s = io (putStrLn "" >> putStrLn s)
 
   Unknown cmd -> io (putStrLn ("Unknown command: " ++ cmd))
 

saw/SAWScript/REPL/Monad.hs

@@ -17,9 +17,8 @@ module SAWScript.REPL.Monad (
   , raise
   , stop
   , catch
-  , catchIO
   , catchFail
-  , catchTypeErrors
+  , catchOther
 
     -- ** Errors
   , REPLException(..)
@@ -82,7 +81,6 @@ import qualified Data.AIG as AIG
 --------------------
 
 import SAWScript.AST (Located(getVal))
-import SAWScript.Exceptions
 import SAWScript.Interpreter (buildTopLevelEnv)
 import SAWScript.Options (Options)
 import SAWScript.TopLevel (TopLevelRO(..), TopLevelRW(..))
@@ -214,14 +212,6 @@ raise exn = io (X.throwIO exn)
 catchEx :: X.Exception e => REPL a -> (e -> REPL a) -> REPL a
 catchEx m k = REPL (\ ref -> unREPL m ref `X.catch` \ e -> unREPL (k e) ref)
 
--- | Handle 'IOError' exceptions in 'REPL' actions.
-catchIO :: REPL a -> (IOError -> REPL a) -> REPL a
-catchIO = catchEx
-
--- | Handle SAWScript type error exceptions in 'REPL' actions.
-catchTypeErrors :: REPL a -> (TypeErrors -> REPL a) -> REPL a
-catchTypeErrors = catchEx
-
 -- | Handle 'REPLException' exceptions in 'REPL' actions.
 catch :: REPL a -> (REPLException -> REPL a) -> REPL a
 catch = catchEx
@@ -234,6 +224,10 @@ catchFail m k = REPL (\ ref -> X.catchJust sel (unREPL m ref) (\s -> unREPL (k s
     sel e | isUserError e = Just (ioeGetErrorString e)
           | otherwise     = Nothing
 
+-- | Handle any other exception
+catchOther :: REPL a -> (X.SomeException -> REPL a) -> REPL a
+catchOther = catchEx
+
 rethrowEvalError :: IO a -> IO a
 rethrowEvalError m = run `X.catch` rethrow
   where

src/SAWScript/Exceptions.hs

@@ -31,7 +31,14 @@ data TopLevelException
   | CrucibleSetupException ProgramLoc String
   | OverrideMatcherException ProgramLoc String
   | LLVMMethodSpecException ProgramLoc String
-  deriving Show
+
+instance Show TopLevelException where
+  show (TopLevelException _ msg) = msg
+  show (JavaException _ msg) = msg
+  show (CrucibleSetupException _ msg) = msg
+  show (OverrideMatcherException _ msg) = msg
+  show (LLVMMethodSpecException _ msg) = msg
+
 instance Exception TopLevelException
 
 data TraceException = TraceException String

src/SAWScript/Value.hs

@@ -988,11 +988,7 @@ addTraceIO str action = X.catches action
   where
     rethrow msg = X.throwIO . SS.TraceException $ mconcat [str, ":\n", msg]
     handleTopLevel :: SS.TopLevelException -> IO a
-    handleTopLevel (SS.TopLevelException _pos msg) = rethrow msg
-    handleTopLevel (SS.JavaException _pos msg) = rethrow msg
-    handleTopLevel (SS.CrucibleSetupException _loc msg) = rethrow msg
-    handleTopLevel (SS.OverrideMatcherException _loc msg) = rethrow msg
-    handleTopLevel (SS.LLVMMethodSpecException _loc msg) = rethrow msg
+    handleTopLevel e = rethrow $ show e
     handleTrace (SS.TraceException msg) = rethrow msg
     handleIO :: X.IOException -> IO a
     handleIO e