hint 0.5.1 → 0.5.2

raw patch · 21 files changed

+453/−289 lines, 21 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• examples/example.hs +30/−22
• hint.cabal +2/−2
• src/Control/Monad/Ghc.hs +4/−4
• src/Hint/Annotations.hs +13/−54
• src/Hint/Base.hs +5/−7
• src/Hint/Compat.hs +2/−60
• src/Hint/CompatPlatform.hs +2/−9
• src/Hint/Configuration.hs +3/−3
• src/Hint/Context.hs +64/−26
• src/Hint/Eval.hs +10/−6
• src/Hint/Extension.hs +213/−1
• src/Hint/GHC.hs +19/−34
• src/Hint/InterpreterT.hs +32/−23
• src/Hint/Parsers.hs +3/−4
• src/Hint/Reflection.hs +3/−3
• src/Hint/Typecheck.hs +11/−2
• src/Hint/Util.hs +0/−4
• src/Language/Haskell/Interpreter.hs +1/−1
• src/Language/Haskell/Interpreter/Unsafe.hs +17/−4
• unit-tests/run-unit-tests.hs +13/−20

@@ -1,3 +1,9 @@+### 0.5.2++* Add `runInterpreter` variant that takes a GHC libdir at runtime+* Add missing negated extensions to the `Extension` type+* Do not throw GHC warnings as errors+ ### 0.5.1  * Expose `unsafeInterpret` in `Language.Haskell.Interpreter.Unsafe`

@@ -1,62 +1,70 @@+import Data.List+ import Control.Monad import Language.Haskell.Interpreter  main :: IO () main = do r <- runInterpreter testHint           case r of-            Left err -> printInterpreterError err-            Right () -> putStrLn "that's all folks"+            Left err -> putStrLn $ errorString err+            Right () -> return () +errorString :: InterpreterError -> String+errorString (WontCompile es) = intercalate "\n" (header : map unbox es)+  where+    header = "ERROR: Won't compile:"+    unbox (GhcError e) = e+errorString e = show e++say :: String -> Interpreter ()+say = liftIO . putStrLn++emptyLine :: Interpreter ()+emptyLine = say ""+ -- observe that Interpreter () is an alias for InterpreterT IO () testHint :: Interpreter () testHint =     do       say "Load SomeModule.hs"       loadModules ["SomeModule.hs"]-      --+      emptyLine       say "Put the Prelude, Data.Map and *SomeModule in scope"       say "Data.Map is qualified as M!"       setTopLevelModules ["SomeModule"]       setImportsQ [("Prelude", Nothing), ("Data.Map", Just "M")]-      --+      emptyLine       say "Now we can query the type of an expression"       let expr1 = "M.singleton (f, g, h, 42)"       say $ "e.g. typeOf " ++ expr1       say =<< typeOf expr1-      --+      emptyLine       say $ "Observe that f, g and h are defined in SomeModule.hs, " ++             "but f is not exported. Let's check it..."       exports <- getModuleExports "SomeModule"-      say (show exports)-      --+      say $ show exports+      emptyLine       say "We can also evaluate an expression; the result will be a string"       let expr2 = "length $ concat [[f,g],[h]]"       say $ "e.g. eval " ++ show expr2       a <- eval expr2-      say (show a)-      --+      say $ show a+      emptyLine       say "Or we can interpret it as a proper, say, int value!"       a_int <- interpret expr2 (as :: Int)-      say (show a_int)-      --+      say $ show a_int+      emptyLine       say "This works for any monomorphic type, even for function types"       let expr3 = "\\(Just x) -> succ x"       say $ "e.g. we interpret " ++ expr3 ++             " with type Maybe Int -> Int and apply it on Just 7"       fun <- interpret expr3 (as :: Maybe Int -> Int)-      say . show $ fun (Just 7)-      --+      say $ show $ fun (Just 7)+      emptyLine       say "And sometimes we can even use the type system to infer the expected type (eg Maybe Bool -> Bool)!"       bool_val <- interpret expr3 infer `ap` return (Just False)-      say (show $ not bool_val)-      --+      say $ show $ not bool_val+      emptyLine       say "Here we evaluate an expression of type string, that when evaluated (again) leads to a string"       res <- interpret "head $ map show [\"Worked!\", \"Didn't work\"]" infer >>= flip interpret infer       say res--say :: String -> Interpreter ()-say = liftIO . putStrLn--printInterpreterError :: InterpreterError -> IO ()-printInterpreterError e = putStrLn $ "Ups... " ++ show e-

@@ -1,5 +1,5 @@ name:         hint-version:      0.5.1+version:      0.5.2 description:         This library defines an Interpreter monad. It allows to load Haskell         modules, browse them, type-check and evaluate strings with Haskell@@ -45,7 +45,7 @@  Library   build-depends: base == 4.*,-                 ghc >= 7.6,+                 ghc >= 7.6 && < 8,                  ghc-paths,                  mtl,                  filepath,

@@ -11,10 +11,10 @@  import Control.Monad.Catch -import qualified GHC ( runGhcT )+import qualified GHC (runGhcT) import qualified MonadUtils as GHC-import qualified Exception  as GHC-import qualified GhcMonad   as GHC+import qualified Exception as GHC+import qualified GhcMonad as GHC  import qualified DynFlags as GHC @@ -43,7 +43,7 @@ instance MonadCatch m => MonadThrow (GhcT m) where     throwM = lift . throwM -instance (MonadIO m,MonadCatch m, MonadMask m) => MonadCatch (GhcT m) where+instance (MonadIO m, MonadCatch m, MonadMask m) => MonadCatch (GhcT m) where     m `catch` f = GhcT (unGhcT m `GHC.gcatch` (unGhcT . f))  instance (MonadIO m, MonadMask m) => MonadMask (GhcT m) where

@@ -1,11 +1,8 @@--- - extract annotations from modules etc. with the GHC API.--- - requires GHC >= 6.11------ austin seipp <as@nijoruj.org>-module Hint.Annotations-( getModuleAnnotations -- :: (Data a, MonadInterpreter m) => a -> String -> m [a]-, getValAnnotations    -- :: (Data a, MonadInterpreter m) => a -> String -> m [a]+module Hint.Annotations (+    getModuleAnnotations,+    getValAnnotations ) where+ import Control.Monad import Data.Data import Annotations@@ -15,58 +12,20 @@ import HscTypes (hsc_mod_graph, ms_mod) import qualified Hint.GHC as GHC --- | Get the annotations associated with a particular module.------   For example, given:------   @---   RBRACE-\# ANN module (1 :: Int) \#-LBRACE---   module SomeModule(g, h) where---   ...---   @------   Then after using 'loadModule' to load SomeModule into scope:------   @---   x <- getModuleAnnotations (as :: Int) "SomeModule"---   liftIO $ print x---   -- result is [1]---   @+-- Get the annotations associated with a particular module. getModuleAnnotations :: (Data a, MonadInterpreter m) => a -> String -> m [a] getModuleAnnotations _ x = do-  mods <- liftM hsc_mod_graph $ runGhc GHC.getSession-  let x' = filter ((==) x . GHC.moduleNameString . GHC.moduleName . ms_mod) mods-  v <- mapM (anns . ModuleTarget . ms_mod) x'-  return $ concat v+    mods <- liftM hsc_mod_graph $ runGhc GHC.getSession+    let x' = filter ((==) x . GHC.moduleNameString . GHC.moduleName . ms_mod) mods+    v <- mapM (anns . ModuleTarget . ms_mod) x'+    return $ concat v --- | Get the annotations associated with a particular function------   For example, given:------   @---   module SomeModule(g, h) where------   LBRACE-\# ANN g (Just 1 :: Maybe Int) \#-RBRACE---   g = f [f]------   LBRACE-\# ANN h (Just 2 :: Maybe Int) \#-RBRACE---   h = f---   @------   Then after using 'loadModule' to bring SomeModule into scope:------   @---   x <- liftM concat $ mapM (getValAnnotations (as :: Maybe Int)) [\"g\",\"h\"]---   liftIO $ print x---   -- result is [Just 2, Just 1]---   @------   This can also work on data constructors and types with annotations.+-- Get the annotations associated with a particular function. getValAnnotations :: (Data a, MonadInterpreter m) => a -> String -> m [a] getValAnnotations _ x = do-  x' <- runGhc1 GHC.parseName x-  v <- mapM (anns . NamedTarget) x'-  return $ concat v+    x' <- runGhc1 GHC.parseName x+    v <- mapM (anns . NamedTarget) x'+    return $ concat v  anns :: (MonadInterpreter m, Data a) => AnnTarget GHC.Name -> m [a] anns = runGhc1 (GHC.findGlobalAnns deserializeWithData)

@@ -61,7 +61,7 @@                            hintSupportModule :: PhantomModule,                            importQualHackMod :: Maybe PhantomModule,                            qualImports       :: [(ModuleName, String)],-                           defaultExts       :: [(Extension,Bool)], -- R/O+                           defaultExts       :: [(Extension, Bool)], -- R/O                            configuration     :: InterpreterConfiguration                         } @@ -76,7 +76,7 @@ instance Exception InterpreterError  type RunGhc  m a =-    (forall n.(MonadIO n, MonadMask n,Functor n) => GHC.GhcT n a)+    (forall n.(MonadIO n, MonadMask n, Functor n) => GHC.GhcT n a)  -> m a  type RunGhc1 m a b =@@ -152,11 +152,9 @@         es <- modifySessionRef ghcErrListRef (const [])         --         case (maybe_res, null es) of-            (Nothing,True)  -> throwM $ UnknownError "Got no error message"-            (Nothing,False) -> throwM $ WontCompile (reverse es)-            (Just a, True)  -> return a-            (Just _, False) -> fail $ "GHC returned a result but said: " ++-                                      show es+            (Nothing, True)  -> throwM $ UnknownError "Got no error message"+            (Nothing, False) -> throwM $ WontCompile (reverse es)+            (Just a, _)      -> return a  -- ================= Debugging stuff =============== 

@@ -1,16 +1,12 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# OPTIONS_GHC -fno-warn-missing-signatures #-} module Hint.Compat where -import Control.Monad (foldM, liftM)- import qualified Hint.GHC as GHC  -- Kinds became a synonym for Type in GHC 6.8. We define this wrapper -- to be able to define a FromGhcRep instance for both versions newtype Kind = Kind GHC.Kind --- supportedLanguages :: [String]+supportedExtensions :: [String] supportedExtensions = map f GHC.xFlags     where #if (__GLASGOW_HASKELL__ >= 710)@@ -19,42 +15,6 @@       f (e,_,_) = e #endif -setContext :: GHC.GhcMonad m => [GHC.Module] -> [GHC.ImportDecl GHC.RdrName] -> m ()-setContext ms ds =-  let ms' = map modToIIMod ms-      ds' = map GHC.IIDecl ds-      is = ms' ++ ds'-  in GHC.setContext is--getContext :: GHC.GhcMonad m => m ([GHC.Module], [GHC.ImportDecl GHC.RdrName])-getContext = GHC.getContext >>= foldM f ([], [])-  where-    f :: (GHC.GhcMonad m) =>-         ([GHC.Module], [GHC.ImportDecl GHC.RdrName]) ->-         GHC.InteractiveImport ->-         m ([GHC.Module], [GHC.ImportDecl GHC.RdrName])-    f (ns, ds) i = case i of-      (GHC.IIDecl d)     -> return (ns, d : ds)-      m@(GHC.IIModule _) -> do n <- iiModToMod m; return (n : ns, ds)--modToIIMod :: GHC.Module -> GHC.InteractiveImport-iiModToMod :: GHC.GhcMonad m => GHC.InteractiveImport -> m GHC.Module-modToIIMod = GHC.IIModule . GHC.moduleName-iiModToMod (GHC.IIModule m) = GHC.findModule m Nothing-iiModToMod _ = error "iiModToMod!"---- Explicitly-typed variants of getContext/setContext, for use where we modify--- or override the context.-setContextModules :: GHC.GhcMonad m => [GHC.Module] -> [GHC.Module] -> m ()-setContextModules as = setContext as . map (GHC.simpleImportDecl . GHC.moduleName)--getContextNames :: GHC.GhcMonad m => m([String], [String])-getContextNames = fmap (\(as,bs) -> (map name as, map decl bs)) getContext-    where name = GHC.moduleNameString . GHC.moduleName-          decl = GHC.moduleNameString . GHC.unLoc . GHC.ideclName--stringToStringBuffer = return . GHC.stringToStringBuffer- configureDynFlags :: GHC.DynFlags -> GHC.DynFlags configureDynFlags dflags = dflags{GHC.ghcMode    = GHC.CompManager,                                   GHC.hscTarget  = GHC.HscInterpreted,@@ -62,31 +22,13 @@                                   GHC.verbosity  = 0}  parseDynamicFlags :: GHC.GhcMonad m-                   => GHC.DynFlags -> [String] -> m (GHC.DynFlags, [String])+                  => GHC.DynFlags -> [String] -> m (GHC.DynFlags, [String]) parseDynamicFlags d = fmap firstTwo . GHC.parseDynamicFlags d . map GHC.noLoc     where firstTwo (a,b,_) = (a, map GHC.unLoc b) -fileTarget :: FilePath -> GHC.Target-fileTarget f = GHC.Target (GHC.TargetFile f $ Just next_phase) True Nothing-    where next_phase = GHC.Cpp GHC.HsSrcFile---- add a bogus Maybe, in order to use it with mayFail-compileExpr :: GHC.GhcMonad m => String -> m (Maybe GHC.HValue)-compileExpr = fmap Just . GHC.compileExpr---- add a bogus Maybe, in order to use it with mayFail-exprType :: GHC.GhcMonad m => String -> m (Maybe GHC.Type)-exprType = fmap Just . GHC.exprType---- add a bogus Maybe, in order to use it with mayFail-typeKind :: GHC.GhcMonad m => String -> m (Maybe GHC.Kind)-typeKind = fmap Just . (liftM snd) . (GHC.typeKind True)- pprType :: GHC.Type -> GHC.SDoc #if __GLASGOW_HASKELL__ < 708 pprType = GHC.pprTypeForUser False -- False means drop explicit foralls #else pprType = GHC.pprTypeForUser #endif--mkLocMessage = GHC.mkLocMessage GHC.SevError

@@ -9,15 +9,13 @@ import Prelude  #if defined(mingw32_HOST_OS) || defined(__MINGW32__)- import Data.Word- #else- import System.Posix.Process- #endif +getPID :: IO Int+ #if defined(mingw32_HOST_OS) || defined(__MINGW32__) -- This function is not yet in the win32 package, so we have to -- roll down our own definition.@@ -27,12 +25,7 @@ foreign import stdcall unsafe "winbase.h GetCurrentProcessId"     c_GetCurrentProcessId :: IO Word32 -getPID :: IO Int getPID = fromIntegral <$> c_GetCurrentProcessId- #else--getPID :: IO Int getPID = fromIntegral <$> getProcessID- #endif

@@ -14,12 +14,12 @@ import Control.Monad import Control.Monad.Catch import Data.Char-import Data.List ( intercalate )+import Data.List (intercalate)  import qualified Hint.GHC as GHC import qualified Hint.Compat as Compat import Hint.Base-import Hint.Util ( quote )+import Hint.Util (quote)  import Hint.Extension @@ -75,7 +75,7 @@ languageExtensions :: MonadInterpreter m => Option m [Extension] languageExtensions = Option setter getter     where setter es = do resetExtensions-                         setGhcOptions $ map (extFlag True)  es+                         setGhcOptions $ map (extFlag True) es                          onConf $ \c -> c{languageExts = es}           --           getter = fromConf languageExts

@@ -10,20 +10,20 @@       supportString, supportShow ) where -import Prelude hiding ( mod )+import Prelude hiding (mod)  import Data.Char import Data.List -import Control.Monad       ( liftM, filterM, unless, guard )-import Control.Monad.Trans ( liftIO )+import Control.Arrow ((***))++import Control.Monad       (liftM, filterM, unless, guard, foldM, (>=>))+import Control.Monad.Trans (liftIO) import Control.Monad.Catch  import Hint.Base-import Hint.Util ( (>=>) ) -- compat version import Hint.Conversions-import qualified Hint.Util   as Util-import qualified Hint.Compat as Compat+import qualified Hint.Util as Util import qualified Hint.CompatPlatform as Compat  import qualified Hint.GHC as GHC@@ -55,28 +55,67 @@        return PhantomModule{pmName = mod_name, pmFile = tmp_dir </> nums}  allModulesInContext :: MonadInterpreter m => m ([ModuleName], [ModuleName])-allModulesInContext = runGhc Compat.getContextNames+allModulesInContext = runGhc getContextNames +getContext :: GHC.GhcMonad m => m ([GHC.Module], [GHC.ImportDecl GHC.RdrName])+getContext = GHC.getContext >>= foldM f ([], [])+  where+    f :: (GHC.GhcMonad m) =>+         ([GHC.Module], [GHC.ImportDecl GHC.RdrName]) ->+         GHC.InteractiveImport ->+         m ([GHC.Module], [GHC.ImportDecl GHC.RdrName])+    f (ns, ds) i = case i of+      (GHC.IIDecl d)     -> return (ns, d : ds)+      m@(GHC.IIModule _) -> do n <- iiModToMod m; return (n : ns, ds)++modToIIMod :: GHC.Module -> GHC.InteractiveImport+modToIIMod = GHC.IIModule . GHC.moduleName++iiModToMod :: GHC.GhcMonad m => GHC.InteractiveImport -> m GHC.Module+iiModToMod (GHC.IIModule m) = GHC.findModule m Nothing+iiModToMod _ = error "iiModToMod!"++getContextNames :: GHC.GhcMonad m => m([String], [String])+getContextNames = fmap (map name *** map decl) getContext+    where name = GHC.moduleNameString . GHC.moduleName+          decl = GHC.moduleNameString . GHC.unLoc . GHC.ideclName++setContext :: GHC.GhcMonad m => [GHC.Module] -> [GHC.ImportDecl GHC.RdrName] -> m ()+setContext ms ds =+  let ms' = map modToIIMod ms+      ds' = map GHC.IIDecl ds+      is = ms' ++ ds'+  in GHC.setContext is++-- Explicitly-typed variants of getContext/setContext, for use where we modify+-- or override the context.+setContextModules :: GHC.GhcMonad m => [GHC.Module] -> [GHC.Module] -> m ()+setContextModules as = setContext as . map (GHC.simpleImportDecl . GHC.moduleName)++fileTarget :: FilePath -> GHC.Target+fileTarget f = GHC.Target (GHC.TargetFile f $ Just next_phase) True Nothing+    where next_phase = GHC.Cpp GHC.HsSrcFile+ addPhantomModule :: MonadInterpreter m                  => (ModuleName -> ModuleText)                  -> m PhantomModule addPhantomModule mod_text =     do pm <- newPhantomModule-       let t  = Compat.fileTarget (pmFile pm)-           m  = GHC.mkModuleName (pmName pm)+       let t = fileTarget (pmFile pm)+           m = GHC.mkModuleName (pmName pm)        --        liftIO $ writeFile (pmFile pm) (mod_text $ pmName pm)        --        onState (\s -> s{activePhantoms = pm:activePhantoms s})        mayFail (do -- GHC.load will remove all the modules from scope, so first                    -- we save the context...-                   (old_top, old_imps) <- runGhc Compat.getContext+                   (old_top, old_imps) <- runGhc getContext                    --                    runGhc1 GHC.addTarget t                    res <- runGhc1 GHC.load (GHC.LoadUpTo m)                    --                    if isSucceeded res-                     then do runGhc2 Compat.setContext old_top old_imps+                     then do runGhc2 setContext old_top old_imps                              return $ Just ()                      else return Nothing)         `catchIE` (\err -> case err of@@ -101,9 +140,9 @@            if isLoaded              then do -- take it out of scope                      mod <- findModule (pmName pm)-                     (mods, imps) <- runGhc Compat.getContext+                     (mods, imps) <- runGhc getContext                      let mods' = filter (mod /=) mods-                     runGhc2 Compat.setContext mods' imps+                     runGhc2 setContext mods' imps                      --                      let isNotPhantom = isPhantomModule . moduleToString  >=>                                           return . not@@ -111,7 +150,7 @@              else return True        --        let file_name = pmFile pm-       runGhc1 GHC.removeTarget (GHC.targetId $ Compat.fileTarget file_name)+       runGhc1 GHC.removeTarget (GHC.targetId $ fileTarget file_name)        --        onState (\s -> s{activePhantoms = filter (pm /=) $ activePhantoms s})        --@@ -119,8 +158,7 @@          then do mayFail $ do res <- runGhc1 GHC.load GHC.LoadAllTargets                               return $ guard (isSucceeded res) >> Just ()                  liftIO $ removeFile (pmFile pm)-         else do onState (\s -> s{zombiePhantoms = pm:zombiePhantoms s})-                 return ()+         else onState (\s -> s{zombiePhantoms = pm:zombiePhantoms s})  -- Returns a tuple with the active and zombie phantom modules respectively getPhantomModules :: MonadInterpreter m => m ([PhantomModule], [PhantomModule])@@ -159,7 +197,7 @@ loadModules :: MonadInterpreter m => [String] -> m () loadModules fs = do -- first, unload everything, and do some clean-up                     reset-                    doLoad fs `catchIE` (\e  -> reset >> throwM e)+                    doLoad fs `catchIE` (\e -> reset >> throwM e)  doLoad :: MonadInterpreter m => [String] -> m () doLoad fs = mayFail $ do@@ -182,7 +220,7 @@                       return $ ms \\ map pmName (active_pms ++ zombie_pms)  modNameFromSummary :: GHC.ModSummary -> ModuleName-modNameFromSummary =  moduleToString . GHC.ms_mod+modNameFromSummary = moduleToString . GHC.ms_mod  getLoadedModSummaries :: MonadInterpreter m => m [GHC.ModSummary] getLoadedModSummaries =@@ -207,12 +245,12 @@        --        let mod_is_interpr = runGhc1 GHC.moduleIsInterpreted        not_interpreted <- filterM (liftM not . mod_is_interpr) ms_mods-       unless (null $ not_interpreted) $+       unless (null not_interpreted) $          throwM $ NotAllowed ("These modules are not interpreted:\n" ++                               unlines (map moduleToString not_interpreted))        ---       (_, old_imports) <- runGhc Compat.getContext-       runGhc2 Compat.setContext ms_mods old_imports+       (_, old_imports) <- runGhc getContext+       runGhc2 setContext ms_mods old_imports  -- | Sets the modules whose exports must be in context. --@@ -252,9 +290,9 @@                    else return Nothing        --        pm <- maybe (return []) (findModule . pmName >=> return . return) new_pm-       (old_top_level, _) <- runGhc Compat.getContext+       (old_top_level, _) <- runGhc getContext        let new_top_level = pm ++ old_top_level-       runGhc2 Compat.setContextModules new_top_level unqual_mods+       runGhc2 setContextModules new_top_level unqual_mods        --        onState (\s ->s{qualImports = quals}) @@ -264,7 +302,7 @@ cleanPhantomModules :: MonadInterpreter m => m () cleanPhantomModules =     do -- Remove all modules from context-       runGhc2 Compat.setContext [] []+       runGhc2 setContext [] []        --        -- Unload all previously loaded modules        runGhc1 GHC.setTargets []@@ -301,7 +339,7 @@ installSupportModule = do mod <- addPhantomModule support_module                           onState (\st -> st{hintSupportModule = mod})                           mod' <- findModule (pmName mod)-                          runGhc2 Compat.setContext [mod'] []+                          runGhc2 setContext [mod'] []     --     where support_module m = unlines [                                "module " ++ m ++ "( ",@@ -345,4 +383,4 @@                  return $ concat [mod_name, ".", altShowName mod_name]  -- SHOULD WE CALL THIS WHEN MODULES ARE LOADED / UNLOADED?--- foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()+-- foreign import ccall "revertCAFs" rts_revertCAFs :: IO ()

@@ -4,17 +4,17 @@       eval, parens ) where -import qualified GHC.Exts ( unsafeCoerce# )+import qualified GHC.Exts (unsafeCoerce#) -import Data.Typeable hiding ( typeOf )-import qualified Data.Typeable ( typeOf )+import Data.Typeable hiding (typeOf)+import qualified Data.Typeable (typeOf)  import Hint.Base import Hint.Context import Hint.Parsers import Hint.Util -import qualified Hint.Compat as Compat+import qualified Hint.GHC as GHC  -- | Convenience functions to be used with @interpret@ to provide witnesses. --   Example:@@ -38,10 +38,14 @@        failOnParseError parseExpr expr        --        let expr_typesig = concat [parens expr, " :: ", type_str]-       expr_val <- mayFail $ runGhc1 Compat.compileExpr expr_typesig+       expr_val <- mayFail $ runGhc1 compileExpr expr_typesig        --        return (GHC.Exts.unsafeCoerce# expr_val :: a) +-- add a bogus Maybe, in order to use it with mayFail+compileExpr :: GHC.GhcMonad m => String -> m (Maybe GHC.HValue)+compileExpr = fmap Just . GHC.compileExpr+ -- | @eval expr@ will evaluate @show expr@. --  It will succeed only if @expr@ has type t and there is a 'Show' --  instance for t.@@ -61,5 +65,5 @@ -- Solution: @parens s = \"(let {foo =\n\" ++ s ++ \"\\n ;} in foo)\"@ where @foo@ does not occur in @s@ parens :: String -> String parens s = concat ["(let {", foo, " =\n", s, "\n",-                    "                     ;} in ", foo, ")"]+                   "                     ;} in ", foo, ")"]     where foo = safeBndFor s

@@ -127,6 +127,112 @@                | PartialTypeSignatures                | NamedWildCards                | DeriveAnyClass+               | NoOverlappingInstances+               | NoUndecidableInstances+               | NoIncoherentInstances+               | NoDoRec+               | NoRecursiveDo+               | NoParallelListComp+               | NoMultiParamTypeClasses+               | NoMonomorphismRestriction+               | NoFunctionalDependencies+               | NoRank2Types+               | NoRankNTypes+               | NoPolymorphicComponents+               | NoExistentialQuantification+               | NoScopedTypeVariables+               | NoPatternSignatures+               | NoImplicitParams+               | NoFlexibleContexts+               | NoFlexibleInstances+               | NoEmptyDataDecls+               | NoCPP+               | NoKindSignatures+               | NoBangPatterns+               | NoTypeSynonymInstances+               | NoTemplateHaskell+               | NoForeignFunctionInterface+               | NoArrows+               | NoGenerics+               | NoImplicitPrelude+               | NoNamedFieldPuns+               | NoPatternGuards+               | NoGeneralizedNewtypeDeriving+               | NoExtensibleRecords+               | NoRestrictedTypeSynonyms+               | NoHereDocuments+               | NoMagicHash+               | NoTypeFamilies+               | NoStandaloneDeriving+               | NoUnicodeSyntax+               | NoUnliftedFFITypes+               | NoInterruptibleFFI+               | NoCApiFFI+               | NoLiberalTypeSynonyms+               | NoTypeOperators+               | NoRecordWildCards+               | NoRecordPuns+               | NoDisambiguateRecordFields+               | NoTraditionalRecordSyntax+               | NoOverloadedStrings+               | NoGADTs+               | NoGADTSyntax+               | NoMonoPatBinds+               | NoRelaxedPolyRec+               | NoExtendedDefaultRules+               | NoUnboxedTuples+               | NoDeriveDataTypeable+               | NoDeriveGeneric+               | NoDefaultSignatures+               | NoInstanceSigs+               | NoConstrainedClassMethods+               | NoPackageImports+               | NoImpredicativeTypes+               | NoNewQualifiedOperators+               | NoPostfixOperators+               | NoQuasiQuotes+               | NoTransformListComp+               | NoMonadComprehensions+               | NoViewPatterns+               | NoXmlSyntax+               | NoRegularPatterns+               | NoTupleSections+               | NoGHCForeignImportPrim+               | NoNPlusKPatterns+               | NoDoAndIfThenElse+               | NoMultiWayIf+               | NoLambdaCase+               | NoRebindableSyntax+               | NoExplicitForAll+               | NoDatatypeContexts+               | NoMonoLocalBinds+               | NoDeriveFunctor+               | NoDeriveTraversable+               | NoDeriveFoldable+               | NoNondecreasingIndentation+               | NoSafeImports+               | NoSafe+               | NoTrustworthy+               | NoUnsafe+               | NoConstraintKinds+               | NoPolyKinds+               | NoDataKinds+               | NoParallelArrays+               | NoRoleAnnotations+               | NoOverloadedLists+               | NoEmptyCase+               | NoAutoDeriveTypeable+               | NoNegativeLiterals+               | NoBinaryLiterals+               | NoNumDecimals+               | NoNullaryTypeClasses+               | NoExplicitNamespaces+               | NoAllowAmbiguousTypes+               | NoJavaScriptFFI+               | NoPatternSynonyms+               | NoPartialTypeSignatures+               | NoNamedWildCards+               | NoDeriveAnyClass                | UnknownExtension String         deriving (Eq, Show, Read) @@ -236,5 +342,111 @@                    PatternSynonyms,                    PartialTypeSignatures,                    NamedWildCards,-                   DeriveAnyClass+                   DeriveAnyClass,+                   NoOverlappingInstances,+                   NoUndecidableInstances,+                   NoIncoherentInstances,+                   NoDoRec,+                   NoRecursiveDo,+                   NoParallelListComp,+                   NoMultiParamTypeClasses,+                   NoMonomorphismRestriction,+                   NoFunctionalDependencies,+                   NoRank2Types,+                   NoRankNTypes,+                   NoPolymorphicComponents,+                   NoExistentialQuantification,+                   NoScopedTypeVariables,+                   NoPatternSignatures,+                   NoImplicitParams,+                   NoFlexibleContexts,+                   NoFlexibleInstances,+                   NoEmptyDataDecls,+                   NoCPP,+                   NoKindSignatures,+                   NoBangPatterns,+                   NoTypeSynonymInstances,+                   NoTemplateHaskell,+                   NoForeignFunctionInterface,+                   NoArrows,+                   NoGenerics,+                   NoImplicitPrelude,+                   NoNamedFieldPuns,+                   NoPatternGuards,+                   NoGeneralizedNewtypeDeriving,+                   NoExtensibleRecords,+                   NoRestrictedTypeSynonyms,+                   NoHereDocuments,+                   NoMagicHash,+                   NoTypeFamilies,+                   NoStandaloneDeriving,+                   NoUnicodeSyntax,+                   NoUnliftedFFITypes,+                   NoInterruptibleFFI,+                   NoCApiFFI,+                   NoLiberalTypeSynonyms,+                   NoTypeOperators,+                   NoRecordWildCards,+                   NoRecordPuns,+                   NoDisambiguateRecordFields,+                   NoTraditionalRecordSyntax,+                   NoOverloadedStrings,+                   NoGADTs,+                   NoGADTSyntax,+                   NoMonoPatBinds,+                   NoRelaxedPolyRec,+                   NoExtendedDefaultRules,+                   NoUnboxedTuples,+                   NoDeriveDataTypeable,+                   NoDeriveGeneric,+                   NoDefaultSignatures,+                   NoInstanceSigs,+                   NoConstrainedClassMethods,+                   NoPackageImports,+                   NoImpredicativeTypes,+                   NoNewQualifiedOperators,+                   NoPostfixOperators,+                   NoQuasiQuotes,+                   NoTransformListComp,+                   NoMonadComprehensions,+                   NoViewPatterns,+                   NoXmlSyntax,+                   NoRegularPatterns,+                   NoTupleSections,+                   NoGHCForeignImportPrim,+                   NoNPlusKPatterns,+                   NoDoAndIfThenElse,+                   NoMultiWayIf,+                   NoLambdaCase,+                   NoRebindableSyntax,+                   NoExplicitForAll,+                   NoDatatypeContexts,+                   NoMonoLocalBinds,+                   NoDeriveFunctor,+                   NoDeriveTraversable,+                   NoDeriveFoldable,+                   NoNondecreasingIndentation,+                   NoSafeImports,+                   NoSafe,+                   NoTrustworthy,+                   NoUnsafe,+                   NoConstraintKinds,+                   NoPolyKinds,+                   NoDataKinds,+                   NoParallelArrays,+                   NoRoleAnnotations,+                   NoOverloadedLists,+                   NoEmptyCase,+                   NoAutoDeriveTypeable,+                   NoNegativeLiterals,+                   NoBinaryLiterals,+                   NoNumDecimals,+                   NoNullaryTypeClasses,+                   NoExplicitNamespaces,+                   NoAllowAmbiguousTypes,+                   NoJavaScriptFFI,+                   NoPatternSynonyms,+                   NoPartialTypeSignatures,+                   NoNamedWildCards,+                   NoDeriveAnyClass                    ]

@@ -1,50 +1,35 @@ module Hint.GHC (-    module GHC,-    module Outputable,-    module ErrUtils, Message,-    module DriverPhases,-    module StringBuffer,-    module Lexer,-    module Parser,-    module DynFlags,-    module FastString,-    module Control.Monad.Ghc,-    module HscTypes,-    module PprTyThing,-    module SrcLoc,-#if __GLASGOW_HASKELL__ >= 708-    module ConLike,-#endif+    Message, module X ) where -import GHC hiding ( Phase, GhcT, runGhcT )-import Control.Monad.Ghc ( GhcT, runGhcT )+import GHC as X hiding (Phase, GhcT, runGhcT)+import Control.Monad.Ghc as X (GhcT, runGhcT) -import HscTypes ( SourceError, srcErrorMessages, GhcApiError )+import HscTypes as X (SourceError, srcErrorMessages, GhcApiError) -import Outputable   ( PprStyle, SDoc, Outputable(ppr),-                      showSDoc, showSDocForUser, showSDocUnqual,-                      withPprStyle, defaultErrStyle )+import Outputable as X (PprStyle, SDoc, Outputable(ppr),+                        showSDoc, showSDocForUser, showSDocUnqual,+                        withPprStyle, defaultErrStyle) -import ErrUtils     ( mkLocMessage, pprErrMsgBagWithLoc, MsgDoc) -- we alias MsgDoc as Message below+import ErrUtils as X (mkLocMessage, pprErrMsgBagWithLoc, MsgDoc) -- we alias MsgDoc as Message below -import DriverPhases ( Phase(Cpp), HscSource(HsSrcFile) )-import StringBuffer ( stringToStringBuffer )-import Lexer        ( P(..), ParseResult(..), mkPState )-import Parser       ( parseStmt, parseType )-import FastString   ( fsLit )+import DriverPhases as X (Phase(Cpp), HscSource(HsSrcFile))+import StringBuffer as X (stringToStringBuffer)+import Lexer as X (P(..), ParseResult(..), mkPState)+import Parser as X (parseStmt, parseType)+import FastString as X (fsLit) -#if   __GLASGOW_HASKELL__ >= 710-import DynFlags     ( xFlags, xopt, LogAction, FlagSpec(..) )+#if __GLASGOW_HASKELL__ >= 710+import DynFlags as X (xFlags, xopt, LogAction, FlagSpec(..)) #else-import DynFlags     ( xFlags, xopt, LogAction )+import DynFlags as X (xFlags, xopt, LogAction) #endif -import PprTyThing   ( pprTypeForUser )-import SrcLoc       ( mkRealSrcLoc )+import PprTyThing as X (pprTypeForUser)+import SrcLoc as X (mkRealSrcLoc)  #if __GLASGOW_HASKELL__ >= 708-import ConLike      ( ConLike(RealDataCon) )+import ConLike as X (ConLike(RealDataCon)) #endif  type Message = MsgDoc

@@ -1,5 +1,6 @@ module Hint.InterpreterT (-    InterpreterT, Interpreter, runInterpreter, runInterpreterWithArgs,+    InterpreterT, Interpreter,+    runInterpreter, runInterpreterWithArgs, runInterpreterWithArgsLibdir,     MultipleInstancesNotAllowed(..) ) where @@ -14,9 +15,9 @@ import Control.Monad.Reader import Control.Monad.Catch as MC -import Data.Typeable ( Typeable )+import Data.Typeable (Typeable) import Control.Concurrent.MVar-import System.IO.Unsafe ( unsafePerformIO )+import System.IO.Unsafe (unsafePerformIO)  import Data.IORef import Data.Maybe@@ -34,13 +35,14 @@     deriving (Functor, Monad, MonadIO, MonadThrow, MonadCatch, MonadMask)  execute :: (MonadIO m, MonadMask m, Functor m)-        => InterpreterSession+        => String+        -> InterpreterSession         -> InterpreterT m a         -> m (Either InterpreterError a)-execute s = try-          . GHC.runGhcT (Just GHC.Paths.libdir)-          . flip runReaderT s-          . unInterpreterT+execute libdir s = try+                 . GHC.runGhcT (Just libdir)+                 . flip runReaderT s+                 . unInterpreterT  instance MonadTrans InterpreterT where     lift = InterpreterT . lift . lift@@ -68,8 +70,8 @@ -- ================= Executing the interpreter ==================  initialize :: (MonadIO m, MonadThrow m, MonadMask m, Functor m)-              => [String]-              -> InterpreterT m ()+           => [String]+           -> InterpreterT m () initialize args =     do log_handler <- fromSession ghcErrLogger        -- Set a custom log handler, to intercept error messages :S@@ -114,13 +116,20 @@ -- were command-line args. Returns @Left InterpreterError@ in case of -- error. runInterpreterWithArgs :: (MonadIO m, MonadMask m, Functor m)-                          => [String]-                          -> InterpreterT m a-                          -> m (Either InterpreterError a)-runInterpreterWithArgs args action =+                       => [String]+                       -> InterpreterT m a+                       -> m (Either InterpreterError a)+runInterpreterWithArgs args = runInterpreterWithArgsLibdir args GHC.Paths.libdir++runInterpreterWithArgsLibdir :: (MonadIO m, MonadMask m, Functor m)+                             => [String]+                             -> String+                             -> InterpreterT m a+                             -> m (Either InterpreterError a)+runInterpreterWithArgsLibdir args libdir action =   ifInterpreterNotRunning $     do s <- newInterpreterSession `MC.catch` rethrowGhcException-       execute s (initialize args >> action `finally` cleanSession)+       execute libdir s (initialize args >> action `finally` cleanSession)     where rethrowGhcException   = throwM . GhcException . showGhcEx           newInterpreterSession = newSessionData ()           cleanSession =@@ -152,17 +161,17 @@  initialState :: InterpreterState initialState = St {-                   activePhantoms      = [],-                   zombiePhantoms      = [],-                   hintSupportModule  = error "No support module loaded!",+                   activePhantoms    = [],+                   zombiePhantoms    = [],+                   hintSupportModule = error "No support module loaded!",                    importQualHackMod = Nothing,-                   qualImports         = [],-                   defaultExts          = error "defaultExts missing!",-                   configuration        = defaultConf+                   qualImports       = [],+                   defaultExts       = error "defaultExts missing!",+                   configuration     = defaultConf                   }  newSessionData :: MonadIO m => a -> m (SessionData a)-newSessionData  a =+newSessionData a =     do initial_state    <- liftIO $ newIORef initialState        ghc_err_list_ref <- liftIO $ newIORef []        return SessionData {@@ -181,7 +190,7 @@ mkGhcError :: (GHC.SDoc -> String) -> GHC.SrcSpan -> GHC.PprStyle -> GHC.Message -> GhcError mkGhcError render src_span style msg = GhcError{errMsg = niceErrMsg}     where niceErrMsg = render . GHC.withPprStyle style $-                         Compat.mkLocMessage src_span msg+                         GHC.mkLocMessage GHC.SevError src_span msg  -- The MonadInterpreter instance 

@@ -1,11 +1,10 @@ module Hint.Parsers where -import Prelude hiding(span)+import Prelude hiding (span)  import Hint.Base-import qualified Hint.Compat as Compat -import Control.Monad.Trans ( liftIO )+import Control.Monad.Trans (liftIO)  import qualified Hint.GHC as GHC @@ -21,7 +20,7 @@ runParser parser expr =     do dyn_fl <- runGhc GHC.getSessionDynFlags        ---       buf <- Compat.stringToStringBuffer expr+       buf <- (return . GHC.stringToStringBuffer) expr        --        -- ghc >= 7 panics if noSrcLoc is given        let srcLoc = GHC.mkRealSrcLoc (GHC.fsLit "<hint>") 1 1

@@ -45,14 +45,14 @@                       ]     where (cs,ts,ds,fs) =            (-             [asModElem df c | c@(GHC.ATyCon c')   <- xs, GHC.isClassTyCon c'],-             [asModElem df t | t@(GHC.ATyCon c')   <- xs, (not . GHC.isClassTyCon) c'],+             [asModElem df c | c@(GHC.ATyCon c') <- xs, GHC.isClassTyCon c'],+             [asModElem df t | t@(GHC.ATyCon c') <- xs, (not . GHC.isClassTyCon) c'], #if __GLASGOW_HASKELL__ < 708              [asModElem df d | d@GHC.ADataCon{} <- xs], #else              [asModElem df d | d@(GHC.AConLike (GHC.RealDataCon{})) <- xs], #endif-             [asModElem df f | f@GHC.AnId{}     <- xs]+             [asModElem df f | f@GHC.AnId{} <- xs]            )           cs' = [Class n $ filter (alsoIn fs) ms  | Class n ms  <- cs]           ts' = [Data  t $ filter (alsoIn ds) dcs | Data  t dcs <- ts]

@@ -9,6 +9,7 @@ import Hint.Conversions  import qualified Hint.Compat as Compat+import qualified Hint.GHC as GHC  -- | Returns a string representation of the type of the expression. typeOf :: MonadInterpreter m => String -> m String@@ -18,7 +19,7 @@        -- kind of errors        failOnParseError parseExpr expr        ---       ty <- mayFail $ runGhc1 Compat.exprType expr+       ty <- mayFail $ runGhc1 exprType expr        --        typeToString ty @@ -36,9 +37,17 @@        -- kind of errors        failOnParseError parseType type_expr        ---       kind <- mayFail $ runGhc1 Compat.typeKind type_expr+       kind <- mayFail $ runGhc1 typeKind type_expr        --        kindToString (Compat.Kind kind)++-- add a bogus Maybe, in order to use it with mayFail+exprType :: GHC.GhcMonad m => String -> m (Maybe GHC.Type)+exprType = fmap Just . GHC.exprType++-- add a bogus Maybe, in order to use it with mayFail+typeKind :: GHC.GhcMonad m => String -> m (Maybe GHC.Kind)+typeKind = fmap (Just . snd) . GHC.typeKind True  onCompilationError :: MonadInterpreter m                    => ([GhcError] -> m a)

@@ -23,9 +23,5 @@ partitionEither (Left  a:xs) = let (ls,rs) = partitionEither xs in (a:ls,rs) partitionEither (Right b:xs) = let (ls,rs) = partitionEither xs in (ls,b:rs) -infixr 1 >=>-(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)-f >=> g = \x -> f x >>= g- quote :: String -> String quote s = concat ["'", s, "'"]

@@ -40,7 +40,7 @@     -- * Error handling      InterpreterError(..), GhcError(..), MultipleInstancesNotAllowed(..),     -- * Miscellaneous-     ghcVersion,parens,+     ghcVersion, parens,      module Control.Monad.Trans ) where 

@@ -1,5 +1,5 @@ module Language.Haskell.Interpreter.Unsafe (-    unsafeSetGhcOption, unsafeRunInterpreterWithArgs,+    unsafeSetGhcOption, unsafeRunInterpreterWithArgs, unsafeRunInterpreterWithArgsLibdir,     unsafeInterpret ) where @@ -25,7 +25,20 @@ -- --   Warning: Some options may interact badly with the Interpreter. unsafeRunInterpreterWithArgs :: (MonadMask m, MonadIO m, Functor m)-                                => [String]-                                -> InterpreterT m a-                                -> m (Either InterpreterError a)+                             => [String]+                             -> InterpreterT m a+                             -> m (Either InterpreterError a) unsafeRunInterpreterWithArgs = runInterpreterWithArgs++-- | A variant of @unsafeRunInterpreterWithArgs@ which also lets you+--   specify the folder in which the GHC bootstrap libraries (base,+--   containers, etc.) can be found. This allows you to run hint on+--   a machine in which GHC is not installed.+--+--   A typical libdir value would be "/opt/ghc/7.10.3/lib/ghc-7.10.3".+unsafeRunInterpreterWithArgsLibdir :: (MonadIO m, MonadMask m, Functor m)+                                   => [String]+                                   -> String+                                   -> InterpreterT m a+                                   -> m (Either InterpreterError a)+unsafeRunInterpreterWithArgsLibdir = runInterpreterWithArgsLibdir

@@ -1,13 +1,13 @@-module Main ( main ) where+module Main (main) where -import Prelude hiding ( catch )+import Prelude hiding (catch) -import Control.Exception.Extensible ( ArithException(..) )+import Control.Exception.Extensible (ArithException(..)) import Control.Monad.Catch as MC -import Control.Monad       ( liftM, when, void )+import Control.Monad (liftM, when, void, (>=>)) -import Control.Concurrent ( forkIO )+import Control.Concurrent (forkIO) import Control.Concurrent.MVar  import System.IO@@ -15,7 +15,7 @@ import System.Directory import System.Exit -import Test.HUnit ( (@?=), (@?) )+import Test.HUnit ((@?=), (@?)) import qualified Test.HUnit as HUnit  import Language.Haskell.Interpreter@@ -42,9 +42,9 @@                               "f :: Int -> Int",                               "f = (1 +)"]           ---          get_f    =  do loadModules [mod_file]-                         setTopLevelModules [mod_name]-                         interpret "f" (as :: Int -> Int)+          get_f    = do loadModules [mod_file]+                        setTopLevelModules [mod_name]+                        interpret "f" (as :: Int -> Int)  test_lang_exts :: TestCase test_lang_exts = TestCase "lang_exts" [mod_file] $ do@@ -67,7 +67,7 @@                         liftIO $ writeFile mod_file "f = id"                         loadModules [mod_file]                         setTopLevelModules ["Main"]-                        setImportsQ [("Prelude",Nothing),+                        setImportsQ [("Prelude", Nothing),                                        ("Data.Maybe", Just "Mb")]                         --                         typeOf "f $ (1 + 1 :: Int)" @@?= "Int"@@ -103,15 +103,12 @@                                         ("Data.Map", Just "M")]                            typeChecks "null []" @@? "Unqual null"                            typeChecks "M.null M.empty" @@? "Qual null"-                           return ()  test_basic_eval :: TestCase-test_basic_eval = TestCase "basic_eval" [] $ do-                           eval "()" @@?= "()"+test_basic_eval = TestCase "basic_eval" [] $ eval "()" @@?= "()"  test_eval_layout :: TestCase-test_eval_layout = TestCase "eval_layout" [] $ do-                           eval layout_expr @@?= "10"+test_eval_layout = TestCase "eval_layout" [] $ eval layout_expr @@?= "10"     where layout_expr = unlines ["let x = let y = 10",                                  "        in y",                                  "in x"]@@ -194,8 +191,7 @@                       return $! s  test_only_one_instance :: TestCase-test_only_one_instance = TestCase "only_one_instance" [] $ do-    liftIO $ do+test_only_one_instance = TestCase "only_one_instance" [] $ liftIO $ do         r <- newEmptyMVar         let concurrent = runInterpreter (liftIO $ putMVar r False)                           `catch` \MultipleInstancesNotAllowed ->@@ -240,9 +236,6 @@  setSandbox :: Interpreter () setSandbox = set [installedModulesInScope := False]--(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)-f >=> g = \a -> f a >>= g  (@@?) :: (HUnit.AssertionPredicable p, MonadIO m) => m p -> String -> m () p @@? msg = do b <- p; liftIO (b @? msg)