hint 0.2 → 0.2.1
raw patch · 7 files changed
+92/−17 lines, 7 files
Files
- AUTHORS +4/−0
- Changes +7/−0
- README +1/−1
- hint.cabal +7/−2
- src/Language/Haskell/Interpreter/GHC/Base.hs +19/−12
- src/Language/Haskell/Interpreter/GHC/Compat.hs +12/−2
- unit-tests/run-unit-tests.hs +42/−0
+ AUTHORS view
@@ -0,0 +1,4 @@+Daniel Gorin++Contributions from:+Evan Laforge
Changes view
@@ -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
README view
@@ -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).
hint.cabal view
@@ -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
src/Language/Haskell/Interpreter/GHC/Base.hs view
@@ -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 =================
src/Language/Haskell/Interpreter/GHC/Compat.hs view
@@ -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
+ unit-tests/run-unit-tests.hs view
@@ -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)