get the renamed (with fully qualified import) haskell AST using ghc api

I can get the following ghc compiler working using ghc api to compile a single file.I would like to get the renamed AST of haskell source (AST with all function calls fully qualified)

ghcmake = defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
  runGhc (Just GP.libdir) $ do
    dflags <- getSessionDynFlags
    setSessionDynFlags dflags
    target <- guessTarget targetFile Nothing
    setTargets [target]
    load LoadAllTargets

From this simple demo,the renaming process ought be done in "load" function.

the source is here

(file:///usr/local/haskell/ghc-7.10.2-x86_64/share/doc/ghc/html/libraries/ghc-7.10.2/src/GhcMake.html#load)

load :: GhcMonad m => LoadHowMuch -> m SuccessFlag Source

This function implements the core of GHC's --make mode. It preprocesses, compiles and loads the specified modules, avoiding re-compilation wherever possible. Depending on the target (see hscTarget) compilating and loading may result in files being created on disk.

load :: GhcMonad m => LoadHowMuch -> m SuccessFlag
load how_much = do
    mod_graph <- depanal [] False
    guessOutputFile
    hsc_env <- getSession

    let hpt1   = hsc_HPT hsc_env
    let dflags = hsc_dflags hsc_env

    -- The "bad" boot modules are the ones for which we have
    -- B.hs-boot in the module graph, but no B.hs
    -- The downsweep should have ensured this does not happen
    -- (see msDeps)
    let all_home_mods = [ms_mod_name s
                        | s <- mod_graph, not (isBootSummary s)]
        bad_boot_mods = [s        | s <- mod_graph, isBootSummary s,
                                    not (ms_mod_name s `elem` all_home_mods)]
    ASSERT( null bad_boot_mods ) return ()

    -- check that the module given in HowMuch actually exists, otherwise
    -- topSortModuleGraph will bomb later.
    let checkHowMuch (LoadUpTo m)           = checkMod m
        checkHowMuch (LoadDependenciesOf m) = checkMod m
        checkHowMuch _ = id

        checkMod m and_then
            | m `elem` all_home_mods = and_then
            | otherwise = do
                    liftIO $ errorMsg dflags (text "no such module:" <+>
                                     quotes (ppr m))
                    return Failed

    checkHowMuch how_much $ do

    -- mg2_with_srcimps drops the hi-boot nodes, returning a
    -- graph with cycles.  Among other things, it is used for
    -- backing out partially complete cycles following a failed
    -- upsweep, and for removing from hpt all the modules
    -- not in strict downwards closure, during calls to compile.
    let mg2_with_srcimps :: [SCC ModSummary]
        mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing

    -- If we can determine that any of the {-# SOURCE #-} imports
    -- are definitely unnecessary, then emit a warning.
    warnUnnecessarySourceImports mg2_with_srcimps

    let
        -- check the stability property for each module.
        stable_mods@(stable_obj,stable_bco)
            = checkStability hpt1 mg2_with_srcimps all_home_mods

        -- prune bits of the HPT which are definitely redundant now,
        -- to save space.
        pruned_hpt = pruneHomePackageTable hpt1
                            (flattenSCCs mg2_with_srcimps)
                            stable_mods

    _ <- liftIO $ evaluate pruned_hpt

    -- before we unload anything, make sure we don't leave an old
    -- interactive context around pointing to dead bindings.  Also,
    -- write the pruned HPT to allow the old HPT to be GC'd.
    modifySession $ _ -> discardIC $ hsc_env { hsc_HPT = pruned_hpt }

    liftIO $ debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
                            text "Stable BCO:" <+> ppr stable_bco)

    -- Unload any modules which are going to be re-linked this time around.
    let stable_linkables = [ linkable
                           | m <- stable_obj++stable_bco,
                             Just hmi <- [lookupUFM pruned_hpt m],
                             Just linkable <- [hm_linkable hmi] ]
    liftIO $ unload hsc_env stable_linkables

    -- We could at this point detect cycles which aren't broken by
    -- a source-import, and complain immediately, but it seems better
    -- to let upsweep_mods do this, so at least some useful work gets
    -- done before the upsweep is abandoned.
    --hPutStrLn stderr "after tsort:n"
    --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))

    -- Now do the upsweep, calling compile for each module in
    -- turn.  Final result is version 3 of everything.

    -- Topologically sort the module graph, this time including hi-boot
    -- nodes, and possibly just including the portion of the graph
    -- reachable from the module specified in the 2nd argument to load.
    -- This graph should be cycle-free.
    -- If we're restricting the upsweep to a portion of the graph, we
    -- also want to retain everything that is still stable.
    let full_mg :: [SCC ModSummary]
        full_mg    = topSortModuleGraph False mod_graph Nothing

        maybe_top_mod = case how_much of
                            LoadUpTo m           -> Just m
                            LoadDependenciesOf m -> Just m
                            _                    -> Nothing

        partial_mg0 :: [SCC ModSummary]
        partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod

        -- LoadDependenciesOf m: we want the upsweep to stop just
        -- short of the specified module (unless the specified module
        -- is stable).
        partial_mg
            | LoadDependenciesOf _mod <- how_much
            = ASSERT( case last partial_mg0 of
                        AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False )
              List.init partial_mg0
            | otherwise
            = partial_mg0

        stable_mg =
            [ AcyclicSCC ms
            | AcyclicSCC ms <- full_mg,
              ms_mod_name ms `elem` stable_obj++stable_bco ]

        -- the modules from partial_mg that are not also stable
        -- NB. also keep cycles, we need to emit an error message later
        unstable_mg = filter not_stable partial_mg
          where not_stable (CyclicSCC _) = True
                not_stable (AcyclicSCC ms)
                   = ms_mod_name ms `notElem` stable_obj++stable_bco

        -- Load all the stable modules first, before attempting to load
        -- an unstable module (#7231).
        mg = stable_mg ++ unstable_mg

    -- clean up between compilations
    let cleanup hsc_env = intermediateCleanTempFiles (hsc_dflags hsc_env)
                              (flattenSCCs mg2_with_srcimps)
                              hsc_env

    liftIO $ debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
                               2 (ppr mg))

    n_jobs <- case parMakeCount dflags of
                    Nothing -> liftIO getNumProcessors
                    Just n  -> return n
    let upsweep_fn | n_jobs > 1 = parUpsweep n_jobs
                   | otherwise  = upsweep

    setSession hsc_env{ hsc_HPT = emptyHomePackageTable }
    (upsweep_ok, modsUpswept)
       <- upsweep_fn pruned_hpt stable_mods cleanup mg

    -- Make modsDone be the summaries for each home module now
    -- available; this should equal the domain of hpt3.
    -- Get in in a roughly top .. bottom order (hence reverse).

    let modsDone = reverse modsUpswept

    -- Try and do linking in some form, depending on whether the
    -- upsweep was completely or only partially successful.

    if succeeded upsweep_ok

     then
       -- Easy; just relink it all.
       do liftIO $ debugTraceMsg dflags 2 (text "Upsweep completely successful.")

          -- Clean up after ourselves
          hsc_env1 <- getSession
          liftIO $ intermediateCleanTempFiles dflags modsDone hsc_env1

          -- Issue a warning for the confusing case where the user
          -- said '-o foo' but we're not going to do any linking.
          -- We attempt linking if either (a) one of the modules is
          -- called Main, or (b) the user said -no-hs-main, indicating
          -- that main() is going to come from somewhere else.
          --
          let ofile = outputFile dflags
          let no_hs_main = gopt Opt_NoHsMain dflags
          let
            main_mod = mainModIs dflags
            a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
            do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib

          when (ghcLink dflags == LinkBinary
                && isJust ofile && not do_linking) $
            liftIO $ debugTraceMsg dflags 1 $
                text ("Warning: output was redirected with -o, " ++
                      "but no output will be generatedn" ++
                      "because there is no " ++
                      moduleNameString (moduleName main_mod) ++ " module.")

          -- link everything together
          linkresult <- liftIO $ link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)

          loadFinish Succeeded linkresult

The code snippet above checks that the module dependency is ok,but after that it seems to jump directly to linking?? and i can not find where the link function is.

linkresult <- liftIO $ link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)

  loadFinish Succeeded linkresult

relevant posts:

https://mistuke.wordpress.com/category/vsx/


From: https://wiki.haskell.org/GHC/As_a_library#Another_example

ghcmake = defaultErrorHandler defaultFatalMessager defaultFlushOut $ do runGhc (Just GP.libdir) $ do dflags <- getSessionDynFlags setSessionDynFlags dflags target <- guessTarget targetFile Nothing setTargets [target] load LoadAllTargets modSum <- getModSummary $ mkModuleName "<Your module name here>" p <- parseModule modSum t <- typecheckModule p let (Just renamedSource) = tm_renamed_source t

After your example code you need to get the module summary for the module you want to parse. Then you need to actually run the parser and the typechecker. Finally you can retrieve the renamed AST from the typechecked result.

链接地址: http://www.djcxy.com/p/7526.html

上一篇: Haskell,GHC 8:动态加载/导入模块

下一篇: 使用ghc api获取重命名的(具有完全限定的导入)haskell AST