hint 0.3.3.4 → 0.3.3.5
raw patch · 11 files changed
+150/−70 lines, 11 filesdep ~ghcdep ~unixPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: ghc, unix
API changes (from Hackage documentation)
- Language.Haskell.Interpreter: as, infer :: Typeable a => a
+ Language.Haskell.Interpreter: as :: Typeable a => a
+ Language.Haskell.Interpreter: infer :: Typeable a => a
Files
- AUTHORS +1/−0
- Changes +4/−0
- hint.cabal +2/−2
- src/Hint/Base.hs +4/−0
- src/Hint/Compat.hs +33/−5
- src/Hint/Context.hs +17/−9
- src/Hint/Conversions.hs +2/−2
- src/Hint/GHC.hs +22/−2
- src/Hint/InterpreterT.hs +17/−5
- src/Hint/Parsers.hs +13/−4
- src/Hint/Reflection.hs +35/−41
AUTHORS view
@@ -12,3 +12,4 @@ Bryan O'Sullivan Conrad Parker Mark Wright+Bertram Felgenhauer
Changes view
@@ -1,3 +1,7 @@+- ver 0.3.3.5+ * Works on GHC 7.4.6+ * Cleans up files for phantom modules that were left behind (thanks to Beltram Felgenhauer)+ - ver 0.3.3.4 * Works on GHC 7.4.1
hint.cabal view
@@ -1,5 +1,5 @@ name: hint-version: 0.3.3.4+version: 0.3.3.5 description: This library defines an @Interpreter@ monad. It allows to load Haskell modules, browse them, type-check and evaluate strings with Haskell@@ -56,7 +56,7 @@ } if !os(windows) {- build-depends: unix >= 2.2.0.0 && < 2.6+ build-depends: unix >= 2.2.0.0 } exposed-modules: Language.Haskell.Interpreter
src/Hint/Base.hs view
@@ -156,11 +156,15 @@ GhcException s -> throwError (buildEx s) _ -> throwError err) +#if __GLASGOW_HASKELL__ < 704 type GhcErrLogger = GHC.Severity -> GHC.SrcSpan -> GHC.PprStyle -> GHC.Message -> IO ()+#else+type GhcErrLogger = GHC.LogAction+#endif -- | Module names are _not_ filepaths. type ModuleName = String
src/Hint/Compat.hs view
@@ -34,8 +34,7 @@ getContext :: GHC.GhcMonad m => m ([GHC.Module], [GHC.Module]) getContext = fmap (\(as,bs) -> (as,map fst bs)) GHC.getContext-#else-#if __GLASGOW_HASKELL__ < 704+#elif __GLASGOW_HASKELL__ < 704 -- Keep setContext/getContext unmodified for use where the results of getContext -- are simply restored by setContext, in which case we don't really care about the -- particular type of b.@@ -48,7 +47,7 @@ #else setContext :: GHC.GhcMonad m => [GHC.Module] -> [GHC.ImportDecl GHC.RdrName] -> m () setContext ms ds =- let ms' = map GHC.IIModule ms+ let ms' = map modToIIMod ms ds' = map GHC.IIDecl ds is = ms' ++ ds' in GHC.setContext is@@ -61,9 +60,21 @@ GHC.InteractiveImport -> m ([GHC.Module], [GHC.ImportDecl GHC.RdrName]) f (ns, ds) i = case i of- (GHC.IIDecl d) -> return (ns, (d:ds))- (GHC.IIModule n) -> return ((n:ns), ds)+ (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+#if __GLASGOW_HASKELL__ < 706+modToIIMod = GHC.IIModule+iiModToMod (GHC.IIModule m) = return m+#else+modToIIMod = GHC.IIModule . GHC.moduleName+iiModToMod (GHC.IIModule m) = GHC.findModule m Nothing #endif+iiModToMod _ = error "iiModToMod!"+ #endif mkPState = GHC.mkPState@@ -220,3 +231,20 @@ #endif +#if __GLASGOW_HASKELL__ >= 706+ -- why did they have to add a DynFlag to each showSDocXXX function.... (sigh)+showSDoc = GHC.showSDoc GHC.tracingDynFlags -- hack!+showSDocForUser = GHC.showSDocForUser GHC.tracingDynFlags -- hack!+showSDocUnqual = GHC.showSDocUnqual+#else+showSDoc = GHC.showSDoc+showSDocForUser = GHC.showSDocForUser+showSDocUnqual = const GHC.showSDocUnqual+#endif+++#if __GLASGOW_HASKELL__ >= 706+mkLocMessage = GHC.mkLocMessage GHC.SevError+#else+mkLocMessage = GHC.mkLocMessage+#endif
src/Hint/Context.hs view
@@ -7,6 +7,7 @@ PhantomModule(..), ModuleText, addPhantomModule, removePhantomModule, getPhantomModules,+ cleanPhantomModules, allModulesInContext, onAnEmptyContext, @@ -250,12 +251,11 @@ -- onState (\s ->s{qual_imports = quals}) --- | All imported modules are cleared from the context, and--- loaded modules are unloaded. It is similar to a @:load@ in--- GHCi, but observe that not even the Prelude will be in--- context after a reset.-reset :: MonadInterpreter m => m ()-reset =+-- | 'cleanPhantomModules' works like 'reset', but skips the+-- loading of the support module that installs '_show'. Its purpose+-- is to clean up all temporary files generated for phantom modules.+cleanPhantomModules :: MonadInterpreter m => m ()+cleanPhantomModules = do -- Remove all modules from context runGhc2 Compat.setContext [] [] --@@ -277,9 +277,17 @@ import_qual_hack_mod = Nothing, qual_imports = []}) liftIO $ mapM_ (removeFile . pm_file) (old_active ++ old_zombie)- --- -- Now, install a support module- installSupportModule++-- | All imported modules are cleared from the context, and+-- loaded modules are unloaded. It is similar to a @:load@ in+-- GHCi, but observe that not even the Prelude will be in+-- context after a reset.+reset :: MonadInterpreter m => m ()+reset = do -- clean up context+ cleanPhantomModules+ --+ -- Now, install a support module+ installSupportModule -- Load a phantom module with all the symbols from the prelude we need installSupportModule :: MonadInterpreter m => m ()
src/Hint/Conversions.hs view
@@ -35,7 +35,7 @@ fromGhcRep t = do -- Unqualify necessary types -- (i.e., do not expose internals) unqual <- runGhc GHC.getPrintUnqual- return $ GHC.showSDocForUser unqual (Compat.pprType t)+ return $ Compat.showSDocForUser unqual (Compat.pprType t) parseModule' :: String -> HsModule parseModule' s = case parseModule s of@@ -45,7 +45,7 @@ show failed] instance FromGhcRep_ Compat.Kind String where- fromGhcRep_ (Compat.Kind k) = GHC.showSDoc (Compat.pprKind k)+ fromGhcRep_ (Compat.Kind k) = Compat.showSDoc (Compat.pprKind k) -- ---------------- Modules --------------------------
src/Hint/GHC.hs view
@@ -1,7 +1,7 @@ module Hint.GHC ( module GHC, module Outputable,- module ErrUtils,+ module ErrUtils, Message, module Pretty, module DriverPhases, module StringBuffer,@@ -38,7 +38,14 @@ import Outputable ( PprStyle, SDoc, ppr, showSDoc, showSDocForUser, showSDocUnqual, withPprStyle, defaultErrStyle )-import ErrUtils ( Message, mkLocMessage )++import ErrUtils ( mkLocMessage )+#if __GLASGOW_HASKELL__ < 706+import ErrUtils ( Message )+#else+import ErrUtils ( MsgDoc ) -- we alias it as Message below+#endif+ import Pretty ( Doc ) import DriverPhases ( Phase(Cpp), HscSource(HsSrcFile) ) import StringBuffer ( stringToStringBuffer )@@ -52,6 +59,14 @@ import DynFlags ( supportedLanguages ) #endif +#if __GLASGOW_HASKELL__ >=704+import DynFlags ( LogAction )+#endif++#if __GLASGOW_HASKELL__ >= 706+import DynFlags ( tracingDynFlags )+#endif+ #if __GLASGOW_HASKELL__ >= 608 import PprTyThing ( pprTypeForUser ) #elif __GLASGOW_HASKELL__ < 608@@ -60,4 +75,9 @@ #if __GLASGOW_HASKELL__ >= 702 import SrcLoc ( mkRealSrcLoc )+#endif+++#if __GLASGOW_HASKELL__ >= 706+type Message = MsgDoc #endif
src/Hint/InterpreterT.hs view
@@ -161,15 +161,20 @@ ifInterpreterNotRunning $ do s <- newInterpreterSession `catch` rethrowGhcException -- SH.protectHandlers $ execute s (initialize args >> action)- execute s (initialize args >> action)+ execute s (initialize args >> action `finally` cleanSession) where rethrowGhcException = throw . GhcException . showGhcEx #if __GLASGOW_HASKELL__ < 610 newInterpreterSession = do s <- liftIO $ Compat.newSession GHC.Paths.libdir newSessionData s+ cleanSession = cleanPhantomModules -- clean ghc session, too? #else -- GHC >= 610 newInterpreterSession = newSessionData ()+ cleanSession =+ do cleanPhantomModules+ runGhc $ do dflags <- GHC.getSessionDynFlags+ GHC.defaultCleanupHandler dflags (return ()) #endif {-# NOINLINE uniqueToken #-}@@ -216,13 +221,20 @@ } mkLogHandler :: IORef [GhcError] -> GhcErrLogger-mkLogHandler r _ src style msg = modifyIORef r (errorEntry :)- where errorEntry = mkGhcError src style msg+mkLogHandler r = compat $ \_ src style msg ->+ let errorEntry = mkGhcError src style msg+ in modifyIORef r (errorEntry :)+ where+#if __GLASGOW_HASKELL__ < 706+ compat = id+#else+ compat = const -- cater for the extra DynFlags args+#endif mkGhcError :: GHC.SrcSpan -> GHC.PprStyle -> GHC.Message -> GhcError mkGhcError src_span style msg = GhcError{errMsg = niceErrMsg}- where niceErrMsg = GHC.showSDoc . GHC.withPprStyle style $- GHC.mkLocMessage src_span msg+ where niceErrMsg = Compat.showSDoc . GHC.withPprStyle style $+ Compat.mkLocMessage src_span msg -- The MonadInterpreter instance
src/Hint/Parsers.hs view
@@ -50,10 +50,19 @@ do -- parsing failed, so we report it just as all -- other errors get reported.... logger <- fromSession ghcErrLogger- liftIO $ logger GHC.SevError- span- GHC.defaultErrStyle- err+#if __GLASGOW_HASKELL__ >= 706+ dflags <- runGhc GHC.getSessionDynFlags+ let logger' = logger dflags+ errStyle = GHC.defaultErrStyle dflags+#else+ let logger' = logger+ errStyle = GHC.defaultErrStyle++#endif+ liftIO $ logger' GHC.SevError+ span+ errStyle+ err -- -- behave like the rest of the GHC API functions -- do on error...
src/Hint/Reflection.hs view
@@ -12,6 +12,7 @@ import Hint.Base import qualified Hint.GHC as GHC+import qualified Hint.Compat as Compat -- | An Id for a class, a type constructor, a data constructor, a binding, etc type Id = String@@ -37,56 +38,49 @@ do module_ <- findModule mn mod_info <- mayFail $ runGhc1 GHC.getModuleInfo module_ exports <- mapM (runGhc1 GHC.lookupName) (GHC.modInfoExports mod_info)+ dflags <- runGhc GHC.getSessionDynFlags --- return (asModElemList $ catMaybes exports)+ return $ asModElemList dflags (catMaybes exports) +asModElemList :: GHC.DynFlags -> [GHC.TyThing] -> [ModuleElem]+asModElemList df xs = concat [+ cs',+ ts',+ ds \\ (concatMap (map Fun . children) ts'),+ fs \\ (concatMap (map Fun . children) cs')+ ]+ where (cs,ts,ds,fs) =+ ( #if __GLASGOW_HASKELL__ < 704-asModElemList :: [GHC.TyThing] -> [ModuleElem]-asModElemList xs = concat [cs',- ts',- ds \\ (concatMap (map Fun . children) ts'),- fs \\ (concatMap (map Fun . children) cs')]- where (cs,ts,ds,fs) = ([asModElem c | c@GHC.AClass{} <- xs],- [asModElem t | t@GHC.ATyCon{} <- xs],- [asModElem d | d@GHC.ADataCon{} <- xs],- [asModElem 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]- alsoIn es = (`elem` (map name es))---asModElem :: GHC.TyThing -> ModuleElem-asModElem (GHC.AnId f) = Fun $ getUnqualName f-asModElem (GHC.ADataCon dc) = Fun $ getUnqualName dc-asModElem (GHC.ATyCon tc) = Data (getUnqualName tc)- (map getUnqualName $ GHC.tyConDataCons tc)-asModElem (GHC.AClass c) = Class (getUnqualName c)- (map getUnqualName $ GHC.classMethods c)-asModElem _ = error "asModElem: can't happen!"+ [asModElem df c | c@GHC.AClass{} <- xs],+ [asModElem df t | t@GHC.ATyCon{} <- xs], #else-asModElemList :: [GHC.TyThing] -> [ModuleElem]-asModElemList xs = concat [cs',- ts',- ds \\ (concatMap (map Fun . children) ts'),- fs \\ (concatMap (map Fun . children) cs')]- where (cs,ts,ds,fs) = ([asModElem c | c@(GHC.ATyCon c') <- xs, GHC.isClassTyCon c'],- [asModElem t | t@(GHC.ATyCon c') <- xs, (not . GHC.isClassTyCon) c'],- [asModElem d | d@GHC.ADataCon{} <- xs],- [asModElem f | f@GHC.AnId{} <- xs])+ [asModElem df c | c@(GHC.ATyCon c') <- xs, GHC.isClassTyCon c'],+ [asModElem df t | t@(GHC.ATyCon c') <- xs, (not . GHC.isClassTyCon) c'],+#endif+ [asModElem df d | d@GHC.ADataCon{} <- 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] alsoIn es = (`elem` (map name es)) -asModElem :: GHC.TyThing -> ModuleElem-asModElem (GHC.AnId f) = Fun $ getUnqualName f-asModElem (GHC.ADataCon dc) = Fun $ getUnqualName dc-asModElem (GHC.ATyCon tc) = +asModElem :: GHC.DynFlags -> GHC.TyThing -> ModuleElem+asModElem df (GHC.AnId f) = Fun $ getUnqualName df f+asModElem df (GHC.ADataCon dc) = Fun $ getUnqualName df dc+#if __GLASGOW_HASKELL__ < 704+asModElem df(GHC.ATyCon tc) = Data (getUnqualName df tc)+ (map (getUnqualName df) $ GHC.tyConDataCons tc)+asModElem df (GHC.AClass c) = Class (getUnqualName c)+ (map (getUnqualName df) $ GHC.classMethods c)+#else+asModElem df (GHC.ATyCon tc) = if GHC.isClassTyCon tc- then Class (getUnqualName tc) (map getUnqualName $ (GHC.classMethods . fromJust . GHC.tyConClass_maybe) tc)- else Data (getUnqualName tc) (map getUnqualName $ GHC.tyConDataCons tc)-asModElem _ = error "asModElem: can't happen!"+ then Class (getUnqualName df tc) (map (getUnqualName df) $ (GHC.classMethods . fromJust . GHC.tyConClass_maybe) tc)+ else Data (getUnqualName df tc) (map (getUnqualName df) $ GHC.tyConDataCons tc)+asModElem _ _ = error "asModElem: can't happen!" #endif -getUnqualName :: GHC.NamedThing a => a -> String-getUnqualName = GHC.showSDocUnqual . GHC.pprParenSymName+getUnqualName :: GHC.NamedThing a => GHC.DynFlags -> a -> String+getUnqualName dfs = Compat.showSDocUnqual dfs . GHC.pprParenSymName