hint 0.2.1 → 0.2.2
raw patch · 7 files changed
+109/−35 lines, 7 files
Files
- AUTHORS +1/−0
- Changes +6/−0
- hint.cabal +4/−4
- src/Language/Haskell/Interpreter/GHC.hs +11/−18
- src/Language/Haskell/Interpreter/GHC/Base.hs +17/−1
- src/Language/Haskell/Interpreter/GHC/Unsafe.hs +12/−0
- unit-tests/run-unit-tests.hs +58/−12
AUTHORS view
@@ -2,3 +2,4 @@ Contributions from: Evan Laforge+Gwern Branwen
Changes view
@@ -1,3 +1,9 @@+- ver 0.2.2+ * setOptimizations added+ * Module Language.Haskell.Interpreter.GHC.Unsafe added+ (contains unsafeSetGhcOption)+ * unit tests now based on HUnit+ - ver 0.2.1 * BUGFIX: Module reloading was broken under 6.8 * GHC.GhcExceptions are catched and turned into InterpreterErrors
hint.cabal view
@@ -1,5 +1,5 @@ name: hint-version: 0.2.1+version: 0.2.2 description: This library defines an @Interpreter@ monad. It allows to load Haskell modules, browse them, type-check and evaluate strings with Haskell@@ -8,8 +8,7 @@ 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. NOTE: Requires Cabal 1.2, currently- won't install with Cabal 1.3 and above.+ API. Works with GHC 6.6.x and 6.8.x. synopsis: Runtime Haskell interpreter (GHC API wrapper) category: Language, Compilers/Interpreters license: BSD3@@ -18,7 +17,7 @@ maintainer: jcpetruzza@gmail.com -- hackage rejects the correct cabal-version specification--- cabal-version: >= 1.2 && < 1.3+-- cabal-version: >= 1.2 && < 1.5 cabal-version: >= 1.2 build-type: Custom tested-with: GHC==6.6.1, GHC==6.8.2@@ -27,6 +26,7 @@ build-depends: base, haskell-src, ghc, mtl exposed-modules: Language.Haskell.Interpreter.GHC+ Language.Haskell.Interpreter.GHC.Unsafe other-modules: Language.Haskell.Interpreter.GHC.Base Language.Haskell.Interpreter.GHC.Compat Language.Haskell.Interpreter.GHC.Conversions
src/Language/Haskell/Interpreter/GHC.hs view
@@ -20,6 +20,7 @@ withSession, -- ** Interpreter options setUseLanguageExtensions,+ Optimizations(..), setOptimizations, -- ** Context handling ModuleName, loadModules, getLoadedModules, setTopLevelModules,@@ -69,24 +70,16 @@ -- | Set to true to allow GHC's extensions to Haskell 98. setUseLanguageExtensions :: Bool -> Interpreter ()-setUseLanguageExtensions val =- do- ghc_session <- fromSessionState ghcSession- --- let negate_or_not = if val then "" else "no-"- let flag = concat ["-f", negate_or_not, "glasgow-exts"]- --- old_flags <- liftIO $ GHC.getSessionDynFlags ghc_session- (new_flags, not_parsed) <- liftIO $ GHC.parseDynamicFlags old_flags- [flag]- --- when (not . null $ not_parsed) $- throwError $ UnknownError (concat ["flag: '", flag,- "' not recognized"])- --- liftIO $ GHC.setSessionDynFlags ghc_session new_flags- --- return ()+setUseLanguageExtensions True = setGhcOption "-fglasgow-exts"+setUseLanguageExtensions False = setGhcOption "-fno-glasgow-exts"++data Optimizations = None | Some | All deriving (Eq, Read, Show)++-- | Set the optimization level (none, some, all)+setOptimizations :: Optimizations -> Interpreter ()+setOptimizations None = setGhcOption "-O0"+setOptimizations Some = setGhcOption "-O1"+setOptimizations All = setGhcOption "-O2" -- | Module names are _not_ filepaths. type ModuleName = String
src/Language/Haskell/Interpreter/GHC/Base.hs view
@@ -2,7 +2,7 @@ where -import Control.Monad ( liftM )+import Control.Monad ( liftM, when ) import Control.Monad.Trans ( MonadIO(liftIO) ) import Control.Monad.Reader ( ReaderT, ask, runReaderT ) import Control.Monad.Error ( Error(..), MonadError(..), ErrorT, runErrorT )@@ -149,3 +149,19 @@ ref <- fromSessionState target old_val <- liftIO $ atomicModifyIORef ref (\a -> (f a, a)) return old_val++-- ================ Interpreter options =====================++setGhcOptions :: [String] -> Interpreter ()+setGhcOptions opts =+ do ghc_session <- fromSessionState ghcSession+ old_flags <- liftIO $ GHC.getSessionDynFlags ghc_session+ (new_flags, not_parsed) <- liftIO $ GHC.parseDynamicFlags old_flags opts+ when (not . null $ not_parsed) $+ throwError $ UnknownError (concat ["flag: '", unwords opts,+ "' not recognized"])+ liftIO $ GHC.setSessionDynFlags ghc_session new_flags+ return ()++setGhcOption :: String -> Interpreter ()+setGhcOption opt = setGhcOptions [opt]
+ src/Language/Haskell/Interpreter/GHC/Unsafe.hs view
@@ -0,0 +1,12 @@+module Language.Haskell.Interpreter.GHC.Unsafe ( unsafeSetGhcOption )++where++import Language.Haskell.Interpreter.GHC.Base ( Interpreter, setGhcOption )++-- | Set a GHC option for the current session,+-- eg. @unsafeSetGhcOption \"-fno-monomorphism-restriction\"@.+--+-- Warning: Some options may interact badly with the Interpreter.+unsafeSetGhcOption :: String -> Interpreter ()+unsafeSetGhcOption = setGhcOption
unit-tests/run-unit-tests.hs view
@@ -1,18 +1,26 @@-import Control.Exception ( catchDyn )-import System.Directory ( removeFile )+import Control.Exception ( catchDyn, finally ) +import Control.Monad ( liftM, when )+import Control.Monad.Trans ( MonadIO(liftIO) )+import Control.Monad.Error ( catchError )++import System.Directory ( doesFileExist, removeFile )+import System.Exit++import Test.HUnit ( (@?=), (@?) )+import qualified Test.HUnit as HUnit+ 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+test_reload_modified :: H.InterpreterSession -> HUnit.Test+test_reload_modified s = testCase "reload_modifie" [mod_file] $ 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)+ (f_v1 5, f_v2 5) @?= (5, 6) -- where mod_name = "TEST_ReloadModified" mod_file = mod_name ++ ".hs"@@ -30,13 +38,51 @@ H.setTopLevelModules [mod_name] H.interpret "f" (H.as :: Int -> Int) +test_lang_exts :: H.InterpreterSession -> HUnit.Test+test_lang_exts s = testCase "lang_exts" [mod_file] $ do+ writeFile mod_file "data T where T :: T"+ H.withSession s $ do+ loadFails @@? "first time, it shouldn't load"+ --+ H.setUseLanguageExtensions True+ loadSucceeds @@? "now, it should load"+ --+ H.setUseLanguageExtensions False+ loadFails @@? "it shouldn't load, again"+ --+ where mod_name = "TEST_LangExts"+ mod_file = mod_name ++ ".hs"+ --+ loadFails = not `liftM` loadSucceeds+ loadSucceeds = do H.loadModules [mod_name]+ return True+ `catchError` (\_ -> return False)+ main :: IO () main = do s <- H.newSession- ok <- test_reload_modified s- if ok- then putStrLn "test ok"- else fail "test failed"+ --+ c <- HUnit.runTestTT $ HUnit.TestList [+ test_reload_modified s,+ test_lang_exts s]+ --+ let failures = HUnit.errors c + HUnit.failures c+ exit_code+ | failures > 0 = ExitFailure failures+ | otherwise = ExitSuccess+ exitWith exit_code `catchDyn` printInterpreterError printInterpreterError :: H.InterpreterError -> IO ()-printInterpreterError e = putStrLn $ "Ups... " ++ (show e)+printInterpreterError e = do putStrLn $ "Ups... " ++ (show e)+ exitWith (ExitFailure $ -1)++(@@?) :: (HUnit.AssertionPredicable p, MonadIO m) => m p -> String -> m ()+p @@? msg = do b <- p; liftIO (b @? msg)++testCase :: String -> [FilePath] -> HUnit.Assertion -> HUnit.Test+testCase title tmps test = HUnit.TestLabel title $+ HUnit.TestCase (test `finally` clean_up)+ where clean_up = mapM_ removeIfExists tmps+ removeIfExists f = do exists <- doesFileExist f+ when exists $+ removeFile f