diff --git a/AUTHORS b/AUTHORS new file mode 100644 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,4 @@ +Daniel Gorin + +Contributions from: +Evan Laforge diff --git a/Changes b/Changes --- a/Changes +++ b/Changes @@ -1,3 +1,10 @@ +- ver 0.2.1 + * BUGFIX: Module reloading was broken under 6.8 + * GHC.GhcExceptions are catched and turned into InterpreterErrors + +- ver 0.2.0.1 + * Adds the requirement cabal-version < 1.3 + - ver 0.2 * Works also with GHC 6.8 and 6.6 diff --git a/README b/README --- a/README +++ b/README @@ -9,7 +9,7 @@ === Documentation === The library cames with haddock documentation you can build -(see above). Also, examples/example.hs to see a simple but +(see above). Also, check examples/example.hs to see a simple but comprehensive example (it must be run from the examples directory, since it expects to find the SomeModule.hs file located there). diff --git a/hint.cabal b/hint.cabal --- a/hint.cabal +++ b/hint.cabal @@ -1,5 +1,5 @@ name: hint -version: 0.2 +version: 0.2.1 description: This library defines an @Interpreter@ monad. It allows to load Haskell modules, browse them, type-check and evaluate strings with Haskell @@ -8,7 +8,8 @@ values). It is, esentially, a huge subset of the GHC API wrapped in a simpler - API. Works with GHC 6.6.x and 6.8.x. + API. Works with GHC 6.6.x and 6.8.x. NOTE: Requires Cabal 1.2, currently + won't install with Cabal 1.3 and above. synopsis: Runtime Haskell interpreter (GHC API wrapper) category: Language, Compilers/Interpreters license: BSD3 @@ -16,6 +17,8 @@ author: Daniel Gorin maintainer: jcpetruzza@gmail.com +-- hackage rejects the correct cabal-version specification +-- cabal-version: >= 1.2 && < 1.3 cabal-version: >= 1.2 build-type: Custom tested-with: GHC==6.6.1, GHC==6.8.2 @@ -32,9 +35,11 @@ hs-source-dirs: src extra-source-files: README + AUTHORS Changes examples/example.hs examples/SomeModule.hs + unit-tests/run-unit-tests.hs ghc-options: -Wall -O2 extensions: CPP diff --git a/src/Language/Haskell/Interpreter/GHC/Base.hs b/src/Language/Haskell/Interpreter/GHC/Base.hs --- a/src/Language/Haskell/Interpreter/GHC/Base.hs +++ b/src/Language/Haskell/Interpreter/GHC/Base.hs @@ -2,11 +2,12 @@ where +import Control.Monad ( liftM ) import Control.Monad.Trans ( MonadIO(liftIO) ) import Control.Monad.Reader ( ReaderT, ask, runReaderT ) import Control.Monad.Error ( Error(..), MonadError(..), ErrorT, runErrorT ) -import Control.Exception ( throwDyn ) +import Control.Exception ( catchDyn, throwDyn ) import Control.Concurrent.MVar ( MVar, newMVar, withMVar ) import Data.IORef ( IORef, newIORef, @@ -41,6 +42,9 @@ data InterpreterError = UnknownError String | WontCompile [GhcError] | NotAllowed String + -- | GhcExceptions from the underlying GHC API are caught + -- and rethrown as this. + | GhcException GHC.GhcException deriving (Show, Typeable) instance Error InterpreterError where @@ -94,20 +98,18 @@ ghc_err_list_ref <- newIORef [] let log_handler = mkLogHandler ghc_err_list_ref -- - let session_state = SessionState{ghcSession = ghc_session, - ghcErrListRef = ghc_err_list_ref, - ghcErrLogger = log_handler} + let session_state = SessionState{ghcSession = ghc_session, + ghcErrListRef = ghc_err_list_ref, + ghcErrLogger = log_handler} -- - -- set HscTarget to HscInterpreted (default is HsAsm!). - -- setSessionDynFlags loads info on packages availables; this call - -- is mandatory! - -- also set a custom log handler, to intercept error messages :S + -- Set a custom log handler, to intercept error messages :S + -- Observe that, setSessionDynFlags loads info on packages available; + -- calling this function once is mandatory! (nevertheless it was most + -- likely already done in Compat.newSession...) dflags <- GHC.getSessionDynFlags ghc_session - let myFlags = dflags{GHC.hscTarget = GHC.HscInterpreted, - GHC.log_action = log_handler} - GHC.setSessionDynFlags ghc_session myFlags + GHC.setSessionDynFlags ghc_session dflags{GHC.log_action = log_handler} -- - return . InterpreterSession =<< newMVar session_state + InterpreterSession `liftM` newMVar session_state mkLogHandler :: IORef [GhcError] -> GhcErrLogger mkLogHandler r _ src style msg = modifyIORef r (errorEntry :) @@ -125,6 +127,11 @@ withSession s i = withMVar (sessionState s) $ \ss -> do err_or_res <- runErrorT . flip runReaderT ss $ unInterpreter i either throwDyn return err_or_res + `catchDyn` rethrowGhcException + +rethrowGhcException :: GHC.GhcException -> IO a +rethrowGhcException = throwDyn . GhcException + -- ================ Handling the interpreter state ================= diff --git a/src/Language/Haskell/Interpreter/GHC/Compat.hs b/src/Language/Haskell/Interpreter/GHC/Compat.hs --- a/src/Language/Haskell/Interpreter/GHC/Compat.hs +++ b/src/Language/Haskell/Interpreter/GHC/Compat.hs @@ -19,7 +19,13 @@ #if __GLASGOW_HASKELL__ >= 608 newSession :: FilePath -> IO GHC.Session -newSession ghc_root = GHC.newSession (Just ghc_root) +newSession ghc_root = + do s <- GHC.newSession (Just ghc_root) + dflags <- GHC.getSessionDynFlags s + GHC.setSessionDynFlags s dflags{GHC.ghcMode = GHC.CompManager, + GHC.hscTarget = GHC.HscInterpreted, + GHC.ghcLink = GHC.LinkInMemory} + return s pprType :: GHC.Type -> (Outputable.PprStyle -> Pretty.Doc) pprType = PprTyThing.pprTypeForUser False -- False means drop explicit foralls @@ -30,7 +36,11 @@ #elif __GLASGOW_HASKELL__ >= 606 newSession :: FilePath -> IO GHC.Session -newSession ghc_root = GHC.newSession GHC.Interactive (Just ghc_root) +newSession ghc_root = + do s <- GHC.newSession GHC.Interactive (Just ghc_root) + dflags <- GHC.getSessionDynFlags s + GHC.setSessionDynFlags s dflags{GHC.hscTarget = GHC.HscInterpreted} + return s pprType :: GHC.Type -> (Outputable.PprStyle -> Pretty.Doc) pprType = Outputable.ppr . GHC.dropForAlls diff --git a/unit-tests/run-unit-tests.hs b/unit-tests/run-unit-tests.hs new file mode 100644 --- /dev/null +++ b/unit-tests/run-unit-tests.hs @@ -0,0 +1,42 @@ +import Control.Exception ( catchDyn ) +import System.Directory ( removeFile ) + +import qualified Language.Haskell.Interpreter.GHC as H + +test_reload_modified :: H.InterpreterSession -> IO Bool +test_reload_modified s = do writeFile mod_file mod_v1 + f_v1 <- H.withSession s get_f + -- + writeFile mod_file mod_v2 + f_v2 <- H.withSession s get_f + -- + removeFile mod_file + -- + return $ (f_v1 5, f_v2 5) == (5, 6) + -- + where mod_name = "TEST_ReloadModified" + mod_file = mod_name ++ ".hs" + -- + mod_v1 = unlines ["module " ++ mod_name, + "where", + "f :: Int -> Int", + "f = id"] + mod_v2 = unlines ["module " ++ mod_name, + "where", + "f :: Int -> Int", + "f = (1 +)"] + -- + get_f = do H.loadModules [mod_file] + H.setTopLevelModules [mod_name] + H.interpret "f" (H.as :: Int -> Int) + +main :: IO () +main = do s <- H.newSession + ok <- test_reload_modified s + if ok + then putStrLn "test ok" + else fail "test failed" + `catchDyn` printInterpreterError + +printInterpreterError :: H.InterpreterError -> IO () +printInterpreterError e = putStrLn $ "Ups... " ++ (show e)