ghc-simple 0.2.1 → 0.3

raw patch · 4 files changed

+80/−98 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ghc-simple.cabal +1/−1
• src/Language/Haskell/GHC/Simple.hs +70/−70
• src/Language/Haskell/GHC/Simple/Impl.hs +3/−17
• src/Language/Haskell/GHC/Simple/Types.hs +6/−10

@@ -1,5 +1,5 @@ name:                ghc-simple-version:             0.2.1+version:             0.3 synopsis:            Simplified interface to the GHC API. description:         The GHC API is a great tool for working with Haskell code.                      Unfortunately, it's also fairly opaque and hard to get

@@ -56,7 +56,6 @@ import Data.Binary import qualified Data.ByteString.Lazy as BS import Data.IORef-import Data.List (sort, sortBy) import Control.Monad import GHC.Paths (libdir) import System.Directory@@ -169,42 +168,50 @@       getSession >>= liftIO . fixPrimopTypes nfo strs      -- TODO: get rid of the @runPhase@ from the HscOut phase-    phaseHook _ p@(HscOut src_flavour mod_name result) inp dfs = do-      loc <- getLocation src_flavour mod_name+    phaseHook _ p@(HscOut src mod_name result) inp dfs = do+      loc <- getLocation src mod_name       setModLocation loc-      let next = hscPostBackendPhase dfs src_flavour (hscTarget dfs)+      let next = hscPostBackendPhase dfs src (hscTarget dfs)       case result of         HscRecomp cgguts ms -> do           outfile <- phaseOutputFilename next           comp (ml_hi_file loc) ms cgguts-          runPhase p inp dfs -- return (RealPhase next, outfile)+          runPhase p inp dfs         _ ->-          runPhase p inp dfs -- return (RealPhase next, ml_obj_file loc)+          runPhase p inp dfs     phaseHook stop (RealPhase p) inp _ | p `elem` stop =       return (RealPhase StopLn, inp)     phaseHook _ p inp dfs =       runPhase p inp dfs  -- | Write a module to cache file.-writeModCache :: Binary a => CompConfig -> CompiledModule a -> IO ()-writeModCache cfg (CompiledModule m meta) = do+writeModCache :: Binary a => CompConfig -> ModSummary -> a -> IO ()+writeModCache cfg ms m = do     createDirectoryIfMissing True (takeDirectory cachefile)     BS.writeFile cachefile (encode m)   where-    ext = cfgCacheFileExt cfg-    modfile = moduleNameSlashes (ms_mod_name (mmSummary meta)) <.> ext-    cachefile = maybe "" id (cfgCacheDirectory cfg) </> modfile+    cachefile = cacheFileFor cfg (ms_mod_name ms)  -- | Read a module from cache file.-readModCache :: Binary a => CompConfig -> ModMetadata -> IO (CompiledModule a)-readModCache cfg meta = do+readModCache :: Binary a+             => CompConfig+             -> ModMetadata+             -> [Target]+             -> IO (CompiledModule a)+readModCache cfg meta tgts = do     m <- decode `fmap` BS.readFile cachefile-    return $ CompiledModule m meta+    return $ CompiledModule m meta (mmSummary meta `isTarget` tgts)   where-    ext = cfgCacheFileExt cfg-    modfile = moduleNameSlashes (ms_mod_name (mmSummary meta)) <.> ext-    cachefile = maybe "" id (cfgCacheDirectory cfg) </> modfile+    cachefile = cacheFileFor cfg (ms_mod_name (mmSummary meta)) +-- | Get the cache file for the given 'ModSummary' under the given+--   configuration.+cacheFileFor :: CompConfig -> ModuleName -> FilePath+cacheFileFor cfg name =+    maybe "" id (cfgCacheDirectory cfg) </> modfile+  where+    modfile = moduleNameSlashes name <.> cfgCacheFileExt cfg+ -- | Left fold over a list of compilation targets and their dependencies. -- --   Sometimes you don't just want a huge pile of intermediate code lying@@ -226,13 +233,10 @@             --   'CompConfig', if 'cfgUseTargetsFromFlags' is set.             -> IO (CompResult acc) compileFold cfg comp f acc files = initStaticFlags `seq` do-    warns <- newIORef []     -- all warnings produced by GHC-    accref <- newIORef acc   -- accumulator for compilation fold function-    tgtref <- newIORef []    -- ref containing all compilation targets-    recomp <- newIORef [] -- ref containing all modules that were recompiled+    warns <- newIORef []  -- all warnings produced by GHC     runGhc (maybe (Just libdir) Just (cfgGhcLibDir cfg)) $ do-      (_, files2) <- setDFS cfg dfs warns (comp' accref recomp tgtref)-      ecode <- genCode cfg f accref tgtref recomp (files ++ files2)+      (_, files2) <- setDFS cfg dfs warns compileToCache+      ecode <- genCode cfg f acc (files ++ files2)       ws <- liftIO $ readIORef warns       case ecode of         Right (finaldfs, code) ->@@ -248,20 +252,23 @@             }   where     dfs = discardStaticFlags (cfgGhcFlags cfg)-    comp' accref recompref tgtref hifile ms cgguts = do+    compileToCache hifile ms cgguts = do       source <- prepare ms cgguts-      liftIO $ do-        tgts <- readIORef tgtref-        let meta = toModMetadata cfg False tgts ms-        code <- comp meta source-        let cm = CompiledModule code meta-        writeModCache cfg cm-        -- TODO: if we already recompiled the module, we shouldn't do it-        --       again, for instance when recompilation is forced due to-        --       missing cache file-        atomicModifyIORef' recompref $ \xs -> (ms_mod ms : xs, ())-        readIORef accref >>= flip f cm >>= writeIORef accref+      liftIO $ comp (toModMetadata cfg ms) source >>= writeModCache cfg ms +-- | Is @ms@ in the list of targets?+isTarget :: ModSummary -> [Target] -> Bool+isTarget ms = any (`isTargetOf` ms)++-- | Is @t@ the target that corresponds to @ms@?+isTargetOf :: Target -> ModSummary -> Bool+isTargetOf t ms =+  case targetId t of+    TargetModule mn                                -> ms_mod_name ms == mn+    TargetFile fn _+      | ModLocation (Just f) _ _ <- ms_location ms -> f == fn+    _                                              -> False+ {-# NOINLINE initStaticFlags #-} -- | Use lazy evaluation to only call 'parseStaticFlags' once. initStaticFlags :: [Located String]@@ -272,54 +279,47 @@ genCode :: (GhcMonad m, Binary b)         => CompConfig         -> (a -> CompiledModule b -> IO a)-        -> IORef a-        -> IORef [Target]-        -> IORef [Module]+        -> a         -> [String]         -> m (Either [Error] (DynFlags, a))-genCode cfg f accref tgtref recompref files = do+genCode cfg f acc files = do     dfs <- getSessionDynFlags-    merrs <- handleSourceError (maybeErrors dfs) $ do+    eerrs <- handleSourceError (maybeErrors dfs) $ do       ts <- mapM (flip guessTarget Nothing) files-      liftIO $ writeIORef tgtref ts       setTargets ts-      loads <- load LoadAllTargets-      mss <- depanal [] False-      acc <- liftIO $ readIORef accref-      recompiled <- liftIO $ readIORef recompref-      let cachedmods = sortBy onModId mss \\ sort recompiled-      -- TODO: if some cached mod failed to load, recompile it-      acc' <- liftIO $ foldM (loadCachedMod ts) acc cachedmods-      liftIO $ writeIORef accref acc'-      return $ if succeeded loads then Nothing else Just []-    case merrs of-      Just errs -> return $ Left errs-      _         -> do-        code <- liftIO $ readIORef accref-        return $ Right (dfs, code)-  where-    onModId m n = ms_mod m `compare` ms_mod n -    loadCachedMod tgts acc ms =-      readModCache cfg (toModMetadata cfg True tgts ms) >>= f acc+      -- Compile all modules; if cached code file is gone, then force+      -- recompilation+      (loads, mss) <- do+        loads <- load LoadAllTargets+        mss <- depanal [] False+        recomp <- filterM needRecomp mss+        if null recomp+          then return (loads, mss)+          else do+            mapM_ (liftIO . removeFile . ml_obj_file . ms_location) recomp+            loads' <- load LoadAllTargets+            mss' <- depanal [] False+            return (loads', mss') -    -- remove all mod summaries from msmss whose mod identities exist in mmods.-    -- both lists must be sorted.-    (\\) :: [ModSummary] -> [Module] -> [ModSummary]-    msmss@(ms:mss) \\ mmods@(m:mods)-      | ms_mod ms == m = mss \\ mmods        -- ms found in mods; remove it-      | ms_mod ms <  m = msmss \\ mods       -- ms < m; ms may still be in mods-      | otherwise      = ms : (mss \\ mmods) -- ms > m; ms is not in mods-    mss \\ []          = mss                 -- mods empty, keep all remaining-    []  \\ _           = []                  -- no mss to keep!+      acc' <- liftIO $ foldM (loadCachedMod ts) acc mss+      return $ if succeeded loads then Right acc' else Left []+    case eerrs of+      Left errs -> return $ Left errs+      Right acc -> return $ Right (dfs, acc)+  where+    needRecomp =+      liftIO . fmap not . doesFileExist . cacheFileFor cfg . ms_mod_name+    loadCachedMod tgts acc ms =+      readModCache cfg (toModMetadata cfg ms) tgts >>= f acc      maybeErrors dfs       | cfgUseGhcErrorLogger cfg = \srcerr -> liftIO $ do         let msgs = srcErrorMessages srcerr         printBagOfErrors dfs msgs-        return . Just . map (fromErrMsg dfs) $ bagToList msgs+        return . Left . map (fromErrMsg dfs) $ bagToList msgs       | otherwise =-        return . Just . map (fromErrMsg dfs) . bagToList . srcErrorMessages+        return . Left . map (fromErrMsg dfs) . bagToList . srcErrorMessages  fromErrMsg :: DynFlags -> ErrMsg -> Error fromErrMsg dfs e = Error {

@@ -64,32 +64,18 @@ pkgKeyString = M.packageKeyString #endif --- | Build a 'ModMetadata' out of scattered  metadata.+-- | Build a 'ModMetadata' out of a 'ModSummary'. toModMetadata :: CompConfig-              -> Bool-              -> [Target]               -> ModSummary               -> ModMetadata-toModMetadata cfg cached tgts ms = ModMetadata {+toModMetadata cfg ms = ModMetadata {     mmSummary        = ms,     mmName           = moduleNameString $ ms_mod_name ms,     mmPackageKey     = pkgKeyString . modulePkgKey $ ms_mod ms,-    mmIsTarget       = any (`isTargetOf` ms) tgts,     mmSourceIsHsBoot = ms_hsc_src ms == HsBootFile,     mmSourceFile     = ml_hs_file $ ms_location ms,-    mmInterfaceFile  = ml_hi_file $ ms_location ms,-    mmCached         = cached+    mmInterfaceFile  = ml_hi_file $ ms_location ms   }----- | Is @t@ the target that corresponds to @ms@?-isTargetOf :: Target -> ModSummary -> Bool-isTargetOf t ms =-  case targetId t of-    TargetModule mn                                -> ms_mod_name ms == mn-    TargetFile fn _-      | ModLocation (Just f) _ _ <- ms_location ms -> f == fn-    _                                              -> False  -- | Compile a 'ModSummary' into a list of simplified 'StgBinding's. --   See <https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/StgSynType>

@@ -143,7 +143,11 @@     modCompiledModule :: a,      -- | Metadata for the compiled module.-    modMetaData :: ModMetadata+    modMetadata :: ModMetadata,++    -- | Was the module a target of the current compilation, as opposed to+    --   a dependency of some target?+    modIsTarget :: Bool   }  -- | Metadata for a module under compilation.@@ -162,10 +166,6 @@     --   'stgModSummary'.     mmPackageKey :: String, -    -- | Is this module a compilation target (as opposed to a dependency of-    --   one)?-    mmIsTarget :: Bool,-     -- | Was the module compiler from a @hs-boot@ file?     mmSourceIsHsBoot :: Bool, @@ -173,11 +173,7 @@     mmSourceFile :: Maybe FilePath,      -- | Interface file corresponding to this module.-    mmInterfaceFile :: FilePath,--    -- | Was this module loaded from cache, as opposed to recompiled from-    --   scratch?-    mmCached :: Bool+    mmInterfaceFile :: FilePath   }  -- | A GHC error message.