Question

我正在尝试获取包中所有模块的CORE （我使用base-4.9.0.0作为示例。）

按照SO和Haskell wiki上的示例，我设法提出以下功能：

compileToSimpleCore otherincludes path = GHC.runGhc (Just libdir) $ do
    dynflags <- GHC.getSessionDynFlags
    _ <- GHC.setSessionDynFlags dynflags { includePaths = otherincludes ++ includePaths dynflags}
        -- set all files in package as compilation targets
        -- This fixes the issue of not finding an import
    targets <- mapM (`GHC.guessTarget` Nothing) (path:otherincludes)
    GHC.setTargets targets
    _ <- GHC.load GHC.LoadAllTargets
    modSum <- GHC.getModSummary $ GHC.mkModuleName path
    p <- GHC.parseModule modSum
    t <- GHC.typecheckModule p
    d <- GHC.desugarModule t
    l <- GHC.loadModule d
    n <- GHC.getNamesInScope
    c <- return $ GHC.coreModule d
    let guts = mg_binds c
    let modName = GHC.moduleNameString $ GHC.moduleName $ mg_module c
    return guts

我收到以下错误：

base-4.9.0.0/Control/Arrow.hs:3:16:
    unknown flag in  {-# OPTIONS_GHC #-} pragma: -Wno-inline-rule-shadowing

base-4.9.0.0/Data/Typeable/Internal.hs:13:14:
    Unsupported extension: TypeApplications

问题

是否有一种简单的方法可以获得包中使用的所有扩展名（可能通过cabal文件？）

另外，我猜测我错过了pragma错误的标志，但不确定我错过了什么。

更新

所以通过使用base-4.8.2.0作为测试用例来解决上述问题。

我现在遇到了两个问题：

.hsc个文件，因此整个过程会停止。我通过为pacakge中的所有hsc2hs文件手动执行.hsc来解决此问题（暂时）。

包的内部模块不可见：

 Could not find module ‘Control.Monad.ST.Imp’
 it is a hidden module in the package ‘base-4.8.2.0’
 Use -v to see a list of the files searched for.

CODE

我知道这是一个很长的镜头，但是如果有人可以帮助我，或者至少在将来参考，我会使用的代码更新代码（主要是LiquidHaskell的改编版）。

-- initial env is Nothing (empty)
compileToCore :: FilePath -> Package -> IO ModGuts
compileToCore target pkg = runEngingeGhc Nothing pkg $ getGhcInfo target

-- | Set up the GHC environment
runEngingeGhc :: Maybe HscEnv -> Package -> GHC.Ghc a -> IO a
runEngingeGhc hscEnv pkg act =
  GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $
    GHC.runGhc (Just libdir) $ do
      maybe (return ()) GHC.setSession hscEnv
      df <- GHC.getSessionDynFlags
      let df' = df { importPaths  = nub $ includeDirs pkg ++ importPaths df
                    , libraryPaths = nub $ includeDirs pkg ++ libraryPaths df
                  , includePaths = nub $ includeDirs pkg ++ includePaths df
                  , packageFlags = [ ExposePackage (PackageArg "ghc")
                                                    (ModRenaming True [])
                                    , ExposePackage (PackageArg "ghc-paths")
                                                    (ModRenaming True [])]
                                    ++ packageFlags df
                    , ghcLink      = NoLink
                    -- , hscTarget    = HscInterpreted -- HscNothing
                    , ghcMode      = CompManager
                    }
      _ <- GHC.setSessionDynFlags df'
      _ <- liftIO $ initPackages df'
      GHC.defaultCleanupHandler df' act


getGhcInfo :: FilePath -> GHC.Ghc ModGuts
getGhcInfo target = do
  -- paths <- importPaths <$> GHC.getSessionDynFlags
  -- find and Load Targets
  GHC.setTargets . return =<< GHC.guessTarget target Nothing
  impNames <- allDepNames <$> GHC.depanal [] False
  GHC.load GHC.LoadAllTargets
  makeModGuts target


-- get the dependencies
allDepNames :: [ModSummary] -> [String] -- from LiquidH
allDepNames = concatMap (map declNameString . ms_textual_imps)

declNameString :: GHC.Located (GHC.ImportDecl GHC.RdrName) -> String -- from LiquidH
declNameString = GHC.moduleNameString . GHC.unLoc . GHC.ideclName . GHC.unLoc

makeModGuts :: FilePath -> GHC.Ghc ModGuts
makeModGuts f = do
  modGraph <- GHC.getModuleGraph
  case find (\m -> not (isBootSummary m) && f == msHsFilePath m) modGraph of
    Just modSummary -> do
      parsed   <- GHC.parseModule modSummary
      modGuts  <- GHC.coreModule <$> (GHC.desugarModule =<< GHC.typecheckModule parsed)
      return $! modGuts
    Nothing ->
      panic "Ghc Interface: Unable to get GhcModGuts"

GHC API将整个包编译为Core

问题

更新

CODE

0 个答案: